]> Git — Sourcephile - haskell/symantic-parser.git/blob - src/Symantic/Base/Univariant.hs
add GramDump and migrate to HLS
[haskell/symantic-parser.git] / src / Symantic / Base / Univariant.hs
1 {-# LANGUAGE DefaultSignatures #-}
2 module Symantic.Base.Univariant where
3
4 -- TODO: move to symantic-base
5
6 import Data.Function ((.))
7
8 -- * Type family 'Unlift'
9 type family Unlift (repr :: * -> *) :: * -> *
10
11 -- * Class 'Unliftable'
12 class Unliftable repr where
13 unlift :: repr a -> Unlift repr a
14
15 -- * Class 'Liftable'
16 class Liftable repr where
17 lift :: Unlift repr a -> repr a
18 lift1 :: (Unlift repr a -> Unlift repr b) ->
19 repr a -> repr b
20 lift2 :: (Unlift repr a -> Unlift repr b -> Unlift repr c) ->
21 repr a -> repr b -> repr c
22 lift3 :: (Unlift repr a -> Unlift repr b -> Unlift repr c -> Unlift repr d) ->
23 repr a -> repr b -> repr c -> repr d
24 default lift1 ::
25 Unliftable repr =>
26 (Unlift repr a -> Unlift repr b) ->
27 repr a -> repr b
28 default lift2 ::
29 Unliftable repr =>
30 (Unlift repr a -> Unlift repr b -> Unlift repr c) ->
31 repr a -> repr b -> repr c
32 default lift3 ::
33 Unliftable repr =>
34 (Unlift repr a -> Unlift repr b -> Unlift repr c -> Unlift repr d) ->
35 repr a -> repr b -> repr c -> repr d
36 lift1 f = lift . f . unlift
37 lift2 f a b = lift (f (unlift a) (unlift b))
38 lift3 f a b c = lift (f (unlift a) (unlift b) (unlift c))
39 {-# INLINE lift1 #-}
40 {-# INLINE lift2 #-}
41 {-# INLINE lift3 #-}