-- |
-- Module      : AOC.Challenge.Day12
-- License     : BSD3
--
-- Stability   : experimental
-- Portability : non-portable
--
-- Day 12.  See "AOC.Solver" for the types used in this module!

module AOC.Challenge.Day12 (
    day12a
  , day12b
  ) where

import           AOC.Common.Point (Point, Dir(..), dirPoint, rotPoint, mannDist)
import           AOC.Solver       ((:~>)(..))
import           Control.DeepSeq  (NFData)
import           Data.Group       (pow)
import           Data.List        (foldl')
import           Data.Map         (Map)
import           GHC.Generics     (Generic)
import           Linear           (V2(..), (*^))
import           Text.Read        (readMaybe)
import qualified Data.Map         as M

data Instr = Forward Int
           | Turn Dir
           | Move Point
  deriving (Int -> Instr -> ShowS
[Instr] -> ShowS
Instr -> String
(Int -> Instr -> ShowS)
-> (Instr -> String) -> ([Instr] -> ShowS) -> Show Instr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instr] -> ShowS
$cshowList :: [Instr] -> ShowS
show :: Instr -> String
$cshow :: Instr -> String
showsPrec :: Int -> Instr -> ShowS
$cshowsPrec :: Int -> Instr -> ShowS
Show, Instr -> Instr -> Bool
(Instr -> Instr -> Bool) -> (Instr -> Instr -> Bool) -> Eq Instr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instr -> Instr -> Bool
$c/= :: Instr -> Instr -> Bool
== :: Instr -> Instr -> Bool
$c== :: Instr -> Instr -> Bool
Eq, (forall x. Instr -> Rep Instr x)
-> (forall x. Rep Instr x -> Instr) -> Generic Instr
forall x. Rep Instr x -> Instr
forall x. Instr -> Rep Instr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Instr x -> Instr
$cfrom :: forall x. Instr -> Rep Instr x
Generic)
instance NFData Instr

mkInstr :: Map Char (Int -> Instr)
mkInstr :: Map Char (Int -> Instr)
mkInstr = [(Char, Int -> Instr)] -> Map Char (Int -> Instr)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (Char
'F', Int -> Instr
Forward)
    , (Char
'L', Dir -> Instr
Turn (Dir -> Instr) -> (Int -> Dir) -> Int -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir -> Int -> Dir
forall m x. (Group m, Integral x) => m -> x -> m
pow Dir
West (Int -> Dir) -> (Int -> Int) -> Int -> Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
90))
    , (Char
'R', Dir -> Instr
Turn (Dir -> Instr) -> (Int -> Dir) -> Int -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir -> Int -> Dir
forall m x. (Group m, Integral x) => m -> x -> m
pow Dir
East (Int -> Dir) -> (Int -> Int) -> Int -> Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
90))
    , (Char
'N', Point -> Instr
Move (Point -> Instr) -> (Int -> Point) -> Int -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Point -> Point
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Dir -> Point
forall a. Num a => Dir -> V2 a
dirPoint Dir
North))
    , (Char
'S', Point -> Instr
Move (Point -> Instr) -> (Int -> Point) -> Int -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Point -> Point
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Dir -> Point
forall a. Num a => Dir -> V2 a
dirPoint Dir
South))
    , (Char
'E', Point -> Instr
Move (Point -> Instr) -> (Int -> Point) -> Int -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Point -> Point
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Dir -> Point
forall a. Num a => Dir -> V2 a
dirPoint Dir
East ))
    , (Char
'W', Point -> Instr
Move (Point -> Instr) -> (Int -> Point) -> Int -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Point -> Point
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Dir -> Point
forall a. Num a => Dir -> V2 a
dirPoint Dir
West ))
    ]

