Solve day 2, part 2

Main.hs

@@ -1,7 +1,9 @@
 module Main where
 
 import Day1 (day1)
+import Day2 (day2)
 
 main :: IO ()
 main = do
   day1
+  day2

src/Day2.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+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
+                     , letter :: Letter
+                     }
+
+parserPolicy :: P.Parser Policy
+parserPolicy = do
+    lB <- P.decimal
+    _ <- P.char '-'
+    uB <- P.decimal
+    _ <- P.char ' '
+    le <- P.letter
+    _ <- P.string ": "
+    return $ Policy lB uB le
+
+validatePolicy :: Validator
+validatePolicy p s =
+    let l = length $ filter (== letter p) s in
+    l >= lBound p && l <= uBound p
+
+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 -> 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
+  rs <- lines <$> readFile "./input/day2"
+  putStr "[Day 2-1] # valid passwords: "
+  print . length . filter (==True) . fmap (validateLine validatePolicy) $ rs
+  putStr "[Day 2-2] # valid passwords: "
+  print . length . filter (==True) . fmap (validateLine validateCorrectPolicy) $ rs