2. Functors, Applicatives, Readers, Traversals

Haskell Mini-Course: Functors, Applicatives, Readers, Traversals — with a Working Example

Download English Pdf | Download French Pdf

French Section is below!

Table of Contents

1. Overview
2. The Code (verbatim)
3. Part A — Either: parsing & validation
4. Part B — Reader (aka (-> r)): Functor/Applicative/Monad in action
5. Part C — traverse / sequence: flipping and collecting effects
6. Part D — Mix & Match: Either + Reader + rendering
7. Add-on 1 — Validation applicative that accumulates errors
8. Add-on 2 — ReaderT + Either: a tiny app stack
9. Add-on 3 — Functor law sanity checks (no QuickCheck needed)
10. Add-on 4 — Reader utilities: ask/asks/local
11. Add-on 5 — traverse_ implementations (recursive, foldr, foldMap)
12. Glossary of Terms

---

1) Overview

This tutorial walks through a single Haskell module that demonstrates:

• Either for error-aware computations,
• Reader for environment-dependent computations (as plain functions and as Reader/ReaderT),
• Functors/Applicatives/Monads via concrete, readable examples,
• Traversals (traverse, sequence) to turn lists of effects into effectful lists,
• A custom Validation applicative that accumulates errors (instead of failing fast),
• Multiple ways to implement traverse_ for sequencing effects while discarding results.

Everything is self-contained and compiles as one file.

---

2) The Code (verbatim)

