get rid of the Colonnade.Internal module
This commit is contained in:
parent
66e607f732
commit
2209ed7162
@ -31,7 +31,6 @@ library
|
||||
Colonnade.Types
|
||||
Colonnade.Encoding
|
||||
Colonnade.Decoding
|
||||
Colonnade.Internal
|
||||
build-depends:
|
||||
base >= 4.7 && < 5
|
||||
, contravariant >= 1.2 && < 1.5
|
||||
|
||||
@ -1,9 +1,9 @@
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
module Colonnade.Decoding where
|
||||
|
||||
import Colonnade.Internal (EitherWrap(..),mapLeft)
|
||||
import Colonnade.Types
|
||||
import Data.Functor.Contravariant
|
||||
import Data.Vector (Vector)
|
||||
@ -157,4 +157,18 @@ columnNumToLetters i
|
||||
| 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)
|
||||
|
||||
|
||||
@ -38,7 +38,6 @@ import qualified Data.Bool
|
||||
import qualified Data.Maybe
|
||||
import qualified Data.List as List
|
||||
import qualified Data.Vector as Vector
|
||||
import qualified Colonnade.Internal as Internal
|
||||
|
||||
-- $setup
|
||||
--
|
||||
@ -228,7 +227,7 @@ runRowMonadic :: (Monad m, Monoid b)
|
||||
-> a
|
||||
-> m b
|
||||
runRowMonadic (Colonnade v) g a =
|
||||
flip Internal.foldlMapM v
|
||||
flip foldlMapM v
|
||||
$ \e -> g (oneColonnadeEncode e a)
|
||||
|
||||
runRowMonadic_ :: Monad m
|
||||
@ -264,7 +263,7 @@ runHeaderMonadicGeneral :: (Monad m, Monoid b, Foldable h)
|
||||
-> m b
|
||||
runHeaderMonadicGeneral (Colonnade v) g = id
|
||||
$ fmap (mconcat . Vector.toList)
|
||||
$ Vector.mapM (Internal.foldlMapM g . oneColonnadeHead) v
|
||||
$ Vector.mapM (foldlMapM g . oneColonnadeHead) v
|
||||
|
||||
runHeaderMonadic :: (Monad m, Monoid b)
|
||||
=> Colonnade Headed content a
|
||||
@ -278,7 +277,7 @@ runHeaderMonadicGeneral_ :: (Monad m, Monoid b, Foldable h)
|
||||
-> (content -> m b)
|
||||
-> m ()
|
||||
runHeaderMonadicGeneral_ (Colonnade v) g =
|
||||
Vector.mapM_ (Internal.foldlMapM g . oneColonnadeHead) v
|
||||
Vector.mapM_ (foldlMapM g . oneColonnadeHead) v
|
||||
|
||||
runHeaderMonadic_ ::
|
||||
(Monad m)
|
||||
@ -342,3 +341,7 @@ atDef def = Data.Maybe.fromMaybe def .^ atMay where
|
||||
f i (_:zs) = f (i-1) zs
|
||||
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
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user