aoc-day2.hs

#!/usr/bin/env cabal

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

{- cabal:
build-depends:
  , base ^>= 4.13.0.0
  , text ^>= 1.2.4.0
  , transformers ^>= 0.5.6.2
  , either ^>= 5.0.1.1
-}

import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
import Data.Foldable as F (Foldable (foldl))
import Data.Text (Text)
import qualified Data.Text as T (splitOn, count, unpack, lines, index, head)
import Data.Text.IO (hGetContents)
import Data.Text.Read (decimal)
import Data.Either.Combinators (fromRight')
import Debug.Trace (trace)
import System.Environment
import System.IO (IOMode (ReadMode), openFile)

main :: (MonadIO m) => m ()
main = do
  passwords <- readPasswords "../data/day2.txt"
  results <- runMaybeT $ do
    r  <- mapM decodePasswordEntries passwords
    return $
      let rPart1 = foldl (\b a-> b + countValid checkPolicyPart1 a) 0 r
          rPart2 = foldl (\b a-> b + countValid checkPolicyPart2 a) 0 r
      in (rPart1, rPart2)
  liftIO $
    case results of
      Nothing -> print "Error"
      Just r -> print r

countValid :: (PasswordPolicy -> Text -> Bool) -> (PasswordPolicy,Text) -> Int
countValid f (policy,pwd) =
  if f policy pwd
  then 1
  else 0

readPasswords :: MonadIO m => Text -> m [Text]
readPasswords path = do
  fileHandle <- liftIO . openFile path' $ ReadMode
  liftIO $ T.lines <$> hGetContents fileHandle
  where
    path' = T.unpack path

data PasswordPolicy = PP
  { min :: Int,
    max :: Int,
    letter :: Text
  }

decodePasswordEntries :: Monad m => Text -> MaybeT m (PasswordPolicy, Text)
decodePasswordEntries entry = MaybeT $ do
 if length components == 3
    then return $ Just (PP {min = minPolicy, max = maxPolicy, letter = letterPolicy}, pwd)
    else return Nothing
  where
    components = T.splitOn " " entry
    letterPolicy = head . T.splitOn ":" $ components !! 1
    minPolicy = int . head $ T.splitOn "-" $ head components
    maxPolicy = int . last $ T.splitOn "-" $ head components
    pwd = last components
    int = fst . fromRight' . decimal

checkPolicyPart1 :: PasswordPolicy -> Text -> Bool
checkPolicyPart1 PP{..} pwd =
  let nbLetter = T.count letter pwd
  in
    nbLetter >= min && nbLetter <= max

checkPolicyPart2 :: PasswordPolicy -> Text -> Bool
checkPolicyPart2 PP{..} pwd =
  posMinLetter /= posMaxLetter && ((posMinLetter == letter') || (posMaxLetter == letter'))
  where
    posMinLetter = T.index pwd (min - 1)
    posMaxLetter = T.index pwd (max - 1)
    letter' = T.head letter