{-# OPTIONS_GHC -Wall #-}
module Main where

import Control.Applicative (liftA2, (*>))
import Data.List.NonEmpty (NonEmpty(..))
import Text.Read (readMaybe)

-- Reader (plain) utilities
import Control.Monad.Reader (Reader, asks, local, runReader)
-- ReaderT transformer (qualified to avoid name clashes)
import qualified Control.Monad.Trans.Reader as RT
import Control.Monad.Trans.Class (lift)
import Data.Foldable (foldMap)

----------------------------------------------------------------
-- Part A — Either
----------------------------------------------------------------

-- (3) readPositive
readPositive :: String -> Either String Int
readPositive s =
  case readMaybe s of
    Nothing -> Left ("not an Int: " ++ s)
    Just n  -> if n > 0 then Right n else Left ("non-positive: " ++ s)

-- (4) mkRange
mkRange :: String -> String -> Either String (Int,Int)
mkRange loS hiS =
  liftA2 (,) (readPositive loS) (readPositive hiS) >>= \(lo,hi) ->
    if lo < hi then Right (lo,hi) else Left "invalid range: lo>=hi"

-- (5) parseAll
parseAll :: [String] -> Either String [Int]
parseAll = traverse readPositive

----------------------------------------------------------------
-- Part B — Reader (as (-> r))
----------------------------------------------------------------

-- (6) incEnv
incEnv :: Int -> Int
incEnv = fmap (+1) id

-- (7) Applicative combine: Env greeting (curried greet)
data Env = Env { firstName :: String, lastName :: String } deriving Show

greet :: String -> String -> String
greet first last = "Hi " ++ first ++ " " ++ last

fullGreeting :: Env -> String
fullGreeting = greet <$> firstName <*> lastName

-- (8) Reader monad composition
data Cfg = Cfg { base :: Int, factor :: Int } deriving Show

step1 :: Cfg -> Int
step1 = base

step2 :: Int -> Cfg -> Int
step2 x cfg = x * factor cfg

step3 :: Int -> Cfg -> String
step3 x _ = "result=" ++ show x

pipeline :: Cfg -> String
pipeline = step1 >>= step2 >>= step3   -- (-> Cfg) monad

-- (9) local environment tweak (pure functions)
priceWithTax :: Double -> (Double -> Double)
priceWithTax taxRate = \basePrice -> basePrice * (1 + taxRate)

total :: Double -> Double -> Double
total tax basePrice = priceWithTax tax basePrice

totalDiscounted :: Double -> Double -> Double
totalDiscounted tax basePrice = priceWithTax (tax * 0.9) basePrice

----------------------------------------------------------------
-- Part C — traverse / sequence
----------------------------------------------------------------

safeDiv :: Int -> Int -> Maybe Int
safeDiv _ 0 = Nothing
safeDiv x y = Just (x `div` y)

----------------------------------------------------------------
-- Part D — Mix & Match
----------------------------------------------------------------

lookupKey :: String -> ([(String, Int)] -> Either String Int)
lookupKey k env =
  case lookup k env of
    Nothing -> Left ("missing: " ++ k)
    Just v  -> Right v

type Assoc = [(String, Int)]

need :: [String] -> (Assoc -> Either String [Int])
need ks env = traverse (\k -> lookupKey k env) ks

data C = C { low :: Int, high :: Int } deriving Show

mkC :: Int -> Int -> Either String C
mkC l h | l < h     = Right (C l h)
        | otherwise = Left "low>=high"

render :: C -> String
render c = "range: [" ++ show (low c) ++ ", " ++ show (high c) ++ ")"

build :: (Int, Int) -> (C -> String)
build (l,h) =
  case mkC l h of
    Left e  -> const ("error: " ++ e)
    Right c -> const (render c)

-- (20) traverse_ (custom)
traverse_ :: Applicative f => (a -> f b) -> [a] -> f ()
traverse_ _ []     = pure ()
traverse_ g (x:xs) = g x *> traverse_ g xs

----------------------------------------------------------------
-- Add-on 1: Validation style Applicative that accumulates errors
----------------------------------------------------------------

data V e a = Failure e | Success a
  deriving (Show, Eq)

instance Functor (V e) where
  fmap f (Success a)  = Success (f a)
  fmap _ (Failure e)  = Failure e

instance Semigroup e => Applicative (V e) where
  pure = Success
  Success f <*> Success a = Success (f a)
  Failure e1 <*> Failure e2 = Failure (e1 <> e2)
  Failure e  <*> _          = Failure e
  _          <*> Failure e  = Failure e

-- A helper to lift String messages into NonEmpty
one :: a -> NonEmpty a
one x = x :| []

readPositiveV :: String -> V (NonEmpty String) Int
readPositiveV s =
  case readMaybe s of
    Nothing -> Failure (one ("not an Int: " ++ s))
    Just n  -> if n > 0 then Success n else Failure (one ("non-positive: " ++ s))

-- Combine two validated fields, then check a cross-field invariant
mkRangeV :: String -> String -> V (NonEmpty String) (Int, Int)
mkRangeV loS hiS =
  case liftA2 (,) (readPositiveV loS) (readPositiveV hiS) of
    Failure es      -> Failure es
    Success (lo,hi) -> if lo < hi
                         then Success (lo,hi)
                         else Failure (one "invalid range: lo>=hi")

----------------------------------------------------------------
-- Add-on 2: ReaderT + Either composition
----------------------------------------------------------------

type App e r a = RT.ReaderT r (Either e) a

askAssoc :: App String Assoc Assoc
askAssoc = RT.ask

needKeyT :: String -> App String Assoc Int
needKeyT k = do
  env <- RT.ask
  case lookup k env of
    Nothing -> lift (Left ("missing: " ++ k))
    Just v  -> pure v

needAllT :: [String] -> App String Assoc [Int]
needAllT = traverse needKeyT

----------------------------------------------------------------
-- Add-on 3: QuickCheck-style notes (kept simple & runnable without QuickCheck)
----------------------------------------------------------------

-- We show the Functor laws on a few concrete examples
functorIdTests :: IO ()
functorIdTests = do
  putStrLn "Functor identity law (Maybe):"
  print (fmap id (Just 5) == (Just 5))
  print (fmap id (Nothing :: Maybe Int) == Nothing)

functorCompTests :: IO ()
functorCompTests = do
  putStrLn "Functor composition law (Maybe):"
  let f = (+1); g = (*2)
  print (fmap (f . g) (Just 10) == (fmap f . fmap g) (Just 10))
  print (fmap (f . g) (Nothing :: Maybe Int) == (fmap f . fmap g) (Nothing :: Maybe Int))

{-
-- If you want real QuickCheck, uncomment and add quickcheck to your build:
import Test.QuickCheck
prop_Functor_Id :: Maybe Int -> Bool
prop_Functor_Id x = fmap id x == x

prop_Functor_Comp :: Fun Int Int -> Fun Int Int -> Maybe Int -> Bool
prop_Functor_Comp (Fun _ f) (Fun _ g) x =
  fmap (f . g) x == (fmap f . fmap g) x
-}

----------------------------------------------------------------
-- Add-on 4: Reader newtype demo with ask/asks/local
----------------------------------------------------------------

fullGreetingR :: Reader Env String
fullGreetingR = do
  f <- asks firstName
  l <- asks lastName
  pure (greet f l)

promoGreeting :: Reader Env String
promoGreeting =
  local (\e -> e { lastName = lastName e ++ " (VIP)" }) fullGreetingR

----------------------------------------------------------------
-- Add-on 5: traverse_ via foldMap (alternative implementation)
----------------------------------------------------------------

traverse_foldMap_ :: (Applicative f, Monoid (f ())) => (a -> f b) -> [a] -> f ()
traverse_foldMap_ g = foldMap (\x -> g x *> pure ())

----------------------------------------------------------------
-- Alternate styles (point-free / do-notation where it helps)
----------------------------------------------------------------

-- A3-alt) readPositive (point-free-ish helper)
readPositivePF :: String -> Either String Int
readPositivePF = maybeErr . readMaybe
  where
    maybeErr Nothing  = Left "not an Int"
    maybeErr (Just n) = if n > 0 then Right n else Left "non-positive"

