colonnade 0.1 → 0.3

raw patch · 5 files changed

+214/−14 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• colonnade.cabal +2/−1
• src/Colonnade/Decoding.hs +90/−0
• src/Colonnade/Encoding.hs +35/−3
• src/Colonnade/Internal.hs +14/−0
• src/Colonnade/Types.hs +73/−10

@@ -1,5 +1,5 @@ name:                colonnade-version:             0.1+version:             0.3 synopsis:            Generic types and functions for columnar encoding and decoding description:         Please see README.md homepage:            https://github.com/andrewthad/colonnade#readme@@ -18,6 +18,7 @@     Colonnade.Types     Colonnade.Encoding     Colonnade.Decoding+    Colonnade.Internal     Colonnade.Internal.Ap   build-depends:       base >= 4.7 && < 5

@@ -1,9 +1,13 @@ {-# LANGUAGE RankNTypes          #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns        #-} module Colonnade.Decoding where +import Colonnade.Internal (EitherWrap(..)) import Colonnade.Types import Data.Functor.Contravariant+import Data.Vector (Vector)+import qualified Data.Vector as Vector  -- | Converts the content type of a 'Decoding'. The @'Contravariant' f@ -- constraint means that @f@ can be 'Headless' but not 'Headed'.@@ -21,4 +25,90 @@ headed :: content -> (content -> Either String a) -> Decoding Headed content a headed h f = DecodingAp (Headed h) f (DecodingPure id) +indexed :: Int -> (content -> Either String a) -> Decoding (Indexed Headless) content a+indexed ix f = DecodingAp (Indexed ix Headless) f (DecodingPure id)++maxIndex :: forall f c a. Decoding (Indexed f) c a -> Int+maxIndex = go 0 where+  go :: forall b. Int -> Decoding (Indexed f) c b -> Int+  go !ix (DecodingPure _) = ix+  go !ix1 (DecodingAp (Indexed ix2 _) decode apNext) =+    go (max ix1 ix2) apNext++-- | This function uses 'unsafeIndex' to access+--   elements of the 'Vector'.+uncheckedRunWithRow ::+     Int+  -> Decoding (Indexed f) content a+  -> Vector content+  -> Either (DecodingRowError f content) a+uncheckedRunWithRow i d v = mapLeft (DecodingRowError i . RowErrorDecode) (uncheckedRun d v)++-- | This function does not check to make sure that the indicies in+--   the 'Decoding' are in the 'Vector'.+uncheckedRun :: forall content a f.+                Decoding (Indexed f) content a+             -> Vector content+             -> Either (DecodingCellErrors f content) a+uncheckedRun dc v = getEitherWrap (go dc)+  where+  go :: forall b.+        Decoding (Indexed f) content b+     -> EitherWrap (DecodingCellErrors f content) b+  go (DecodingPure b) = EitherWrap (Right b)+  go (DecodingAp ixed@(Indexed ix h) decode apNext) =+    let rnext = go apNext+        content = Vector.unsafeIndex v ix+        rcurrent = mapLeft (DecodingCellErrors . Vector.singleton . DecodingCellError content ixed) (decode content)+    in rnext <*> (EitherWrap rcurrent)++headlessToIndexed :: forall c a.+  Decoding Headless c a -> Decoding (Indexed Headless) c a+headlessToIndexed = go 0 where+  go :: forall b. Int -> Decoding Headless c b -> Decoding (Indexed Headless) c b+  go !ix (DecodingPure a) = DecodingPure a+  go !ix (DecodingAp Headless decode apNext) =+    DecodingAp (Indexed ix Headless) decode (go (ix + 1) apNext)++length :: forall f c a. Decoding f c a -> Int+length = go 0 where+  go :: forall b. Int -> Decoding f c b -> Int+  go !a (DecodingPure _) = a+  go !a (DecodingAp _ _ apNext) = go (a + 1) apNext++-- | Maps over a 'Decoding' that expects headers, converting these+--   expected headers into the indices of the columns that they+--   correspond to.+headedToIndexed :: forall content a. Eq content+                => Vector content -- ^ Headers in the source document+                -> Decoding Headed content a -- ^ Decoding that contains expected headers+                -> Either (HeadingErrors content) (Decoding (Indexed Headed) content a)+headedToIndexed v = getEitherWrap . go+  where+  go :: forall b. Eq content+     => Decoding Headed content b+     -> EitherWrap (HeadingErrors content) (Decoding (Indexed Headed) content b)+  go (DecodingPure b) = EitherWrap (Right (DecodingPure b))+  go (DecodingAp hd@(Headed h) decode apNext) =+    let rnext = go apNext+        ixs = Vector.elemIndices h v+        ixsLen = Vector.length ixs+        rcurrent+          | ixsLen == 1 = Right (Vector.unsafeIndex ixs 0)+          | ixsLen == 0 = Left (HeadingErrors (Vector.singleton h) Vector.empty)+          | otherwise   = Left (HeadingErrors Vector.empty (Vector.singleton (h,ixsLen)))+    in (\ix ap -> DecodingAp (Indexed ix hd) decode ap)+       <$> EitherWrap rcurrent+       <*> rnext++eitherMonoidAp :: Monoid a => Either a (b -> c) -> Either a b -> Either a c+eitherMonoidAp = go where+  go (Left a1) (Left a2) = Left (mappend a1 a2)+  go (Left a1) (Right _) = Left a1+  go (Right _) (Left a2) = Left a2+  go (Right f) (Right b) = Right (f b)++mapLeft :: (a -> b) -> Either a c -> Either b c+mapLeft _ (Right a) = Right a+mapLeft f (Left a) = Left (f a) 

@@ -1,15 +1,47 @@ module Colonnade.Encoding where  import Colonnade.Types+import Data.Vector (Vector) import qualified Data.Vector as Vector  mapContent :: Functor f => (c1 -> c2) -> Encoding f c1 a -> Encoding f c2 a mapContent f (Encoding v) = Encoding-  $ Vector.map (\(h,c) -> (fmap f h,f . c)) v+  $ Vector.map (\(OneEncoding h c) -> (OneEncoding (fmap f h) (f . c))) v  headless :: (a -> content) -> Encoding Headless content a-headless f = Encoding (Vector.singleton (Headless,f))+headless f = Encoding (Vector.singleton (OneEncoding Headless f))  headed :: content -> (a -> content) -> Encoding Headed content a-headed h f = Encoding (Vector.singleton (Headed h,f))+headed h f = Encoding (Vector.singleton (OneEncoding (Headed h) f))++-- runRow' :: Encoding f content a -> a -> Vector content+-- runRow' = runRow id++-- | Consider providing a variant the produces a list+-- instead. It may allow more things to get inlined+-- in to a loop.+runRow :: (c1 -> c2) -> Encoding f c1 a -> a -> Vector c2+runRow g (Encoding v) a = flip Vector.map v $+  \(OneEncoding _ encode) -> g (encode a)++runRowMonadic :: (Monad m, Monoid b)+              => Encoding f content a+              -> (content -> m b)+              -> a+              -> m b+runRowMonadic (Encoding v) g a = fmap (mconcat . Vector.toList) $ Vector.forM v $ \e ->+  g (oneEncodingEncode e a)++runHeader :: (c1 -> c2) -> Encoding Headed c1 a -> Vector c2+runHeader g (Encoding v) =+  Vector.map (g . getHeaded . oneEncodingHead) v++runHeaderMonadic :: (Monad m, Monoid b)+                 => Encoding Headed content a+                 -> (content -> m b)+                 -> m b+runHeaderMonadic (Encoding v) g =+  fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneEncodingHead) v++ 

