advent07.hs

   1 import Text.Parsec
   2 import Control.Applicative ((<$), (<*), (*>), liftA)
   3 import Data.List (partition, union, intersect)
   4
   5 data Chunk = Include String | Exclude String deriving (Show)
   6 data ChunkV = Includev Bool | Excludev Bool deriving (Show)
   7
   8 chunkValue :: Chunk -> String
   9 chunkValue (Include v) = v
  10 chunkValue (Exclude v) = v
  11
  12 isInclude :: Chunk -> Bool
  13 isInclude (Include _) = True
  14 isInclude (Exclude _) = False
  15
  16 chunkValueV :: ChunkV -> Bool
  17 chunkValueV (Includev v) = v
  18 chunkValueV (Excludev v) = v
  19
  20 isIncludeV :: ChunkV -> Bool
  21 isIncludeV (Includev _) = True
  22 isIncludeV (Excludev _) = False
  23
  24
  25 main :: IO ()
  26 main = do
  27     text <- readFile "advent07.txt"
  28     part1 text
  29     part2 text
  30
  31
  32 part1 :: String -> IO ()
  33 part1 text = do
  34     print $ length $ filter (allowsAbba) $ successfulParse $ parseI7vf text
  35
  36
  37 part2 :: String -> IO ()
  38 part2 text = do
  39     print $ length $ filter (supportsSSL) $ successfulParse $ parseI7f text
  40
  41
  42 allowsAbba :: [ChunkV] -> Bool
  43 allowsAbba chunks = (any (chunkValueV) includeChunks) && (not (any (chunkValueV) excludeChunks))
  44     where (includeChunks, excludeChunks) = partition (isIncludeV) chunks
  45
  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 i7filev = i7linev `endBy` newline
  68 i7linev = many1 (includeChunkv <|> excludeChunkv)
  69
  70 excludeChunkv = Excludev <$> (between (char '[') (char ']') $ hasABBAv)
  71 includeChunkv = Includev <$> hasABBAv
  72
  73 hasABBAv =
  74     (try (id True <$ preambleAbba <* (many alphaNum)))
  75     <|>
  76     (id False <$ (many1 alphaNum))
  77
  78
  79 parseI7f :: String -> Either ParseError [[Chunk]]
  80 parseI7f input = parse i7file "(unknown)" input
  81
  82 parseI7 :: String -> Either ParseError [Chunk]
  83 parseI7 input = parse i7line "(unknown)" input
  84
  85 parseAbba :: String -> Either ParseError String
  86 parseAbba input = parse hasABBA "(unknown)" input
  87
  88 parseI7v :: String -> Either ParseError [ChunkV]
  89 parseI7v input = parse i7linev "(unknown)" input
  90
  91 parseI7vf :: String -> Either ParseError [[ChunkV]]
  92 parseI7vf input = parse i7filev "(unknown)" input
  93
  94 successfulParse :: Either ParseError [a] -> [a]
  95 successfulParse (Left _) = []
  96 successfulParse (Right a) = a
  97
  98
  99 allSubstrings :: Int -> [a] -> [[a]]
 100 allSubstrings n es
 101     | length es < n = []
 102     | otherwise = (take n es) : (allSubstrings n $ tail es)
 103
 104 ieCandidates :: [Chunk] -> ([String], [String])
 105 ieCandidates chunks = (includeCandidates, excludeCandidates)
 106     where (includeChunks, excludeChunks) = partition (isInclude) chunks
 107           isABA s = (s!!0 == s!!2) && (s!!0 /= s!!1)
 108           candidates = (filter (isABA)) . (foldl (union) []) . (map ((allSubstrings 3) . chunkValue))
 109           includeCandidates = candidates includeChunks
 110           excludeCandidates = candidates excludeChunks
 111
 112 inverseABA :: String -> String
 113 inverseABA s = [s!!1, s!!0, s!!1]
 114
 115 supportsSSL :: [Chunk] -> Bool
 116 supportsSSL chunks = not $ null $ intersect abas eabas
 117     where (abas, babs) = ieCandidates chunks
 118           eabas = map (inverseABA) babs