-- A4-alt) mkRange using do-notation
mkRangeDo :: String -> String -> Either String (Int,Int)
mkRangeDo loS hiS = do
  lo <- readPositive loS
  hi <- readPositive hiS
  if lo < hi then pure (lo,hi) else Left "invalid range: lo>=hi"

-- B7-alt) fullGreeting point-free (same shape as fullGreeting)
fullGreetingPF :: Env -> String
fullGreetingPF = greet <$> firstName <*> lastName

-- B8-alt) pipeline with explicit composition
pipelinePF :: Cfg -> String
pipelinePF cfg = step3 (step2 (step1 cfg) cfg) cfg

-- C12-alt) traverse with safeDiv (same but explicit)
safeDivs :: [Int] -> Maybe [Int]
safeDivs = traverse (safeDiv 100)

-- D15-alt) lookupKey using maybe
lookupKeyPF :: String -> (Assoc -> Either String Int)
lookupKeyPF k env = maybe (Left ("missing: " ++ k)) Right (lookup k env)

-- D16-alt) need (more point-free)
needPF :: [String] -> (Assoc -> Either String [Int])
needPF ks env = traverse (`lookupKey` env) ks

-- D20-alt) traverse_ using foldr
traverse_foldr :: Applicative f => (a -> f b) -> [a] -> f ()
traverse_foldr g = foldr (\x acc -> g x *> acc) (pure ())

----------------------------------------------------------------
-- Demo helpers
----------------------------------------------------------------

sep :: String -> IO ()
sep title = putStrLn ("\n--- " ++ title ++ " ---")

showEitherList :: Show a => Either String [a] -> String
showEitherList (Left e)  = "Left " ++ show e
showEitherList (Right x) = "Right " ++ show x

main :: IO ()
main = do
  sep "Part A — Either"
  print (fmap (+1) (Right 4 :: Either String Int))
  print (fmap (+1) (Left "err" :: Either String Int))
  print (Right 3 >>= (\x -> Right (x*10) :: Either String Int))
  print (Left "bad" >>= (\x -> Right (x*10) :: Either String Int))
  print (liftA2 (+) (Left "A") (Left "B") :: Either String Int)

  print (readPositive "10")
  print (readPositive "0")
  print (readPositive "abc")
  print (mkRange "2" "5")
  print (mkRange "5" "2")
  putStrLn (showEitherList (parseAll ["3","2","x","5"]))
  putStrLn (showEitherList (parseAll ["3","2","5"]))

  sep "Part B — Reader"
  print (incEnv 41)  -- 42
  print (fullGreeting (Env "Ada" "Lovelace"))
  putStrLn (pipeline (Cfg 3 7))
  print (total 0.15 100)
  print (totalDiscounted 0.15 100)

  sep "Part C — traverse / sequence"
  print (sequence [Just 1, Just 2, Just 3])
  print (sequence [Just 1, Nothing, Just 3])
  print (traverse (safeDiv 100) [5,4,0,2])

  sep "Part D — Mix & Match"
  let env = [("a",10),("b",20)] :: Assoc
  print (lookupKey "a" env)
  print (lookupKey "c" env)
  print (need ["a","b"] env)
  print (need ["a","z"] env)
  putStrLn (render (C 1 4))
  putStrLn (build (1,4) (C 100 200))
  putStrLn (build (4,1) (C 100 200))

  sep "Add-on 1 — Validation (accumulating)"
  print (readPositiveV "10")
  print (readPositiveV "0")
  print (mkRangeV "2" "5")
  print (mkRangeV "0" "x")   -- two errors accumulated

  sep "Add-on 2 — ReaderT + Either"
  let assoc = [("a",1),("b",2)] :: Assoc
  print (RT.runReaderT (needAllT ["a","b"]) assoc)
  print (RT.runReaderT (needAllT ["a","z"]) assoc)

  sep "Add-on 3 — QuickCheck-style sanity checks"
  functorIdTests
  functorCompTests

  sep "Add-on 4 — Reader ask/asks/local"
  print (runReader fullGreetingR (Env "Grace" "Hopper"))
  print (runReader promoGreeting (Env "Grace" "Hopper"))

  sep "Add-on 5 — traverse_ variants"
  print (traverse_ (\n -> if n>0 then Just () else Nothing) [1,2,3])
  print (traverse_ (\n -> if n>0 then Just () else Nothing) [1,0,3])
  print (traverse_foldMap_ (\n -> if n>0 then Just () else Nothing) [1,2,3])
  print (traverse_foldr (\n -> if n>0 then Just () else Nothing) [1,2,3])

  putStrLn "Done."

