{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Hyper.Syntax.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
    { forall (typ :: HyperType) (h :: AHyperType).
FuncType typ h -> h :# typ
_funcIn :: h :# typ
    , forall (typ :: HyperType) (h :: AHyperType).
FuncType typ h -> h :# typ
_funcOut :: h :# typ
    }
    deriving (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) =
        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
<+> forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
lvl Rational
10 h :# typ
o
            forall a b. a -> (a -> b) -> b
& Bool -> Doc -> Doc
maybeParens (Rational
p 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" forall a. Show a => PrecShowS -> a -> PrecShowS
@| h :# typ
i forall a. Show a => PrecShowS -> a -> PrecShowS
@| h :# typ
o) Int
p