advent07.hs

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