{-# LANGUAGE NoStarIsType    #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module AOC.Common.Point (
  -- * Points
    Point
  , FinPoint
  , cardinalNeighbs
  , cardinalNeighbsSet
  , fullNeighbs
  , fullNeighbsSet
  , mannDist
  , mulPoint
  , lineTo
  -- * Directions
  , Dir(..)
  , parseDir
  , dirPoint
  , dirPoint'
  , rotPoint
  , rotFin
  , mulDir
  , allDir
  , allDirSet
  -- * Orientations
  , D8(..)
  , mulD8
  , orientPoint
  , orientFin
  , allD8
  , allD8Set
  -- * 2D Maps
  , memoPoint
  , boundingBox
  , boundingBox'
  , inBoundingBox
  , minCorner, minCorner'
  , shiftToZero
  , shiftToZero'
  , parseAsciiMap
  , asciiGrid
  , parseAsciiSet
  , ScanPoint(..)
  , displayAsciiMap
  , displayAsciiSet
  -- * Util
  , centeredFinite
  ) where

import           Control.Applicative
import           Control.DeepSeq
import           Control.Lens
import           Data.Char
import           Data.Finitary
import           Data.Finite
import           Data.Finite.Internal
import           Data.Foldable
import           Data.Group
import           Data.Hashable
import           Data.List.NonEmpty      (NonEmpty(..))
import           Data.Map                (Map)
import           Data.Map.Lens
import           Data.MemoCombinators    (Memo)
import           Data.Monoid
import           Data.Ord
import           Data.Proxy
import           Data.Ratio
import           Data.Semigroup
import           Data.Semigroup.Foldable
import           Data.Set                (Set)
import           Data.Set.Lens
import           Data.Set.NonEmpty       (NESet)
import           Data.Tuple.Strict
import           GHC.Generics
import           GHC.TypeNats
import           Linear
import qualified Data.List.NonEmpty      as NE
import qualified Data.Map                as M
import qualified Data.Map.NonEmpty       as NEM
import qualified Data.MemoCombinators    as Memo
import qualified Data.Set                as S
import qualified Data.Set.NonEmpty       as NES

-- | 2D Coordinate
type Point = V2 Int

type FinPoint n = V2 (Finite n)

-- | Find the minimum and maximum x and y from a collection of points.
--
-- Returns @'V2' (V2 xMin yMin) (V2 xMax yMax)@.
boundingBox :: (Foldable1 f, Applicative g, Ord a) => f (g a) -> V2 (g a)
boundingBox :: forall (f :: Type -> Type) (g :: Type -> Type) a.
(Foldable1 f, Applicative g, Ord a) =>
f (g a) -> V2 (g a)
boundingBox = (\(T2 (Ap g (Min a)
mn) (Ap g (Max a)
mx)) -> g a -> g a -> V2 (g a)
forall a. a -> a -> V2 a
V2 (Min a -> a
forall a. Min a -> a
getMin (Min a -> a) -> g (Min a) -> g a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Min a)
mn) (Max a -> a
forall a. Max a -> a
getMax (Max a -> a) -> g (Max a) -> g a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Max a)
mx))
            (T2 (Ap g (Min a)) (Ap g (Max a)) -> V2 (g a))