---

3) Part A — Either: parsing & validation

• readPositive parses String -> Either String Int. On bad parse, returns Left "not an Int: …". On non-positive, returns Left "non-positive: …". Otherwise Right n. Takeaway: Either e a models computations that can fail with an informative error.
• mkRange composes two readPositive calls using liftA2 (,) (Applicative) to build a pair (lo,hi), then uses >>= to check lo < hi. Pattern: Use Applicative to parse independently, then Monad to enforce relationships between parsed values.
• parseAll = traverse readPositive lifts element-wise parsing into list parsing: a single failure short-circuits to Left.

---

4) Part B — Reader: Functor/Applicative/Monad in action

• incEnv = fmap (+1) id shows Functor (-> r): mapping over a function composes on its output.

• Env & greet demonstrate Applicative for functions:

  • fullGreeting = greet <$> firstName <*> lastName means “call both getters on the same Env, then feed their results to greet.”

• Cfg pipeline:

  • pipeline = step1 >>= step2 >>= step3 uses the Reader monad: each step receives the same environment (Cfg) automatically.

---

5) Part C — traverse / sequence

• safeDiv returns Nothing on division by zero.
• traverse (safeDiv 100) [5,4,0,2] yields Nothing at the first 0. Rule: With Maybe, traverse fails fast; with Either, it returns the first Left.

---

6) Part D — Mix & Match

• lookupKey :: String -> (Assoc -> Either String Int) is a Reader of an association list that may fail (Either) if the key is missing.

• need :: [String] -> (Assoc -> Either String [Int]) uses traverse to batch lookups: first missing key stops the process.

• C + mkC + render + build:

  • mkC validates low < high.
  • build turns a possibly failing construction into a total renderer function by capturing either an error message or a ready-to-use render. This cleanly separates validation from use.

---

7) Add-on 1 — Validation applicative (accumulating errors)

• V e a = Failure e | Success a with Applicative instance that combines errors via (<>) (requires Semigroup e).
• With NonEmpty String, readPositiveV and mkRangeV can collect multiple errors at once, e.g., both endpoints invalid.

---

8) Add-on 2 — ReaderT + Either

• type App e r a = ReaderT r (Either e) a: a tiny app monad with configuration (r) and fail-with-message (Either e).
• needKeyT reads the environment (RT.ask) and lifts failures via lift (Left ...).
• needAllT composes many needKeyT operations with traverse. Pattern: A very common real-world stack.

---

9) Add-on 3 — Functor law sanity checks

• functorIdTests checks fmap id == id for Maybe.
• functorCompTests checks fmap (f . g) == fmap f . fmap g. These are quick, executable sanity checks. (Commented QuickCheck props show how you’d property-test them.)

---

10) Add-on 4 — Reader utilities

• fullGreetingR uses asks to pull fields; promoGreeting uses local to temporarily tweak the environment (append “(VIP)” to lastName). Key idea: local = “run a computation under a modified environment.”

---

11) Add-on 5 — traverse_ implementations

• Recursive version: traverse_ g (x:xs) = g x *> traverse_ g xs — sequences effects, discards values.

• foldr version: traverse_foldr g = foldr (\x acc -> g x *> acc) (pure ()) — same behavior via folding.

• foldMap version:

  traverse_foldMap_ :: (Applicative f, Monoid (f ())) => (a -> f b) -> [a] -> f ()
  traverse_foldMap_ g = foldMap (\x -> g x *> pure ())

  Requires Monoid (f ()) because foldMap aggregates monoidal results.

---

12) Glossary of Terms

