Code cleanup; coding style

README.md

@@ -14,6 +14,7 @@ Library `freer-effects` is an implementation of effect system for Haskell,
 which is based on the work of Oleg Kiselyov et al.:
 
 * [Freer Monads, More Extensible Effects](http://okmij.org/ftp/Haskell/extensible/more.pdf)
+* [Reflection without Remorse](http://okmij.org/ftp/Haskell/zseq.pdf)
 * [Extensible Effects](http://okmij.org/ftp/Haskell/extensible/exteff.pdf)
 
 Much of the implementation is a repackaging and cleaning up of the reference

freer-effects.cabal

@@ -6,6 +6,7 @@ description:
   Oleg Kiselyov et al.:
   .
   * <http://okmij.org/ftp/Haskell/extensible/more.pdf Freer Monads, More Extensible Effects>
+  * <http://okmij.org/ftp/Haskell/zseq.pdf Reflection without Remorse>
   * <http://okmij.org/ftp/Haskell/extensible/exteff.pdf Extensible Effects>
   .
   The key features are:

src/Data/FTCQueue.hs

@@ -1,79 +1,77 @@
 {-# LANGUAGE GADTs #-}
-
-{-|
-Module      : Data.FTCQueue
-Description : Fast type-aligned queue optimized to effectful functions.
-Copyright   : Allele Dev 2016
-License     : BSD-3
-Maintainer  : allele.dev@gmail.com
-Stability   : experimental
-Portability : POSIX
-
-* Constant-time append/(><) and snoc/(|>)
-* Average constant-time viewL (left-edge deconstruction)
-
-Using <http://okmij.org/ftp/Haskell/extensible/FTCQueue1.hs> as a
-starting point.
-
-A minimal version of FTCQueue from "Reflection w/o Remorse":
-
-* research: http://okmij.org/ftp/Haskell/Reflection.html
-* type-aligned(FTCQueue): https://hackage.haskell.org/package/type-aligned
-
--}
-module Data.FTCQueue (
-  FTCQueue,
-  tsingleton,
-  (|>),
-  snoc,
-  (><),
-  append,
-  ViewL(..),
-  tviewl
-) where
-
 -- |
--- Non-empty tree. Deconstruction operations make it more and more
+-- Module:       Data.FTCQueue
+-- Description:  Fast type-aligned queue optimized to effectful functions.
+-- Copyright:    (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.
+-- License:      BSD3
+-- Maintainer:   ixcom-core@ixperta.com
+-- Stability:    experimental
+-- Portability:  POSIX
+--
+-- * Constant-time append\/('><') and snoc\/('|>')
+-- * Average constant-time 'viewL' (left-edge deconstruction).
+--
+-- Using <http://okmij.org/ftp/Haskell/extensible/FTCQueue1.hs> as a starting
+-- point.
+--
+-- A minimal version of FTCQueue from "Reflection w/o Remorse":
+--
+-- * Research: <http://okmij.org/ftp/Haskell/Reflection.html>
+-- * <https://hackage.haskell.org/package/type-aligned type-aligned> (FTCQueue)
+module Data.FTCQueue
+    ( FTCQueue
+    , tsingleton
+    , (|>)
+    , snoc
+    , (><)
+    , append
+    , ViewL(..)
+    , tviewl
+    )
+  where
+
+
+-- | Non-empty tree. Deconstruction operations make it more and more
 -- left-leaning
 data FTCQueue m a b where
-  Leaf :: (a -> m b) -> FTCQueue m a b
+    Leaf :: (a -> m b) -> FTCQueue m a b
-  Node :: FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
+    Node :: FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
 
-{-# INLINE tsingleton #-}
+-- | Build a leaf from a single operation. [O(1)]
--- | Build a leaf from a single operation [O(1)]
 tsingleton :: (a -> m b) -> FTCQueue m a b
 tsingleton = Leaf
+{-# INLINE tsingleton #-}
 
-{-# INLINE (|>) #-}
+-- | Append an operation to the right of the tree. [O(1)]
--- | Append an operation to the right of the tree [O(1)]
 (|>) :: FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
 t |> r = Node t (Leaf r)
+{-# INLINE (|>) #-}
 
-{-# INLINE snoc #-}
 -- | An alias for '(|>)'
 snoc :: FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
 snoc = (|>)
+{-# INLINE snoc #-}
 
-{-# INLINE (><) #-}
+-- | Append two trees of operations. [O(1)]
--- | Append two trees of operations [O(1)]
 (><)   :: FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
 t1 >< t2 = Node t1 t2
+{-# INLINE (><) #-}
 
-{-# INLINE append #-}
 -- | An alias for '(><)'
 append :: FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
 append = (><)
+{-# INLINE append #-}
 
--- | Left view deconstruction data structure
+-- | Left view deconstruction data structure.
 data ViewL m a b where
-  TOne  :: (a -> m b) -> ViewL m a b
+    TOne  :: (a -> m b) -> ViewL m a b
-  (:|)  :: (a -> m x) -> FTCQueue m x b -> ViewL m a b
+    (:|)  :: (a -> m x) -> FTCQueue m x b -> ViewL m a b
 
--- | Left view deconstruction [average O(1)]
+-- | Left view deconstruction. [average O(1)]
 tviewl :: FTCQueue m a b -> ViewL m a b
 tviewl (Leaf r) = TOne r
 tviewl (Node t1 t2) = go t1 t2
- where
+  where
-   go :: FTCQueue m a x -> FTCQueue m x b -> ViewL m a b
+    go :: FTCQueue m a x -> FTCQueue m x b -> ViewL m a b
-   go (Leaf r) tr = r :| tr
+    go (Leaf r) tr = r :| tr
-   go (Node tl1 tl2) tr = go tl1 (Node tl2 tr)
+    go (Node tl1 tl2) tr = go tl1 (Node tl2 tr)

src/Data/Open/Union.hs

@@ -1,52 +1,69 @@
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE CPP #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE DataKinds, PolyKinds #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
+-- |
+-- Module:       Data.Open.Union
+-- Description:  Open unions (type-indexed co-products) for extensible effects.
+-- Copyright:    (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.
+-- License:      BSD3
+-- Maintainer:   ixcom-core@ixperta.com
+-- Stability:    experimental
+-- Portability:  POSIX
+--
+-- This implementation relies on _closed_ type families added to GHC 7.8. It
+-- has NO overlapping instances and NO @Typeable@. Alas, the absence of
+-- @Typeable@ means the projections and injections generally take linear time.
+-- The code illustrate how to use closed type families to disambiguate
+-- otherwise overlapping instances.
+--
+-- The data constructors of 'Union' are not exported. Essentially, the nested
+-- 'Either' data type.
+--
+-- Using <http://okmij.org/ftp/Haskell/extensible/OpenUnion41.hs> as a starting
+-- point.
+module Data.Open.Union
+    (
+    -- * Open Union
+      Union
 
-{-|
+    -- * Open Union Operations
-Module      : Data.Open.Union
+    , decomp
-Description : Open unions (type-indexed co-products) for extensible effects.
+    , weaken
-Copyright   : Allele Dev 2016
+    , extract
-License     : BSD-3
-Maintainer  : allele.dev@gmail.com
-Stability   : experimental
-Portability : POSIX
 
-This implementation relies on _closed_ type families added to GHC
+    -- * Open Union Membership Constraints
-7.8. It has NO overlapping instances and NO Typeable. Alas, the
+    , Member(..)
-absence of Typeable means the projections and injections generally
+    , Members
-take linear time.  The code illustrate how to use closed type families
-to disambiguate otherwise overlapping instances.
 
-The data constructors of Union are not exported. Essentially, the
+    -- * Re-exported
-nested Either data type.
+    , Functor(..)
+    )
+  where
 
-Using <http://okmij.org/ftp/Haskell/extensible/OpenUnion41.hs> as a
+#if MIN_VERSION_base(4,9,0)
-starting point.
+import Data.Kind (Constraint)
+#else
+import GHC.Exts (Constraint)
+#endif
 
--}
-
-module Data.Open.Union (
-  module Data.Open.Union,
-  Union,
-  Member(..),
-  decomp,
-  weaken,
-  extract,
-  Functor(..)
-) where
-
-import GHC.Exts
 import Data.Open.Union.Internal
+    ( Member(inj, prj)
+    , Union
+    , decomp
+    , extract
+    , weaken
+    )
+
 
---------------------------------------------------------------------------------
-                           -- Interface --
---------------------------------------------------------------------------------
 type family Members m r :: Constraint where
-  Members (t ': c) r = (Member t r, Members c r)
+    Members (t ': c) r = (Member t r, Members c r)
-  Members '[] r = ()
+    Members '[] r = ()
-

src/Data/Open/Union/Internal.hs

@@ -1,46 +1,65 @@
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE DataKinds, PolyKinds #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
-
+-- |
+-- Module:       Control.Monad.Freer
+-- Description:  Open unions (type-indexed co-products) for extensible effects.
+--
+-- Copyright:    (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.
+-- License:      BSD3
+-- Maintainer:   ixcom-core@ixperta.com
+-- Stability:    experimental
+-- Portability:  POSIX
+--
+-- These are internal definitions and should be used with caution. There are no
+-- guarantees that the API of this module will be preserved between minor
+-- versions of this package.
 module Data.Open.Union.Internal where
 
+
 data Union (r :: [ * -> * ]) v where
   UNow  :: t v -> Union (t ': r) v
   UNext :: Union (t ': r) v -> Union (any ': t ': r) v
 
+-- | Type level naturals are used to disambiguate otherwise overlapping
+-- instances when iterating through a type list.
 data Nat = S Nat | Z
+
+-- | Represents position @(n :: 'Nat')@ in a type list.
 data P (n :: Nat) = P
 
--- injecting/projecting at a specified position P n
+-- | Injecting\/projecting at a specified position @P n@.
 class Member' t r (n :: Nat) where
-  inj' :: P n -> t v -> Union r v
+    inj' :: P n -> t v -> Union r v
-  prj' :: P n -> Union r v -> Maybe (t v)
+    prj' :: P n -> Union r v -> Maybe (t v)
 
 instance (r ~ (t ': r')) => Member' t r 'Z where
-  inj' _ = UNow
+    inj' _ = UNow
-  prj' _ (UNow x) = Just x
+    prj' _ (UNow x) = Just x
-  prj' _ _        = Nothing
+    prj' _ _        = Nothing
 
 instance (r ~ (t' ': r' ': rs'), Member' t (r' ': rs') n) => Member' t r ('S n) where
-  inj' _ = UNext . inj' (P::P n)
+    inj' _ = UNext . inj' (P::P n)
-  prj' _ (UNow _)  = Nothing
+    prj' _ (UNow _)  = Nothing
-  prj' _ (UNext x) = prj' (P::P n) x
+    prj' _ (UNext x) = prj' (P::P n) x
 
--- Find an index of an element in a `list'
+-- | Find an index of an element in a type list. The element must exist.
--- The element must exist
+--
--- This closed type family disambiguates otherwise overlapping
+-- This closed type family disambiguates otherwise overlapping instances.
--- instances
 type family FindElem (t :: * -> *) r :: Nat where
-  FindElem t (t ': r)    = 'Z
+    FindElem t (t ': r)    = 'Z
-  FindElem t (any ': r)  = 'S (FindElem t r)
+    FindElem t (any ': r)  = 'S (FindElem t r)
 
 type family EQU (a :: k) (b :: k) :: Bool where
-  EQU a a = 'True
+    EQU a a = 'True
-  EQU a b = 'False
+    EQU a b = 'False
 
 type family Head (xs :: [x]) :: x where
     Head (x ': xs) = x
@@ -52,30 +71,33 @@ type family Tail (xs :: [x]) :: [x] where
                            -- Interface --
 --------------------------------------------------------------------------------
 
-{-# INLINE decomp #-}
 decomp :: Union (t ': r) v -> Either (Union r v) (t v)
 decomp (UNow x)  = Right x
 decomp (UNext v) = Left v
+{-# INLINE decomp #-}
 
-{-# INLINE weaken #-}
 weaken :: Union (t ': r) w -> Union (any ': t ': r) w
 weaken = UNext
+{-# INLINE weaken #-}
 
-{-# INLINE extract #-}
 extract :: Union '[t] v -> t v
 extract (UNow x)  = x
-
+{-# INLINE extract #-}
 
 class (Member' t r (FindElem t r), r ~ (Head r ': Tail r)) => Member t r where
-  inj :: t v -> Union r v
+    inj :: t v -> Union r v
-  prj :: Union r v -> Maybe (t v)
+    prj :: Union r v -> Maybe (t v)
 
-instance (Member' t r (FindElem t r), r ~ (Head r ': Tail r)) => Member t r where
+instance (Member' t r (FindElem t r), r ~ (Head r ': Tail r)) => Member t r
-  inj = inj' (P :: P (FindElem t r))
+  where
-  prj = prj' (P :: P (FindElem t r))
+    inj = inj' (P :: P (FindElem t r))
+    prj = prj' (P :: P (FindElem t r))
 
 instance (Functor f) => Functor (Union '[f]) where
-  fmap f = inj . fmap f . extract
+    fmap f = inj . fmap f . extract
-instance (Functor f1, Functor (Union (f2 ': fs))) =>
+
-         Functor (Union (f1 ': f2 ': fs)) where
+instance
-  fmap f = either (weaken . fmap f) (inj . fmap f) . decomp
+    ( Functor f1, Functor (Union (f2 ': fs))
+    ) => Functor (Union (f1 ': f2 ': fs))
+  where
+    fmap f = either (weaken . fmap f) (inj . fmap f) . decomp