never executed always true always false

    1 {-|
    2 Module:      Y2021.D10
    3 Description: Advent of Code 2021 Day 10 Solutions.
    4 License:     MIT
    5 Maintainer:  @tylerjl
    6 
    7 Solutions to the 2021 day 10 set of problems for <adventofcode.com>.
    8 -}
    9 module Y2021.D10
   10   ( part10A
   11   , part10B
   12   , parse10
   13   ) where
   14 
   15 import Control.Monad     (foldM)
   16 import Data.Either.Extra (lefts, rights)
   17 import Data.Foldable     (foldl')
   18 import Data.List         (sort)
   19 import Data.Text         (Text)
   20 import Witch
   21 
   22 import qualified Data.Text as T
   23 
   24 -- |Solve part A
   25 part10A :: Text -> Int
   26 part10A = sum . map errorTable . lefts . map (parse10 . into @String) . T.lines
   27 
   28 -- |Character lookup table for part A
   29 errorTable :: Char -> Int
   30 errorTable c | c == '(' || c == ')' = 3
   31 errorTable c | c == '[' || c == ']' = 57
   32 errorTable c | c == '{' || c == '}' = 1197
   33 errorTable c | c == '<' || c == '>' = 25137
   34 errorTable _ = 0
   35 
   36 -- |Solve part B
   37 part10B :: Text -> Int
   38 part10B
   39   -- Then convert them to scores, custom score, and get the median
   40   = median . sort . map (foldl' score 0 . fmap syntaxPoints)
   41   -- Get all valid unterminated syntaxes
   42   . rights . map (parse10 . into @String) . T.lines
   43 
   44 -- |Manual parser for a given input string. I tried a `Seq` intially, just a
   45 -- stock `List`s as a stack works just as well.
   46 parse10 :: [Char] -> Either Char [Char]
   47 parse10 = fmap (map pair') . foldM go []
   48   where
   49     go [] c
   50       | opener c = pure [c]
   51       | otherwise = Left c
   52     go acc c | opener c = pure (c:acc)
   53     go ('(':acc) ')' = pure acc
   54     go ('{':acc) '}' = pure acc
   55     go ('[':acc) ']' = pure acc
   56     go ('<':acc) '>' = pure acc
   57     go _ c = Left c
   58     opener c = c == '(' || c == '[' || c == '{' || c == '<'
   59 
   60 -- |Utility to lookup the pairwise values for a expression opener/closer.
   61 pair' :: Char -> Char
   62 pair' '(' = ')'
   63 pair' ')' = '('
   64 pair' '{' = '}'
   65 pair' '}' = '{'
   66 pair' ']' = '['
   67 pair' '[' = ']'
   68 pair' '<' = '>'
   69 pair' '>' = '<'
   70 pair'  _  = error "invalid pair"
   71 
   72 -- |Silly little median function
   73 median :: [a] -> a
   74 median []    = error "empty list"
   75 median [x]   = x
   76 median [x,_] = x
   77 median xs    = median $ init $ tail xs
   78 
   79 -- |Expresses the scoring algorithm for part B, suitable for use in a fold
   80 score :: Num a => a -> a -> a
   81 score total n = (total * 5) + n
   82 
   83 -- |Maps the characters for part B into their given values.
   84 syntaxPoints :: Num p => Char -> p
   85 syntaxPoints ')' = 1
   86 syntaxPoints ']' = 2
   87 syntaxPoints '}' = 3
   88 syntaxPoints '>' = 4
   89 syntaxPoints  _  = 0