• Functor: Things you can map over. fmap :: (a -> b) -> f a -> f b.
• Applicative: Functors that support function application in a context. (<*>), pure, and helpers like liftA2. Great for independent effects/validations.
• Monad: Applicatives that support dependent sequencing via (>>=) (“bind”).
• Reader: A pattern for environment-passing computations. Plain functions r -> a form a Reader functor/applicative/monad.
• ReaderT: Monad transformer adding a read-only environment to another effect (here, Either e).
• Either e a: Error-aware computation. Left e = error, Right a = success.
• Maybe a: Partial computation. Nothing = failure, Just a = success.
• traverse: Map a function producing effects over a structure, then flip the structure and the effect: traverse :: Applicative f => (a -> f b) -> t a -> f (t b).
• sequence: sequence :: Applicative f => t (f a) -> f (t a); the special case of traverse id.
• liftA2: Lift a binary function into an Applicative context, combining two effectful arguments.
• (<$>) / (<*>) / (*>): Infix aliases for fmap, applicative apply, and sequencing (discarding left value).
• asks / ask / local: Read parts of the environment; temporarily run under a modified environment.
• NonEmpty: A list guaranteed to have at least one element — perfect for aggregating one-or-more errors.
• Semigroup / Monoid: Types you can combine with (<>); Monoids also have an identity mempty. Used here to accumulate validation errors.
• foldMap: Map each element to a monoid and combine them — used for the foldMap-based traverse_.

Super — voici la version française et son PDF. Le code ci-dessous est repris verbatim (inchangé), comme demandé.

Mini-cours Haskell : Foncteurs, Applicatifs, Reader, Traversals — avec un exemple qui compile

Table des matières

1. Vue d’ensemble
2. Le code (verbatim – ne pas modifier)
3. Partie A — Either : analyse & validation
4. Partie B — Reader (fonctions (-> r)) : Functor/Applicative/Monad
5. Partie C — traverse / sequence : inversion structure/effet
6. Partie D — Mix & Match : Either + Reader + rendu
7. Module additionnel 1 — Applicative « Validation » (accumulation d’erreurs)
8. Module additionnel 2 — ReaderT + Either : mini pile applicative
9. Module additionnel 3 — Sanity checks des lois de foncteur
10. Module additionnel 4 — Utilitaires Reader : asks / local
11. Module additionnel 5 — Variantes de traverse_
12. Glossaire

---

1) Vue d’ensemble

Ce tutoriel montre, dans un seul module Haskell, comment :

• utiliser Either pour parser et valider avec messages d’erreur (échec immédiat) ;
• écrire du code dépendant d’un environnement avec des fonctions (r -> a), puis avec Reader/ReaderT ;
• mettre en pratique Functor / Applicative / Monad et savoir quand choisir l’un ou l’autre ;
• employer traverse / sequence pour « retourner » structure et effet et agréger les résultats ;
• construire une Applicative de Validation qui accumule plusieurs erreurs (au lieu de s’arrêter à la première).

---

2) Le code (verbatim – ne pas modifier)

