diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,4 @@ +## 0.1.0.0 + +- Initial release +- Includes `XFreer` data type, `XApplicative` and `XMonad` classes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Evgeny Poberezkin (c) 2020 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,7 @@ +# freer-indexed + +Freer indexed (parameterized) monad for type-level resource-aware effectual operations. + +See [Parameterized Extensible Effects and Session Types](http://okmij.org/ftp/Haskell/extensible/index.html#extext). + +See [docs on hackage](http://hackage.haskell.org/package/freer-indexed/docs/Control-XFreer.html). diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/freer-indexed.cabal b/freer-indexed.cabal new file mode 100644 --- /dev/null +++ b/freer-indexed.cabal @@ -0,0 +1,66 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 17819600aa912c8d567ebcb890baa163e88586b432f075b4174db649de9ccc01 + +name: freer-indexed +version: 0.1.0.0 +synopsis: Freer indexed monad for type-level resource-aware effectual operations. +description: This package defines "freer indexed monad". It combines the ideas of freer monad and indexed (aka parameterized) monad: + . + * + * + * + . + It allows defining indexed monadic computations as GADTs without making + them into ad-hoc indexed monads, and instead use this data type + to convert them into Functor, XApplicative and XMonad instances + - see Control.XApplicative and Control.XMonad in this package. + . + This package does not (yet) allow composing these computations. + . + Semantically, these computations could represent type-level state changes + of some associated resources, with the first index parameter meaning + initial resource state prior to the computation, and the second index - + the final resource state, making each computation an edge in the graph + of resource state transitions. + . + For XApplicative/XMonad classes all class and additional functions have similar names + to standard Applicative/Monad functions, following two naming conventions: + . + * function names are prefixed with "x" (for "indeXed") - e.g. `xpure`, `xreturn`, `xliftM2` etc. + * operators are postfixed with ":" - e.g. `<*>:`, `>>=:`, `>=>:` etc. +category: Effects +homepage: https://github.com/epoberezkin/freer-indexed#readme +bug-reports: https://github.com/epoberezkin/freer-indexed/issues +author: Evgeny Poberezkin +maintainer: evgeny@poberezkin.com +copyright: 2020 Evgeny Poberezkin +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/epoberezkin/freer-indexed + +library + exposed-modules: + Control.XApplicative + Control.XFreer + Control.XMonad + Control.XMonad.Do + other-modules: + Paths_freer_indexed + hs-source-dirs: + src + ghc-options: -Wall -Wcompat -Worphans -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Wno-name-shadowing + build-depends: + base >=4.7 && <5 + default-language: Haskell2010 diff --git a/src/Control/XApplicative.hs b/src/Control/XApplicative.hs new file mode 100644 --- /dev/null +++ b/src/Control/XApplicative.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} + +-- | +-- Module : Control.XApplicative +-- Copyright : (c) Evgeny Poberezkin +-- License : BSD3 +-- +-- Maintainer : evgeny@poberezkin.com +-- Stability : experimental +-- Portability : non-portable +-- +-- This module describes an intermediate type class between +-- a functor and an indexed monad 'Control.XMonad' - an indexed applicative. +module Control.XApplicative + ( -- * XApplicative + XApplicative (..), + + -- ** Functions + (<**>:), + xliftA, + xliftA3, + ) +where + +infixl 4 <*>:, <*:, *>:, <**>: + +-- | A poly-kinded type-parameterized (indexed) functor with application, with operations to +-- +-- * embed pure expressions ('xpure'), and +-- * sequence computations and combine their results ('<*>:' and 'xliftA2'). +-- +-- These functors have kind @r -> r -> Type -> Type@, where the kind equality +-- of the of the first and the second type parameters is implied from chaining. +-- +-- A minimal complete definition must include implementations of 'xpure' +-- and of either '<*>:' or 'xliftA2'. If it defines both, then they must behave +-- the same as their default definitions: +-- +-- @('<*>:') = 'xliftA2' 'id'@ +-- +-- @'liftA2' f x y = f 'Prelude.<$>' x '<*>:' y@ +-- +-- The definition must satisfy the same laws as 'Applicative': +-- +-- [Identity] +-- +-- @'xpure' 'id' '<*>:' v = v@ +-- +-- [Composition] +-- +-- @'xpure' (.) '<*>:' u '<*>:' v '<*>:' w = u '<*>:' (v '<*>:' w)@ +-- +-- [Homomorphism] +-- +-- @'xpure' f '<*>:' 'xpure' x = 'xpure' (f x)@ +-- +-- [Interchange] +-- +-- @u '<*>:' 'xpure' y = 'xpure' ('$' y) '<*>:' u@ +-- +-- +-- The other methods have the following default definitions: +-- +-- * @u '*>:' v = ('id' '<$' u) '<*>:' v@ +-- * @u '<*:' v = 'xliftA2' 'const' u v@ +-- +-- The 'Functor' instance for @f p q@ will satisfy +-- +-- * @'fmap' f x = 'xpure' f '<*>:' x@ +-- +-- If @f@ is also an 'XMonad', it should satisfy +-- +-- * @'xpure' = 'Control.XMonad.xreturn'@ +-- * @m1 '<*>:' m2 = m1 'Control.XMonad.>>=:' (\x1 -> m2 'Control.XMonad.>>=:' (\x2 -> 'Control.XMonad.xreturn' (x1 x2)))@ +-- * @('*>:') = ('Control.XMonad.>>:')@ +class (forall p q. Functor (f p q)) => XApplicative f where + {-# MINIMAL xpure, ((<*>:) | xliftA2) #-} + + -- | Lift a value. + xpure :: a -> f p p a + + -- | Sequential application. + (<*>:) :: f p q (a -> b) -> f q r a -> f p r b + (<*>:) = xliftA2 id + + -- | Lift a binary function to type-parameterized actions. + -- + -- If 'fmap' is an expensive operation, it is likely better to use 'xliftA2' than to + -- 'fmap' over the structure and then use '<*>:'. + xliftA2 :: (a -> b -> c) -> f p q a -> f q r b -> f p r c + xliftA2 f x = (<*>:) (fmap f x) + + -- | Sequence actions, discarding the value of the first argument. + (*>:) :: f p q a -> f q r b -> f p r b + a1 *>: a2 = (id <$ a1) <*>: a2 + + -- | Sequence actions, discarding the value of the second argument. + (<*:) :: f p q a -> f q r b -> f p r a + (<*:) = xliftA2 const + +-- | A variant of '<*>:' with the arguments reversed. +(<**>:) :: XApplicative f => f p q a -> f q r (a -> b) -> f p r b +(<**>:) = xliftA2 (\a f -> f a) + +-- | Lift a function to actions. +-- This function may be used as a value for `fmap` in a `Functor` instance. +xliftA :: XApplicative f => (a -> b) -> f p q a -> f p q b +xliftA f a = xpure f <*>: a +{-# INLINEABLE xliftA #-} + +-- | Lift a ternary function to actions. +xliftA3 :: XApplicative f => (a -> b -> c -> d) -> f p q a -> f q r b -> f r l c -> f p l d +xliftA3 f a b c = xliftA2 f a b <*>: c +{-# INLINEABLE xliftA3 #-} diff --git a/src/Control/XFreer.hs b/src/Control/XFreer.hs new file mode 100644 --- /dev/null +++ b/src/Control/XFreer.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} + +-- | +-- Module : Control.XFreer +-- Copyright : (c) Evgeny Poberezkin +-- License : BSD3 +-- +-- Maintainer : evgeny@poberezkin.com +-- Stability : experimental +-- Portability : non-portable +-- +-- This module defines a "freer indexed monad" 'XFree'. +-- It generalizes freer monad to have type indices/parameters: +-- +-- * +-- * +-- * +-- +-- It defines 'Functor' instance for @'XFree' f p q@, 'XApplicative' and 'XMonad' instances for @'XFree' f@, +-- as well as 'Applicative' and 'Monad' instances for @'XFree' f p p@, where f is an effect of kind @k -> k -> Type -> Type@ +-- +-- 'XFree' simplifies defining indexed monadic computations as GADTs without making +-- them into ad-hoc indexed monads and defining all needed applicative and monadic functions on them. +-- +-- __Example__ +-- +-- Given an indexed (non-composable) effect XState that allows +-- changing data type of the stored data and tracks these changes on the type level: +-- +-- > data IxdState s s' x where +-- > XGet :: IxdState s s s +-- > XPut :: s' -> IxdState s s' () +-- +-- you can make it into an indexed monad and use it with do notation +-- (with @RebindableSyntax@ and @Control.XMonad.'Control.XMonad.Do'@) +-- with a few lines of boilerplate: +-- +-- > type XState = XFree IxdState +-- > +-- > xGet :: XState s s s +-- > xGet = xfree XGet +-- > +-- > xPut :: s' -> XState s s' () +-- > xPut = xfree . XPut +-- +-- To execute this effect you need an interpreter: +-- +-- > runXState :: XState s s' x -> s -> (x, s') +-- > runXState (Pure x) s = (x, s) +-- > runXState (Bind m j) s = +-- > let (x, s') = unIxdState m s in runXState (j x) s' +-- > +-- > unIxdState :: IxdState s s' x -> (s -> (x, s')) +-- > unIxdState XGet s = (s, s) +-- > unIxdState (XPut s) _ = ((), s) +module Control.XFreer + ( XFree (..), + xfree, + ) +where + +import Control.XApplicative +import Control.XMonad + +-- | 'XFree' is the freer indexed monad that wraps an (algebraic, non-composable) effect +-- to provide 'Functor', 'XApplicative' and 'XMonad' (indexed applicative and monad) for free. +data XFree f p q a where + Pure :: a -> XFree f p p a + Bind :: f p q x -> (x -> XFree f q r a) -> XFree f p r a + +-- | Function to convert an indexed effect to 'XFree' monad (see example above) +xfree :: f p q a -> XFree f p q a +xfree fa = Bind fa Pure + +instance Functor (XFree f p q) where + fmap f (Pure x) = Pure (f x) + fmap f (Bind u j) = Bind u (fmap f . j) + +instance XApplicative (XFree f) where + xpure = Pure + Pure f <*>: x = fmap f x + Bind u j <*>: x = Bind u ((<*>: x) . j) + +instance XMonad (XFree f) where + Pure x >>=: f = f x + Bind u f >>=: g = Bind u (f >=>: g) + +-- | @'XFree' (f p p)@ is a normal Applicative, it supports 'forever', 'traverse', 'sequenceA', etc. +instance Applicative (XFree f p p) where + pure = xpure + (<*>) = (<*>:) + +-- | @'XFree' (f p p)@ is a normal Monad, it supports 'mapM', 'forM', 'sequence', etc. +instance Monad (XFree f p p) where + (>>=) = (>>=:) diff --git a/src/Control/XMonad.hs b/src/Control/XMonad.hs new file mode 100644 --- /dev/null +++ b/src/Control/XMonad.hs @@ -0,0 +1,206 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} + +-- | +-- Module : Control.XMonad +-- Copyright : (c) Evgeny Poberezkin +-- License : BSD3 +-- +-- Maintainer : evgeny@poberezkin.com +-- Stability : experimental +-- Portability : non-portable +-- +-- 'XMonad' and 'XMonadFail type classes for type-indexed (parameterized) +-- monads with additional functions on them. +module Control.XMonad + ( -- * XMonad + XMonad (..), + + -- ** XMonad functions + (=<<:), + xliftM, + xliftM2, + xliftM3, + xap, + xjoin, + (>=>:), + (<=<:), + (<$!>:), + + -- * XMonadFail + XMonadFail (..), + ) +where + +import Control.XApplicative + +infixl 1 >>:, >>=: + +infixr 1 =<<:, <=<:, >=>: + +-- | The 'XMonad' class defines the basic operations over a +-- parameterized (indexed) /monad/, where two type parameters must be +-- correctly chained. +-- +-- These monads have been described by Oleg Kiselyov in +-- +-- +-- Indexed monads have been previously released by Edward A. Kmett and Reiner Pope +-- as the package - +-- this package adds other monadic functions and freer indexed monad 'Control.XFreer.XFree'. +-- +-- Semantically, these computations can represent type-level state changes +-- of some associated resource, with the first index parameter meaning +-- initial resource state prior to the computation, and the second index - +-- the final resource state, making each computation an edge in the graph +-- of resource state transitions. +-- +-- Chained type parameters in bind operation require that associated +-- resource changes are continuos. +-- +-- When combined with computations defined as GADTs and singleton types +-- they can be used to limit allowed computations depending on the context +-- (that is reflected in the final type of the previous and initial type +-- of the next computations) and to make type-level state transitions dependent on the +-- run-time parameters and also on the results of the previous computations. +-- +-- @do@ expressions can support such parameterized monads using +-- +-- extension and @Control.XMonad.'Control.XMonad.Do'@ module (it has to be imported separately). +-- +-- If your code contains any action that can fail (e.g. "monadic" binding with +-- a potentially incomplete pattern match, your computation needs to be an instance +-- of 'XMonadFail' as well to be used in @do@ expression. +-- +-- To use @do@ expressions 'GHC.Base.Prelude' has to be explicitly imported hiding monad operators: +-- +-- > import Prelude hiding ((>>), (>>=)) +-- +-- Instances of 'XMonad' should satisfy the same laws as 'Monad': +-- +-- [Left identity] @'xreturn' a '>>=:' k = k a@ +-- [Right identity] @m '>>=:' 'xreturn' = m@ +-- [Associativity] @m '>>=:' (\\x -> k x '>>=:' h) = (m '>>=:' k) '>>=:' h@ +-- +-- 'XMonad' and 'XApplicative' operations should relate as follows: +-- +-- * @'xpure' = 'xreturn'@ +-- * @mf '<*>:' m = mf '>>=:' (\\f -> m '>>=:' (\\x -> 'xreturn' (f x)))@ +-- +-- The above laws imply: +-- +-- * @'fmap' f xs = xs '>>=:' 'xreturn' . f@ +-- * @('>>:') = ('*>:')@ +-- +-- and that 'xpure' and ('<*>:') satisfy the applicative functor laws. +class XApplicative m => XMonad m where + -- | Sequentially compose two parameterized actions, passing any value produced + -- by the first as an argument to the second, and ensuring the continuity in + -- type parameters changes. + (>>=:) :: forall a b p q r. m p q a -> (a -> m q r b) -> m p r b + + -- | Sequentially compose two actions, discarding any value produced + -- by the first, and ensuring the continuity in type parameters changes. + (>>:) :: forall a b p q r. m p q a -> m q r b -> m p r b + m >>: k = m >>=: \_ -> k + {-# INLINE (>>:) #-} + + -- | Inject a value into the monadic type. + xreturn :: a -> m p p a + xreturn = xpure + +(=<<:) :: XMonad m => (a -> m q r b) -> m p q a -> m p r b +f =<<: x = x >>=: f + +-- | Promote a function to XMonad. +xliftM :: (XMonad m) => (a -> r) -> m p q a -> m p q r +xliftM f m = m >>=: \x -> xreturn (f x) +{-# INLINEABLE xliftM #-} + +-- | Promote a binary function to XMonad, scanning the monadic arguments from left to right. +xliftM2 :: (XMonad m) => (a -> b -> c) -> m p q a -> m q r b -> m p r c +xliftM2 f m1 m2 = + m1 >>=: \x1 -> + m2 >>=: \x2 -> + xreturn (f x1 x2) +{-# INLINEABLE xliftM2 #-} + +-- | Promote a function to a monad, scanning the monadic arguments from left to right. +xliftM3 :: (XMonad m) => (a -> b -> c -> d) -> m p q a -> m q r b -> m r s c -> m p s d +xliftM3 f m1 m2 m3 = + m1 >>=: \x1 -> + m2 >>=: \x2 -> + m3 >>=: \x3 -> + xreturn (f x1 x2 x3) +{-# INLINEABLE xliftM3 #-} + +-- | 'liftXM' operations can be replaced by uses of 'ap', which promotes function application. +-- +-- > return f `ap` x1 `ap` ... `ap` xn +-- +-- is equivalent to +-- +-- > liftMn f x1 x2 ... xn +xap :: (XMonad m) => m p q (a -> b) -> m q r a -> m p r b +xap m1 m2 = + m1 >>=: \x1 -> + m2 >>=: \x2 -> + xreturn (x1 x2) +{-# INLINEABLE xap #-} + +-- | The 'xjoin' function removes one level of indexed monadic structure, projecting its +-- bound argument into the outer level. +-- +-- \'@'join' bss@\' can be understood as the @do@ expression +-- +-- @ +-- do bs <- bss +-- bs +-- @ +-- +-- Please note the chaining order of type parameters - from outside to inside. +xjoin :: (XMonad m) => m p q (m q r a) -> m p r a +xjoin m = m >>=: id + +-- | Left-to-right composition of Kleisli arrows. +-- +-- \'@(f '>=>:' g) a@\' is equivalent to @\\x -> f x '>>=:' g@ +(>=>:) :: XMonad m => (a -> m p q b) -> (b -> m q r c) -> (a -> m p r c) +f >=>: g = \x -> f x >>=: g + +-- | Right-to-left composition of Kleisli arrows. +-- Same as @('>=>:')@, with the arguments flipped. +-- +-- This operator resembles function composition @('.')@: +-- +-- > (.) :: (b -> c) -> (a -> b) -> a -> c +-- > (<=<:) :: XMonad m => (b -> m q r c) -> (a -> m p q b) -> a -> m p r c +(<=<:) :: XMonad m => (b -> m q r c) -> (a -> m p q b) -> (a -> m p r c) +(<=<:) = flip (>=>:) + +infixl 4 <$!>: + +-- | Strict version of 'Data.Functor.<$>' for indexed monads. +(<$!>:) :: XMonad m => (a -> b) -> m p q a -> m p q b +{-# INLINE (<$!>:) #-} +f <$!>: m = + m >>=: \x -> + let z = f x + in z `seq` xreturn z + +-- | When a type-indexed computation value is bound in @do@-notation (using RebindableSyntax for 'XMonad'), +-- the pattern on the left hand side of @<-@ might not match. In this case, this class +-- provides a function 'xfail' to recover. +-- +-- An 'XMonad' without an 'XMonadFail' instance may only be used in conjunction +-- with pattern that always match, such as newtypes, tuples, data types with +-- only a single data constructor, and irrefutable patterns (@~pat@). +-- +-- Instances of 'XMonadFail' should satisfy the following law: @xfail s@ should +-- be a left zero for '>>=:'. +-- +-- @ +-- xfail s >>=: f = xfail s +-- @ +class XMonad m => XMonadFail m where + xfail :: String -> m p q a diff --git a/src/Control/XMonad/Do.hs b/src/Control/XMonad/Do.hs new file mode 100644 --- /dev/null +++ b/src/Control/XMonad/Do.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE PolyKinds #-} + +-- | +-- Module : Control.XMonad.Do +-- Copyright : (c) Evgeny Poberezkin +-- License : BSD3 +-- +-- Maintainer : evgeny@poberezkin.com +-- Stability : experimental +-- Portability : non-portable +-- +-- This module re-defines standard monadic operations to allow @do@ expressions +-- with indexed monad 'XMonad' instances using +-- extension. +-- +-- In addition to importing this module (it is not re-exported by @Control.'XMonad'@), +-- you have to explicitly import Prelude (or any replacement) hiding standard monadic operations: +-- +-- > import Prelude hiding (fail, (>>), (>>=)) +-- +-- 'fail' is only needed if your indexed monad is also an instance of 'XMonadFail'. +-- +-- You cannot combine @do@ expressions for normal and indexed monads in the same module. +module Control.XMonad.Do + ( -- * Monadic functions + (>>=), + (>>), + fail, + ) +where + +import Control.XMonad +import Prelude hiding (fail, (>>), (>>=)) + +infixl 1 >>=, >> + +(>>=) :: XMonad m => m i j a -> (a -> m j k b) -> m i k b +(>>=) = (>>=:) + +(>>) :: XMonad m => m i j a -> m j k b -> m i k b +(>>) = (>>:) + +fail :: XMonadFail m => String -> m i j a +fail = xfail