colonnade 0.3 → 0.4

raw patch · 10 files changed

+222/−74 lines, 10 filesdep +bytestringdep +textPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, text

API changes (from Hackage documentation)

Files

• colonnade.cabal +7/−2
• src/Colonnade/Decoding.hs +56/−10
• src/Colonnade/Decoding/ByteString/Char8.hs +26/−0
• src/Colonnade/Decoding/Text.hs +47/−0
• src/Colonnade/Encoding.hs +12/−2
• src/Colonnade/Encoding/ByteString/Char8.hs +24/−0
• src/Colonnade/Encoding/Text.hs +24/−0
• src/Colonnade/Internal.hs +3/−0
• src/Colonnade/Internal/Ap.hs +0/−47
• src/Colonnade/Types.hs +23/−13

@@ -1,5 +1,5 @@ name:                colonnade-version:             0.3+version:             0.4 synopsis:            Generic types and functions for columnar encoding and decoding description:         Please see README.md homepage:            https://github.com/andrewthad/colonnade#readme@@ -17,13 +17,18 @@   exposed-modules:     Colonnade.Types     Colonnade.Encoding+    Colonnade.Encoding.Text+    Colonnade.Encoding.ByteString.Char8     Colonnade.Decoding+    Colonnade.Decoding.Text+    Colonnade.Decoding.ByteString.Char8     Colonnade.Internal-    Colonnade.Internal.Ap   build-depends:       base >= 4.7 && < 5     , contravariant     , vector+    , text+    , bytestring   default-language:    Haskell2010  source-repository head

