1 {-# LANGUAGE OverloadedStrings #-}
3 import Data.List (foldl') -- import the strict fold
5 import qualified Data.Map.Strict as M
7 import Data.Text (Text)
8 import qualified Data.Text as T
9 import qualified Data.Text.IO as TIO
11 import Data.Void (Void)
13 import Text.Megaparsec -- hiding (State)
14 import Text.Megaparsec.Char
15 import qualified Text.Megaparsec.Char.Lexer as L
16 import qualified Control.Applicative as CA
23 type Position = (Int, Int)
25 -- the directions. See below for functions for turning
26 data Direction = North | East | South | West
27 deriving (Enum, Show, Bounded, Eq)
29 type Grass = M.Map Position Bool
32 -- The currenct state of a World
33 data World = World { direction :: Direction
34 , position :: Position
39 -- one instruction for the World
40 data Instruction = Forward Distance
50 instruction_text <- TIO.readFile "data/03-graffiti.txt"
51 let instructions = successfulParse instruction_text
52 let mownWorld = foldl' execute initialWorld instructions
53 print $ part1 mownWorld
54 TIO.putStr $ part2 mownWorld
58 part1 = M.size . grass
62 initialWorld = World { direction = North
70 execute :: World -> Instruction -> World
71 execute w (Forward s) = iterate forward w !! s
72 execute w Clockwise = w {direction = turnCW (direction w)}
73 execute w Anticlockwise = w {direction = turnACW (direction w)}
74 execute w Up = w {pen = False}
75 execute w Down = mow $ w {pen = True}
79 mow w | pen w = w {grass = M.insert (position w) True (grass w)}
83 forward :: World -> World
84 forward w = mow $ w {position = newPosition (direction w) (position w)}
86 -- Move in the current direction
87 newPosition :: Direction -> Position -> Position
88 newPosition North (e, n) = (e, n+1)
89 newPosition South (e, n) = (e, n-1)
90 newPosition West (e, n) = (e-1, n)
91 newPosition East (e, n) = (e+1, n)
94 -- | a `succ` that wraps
95 turnCW :: (Bounded a, Enum a, Eq a) => a -> a
96 turnCW dir | dir == maxBound = minBound
97 | otherwise = succ dir
99 -- | a `pred` that wraps
100 turnACW :: (Bounded a, Enum a, Eq a) => a -> a
101 turnACW dir | dir == minBound = maxBound
102 | otherwise = pred dir
106 showWorld :: World -> Text
107 showWorld w = showGrass mine maxn minn mine maxn maxe g
110 mine = minimum(map fst $ M.keys g)
111 maxe = maximum(map fst $ M.keys g)
112 minn = minimum(map snd $ M.keys g)
113 maxn = maximum(map snd $ M.keys g)
115 showGrass :: Int -> Int -> Int -> Int -> Int -> Int -> Grass -> Text
116 showGrass e n minn mine maxn maxe g
117 | n == minn && e == maxe = T.singleton '\n'
118 | e == maxe = T.cons '\n' $ showGrass mine (n-1) minn mine maxn maxe g
119 | otherwise = T.cons cell $ showGrass (e+1) n minn mine maxn maxe g
120 where cell = if M.member (e, n) g then '⌷' else ' '
122 -- Parse the input file
124 type Parser = Parsec Void Text
126 -- treat comment lines as whitespace
128 sc = L.space space1 lineComment CA.empty
129 where lineComment = L.skipLineComment "#"
132 integer = lexeme L.decimal
135 -- instructions is some optional space followed by many instructions
136 instrsP = optional sc *> many instrP
138 -- an instruction is either F, C, or A
139 instrP = forwardP <|> cwP <|> acwP <|> upP <|> downP
141 -- parse each instruction
142 forwardP = Forward <$> (symb "F" *> integer)
143 cwP = Clockwise <$ symb "C"
144 acwP = Anticlockwise <$ symb "A"
146 downP = Down <$ symb "D"
148 successfulParse :: Text -> [Instruction]
149 successfulParse input =
150 case parse instrsP "input" input of
151 Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
152 Right instrs -> instrs