@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveFunctor #-}+module Colonnade.Internal where++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))+

@@ -4,13 +4,22 @@ module Colonnade.Types   ( Encoding(..)   , Decoding(..)+  , OneEncoding(..)   , Headed(..)   , Headless(..)+  , Indexed(..)+  , HeadingErrors(..)+  , DecodingCellError(..)+  , DecodingRowError(..)+  , DecodingCellErrors(..)+  , RowError(..)   ) where  import Data.Vector (Vector) import Data.Functor.Contravariant (Contravariant(..)) import Data.Functor.Contravariant.Divisible (Divisible(..))+import Control.Exception (Exception)+import Data.Typeable (Typeable) import qualified Data.Vector as Vector  -- | Isomorphic to 'Identity'@@ -21,6 +30,51 @@ data Headless a = Headless   deriving (Eq,Ord,Functor,Show,Read) +data Indexed f a = Indexed+  { indexedIndex :: !Int+  , indexedHeading :: !(f a)+  } deriving (Eq,Ord,Functor,Show,Read)++data HeadingErrors content = HeadingErrors+  { headingErrorsMissing   :: Vector content       -- ^ headers that were missing+  , headingErrorsDuplicate :: Vector (content,Int) -- ^ headers that occurred more than once+  } deriving (Show,Read)++instance (Show content, Typeable content) => Exception (HeadingErrors content)++instance Monoid (HeadingErrors content) where+  mempty = HeadingErrors Vector.empty Vector.empty+  mappend (HeadingErrors a1 b1) (HeadingErrors a2 b2) = HeadingErrors+    (a1 Vector.++ a2) (b1 Vector.++ b2)++data DecodingCellError f content = DecodingCellError+  { decodingCellErrorContent :: !content+  , decodingCellErrorHeader  :: !(Indexed f content)+  , decodingCellErrorMessage :: !String+  } deriving (Show,Read)++-- instance (Show (f content), Typeable content) => Exception (DecodingError f content)++newtype DecodingCellErrors f content = DecodingCellErrors+  { getDecodingCellErrors :: Vector (DecodingCellError f content)+  } deriving (Monoid,Show,Read)++-- newtype ParseRowError = ParseRowError String++data DecodingRowError f content = DecodingRowError+  { decodingRowErrorRow   :: !Int+  , decodingRowErrorError :: !(RowError f content)+  }++data RowError f content+  = RowErrorParse !String -- ^ Error occurred parsing the document into cells+  | RowErrorDecode !(DecodingCellErrors f content) -- ^ Error decoding the content+  | RowErrorSize !Int !Int -- ^ Wrong number of cells in the row+  | RowErrorHeading !(HeadingErrors content)+  | RowErrorMinSize !Int !Int++-- instance (Show (f content), Typeable content) => Exception (DecodingErrors f content)+ instance Contravariant Headless where   contramap _ Headless = Headless @@ -28,11 +82,11 @@ --   Check out @Control.Applicative.Free@ in the @free@ library to --   learn more about this. data Decoding f content a where-  DecodingPure :: !a+  DecodingPure :: !a -- ^ function                -> Decoding f content a-  DecodingAp :: !(f content)-             -> !(content -> Either String a)-             -> !(Decoding f content (a -> b))+  DecodingAp :: !(f content) -- ^ header+             -> !(content -> Either String a) -- ^ decoding function+             -> !(Decoding f content (a -> b)) -- ^ next decoding              -> Decoding f content b  instance Functor (Decoding f content) where@@ -44,19 +98,28 @@   DecodingPure f <*> y = fmap f y   DecodingAp h c y <*> z = DecodingAp h c (flip <$> y <*> z) +data OneEncoding f content a = OneEncoding+  { oneEncodingHead   :: !(f content)+  , oneEncodingEncode :: !(a -> content)+  }++instance Contravariant (OneEncoding f content) where+  contramap f (OneEncoding h e) = OneEncoding h (e . f)+ newtype Encoding f content a = Encoding-  { getEncoding :: Vector (f content,a -> content) }-  deriving (Monoid)+  { getEncoding :: Vector (OneEncoding f content a)+  } deriving (Monoid)  instance Contravariant (Encoding f content) where   contramap f (Encoding v) = Encoding-    (Vector.map (\(h,c) -> (h, c . f)) v)+    (Vector.map (contramap f) v)  instance Divisible (Encoding f content) where   conquer = Encoding Vector.empty   divide f (Encoding a) (Encoding b) =     Encoding $ (Vector.++)-      (Vector.map (\(h,c) -> (h,c . fst . f)) a)-      (Vector.map (\(h,c) -> (h,c . snd . f)) b)-+      (Vector.map (contramap (fst . f)) a)+      (Vector.map (contramap (snd . f)) b)+      -- (Vector.map (\(OneEncoding h c) -> (h,c . fst . f)) a)+      -- (Vector.map (\(OneEncoding h c) -> (h,c . snd . f)) b)