Solve day 2, part 2

src/Day2.hs

@@ -4,10 +4,12 @@ module Day2 (day2) where
 
 import qualified Data.Text as T
 import qualified Data.Attoparsec.Text as P
+import Data.List (elemIndices)
 
 type Max = Int
 type Min = Int
 type Letter = Char
+type Validator = Policy -> String -> Bool
 
 data Policy = Policy { lBound :: Min
                      , uBound :: Max
@@ -24,20 +26,34 @@ parserPolicy = do
     _ <- P.string ": "
     return $ Policy lB uB le
 
-validatePolicy :: Policy -> String -> Bool
+validatePolicy :: Validator
 validatePolicy p s =
     let l = length $ filter (== letter p) s in
     l >= lBound p && l <= uBound p
 
-validateLine :: String -> Bool
-validateLine s =
+validateLine :: Validator -> String -> Bool
+validateLine v s =
     case P.parse parserPolicy (T.pack s) of
         P.Fail {} -> error "day2 - parser error"
         P.Partial _ -> error "day2 - input error"
-        P.Done i r -> validatePolicy r (T.unpack i)
+        P.Done i r -> v r (T.unpack i)
+
+xor :: Bool -> Bool -> Bool
+xor True = not
+xor False = id
+
+validateCorrectPolicy :: Validator
+validateCorrectPolicy p s =
+    let index1 = lBound p - 1
+        index2 = uBound p - 1
+        indices = elemIndices (letter p) s in
+        xor (index1 `elem` indices) (index2 `elem` indices)
+
 
 day2 :: IO ()
 day2 = do
-  r <- readFile "./input/day2"
+  rs <- lines <$> readFile "./input/day2"
   putStr "[Day 2-1] # valid passwords: "
-  print . length . filter (==True) . fmap validateLine . lines $ r
+  print . length . filter (==True) . fmap (validateLine validatePolicy) $ rs
+  putStr "[Day 2-2] # valid passwords: "
+  print . length . filter (==True) . fmap (validateLine validateCorrectPolicy) $ rs