]> Git — Sourcephile - haskell/symantic-base.git/blob - src/Symantic/Semantics/ToFer.hs
iface: add instance `Eq Endpoint` and `Show Endpoint`
[haskell/symantic-base.git] / src / Symantic / Semantics / ToFer.hs
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE ConstraintKinds #-}
3 {-# LANGUAGE DataKinds #-}
4 {-# LANGUAGE InstanceSigs #-}
5 {-# LANGUAGE RankNTypes #-}
6 {-# LANGUAGE UndecidableInstances #-}
7
8 module Symantic.Semantics.ToFer where
9
10 import Control.Monad (Monad, (>=>))
11 import Data.Function qualified as Fun
12 import Data.Functor (Functor, (<$>))
13 import GHC.Generics (Generic)
14
15 import Symantic.Syntaxes.Classes
16 import Symantic.Syntaxes.EithersOfTuples
17 import Symantic.Syntaxes.TuplesOfFunctions
18
19 -- * Type 'TuplesOfFunctions'
20
21 -- | The 'ToFer' intermediate interpreter
22 -- return Tuples-of-Functions instead of Eithers-of-Tuples.
23 --
24 -- In other words, it transforms 'SumFunctor' into functions returning @(sem next)@
25 -- and 'ProductFunctor' into arguments of those functions.
26 --
27 -- This is like using an extension parameter introduced in
28 -- https://okmij.org/ftp/typed-formatting/index.html#DSL-FIn
29 -- but here only a single type parameter @(a)@ is exposed
30 -- instead of two.
31 --
32 -- Useful to avoid declaring and pattern-matching
33 -- an algebraic datatype of type @(a)@,
34 -- as the corresponding function will be called directly,
35 -- given as arguments the terms that would have been
36 -- pattern-matched from a constructor
37 -- of such algebraic datatype.
38 data ToFer sem a = ToFer
39 { tuplesOfFunctions :: forall next. ToF a next -> sem next
40 , eithersOfTuples :: sem a
41 }
42
43 instance (ProductFunctor sem, Monad sem) => ProductFunctor (ToFer sem) where
44 a <.> b =
45 ToFer
46 { tuplesOfFunctions = tuplesOfFunctions a >=> tuplesOfFunctions b
47 , eithersOfTuples = eithersOfTuples a <.> eithersOfTuples b
48 }
49 a .> b =
50 ToFer
51 { tuplesOfFunctions = tuplesOfFunctions a >=> tuplesOfFunctions b
52 , eithersOfTuples = eithersOfTuples a .> eithersOfTuples b
53 }
54 a <. b =
55 ToFer
56 { tuplesOfFunctions = tuplesOfFunctions a >=> tuplesOfFunctions b
57 , eithersOfTuples = eithersOfTuples a <. eithersOfTuples b
58 }
59 instance (SumFunctor sem, AlternativeFunctor sem) => SumFunctor (ToFer sem) where
60 a <+> b =
61 ToFer
62 { tuplesOfFunctions = \(l, r) -> tuplesOfFunctions a l <|> tuplesOfFunctions b r
63 , eithersOfTuples = eithersOfTuples a <+> eithersOfTuples b
64 }
65 instance (Optionable sem, Functor sem) => Optionable (ToFer sem) where
66 optional ma = ToFer{tuplesOfFunctions = (<$> sem), eithersOfTuples = sem}
67 where
68 sem = optional (eithersOfTuples ma)
69 instance Functor sem => Dataable (ToFer sem) where
70 data_ ::
71 forall a.
72 Generic a =>
73 RepOfEoT a =>
74 EoTOfRep a =>
75 UnToF a =>
76 ToFer sem (EoT (ADT a)) ->
77 ToFer sem a
78 data_ a =
79 ToFer
80 { tuplesOfFunctions = \f -> unToF @(IsToF a) @a f Fun.. adtOfeot <$> eithersOfTuples a
81 , eithersOfTuples = adtOfeot <$> eithersOfTuples a
82 }