DerivOptions.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GADTs           #-}
{-# LANGUAGE KindSignatures  #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MonomorphismRestriction #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS -fwarn-missing-signatures #-}

module Generics.MultiRec.TH.Alt.DerivOptions
  ( 
    SumMode(..),
    DerivOptions(..),
    defaultConstructorNameModifier
  ) where

import Language.Haskell.TH(TypeQ)
import Generics.MultiRec.Base((:+:))

data SumMode = 
      RightNested -- ^ e.g. @ a ':+:' (b ':+:' (c ':+:' d))@ 
    | Balanced    -- ^ e.g. @ (a ':+:' b) ':+:' (c ':+:' d)@
    
data DerivOptions = 
    DerivOptions {
      -- | A list of:
      --
      -- > (type (quoted), name of the proof for this type (i.e. the name of the constructor of the family GADT))
      --
      -- E.g. 
      --
      -- > data FooFam a where
      -- >      FooPrf    :: FooFam Foo
      -- >      BarStrPrf :: FooFam (Bar String)
      -- >
      -- > ... DerivOptions { 
      -- >       familyTypes = 
      -- >        [ ( [t| Foo        |], "FooPrf"   ) ], 
      -- >          ( [t| Bar String |], "BarStrPrf") ] ] 
      -- > ... 
      -- > }  
      --
      -- This defines our mutually recursive family. The types must resolve to
      -- @data@types or @newtype@s of kind @*@ (type synonyms will be expanded).
      familyTypes :: [(TypeQ,String)]
      -- | Name of the family GADT (this type has to be generated
      -- manually because TH doesn't support GADTs yet)
    , indexGadtName :: String
      -- | Scheme for producing names for the
      -- empty types corresponding to constructors. The first arg is the name
      -- of the type (as given in 'familyTypes'), the second arg is the name
      -- of the constructor (builtins will be called: @NIL@, @CONS@, @TUPLE2@, @TUPLE3@ ...)
    , constructorNameModifier :: String -> String -> String
      -- | Name of the pattern functor ('PF') to generate
    , patternFunctorName :: String
      -- | Print various informational messges?
    , verbose :: Bool
      -- | The shape for trees of ':+:'s
    , sumMode :: SumMode
    }


-- | Makes names like @CTOR_Either_Left@, @CTOR_Either_Right@ etc.
defaultConstructorNameModifier :: String -> String -> String
defaultConstructorNameModifier ty ctor = "CTOR_" ++ ty ++ "_" ++ ctor