parseInstr :: String -> Maybe Instr
parseInstr :: String -> Maybe Instr
parseInstr []    = Maybe Instr
forall a. Maybe a
Nothing
parseInstr (Char
c:String
n) = Char -> Map Char (Int -> Instr) -> Maybe (Int -> Instr)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Char
c Map Char (Int -> Instr)
mkInstr Maybe (Int -> Instr) -> Maybe Int -> Maybe Instr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
n

day12a :: [Instr] :~> Point
day12a :: [Instr] :~> Point
day12a = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
    { sParse :: String -> Maybe [Instr]
sParse = (String -> Maybe Instr) -> [String] -> Maybe [Instr]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Maybe Instr
parseInstr ([String] -> Maybe [Instr])
-> (String -> [String]) -> String -> Maybe [Instr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    , sShow :: Point -> String
sShow  = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Point -> Int) -> Point -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point -> Int
forall (f :: * -> *) a.
(Foldable f, Num a, Num (f a)) =>
f a -> f a -> a
mannDist Point
0
    , sSolve :: (?dyno::DynoMap) => [Instr] -> Maybe Point
sSolve = Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point)
-> ([Instr] -> Point) -> [Instr] -> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dir, Point) -> Point
forall a b. (a, b) -> b
snd ((Dir, Point) -> Point)
-> ([Instr] -> (Dir, Point)) -> [Instr] -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Dir, Point) -> Instr -> (Dir, Point))
-> (Dir, Point) -> [Instr] -> (Dir, Point)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Dir, Point) -> Instr -> (Dir, Point)
go (Dir
East, Point
0)
    }
  where
    go :: (Dir, Point) -> Instr -> (Dir, Point)
    go :: (Dir, Point) -> Instr -> (Dir, Point)
go (!Dir
dir, !Point
p) = \case
      Forward Int
n -> (Dir
dir     , Point
p Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Int
n Int -> Point -> Point
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Dir -> Point
forall a. Num a => Dir -> V2 a
dirPoint Dir
dir)
      Turn Dir
d    -> (Dir
dir Dir -> Dir -> Dir
forall a. Semigroup a => a -> a -> a
<> Dir
d, Point
p                    )
      Move Point
r    -> (Dir
dir     , Point
p Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Point
r                )

day12b :: [Instr] :~> Point
day12b :: [Instr] :~> Point
day12b = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
    { sParse :: String -> Maybe [Instr]
sParse = ([Instr] :~> Point) -> String -> Maybe [Instr]
forall a b. (a :~> b) -> String -> Maybe a
sParse [Instr] :~> Point
day12a
    , sShow :: Point -> String
sShow  = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Point -> Int) -> Point -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point -> Int
forall (f :: * -> *) a.
(Foldable f, Num a, Num (f a)) =>
f a -> f a -> a
mannDist Point
0
    , sSolve :: (?dyno::DynoMap) => [Instr] -> Maybe Point
sSolve = Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point)
-> ([Instr] -> Point) -> [Instr] -> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point, Point) -> Point
forall a b. (a, b) -> a
fst ((Point, Point) -> Point)
-> ([Instr] -> (Point, Point)) -> [Instr] -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Point, Point) -> Instr -> (Point, Point))
-> (Point, Point) -> [Instr] -> (Point, Point)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Point, Point) -> Instr -> (Point, Point)
go (Point
0, Int -> Int -> Point
forall a. a -> a -> V2 a
V2 Int
10 Int
1)
    }
  where
    go :: (Point, Point) -> Instr -> (Point, Point)
    go :: (Point, Point) -> Instr -> (Point, Point)
go (!Point
shp, !Point
wp) = \case
      Forward Int
n -> (Point
shp Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Int
n Int -> Point -> Point
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Point
wp, Point
wp           )
      Turn Dir
d    -> (Point
shp          , Dir -> Point -> Point
forall a. Num a => Dir -> V2 a -> V2 a
rotPoint Dir
d Point
wp)
      Move Point
r    -> (Point
shp          , Point
wp Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Point
r       )