-- For ifSemantic
{-# LANGUAGE AllowAmbiguousTypes #-}
-- For Syntax
{-# LANGUAGE DataKinds #-}
-- For (:!:)
{-# LANGUAGE PatternSynonyms #-}
-- For ifSemantic
{-# LANGUAGE RankNTypes #-}
-- For Permutation
{-# LANGUAGE TypeFamilyDependencies #-}
-- For Permutation
{-# LANGUAGE UndecidableInstances #-}

-- | Combinators in this module conflict with usual ones from the @Prelude@
-- hence they are meant to be imported either explicitely or qualified.
module Symantic.Syntaxes.Classes where

import Control.Category qualified as Cat
import Data.Bool (Bool (..))
import Data.Char (Char)
import Data.Either (Either (..))
import Data.Eq (Eq)
import Data.Function qualified as Fun
import Data.Int (Int)
import Data.Kind (Constraint)
import Data.Maybe (Maybe (..), fromJust)
import Data.Proxy (Proxy (..))
import Data.Semigroup (Semigroup)
import Data.String (String)
import Data.Tuple qualified as Tuple
import GHC.Generics (Generic)
import Numeric.Natural (Natural)

import Symantic.Syntaxes.CurryN
import Symantic.Syntaxes.Derive
import Symantic.Syntaxes.EithersOfTuples
import Symantic.Syntaxes.TuplesOfFunctions

-- * Type 'Syntax'
type Syntax = Semantic -> Constraint

-- ** Type family 'Syntaxes'

-- | Merge several 'Syntax'es into a single one.
--
-- Useful in 'IfSemantic'.
type family Syntaxes (syns :: [Syntax]) (sem :: Semantic) :: Constraint where
  Syntaxes '[] sem = ()
  Syntaxes (syn ': syns) sem = (syn sem, Syntaxes syns sem)

-- * Class 'Abstractable'
class Unabstractable sem => Abstractable sem where
  -- | Lambda term abstraction, in HOAS (Higher-Order Abstract Syntax) style.
  lam :: (sem a -> sem b) -> sem (a -> b)

  -- | Like 'lam' but whose argument must be used only once,
  -- hence safe to beta-reduce (inline) without duplicating work.
  lam1 :: (sem a -> sem b) -> sem (a -> b)

  var :: sem a -> sem a
  lam sem a -> sem b
f = Derived sem (a -> b) -> sem (a -> b)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived ((Derived sem a -> Derived sem b) -> Derived sem (a -> b)
forall (sem :: * -> *) a b.
Abstractable sem =>
(sem a -> sem b) -> sem (a -> b)
lam (sem b -> Derived sem b
forall (sem :: * -> *) a. Derivable sem => sem a -> Derived sem a
derive (sem b -> Derived sem b)
-> (Derived sem a -> sem b) -> Derived sem a -> Derived sem b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. sem a -> sem b
f (sem a -> sem b)
-> (Derived sem a -> sem a) -> Derived sem a -> sem b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. Derived sem a -> sem a
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived))
  lam1 sem a -> sem b
f = Derived sem (a -> b) -> sem (a -> b)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived ((Derived sem a -> Derived sem b) -> Derived sem (a -> b)
forall (sem :: * -> *) a b.
Abstractable sem =>
(sem a -> sem b) -> sem (a -> b)
lam1 (sem b -> Derived sem b
forall (sem :: * -> *) a. Derivable sem => sem a -> Derived sem a
derive (sem b -> Derived sem b)
-> (Derived sem a -> sem b) -> Derived sem a -> Derived sem b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. sem a -> sem b
f (sem a -> sem b)
-> (Derived sem a -> sem a) -> Derived sem a -> sem b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. Derived sem a -> sem a
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived))
  var = (Derived sem a -> Derived sem a) -> sem a -> sem a
forall (sem :: * -> *) a b.
LiftDerived1 sem =>
(Derived sem a -> Derived sem b) -> sem a -> sem b
liftDerived1 Derived sem a -> Derived sem a
forall (sem :: * -> *) a. Abstractable sem => sem a -> sem a
var
  default lam ::
    FromDerived Abstractable sem =>
    Derivable sem =>
    (sem a -> sem b) ->
    sem (a -> b)
  default lam1 ::
    FromDerived Abstractable sem =>
    Derivable sem =>
    (sem a -> sem b) ->
    sem (a -> b)
  default var ::
    FromDerived1 Abstractable sem =>
    sem a ->
    sem a

-- ** Class 'Unabstractable'
class Unabstractable sem where
  -- | Application, aka. unabstract.
  (.@) :: sem (a -> b) -> sem a -> sem b

  infixl 9 .@
  (.@) = (Derived sem (a -> b) -> Derived sem a -> Derived sem b)
-> sem (a -> b) -> sem a -> sem b
forall (sem :: * -> *) a b c.
LiftDerived2 sem =>
(Derived sem a -> Derived sem b -> Derived sem c)
-> sem a -> sem b -> sem c
liftDerived2 Derived sem (a -> b) -> Derived sem a -> Derived sem b
forall (sem :: * -> *) a b.
Unabstractable sem =>
sem (a -> b) -> sem a -> sem b
(.@)
  default (.@) ::
    FromDerived2 Unabstractable sem =>
    sem (a -> b) ->
    sem a ->
    sem b

-- ** Class 'Functionable'
class Functionable sem where
  const :: sem (a -> b -> a)
  flip :: sem ((a -> b -> c) -> b -> a -> c)
  id :: sem (a -> a)
  (.) :: sem ((b -> c) -> (a -> b) -> a -> c)
  infixr 9 .
  ($) :: sem ((a -> b) -> a -> b)
  infixr 0 $
  const = Derived sem (a -> b -> a) -> sem (a -> b -> a)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem (a -> b -> a)
forall (sem :: * -> *) a b. Functionable sem => sem (a -> b -> a)
const
  flip = Derived sem ((a -> b -> c) -> b -> a -> c)
-> sem ((a -> b -> c) -> b -> a -> c)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem ((a -> b -> c) -> b -> a -> c)
forall (sem :: * -> *) a b c.
Functionable sem =>
sem ((a -> b -> c) -> b -> a -> c)
flip
  id = Derived sem (a -> a) -> sem (a -> a)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem (a -> a)
forall (sem :: * -> *) a. Functionable sem => sem (a -> a)
id
  (.) = Derived sem ((b -> c) -> (a -> b) -> a -> c)
-> sem ((b -> c) -> (a -> b) -> a -> c)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem ((b -> c) -> (a -> b) -> a -> c)
forall (sem :: * -> *) b c a.
Functionable sem =>
sem ((b -> c) -> (a -> b) -> a -> c)
(.)
  ($) = Derived sem ((a -> b) -> a -> b) -> sem ((a -> b) -> a -> b)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem ((a -> b) -> a -> b)
forall (sem :: * -> *) a b.
Functionable sem =>
sem ((a -> b) -> a -> b)
($)
  default const ::
    FromDerived Functionable sem =>
    sem (a -> b -> a)
  default flip ::
    FromDerived Functionable sem =>
    sem ((a -> b -> c) -> b -> a -> c)
  default id ::
    FromDerived Functionable sem =>
    sem (a -> a)
  default (.) ::
    FromDerived Functionable sem =>
    sem ((b -> c) -> (a -> b) -> a -> c)
  default ($) ::
    FromDerived Functionable sem =>
    sem ((a -> b) -> a -> b)

-- * Class 'Anythingable'
class Anythingable sem where
  anything :: sem a -> sem a
  anything = sem a -> sem a
forall a. a -> a
Fun.id

-- * Class 'Bottomable'
class Bottomable sem where
  bottom :: sem a

-- * Class 'Constantable'
class Constantable c sem where
  constant :: c -> sem c
  constant = Derived sem c -> sem c
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived (Derived sem c -> sem c) -> (c -> Derived sem c) -> c -> sem c
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. c -> Derived sem c
forall c (sem :: * -> *). Constantable c sem => c -> sem c
constant
  default constant ::
    FromDerived (Constantable c) sem =>
    c ->
    sem c

-- * Class 'Eitherable'
class Eitherable sem where
  either :: sem ((l -> a) -> (r -> a) -> Either l r -> a)
  left :: sem (l -> Either l r)
  right :: sem (r -> Either l r)
  either = Derived sem ((l -> a) -> (r -> a) -> Either l r -> a)
-> sem ((l -> a) -> (r -> a) -> Either l r -> a)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem ((l -> a) -> (r -> a) -> Either l r -> a)
forall (sem :: * -> *) l a r.
Eitherable sem =>
sem ((l -> a) -> (r -> a) -> Either l r -> a)
either
  left = Derived sem (l -> Either l r) -> sem (l -> Either l r)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem (l -> Either l r)
forall (sem :: * -> *) l r. Eitherable sem => sem (l -> Either l r)
left
  right = Derived sem (r -> Either l r) -> sem (r -> Either l r)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem (r -> Either l r)
forall (sem :: * -> *) r l. Eitherable sem => sem (r -> Either l r)
right
  default either ::
    FromDerived Eitherable sem =>
    sem ((l -> a) -> (r -> a) -> Either l r -> a)
  default left ::
    FromDerived Eitherable sem =>
    sem (l -> Either l r)
  default right ::
    FromDerived Eitherable sem =>
    sem (r -> Either l r)

-- * Class 'Equalable'
class Equalable sem where
  equal :: Eq a => sem (a -> a -> Bool)
  equal = Derived sem (a -> a -> Bool) -> sem (a -> a -> Bool)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem (a -> a -> Bool)
forall (sem :: * -> *) a.
(Equalable sem, Eq a) =>
sem (a -> a -> Bool)
equal
  default equal ::
    FromDerived Equalable sem =>
    Eq a =>
    sem (a -> a -> Bool)

infix 4 `equal`, ==
(==) ::
  Abstractable sem =>
  Equalable sem =>
  Eq a =>
  sem a ->
  sem a ->
  sem Bool
== :: forall (sem :: * -> *) a.
(Abstractable sem, Equalable sem, Eq a) =>
sem a -> sem a -> sem Bool
(==) sem a
x sem a
y = sem (a -> a -> Bool)
forall (sem :: * -> *) a.
(Equalable sem, Eq a) =>
sem (a -> a -> Bool)
equal sem (a -> a -> Bool) -> sem a -> sem (a -> Bool)
forall (sem :: * -> *) a b.
Unabstractable sem =>
sem (a -> b) -> sem a -> sem b
.@ sem a
x sem (a -> Bool) -> sem a -> sem Bool
forall (sem :: * -> *) a b.
Unabstractable sem =>
sem (a -> b) -> sem a -> sem b
.@ sem a
y

-- * Class 'IfThenElseable'
class IfThenElseable sem where
  ifThenElse :: sem Bool -> sem a -> sem a -> sem a
  ifThenElse = (Derived sem Bool
 -> Derived sem a -> Derived sem a -> Derived sem a)
-> sem Bool -> sem a -> sem a -> sem a
forall (sem :: * -> *) a b c d.
LiftDerived3 sem =>
(Derived sem a -> Derived sem b -> Derived sem c -> Derived sem d)
-> sem a -> sem b -> sem c -> sem d
liftDerived3 Derived sem Bool -> Derived sem a -> Derived sem a -> Derived sem a
forall (sem :: * -> *) a.
IfThenElseable sem =>
sem Bool -> sem a -> sem a -> sem a
ifThenElse
  default ifThenElse ::
    FromDerived3 IfThenElseable sem =>
    sem Bool ->
    sem a ->
    sem a ->
    sem a

-- * Class 'Inferable'
class Inferable a sem where
  infer :: sem a
  default infer :: FromDerived (Inferable a) sem => sem a
  infer = Derived sem a -> sem a
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem a
forall a (sem :: * -> *). Inferable a sem => sem a
infer

unit :: Inferable () sem => sem ()
unit :: forall (sem :: * -> *). Inferable () sem => sem ()
unit = sem ()
forall a (sem :: * -> *). Inferable a sem => sem a
infer
bool :: Inferable Bool sem => sem Bool
bool :: forall (sem :: * -> *). Inferable Bool sem => sem Bool
bool = sem Bool
forall a (sem :: * -> *). Inferable a sem => sem a
infer
char :: Inferable Char sem => sem Char
char :: forall (sem :: * -> *). Inferable Char sem => sem Char
char = sem Char
forall a (sem :: * -> *). Inferable a sem => sem a
infer
int :: Inferable Int sem => sem Int
int :: forall (sem :: * -> *). Inferable Int sem => sem Int
int = sem Int
forall a (sem :: * -> *). Inferable a sem => sem a
infer
natural :: Inferable Natural sem => sem Natural
natural :: forall (sem :: * -> *). Inferable Natural sem => sem Natural
natural = sem Natural
forall a (sem :: * -> *). Inferable a sem => sem a
infer
string :: Inferable String sem => sem String
string :: forall (sem :: * -> *). Inferable String sem => sem String
string = sem String
forall a (sem :: * -> *). Inferable a sem => sem a
infer

-- * Class 'Listable'
class Listable sem where
  cons :: sem (a -> [a] -> [a])
  nil :: sem [a]
  cons = Derived sem (a -> [a] -> [a]) -> sem (a -> [a] -> [a])
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem (a -> [a] -> [a])
forall (sem :: * -> *) a. Listable sem => sem (a -> [a] -> [a])
cons
  nil = Derived sem [a] -> sem [a]
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem [a]
forall (sem :: * -> *) a. Listable sem => sem [a]
nil
  default cons ::
    FromDerived Listable sem =>
    sem (a -> [a] -> [a])
  default nil ::
    FromDerived Listable sem =>
    sem [a]

-- * Class 'Maybeable'
class Maybeable sem where
  nothing :: sem (Maybe a)
  just :: sem (a -> Maybe a)
  nothing = Derived sem (Maybe a) -> sem (Maybe a)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem (Maybe a)
forall (sem :: * -> *) a. Maybeable sem => sem (Maybe a)
nothing
  just = Derived sem (a -> Maybe a) -> sem (a -> Maybe a)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem (a -> Maybe a)
forall (sem :: * -> *) a. Maybeable sem => sem (a -> Maybe a)
just
  default nothing ::
    FromDerived Maybeable sem =>
    sem (Maybe a)
  default just ::
    FromDerived Maybeable sem =>
    sem (a -> Maybe a)

-- * Class 'IsoFunctor'
class IsoFunctor sem where
  (<%>) :: Iso a b -> sem a -> sem b
  infixl 4 <%>
  (<%>) Iso a b
iso = (Derived sem a -> Derived sem b) -> sem a -> sem b
forall (sem :: * -> *) a b.
LiftDerived1 sem =>
(Derived sem a -> Derived sem b) -> sem a -> sem b
liftDerived1 (Iso a b
iso Iso a b -> Derived sem a -> Derived sem b
forall (sem :: * -> *) a b.
IsoFunctor sem =>
Iso a b -> sem a -> sem b
<%>)
  default (<%>) ::
    FromDerived1 IsoFunctor sem =>
    Iso a b ->
    sem a ->
    sem b

-- ** Type 'Iso'
data Iso a b = Iso {forall a b. Iso a b -> a -> b
a2b :: a -> b, forall a b. Iso a b -> b -> a
b2a :: b -> a}
instance Cat.Category Iso where
  id :: forall a. Iso a a
id = (a -> a) -> (a -> a) -> Iso a a
forall a b. (a -> b) -> (b -> a) -> Iso a b
Iso a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id
  Iso b c
f . :: forall b c a. Iso b c -> Iso a b -> Iso a c
. Iso a b
g = (a -> c) -> (c -> a) -> Iso a c
forall a b. (a -> b) -> (b -> a) -> Iso a b
Iso (Iso b c -> b -> c
forall a b. Iso a b -> a -> b
a2b Iso b c
f (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
Cat.. Iso a b -> a -> b
forall a b. Iso a b -> a -> b
a2b Iso a b
g) (Iso a b -> b -> a
forall a b. Iso a b -> b -> a
b2a Iso a b
g (b -> a) -> (c -> b) -> c -> a
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
Cat.. Iso b c -> c -> b
forall a b. Iso a b -> b -> a
b2a Iso b c
f)

-- * Class 'ProductFunctor'

-- | Beware that this is an @infixr@,
-- not @infixl@ like 'Control.Applicative.<*>';
-- this is to follow what is expected by 'ADT'.
class ProductFunctor sem where
  (<.>) :: sem a -> sem b -> sem (a, b)
  infixr 4 <.>
  (<.>) = (Derived sem a -> Derived sem b -> Derived sem (a, b))
-> sem a -> sem b -> sem (a, b)
forall (sem :: * -> *) a b c.
LiftDerived2 sem =>
(Derived sem a -> Derived sem b -> Derived sem c)
-> sem a -> sem b -> sem c
liftDerived2 Derived sem a -> Derived sem b -> Derived sem (a, b)
forall (sem :: * -> *) a b.
ProductFunctor sem =>
sem a -> sem b -> sem (a, b)
(<.>)
  default (<.>) ::
    FromDerived2 ProductFunctor sem =>
    sem a ->
    sem b ->
    sem (a, b)
  (<.) :: sem a -> sem () -> sem a
  infixr 4 <.
  sem a
ra <. sem ()
rb = ((a, ()) -> a) -> (a -> (a, ())) -> Iso (a, ()) a
forall a b. (a -> b) -> (b -> a) -> Iso a b
Iso (a, ()) -> a
forall a b. (a, b) -> a
Tuple.fst (,()) Iso (a, ()) a -> sem (a, ()) -> sem a
forall (sem :: * -> *) a b.
IsoFunctor sem =>
Iso a b -> sem a -> sem b
<%> (sem a
ra sem a -> sem () -> sem (a, ())
forall (sem :: * -> *) a b.
ProductFunctor sem =>
sem a -> sem b -> sem (a, b)
<.> sem ()
rb)
  default (<.) :: IsoFunctor sem => sem a -> sem () -> sem a
  (.>) :: sem () -> sem a -> sem a
  infixr 4 .>
  sem ()
ra .> sem a
rb = (((), a) -> a) -> (a -> ((), a)) -> Iso ((), a) a
forall a b. (a -> b) -> (b -> a) -> Iso a b
Iso ((), a) -> a
forall a b. (a, b) -> b
Tuple.snd ((),) Iso ((), a) a -> sem ((), a) -> sem a
forall (sem :: * -> *) a b.
IsoFunctor sem =>
Iso a b -> sem a -> sem b
<%> (sem ()
ra sem () -> sem a -> sem ((), a)
forall (sem :: * -> *) a b.
ProductFunctor sem =>
sem a -> sem b -> sem (a, b)
<.> sem a
rb)
  default (.>) :: IsoFunctor sem => sem () -> sem a -> sem a

-- * Class 'SumFunctor'

-- | Beware that this is an @infixr@,
-- not @infixl@ like 'Control.Applicative.<|>';
-- this is to follow what is expected by 'ADT'.
class SumFunctor sem where
  (<+>) :: sem a -> sem b -> sem (Either a b)
  infixr 3 <+>
  (<+>) = (Derived sem a -> Derived sem b -> Derived sem (Either a b))
-> sem a -> sem b -> sem (Either a b)
forall (sem :: * -> *) a b c.
LiftDerived2 sem =>
(Derived sem a -> Derived sem b -> Derived sem c)
-> sem a -> sem b -> sem c
liftDerived2 Derived sem a -> Derived sem b -> Derived sem (Either a b)
forall (sem :: * -> *) a b.
SumFunctor sem =>
sem a -> sem b -> sem (Either a b)
(<+>)
  default (<+>) ::
    FromDerived2 SumFunctor sem =>
    sem a ->
    sem b ->
    sem (Either a b)

-- | Like @(,)@ but @infixr@.
-- Mostly useful for clarity when using 'SumFunctor'.
pattern (:!:) :: a -> b -> (a, b)
pattern a $b:!: :: forall a b. a -> b -> (a, b)
$m:!: :: forall {r} {a} {b}. (a, b) -> (a -> b -> r) -> (Void# -> r) -> r
:!: b <-
  (a, b)
  where
    a
a :!: b
b = (a
a, b
b)

infixr 4 :!:

-- * Class 'AlternativeFunctor'

-- | Beware that this is an @infixr@,
-- not @infixl@ like 'Control.Applicative.<|>';
-- this is to follow what is expected by 'ADT'.
class AlternativeFunctor sem where
  (<|>) :: sem a -> sem a -> sem a
  infixr 3 <|>
  (<|>) = (Derived sem a -> Derived sem a -> Derived sem a)
-> sem a -> sem a -> sem a
forall (sem :: * -> *) a b c.
LiftDerived2 sem =>
(Derived sem a -> Derived sem b -> Derived sem c)
-> sem a -> sem b -> sem c
liftDerived2 Derived sem a -> Derived sem a -> Derived sem a
forall (sem :: * -> *) a.
AlternativeFunctor sem =>
sem a -> sem a -> sem a
(<|>)
  default (<|>) ::
    FromDerived2 AlternativeFunctor sem =>
    sem a ->
    sem a ->
    sem a

-- * Class 'Dicurryable'
class Dicurryable sem where
  dicurry ::
    CurryN args =>
    proxy args ->
    (args -..-> a) -> -- construction
    (a -> Tuples args) -> -- destruction
    sem (Tuples args) ->
    sem a
  dicurry proxy args
args args -..-> a
constr a -> Tuples args
destr = (Derived sem (Tuples args) -> Derived sem a)
-> sem (Tuples args) -> sem a
forall (sem :: * -> *) a b.
LiftDerived1 sem =>
(Derived sem a -> Derived sem b) -> sem a -> sem b
liftDerived1 (proxy args
-> (args -..-> a)
-> (a -> Tuples args)
-> Derived sem (Tuples args)
-> Derived sem a
forall (sem :: * -> *) (args :: [*]) (proxy :: [*] -> *) a.
(Dicurryable sem, CurryN args) =>
proxy args
-> (args -..-> a)
-> (a -> Tuples args)
-> sem (Tuples args)
-> sem a
dicurry proxy args
args args -..-> a
constr a -> Tuples args
destr)
  default dicurry ::
    FromDerived1 Dicurryable sem =>
    CurryN args =>
    proxy args ->
    (args -..-> a) ->
    (a -> Tuples args) ->
    sem (Tuples args) ->
    sem a

construct ::
  forall args a sem.
  Dicurryable sem =>
  Generic a =>
  EoTOfRep a =>
  CurryN args =>
  Tuples args ~ EoT (ADT a) =>
  (args ~ Args (args -..-> a)) =>
  (args -..-> a) ->
  sem (Tuples args) ->
  sem a
construct :: forall (args :: [*]) a (sem :: * -> *).
(Dicurryable sem, Generic a, EoTOfRep a, CurryN args,
 Tuples args ~ EoT (ADT a), args ~ Args (args -..-> a)) =>
(args -..-> a) -> sem (Tuples args) -> sem a
construct args -..-> a
f = Proxy args
-> (args -..-> a)
-> (a -> Tuples args)
-> sem (Tuples args)
-> sem a
forall (sem :: * -> *) (args :: [*]) (proxy :: [*] -> *) a.
(Dicurryable sem, CurryN args) =>
proxy args
-> (args -..-> a)
-> (a -> Tuples args)
-> sem (Tuples args)
-> sem a
dicurry (Proxy args
forall {k} (t :: k). Proxy t
Proxy :: Proxy args) args -..-> a
f a -> Tuples args
forall a. (Generic a, EoTOfRep a) => a -> EoT (ADT a)
eotOfadt

-- * Class 'Dataable'

-- | Enable the contruction or deconstruction
-- of a any algebraic data type
class Dataable sem where
  data_ :: Generic a => RepOfEoT a => UnToF a => sem (EoT (ADT a)) -> sem a
  default data_ ::
    Generic a =>
    RepOfEoT a =>
    EoTOfRep a =>
    IsoFunctor sem =>
    sem (EoT (ADT a)) ->
    sem a
  data_ = Iso (EoT (ListOfRepSums (Rep a) '[])) a
-> sem (EoT (ListOfRepSums (Rep a) '[])) -> sem a
forall (sem :: * -> *) a b.
IsoFunctor sem =>
Iso a b -> sem a -> sem b
(<%>) ((EoT (ListOfRepSums (Rep a) '[]) -> a)
-> (a -> EoT (ListOfRepSums (Rep a) '[]))
-> Iso (EoT (ListOfRepSums (Rep a) '[])) a
forall a b. (a -> b) -> (b -> a) -> Iso a b
Iso EoT (ListOfRepSums (Rep a) '[]) -> a
forall a. (Generic a, RepOfEoT a) => EoT (ADT a) -> a
adtOfeot a -> EoT (ListOfRepSums (Rep a) '[])
forall a. (Generic a, EoTOfRep a) => a -> EoT (ADT a)
eotOfadt)

-- | Like 'data_' but with the @(a)@ type parameter first
-- for convenience when specifying it.
dataType :: forall a sem. Dataable sem => Generic a => RepOfEoT a => UnToF a => sem (EoT (ADT a)) -> sem a
dataType :: forall a (sem :: * -> *).
(Dataable sem, Generic a, RepOfEoT a, UnToF a) =>
sem (EoT (ADT a)) -> sem a
dataType = sem (EoT (ADT a)) -> sem a
forall (sem :: * -> *) a.
(Dataable sem, Generic a, RepOfEoT a, UnToF a) =>
sem (EoT (ADT a)) -> sem a
data_

-- * Class 'IfSemantic'

-- | 'IfSemantic' enables to change the 'Syntax' for a specific 'Semantic'.
--
-- Useful when a 'Semantic' does not implement some 'Syntax'es used by other 'Semantic's.
class
  IfSemantic
    (thenSyntaxes :: [Syntax])
    (elseSyntaxes :: [Syntax])
    thenSemantic
    elseSemantic
  where
  ifSemantic ::
    (Syntaxes thenSyntaxes thenSemantic => thenSemantic a) ->
    (Syntaxes elseSyntaxes elseSemantic => elseSemantic a) ->
    elseSemantic a

instance
  {-# OVERLAPPING #-}
  Syntaxes thenSyntaxes thenSemantic =>
  IfSemantic thenSyntaxes elseSyntaxes thenSemantic thenSemantic
  where
  ifSemantic :: forall a.
(Syntaxes thenSyntaxes thenSemantic => thenSemantic a)
-> (Syntaxes elseSyntaxes thenSemantic => thenSemantic a)
-> thenSemantic a
ifSemantic Syntaxes thenSyntaxes thenSemantic => thenSemantic a
thenSyntax Syntaxes elseSyntaxes thenSemantic => thenSemantic a
_elseSyntax = thenSemantic a
Syntaxes thenSyntaxes thenSemantic => thenSemantic a
thenSyntax
instance
  Syntaxes elseSyntaxes elseSemantic =>
  IfSemantic thenSyntaxes elseSyntaxes thenSemantic elseSemantic
  where
  ifSemantic :: forall a.
(Syntaxes thenSyntaxes thenSemantic => thenSemantic a)
-> (Syntaxes elseSyntaxes elseSemantic => elseSemantic a)
-> elseSemantic a
ifSemantic Syntaxes thenSyntaxes thenSemantic => thenSemantic a
_thenSyntax Syntaxes elseSyntaxes elseSemantic => elseSemantic a
elseSyntax = elseSemantic a
Syntaxes elseSyntaxes elseSemantic => elseSemantic a
elseSyntax

-- * Class 'Monoidable'
class
  ( Emptyable sem
  , Semigroupable sem
  ) =>
  Monoidable sem
instance
  ( Emptyable sem
  , Semigroupable sem
  ) =>
  Monoidable sem

-- ** Class 'Emptyable'
class Emptyable sem where
  empty :: sem a
  empty = Derived sem a -> sem a
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem a
forall (sem :: * -> *) a. Emptyable sem => sem a
empty
  default empty ::
    FromDerived Emptyable sem =>
    sem a

-- ** Class 'Semigroupable'
class Semigroupable sem where
  concat :: Semigroup a => sem (a -> a -> a)
  concat = Derived sem (a -> a -> a) -> sem (a -> a -> a)
forall (sem :: * -> *) a. LiftDerived sem => Derived sem a -> sem a
liftDerived Derived sem (a -> a -> a)
forall (sem :: * -> *) a.
(Semigroupable sem, Semigroup a) =>
sem (a -> a -> a)
concat
  default concat ::
    FromDerived Semigroupable sem =>
    Semigroup a =>
    sem (a -> a -> a)

infixr 6 `concat`, <>
(<>) ::
  Abstractable sem =>
  Semigroupable sem =>
  Semigroup a =>
  sem a ->
  sem a ->
  sem a
<> :: forall (sem :: * -> *) a.
(Abstractable sem, Semigroupable sem, Semigroup a) =>
sem a -> sem a -> sem a
(<>) sem a
x sem a
y = sem (a -> a -> a)
forall (sem :: * -> *) a.
(Semigroupable sem, Semigroup a) =>
sem (a -> a -> a)
concat sem (a -> a -> a) -> sem a -> sem (a -> a)
forall (sem :: * -> *) a b.
Unabstractable sem =>
sem (a -> b) -> sem a -> sem b
.@ sem a
x sem (a -> a) -> sem a -> sem a
forall (sem :: * -> *) a b.
Unabstractable sem =>
sem (a -> b) -> sem a -> sem b
.@ sem a
y

-- ** Class 'Optionable'
class Optionable sem where
  optional :: sem a -> sem (Maybe a)
  optional = (Derived sem a -> Derived sem (Maybe a)) -> sem a -> sem (Maybe a)
forall (sem :: * -> *) a b.
LiftDerived1 sem =>
(Derived sem a -> Derived sem b) -> sem a -> sem b
liftDerived1 Derived sem a -> Derived sem (Maybe a)
forall (sem :: * -> *) a. Optionable sem => sem a -> sem (Maybe a)
optional
  default optional ::
    FromDerived1 Optionable sem =>
    sem a ->
    sem (Maybe a)

-- * Class 'Repeatable'
class Repeatable sem where
  many0 :: sem a -> sem [a]
  many1 :: sem a -> sem [a]
  many0 = (Derived sem a -> Derived sem [a]) -> sem a -> sem [a]
forall (sem :: * -> *) a b.
LiftDerived1 sem =>
(Derived sem a -> Derived sem b) -> sem a -> sem b
liftDerived1 Derived sem a -> Derived sem [a]
forall (sem :: * -> *) a. Repeatable sem => sem a -> sem [a]
many0
  many1 = (Derived sem a -> Derived sem [a]) -> sem a -> sem [a]
forall (sem :: * -> *) a b.
LiftDerived1 sem =>
(Derived sem a -> Derived sem b) -> sem a -> sem b
liftDerived1 Derived sem a -> Derived sem [a]
forall (sem :: * -> *) a. Repeatable sem => sem a -> sem [a]
many1
  default many0 ::
    FromDerived1 Repeatable sem =>
    sem a ->
    sem [a]
  default many1 ::
    FromDerived1 Repeatable sem =>
    sem a ->
    sem [a]

-- | Alias to 'many0'.
many :: Repeatable sem => sem a -> sem [a]
many :: forall (sem :: * -> *) a. Repeatable sem => sem a -> sem [a]
many = sem a -> sem [a]
forall (sem :: * -> *) a. Repeatable sem => sem a -> sem [a]
many0

-- | Alias to 'many1'.
some :: Repeatable sem => sem a -> sem [a]
some :: forall (sem :: * -> *) a. Repeatable sem => sem a -> sem [a]
some = sem a -> sem [a]
forall (sem :: * -> *) a. Repeatable sem => sem a -> sem [a]
many1

-- * Class 'Permutable'
class Permutable sem where
  -- Use @TypeFamilyDependencies@ to help type-inference infer @(sem)@.
  type Permutation (sem :: Semantic) = (r :: Semantic) | r -> sem
  type Permutation sem = Permutation (Derived sem)
  permutable :: Permutation sem a -> sem a
  perm :: sem a -> Permutation sem a
  noPerm :: Permutation sem ()
  permWithDefault :: a -> sem a -> Permutation sem a
  optionalPerm ::
    Eitherable sem =>
    IsoFunctor sem =>
    Permutable sem =>
    sem a ->
    Permutation sem (Maybe a)
  optionalPerm = Maybe a -> sem (Maybe a) -> Permutation sem (Maybe a)
forall (sem :: * -> *) a.
Permutable sem =>
a -> sem a -> Permutation sem a
permWithDefault Maybe a
forall a. Maybe a
Nothing (sem (Maybe a) -> Permutation sem (Maybe a))
-> (sem a -> sem (Maybe a)) -> sem a -> Permutation sem (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. Iso a (Maybe a) -> sem a -> sem (Maybe a)
forall (sem :: * -> *) a b.
IsoFunctor sem =>
Iso a b -> sem a -> sem b
(<%>) ((a -> Maybe a) -> (Maybe a -> a) -> Iso a (Maybe a)
forall a b. (a -> b) -> (b -> a) -> Iso a b
Iso a -> Maybe a
forall a. a -> Maybe a
Just Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust)

(<&>) ::
  Permutable sem =>
  ProductFunctor (Permutation sem) =>
  sem a ->
  Permutation sem b ->
  Permutation sem (a, b)
sem a
x <&> :: forall (sem :: * -> *) a b.
(Permutable sem, ProductFunctor (Permutation sem)) =>
sem a -> Permutation sem b -> Permutation sem (a, b)
<&> Permutation sem b
y = sem a -> Permutation sem a
forall (sem :: * -> *) a.
Permutable sem =>
sem a -> Permutation sem a
perm sem a
x Permutation sem a -> Permutation sem b -> Permutation sem (a, b)
forall (sem :: * -> *) a b.
ProductFunctor sem =>
sem a -> sem b -> sem (a, b)
<.> Permutation sem b
y
infixr 4 <&>
{-# INLINE (<&>) #-}

(<?&>) ::
  Eitherable sem =>
  IsoFunctor sem =>
  Permutable sem =>
  ProductFunctor (Permutation sem) =>
  sem a ->
  Permutation sem b ->
  Permutation sem (Maybe a, b)
sem a
x <?&> :: forall (sem :: * -> *) a b.
(Eitherable sem, IsoFunctor sem, Permutable sem,
 ProductFunctor (Permutation sem)) =>
sem a -> Permutation sem b -> Permutation sem (Maybe a, b)
<?&> Permutation sem b
y = sem a -> Permutation sem (Maybe a)
forall (sem :: * -> *) a.
(Permutable sem, Eitherable sem, IsoFunctor sem, Permutable sem) =>
sem a -> Permutation sem (Maybe a)
optionalPerm sem a
x Permutation sem (Maybe a)
-> Permutation sem b -> Permutation sem (Maybe a, b)
forall (sem :: * -> *) a b.
ProductFunctor sem =>
sem a -> sem b -> sem (a, b)
<.> Permutation sem b
y
infixr 4 <?&>
{-# INLINE (<?&>) #-}

(<*&>) ::
  Eitherable sem =>
  Repeatable sem =>
  IsoFunctor sem =>
  Permutable sem =>
  ProductFunctor (Permutation sem) =>
  sem a ->
  Permutation sem b ->
  Permutation sem ([a], b)
sem a
x <*&> :: forall (sem :: * -> *) a b.
(Eitherable sem, Repeatable sem, IsoFunctor sem, Permutable sem,
 ProductFunctor (Permutation sem)) =>
sem a -> Permutation sem b -> Permutation sem ([a], b)
<*&> Permutation sem b
y = [a] -> sem [a] -> Permutation sem [a]
forall (sem :: * -> *) a.
Permutable sem =>
a -> sem a -> Permutation sem a
permWithDefault [] (sem a -> sem [a]
forall (sem :: * -> *) a. Repeatable sem => sem a -> sem [a]
many1 sem a
x) Permutation sem [a]
-> Permutation sem b -> Permutation sem ([a], b)
forall (sem :: * -> *) a b.
ProductFunctor sem =>
sem a -> sem b -> sem (a, b)
<.> Permutation sem b
y
infixr 4 <*&>
{-# INLINE (<*&>) #-}

(<+&>) ::
  Eitherable sem =>
  Repeatable sem =>
  IsoFunctor sem =>
  Permutable sem =>
  ProductFunctor (Permutation sem) =>
  sem a ->
  Permutation sem b ->
  Permutation sem ([a], b)
sem a
x <+&> :: forall (sem :: * -> *) a b.
(Eitherable sem, Repeatable sem, IsoFunctor sem, Permutable sem,
 ProductFunctor (Permutation sem)) =>
sem a -> Permutation sem b -> Permutation sem ([a], b)
<+&> Permutation sem b
y = sem [a] -> Permutation sem [a]
forall (sem :: * -> *) a.
Permutable sem =>
sem a -> Permutation sem a
perm (sem a -> sem [a]
forall (sem :: * -> *) a. Repeatable sem => sem a -> sem [a]
many1 sem a
x) Permutation sem [a]
-> Permutation sem b -> Permutation sem ([a], b)
forall (sem :: * -> *) a b.
ProductFunctor sem =>
sem a -> sem b -> sem (a, b)
<.> Permutation sem b
y
infixr 4 <+&>
{-# INLINE (<+&>) #-}

-- * Class 'Voidable'
class Voidable sem where
  -- | Useful to supply @(a)@ to a @(sem)@ consuming @(a)@,
  -- for example in the format of a printing interpreter.
  void :: a -> sem a -> sem ()
  void = (Derived sem a -> Derived sem ()) -> sem a -> sem ()
forall (sem :: * -> *) a b.
LiftDerived1 sem =>
(Derived sem a -> Derived sem b) -> sem a -> sem b
liftDerived1 ((Derived sem a -> Derived sem ()) -> sem a -> sem ())
-> (a -> Derived sem a -> Derived sem ()) -> a -> sem a -> sem ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. a -> Derived sem a -> Derived sem ()
forall (sem :: * -> *) a. Voidable sem => a -> sem a -> sem ()
void
  default void ::
    FromDerived1 Voidable sem =>
    a ->
    sem a ->
    sem ()

-- * Class 'Substractable'
class Substractable sem where
  (<->) :: sem a -> sem b -> sem a
  infixr 3 <->
  (<->) = (Derived sem a -> Derived sem b -> Derived sem a)
-> sem a -> sem b -> sem a
forall (sem :: * -> *) a b c.
LiftDerived2 sem =>
(Derived sem a -> Derived sem b -> Derived sem c)
-> sem a -> sem b -> sem c
liftDerived2 Derived sem a -> Derived sem b -> Derived sem a
forall (sem :: * -> *) a b.
Substractable sem =>
sem a -> sem b -> sem a
(<->)
  default (<->) ::
    FromDerived2 Substractable sem =>
    sem a ->
    sem b ->
    sem a