adventOfCode/2015/days/Day5.hs at master · GuillaumedeVolpiano/adventOfCode · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
module Day5
  ( part1
  , part2
  ) where

import           Control.Monad.State  (State, evalState, get, put)
import           Data.ByteString      (ByteString, pack)
import           Data.Either          (fromRight)
import           Data.Set             (Set, empty, insert, member, singleton)
import           Data.Void            (Void)
import           Data.Word            (Word8)
import           Data.Word8           (_a, _b, _c, _d, _e, _i, _o, _p, _q,
                                       _space, _u, _x, _y)
import           Text.Megaparsec      (ParsecT, eof, runParserT, (<|>))
import           Text.Megaparsec.Byte (eol, lowerChar)

type ParserState = State (Word8, [Word8], Bool, Bool)

type Parser = ParsecT Void ByteString ParserState Int

type BetterState = State (Word8, Word8, Word8, Set [Word8], Bool, Bool)

type BetterParser = ParsecT Void ByteString BetterState Int

parseFirst :: Parser
parseFirst = do
  firstChar <- lowerChar
  let vowels = updateVowels firstChar []
  put (firstChar, vowels, False, False)
  parseLine

betterParseFirst :: BetterParser
betterParseFirst = do
  firstChar <- lowerChar
  put (firstChar, _space, _space, empty, False, False)
  betterParseSecond

betterParseSecond :: BetterParser
betterParseSecond = do
  secondChar <- lowerChar
  (firstChar, _, _, _, _, _) <- get
  put
    ( firstChar
    , secondChar
    , _space
    , singleton [firstChar, secondChar]
    , False
    , False)
  betterParseThird

betterParseThird :: BetterParser
betterParseThird = do
  thirdChar <- lowerChar
  (firstChar, secondChar, _, pairs, False, False) <- get
  let hasSepPair = thirdChar == firstChar
  put
    ( firstChar
    , secondChar
    , thirdChar
    , insert [secondChar, thirdChar] pairs
    , False
    , hasSepPair)
  betterParseLine

betterParseLine :: BetterParser
betterParseLine = betterParseLetter <|> betterParseEOL

parseLine :: Parser
parseLine = parseLetter <|> parseEOL

parseLetter :: Parser
parseLetter = do
  letter <- lowerChar
  (previous, vowels, hasPairs, hasNaughty) <- get
  let hasPairs' = hasPairs || letter == previous
      hasNaughty' =
        hasNaughty
          || [previous, letter] `elem` [[_a, _b], [_c, _d], [_p, _q], [_x, _y]]
      vowels' = updateVowels letter vowels
  put (letter, vowels', hasPairs', hasNaughty')
  parseLine

betterParseLetter :: BetterParser
betterParseLetter = do
  letter <- lowerChar
  (firstChar, secondChar, thirdChar, pairs, hasPair, hasSepPair) <- get
  let pair = [thirdChar, letter]
      hasPair' =
        hasPair
          || ((letter /= secondChar
                 || letter /= thirdChar
                 || letter == firstChar)
                && pair `member` pairs)
      hasSepPair' = hasSepPair || letter == secondChar
      pairs' = insert pair pairs
  put (secondChar, thirdChar, letter, pairs', hasPair', hasSepPair')
  betterParseLine

parseEOL :: Parser
parseEOL = do
  eol
  (_, vowels, hasPairs, hasNaughty) <- get
  let result
        | length vowels >= 3 && hasPairs && not hasNaughty = (+ 1)
        | otherwise = id
  result <$> parseNext

betterParseEOL :: BetterParser
betterParseEOL = do
  eol
  (_, _, _, _, hasPair, hasSepPair) <- get
  let result
        | hasPair && hasSepPair = (+ 1)
        | otherwise = id
  result <$> betterParseNext

parseNext :: Parser
parseNext = parseFirst <|> (eof >> return 0)

betterParseNext :: BetterParser
betterParseNext = betterParseFirst <|> (eof >> return 0)

updateVowels :: Word8 -> [Word8] -> [Word8]
updateVowels letter vowels
  | letter `elem` [_a, _e, _i, _o, _u] = letter : vowels
  | otherwise = vowels

part1 :: Bool -> ByteString -> String
part1 _ =
  show
    . fromRight (error "parser failed")
    . flip evalState (_space, [], False, False)
    . runParserT parseFirst "Day 5"

part2 :: Bool -> ByteString -> String
part2 _ =
  show
    . fromRight (error "parser failed")
    . flip evalState (_space, _space, _space, empty, False, False)
    . runParserT betterParseFirst "Day 5"