{-# OPTIONS_GHC -Wall #-}
module Main where

import Control.Applicative (liftA2, (*>))
import Data.List.NonEmpty (NonEmpty(..))
import Text.Read (readMaybe)

-- Reader (plain) utilities
import Control.Monad.Reader (Reader, asks, local, runReader)
-- ReaderT transformer (qualified to avoid name clashes)
import qualified Control.Monad.Trans.Reader as RT
import Control.Monad.Trans.Class (lift)
import Data.Foldable (foldMap)

----------------------------------------------------------------
-- Part A — Either
----------------------------------------------------------------

-- (3) readPositive
readPositive :: String -> Either String Int
readPositive s =
  case readMaybe s of
    Nothing -> Left ("not an Int: " ++ s)
    Just n  -> if n > 0 then Right n else Left ("non-positive: " ++ s)

-- (4) mkRange
mkRange :: String -> String -> Either String (Int,Int)
mkRange loS hiS =
  liftA2 (,) (readPositive loS) (readPositive hiS) >>= \(lo,hi) ->
    if lo < hi then Right (lo,hi) else Left "invalid range: lo>=hi"

-- (5) parseAll
parseAll :: [String] -> Either String [Int]
parseAll = traverse readPositive

----------------------------------------------------------------
-- Part B — Reader (as (-> r))
----------------------------------------------------------------

-- (6) incEnv
incEnv :: Int -> Int
incEnv = fmap (+1) id

-- (7) Applicative combine: Env greeting (curried greet)
data Env = Env { firstName :: String, lastName :: String } deriving Show

greet :: String -> String -> String
greet first last = "Hi " ++ first ++ " " ++ last

fullGreeting :: Env -> String
fullGreeting = greet <$> firstName <*> lastName

-- (8) Reader monad composition
data Cfg = Cfg { base :: Int, factor :: Int } deriving Show

step1 :: Cfg -> Int
step1 = base

step2 :: Int -> Cfg -> Int
step2 x cfg = x * factor cfg

step3 :: Int -> Cfg -> String
step3 x _ = "result=" ++ show x

pipeline :: Cfg -> String
pipeline = step1 >>= step2 >>= step3   -- (-> Cfg) monad

-- (9) local environment tweak (pure functions)
priceWithTax :: Double -> (Double -> Double)
priceWithTax taxRate = \basePrice -> basePrice * (1 + taxRate)

total :: Double -> Double -> Double
total tax basePrice = priceWithTax tax basePrice

totalDiscounted :: Double -> Double -> Double
totalDiscounted tax basePrice = priceWithTax (tax * 0.9) basePrice

----------------------------------------------------------------
-- Part C — traverse / sequence
----------------------------------------------------------------

safeDiv :: Int -> Int -> Maybe Int
safeDiv _ 0 = Nothing
safeDiv x y = Just (x `div` y)

----------------------------------------------------------------
-- Part D — Mix & Match
----------------------------------------------------------------

lookupKey :: String -> ([(String, Int)] -> Either String Int)
lookupKey k env =
  case lookup k env of
    Nothing -> Left ("missing: " ++ k)
    Just v  -> Right v

type Assoc = [(String, Int)]

need :: [String] -> (Assoc -> Either String [Int])
need ks env = traverse (\k -> lookupKey k env) ks

data C = C { low :: Int, high :: Int } deriving Show

mkC :: Int -> Int -> Either String C
mkC l h | l < h     = Right (C l h)
        | otherwise = Left "low>=high"

render :: C -> String
render c = "range: [" ++ show (low c) ++ ", " ++ show (high c) ++ ")"

build :: (Int, Int) -> (C -> String)
build (l,h) =
  case mkC l h of
    Left e  -> const ("error: " ++ e)
    Right c -> const (render c)

-- (20) traverse_ (custom)
traverse_ :: Applicative f => (a -> f b) -> [a] -> f ()
traverse_ _ []     = pure ()
traverse_ g (x:xs) = g x *> traverse_ g xs

----------------------------------------------------------------
-- Add-on 1: Validation style Applicative that accumulates errors
----------------------------------------------------------------

data V e a = Failure e | Success a
  deriving (Show, Eq)

instance Functor (V e) where
  fmap f (Success a)  = Success (f a)
  fmap _ (Failure e)  = Failure e

instance Semigroup e => Applicative (V e) where
  pure = Success
  Success f <*> Success a = Success (f a)
  Failure e1 <*> Failure e2 = Failure (e1 <> e2)
  Failure e  <*> _          = Failure e
  _          <*> Failure e  = Failure e

-- A helper to lift String messages into NonEmpty
one :: a -> NonEmpty a
one x = x :| []

readPositiveV :: String -> V (NonEmpty String) Int
readPositiveV s =
  case readMaybe s of
    Nothing -> Failure (one ("not an Int: " ++ s))
    Just n  -> if n > 0 then Success n else Failure (one ("non-positive: " ++ s))

-- Combine two validated fields, then check a cross-field invariant
mkRangeV :: String -> String -> V (NonEmpty String) (Int, Int)
mkRangeV loS hiS =
  case liftA2 (,) (readPositiveV loS) (readPositiveV hiS) of
    Failure es      -> Failure es
    Success (lo,hi) -> if lo < hi
                         then Success (lo,hi)
                         else Failure (one "invalid range: lo>=hi")

----------------------------------------------------------------
-- Add-on 2: ReaderT + Either composition
----------------------------------------------------------------

type App e r a = RT.ReaderT r (Either e) a

askAssoc :: App String Assoc Assoc
askAssoc = RT.ask

needKeyT :: String -> App String Assoc Int
needKeyT k = do
  env <- RT.ask
  case lookup k env of
    Nothing -> lift (Left ("missing: " ++ k))
    Just v  -> pure v

needAllT :: [String] -> App String Assoc [Int]
needAllT = traverse needKeyT

----------------------------------------------------------------
-- Add-on 3: QuickCheck-style notes (kept simple & runnable without QuickCheck)
----------------------------------------------------------------

-- We show the Functor laws on a few concrete examples
functorIdTests :: IO ()
functorIdTests = do
  putStrLn "Functor identity law (Maybe):"
  print (fmap id (Just 5) == (Just 5))
  print (fmap id (Nothing :: Maybe Int) == Nothing)

functorCompTests :: IO ()
functorCompTests = do
  putStrLn "Functor composition law (Maybe):"
  let f = (+1); g = (*2)
  print (fmap (f . g) (Just 10) == (fmap f . fmap g) (Just 10))
  print (fmap (f . g) (Nothing :: Maybe Int) == (fmap f . fmap g) (Nothing :: Maybe Int))

{-
-- If you want real QuickCheck, uncomment and add quickcheck to your build:
import Test.QuickCheck
prop_Functor_Id :: Maybe Int -> Bool
prop_Functor_Id x = fmap id x == x

prop_Functor_Comp :: Fun Int Int -> Fun Int Int -> Maybe Int -> Bool
prop_Functor_Comp (Fun _ f) (Fun _ g) x =
  fmap (f . g) x == (fmap f . fmap g) x
-}

----------------------------------------------------------------
-- Add-on 4: Reader newtype demo with ask/asks/local
----------------------------------------------------------------

fullGreetingR :: Reader Env String
fullGreetingR = do
  f <- asks firstName
  l <- asks lastName
  pure (greet f l)

promoGreeting :: Reader Env String
promoGreeting =
  local (\e -> e { lastName = lastName e ++ " (VIP)" }) fullGreetingR

----------------------------------------------------------------
-- Add-on 5: traverse_ via foldMap (alternative implementation)
----------------------------------------------------------------

traverse_foldMap_ :: (Applicative f, Monoid (f ())) => (a -> f b) -> [a] -> f ()
traverse_foldMap_ g = foldMap (\x -> g x *> pure ())

----------------------------------------------------------------
-- Alternate styles (point-free / do-notation where it helps)
----------------------------------------------------------------

-- A3-alt) readPositive (point-free-ish helper)
readPositivePF :: String -> Either String Int
readPositivePF = maybeErr . readMaybe
  where
    maybeErr Nothing  = Left "not an Int"
    maybeErr (Just n) = if n > 0 then Right n else Left "non-positive"

