endo-0.3.0.0: example/Example8.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}

module Main where

import Data.Functor.Identity

import Data.Monoid.Endo
import Data.Monoid.Endo.AnEndo

import Data.Default.Class (Default(def))


data Verbosity
    = Silent
    | Normal
    | Verbose
    | Annoying
  deriving (Show {- ... -})

instance Default Verbosity where
    def = Normal

class HasVerbosity s where
    verbosity :: Functor f => (Verbosity -> f Verbosity) -> s -> f s

setVerbosity :: HasVerbosity s => Verbosity -> s -> s
setVerbosity v = runIdentity . verbosity (const (Identity v))

data Config = Config
    { cfgVerbosity :: Verbosity
    -- ...
    }
  deriving (Show)

instance HasVerbosity Config where
    verbosity f cfg@Config{cfgVerbosity = v} =
        (\v' -> cfg{cfgVerbosity = v'}) <$> f v

data Action = NormalAction Config | ShowVersion | ShowHelp
  deriving (Show {- ... -})

instance Default Config where
    def = Config
        { cfgVerbosity = def
        -- ...
        }

instance Default Action where
    def = NormalAction def

instance AnEndo Verbosity where
    type EndoOperatesOn Verbosity = Action

    anEndo v = Endo $ \case
        NormalAction cfg -> NormalAction $ setVerbosity v cfg
        action           -> action