19/one.icl

   1 module one
   2
   3 import StdEnv
   4 import Data.Either
   5 import Data.Func
   6 import Data.Functor
   7 import Data.List
   8 import Data.Maybe
   9 import Data.Tuple
  10 import Control.Applicative
  11 import Control.Monad => qualified join
  12 import Text
  13 import Text.Parsers.Simple.ParserCombinators
  14
  15 read :: *File -> [Char]
  16 read f
  17         # (ok, c, f) = freadc f
  18         | not ok = []
  19         = [c:read f]
  20
  21 Start w
  22         # (io, w) = stdio w
  23         = case split ['\n\n'] $ read io of
  24                 [gram,ip] = case parse pGram gram of
  25                         Right gram
  26                                 = (both gram ip, both
  27                                         [(8, [[Left 42], [Left 42,Left 8]])
  28                                         ,(11, [[Left 42, Left 31], [Left 42, Left 11, Left 31]]):gram] ip)
  29 where
  30         both gram = length o rights o map (parse $ toParser 0 gram) o split ['\n'] o trim
  31
  32 toParser :: Int [(Int, [[Either Int Char]])] -> Parser Char [Char]
  33 toParser i m = foldr (<|>) empty $ map (fmap flatten o sequence o map toP) $ fromJust $ lookup i m
  34 where
  35         toP (Left i) = toParser i m
  36         toP (Right c) = (\x->[x]) <$> pToken c
  37
  38 pGram :: Parser Char [(Int, [[Either Int Char]])]
  39 pGram = pSepBy1
  40         (tuple <$> pInt <* pStr [': '] <*> pSepBy1
  41                 (pSepBy (Left <$> pInt <|> Right <$> pChar) (pToken ' '))
  42                 (pStr [' | ']))
  43         (pToken '\n')
  44
  45 pInt :: Parser Char Int
  46 pInt = toInt o toString <$> some pDigit
  47 pChar :: Parser Char Char
  48 pChar = pToken '"' *> pAlpha <* pToken'"'
  49 pStr :: ([Char] -> Parser Char [Char])
  50 pStr = sequence o map pToken