shithub: MicroHs

--- a/Makefile

+++ b/Makefile

@@ -198,7 +198,7 @@

 MCABALBIN=$(MCABAL)/bin

 MDIST=dist-mcabal

 BASE=base-$(VERSION)

-BASEMODULES=Control.Applicative Control.Arrow Control.Category Control.DeepSeq Control.Error Control.Exception Control.Monad Control.Monad.Fail Control.Monad.Fix Control.Monad.ST Control.Monad.Zip Data.Array Data.Bifoldable Data.Bifunctor Data.Bits Data.Bool Data.Bounded Data.ByteString Data.Char Data.Complex Data.Constraint Data.Data Data.Double Data.Dynamic Data.Either Data.Enum Data.Eq Data.Float Data.FloatW Data.Floating Data.Foldable Data.Foldable1 Data.Fractional Data.Function Data.Functor Data.Functor.Classes Data.Functor.Compose Data.Functor.Const Data.Functor.Contravariant Data.Functor.Identity Data.Functor.Product Data.Functor.Sum Data.IOArray Data.IORef Data.Int Data.Integer Data.Integral Data.Ix Data.List Data.List.NonEmpty Data.Maybe Data.Monoid Data.Num Data.Ord Data.Proxy Data.Ratio Data.Real Data.RealFloat Data.RealFrac Data.Records Data.STRef Data.Semigroup Data.String Data.Text Data.Time.Clock Data.Time.Format Data.Traversable Data.Tuple Data.Type.Equality Data.TypeLits Data.Typeable Data.Version Data.Void Data.Word Data.ZipList Debug.Trace Foreign.C.String Foreign.C.Types Foreign.ForeignPtr Foreign.Marshal.Alloc Foreign.Marshal.Array Foreign.Marshal.Utils Foreign.Ptr Foreign.Storable GHC.Stack GHC.Types Numeric Numeric.FormatFloat Numeric.Natural Prelude System.Cmd System.Compress System.Directory System.Environment System.Exit System.IO System.IO.MD5 System.IO.PrintOrRun System.IO.Serialize System.IO.TimeMilli System.IO.Unsafe System.Info System.Process Text.Printf Text.ParserCombinators.ReadP Text.ParserCombinators.ReadPrec Text.Read Text.Read.Lex Text.Show TimeCompat Unsafe.Coerce

+BASEMODULES=Control.Applicative Control.Arrow Control.Category Control.DeepSeq Control.Error Control.Exception Control.Monad Control.Monad.Fail Control.Monad.Fix Control.Monad.ST Control.Monad.Zip Data.Array Data.Bifoldable Data.Bifunctor Data.Bitraversable Data.Bits Data.Bool Data.Bounded Data.ByteString Data.Char Data.Complex Data.Constraint Data.Data Data.Double Data.Dynamic Data.Either Data.Enum Data.Eq Data.Float Data.FloatW Data.Floating Data.Foldable Data.Foldable1 Data.Fractional Data.Function Data.Functor Data.Functor.Classes Data.Functor.Compose Data.Functor.Const Data.Functor.Contravariant Data.Functor.Identity Data.Functor.Product Data.Functor.Sum Data.IOArray Data.IORef Data.Int Data.Integer Data.Integral Data.Ix Data.List Data.List.NonEmpty Data.Maybe Data.Monoid Data.Num Data.Ord Data.Proxy Data.Ratio Data.Real Data.RealFloat Data.RealFrac Data.Records Data.STRef Data.Semigroup Data.String Data.Text Data.Time.Clock Data.Time.Format Data.Traversable Data.Tuple Data.Type.Equality Data.TypeLits Data.Typeable Data.Version Data.Void Data.Word Data.ZipList Debug.Trace Foreign.C.String Foreign.C.Types Foreign.ForeignPtr Foreign.Marshal.Alloc Foreign.Marshal.Array Foreign.Marshal.Utils Foreign.Ptr Foreign.Storable GHC.Stack GHC.Types Numeric Numeric.FormatFloat Numeric.Natural Prelude System.Cmd System.Compress System.Directory System.Environment System.Exit System.IO System.IO.MD5 System.IO.PrintOrRun System.IO.Serialize System.IO.TimeMilli System.IO.Unsafe System.Info System.Process Text.Printf Text.ParserCombinators.ReadP Text.ParserCombinators.ReadPrec Text.Read Text.Read.Lex Text.Show TimeCompat Unsafe.Coerce

 $(MCABALBIN)/mhs: bin/mhs

 	@mkdir -p $(MCABALBIN)

