{-# LANGUAGE DataKinds #-} -- For ReprKind
{-# LANGUAGE PatternSynonyms #-} -- For (:!:)
{-# LANGUAGE TypeFamilyDependencies #-} -- For Permutation
{-# LANGUAGE UndecidableInstances #-} -- For Permutation
-- | Comibnators in this module conflict with usual ones from the @Prelude@
-- hence they are meant to be imported either explicitely or qualified.
module Symantic.Classes where

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

import Symantic.Derive
import Symantic.ADT
import Symantic.CurryN

-- * Type 'ReprKind'
-- | The kind of @repr@(esentations) throughout this library.
type ReprKind = Type -> Type

-- * Class 'Abstractable'
class Abstractable repr where
  -- | Lambda term abstraction, in HOAS (Higher-Order Abstract Syntax) style.
  lam :: (repr a -> repr b) -> repr (a->b)
  -- | Like 'lam' but whose argument must be used only once,
  -- hence safe to beta-reduce (inline) without duplicating work.
  lam1 :: (repr a -> repr b) -> repr (a->b)
  var :: repr a -> repr a
  -- | Application, aka. unabstract.
  (.@) :: repr (a->b) -> repr a -> repr b; infixl 9 .@
  lam repr a -> repr b
f = Derived repr (a -> b) -> repr (a -> b)
forall (repr :: * -> *) a.
LiftDerived repr =>
Derived repr a -> repr a
liftDerived ((Derived repr a -> Derived repr b) -> Derived repr (a -> b)
forall (repr :: * -> *) a b.
Abstractable repr =>
(repr a -> repr b) -> repr (a -> b)
lam (repr b -> Derived repr b
forall (repr :: * -> *) a.
Derivable repr =>
repr a -> Derived repr a
derive (repr b -> Derived repr b)
-> (Derived repr a -> repr b) -> Derived repr a -> Derived repr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. repr a -> repr b
f (repr a -> repr b)
-> (Derived repr a -> repr a) -> Derived repr a -> repr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. Derived repr a -> repr a
forall (repr :: * -> *) a.
LiftDerived repr =>
Derived repr a -> repr a
liftDerived))
  lam1 repr a -> repr b
f = Derived repr (a -> b) -> repr (a -> b)
forall (repr :: * -> *) a.
LiftDerived repr =>
Derived repr a -> repr a
liftDerived ((Derived repr a -> Derived repr b) -> Derived repr (a -> b)
forall (repr :: * -> *) a b.
Abstractable repr =>
(repr a -> repr b) -> repr (a -> b)
lam1 (repr b -> Derived repr b
forall (repr :: * -> *) a.
Derivable repr =>
repr a -> Derived repr a
derive (repr b -> Derived repr b)
-> (Derived repr a -> repr b) -> Derived repr a -> Derived repr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. repr a -> repr b
f (repr a -> repr b)
-> (Derived repr a -> repr a) -> Derived repr a -> repr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. Derived repr a -> repr a
forall (repr :: * -> *) a.
LiftDerived repr =>
Derived repr a -> repr a
liftDerived))
  var = (Derived repr a -> Derived repr a) -> repr a -> repr a
forall (repr :: * -> *) a b.
LiftDerived1 repr =>
(Derived repr a -> Derived repr b) -> repr a -> repr b
liftDerived1 Derived repr a -> Derived repr a
forall (repr :: * -> *) a. Abstractable repr => repr a -> repr a
var
  (.@) = (Derived repr (a -> b) -> Derived repr a -> Derived repr b)
-> repr (a -> b) -> repr a -> repr b
forall (repr :: * -> *) a b c.
LiftDerived2 repr =>
(Derived repr a -> Derived repr b -> Derived repr c)
-> repr a -> repr b -> repr c
liftDerived2 Derived repr (a -> b) -> Derived repr a -> Derived repr b
forall (repr :: * -> *) a b.
Abstractable repr =>
repr (a -> b) -> repr a -> repr b
(.@)
  default lam ::
    FromDerived Abstractable repr => Derivable repr =>
    (repr a -> repr b) -> repr (a->b)
  default lam1 ::
    FromDerived Abstractable repr => Derivable repr =>
    (repr a -> repr b) -> repr (a->b)
  default var ::
    FromDerived1 Abstractable repr =>
    repr a -> repr a
  default (.@) ::
    FromDerived2 Abstractable repr =>
    repr (a->b) -> repr a -> repr b

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

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

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

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

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

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

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

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

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

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

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

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

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

-- ** Type 'Iso'
data Iso a b = Iso { Iso a b -> a -> b
a2b :: a->b, Iso a b -> b -> a
b2a :: b->a }
instance Cat.Category Iso where
  id :: 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 . :: 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 repr where
  (<.>) :: repr a -> repr b -> repr (a, b); infixr 4 <.>
  (<.>) = (Derived repr a -> Derived repr b -> Derived repr (a, b))
-> repr a -> repr b -> repr (a, b)
forall (repr :: * -> *) a b c.
LiftDerived2 repr =>
(Derived repr a -> Derived repr b -> Derived repr c)
-> repr a -> repr b -> repr c
liftDerived2 Derived repr a -> Derived repr b -> Derived repr (a, b)
forall (repr :: * -> *) a b.
ProductFunctor repr =>
repr a -> repr b -> repr (a, b)
(<.>)
  default (<.>) ::
    FromDerived2 ProductFunctor repr =>
    repr a -> repr b -> repr (a, b)
  (<.) :: repr a -> repr () -> repr a; infixr 4 <.
  repr a
ra <. repr ()
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 -> repr (a, ()) -> repr a
forall (repr :: * -> *) a b.
IsoFunctor repr =>
Iso a b -> repr a -> repr b
<%> (repr a
ra repr a -> repr () -> repr (a, ())
forall (repr :: * -> *) a b.
ProductFunctor repr =>
repr a -> repr b -> repr (a, b)
<.> repr ()
rb)
  default (<.) :: IsoFunctor repr => repr a -> repr () -> repr a
  (.>) :: repr () -> repr a -> repr a; infixr 4 .>
  repr ()
ra .> repr 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 -> repr ((), a) -> repr a
forall (repr :: * -> *) a b.
IsoFunctor repr =>
Iso a b -> repr a -> repr b
<%> (repr ()
ra repr () -> repr a -> repr ((), a)
forall (repr :: * -> *) a b.
ProductFunctor repr =>
repr a -> repr b -> repr (a, b)
<.> repr a
rb)
  default (.>) :: IsoFunctor repr => repr () -> repr a -> repr 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 repr where
  (<+>) :: repr a -> repr b -> repr (Either a b); infixr 3 <+>
  (<+>) = (Derived repr a -> Derived repr b -> Derived repr (Either a b))
-> repr a -> repr b -> repr (Either a b)
forall (repr :: * -> *) a b c.
LiftDerived2 repr =>
(Derived repr a -> Derived repr b -> Derived repr c)
-> repr a -> repr b -> repr c
liftDerived2 Derived repr a -> Derived repr b -> Derived repr (Either a b)
forall (repr :: * -> *) a b.
SumFunctor repr =>
repr a -> repr b -> repr (Either a b)
(<+>)
  default (<+>) ::
    FromDerived2 SumFunctor repr =>
    repr a -> repr b -> repr (Either a b)

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

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

construct ::
  forall args a repr.
  Dicurryable repr =>
  Generic a =>
  EoTOfRep a =>
  CurryN args =>
  Tuples args ~ EoT (ADT a) =>
  (args ~ Args (args-..->a)) =>
  (args-..->a) ->
  repr (Tuples args) ->
  repr a
construct :: (args -..-> a) -> repr (Tuples args) -> repr a
construct args -..-> a
f = Proxy args
-> (args -..-> a)
-> (a -> Tuples args)
-> repr (Tuples args)
-> repr a
forall (repr :: * -> *) (args :: [*]) (proxy :: [*] -> *) a.
(Dicurryable repr, CurryN args) =>
proxy args
-> (args -..-> a)
-> (a -> Tuples args)
-> repr (Tuples args)
-> repr 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

adt ::
  forall adt repr.
  IsoFunctor repr =>
  Generic adt =>
  RepOfEoT adt =>
  EoTOfRep adt =>
  repr (EoT (ADT adt)) ->
  repr adt
adt :: repr (EoT (ADT adt)) -> repr adt
adt = Iso (EoT (ADT adt)) adt -> repr (EoT (ADT adt)) -> repr adt
forall (repr :: * -> *) a b.
IsoFunctor repr =>
Iso a b -> repr a -> repr b
(<%>) ((EoT (ADT adt) -> adt)
-> (adt -> EoT (ADT adt)) -> Iso (EoT (ADT adt)) adt
forall a b. (a -> b) -> (b -> a) -> Iso a b
Iso EoT (ADT adt) -> adt
forall a. (Generic a, RepOfEoT a) => EoT (ADT a) -> a
adtOfeot adt -> EoT (ADT adt)
forall a. (Generic a, EoTOfRep a) => a -> EoT (ADT a)
eotOfadt)

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

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

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

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

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

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

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

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

-- * Class 'Permutable'
class Permutable repr where
  -- Use @TypeFamilyDependencies@ to help type-inference infer @(repr)@.
  type Permutation (repr:: ReprKind) = (r :: ReprKind) | r -> repr
  type Permutation repr = Permutation (Derived repr)
  permutable :: Permutation repr a -> repr a
  perm :: repr a -> Permutation repr a
  noPerm :: Permutation repr ()
  permWithDefault :: a -> repr a -> Permutation repr a
  optionalPerm ::
    Eitherable repr => IsoFunctor repr => Permutable repr =>
    repr a -> Permutation repr (Maybe a)
  optionalPerm = Maybe a -> repr (Maybe a) -> Permutation repr (Maybe a)
forall (repr :: * -> *) a.
Permutable repr =>
a -> repr a -> Permutation repr a
permWithDefault Maybe a
forall a. Maybe a
Nothing (repr (Maybe a) -> Permutation repr (Maybe a))
-> (repr a -> repr (Maybe a))
-> repr a
-> Permutation repr (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. Iso a (Maybe a) -> repr a -> repr (Maybe a)
forall (repr :: * -> *) a b.
IsoFunctor repr =>
Iso a b -> repr a -> repr 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 repr =>
  ProductFunctor (Permutation repr) =>
  repr a ->
  Permutation repr b ->
  Permutation repr (a, b)
repr a
x <&> :: repr a -> Permutation repr b -> Permutation repr (a, b)
<&> Permutation repr b
y = repr a -> Permutation repr a
forall (repr :: * -> *) a.
Permutable repr =>
repr a -> Permutation repr a
perm repr a
x Permutation repr a -> Permutation repr b -> Permutation repr (a, b)
forall (repr :: * -> *) a b.
ProductFunctor repr =>
repr a -> repr b -> repr (a, b)
<.> Permutation repr b
y
infixr 4 <&>
{-# INLINE (<&>)  #-}

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

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

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

-- * Class 'Routable'
class Routable repr where
  (<!>) :: repr a -> repr b -> repr (a, b); infixr 4 <!>
  (<!>) = (Derived repr a -> Derived repr b -> Derived repr (a, b))
-> repr a -> repr b -> repr (a, b)
forall (repr :: * -> *) a b c.
LiftDerived2 repr =>
(Derived repr a -> Derived repr b -> Derived repr c)
-> repr a -> repr b -> repr c
liftDerived2 Derived repr a -> Derived repr b -> Derived repr (a, b)
forall (repr :: * -> *) a b.
Routable repr =>
repr a -> repr b -> repr (a, b)
(<!>)
  default (<!>) ::
    FromDerived2 Routable repr =>
    repr a -> repr b -> repr (a, b)

-- | Like @(,)@ but @infixr@.
-- Mostly useful for clarity when using 'Routable'.
pattern (:!:) :: a -> b -> (a, b)
pattern 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 'Voidable'
class Voidable repr where
  -- | Useful to supply @(a)@ to a @(repr)@ consuming @(a)@,
  -- for example in the format of a printing interpreter.
  void :: a -> repr a -> repr ()
  void = (Derived repr a -> Derived repr ()) -> repr a -> repr ()
forall (repr :: * -> *) a b.
LiftDerived1 repr =>
(Derived repr a -> Derived repr b) -> repr a -> repr b
liftDerived1 ((Derived repr a -> Derived repr ()) -> repr a -> repr ())
-> (a -> Derived repr a -> Derived repr ())
-> a
-> repr a
-> repr ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. a -> Derived repr a -> Derived repr ()
forall (repr :: * -> *) a. Voidable repr => a -> repr a -> repr ()
void
  default void ::
    FromDerived1 Voidable repr =>
    a -> repr a -> repr ()

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