]> Git — Sourcephile - haskell/symantic.git/blob - symantic-lib/Language/Symantic/Lib/MonoFoldable.hs
Remove need for space after infix operator.
[haskell/symantic.git] / symantic-lib / Language / Symantic / Lib / MonoFoldable.hs
1 {-# LANGUAGE UndecidableInstances #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3 -- | Symantic for 'MonoFoldable'.
4 module Language.Symantic.Lib.MonoFoldable where
5
6 import Data.MonoTraversable (MonoFoldable)
7 import qualified Data.MonoTraversable as MT
8
9 import Language.Symantic
10 import Language.Symantic.Lib.Bool (tyBool)
11 import Language.Symantic.Lib.Function ()
12 import Language.Symantic.Lib.Int (tyInt)
13 import Language.Symantic.Lib.List (tyList)
14 import Language.Symantic.Lib.MonoFunctor (famElement, o0, e1)
15 import Language.Symantic.Lib.Monoid (tyMonoid)
16
17 -- * Class 'Sym_MonoFoldable'
18 type instance Sym MonoFoldable = Sym_MonoFoldable
19 class Sym_MonoFoldable term where
20 ofoldMap :: (MonoFoldable o, Monoid m) => term (MT.Element o -> m) -> term o -> term m
21 ofoldr :: MonoFoldable o => term (MT.Element o -> b -> b) -> term b -> term o -> term b
22 ofoldl' :: MonoFoldable o => term (b -> MT.Element o -> b) -> term b -> term o -> term b
23 olength :: MonoFoldable o => term o -> term Int
24 onull :: MonoFoldable o => term o -> term Bool
25 oall :: MonoFoldable o => term (MT.Element o -> Bool) -> term o -> term Bool
26 oany :: MonoFoldable o => term (MT.Element o -> Bool) -> term o -> term Bool
27 otoList :: MonoFoldable o => term o -> term [MT.Element o]
28 default ofoldMap :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => Monoid m => term (MT.Element o -> m) -> term o -> term m
29 default ofoldr :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term (MT.Element o -> b -> b) -> term b -> term o -> term b
30 default ofoldl' :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term (b -> MT.Element o -> b) -> term b -> term o -> term b
31 default olength :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term o -> term Int
32 default onull :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term o -> term Bool
33 default oall :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term (MT.Element o -> Bool) -> term o -> term Bool
34 default oany :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term (MT.Element o -> Bool) -> term o -> term Bool
35 default otoList :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term o -> term [MT.Element o]
36 ofoldMap = trans2 ofoldMap
37 ofoldr = trans3 ofoldr
38 ofoldl' = trans3 ofoldl'
39 olength = trans1 olength
40 onull = trans1 onull
41 oall = trans2 oall
42 oany = trans2 oany
43 otoList = trans1 otoList
44
45 -- Interpreting
46 instance Sym_MonoFoldable Eval where
47 ofoldMap = eval2 MT.ofoldMap
48 ofoldr = eval3 MT.ofoldr
49 ofoldl' = eval3 MT.ofoldl'
50 olength = eval1 MT.olength
51 onull = eval1 MT.onull
52 oall = eval2 MT.oall
53 oany = eval2 MT.oany
54 otoList = eval1 MT.otoList
55 instance Sym_MonoFoldable View where
56 ofoldMap = view2 "ofoldMap"
57 ofoldr = view3 "ofoldr"
58 ofoldl' = view3 "ofoldl'"
59 olength = view1 "olength"
60 onull = view1 "onull"
61 oall = view2 "oall"
62 oany = view2 "oany"
63 otoList = view1 "otoList"
64 instance (Sym_MonoFoldable r1, Sym_MonoFoldable r2) => Sym_MonoFoldable (Dup r1 r2) where
65 ofoldMap = dup2 @Sym_MonoFoldable ofoldMap
66 ofoldr = dup3 @Sym_MonoFoldable ofoldr
67 ofoldl' = dup3 @Sym_MonoFoldable ofoldl'
68 olength = dup1 @Sym_MonoFoldable olength
69 onull = dup1 @Sym_MonoFoldable onull
70 oall = dup2 @Sym_MonoFoldable oall
71 oany = dup2 @Sym_MonoFoldable oany
72 otoList = dup1 @Sym_MonoFoldable otoList
73
74 -- Transforming
75 instance (Sym_MonoFoldable term, Sym_Lambda term) => Sym_MonoFoldable (BetaT term)
76
77 -- Typing
78 instance NameTyOf MonoFoldable where
79 nameTyOf _c = ["MonoFoldable"] `Mod` "MonoFoldable"
80 instance FixityOf MonoFoldable
81 instance ClassInstancesFor MonoFoldable
82 instance TypeInstancesFor MonoFoldable
83
84 -- Compiling
85 instance Gram_Term_AtomsFor src ss g MonoFoldable
86 instance (Source src, SymInj ss MonoFoldable) => ModuleFor src ss MonoFoldable where
87 moduleFor = ["MonoFoldable"] `moduleWhere`
88 [ "ofoldMap" := teMonoFoldable_ofoldMap
89 , "otoList" := teMonoFoldable_otoList
90 , "ofoldr" := teMonoFoldable_ofoldr
91 , "ofoldl'" := teMonoFoldable_ofoldl'
92 , "olength" := teMonoFoldable_olength
93 , "onull" := teMonoFoldable_onull
94 , "oall" := teMonoFoldable_oall
95 , "oany" := teMonoFoldable_oany
96 ]
97
98 -- ** 'Type's
99 tyMonoFoldable :: Source src => Type src vs a -> Type src vs (MonoFoldable a)
100 tyMonoFoldable a = tyConstLen @(K MonoFoldable) @MonoFoldable (lenVars a) `tyApp` a
101
102 -- ** 'Term's
103 teMonoFoldable_ofoldMap :: TermDef MonoFoldable '[Proxy o, Proxy e, Proxy m] (MonoFoldable o # Monoid m # e #~ MT.Element o #> ((e -> m) -> o -> m))
104 teMonoFoldable_ofoldMap = Term (tyMonoFoldable o0 # tyMonoid m # e1 #~ famElement o0) ((e1 ~> m) ~> o0 ~> m) $ teSym @MonoFoldable $ lam2 ofoldMap
105 where
106 m :: Source src => LenInj vs => KindInj (K m) => Type src (Proxy a ': Proxy b ': Proxy m ': vs) m
107 m = tyVar "m" $ VarS $ VarS varZ
108
109 teMonoFoldable_otoList :: TermDef MonoFoldable '[Proxy o, Proxy e] (MonoFoldable o # e #~ MT.Element o #> (o -> [MT.Element o]))
110 teMonoFoldable_otoList = Term (tyMonoFoldable o0 # e1 #~ famElement o0) (o0 ~> tyList (famElement o0)) $ teSym @MonoFoldable $ lam1 otoList
111
112 teMonoFoldable_ofoldr :: TermDef MonoFoldable '[Proxy o, Proxy e, Proxy a] (MonoFoldable o # e #~ MT.Element o #> ((e -> a -> a) -> a -> o -> a))
113 teMonoFoldable_ofoldr = Term (tyMonoFoldable o0 # e1 #~ famElement o0) ((e1 ~> a ~> a) ~> a ~> o0 ~> a) $ teSym @MonoFoldable $ lam1 $ \f -> lam $ lam . ofoldr f
114 where
115 a :: Source src => LenInj vs => KindInj (K a) => Type src (Proxy _a ': Proxy b ': Proxy a ': vs) a
116 a = tyVar "a" $ VarS $ VarS varZ
117
118 teMonoFoldable_ofoldl' :: TermDef MonoFoldable '[Proxy o, Proxy e, Proxy a] (MonoFoldable o # e #~ MT.Element o #> ((a -> e -> a) -> a -> o -> a))
119 teMonoFoldable_ofoldl' = Term (tyMonoFoldable o0 # e1 #~ famElement o0) ((a ~> e1 ~> a) ~> a ~> o0 ~> a) $ teSym @MonoFoldable $ lam1 $ \f -> lam $ lam . ofoldl' f
120 where
121 a :: Source src => LenInj vs => KindInj (K a) => Type src (Proxy _a ': Proxy b ': Proxy a ': vs) a
122 a = tyVar "a" $ VarS $ VarS varZ
123
124 teMonoFoldable_olength :: TermDef MonoFoldable '[Proxy o, Proxy e] (MonoFoldable o # e #~ MT.Element o #> (o -> Int))
125 teMonoFoldable_olength = Term (tyMonoFoldable o0 # e1 #~ famElement o0) (o0 ~> tyInt) $ teSym @MonoFoldable $ lam1 olength
126
127 teMonoFoldable_onull :: TermDef MonoFoldable '[Proxy o] (MonoFoldable o #> (o -> Bool))
128 teMonoFoldable_onull = Term (tyMonoFoldable o0) (o0 ~> tyBool) $ teSym @MonoFoldable $ lam1 onull
129
130 teMonoFoldable_oall :: TermDef MonoFoldable '[Proxy o, Proxy e] (MonoFoldable o # e #~ MT.Element o #> ((e -> Bool) -> o -> Bool))
131 teMonoFoldable_oall = Term (tyMonoFoldable o0 # e1 #~ famElement o0) ((e1 ~> tyBool) ~> o0 ~> tyBool) $ teSym @MonoFoldable $ lam2 oall
132
133 teMonoFoldable_oany :: TermDef MonoFoldable '[Proxy o, Proxy e] (MonoFoldable o # e #~ MT.Element o #> ((e -> Bool) -> o -> Bool))
134 teMonoFoldable_oany = Term (tyMonoFoldable o0 # e1 #~ famElement o0) ((e1 ~> tyBool) ~> o0 ~> tyBool) $ teSym @MonoFoldable $ lam2 oany