{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE RankNTypes             #-}

-- | A monadic interface to configurable pretty-printing.

module Text.PrettyBy.Monad
    ( HasPrettyConfig (..)
    , MonadPretty
    , prettyM
    , displayM
    ) where

import Text.Pretty
import Text.PrettyBy.Default
import Text.PrettyBy.Internal
import Text.PrettyBy.Internal.Utils

import Control.Monad.Reader
import Lens.Micro

-- | A constraint for \"@config@ is a part of @env@\".
class HasPrettyConfig env config | env -> config where
    prettyConfig :: Lens' env config

-- @env@ is an artefact of the encoding, it shouldn't be necessary as @m@ determines what it is
-- and we're not interested in reflecting @env@ explicitly (unlike @config@, which is also
-- determined by @m@ through @env@, but is useful to have explicitly). But GHC does not like it
-- when @env@ is left implicit, see https://gitlab.haskell.org/ghc/ghc/issues/3490
-- | A constraint for \"@m@ is a monad that allows to pretty-print values in it by a @config@\".
type MonadPretty config env m = (MonadReader env m, HasPrettyConfig env config)

-- | Pretty-print a value in a configurable way in a monad holding a config.
prettyM :: (MonadPretty config env m, PrettyBy config a) => a -> m (Doc ann)
prettyM :: a -> m (Doc ann)
prettyM a
x = (config -> a -> Doc ann) -> a -> config -> Doc ann
forall a b c. (a -> b -> c) -> b -> a -> c
flip config -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy a
x (config -> Doc ann) -> m config -> m (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting config env config -> m config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting config env config
forall env config. HasPrettyConfig env config => Lens' env config
prettyConfig

-- | Pretty-print and render a value as a string type in a configurable way in a monad holding
-- a config.
displayM
    :: forall str a m env config. (MonadPretty config env m, PrettyBy config a, Render str)
    => a -> m str
displayM :: a -> m str
displayM = (Doc Any -> str) -> m (Doc Any) -> m str
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Any -> str
forall str ann. Render str => Doc ann -> str
render (m (Doc Any) -> m str) -> (a -> m (Doc Any)) -> a -> m str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Doc Any)
forall config env (m :: * -> *) a ann.
(MonadPretty config env m, PrettyBy config a) =>
a -> m (Doc ann)
prettyM