Merge branch 'master' of git.njae.me.uk:advent-of-code-16
[advent-of-code-16.git] / 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