{-# LANGUAGE UndecidableInstances, TemplateHaskell #-}

module Hyper.Type.AST.FuncType
    ( FuncType(..), funcIn, funcOut, W_FuncType(..), MorphWitness(..)
    ) where

import           Generics.Constraints (makeDerivings, makeInstances)
import           Hyper
import           Text.PrettyPrint ((<+>))
import qualified Text.PrettyPrint as Pretty
import           Text.PrettyPrint.HughesPJClass (Pretty(..), maybeParens)
import           Text.Show.Combinators ((@|), showCon)

import           Hyper.Internal.Prelude

-- | A term for the types of functions. Analogues to @(->)@ in Haskell.
--
-- @FuncType typ@s express types of functions of @typ@.
data FuncType typ h = FuncType
    { FuncType typ h -> h :# typ
_funcIn  :: h :# typ
    , FuncType typ h -> h :# typ
_funcOut :: h :# typ
    } deriving (forall x. FuncType typ h -> Rep (FuncType typ h) x)
-> (forall x. Rep (FuncType typ h) x -> FuncType typ h)
-> Generic (FuncType typ h)
forall x. Rep (FuncType typ h) x -> FuncType typ h
forall x. FuncType typ h -> Rep (FuncType typ h) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (typ :: HyperType) (h :: AHyperType) x.
Rep (FuncType typ h) x -> FuncType typ h
forall (typ :: HyperType) (h :: AHyperType) x.
FuncType typ h -> Rep (FuncType typ h) x
$cto :: forall (typ :: HyperType) (h :: AHyperType) x.
Rep (FuncType typ h) x -> FuncType typ h
$cfrom :: forall (typ :: HyperType) (h :: AHyperType) x.
FuncType typ h -> Rep (FuncType typ h) x
Generic

makeLenses ''FuncType
makeZipMatch ''FuncType
makeHContext ''FuncType
makeHMorph ''FuncType
makeHTraversableApplyAndBases ''FuncType
makeDerivings [''Eq, ''Ord] [''FuncType]
makeInstances [''Binary, ''NFData] [''FuncType]

instance Pretty (h :# typ) => Pretty (FuncType typ h) where
    pPrintPrec :: PrettyLevel -> Rational -> FuncType typ h -> Doc
pPrintPrec PrettyLevel
lvl Rational
p (FuncType h :# typ
i h :# typ
o) =
        PrettyLevel -> Rational -> (h :# typ) -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
lvl Rational
11 h :# typ
i Doc -> Doc -> Doc
<+> String -> Doc
Pretty.text String
"->" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> (h :# typ) -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
lvl Rational
10 h :# typ
o
        Doc -> (Doc -> Doc) -> Doc
forall a b. a -> (a -> b) -> b
& Bool -> Doc -> Doc
maybeParens (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
10)

instance Show (h :# typ) => Show (FuncType typ h) where
    showsPrec :: Int -> FuncType typ h -> ShowS
showsPrec Int
p (FuncType h :# typ
i h :# typ
o) = (String -> PrecShowS
showCon String
"FuncType" PrecShowS -> (h :# typ) -> PrecShowS
forall a. Show a => PrecShowS -> a -> PrecShowS
@| h :# typ
i PrecShowS -> (h :# typ) -> PrecShowS
forall a. Show a => PrecShowS -> a -> PrecShowS
@| h :# typ
o) Int
p