{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Categorical.Dual.Example
( Coapplicative (..)
, Comonad (..)
, Distributive (..)
, consume
, Algebra, Coalgebra
, GAlgebra, GCoalgebra
, ElgotAlgebra, ElgotCoalgebra
, NewEither (..), NewTuple (..)
, NewEither' (..), NewTuple' (..)
, TestA, DualA
, TestB, DualB
, TestC, DualC
, (>^>), (<^<)
, Mu (..), Nu (..)
, Fix (..)
, cata, ana
, exampleDuals) where
import Categorical.Dual
import Categorical.Dual.Base
import Categorical.Dual.Lens
import Control.Arrow
import Data.Char
import Data.Void
importDuals baseDuals
importDuals lensDuals
testF :: $(dualType =<< [t|Int -> Char|])
testF = Data.Char.ord
testT :: $(dualType =<< [t|Either Int Char|])
testT = (7, 'a')
testV :: $(dualType =<< [t|Either () Char|])
testV = undefined :: (Void, Char)
testV' :: $(dualType =<< [t|((), Char)|])
testV' = Right 'a' :: Either Void Char
testQ :: $(dualType =<< [t|forall a b. Either (a -> Int) Char -> (Bool, Either Char (Int -> b))|])
testQ = undefined :: Either Bool (Char, b -> Int) -> (Int -> a, Char)
makeDualClass ''Applicative "Coapplicative" [('pure, "extract")]
makeDualClass ''Monad "Comonad" [('(>>=) , "=>>")]
labelSemiDual ''Foldable ''Functor
makeDualClass ''Traversable "Distributive"
[ ('traverse, "cotraverse")
, ('sequenceA, "distribute")]
consume :: (Traversable g, Applicative f) => (g b -> a) -> g (f b) -> f a
consume f = fmap f . sequenceA
makeDualDec [d|type Algebra f a = f a -> a|] "Coalgebra"
makeDualDec [d|type GAlgebra w f a = f (w a) -> a|] "GCoalgebra"
makeDualDec [d|type ElgotAlgebra w f a = w (f a) -> a|] "ElgotCoalgebra"
makeDualDec [d|newtype NewEither a b = NewEither (Either a b)|] "NewTuple"
makeDualDec [d|data NewEither' a b = NewEither' (Either a b)|] "NewTuple'"
makeDualDec [d|data family TestA a|] "DualA"
makeDualDec [d|type family TestB a|] "DualB"
makeDualDec
[d| type family TestC a where
TestC (Either b c) = b
TestC Int = Char |]
"DualC"
makeDualDec
[d| (>^>) :: (a -> b) -> (b -> c) -> a -> c
(>^>) = (>>>) |]
"<^<"
labelSelfDual '($)
data Mu f = Mu (forall a. Algebra f a -> a)
data Nu f where Nu :: Coalgebra f a -> a -> Nu f
labelDual ''Mu ''Nu
data Fix f = Fix { unfix :: f (Fix f) }
labelSelfDual ''Fix
labelDual 'Fix 'unfix
makeDualDec
[d| cata :: Functor f => (f a -> a) -> Fix f -> a
cata f = f . fmap (cata f) . unfix |]
"ana"
exportDuals "exampleDuals"