FunctorDescription.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}

module Copar.FunctorDescription
  ( DynFunctorDescription(..)
  , FunctorParser(..)
  , FunctorDescription(..)
  , Suitable
  , ToDynFunctorDescription(..)
  , formatFunctorDescription
  , formatFunctorDescriptions
  , dynPrecedence
  , dynFunctorDescription
  )
where

import           Control.DeepSeq (NFData(..))

import           Data.Functor.Classes
import           Data.Text                      ( Text )
import           Data.Text.Prettyprint          ( Doc
                                                , (<+>)
                                                , AnsiStyle
                                                )
import qualified Data.Text.Prettyprint         as Doc

import           Data.Proxy

import           Type.Reflection

import           Copar.FunctorExpression.Printable
import           Copar.FunctorExpression.Parser
import           Copar.RefinementInterface
import           Copar.Coalgebra.Parser.Class
import           Copar.PrettyShow

type Suitable f
   = ( RefinementInterface f
     , ParseMorphism f
     , Printable f
     , Eq1 f
     , Functor f
     , FunctorDescription f
     , Foldable f
     , Typeable f
     , Traversable f
     , Show1 f
     , NFData (F1 f)
     , NFData (Label f)
     , PrettyShow (Label f)
     , PrettyShow (F1 f))

class FunctorDescription f where
  name :: Text
  syntaxExample :: Text
  description :: Maybe (Doc AnsiStyle)
  precedence :: Int
  functorExprParser :: FunctorParser f

dynFunctorDescription :: forall f. Suitable f => DynFunctorDescription
dynFunctorDescription = DynFunctorDescription (Proxy :: Proxy f)


class ToDynFunctorDescription f where
  toDynFunctorDescription :: f a -> DynFunctorDescription

data DynFunctorDescription where
  DynFunctorDescription :: Suitable f => Proxy f -> DynFunctorDescription

dynPrecedence :: DynFunctorDescription -> Int
dynPrecedence (DynFunctorDescription (Proxy :: Proxy f)) = precedence @f

formatFunctorDescription :: FunctorDescription f => Proxy f -> Doc AnsiStyle
formatFunctorDescription (Proxy :: Proxy f)= Doc.vsep
  [ Doc.annotate (Doc.bold <> Doc.underlined) (Doc.pretty (name @f))
    <+> Doc.parens (Doc.pretty (syntaxExample @f))
  , maybe mempty ((Doc.line <>) . Doc.indent 4) (description @f)
  , ""
  ]

formatFunctorDescriptions :: [DynFunctorDescription] -> Doc AnsiStyle
formatFunctorDescriptions = Doc.vsep . map (\(DynFunctorDescription proxy) -> formatFunctorDescription proxy)