-> (f (g a) -> T2 (Ap g (Min a)) (Ap g (Max a)))
-> f (g a)
-> V2 (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g a -> T2 (Ap g (Min a)) (Ap g (Max a)))
-> f (g a) -> T2 (Ap g (Min a)) (Ap g (Max a))
forall (t :: Type -> Type) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (\g a
p -> Ap g (Min a) -> Ap g (Max a) -> T2 (Ap g (Min a)) (Ap g (Max a))
forall a b. a -> b -> T2 a b
T2 (g (Min a) -> Ap g (Min a)
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (a -> Min a
forall a. a -> Min a
Min (a -> Min a) -> g a -> g (Min a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> g a
p)) (g (Max a) -> Ap g (Max a)
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (a -> Max a
forall a. a -> Max a
Max (a -> Max a) -> g a -> g (Max a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> g a
p)))

-- | A version of 'boundingBox' that works for normal possibly-empty lists.
boundingBox' :: (Foldable f, Applicative g, Ord a) => f (g a) -> Maybe (V2 (g a))
boundingBox' :: forall (f :: Type -> Type) (g :: Type -> Type) a.
(Foldable f, Applicative g, Ord a) =>
f (g a) -> Maybe (V2 (g a))
boundingBox' = (NonEmpty (g a) -> V2 (g a))
-> Maybe (NonEmpty (g a)) -> Maybe (V2 (g a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (g a) -> V2 (g a)
forall (f :: Type -> Type) (g :: Type -> Type) a.
(Foldable1 f, Applicative g, Ord a) =>
f (g a) -> V2 (g a)
boundingBox (Maybe (NonEmpty (g a)) -> Maybe (V2 (g a)))
-> (f (g a) -> Maybe (NonEmpty (g a)))
-> f (g a)
-> Maybe (V2 (g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [g a] -> Maybe (NonEmpty (g a))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([g a] -> Maybe (NonEmpty (g a)))
-> (f (g a) -> [g a]) -> f (g a) -> Maybe (NonEmpty (g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g a) -> [g a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList

minCorner :: (Foldable1 f, Applicative g, Ord a) => f (g a) -> g a
minCorner :: forall (f :: Type -> Type) (g :: Type -> Type) a.
(Foldable1 f, Applicative g, Ord a) =>
f (g a) -> g a
minCorner = (Min a -> a) -> g (Min a) -> g a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Min a -> a
forall a. Min a -> a
getMin (g (Min a) -> g a) -> (f (g a) -> g (Min a)) -> f (g a) -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ap g (Min a) -> g (Min a)
forall {k} (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Ap g (Min a) -> g (Min a))
-> (f (g a) -> Ap g (Min a)) -> f (g a) -> g (Min a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g a -> Ap g (Min a)) -> f (g a) -> Ap g (Min a)
forall (t :: Type -> Type) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (g (Min a) -> Ap g (Min a)
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (g (Min a) -> Ap g (Min a))
-> (g a -> g (Min a)) -> g a -> Ap g (Min a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Min a) -> g a -> g (Min a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Min a
forall a. a -> Min a
Min)

minCorner' :: (Foldable f, Applicative g, Ord a) => f (g a) -> Maybe (g a)
minCorner' :: forall (f :: Type -> Type) (g :: Type -> Type) a.
(Foldable f, Applicative g, Ord a) =>
f (g a) -> Maybe (g a)
minCorner' = (NonEmpty (g a) -> g a) -> Maybe (NonEmpty (g a)) -> Maybe (g a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (g a) -> g a
forall (f :: Type -> Type) (g :: Type -> Type) a.
(Foldable1 f, Applicative g, Ord a) =>
f (g a) -> g a
minCorner (Maybe (NonEmpty (g a)) -> Maybe (g a))
-> (f (g a) -> Maybe (NonEmpty (g a))) -> f (g a) -> Maybe (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [g a] -> Maybe (NonEmpty (g a))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([g a] -> Maybe (NonEmpty (g a)))
-> (f (g a) -> [g a]) -> f (g a) -> Maybe (NonEmpty (g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g a) -> [g a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList

-- | Shift corner to (0,0)
shiftToZero
    :: (Applicative f, Num a, Ord a)
    => NESet (f a) -> NESet (f a)
shiftToZero :: forall (f :: Type -> Type) a.
(Applicative f, Num a, Ord a) =>
NESet (f a) -> NESet (f a)
shiftToZero NESet (f a)
ps = (f a -> f a) -> NESet (f a) -> NESet (f a)
forall a b. (a -> b) -> NESet a -> NESet b
NES.mapMonotonic ((a -> a -> a) -> f a -> f a -> f a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
subtract f a
mn) NESet (f a)
ps
  where
    mn :: f a
mn = NESet (f a) -> f a
forall (f :: Type -> Type) (g :: Type -> Type) a.
(Foldable1 f, Applicative g, Ord a) =>
f (g a) -> g a
minCorner NESet (f a)
ps

-- | Shift corner to (0,0)
shiftToZero'
    :: (Applicative f, Num a, Ord a)
    => Set (f a) -> Set (f a)
shiftToZero' :: forall (f :: Type -> Type) a.
(Applicative f, Num a, Ord a) =>
Set (f a) -> Set (f a)
shiftToZero' Set (f a)
ps = case Set (f a) -> Maybe (f a)
forall (f :: Type -> Type) (g :: Type -> Type) a.
(Foldable f, Applicative g, Ord a) =>
f (g a) -> Maybe (g a)
minCorner' Set (f a)
ps of
    Maybe (f a)
Nothing -> Set (f a)
ps
    Just f a
mn -> (f a -> f a) -> Set (f a) -> Set (f a)
forall a b. (a -> b) -> Set a -> Set b
S.mapMonotonic ((a -> a -> a) -> f a -> f a -> f a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
subtract f a
mn) Set (f a)
ps


inBoundingBox
    :: (Applicative g, Foldable g, Ord a)
    => V2 (g a)
    -> g a
    -> Bool
inBoundingBox :: forall (g :: Type -> Type) a.
(Applicative g, Foldable g, Ord a) =>
V2 (g a) -> g a -> Bool
inBoundingBox (V2 g a
mn g a
mx) g a
x = g Bool -> Bool
forall (t :: Type -> Type). Foldable t => t Bool -> Bool
and (g Bool -> Bool) -> g Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Bool
forall {a}. Ord a => a -> a -> a -> Bool
go (a -> a -> a -> Bool) -> g a -> g (a -> a -> Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> g a
x g (a -> a -> Bool) -> g a -> g (a -> Bool)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> g a
mn g (a -> Bool) -> g a -> g Bool
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> g a
mx
  where
    go :: a -> a -> a -> Bool
go a
x' a
mn' a
mx' = a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
mn' Bool -> Bool -> Bool
&& a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
mx'


cardinalNeighbs :: Point -> [Point]
cardinalNeighbs :: Point -> [Point]
cardinalNeighbs Point
p = (Point
p Point -> Point -> Point
forall a. Num a => a -> a -> a
+) (Point -> Point) -> [Point] -> [Point]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Int -> Int -> Point
forall a. a -> a -> V2 a
V2 Int
0 (-Int
1), Int -> Int -> Point
forall a. a -> a -> V2 a
V2 Int
1 Int
0, Int -> Int -> Point
forall a. a -> a -> V2 a
V2 Int
0 Int
1, Int -> Int -> Point
forall a. a -> a -> V2 a
V2 (-Int
1) Int
0 ]

cardinalNeighbsSet :: Point -> Set Point
cardinalNeighbsSet :: Point -> Set Point
cardinalNeighbsSet Point
p = [Point] -> Set Point
forall a. [a] -> Set a
S.fromDistinctAscList ([Point] -> Set Point)
-> ([Point] -> [Point]) -> [Point] -> Set Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point -> Point) -> [Point] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point
p Point -> Point -> Point
forall a. Num a => a -> a -> a
+) ([Point] -> Set Point) -> [Point] -> Set Point
forall a b. (a -> b) -> a -> b
$
  [ Int -> Int -> Point
forall a. a -> a -> V2 a
V2 (-Int
1)   Int
0
  , Int -> Int -> Point
forall a. a -> a -> V2 a
V2   Int
0  (-Int
1)
  , Int -> Int -> Point
forall a. a -> a -> V2 a
V2   Int
0    Int
1
  , Int -> Int -> Point
forall a. a -> a -> V2 a
V2   Int
1    Int
0
  ]

fullNeighbs
    :: (Applicative f, Num a, Traversable f)
    => f a
    -> [f a]
fullNeighbs :: forall (f :: Type -> Type) a.
(Applicative f, Num a, Traversable f) =>
f a -> [f a]
fullNeighbs f a
p = [f a] -> [f a]
forall a. [a] -> [a]
tail
    [ (a -> a -> a) -> f a -> f a -> f a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+) f a
p f a
d
    | f a
d <- f [a] -> [f a]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([a] -> f [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [a
0,-a
1,a
1])
    ]
{-# INLINE fullNeighbs #-}

fullNeighbsSet
    :: (Applicative f, Num a, Ord (f a), Traversable f)
    => f a
    -> Set (f a)
fullNeighbsSet :: forall (f :: Type -> Type) a.
(Applicative f, Num a, Ord (f a), Traversable f) =>
f a -> Set (f a)
fullNeighbsSet f a
p = [f a] -> Set (f a)
forall a. [a] -> Set a
S.fromDistinctAscList ([f a] -> Set (f a)) -> [f a] -> Set (f a)
forall a b. (a -> b) -> a -> b
$
    [ (a -> a -> a) -> f a -> f a -> f a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+) f a
p f a
d
    | f a
d <- f [a] -> [f a]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([a] -> f [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [-a
1,a
0,a
1])
    , f a
d f a -> f a -> Bool
forall a. Eq a => a -> a -> Bool
/= a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
0
    ]

memoPoint :: Memo Point
memoPoint :: Memo Point
memoPoint = ((Int, Int) -> Point)
-> (Point -> (Int, Int)) -> Memo (Int, Int) -> Memo Point
forall a b. (a -> b) -> (b -> a) -> Memo a -> Memo b
Memo.wrap ((Int -> Int -> Point) -> (Int, Int) -> Point
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Point
forall a. a -> a -> V2 a
V2) (\(V2 Int
x Int
y) -> (Int
x, Int
y)) (Memo (Int, Int) -> (Point -> r) -> Point -> r)
-> Memo (Int, Int) -> (Point -> r) -> Point -> r
forall a b. (a -> b) -> a -> b
$
                Memo Int -> Memo Int -> Memo (Int, Int)
forall a b. Memo a -> Memo b -> Memo (a, b)
Memo.pair forall a. Integral a => Memo a
Memo Int
Memo.integral forall a. Integral a => Memo a
Memo Int
Memo.integral

mannDist :: (Foldable f, Num a, Num (f a)) => f a -> f a -> a
mannDist :: forall (f :: Type -> Type) a.
(Foldable f, Num a, Num (f a)) =>
f a -> f a -> a
mannDist f a
x f a
y = f a -> a
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum (f a -> a) -> (f a -> f a) -> f a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> f a
forall a. Num a => a -> a
abs (f a -> a) -> f a -> a
forall a b. (a -> b) -> a -> b
$ f a
x f a -> f a -> f a
forall a. Num a => a -> a -> a
- f a
y

-- | Treat as complex number multiplication. useful for rotations
mulPoint :: Num a => V2 a -> V2 a -> V2 a
mulPoint :: forall a. Num a => V2 a -> V2 a -> V2 a
mulPoint (V2 a
x a
y) (V2 a
u a
v) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
u a -> a -> a
forall a. Num a => a -> a -> a
- a
ya -> a -> a
forall a. Num a => a -> a -> a
*a
v) (a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
v a -> a -> a
forall a. Num a => a -> a -> a
+ a
ya -> a -> a
forall a. Num a => a -> a -> a
*a
u)

data Dir = North | East | South | West
  deriving (Int -> Dir -> ShowS
[Dir] -> ShowS
Dir -> String
(Int -> Dir -> ShowS)
-> (Dir -> String) -> ([Dir] -> ShowS) -> Show Dir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dir] -> ShowS
$cshowList :: [Dir] -> ShowS
show :: Dir -> String
$cshow :: Dir -> String
showsPrec :: Int -> Dir -> ShowS
$cshowsPrec :: Int -> Dir -> ShowS
Show, Dir -> Dir -> Bool
(Dir -> Dir -> Bool) -> (Dir -> Dir -> Bool) -> Eq Dir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dir -> Dir -> Bool
$c/= :: Dir -> Dir -> Bool
== :: Dir -> Dir -> Bool
$c== :: Dir -> Dir -> Bool
Eq, Eq Dir
Eq Dir
-> (Dir -> Dir -> Ordering)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Dir)
-> (Dir -> Dir -> Dir)
-> Ord Dir
Dir -> Dir -> Bool
Dir -> Dir -> Ordering
Dir -> Dir -> Dir
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dir -> Dir -> Dir
$cmin :: Dir -> Dir -> Dir
max :: Dir -> Dir -> Dir
$cmax :: Dir -> Dir -> Dir
>= :: Dir -> Dir -> Bool
$c>= :: Dir -> Dir -> Bool
> :: Dir -> Dir -> Bool
$c> :: Dir -> Dir -> Bool
<= :: Dir -> Dir -> Bool
$c<= :: Dir -> Dir -> Bool
< :: Dir -> Dir -> Bool
$c< :: Dir -> Dir -> Bool
compare :: Dir -> Dir -> Ordering
$ccompare :: Dir -> Dir -> Ordering
Ord, (forall x. Dir -> Rep Dir x)
-> (forall x. Rep Dir x -> Dir) -> Generic Dir
forall x. Rep Dir x -> Dir
forall x. Dir -> Rep Dir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dir x -> Dir
$cfrom :: forall x. Dir -> Rep Dir x
Generic, Int -> Dir
Dir -> Int
Dir -> [Dir]
Dir -> Dir
Dir -> Dir -> [Dir]
Dir -> Dir -> Dir -> [Dir]
(Dir -> Dir)
-> (Dir -> Dir)
-> (Int -> Dir)
-> (Dir -> Int)
-> (Dir -> [Dir])
-> (Dir -> Dir -> [Dir])
-> (Dir -> Dir -> [Dir])
-> (Dir -> Dir -> Dir -> [Dir])
-> Enum Dir
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Dir -> Dir -> Dir -> [Dir]
$cenumFromThenTo :: Dir -> Dir -> Dir -> [Dir]
enumFromTo :: Dir -> Dir -> [Dir]
$cenumFromTo :: Dir -> Dir -> [Dir]
enumFromThen :: Dir -> Dir -> [Dir]
$cenumFromThen :: Dir -> Dir -> [Dir]
enumFrom :: Dir -> [Dir]
$cenumFrom :: Dir -> [Dir]
fromEnum :: Dir -> Int
$cfromEnum :: Dir -> Int
toEnum :: Int -> Dir
$ctoEnum :: Int -> Dir
pred :: Dir -> Dir
$cpred :: Dir -> Dir
succ :: Dir -> Dir
$csucc :: Dir -> Dir
Enum)

instance Hashable Dir
instance NFData Dir
instance Finitary Dir

dirPoint :: Num a => Dir -> V2 a
dirPoint :: forall a. Num a => Dir -> V2 a
dirPoint = \case
    Dir
North -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2   a
0   a
1
    Dir
East  -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2   a
1   a
0
    Dir
South -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2   a
0 (-a
1)
    Dir
West  -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (-a
1)  a
0

-- | 'dirPoint' but with inverted y axis
dirPoint' :: Num a => Dir -> V2 a
dirPoint' :: forall a. Num a => Dir -> V2 a
dirPoint' = \case
    Dir
North -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2   a
0 (-a
1)
    Dir
East  -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2   a
1   a
0
    Dir
South -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2   a
0   a
1
    Dir
West  -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (-a
1)  a
0

-- | Rotate a point by a direction
rotPoint :: Num a => Dir -> V2 a -> V2 a
rotPoint :: forall a. Num a => Dir -> V2 a -> V2 a
rotPoint = \case
    Dir
North -> V2 a -> V2 a
forall a. a -> a
id
    Dir
East  -> \(V2 a
x a
y) -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2   a
y  (-a
x)
    Dir
West  -> \(V2 a
x a
y) -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (-a
y)   a
x
    Dir
South -> V2 a -> V2 a
forall a. Num a => a -> a
negate

-- | Rotate a point by a direction
rotFin :: KnownNat n => Dir -> FinPoint n -> FinPoint n
rotFin :: forall (n :: Nat). KnownNat n => Dir -> FinPoint n -> FinPoint n
rotFin Dir
d = ASetter (FinPoint n) (FinPoint n) (V2 Rational) (V2 Rational)
-> (V2 Rational -> V2 Rational) -> FinPoint n -> FinPoint n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (AnIso (Finite n) (Finite n) Rational Rational
-> Iso (FinPoint n) (FinPoint n) (V2 Rational) (V2 Rational)
forall (f :: Type -> Type) (g :: Type -> Type) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso (Finite n) (Finite n) Rational Rational
forall (n :: Nat). KnownNat n => Iso' (Finite n) Rational
centeredFinite) (Dir -> V2 Rational -> V2 Rational
forall a. Num a => Dir -> V2 a -> V2 a
rotPoint Dir
d)

centeredFinite :: forall n. KnownNat n => Iso' (Finite n) Rational
centeredFinite :: forall (n :: Nat). KnownNat n => Iso' (Finite n) Rational
centeredFinite = (Finite n -> Rational)
-> (Rational -> Finite n)
-> Iso (Finite n) (Finite n) Rational Rational
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
subtract Rational
d (Rational -> Rational)
-> (Finite n -> Rational) -> Finite n -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1) (Integer -> Rational)
-> (Finite n -> Integer) -> Finite n -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite n -> Integer
forall (n :: Nat). Finite n -> Integer
getFinite)
                     (Integer -> Finite n
forall (n :: Nat). Integer -> Finite n
Finite (Integer -> Finite n)
-> (Rational -> Integer) -> Rational -> Finite n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Integer
forall a. Ratio a -> a
numerator (Rational -> Integer)
-> (Rational -> Rational) -> Rational -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
d))
-- Finite . numerator . (+ d) <$> f ((getFinite i % 1) - d)
  where
    d :: Rational
d = Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Natural
natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2

parseDir :: Char -> Maybe Dir
parseDir :: Char -> Maybe Dir
parseDir = (Char -> Map Char Dir -> Maybe Dir)
-> Map Char Dir -> Char -> Maybe Dir
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Map Char Dir -> Maybe Dir
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Char Dir
dirMap (Char -> Maybe Dir) -> (Char -> Char) -> Char -> Maybe Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper
  where
    dirMap :: Map Char Dir
dirMap = [(Char, Dir)] -> Map Char Dir
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
        (Char
'N', Dir
North) , (Char
'E', Dir
East) , (Char
'S', Dir
South) , (Char
'W', Dir
West)
      , (Char
'U', Dir
North) , (Char
'R', Dir
East) , (Char
'D', Dir
South) , (Char
'L', Dir
West)
      ]

-- | Multiply headings, taking North as straight, East as clockwise turn,
-- West as counter-clockwise turn, and South as reverse.
--
-- Should be a commutative group; it's essentially complex number
-- multiplication like 'mulPoint', with North = 1, West = i.  The identity
-- is 'North' and the inverse is the opposite direction.
mulDir :: Dir -> Dir -> Dir
mulDir :: Dir -> Dir -> Dir
mulDir Dir
North = Dir -> Dir
forall a. a -> a
id
mulDir Dir
East  = \case Dir
North -> Dir
East
                     Dir
East  -> Dir
South
                     Dir
South -> Dir
West
                     Dir
West  -> Dir
North
mulDir Dir
South = \case Dir
North -> Dir
South
                     Dir
East  -> Dir
West
                     Dir
South -> Dir
North
                     Dir
West  -> Dir
East
mulDir Dir
West  = \case Dir
North -> Dir
West
                     Dir
East  -> Dir
North
                     Dir
South -> Dir
East
                     Dir
West  -> Dir
South

allDir :: NonEmpty Dir
allDir :: NonEmpty Dir
allDir = Dir
North Dir -> [Dir] -> NonEmpty Dir
forall a. a -> [a] -> NonEmpty a
:| [ Dir
East .. ]

allDirSet :: NESet Dir
allDirSet :: NESet Dir
allDirSet = NonEmpty Dir -> NESet Dir
forall a. NonEmpty a -> NESet a
NES.fromDistinctAscList NonEmpty Dir
allDir

-- | '<>' is 'mulDir'.
instance Semigroup Dir where
    <> :: Dir -> Dir -> Dir
(<>) = Dir -> Dir -> Dir
mulDir
    stimes :: forall b. Integral b => b -> Dir -> Dir
stimes b
n Dir
x = case b
n b -> b -> b
forall a. Integral a => a -> a -> a
`mod` b
4 of
      b
1 -> Dir
x
      b
2 -> Dir
x Dir -> Dir -> Dir
forall a. Semigroup a => a -> a -> a
<> Dir
x
      b
3 -> Dir -> Dir
forall m. Group m => m -> m
invert Dir
x
      b
_ -> Dir
North

instance Monoid Dir where
    mempty :: Dir
mempty = Dir
North

instance Group Dir where
    invert :: Dir -> Dir
invert = \case Dir
North -> Dir
North
                   Dir
East  -> Dir
West
                   Dir
South -> Dir
South
                   Dir
West  -> Dir
East
    pow :: forall x. Integral x => Dir -> x -> Dir
pow = (x -> Dir -> Dir) -> Dir -> x -> Dir
forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> Dir -> Dir
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes

instance Abelian Dir

-- | Represents an orientation of a 2d tile.
data D8 = D8 { D8 -> Dir
d8Rot :: !Dir, D8 -> Bool
d8Flip :: !Bool }
  deriving (Int -> D8 -> ShowS
[D8] -> ShowS
D8 -> String
(Int -> D8 -> ShowS)
-> (D8 -> String) -> ([D8] -> ShowS) -> Show D8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [D8] -> ShowS
$cshowList :: [D8] -> ShowS
show :: D8 -> String
$cshow :: D8 -> String
showsPrec :: Int -> D8 -> ShowS
$cshowsPrec :: Int -> D8 -> ShowS
Show, D8 -> D8 -> Bool
(D8 -> D8 -> Bool) -> (D8 -> D8 -> Bool) -> Eq D8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: D8 -> D8 -> Bool
$c/= :: D8 -> D8 -> Bool
== :: D8 -> D8 -> Bool
$c== :: D8 -> D8 -> Bool
Eq, Eq D8
Eq D8
-> (D8 -> D8 -> Ordering)
-> (D8 -> D8 -> Bool)
-> (D8 -> D8 -> Bool)
-> (D8 -> D8 -> Bool)
-> (D8 -> D8 -> Bool)
-> (D8 -> D8 -> D8)
-> (D8 -> D8 -> D8)
-> Ord D8
D8 -> D8 -> Bool
D8 -> D8 -> Ordering
D8 -> D8 -> D8
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: D8 -> D8 -> D8
$cmin :: D8 -> D8 -> D8
max :: D8 -> D8 -> D8
$cmax :: D8 -> D8 -> D8
>= :: D8 -> D8 -> Bool
$c>= :: D8 -> D8 -> Bool
> :: D8 -> D8 -> Bool
$c> :: D8 -> D8 -> Bool
<= :: D8 -> D8 -> Bool
$c<= :: D8 -> D8 -> Bool
< :: D8 -> D8 -> Bool
$c< :: D8 -> D8 -> Bool
compare :: D8 -> D8 -> Ordering
$ccompare :: D8 -> D8 -> Ordering
Ord, (forall x. D8 -> Rep D8 x)
-> (forall x. Rep D8 x -> D8) -> Generic D8
forall x. Rep D8 x -> D8
forall x. D8 -> Rep D8 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep D8 x -> D8
$cfrom :: forall x. D8 -> Rep D8 x
Generic)

instance Hashable D8
instance NFData D8
instance Finitary D8

-- | '<>' is 'mulDir'.
instance Semigroup D8 where
    D8 Dir
x1 Bool
False <> :: D8 -> D8 -> D8
<> D8 Dir
x2 Bool
y2 = Dir -> Bool -> D8
D8 (Dir
x1 Dir -> Dir -> Dir
forall a. Semigroup a => a -> a -> a
<> Dir
x2) Bool
y2
    D8 Dir
x1 Bool
True  <> D8 Dir
x2 Bool
y2 = Dir -> Bool -> D8
D8 (Dir
x1 Dir -> Dir -> Dir
forall a. Semigroup a => a -> a -> a
<> Dir -> Dir
forall m. Group m => m -> m
invert Dir
x2) (Bool -> Bool
not Bool
y2)

instance Monoid D8 where
    mempty :: D8
mempty = Dir -> Bool -> D8
D8 Dir
North Bool
False

instance Group D8 where
    invert :: D8 -> D8
invert (D8 Dir
x Bool
False) = Dir -> Bool -> D8
D8 (Dir -> Dir
forall m. Group m => m -> m
invert Dir
x) Bool
False
    invert (D8 Dir
x Bool
True ) = Dir -> Bool -> D8
D8 Dir
x          Bool
True

-- | @a `mulD8` b@ represents applying b, then a.
mulD8 :: D8 -> D8 -> D8
mulD8 :: D8 -> D8 -> D8
mulD8 = D8 -> D8 -> D8
forall a. Semigroup a => a -> a -> a
(<>)

allD8 :: NonEmpty D8
allD8 :: NonEmpty D8
allD8 = Dir -> Bool -> D8
D8 (Dir -> Bool -> D8) -> NonEmpty Dir -> NonEmpty (Bool -> D8)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Dir
allDir NonEmpty (Bool -> D8) -> NonEmpty Bool -> NonEmpty D8
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Bool
False Bool -> [Bool] -> NonEmpty Bool
forall a. a -> [a] -> NonEmpty a
:| [ Bool
True ])

allD8Set :: NESet D8
allD8Set :: NESet D8
allD8Set = NonEmpty D8 -> NESet D8
forall a. NonEmpty a -> NESet a
NES.fromDistinctAscList NonEmpty D8
allD8

-- | Rotate and flip a point by a 'D8'
orientPoint :: Num a => D8 -> V2 a -> V2 a
orientPoint :: forall a. Num a => D8 -> V2 a -> V2 a
orientPoint = \case
    D8 Dir
North Bool
False -> V2 a -> V2 a
forall a. a -> a
id
    D8 Dir
East  Bool
False -> \(V2 a
x a
y) -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2   a
y  (-a
x)
    D8 Dir
West  Bool
False -> \(V2 a
x a
y) -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (-a
y)   a
x
    D8 Dir
South Bool
False -> \(V2 a
x a
y) -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (-a
x) (-a
y)
    D8 Dir
North Bool
True  -> \(V2 a
x a
y) -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (-a
x)   a
y
    D8 Dir
East  Bool
True  -> \(V2 a
x a
y) -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2   a
y    a
x
    D8 Dir
West  Bool
True  -> \(V2 a
x a
y) -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (-a
y) (-a
x)
    D8 Dir
South Bool
True  -> \(V2 a
x a
y) -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2   a
x  (-a
y)

orientFin :: KnownNat n => D8 -> FinPoint n -> FinPoint n
orientFin :: forall (n :: Nat). KnownNat n => D8 -> FinPoint n -> FinPoint n
orientFin D8
d = ASetter (FinPoint n) (FinPoint n) (V2 Rational) (V2 Rational)
-> (V2 Rational -> V2 Rational) -> FinPoint n -> FinPoint n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (AnIso (Finite n) (Finite n) Rational Rational
-> Iso (FinPoint n) (FinPoint n) (V2 Rational) (V2 Rational)
forall (f :: Type -> Type) (g :: Type -> Type) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso (Finite n) (Finite n) Rational Rational
forall (n :: Nat). KnownNat n => Iso' (Finite n) Rational
centeredFinite) (D8 -> V2 Rational -> V2 Rational
forall a. Num a => D8 -> V2 a -> V2 a
orientPoint D8
d)

-- | It's 'Point', but with a newtype wrapper so we have an 'Ord' that
-- sorts by y first, then x
newtype ScanPoint = SP { ScanPoint -> Point
_getSP :: Point }
  deriving (ScanPoint -> ScanPoint -> Bool
(ScanPoint -> ScanPoint -> Bool)
-> (ScanPoint -> ScanPoint -> Bool) -> Eq ScanPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScanPoint -> ScanPoint -> Bool
$c/= :: ScanPoint -> ScanPoint -> Bool
== :: ScanPoint -> ScanPoint -> Bool
$c== :: ScanPoint -> ScanPoint -> Bool
Eq, Int -> ScanPoint -> ShowS
[ScanPoint] -> ShowS
ScanPoint -> String
(Int -> ScanPoint -> ShowS)
-> (ScanPoint -> String)
-> ([ScanPoint] -> ShowS)
-> Show ScanPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScanPoint] -> ShowS
$cshowList :: [ScanPoint] -> ShowS
show :: ScanPoint -> String
$cshow :: ScanPoint -> String
showsPrec :: Int -> ScanPoint -> ShowS
$cshowsPrec :: Int -> ScanPoint -> ShowS
Show, (forall x. ScanPoint -> Rep ScanPoint x)
-> (forall x. Rep ScanPoint x -> ScanPoint) -> Generic ScanPoint
forall x. Rep ScanPoint x -> ScanPoint
forall x. ScanPoint -> Rep ScanPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScanPoint x -> ScanPoint
$cfrom :: forall x. ScanPoint -> Rep ScanPoint x
Generic)
  deriving newtype Integer -> ScanPoint
ScanPoint -> ScanPoint
ScanPoint -> ScanPoint -> ScanPoint
(ScanPoint -> ScanPoint -> ScanPoint)
-> (ScanPoint -> ScanPoint -> ScanPoint)
-> (ScanPoint -> ScanPoint -> ScanPoint)
-> (ScanPoint -> ScanPoint)
-> (ScanPoint -> ScanPoint)
-> (ScanPoint -> ScanPoint)
-> (Integer -> ScanPoint)
-> Num ScanPoint
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ScanPoint
$cfromInteger :: Integer -> ScanPoint
signum :: ScanPoint -> ScanPoint
$csignum :: ScanPoint -> ScanPoint
abs :: ScanPoint -> ScanPoint
$cabs :: ScanPoint -> ScanPoint
negate :: ScanPoint -> ScanPoint
$cnegate :: ScanPoint -> ScanPoint
* :: ScanPoint -> ScanPoint -> ScanPoint
$c* :: ScanPoint -> ScanPoint -> ScanPoint
- :: ScanPoint -> ScanPoint -> ScanPoint
$c- :: ScanPoint -> ScanPoint -> ScanPoint
+ :: ScanPoint -> ScanPoint -> ScanPoint
$c+ :: ScanPoint -> ScanPoint -> ScanPoint
Num

instance Hashable ScanPoint
instance NFData ScanPoint

instance Ord ScanPoint where
    compare :: ScanPoint -> ScanPoint -> Ordering
compare = (ScanPoint -> Int) -> ScanPoint -> ScanPoint -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Getting Int Point Int -> Point -> Int
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting Int Point Int
forall (t :: Type -> Type) a. R2 t => Lens' (t a) a
_y (Point -> Int) -> (ScanPoint -> Point) -> ScanPoint -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScanPoint -> Point
_getSP)
           (ScanPoint -> ScanPoint -> Ordering)
-> (ScanPoint -> ScanPoint -> Ordering)
-> ScanPoint
-> ScanPoint
-> Ordering
forall a. Semigroup a => a -> a -> a
<> (ScanPoint -> Int) -> ScanPoint -> ScanPoint -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Getting Int Point Int -> Point -> Int
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting Int Point Int
forall (t :: Type -> Type) a. R1 t => Lens' (t a) a
_x (Point -> Int) -> (ScanPoint -> Point) -> ScanPoint -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScanPoint -> Point
_getSP)

