get rid of the Colonnade.Internal module

This commit is contained in:
Andrew Martin 2017-01-31 19:05:41 -05:00
parent 66e607f732
commit 2209ed7162
4 changed files with 22 additions and 29 deletions

View File

@ -31,7 +31,6 @@ library
Colonnade.Types Colonnade.Types
Colonnade.Encoding Colonnade.Encoding
Colonnade.Decoding Colonnade.Decoding
Colonnade.Internal
build-depends: build-depends:
base >= 4.7 && < 5 base >= 4.7 && < 5
, contravariant >= 1.2 && < 1.5 , contravariant >= 1.2 && < 1.5

View File

@ -1,9 +1,9 @@
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
module Colonnade.Decoding where module Colonnade.Decoding where
import Colonnade.Internal (EitherWrap(..),mapLeft)
import Colonnade.Types import Colonnade.Types
import Data.Functor.Contravariant import Data.Functor.Contravariant
import Data.Vector (Vector) import Data.Vector (Vector)
@ -157,4 +157,18 @@ columnNumToLetters i
| otherwise = "Beyond Z. Fix this." | otherwise = "Beyond Z. Fix this."
newtype EitherWrap a b = EitherWrap
{ getEitherWrap :: Either a b
} deriving (Functor)
instance Monoid a => Applicative (EitherWrap a) where
pure = EitherWrap . Right
EitherWrap (Left a1) <*> EitherWrap (Left a2) = EitherWrap (Left (mappend a1 a2))
EitherWrap (Left a1) <*> EitherWrap (Right _) = EitherWrap (Left a1)
EitherWrap (Right _) <*> EitherWrap (Left a2) = EitherWrap (Left a2)
EitherWrap (Right f) <*> EitherWrap (Right b) = EitherWrap (Right (f b))
mapLeft :: (a -> b) -> Either a c -> Either b c
mapLeft _ (Right a) = Right a
mapLeft f (Left a) = Left (f a)

View File

@ -38,7 +38,6 @@ import qualified Data.Bool
import qualified Data.Maybe import qualified Data.Maybe
import qualified Data.List as List import qualified Data.List as List
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import qualified Colonnade.Internal as Internal
-- $setup -- $setup
-- --
@ -228,7 +227,7 @@ runRowMonadic :: (Monad m, Monoid b)
-> a -> a
-> m b -> m b
runRowMonadic (Colonnade v) g a = runRowMonadic (Colonnade v) g a =
flip Internal.foldlMapM v flip foldlMapM v
$ \e -> g (oneColonnadeEncode e a) $ \e -> g (oneColonnadeEncode e a)
runRowMonadic_ :: Monad m runRowMonadic_ :: Monad m
@ -264,7 +263,7 @@ runHeaderMonadicGeneral :: (Monad m, Monoid b, Foldable h)
-> m b -> m b
runHeaderMonadicGeneral (Colonnade v) g = id runHeaderMonadicGeneral (Colonnade v) g = id
$ fmap (mconcat . Vector.toList) $ fmap (mconcat . Vector.toList)
$ Vector.mapM (Internal.foldlMapM g . oneColonnadeHead) v $ Vector.mapM (foldlMapM g . oneColonnadeHead) v
runHeaderMonadic :: (Monad m, Monoid b) runHeaderMonadic :: (Monad m, Monoid b)
=> Colonnade Headed content a => Colonnade Headed content a
@ -278,7 +277,7 @@ runHeaderMonadicGeneral_ :: (Monad m, Monoid b, Foldable h)
-> (content -> m b) -> (content -> m b)
-> m () -> m ()
runHeaderMonadicGeneral_ (Colonnade v) g = runHeaderMonadicGeneral_ (Colonnade v) g =
Vector.mapM_ (Internal.foldlMapM g . oneColonnadeHead) v Vector.mapM_ (foldlMapM g . oneColonnadeHead) v
runHeaderMonadic_ :: runHeaderMonadic_ ::
(Monad m) (Monad m)
@ -342,3 +341,7 @@ atDef def = Data.Maybe.fromMaybe def .^ atMay where
f i (_:zs) = f (i-1) zs f i (_:zs) = f (i-1) zs
f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i) f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i)
foldlMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b
foldlMapM f = foldlM (\b a -> fmap (mappend b) (f a)) mempty

View File

@ -1,23 +0,0 @@
{-# LANGUAGE DeriveFunctor #-}
module Colonnade.Internal where
import Data.Foldable (foldrM,foldlM)
newtype EitherWrap a b = EitherWrap
{ getEitherWrap :: Either a b
} deriving (Functor)
instance Monoid a => Applicative (EitherWrap a) where
pure = EitherWrap . Right
EitherWrap (Left a1) <*> EitherWrap (Left a2) = EitherWrap (Left (mappend a1 a2))
EitherWrap (Left a1) <*> EitherWrap (Right _) = EitherWrap (Left a1)
EitherWrap (Right _) <*> EitherWrap (Left a2) = EitherWrap (Left a2)
EitherWrap (Right f) <*> EitherWrap (Right b) = EitherWrap (Right (f b))
mapLeft :: (a -> b) -> Either a c -> Either b c
mapLeft _ (Right a) = Right a
mapLeft f (Left a) = Left (f a)
foldlMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b
foldlMapM f = foldlM (\b a -> fmap (mappend b) (f a)) mempty