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