@@ -3,11 +3,12 @@ {-# LANGUAGE BangPatterns        #-} module Colonnade.Decoding where -import Colonnade.Internal (EitherWrap(..))+import Colonnade.Internal (EitherWrap(..),mapLeft) import Colonnade.Types import Data.Functor.Contravariant import Data.Vector (Vector) import qualified Data.Vector as Vector+import Data.Char (chr)  -- | Converts the content type of a 'Decoding'. The @'Contravariant' f@ -- constraint means that @f@ can be 'Headless' but not 'Headed'.@@ -101,14 +102,59 @@        <$> 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)+-- | This adds one to the index because text editors consider+--   line number to be one-based, not zero-based.+prettyError :: (c -> String) -> DecodingRowError f c -> String+prettyError toStr (DecodingRowError ix e) = unlines+  $ ("Decoding error on line " ++ show (ix + 1) ++ " of file.")+  : ("Error Category: " ++ descr)+  : map ("  " ++) errDescrs+  where (descr,errDescrs) = prettyRowError toStr e -mapLeft :: (a -> b) -> Either a c -> Either b c-mapLeft _ (Right a) = Right a-mapLeft f (Left a) = Left (f a)+prettyRowError :: (content -> String) -> RowError f content -> (String, [String])+prettyRowError toStr x = case x of+  RowErrorParse err -> (,) "CSV Parsing"+    [ "The line could not be parsed into cells correctly."+    , "Original parser error: " ++ err+    ]+  RowErrorSize reqLen actualLen -> (,) "Row Length"+    [ "Expected the row to have exactly " ++ show reqLen ++ " cells."+    , "The row only has " ++ show actualLen ++ " cells."+    ]+  RowErrorMinSize reqLen actualLen -> (,) "Row Min Length"+    [ "Expected the row to have at least " ++ show reqLen ++ " cells."+    , "The row only has " ++ show actualLen ++ " cells."+    ]+  RowErrorMalformed enc -> (,) "Text Decoding"+    [ "Tried to decode the input as " ++ enc ++ " text"+    , "There is a mistake in the encoding of the text."+    ]+  RowErrorHeading errs -> (,) "Header" (prettyHeadingErrors toStr errs)+  RowErrorDecode errs -> (,) "Cell Decoding" (prettyCellErrors toStr errs)++prettyCellErrors :: (c -> String) -> DecodingCellErrors f c -> [String]+prettyCellErrors toStr (DecodingCellErrors errs) = drop 1 $+  flip concatMap errs $ \(DecodingCellError content (Indexed ix _) msg) ->+    let str = toStr content in+    [ "-----------"+    , "Column " ++ columnNumToLetters ix+    , "Original parse error: " ++ msg+    , "Cell Content Length: " ++ show (Prelude.length str)+    , "Cell Content: " ++ if null str+        then "[empty cell]"+        else str+    ]++prettyHeadingErrors :: (c -> String) -> HeadingErrors c -> [String]+prettyHeadingErrors conv (HeadingErrors missing duplicates) = concat+  [ concatMap (\h -> ["The header " ++ conv h ++ " was missing."]) missing+  , concatMap (\(h,n) -> ["The header " ++ conv h ++ " occurred " ++ show n ++ " times."]) duplicates+  ]++columnNumToLetters :: Int -> String+columnNumToLetters i+  | i >= 0 && i < 25 = [chr (i + 65)]+  | otherwise = "Beyond Z. Fix this."++ 

@@ -0,0 +1,26 @@+module Colonnade.Decoding.ByteString.Char8 where++import Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Char8 as BC8++char :: ByteString -> Either String Char+char b = case BC8.length b of+  1 -> Right (BC8.head b)+  0 -> Left "cannot decode Char from empty bytestring"+  _ -> Left "cannot decode Char from multi-character bytestring"++int :: ByteString -> Either String Int+int b = do+  (a,bsRem) <- maybe (Left "could not parse int") Right (BC8.readInt b)+  if ByteString.null bsRem+    then Right a+    else Left "found extra characters after int"++bool :: ByteString -> Either String Bool+bool b+  | b == BC8.pack "true" = Right True+  | b == BC8.pack "false" = Right False+  | otherwise = Left "must be true or false"++

@@ -0,0 +1,47 @@+module Colonnade.Decoding.Text where++import Prelude hiding (map)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Read as TextRead++char :: Text -> Either String Char+char t = case Text.length t of+  1 -> Right (Text.head t)+  0 -> Left "cannot decode Char from empty text"+  _ -> Left "cannot decode Char from multi-character text"++text :: Text -> Either String Text+text = Right++int :: Text -> Either String Int+int t = do+  (a,tRem) <- TextRead.decimal t+  if Text.null tRem+    then Right a+    else Left "found extra characters after int"++trueFalse :: Text -> Text -> Text -> Either String Bool+trueFalse t f txt+  | txt == t = Right True+  | txt == f = Right False+  | otherwise = Left $ concat+      ["must be [", Text.unpack t, "] or [", Text.unpack f, "]"]++-- | This refers to the 'TextRead.Reader' from @Data.Text.Read@, not+--   to the @Reader@ monad.+fromReader :: TextRead.Reader a -> Text -> Either String a+fromReader f t = do+  (a,tRem) <- f t+  if Text.null tRem+    then Right a+    else Left "found extra characters at end of text"++optional :: (Text -> Either String a) -> Text -> Either String (Maybe a)+optional f t = if Text.null t+  then Right Nothing+  else fmap Just (f t)++map :: (a -> b) -> (Text -> Either String a) -> Text -> Either String b+map f g t = fmap f (g t)+

@@ -29,8 +29,9 @@               -> (content -> m b)               -> a               -> m b-runRowMonadic (Encoding v) g a = fmap (mconcat . Vector.toList) $ Vector.forM v $ \e ->-  g (oneEncodingEncode e a)+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) =@@ -43,5 +44,14 @@ runHeaderMonadic (Encoding v) g =   fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneEncodingHead) v +fromMaybe :: c -> Encoding f c a -> Encoding f c (Maybe a)+fromMaybe c (Encoding v) = Encoding $ flip Vector.map v $+  \(OneEncoding h encode) -> OneEncoding h (maybe c encode) +columns :: (b -> a -> c)+        -> (b -> f c) +        -> Vector b +        -> Encoding f c a+columns getCell getHeader bs =+  Encoding $ Vector.map (\b -> OneEncoding (getHeader b) (getCell b)) bs 

@@ -0,0 +1,24 @@+module Colonnade.Encoding.ByteString.Char8 where++import Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Char8 as BC8+import qualified Data.ByteString.Builder    as Builder+import qualified Data.ByteString.Lazy       as LByteString++char :: Char -> ByteString+char = BC8.singleton++int :: Int -> ByteString+int = LByteString.toStrict+    . Builder.toLazyByteString +    . Builder.intDec++bool :: Bool -> ByteString+bool x = case x of+  True -> BC8.pack "true"+  False -> BC8.pack "false"++byteString :: ByteString -> ByteString+byteString = id+

@@ -0,0 +1,24 @@+module Colonnade.Encoding.Text where++import Data.Text+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LText+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Text.Lazy.Builder.Int as Builder++char :: Char -> Text+char = Text.singleton++int :: Int -> Text+int = LText.toStrict+    . Builder.toLazyText+    . Builder.decimal++text :: Text -> Text+text = id++bool :: Bool -> Text+bool x = case x of+  True -> Text.pack "true"+  False -> Text.pack "false"+

@@ -12,3 +12,6 @@   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)

