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

-- | A 'Hyper.Type.HyperType' to express the simplest plain form of a nested higher-kinded data structure.
--
-- The value level [hyperfunctions](http://hackage.haskell.org/package/hyperfunctions)
-- equivalent of 'Pure' is called @self@ in
-- [Hyperfunctions papers](https://arxiv.org/abs/1309.5135).
module Hyper.Type.Pure
    ( Pure (..)
    , _Pure
    , W_Pure (..)
    ) where

import Control.Lens (iso)
import Hyper.TH.Traversable (makeHTraversableApplyAndBases)
import Hyper.Type (type (#), type (:#))
import Text.PrettyPrint.HughesPJClass (Pretty (..))

import Hyper.Internal.Prelude

-- | A 'Hyper.Type.HyperType' to express the simplest plain form of a nested higher-kinded data structure
newtype Pure h = Pure (h :# Pure)
    deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (h :: AHyperType) x. Rep (Pure h) x -> Pure h
forall (h :: AHyperType) x. Pure h -> Rep (Pure h) x
$cto :: forall (h :: AHyperType) x. Rep (Pure h) x -> Pure h
$cfrom :: forall (h :: AHyperType) x. Pure h -> Rep (Pure h) x
Generic)

makeHTraversableApplyAndBases ''Pure
makeCommonInstances [''Pure]

-- | An 'Iso' from 'Pure' to its content.
--
-- Using `_Pure` rather than the 'Pure' data constructor is recommended,
-- because it helps the type inference know that 'Pure' is parameterized with a 'Hyper.Type.HyperType'.
{-# INLINE _Pure #-}
_Pure :: Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure :: forall (h :: HyperType) (j :: HyperType).
Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Pure 'AHyperType h :# Pure
x) -> 'AHyperType h :# Pure
x) forall (h :: AHyperType). (h :# Pure) -> Pure h
Pure

instance Pretty (h :# Pure) => Pretty (Pure h) where
    pPrintPrec :: PrettyLevel -> Rational -> Pure h -> Doc
pPrintPrec PrettyLevel
lvl Rational
p (Pure h :# Pure
x) = forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
lvl Rational
p h :# Pure
x