--- a/lib/AllOfLib.hs

+++ b/lib/AllOfLib.hs

@@ -17,6 +17,7 @@

 import Data.Bool_Type

 import Data.Bifoldable

 import Data.Bifunctor

+import Data.Bitraversable

 import Data.Bounded

 import Data.ByteString

 import Data.Char

--- a/lib/Data/Bifunctor.hs

+++ b/lib/Data/Bifunctor.hs

@@ -141,6 +141,7 @@

 -- *** Exception: Prelude.undefined

--

 -- @since 4.8.0.0

{-

 instance Bifunctor (,) where

     bimap f g ~(a, b) = (f a, g b)

--- /dev/null

+++ b/lib/Data/Bitraversable.hs

@@ -1,0 +1,105 @@

+{-# LANGUAGE Trustworthy #-}

+{-# LANGUAGE ScopedTypeVariables #-}

+-----------------------------------------------------------------------------

+-- |

+-- Module      :  Data.Bitraversable

+-- Copyright   :  (C) 2011-2016 Edward Kmett

+-- License     :  BSD-style (see the file LICENSE)

+--

+-- Maintainer  :  libraries@haskell.org

+-- Stability   :  provisional

+-- Portability :  portable

+--

+-- @since 4.10.0.0

+----------------------------------------------------------------------------

+module Data.Bitraversable

+  ( Bitraversable(..)

+  , bisequenceA

+  , bisequence

+  , bimapM

+  , bifor

+  , biforM

+  , bimapAccumL

+  , bimapAccumR

+--  , bimapDefault

+--  , bifoldMapDefault

+  ) where

+import Control.Applicative

+import Data.Bifunctor

+import Data.Bifoldable

+-- Data.Coerce

+import Data.Functor.Identity(Identity(..))

+import Data.Foldable.Internal(StateL(..), runStateL, StateR(..), runStateR)

+class (Bifunctor t, Bifoldable t) => Bitraversable t where

+  bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)

+bisequenceA :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)

+bisequenceA = bisequence

+bimapM :: (Bitraversable t, Applicative f)

+       => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)

+bimapM = bitraverse

+bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)

+bisequence = bitraverse id id

+{-

+instance Bitraversable (,) where

+  bitraverse f g ~(a, b) = liftA2 (,) (f a) (g b)

+instance Bitraversable ((,,) x) where

+  bitraverse f g ~(x, a, b) = liftA2 ((,,) x) (f a) (g b)

+instance Bitraversable ((,,,) x y) where

+  bitraverse f g ~(x, y, a, b) = liftA2 ((,,,) x y) (f a) (g b)

+instance Bitraversable ((,,,,) x y z) where

+  bitraverse f g ~(x, y, z, a, b) = liftA2 ((,,,,) x y z) (f a) (g b)

+instance Bitraversable ((,,,,,) x y z w) where

+  bitraverse f g ~(x, y, z, w, a, b) = liftA2 ((,,,,,) x y z w) (f a) (g b)

+instance Bitraversable ((,,,,,,) x y z w v) where

+  bitraverse f g ~(x, y, z, w, v, a, b) =

+    liftA2 ((,,,,,,) x y z w v) (f a) (g b)

+-}

+instance Bitraversable Either where

+  bitraverse f _ (Left a) = Left <$> f a

+  bitraverse _ g (Right b) = Right <$> g b

+instance Bitraversable Const where

+  bitraverse f _ (Const a) = Const <$> f a

+bifor :: (Bitraversable t, Applicative f)

+      => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)

+bifor t f g = bitraverse f g t

+biforM :: (Bitraversable t, Applicative f)

+       => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)

+biforM = bifor

+bimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e))

+            -> a -> t b d -> (a, t c e)

+bimapAccumL f g s t

+  = runStateL (bitraverse (StateL . flip f) (StateL . flip g) t) s

+bimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e))

+            -> a -> t b d -> (a, t c e)

+bimapAccumR f g s t

+  = runStateR (bitraverse (StateR . flip f) (StateR . flip g) t) s

+{-

+bimapDefault = coerce

+  (bitraverse :: (a -> Identity b)

+              -> (c -> Identity d) -> t a c -> Identity (t b d))

+bifoldMapDefault :: forall t m a b . (Bitraversable t, Monoid m)

+                 => (a -> m) -> (b -> m) -> t a b -> m

+bifoldMapDefault = coerce

+  (bitraverse :: (a -> Const m ())

+              -> (b -> Const m ()) -> t a b -> Const m (t () ()))

+-}

