19

[aoc20.git] / 19 / one.icl

diff --git a/19/one.icl b/19/one.icl
new file mode 100644 (file)
index 0000000..8bff425
--- /dev/null
+++ b/19/one.icl
@@ -0,0 +1,50 @@
+module one
+
+import StdEnv
+import Data.Either
+import Data.Func
+import Data.Functor
+import Data.List
+import Data.Maybe
+import Data.Tuple
+import Control.Applicative
+import Control.Monad => qualified join
+import Text
+import Text.Parsers.Simple.ParserCombinators
+
+read :: *File -> [Char]
+read f
+       # (ok, c, f) = freadc f
+       | not ok = []
+       = [c:read f]
+
+Start w
+       # (io, w) = stdio w
+       = case split ['\n\n'] $ read io of
+               [gram,ip] = case parse pGram gram of
+                       Right gram
+                               = (both gram ip, both
+                                       [(8, [[Left 42], [Left 42,Left 8]])
+                                       ,(11, [[Left 42, Left 31], [Left 42, Left 11, Left 31]]):gram] ip)
+where
+       both gram = length o rights o map (parse $ toParser 0 gram) o split ['\n'] o trim
+
+toParser :: Int [(Int, [[Either Int Char]])] -> Parser Char [Char]
+toParser i m = foldr (<|>) empty $ map (fmap flatten o sequence o map toP) $ fromJust $ lookup i m
+where
+       toP (Left i) = toParser i m
+       toP (Right c) = (\x->[x]) <$> pToken c
+
+pGram :: Parser Char [(Int, [[Either Int Char]])]
+pGram = pSepBy1
+       (tuple <$> pInt <* pStr [': '] <*> pSepBy1
+               (pSepBy (Left <$> pInt <|> Right <$> pChar) (pToken ' '))
+               (pStr [' | ']))
+       (pToken '\n')
+
+pInt :: Parser Char Int
+pInt = toInt o toString <$> some pDigit
+pChar :: Parser Char Char
+pChar = pToken '"' *> pAlpha <* pToken'"'
+pStr :: ([Char] -> Parser Char [Char])
+pStr = sequence o map pToken