I’m relatively new to the language and I saw the post ‘Beautifal Functional Programming’. While I was coding my solution I came across the problem.
The code was like this(using GHC 9.0.2):
{-# LANGUAGE DeriveFunctor #-}
import Data.List
import Data.Bifunctor
type Lesson a = (String, a)
data Section a b= Section
{ title :: String
, reset :: Bool
, lessons :: [Lesson a]
, pos :: b
} deriving (Eq, Functor)
-- the problem occurs here
-- assign :: (Functor f, Num a, Enum a) => [f b] -> [f a]
assign = zipWith (<$) [1 ..]
segment :: [Section a b] -> Maybe ([Lesson a], [Section a b])
segment [] = Nothing
segment (x : xs) = Just . first (concatMap lessons . (x :))
$ span (not . reset) xs
assemble :: [Section a b] -> [Lesson c] -> [Section c b]
assemble [] _ = []
assemble (x : xs) ls =
let (new, rest) = splitAt (length $ lessons x) ls
in x { lessons = new } : assemble xs rest
solve :: [Section () ()] -> [Section Int Int]
solve = assign . (assemble <*> (concatMap assign . unfoldr segment))
It type checked with the type signature but fails if I comment it out. But when I use :t
to check assign
's inferred type it’s exactly the same as the signature.
I’m afraid it is caused by the ‘ad-hoc polymorphism’ but I can’t figure out why.