-- A4-alt) mkRange using do-notation
mkRangeDo :: String -> String -> Either String (Int,Int)
mkRangeDo loS hiS = do
  lo <- readPositive loS
  hi <- readPositive hiS
  if lo < hi then pure (lo,hi) else Left "invalid range: lo>=hi"

-- B7-alt) fullGreeting point-free (same shape as fullGreeting)
fullGreetingPF :: Env -> String
fullGreetingPF = greet <$> firstName <*> lastName

-- B8-alt) pipeline with explicit composition
pipelinePF :: Cfg -> String
pipelinePF cfg = step3 (step2 (step1 cfg) cfg) cfg

-- C12-alt) traverse with safeDiv (same but explicit)
safeDivs :: [Int] -> Maybe [Int]
safeDivs = traverse (safeDiv 100)

-- D15-alt) lookupKey using maybe
lookupKeyPF :: String -> (Assoc -> Either String Int)
lookupKeyPF k env = maybe (Left ("missing: " ++ k)) Right (lookup k env)

-- D16-alt) need (more point-free)
needPF :: [String] -> (Assoc -> Either String [Int])
needPF ks env = traverse (`lookupKey` env) ks

-- D20-alt) traverse_ using foldr
traverse_foldr :: Applicative f => (a -> f b) -> [a] -> f ()
traverse_foldr g = foldr (\x acc -> g x *> acc) (pure ())

----------------------------------------------------------------
-- Demo helpers
----------------------------------------------------------------

sep :: String -> IO ()
sep title = putStrLn ("\n--- " ++ title ++ " ---")

showEitherList :: Show a => Either String [a] -> String
showEitherList (Left e)  = "Left " ++ show e
showEitherList (Right x) = "Right " ++ show x

