Tidying, especially the parser
[advent-of-code-16.git] / adventofcode16 / 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