{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- |
-- Module:       $HEADER$
-- Description:  Type class for accessing Verbosity.
-- Copyright:    (c) 2015-2019 Peter Trško
-- License:      BSD3
--
-- Maintainer:   peter.trsko@gmail.com
-- Stability:    experimental
-- Portability:  GHC specific language extensions.
--
-- Type class for accessing 'Verbosity'.
module Data.Verbosity.Class
    (
    -- * GHC Generics Example
    --
    -- $basicUsageExample

    -- * Hand Written Instance Example
    --
    -- $handWrittenInstance

    -- * TemplateHaskell Example
    --
    -- $thUsageExample

    -- * HasVerbosity Type Class
      HasVerbosity(..)
    , getVerbosity
    , setVerbosity
    , modifyVerbosity

    -- * Verbosity Re-export
    , module Data.Verbosity
    )
  where

import Control.Applicative (Const(Const, getConst))
import Data.Function ((.), ($), const)
import Data.Functor (Functor)
import Data.Functor.Identity (Identity(Identity, runIdentity))

import Data.Generics.Product.Typed (HasType, typed)

import Data.Verbosity


class HasVerbosity s where
    -- | Lens for accessing 'Verbosity' embedded in the type @s@.
    verbosity :: Functor f => (Verbosity -> f Verbosity) -> s -> f s

    default verbosity
        :: (HasType Verbosity s, Functor f)
        => (Verbosity -> f Verbosity)
        -> s -> f s
    verbosity = typed

instance HasVerbosity Verbosity where
    verbosity = ($)

-- | Specialization of 'verbosity' lens in to getter function.
getVerbosity :: HasVerbosity s => s -> Verbosity
getVerbosity = getConst . verbosity Const

-- | Specialization of 'verbosity' lens in to setter function.
setVerbosity :: HasVerbosity s => Verbosity -> s -> s
setVerbosity v = runIdentity . verbosity (const (Identity v))

-- | Specialization of 'verbosity' lens in to modification function.
modifyVerbosity :: HasVerbosity s => (Verbosity -> Verbosity) -> s -> s
modifyVerbosity f = runIdentity . verbosity (Identity . f)

-- $basicUsageExample
--
-- Lets define simple data type that looks something like:
--
-- @
-- data Config = Config
--     { _appVerbosity :: 'Verbosity'
--     , ...
--     }
--   deriving ('GHC.Generics.Generic', Show, ...)
-- @
--
-- Type class 'HasVerbosity' uses
-- <https://hackage.haskell.org/package/generic-lens generic-lens> package and
-- @DefaultSignatures@ language extension so that we can define instance of
-- 'HasVerbosity' by simply stating:
--
-- @
-- instance 'HasVerbosity' Config
-- @
--
-- With @DerivingStrategies@ we can rewrite the above example as:
--
-- @
-- {-\# LANGUAGE DeriveAnyClass \#-}
-- {-\# LANGUAGE DeriveGeneric \#-}
-- {-\# LANGUAGE DerivingStrategies \#-}
--
-- import "GHC.Generics" ('GHC.Generics.Generic')
--
--
-- data Config = Config
--     { _appVerbosity :: 'Verbosity'
--     , ...
--     }
--   deriving stock ('GHC.Generics.Generic', Show, ...)
--   deriving anyclass ('HasVerbosity')
-- @

-- $handWrittenInstance
--
-- Lets define simple data type that looks something like:
--
-- @
-- data Config = Config
--     { _appVerbosity :: 'Verbosity'
--     , ...
--     }
--   deriving (Show, ...)
-- @
--
-- Now we can define instance of 'HasVerbosity' by hand:
--
-- @
-- instance 'HasVerbosity' Config where
--     verbosity f c@Config{_appVerbosity = a} =
--         (\\b -> c{_appVerbosity = b}) 'Data.Functor.<$>' f a
-- @

-- $thUsageExample
--
-- Package [lens](https://hackage.haskell.org/package/lens) has TemplateHaskell
-- functions that can define lenses for you:
--
-- @
-- {-\# LANGUAGE TemplateHaskell \#-}
--
-- import Control.Lens.TH (makeLenses)
--
-- data Config = Config
--     { _appVerbosity :: 'Verbosity'
--     , ...
--     }
--   deriving (Show, ...)
--
-- makeLenses ''Config
-- @
--
-- Now definition of 'HasVerbosity' instance will look like:
--
-- @
-- instance 'HasVerbosity' Config where
--     'verbosity' = appVerbosity   -- Lens generated by makeLenses.
-- @