--- a/lib/Data/Foldable/Internal.hs

+++ b/lib/Data/Foldable/Internal.hs

@@ -1,6 +1,10 @@

 module Data.Foldable.Internal(module Data.Foldable.Internal) where

 import Prelude()

+import Control.Applicative

+import Control.Monad

 import Data.Bool

+import Data.Function

+import Data.Functor

 import Data.Maybe_Type

 import Data.Monoid.Internal hiding (Max(..), Min(..))

 import Data.List

@@ -35,3 +39,50 @@

 instance forall a . Ord a => Monoid (Min a) where

     mempty = Min Nothing

     mconcat = foldl' (<>) mempty

+newtype StateL s a = StateL (s -> (s, a))

+runStateL :: StateL s a -> s -> (s, a)

+runStateL (StateL f) = f

+instance Functor (StateL s) where

+    fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)

+instance Applicative (StateL s) where

+    pure x = StateL (\ s -> (s, x))

+    StateL kf <*> StateL kv = StateL $ \ s ->

+        let (s', f) = kf s

+            (s'', v) = kv s'

+        in (s'', f v)

+newtype StateR s a = StateR (s -> (s, a))

+runStateR :: StateR s a -> s -> (s, a)

+runStateR (StateR f) = f

+instance Functor (StateR s) where

+    fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)

+instance Applicative (StateR s) where

+    pure x = StateR (\ s -> (s, x))

+    StateR kf <*> StateR kv = StateR $ \ s ->

+        let (s', v) = kv s

+            (s'', f) = kf s'

+        in (s'', f v)

+newtype StateT s m a = StateT (s -> m (s, a))

+runStateT :: StateT s m a -> s -> m (s, a)

+runStateT (StateT f) = f

+instance Monad m => Functor (StateT s m) where

+    fmap = liftM

+instance Monad m => Applicative (StateT s m) where

+    pure a = StateT $ \ s -> return (s, a)

+    StateT mf <*> StateT mx = StateT $ \ s -> do

+        (s', f) <- mf s

+        (s'', x) <- mx s'

+        return (s'', f x)

+instance (Monad m) => Monad (StateT s m) where

+    m >>= k  = StateT $ \ s -> do

+        (s', a) <- runStateT m s

+        runStateT (k a) s'

--- a/lib/Data/Traversable.hs

+++ b/lib/Data/Traversable.hs

@@ -35,11 +35,11 @@

 --import Data.Coerce

 import Data.Either

 import Data.Foldable

+import Data.Foldable.Internal(StateL(..), runStateL, StateR(..), runStateR, StateT(..), runStateT)

 import Data.Function

 import Data.Functor

 import Data.Functor.Const

 import Data.Functor.Identity

---import Data.Functor.Utils ( StateL(..), StateR(..), StateT(..), (#.) )

 import Data.List_Type

 import qualified Data.List as List

 import Data.Maybe

@@ -248,49 +248,3 @@

 -----------------------

-newtype StateL s a = StateL (s -> (s, a))

-runStateL :: StateL s a -> s -> (s, a)

-runStateL (StateL f) = f

-instance Functor (StateL s) where

-    fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)

-instance Applicative (StateL s) where

-    pure x = StateL (\ s -> (s, x))

-    StateL kf <*> StateL kv = StateL $ \ s ->

-        let (s', f) = kf s

-            (s'', v) = kv s'

-        in (s'', f v)

-newtype StateR s a = StateR (s -> (s, a))

-runStateR :: StateR s a -> s -> (s, a)

-runStateR (StateR f) = f

-instance Functor (StateR s) where

-    fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)

-instance Applicative (StateR s) where

-    pure x = StateR (\ s -> (s, x))

-    StateR kf <*> StateR kv = StateR $ \ s ->

-        let (s', v) = kv s

-            (s'', f) = kf s'

-        in (s'', f v)

-newtype StateT s m a = StateT (s -> m (s, a))

-runStateT :: StateT s m a -> s -> m (s, a)

-runStateT (StateT f) = f

-instance Monad m => Functor (StateT s m) where

-    fmap = liftM

-instance Monad m => Applicative (StateT s m) where

-    pure a = StateT $ \ s -> return (s, a)

-    StateT mf <*> StateT mx = StateT $ \ s -> do

-        (s', f) <- mf s

-        (s'', x) <- mx s'

-        return (s'', f x)

-instance (Monad m) => Monad (StateT s m) where

-    m >>= k  = StateT $ \ s -> do

-        (s', a) <- runStateT m s

-        runStateT (k a) s'

--

⑨