parseAsciiMap
    :: (Char -> Maybe a)
    -> String
    -> Map Point a
parseAsciiMap :: forall a. (Char -> Maybe a) -> String -> Map Point a
parseAsciiMap Char -> Maybe a
f = IndexedGetting Point (Map Point a) String a
-> String -> Map Point a
forall i a s. IndexedGetting i (Map i a) s a -> s -> Map i a
toMapOf (Indexed Point Char (Const (Map Point a) Char)
-> String -> Const (Map Point a) String
forall a. IndexedTraversal Point String [a] Char a
asciiGrid (Indexed Point Char (Const (Map Point a) Char)
 -> String -> Const (Map Point a) String)
-> ((a -> Const (Map Point a) a)
    -> Char -> Const (Map Point a) Char)
-> IndexedGetting Point (Map Point a) String a
forall i (p :: Type -> Type -> Type) s t r a b.
Indexable i p =>
(Indexed i s t -> r) -> ((a -> b) -> s -> t) -> p a b -> r
<. (Char -> Maybe a) -> Fold Char a
forall (f :: Type -> Type) s a.
Foldable f =>
(s -> f a) -> Fold s a
folding Char -> Maybe a
f)

parseAsciiSet
    :: (Char -> Bool)
    -> String
    -> Set Point
