{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Pretty-printing stuff, some of which should probably go into the main library.
module PlutusCore.Pretty.Extra
    ( PrettyParens
    , juxtRenderContext
    ) where

import PlutusPrelude

import Control.Monad.Trans.Reader
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Profunctor
import Data.Set (Set)
import Data.Set qualified as Set
import Text.PrettyBy.Fixity
import Text.PrettyBy.Internal

type instance HasPrettyDefaults (Sole config) = HasPrettyDefaults config

instance Profunctor InContextM where
    lmap
        :: forall config' config a.
           (config' -> config)
        -> InContextM config a
        -> InContextM config' a
    lmap :: forall a b c. (a -> b) -> InContextM b c -> InContextM a c
lmap = ((config' -> config) -> Reader config a -> Reader config' a)
-> (config' -> config)
-> InContextM config a
-> InContextM config' a
forall a b. Coercible a b => a -> b
coerce ((config' -> config) -> Reader config a -> Reader config' a
forall r' r a. (r' -> r) -> Reader r a -> Reader r' a
withReader :: (config' -> config) -> Reader config a -> Reader config' a)
    {-# INLINE lmap #-}

    rmap
        :: forall config a b.
           (a -> b)
        -> InContextM config a
        -> InContextM config b
    rmap :: forall config a b.
(a -> b) -> InContextM config a -> InContextM config b
rmap = ((a -> b) -> Reader config a -> Reader config b)
-> (a -> b) -> InContextM config a -> InContextM config b
forall a b. Coercible a b => a -> b
coerce ((a -> b) -> Reader config a -> Reader config b
forall a b r. (a -> b) -> Reader r a -> Reader r b
mapReader :: (a -> b) -> Reader config a -> Reader config b)
    {-# INLINE rmap #-}

-- | For pretty-printing a value with a minimum amount of parens.
type PrettyParens = PrettyBy RenderContext

-- | An initial 'RenderContext'.
-- An expression printed in this context gets enclosed in parens unless its outermost operator (if
-- any) binds even stronger than function application.
juxtRenderContext :: RenderContext
juxtRenderContext :: RenderContext
juxtRenderContext = Direction -> FixityOver Precedence -> RenderContext
forall prec. Direction -> FixityOver prec -> RenderContextOver prec
RenderContext Direction
ToTheRight FixityOver Precedence
juxtFixity

instance PrettyDefaultBy config [(k, v)] => DefaultPrettyBy config (Map k v) where
    defaultPrettyBy :: forall ann. config -> Map k v -> Doc ann
defaultPrettyBy config
config = config -> [(k, v)] -> Doc ann
forall ann. config -> [(k, v)] -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy config
config ([(k, v)] -> Doc ann)
-> (Map k v -> [(k, v)]) -> Map k v -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList
deriving via PrettyCommon (Map k v)
    instance PrettyDefaultBy config (Map k v) => PrettyBy config (Map k v)

instance PrettyDefaultBy config [a] => DefaultPrettyBy config (Set a) where
    defaultPrettyBy :: forall ann. config -> Set a -> Doc ann
defaultPrettyBy config
config = config -> [a] -> Doc ann
forall ann. config -> [a] -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy config
config ([a] -> Doc ann) -> (Set a -> [a]) -> Set a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList
deriving via PrettyCommon (Set a)
    instance PrettyDefaultBy config (Set a) => PrettyBy config (Set a)