module Symantic.Base.Algebrable where
import Data.Either (Either)
import Data.Function ((.))
import Data.Maybe (Maybe(..))
import Data.Proxy (Proxy(..))
import GHC.Generics (Generic)
import Symantic.Base.ADT
import Symantic.Base.CurryN
import Symantic.Base.Composable
adt ::
forall adt repr k.
Dimapable repr =>
Generic adt =>
RepOfEoT adt =>
EoTOfRep adt =>
repr (EoT (ADT adt) -> k) k ->
repr (adt -> k) k
adt = dimap adtOfeot eotOfadt
class Tupable repr where
default (<:>) :: Transformable repr => Tupable (UnTrans repr) =>
repr (a->k) k -> repr (b->k) k -> repr ((a,b)->k) k
(<:>) :: repr (a->k) k -> repr (b->k) k -> repr ((a,b)->k) k
(<:>) = trans2 (<:>)
infixr 4 <:>
class Unitable repr where
default unit :: Transformable repr => Unitable (UnTrans repr) =>
repr (() -> k) k
unit :: repr (() -> k) k
unit = noTrans unit
class Constant repr where
default constant :: Transformable repr => Constant (UnTrans repr) =>
a -> repr (a -> k) k
constant :: a -> repr (a -> k) k
constant = noTrans . constant
class Eitherable repr where
default (<+>) :: Transformable repr => Eitherable (UnTrans repr) =>
repr (a->k) k -> repr (b->k) k -> repr (Either a b -> k) k
(<+>) :: repr (a->k) k -> repr (b->k) k -> repr (Either a b->k) k
(<+>) = trans2 (<+>)
infixr 3 <+>
class Emptyable repr where
default empty :: Transformable repr => Emptyable (UnTrans repr) =>
repr k k
empty :: repr k k
empty = noTrans empty
class Optionable repr where
default option :: Transformable repr => Optionable (UnTrans repr) =>
repr k k -> repr k k
option :: repr k k -> repr k k
option = trans1 option
default optional :: Transformable repr => Optionable (UnTrans repr) =>
repr (a->k) k -> repr (Maybe a->k) k
optional :: repr (a->k) k -> repr (Maybe a->k) k
optional = trans1 optional
class Repeatable repr where
default many0 :: Transformable repr => Repeatable (UnTrans repr) =>
repr (a->k) k -> repr ([a]->k) k
many0 :: repr (a->k) k -> repr ([a]->k) k
many0 = trans1 many0
default many1 :: Transformable repr => Repeatable (UnTrans repr) =>
repr (a->k) k -> repr ([a]->k) k
many1 :: repr (a->k) k -> repr ([a]->k) k
many1 = trans1 many1
class Substractable repr where
default (<->) :: Transformable repr => Substractable (UnTrans repr) =>
repr a k -> repr k' k' -> repr a k
(<->) :: repr a k -> repr k' k' -> repr a k
(<->) = trans2 (<->)
infixr 3 <->
class Dicurryable repr where
dicurry ::
CurryN args =>
proxy args ->
(args-..->r) ->
(r->Tuples args) ->
repr (args-..->k) k ->
repr (r->k) k
default dicurry ::
Transformable repr =>
Dicurryable (UnTrans repr) =>
CurryN args =>
proxy args ->
(args-..->r) ->
(r->Tuples args) ->
repr (args-..->k) k ->
repr (r->k) k
dicurry args constr destr = trans1 (dicurry args constr destr)
construct ::
forall args a k repr.
Dicurryable repr =>
Generic a =>
EoTOfRep a =>
CurryN args =>
Tuples args ~ EoT (ADT a) =>
(args ~ Args (args-..->a)) =>
(args-..->a) ->
repr (args-..->k) k ->
repr (a -> k) k
construct f = dicurry (Proxy::Proxy args) f eotOfadt