src/advent20/advent20.hs

   1 {-# LANGUAGE NegativeLiterals #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE BangPatterns #-}
   4
   5
   6 -- import Debug.Trace
   7
   8 -- import Prelude hiding ((++))
   9 import Data.Text (Text)
  10 import qualified Data.Text as T
  11 import qualified Data.Text.IO as TIO
  12
  13 import Data.Void (Void)
  14 import Text.Megaparsec hiding (State)
  15 import Text.Megaparsec.Char
  16 import qualified Text.Megaparsec.Char.Lexer as L
  17 import qualified Control.Applicative as CA
  18
  19 import qualified Data.Map.Strict as M
  20 import Data.Map.Strict ((!))
  21 import qualified Data.Set as S
  22
  23 import Linear (V2(..))
  24
  25 -- import Control.Monad.State.Lazy
  26 import Control.Monad.State.Strict
  27 import Control.Monad.Extra (concatMapM)
  28 -- import Control.Monad.Trans.List
  29
  30 type Coord = V2 Integer -- x, y, with north and east incresing values (origin a bottom left)
  31 data Door = Door Coord Coord deriving (Show, Eq, Ord)
  32 type Doors = S.Set Door
  33
  34 data MazeSection = Path [Coord] | Junction [Maze] deriving (Show, Eq)
  35 type Maze = [MazeSection]
  36
  37
  38 type Mapper = State Doors [Coord]
  39
  40
  41 makeDoor :: Coord -> Coord -> Door
  42 makeDoor !a !b
  43     | a < b = Door a b
  44     | otherwise = Door b a
  45
  46 main :: IO ()
  47 main = do
  48         text <- TIO.readFile "data/advent20.txt"
  49         let maze = successfulParse text
  50         print $ T.length text
  51         -- print maze
  52         part1 maze
  53
  54
  55 emptyMap = S.empty
  56
  57 part1 maze =
  58     do
  59         let start = V2 0 0
  60         let doors = execState (mapMaze [start] maze) emptyMap
  61         print $ length doors
  62
  63
  64 mapMaze :: [Coord] -> Maze -> Mapper
  65 mapMaze !starts !sections =
  66     foldM (\heres section -> mapMazeSection heres section) starts sections
  67
  68 mapMazeSection :: [Coord] -> MazeSection -> Mapper
  69 mapMazeSection !starts (Junction mazes) =
  70     concatMapM (\maze -> mapMaze starts maze) mazes
  71 mapMazeSection !starts (Path steps) =
  72     mapM mapPath starts
  73     where mapPath start = foldM (\here step -> includeDoor here step) start steps
  74
  75 includeDoor :: Coord -> Coord -> State Doors Coord
  76 includeDoor !here !step =
  77     do let there = (here + step)
  78        let door = there `seq` makeDoor here there
  79        modify' (door `seq` S.insert door)
  80        return there
  81
  82
  83 type Parser = Parsec Void Text
  84
  85 sc :: Parser ()
  86 sc = L.space (skipSome spaceChar) CA.empty CA.empty
  87
  88 -- lexeme  = L.lexeme sc
  89 symb = L.symbol sc
  90 branchSepP = symb "|"
  91 openBranchP = symb "("
  92 closeBranchP = symb ")"
  93 startP = symb "^"
  94 endP = symb "$"
  95
  96 doorP :: Parser Coord
  97 doorP = nP <|> sP <|> eP <|> wP
  98 nP = (symb "N" *> pure (V2  0  1))
  99 sP = (symb "S" *> pure (V2  0 -1))
 100 eP = (symb "E" *> pure (V2  1  0))
 101 wP = (symb "W" *> pure (V2 -1  0))
 102
 103 pathP = Path <$> some doorP
 104
 105 junctionP = Junction <$> (openBranchP `between` closeBranchP) manyMazesP
 106
 107 manyMazesP = mazeP `sepBy` branchSepP
 108
 109 mazeSectionP = pathP <|> junctionP
 110
 111 mazeP = many mazeSectionP
 112
 113 wholeMazeP = (startP `between` endP) mazeP
 114
 115
 116 successfulParse :: Text -> Maze
 117 successfulParse input =
 118         case parse wholeMazeP "input" input of
 119                 Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 120                 Right maze   -> maze