lude

Haskell prelude alternative
git clone git://git.rr3.xyz/lude | git clone gits://git.rr3.xyz/lude
Log | Files | Refs | README | LICENSE

Monad.hs (2320B)


      1 {-# LANGUAGE UndecidableInstances #-}
      2 
      3 module Lude.Algebra.Category.Monad (
      4     Monadic (..),
      5     MonadicOn,
      6     --
      7     (>>=),
      8     (=<<),
      9     (>>),
     10     (<<),
     11 ) where
     12 
     13 import Data.Coerce
     14 import Prelude qualified as Base
     15 
     16 import Lude.Algebra.Category.Core
     17 import Lude.Function (const, flip)
     18 import Lude.Haskell
     19 import Lude.IO
     20 import Lude.List
     21 import Lude.Maybe
     22 
     23 -- TODO: Make applicative/monoidal functors a superclass.
     24 
     25 -- TODO: Comonads
     26 
     27 --------------------------------------------------------------------------------
     28 
     29 type Monadic :: forall {i}. Endo i -> Constraint
     30 class (Endofunctorial f) => Monadic (f :: Endo i) where
     31     {-# MINIMAL pure, (join | bind) #-}
     32 
     33     -- NOTE: We unwrap the natural transformations so we don't have to use
     34     -- nominal Identity and Compose types.
     35 
     36     pure :: forall (a :: i). (ObjArg f a) => Dom f a (f a)
     37 
     38     join :: forall (a :: i). (ObjArg f a) => Dom f (f (f a)) (f a)
     39     join = bind identity \\ f `preservesObj` a
     40 
     41     bind :: forall (a :: i) (b :: i). (ObjArg f b) => Dom f a (f b) -> Dom f (f a) (f b)
     42     bind f = join . map f
     43 
     44 type MonadicOn :: forall {i}. Cat i -> Endo i -> Constraint
     45 class (Monadic f, Dom f ~ p) => MonadicOn p f
     46 instance (Monadic f, Dom f ~ p) => MonadicOn p f
     47 
     48 --------------------------------------------------------------------------------
     49 -- Haskell
     50 
     51 -- TODO: Generalize to internal hom
     52 instance Monadic ((->) r) where
     53     pure x = \_ -> x
     54     join mm = \c -> mm c c
     55     bind k m = \c -> k (m c) c
     56 
     57 (>>=) :: forall f a b. (MonadicOn Function f) => f a -> (a -> f b) -> f b
     58 (>>=) = flip bind
     59 infixl 1 >>=
     60 
     61 (=<<) :: forall f a b. (MonadicOn Function f) => (a -> f b) -> f a -> f b
     62 (=<<) = bind
     63 infixr 1 =<<
     64 
     65 (>>) :: forall f a b. (MonadicOn Function f) => f a -> f b -> f b
     66 fa >> fb = bind (const fb) fa
     67 infixl 1 >>
     68 
     69 (<<) :: forall f a b. (MonadicOn Function f) => f a -> f b -> f a
     70 fa << fb = bind (\a -> fb >> pure a) fa
     71 infixr 1 <<
     72 
     73 --------------------------------------------------------------------------------
     74 -- Interop
     75 
     76 instance (Base.Monad f) => Monadic (BaseInterop1 f) where
     77     pure = coerce Base.return
     78     join = coerce (Base.>>= unBaseInterop1)
     79     bind = coerce (Base.=<<)
     80 
     81 deriving via BaseInterop1 IO instance Monadic IO
     82 deriving via BaseInterop1 List instance Monadic List
     83 deriving via BaseInterop1 Maybe instance Monadic Maybe