@@ -1,47 +0,0 @@-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE GADTs #-}-{-# OPTIONS_GHC -Wall #-}--module Colonnade.Internal.Ap-  ( Ap(..)-  , runAp-  , runAp_-  , liftAp-  , hoistAp-  , retractAp-  ) where--import Control.Applicative---- | The free 'Applicative' for a 'Functor' @f@.-data Ap f a where-  Pure :: a -> Ap f a-  Ap   :: f a -> Ap f (a -> b) -> Ap f b--runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a-runAp _ (Pure x) = pure x-runAp u (Ap f x) = flip id <$> u f <*> runAp u x--runAp_ :: Monoid m => (forall a. f a -> m) -> Ap f b -> m-runAp_ f = getConst . runAp (Const . f)--instance Functor (Ap f) where-  fmap f (Pure a)   = Pure (f a)-  fmap f (Ap x y)   = Ap x ((f .) <$> y)--instance Applicative (Ap f) where-  pure = Pure-  Pure f <*> y = fmap f y-  Ap x y <*> z = Ap x (flip <$> y <*> z)--liftAp :: f a -> Ap f a-liftAp x = Ap x (Pure id)-{-# INLINE liftAp #-}--hoistAp :: (forall a. f a -> g a) -> Ap f b -> Ap g b-hoistAp _ (Pure a) = Pure a-hoistAp f (Ap x y) = Ap (f x) (hoistAp f y)--retractAp :: Applicative f => Ap f a -> f a-retractAp (Pure a) = pure a-retractAp (Ap x y) = x <**> retractAp y

@@ -1,6 +1,7 @@-{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DeriveFoldable             #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE GADTs                      #-} module Colonnade.Types   ( Encoding(..)   , Decoding(..)@@ -24,11 +25,11 @@  -- | Isomorphic to 'Identity' newtype Headed a = Headed { getHeaded :: a }-  deriving (Eq,Ord,Functor,Show,Read)+  deriving (Eq,Ord,Functor,Show,Read,Foldable)  -- | Isomorphic to 'Proxy' data Headless a = Headless-  deriving (Eq,Ord,Functor,Show,Read)+  deriving (Eq,Ord,Functor,Show,Read,Foldable)  data Indexed f a = Indexed   { indexedIndex :: !Int@@ -38,7 +39,7 @@ data HeadingErrors content = HeadingErrors   { headingErrorsMissing   :: Vector content       -- ^ headers that were missing   , headingErrorsDuplicate :: Vector (content,Int) -- ^ headers that occurred more than once-  } deriving (Show,Read)+  } deriving (Show,Read,Eq)  instance (Show content, Typeable content) => Exception (HeadingErrors content) @@ -51,27 +52,33 @@   { decodingCellErrorContent :: !content   , decodingCellErrorHeader  :: !(Indexed f content)   , decodingCellErrorMessage :: !String-  } deriving (Show,Read)+  } deriving (Show,Read,Eq)  -- instance (Show (f content), Typeable content) => Exception (DecodingError f content)  newtype DecodingCellErrors f content = DecodingCellErrors   { getDecodingCellErrors :: Vector (DecodingCellError f content)-  } deriving (Monoid,Show,Read)+  } deriving (Monoid,Show,Read,Eq)  -- newtype ParseRowError = ParseRowError String +-- TODO: rewrite the instances for this by hand. They+-- currently use FlexibleContexts. data DecodingRowError f content = DecodingRowError   { decodingRowErrorRow   :: !Int   , decodingRowErrorError :: !(RowError f content)-  }+  } deriving (Show,Read,Eq) +-- TODO: rewrite the instances for this by hand. They+-- currently use FlexibleContexts. 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+  | RowErrorMalformed !String -- ^ Error decoding unicode content+  deriving (Show,Read,Eq)  -- instance (Show (f content), Typeable content) => Exception (DecodingErrors f content) @@ -80,13 +87,15 @@  -- | This just actually a specialization of the free applicative. --   Check out @Control.Applicative.Free@ in the @free@ library to---   learn more about this.+--   learn more about this. The meanings of the fields are documented+--   slightly more in the source code. Unfortunately, haddock does not+--   play nicely with GADTs. data Decoding f content a where-  DecodingPure :: !a -- ^ function+  DecodingPure :: !a -- function                -> Decoding f content a-  DecodingAp :: !(f content) -- ^ header-             -> !(content -> Either String a) -- ^ decoding function-             -> !(Decoding f content (a -> b)) -- ^ next decoding+  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@@ -98,6 +107,7 @@   DecodingPure f <*> y = fmap f y   DecodingAp h c y <*> z = DecodingAp h c (flip <$> y <*> z) +-- | Encodes a header and a cell. data OneEncoding f content a = OneEncoding   { oneEncodingHead   :: !(f content)   , oneEncodingEncode :: !(a -> content)