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 allowsAbba :: [ChunkV] -> Bool
  42 allowsAbba chunks = (any (chunkValueV) includeChunks) && (not (any (chunkValueV) excludeChunks))
  43     where (includeChunks, excludeChunks) = partition (isIncludeV) chunks
  44
  45 i7file = i7line `endBy` newline
  46 i7line = many1 (includeChunk <|> excludeChunk)
  47
  48 chunk = many1 alphaNum
  49
  50 excludeChunk = Exclude <$> (between (char '[') (char ']') $ chunk)
  51 includeChunk = Include <$> chunk
  52
  53 hasABBA = preambleAbba <* (many alphaNum)
  54 preambleAbba = (try abba) <|> (alphaNum >> preambleAbba)
  55
  56 -- abba =
  57 --     do  a <- alphaNum
  58 --         b <- alphaNum
  59 --         if a == b then
  60 --             fail "Identical"
  61 --         else do char b
  62 --                 char a
  63 --                 return [a, b, b, a]
  64
  65 abba =
  66     do  a <- alphaNum
  67         b <- noneOf [a]
  68         char b
  69         char a
  70         return [a, b, b, a]
  71
  72 i7filev = i7linev `endBy` newline
  73 i7linev = many1 (includeChunkv <|> excludeChunkv)
  74
  75 excludeChunkv = Excludev <$> (between (char '[') (char ']') $ hasABBAv)
  76 includeChunkv = Includev <$> hasABBAv
  77
  78 hasABBAv =
  79     (try (id True <$ preambleAbba <* (many alphaNum)))
  80     <|>
  81     (id False <$ (many1 alphaNum))
  82
  83
  84 parseI7f :: String -> Either ParseError [[Chunk]]
  85 parseI7f input = parse i7file "(unknown)" input
  86
  87 parseI7 :: String -> Either ParseError [Chunk]
  88 parseI7 input = parse i7line "(unknown)" input
  89
  90 parseAbba :: String -> Either ParseError String
  91 parseAbba input = parse hasABBA "(unknown)" input
  92
  93 parseI7v :: String -> Either ParseError [ChunkV]
  94 parseI7v input = parse i7linev "(unknown)" input
  95
  96 parseI7vf :: String -> Either ParseError [[ChunkV]]
  97 parseI7vf input = parse i7filev "(unknown)" input
  98
  99 successfulParse :: Either ParseError [a] -> [a]
 100 successfulParse (Left _) = []
 101 successfulParse (Right a) = a
 102
 103
 104 allSubstrings :: Int -> [a] -> [[a]]
 105 allSubstrings n es
 106     | length es < n = []
 107     | otherwise = (take n es) : (allSubstrings n $ tail es)
 108
 109 ieCandidates :: [Chunk] -> ([String], [String])
 110 ieCandidates chunks = (includeCandidates, excludeCandidates)
 111     where (includeChunks, excludeChunks) = partition (isInclude) chunks
 112           isABA s = (s!!0 == s!!2) && (s!!0 /= s!!1)
 113           candidates = (filter (isABA)) . (foldl (union) []) . (map ((allSubstrings 3) . chunkValue))
 114           includeCandidates = candidates includeChunks
 115           excludeCandidates = candidates excludeChunks
 116
 117 inverseABA :: String -> String
 118 inverseABA s = [s!!1, s!!0, s!!1]
 119
 120 supportsSSL :: [Chunk] -> Bool
 121 supportsSSL chunks = not $ null $ intersect abas eabas
 122     where (abas, babs) = ieCandidates chunks
 123           eabas = map (inverseABA) babs