Solving Advent of Code 2019 Day4 using recursion schemes and the free list monad

Day4.hs

{-# LANGUAGE FlexibleContexts, FlexibleInstances, RankNTypes, InstanceSigs, TypeApplications, ScopedTypeVariables, MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving, DerivingVia, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies, GADTs #-}
{-# LANGUAGE AllowAmbiguousTypes, UndecidableInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Day4 where

import Data.Functor.Foldable(hylo)
import Data.List(group)
import Control.Monad.Trans.Free(FreeF(Free, Pure))
import Data.Foldable(fold)
import Data.Monoid(Sum(Sum))

newtype Digit = D Int
    deriving newtype (Read, Show, Ord, Eq, Enum)

type Digits = [Digit]

value :: Digits -> Int
value l = sum $ zipWith ((*) . getDigit) l p
    where p = [100000,10000,1000,100,10,1]
          getDigit (D d) = d

repeatA :: (Eq a) => [a] -> Bool
repeatA (x:y:_) | x == y = True
repeatA [] = False
repeatA (_:l) = repeatA l

repeatB :: (Eq a) => [a] -> Bool
repeatB = any ((== 2) . length) . group

valueInRange :: Digits -> Bool
valueInRange = inRange . value
    where inRange l = 284639 <= l && l <= 748759

expand ::  (Digits -> Bool) -> Digits -> FreeF [] Digits Digits
expand f l = case length l of
    6 -> Pure l
    5 -> Free $ filter f next'
    0 -> Free $ pure <$> [(D 0)..(D 9)]
    _ -> Free next'
    where next' = (:) <$> [(D 1)..head l] <*> (pure l)

foldMap' :: (Foldable t, Monoid m) => (a -> m) -> FreeF t a m -> m
foldMap' f (Pure x) = f x
foldMap' _ (Free l) = fold l 

count :: (Foldable t) => FreeF t a (Sum Int) -> Sum Int
count = foldMap' $ const $ Sum 1

-- Not actually needed for the finished product, but pretty vital during debugging
all' :: (Foldable t) => Digits -> [Int]
all' = pure . value

day4a :: Sum Int
day4a = hylo count (expand ((&&) <$> repeatA <*> valueInRange)) []

day4b :: Sum Int
day4b = hylo count (expand ((&&) <$> repeatB <*> valueInRange)) []

Second version has the following changes:

• Newtype for Digit and Digits (required GeneralizedNewTypeDeriving)
• foldMap' that highlights the foldability of Free t a (even if you can't implement Foldable).
• repeatA and repeatB are now generic (since changing type X to Y isn't worth doing)