main :: IO ()
main = do
  sep "Part A — Either"
  print (fmap (+1) (Right 4 :: Either String Int))
  print (fmap (+1) (Left "err" :: Either String Int))
  print (Right 3 >>= (\x -> Right (x*10) :: Either String Int))
  print (Left "bad" >>= (\x -> Right (x*10) :: Either String Int))
  print (liftA2 (+) (Left "A") (Left "B") :: Either String Int)

  print (readPositive "10")
  print (readPositive "0")
  print (readPositive "abc")
  print (mkRange "2" "5")
  print (mkRange "5" "2")
  putStrLn (showEitherList (parseAll ["3","2","x","5"]))
  putStrLn (showEitherList (parseAll ["3","2","5"]))

  sep "Part B — Reader"
  print (incEnv 41)  -- 42
  print (fullGreeting (Env "Ada" "Lovelace"))
  putStrLn (pipeline (Cfg 3 7))
  print (total 0.15 100)
  print (totalDiscounted 0.15 100)

  sep "Part C — traverse / sequence"
  print (sequence [Just 1, Just 2, Just 3])
  print (sequence [Just 1, Nothing, Just 3])
  print (traverse (safeDiv 100) [5,4,0,2])

  sep "Part D — Mix & Match"
  let env = [("a",10),("b",20)] :: Assoc
  print (lookupKey "a" env)
  print (lookupKey "c" env)
  print (need ["a","b"] env)
  print (need ["a","z"] env)
  putStrLn (render (C 1 4))
  putStrLn (build (1,4) (C 100 200))
  putStrLn (build (4,1) (C 100 200))

  sep "Add-on 1 — Validation (accumulating)"
  print (readPositiveV "10")
  print (readPositiveV "0")
  print (mkRangeV "2" "5")
  print (mkRangeV "0" "x")   -- two errors accumulated

  sep "Add-on 2 — ReaderT + Either"
  let assoc = [("a",1),("b",2)] :: Assoc
  print (RT.runReaderT (needAllT ["a","b"]) assoc)
  print (RT.runReaderT (needAllT ["a","z"]) assoc)

  sep "Add-on 3 — QuickCheck-style sanity checks"
  functorIdTests
  functorCompTests

  sep "Add-on 4 — Reader ask/asks/local"
  print (runReader fullGreetingR (Env "Grace" "Hopper"))
  print (runReader promoGreeting (Env "Grace" "Hopper"))

  sep "Add-on 5 — traverse_ variants"
  print (traverse_ (\n -> if n>0 then Just () else Nothing) [1,2,3])
  print (traverse_ (\n -> if n>0 then Just () else Nothing) [1,0,3])
  print (traverse_foldMap_ (\n -> if n>0 then Just () else Nothing) [1,2,3])
  print (traverse_foldr (\n -> if n>0 then Just () else Nothing) [1,2,3])

  putStrLn "Done."

---

3) Partie A — Either : analyse & validation

• readPositive : String -> Either String Int. En cas d’échec de parse → Left, en cas d’entier ≤ 0 → Left, sinon Right n.
• mkRange : liftA2 (,) parse indépendamment les deux bornes ; ensuite >>= vérifie lo < hi.
• parseAll = traverse readPositive : remonte la première erreur sur une liste.

4) Partie B — Reader

• incEnv = fmap (+1) id : fmap sur (-> r) compose la fonction de sortie.
• fullGreeting = greet <$> firstName <*> lastName : applique le même Env aux deux getters et les donne à greet.
• pipeline = step1 >>= step2 >>= step3 : le Reader monad file le même Cfg.

5) Partie C — traverse / sequence

• safeDiv renvoie Nothing sur division par zéro.
• traverse (safeDiv 100) [5,4,0,2] → Nothing au premier 0. Avec Either, on récupère le premier Left.

6) Partie D — Mix & Match

• lookupKey lit dans l’environnement (Assoc) et peut échouer (Left).
• need regroupe plusieurs lectures avec traverse.
• mkC + render + build séparent validation (qui peut échouer) et affichage pur.

7) Module additionnel 1 — Validation (accumulation)

• V e a cumule les erreurs via (<>) (nécessite Semigroup e, ici NonEmpty String).
• mkRangeV peut renvoyer plusieurs messages d’erreur.

8) Module additionnel 2 — ReaderT + Either

• type App e r a = ReaderT r (Either e) a : configuration + erreurs.
• needAllT compose des lectures dépendantes via traverse.

9) Module additionnel 3 — Lois de foncteur

• Vérifie fmap id == id et la composition sur Maybe (exécutables sans QuickCheck).

10) Module additionnel 4 — Reader utils

• asks extrait un champ ; local exécute sous un env temporairement modifié.

11) Module additionnel 5 — traverse_

• Récursif et foldr : nécessitent seulement Applicative.
• foldMap : demande Monoid (f ()) car foldMap agrège par monoïde.

---

12) Glossaire

• Functor : supporte fmap :: (a -> b) -> f a -> f b.
• Applicative : applique des fonctions contextuelles (<*>, liftA2).
• Monad : chaînage dépendant via (>>=).
• Reader : passage d’environnement avec des fonctions r -> a.
• ReaderT : ajoute un environnement à un autre effet.
• Either : Left e (erreur) / Right a (succès).
• Maybe : Nothing (échec) / Just a (succès).
• traverse : map + inversion effet/structure.
• sequence : inversion t (f a) → f (t a).
• NonEmpty : liste non vide (pratique pour ≥ 1 erreur).
• Semigroup / Monoid : combinaison par (<>) ; Monoid a mempty.

---