parseAsciiSet :: (Char -> Bool) -> String -> Set Point
parseAsciiSet Char -> Bool
f = Getting (Set Point) String Point -> String -> Set Point
forall a s. Getting (Set a) s a -> s -> Set a
setOf (Indexed Point Char (Const (Set Point) Char)
-> String -> Const (Set Point) String
forall a. IndexedTraversal Point String [a] Char a
asciiGrid (Indexed Point Char (Const (Set Point) Char)
 -> String -> Const (Set Point) String)
-> ((Point -> Const (Set Point) Point)
    -> Indexed Point Char (Const (Set Point) Char))
-> Getting (Set Point) String Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool)
-> Optic' (Indexed Point) (Const (Set Point)) Char Char
forall (p :: Type -> Type -> Type) (f :: Type -> Type) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered Char -> Bool
f Optic' (Indexed Point) (Const (Set Point)) Char Char
-> ((Point -> Const (Set Point) Point)
    -> Indexed Point Char (Const (Set Point) Char))
-> (Point -> Const (Set Point) Point)
-> Indexed Point Char (Const (Set Point) Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point -> Const (Set Point) Point)
-> Indexed Point Char (Const (Set Point) Char)
forall i (p :: Type -> Type -> Type) (f :: Type -> Type) s.
(Indexable i p, Contravariant f, Functor f) =>
p i (f i) -> Indexed i s (f s)
asIndex)

