app/advent07.hs

   1 module Main(main) where
   2
   3 import Text.Parsec
   4 import Data.List (partition, union, intersect, tails)
   5 import Data.Char (isAlphaNum)
   6
   7 data Chunk = Include String | Exclude String deriving (Show)
   8 data ChunkV = Includev Bool | Excludev Bool deriving (Show)
   9
  10 chunkValue :: Chunk -> String
  11 chunkValue (Include v) = v
  12 chunkValue (Exclude v) = v
  13
  14 isInclude :: Chunk -> Bool
  15 isInclude (Include _) = True
  16 isInclude (Exclude _) = False
  17
  18 chunkValueV :: ChunkV -> Bool
  19 chunkValueV (Includev v) = v
  20 chunkValueV (Excludev v) = v
  21
  22 isIncludeV :: ChunkV -> Bool
  23 isIncludeV (Includev _) = True
  24 isIncludeV (Excludev _) = False
  25
  26
  27 main :: IO ()
  28 main = do
  29     text <- readFile "data/advent07.txt"
  30     part1 text
  31     part2 text
  32
  33
  34 part1 :: String -> IO ()
  35 part1 text = do
  36     print $ length $ filter (allowsAbba) $ successfulParse $ parseI7vf text
  37
  38
  39 part2 :: String -> IO ()
  40 part2 text = do
  41     print $ length $ filter (supportsSSL) $ successfulParse $ parseI7f text
  42
  43 allowsAbba :: [ChunkV] -> Bool
  44 allowsAbba chunks = (any (chunkValueV) includeChunks) && (not (any (chunkValueV) excludeChunks))
  45     where (includeChunks, excludeChunks) = partition (isIncludeV) chunks
  46
  47 i7file = i7line `endBy` newline
  48 i7line = many1 (includeChunk <|> excludeChunk)
  49
  50 chunk = many1 alphaNum
  51
  52 excludeChunk = Exclude <$> (between (char '[') (char ']') $ chunk)
  53 includeChunk = Include <$> chunk
  54
  55 hasABBA = preambleAbba <* (many alphaNum)
  56 preambleAbba = (try abba) <|> (alphaNum >> preambleAbba)
  57
  58 -- abba =
  59 --     do  a <- alphaNum
  60 --         b <- alphaNum
  61 --         if a == b then
  62 --             fail "Identical"
  63 --         else do char b
  64 --                 char a
  65 --                 return [a, b, b, a]
  66
  67 abba =
  68     do  a <- alphaNum
  69         b <- noneOf [a]
  70         char b
  71         char a
  72         return [a, b, b, a]
  73
  74 --         where
  75 --   firstChar = satisfy (\a -> isLetter a || a == '_')
  76 --   nonFirstChar = satisfy (\a -> isDigit a || isLetter a || a == '_')
  77
  78    -- b <- bChar
  79 -- where bChar = satisfy (\l -> lsLetter l && l /= a)
  80
  81
  82
  83 i7filev = i7linev `endBy` newline
  84 i7linev = many1 (includeChunkv <|> excludeChunkv)
  85
  86 excludeChunkv = Excludev <$> (between (char '[') (char ']') $ hasABBAv)
  87 includeChunkv = Includev <$> hasABBAv
  88
  89 hasABBAv =
  90     (try (id True <$ preambleAbba <* (many alphaNum)))
  91     <|>
  92     (id False <$ (many1 alphaNum))
  93
  94
  95 parseI7f :: String -> Either ParseError [[Chunk]]
  96 parseI7f input = parse i7file "(unknown)" input
  97
  98 parseI7 :: String -> Either ParseError [Chunk]
  99 parseI7 input = parse i7line "(unknown)" input
 100
 101 parseAbba :: String -> Either ParseError String
 102 parseAbba input = parse hasABBA "(unknown)" input
 103
 104 parseI7v :: String -> Either ParseError [ChunkV]
 105 parseI7v input = parse i7linev "(unknown)" input
 106
 107 parseI7vf :: String -> Either ParseError [[ChunkV]]
 108 parseI7vf input = parse i7filev "(unknown)" input
 109
 110 successfulParse :: Either ParseError [a] -> [a]
 111 successfulParse (Left _) = []
 112 successfulParse (Right a) = a
 113
 114
 115 allSubstrings :: Int -> [a] -> [[a]]
 116 -- allSubstrings n es
 117 --     | length es < n = []
 118 --     | otherwise = (take n es) : (allSubstrings n $ tail es)
 119 allSubstrings n e = filter (\s -> length s == n) $ map (take n) $ tails e
 120
 121
 122 ieCandidates :: [Chunk] -> ([String], [String])
 123 ieCandidates chunks = (includeCandidates, excludeCandidates)
 124     where (includeChunks, excludeChunks) = partition (isInclude) chunks
 125           isABA s = (s!!0 == s!!2) && (s!!0 /= s!!1)
 126           candidates = (filter (isABA)) . (foldl (union) []) . (map ((allSubstrings 3) . chunkValue))
 127           includeCandidates = candidates includeChunks
 128           excludeCandidates = candidates excludeChunks
 129
 130 inverseABA :: String -> String
 131 inverseABA s = [s!!1, s!!0, s!!1]
 132
 133 supportsSSL :: [Chunk] -> Bool
 134 supportsSSL chunks = not $ null $ intersect abas eabas
 135     where (abas, babs) = ieCandidates chunks
 136           eabas = map (inverseABA) babs