asciiGrid :: IndexedTraversal Point String [a] Char a
asciiGrid :: forall a. IndexedTraversal Point String [a] Char a
asciiGrid = ((p ~ (->)) => (Char -> f a) -> String -> f [a])
-> (p Char (f a) -> String -> f [a])
-> p Char (f a)
-> String
-> f [a]
forall (p :: Type -> Type -> Type) (q :: Type -> Type -> Type) a b
       r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined (p ~ (->)) => (Char -> f a) -> String -> f [a]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((p Char (f a) -> String -> f [a])
 -> p Char (f a) -> String -> f [a])
-> (p Char (f a) -> String -> f [a])
-> p Char (f a)
-> String
-> f [a]
forall a b. (a -> b) -> a -> b
$ \p Char (f a)
pcfa ->
      [f a] -> f [a]
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
    ([f a] -> f [a]) -> (String -> [f a]) -> String -> f [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[f a]] -> [f a]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat
    ([[f a]] -> [f a]) -> (String -> [[f a]]) -> String -> [f a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String -> [f a]) -> [Int] -> [String] -> [[f a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
y -> (Int -> Char -> f a) -> [Int] -> String -> [f a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
x -> p Char (f a) -> Point -> Char -> f a
forall i (p :: Type -> Type -> Type) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p Char (f a)
pcfa (Int -> Int -> Point
forall a. a -> a -> V2 a
V2 Int
x Int
y :: Point)) [Int
0..]) [Int
0..]
    ([String] -> [[f a]]) -> (String -> [String]) -> String -> [[f a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

displayAsciiMap
    :: Char             -- ^ default tile
    -> Map Point Char   -- ^ tile map
    -> String
displayAsciiMap :: Char -> Map Point Char -> String
displayAsciiMap Char
d (NEM.IsNonEmpty NEMap Point Char
mp) = [String] -> String
unlines
    [ [ Char -> Point -> NEMap Point Char -> Char
forall k a. Ord k => a -> k -> NEMap k a -> a
NEM.findWithDefault Char
d (Int -> Int -> Point
forall a. a -> a -> V2 a
V2 Int
x Int
y) NEMap Point Char
mp
      | Int
x <- [Int
xMin .. Int
xMax]
      ]
    | Int
y <- [Int
yMin .. Int
yMax]
    ]
  where
    V2 Int
xMin Int
yMin `V2` V2 Int
xMax Int
yMax = NESet Point -> V2 Point
forall (f :: Type -> Type) (g :: Type -> Type) a.
(Foldable1 f, Applicative g, Ord a) =>
f (g a) -> V2 (g a)
boundingBox (NESet Point -> V2 Point) -> NESet Point -> V2 Point
forall a b. (a -> b) -> a -> b
$ NEMap Point Char -> NESet Point
forall k a. NEMap k a -> NESet k
NEM.keysSet NEMap Point Char
mp
displayAsciiMap Char
_ Map Point Char
_ = String
""

displayAsciiSet
    :: Char      -- ^ missing tile
    -> Char      -- ^ present tile
    -> Set Point -- ^ tile set
    -> String
displayAsciiSet :: Char -> Char -> Set Point -> String
displayAsciiSet Char
x Char
y = Char -> Map Point Char -> String
displayAsciiMap Char
x (Map Point Char -> String)
-> (Set Point -> Map Point Char) -> Set Point -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point -> Char) -> Set Point -> Map Point Char
forall k a. (k -> a) -> Set k -> Map k a
M.fromSet (Char -> Point -> Char
forall a b. a -> b -> a
const Char
y)

-- | Lattice points for line between points, not including endpoints
lineTo :: Point -> Point -> [Point]
lineTo :: Point -> Point -> [Point]
lineTo Point
p0 Point
p1 = [ Point
p0 Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Int
t Int -> Point -> Point
forall (f :: Type -> Type) a. (Functor f, Num a) => a -> f a -> f a
*^ Point
step | Int
t <- [Int
1 .. Int
gcf  Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]
  where
    d :: Point
d@(V2 Int
dx Int
dy) = Point
p1 Point -> Point -> Point
forall a. Num a => a -> a -> a
- Point
p0
    gcf :: Int
gcf          = Int -> Int -> Int
forall a. Integral a => a -> a -> a
gcd Int
dx Int
dy
    step :: Point
step         = (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
gcf) (Int -> Int) -> Point -> Point
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Point
d

instance (Finitary a, KnownNat (Cardinality a), KnownNat (Cardinality a * Cardinality a)) => Finitary (V2 a)
instance (Finitary a, KnownNat (Cardinality a), KnownNat (Cardinality a * (Cardinality a * Cardinality a))) => Finitary (V3 a)
instance (Finitary a, KnownNat (Cardinality a), KnownNat ((Cardinality a * Cardinality a) * (Cardinality a * Cardinality a))) => Finitary (V4 a)