diff --git a/colonnade/colonnade.cabal b/colonnade/colonnade.cabal index 89957d9..37001da 100644 --- a/colonnade/colonnade.cabal +++ b/colonnade/colonnade.cabal @@ -1,7 +1,20 @@ name: colonnade -version: 0.4.7 +version: 0.5 synopsis: Generic types and functions for columnar encoding and decoding -description: Please see README.md +description: + The `colonnade` package provides a way to to talk about + columnar encodings and decodings of data. This package provides + very general types and does not provide a way for the end-user + to actually apply the columnar encodings they build to data. + Most users will also want to one a companion packages + that provides (1) a content type and (2) functions for feeding + data into a columnar encoding: + . + * for reactive `reflex-dom` tables + . + * for `yesod` widgets + . + * for encoding and decoding CSVs homepage: https://github.com/andrewthad/colonnade#readme license: BSD3 license-file: LICENSE @@ -17,16 +30,12 @@ library exposed-modules: Colonnade.Types Colonnade.Encoding - Colonnade.Encoding.Text - Colonnade.Encoding.ByteString.Char8 Colonnade.Decoding - Colonnade.Decoding.Text - Colonnade.Decoding.ByteString.Char8 Colonnade.Internal build-depends: base >= 4.7 && < 5 , contravariant >= 1.2 && < 1.5 - , vector >= 0.10 && < 0.12 + , vector >= 0.10 && < 0.13 , text >= 1.0 && < 1.3 , bytestring >= 0.10 && < 0.11 default-language: Haskell2010 diff --git a/colonnade/src/Colonnade/Decoding.hs b/colonnade/src/Colonnade/Decoding.hs index 07a7748..5121b56 100644 --- a/colonnade/src/Colonnade/Decoding.hs +++ b/colonnade/src/Colonnade/Decoding.hs @@ -10,87 +10,87 @@ import Data.Vector (Vector) import qualified Data.Vector as Vector import Data.Char (chr) --- | Converts the content type of a 'Decoding'. The @'Contravariant' f@ +-- | Converts the content type of a 'Decolonnade'. The @'Contravariant' f@ -- constraint means that @f@ can be 'Headless' but not 'Headed'. -contramapContent :: forall c1 c2 f a. Contravariant f => (c2 -> c1) -> Decoding f c1 a -> Decoding f c2 a +contramapContent :: forall c1 c2 f a. Contravariant f => (c2 -> c1) -> Decolonnade f c1 a -> Decolonnade f c2 a contramapContent f = go where - go :: forall b. Decoding f c1 b -> Decoding f c2 b - go (DecodingPure x) = DecodingPure x - go (DecodingAp h decode apNext) = - DecodingAp (contramap f h) (decode . f) (go apNext) + go :: forall b. Decolonnade f c1 b -> Decolonnade f c2 b + go (DecolonnadePure x) = DecolonnadePure x + go (DecolonnadeAp h decode apNext) = + DecolonnadeAp (contramap f h) (decode . f) (go apNext) -headless :: (content -> Either String a) -> Decoding Headless content a -headless f = DecodingAp Headless f (DecodingPure id) +headless :: (content -> Either String a) -> Decolonnade Headless content a +headless f = DecolonnadeAp Headless f (DecolonnadePure id) -headed :: content -> (content -> Either String a) -> Decoding Headed content a -headed h f = DecodingAp (Headed h) f (DecodingPure id) +headed :: content -> (content -> Either String a) -> Decolonnade Headed content a +headed h f = DecolonnadeAp (Headed h) f (DecolonnadePure id) -indexed :: Int -> (content -> Either String a) -> Decoding (Indexed Headless) content a -indexed ix f = DecodingAp (Indexed ix Headless) f (DecodingPure id) +indexed :: Int -> (content -> Either String a) -> Decolonnade (Indexed Headless) content a +indexed ix f = DecolonnadeAp (Indexed ix Headless) f (DecolonnadePure id) -maxIndex :: forall f c a. Decoding (Indexed f) c a -> Int +maxIndex :: forall f c a. Decolonnade (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 :: forall b. Int -> Decolonnade (Indexed f) c b -> Int + go !ix (DecolonnadePure _) = ix + go !ix1 (DecolonnadeAp (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 + -> Decolonnade (Indexed f) content a -> Vector content - -> Either (DecodingRowError f content) a -uncheckedRunWithRow i d v = mapLeft (DecodingRowError i . RowErrorDecode) (uncheckedRun d v) + -> Either (DecolonnadeRowError f content) a +uncheckedRunWithRow i d v = mapLeft (DecolonnadeRowError i . RowErrorDecode) (uncheckedRun d v) -- | This function does not check to make sure that the indicies in --- the 'Decoding' are in the 'Vector'. +-- the 'Decolonnade' are in the 'Vector'. uncheckedRun :: forall content a f. - Decoding (Indexed f) content a + Decolonnade (Indexed f) content a -> Vector content - -> Either (DecodingCellErrors f content) a + -> Either (DecolonnadeCellErrors 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) = + Decolonnade (Indexed f) content b + -> EitherWrap (DecolonnadeCellErrors f content) b + go (DecolonnadePure b) = EitherWrap (Right b) + go (DecolonnadeAp 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) + rcurrent = mapLeft (DecolonnadeCellErrors . Vector.singleton . DecolonnadeCellError content ixed) (decode content) in rnext <*> (EitherWrap rcurrent) headlessToIndexed :: forall c a. - Decoding Headless c a -> Decoding (Indexed Headless) c a + Decolonnade Headless c a -> Decolonnade (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) + go :: forall b. Int -> Decolonnade Headless c b -> Decolonnade (Indexed Headless) c b + go !ix (DecolonnadePure a) = DecolonnadePure a + go !ix (DecolonnadeAp Headless decode apNext) = + DecolonnadeAp (Indexed ix Headless) decode (go (ix + 1) apNext) -length :: forall f c a. Decoding f c a -> Int +length :: forall f c a. Decolonnade 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 + go :: forall b. Int -> Decolonnade f c b -> Int + go !a (DecolonnadePure _) = a + go !a (DecolonnadeAp _ _ apNext) = go (a + 1) apNext --- | Maps over a 'Decoding' that expects headers, converting these +-- | Maps over a 'Decolonnade' 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) + -> Decolonnade Headed content a -- ^ Decolonnade that contains expected headers + -> Either (HeadingErrors content) (Decolonnade (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) = + => Decolonnade Headed content b + -> EitherWrap (HeadingErrors content) (Decolonnade (Indexed Headed) content b) + go (DecolonnadePure b) = EitherWrap (Right (DecolonnadePure b)) + go (DecolonnadeAp hd@(Headed h) decode apNext) = let rnext = go apNext ixs = Vector.elemIndices h v ixsLen = Vector.length ixs @@ -98,15 +98,15 @@ headedToIndexed v = getEitherWrap . go | 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) + in (\ix ap -> DecolonnadeAp (Indexed ix hd) decode ap) <$> EitherWrap rcurrent <*> rnext -- | 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.") +prettyError :: (c -> String) -> DecolonnadeRowError f c -> String +prettyError toStr (DecolonnadeRowError ix e) = unlines + $ ("Decolonnade error on line " ++ show (ix + 1) ++ " of file.") : ("Error Category: " ++ descr) : map (" " ++) errDescrs where (descr,errDescrs) = prettyRowError toStr e @@ -125,16 +125,16 @@ prettyRowError toStr x = case x of [ "Expected the row to have at least " ++ show reqLen ++ " cells." , "The row only has " ++ show actualLen ++ " cells." ] - RowErrorMalformed enc -> (,) "Text Decoding" + RowErrorMalformed enc -> (,) "Text Decolonnade" [ "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) + RowErrorDecode errs -> (,) "Cell Decolonnade" (prettyCellErrors toStr errs) -prettyCellErrors :: (c -> String) -> DecodingCellErrors f c -> [String] -prettyCellErrors toStr (DecodingCellErrors errs) = drop 1 $ - flip concatMap errs $ \(DecodingCellError content (Indexed ix _) msg) -> +prettyCellErrors :: (c -> String) -> DecolonnadeCellErrors f c -> [String] +prettyCellErrors toStr (DecolonnadeCellErrors errs) = drop 1 $ + flip concatMap errs $ \(DecolonnadeCellError content (Indexed ix _) msg) -> let str = toStr content in [ "-----------" , "Column " ++ columnNumToLetters ix diff --git a/colonnade/src/Colonnade/Decoding/ByteString/Char8.hs b/colonnade/src/Colonnade/Decoding/ByteString/Char8.hs deleted file mode 100644 index be9fa27..0000000 --- a/colonnade/src/Colonnade/Decoding/ByteString/Char8.hs +++ /dev/null @@ -1,26 +0,0 @@ -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" - - diff --git a/colonnade/src/Colonnade/Decoding/Text.hs b/colonnade/src/Colonnade/Decoding/Text.hs deleted file mode 100644 index 595deba..0000000 --- a/colonnade/src/Colonnade/Decoding/Text.hs +++ /dev/null @@ -1,47 +0,0 @@ -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) - diff --git a/colonnade/src/Colonnade/Encoding.hs b/colonnade/src/Colonnade/Encoding.hs index 0d3bb27..ec5fb1e 100644 --- a/colonnade/src/Colonnade/Encoding.hs +++ b/colonnade/src/Colonnade/Encoding.hs @@ -57,14 +57,14 @@ import qualified Colonnade.Internal as Internal -- One potential columnar encoding of a @Person@ would be: -- -- >>> :{ --- let encodingPerson :: Encoding Headed String Person +-- let encodingPerson :: Colonnade Headed String Person -- encodingPerson = mconcat -- [ headed "Name" name -- , headed "Age" (show . age) -- ] -- :} -- --- The type signature on @basicPersonEncoding@ is not neccessary +-- The type signature on @encodingPerson@ is not neccessary -- but is included for clarity. We can feed data into this encoding -- to build a table: -- @@ -82,7 +82,7 @@ import qualified Colonnade.Internal as Internal -- -- >>> let showDollar = (('$':) . show) :: Int -> String -- >>> :{ --- let encodingHouse :: Encoding Headed String House +-- let encodingHouse :: Colonnade Headed String House -- encodingHouse = mconcat -- [ headed "Color" (show . color) -- , headed "Price" (showDollar . price) @@ -101,16 +101,16 @@ import qualified Colonnade.Internal as Internal -- | A single column with a header. -headed :: c -> (a -> c) -> Encoding Headed c a +headed :: c -> (a -> c) -> Colonnade Headed c a headed h = singleton (Headed h) -- | A single column without a header. -headless :: (a -> c) -> Encoding Headless c a +headless :: (a -> c) -> Colonnade Headless c a headless = singleton Headless -- | A single column with any kind of header. This is not typically needed. -singleton :: f c -> (a -> c) -> Encoding f c a -singleton h = Encoding . Vector.singleton . OneEncoding h +singleton :: f c -> (a -> c) -> Colonnade f c a +singleton h = Colonnade . Vector.singleton . OneColonnade h -- | Lift a column over a 'Maybe'. For example, if some people -- have houses and some do not, the data that pairs them together @@ -129,7 +129,7 @@ singleton h = Encoding . Vector.singleton . OneEncoding h -- the help of 'fromMaybe': -- -- >>> :{ --- >>> let encodingOwners :: Encoding Headed String (Person,Maybe House) +-- >>> let encodingOwners :: Colonnade Headed String (Person,Maybe House) -- >>> encodingOwners = mconcat -- >>> [ contramap fst encodingPerson -- >>> , contramap snd (fromMaybe "" encodingHouse) @@ -144,9 +144,9 @@ singleton h = Encoding . Vector.singleton . OneEncoding h -- | Ruth | 25 | Red | $125000 | -- | Sonia | 12 | Green | $145000 | -- +--------+-----+-------+---------+ -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) +fromMaybe :: c -> Colonnade f c a -> Colonnade f c (Maybe a) +fromMaybe c (Colonnade v) = Colonnade $ flip Vector.map v $ + \(OneColonnade h encode) -> OneColonnade h (maybe c encode) -- | Convert a collection of @b@ values into a columnar encoding of -- the same size. Suppose we decide to show a house\'s color @@ -156,10 +156,10 @@ fromMaybe c (Encoding v) = Encoding $ flip Vector.map v $ -- >>> let allColors = [Red,Green,Blue] -- >>> let encColor = columns (\c1 c2 -> if c1 == c2 then "✓" else "") (Headed . show) allColors -- >>> :t encColor --- encColor :: Encoding Headed [Char] Color +-- encColor :: Colonnade Headed [Char] Color -- >>> let encHouse = headed "Price" (showDollar . price) <> contramap color encColor -- >>> :t encHouse --- encHouse :: Encoding Headed [Char] House +-- encHouse :: Colonnade Headed [Char] House -- >>> putStr (ascii encHouse houses) -- +---------+-----+-------+------+ -- | Price | Red | Green | Blue | @@ -172,10 +172,10 @@ columns :: Foldable g => (b -> a -> c) -- ^ Cell content function -> (b -> f c) -- ^ Header content function -> g b -- ^ Basis for column encodings - -> Encoding f c a + -> Colonnade f c a columns getCell getHeader = id - . Encoding - . Vector.map (\b -> OneEncoding (getHeader b) (getCell b)) + . Colonnade + . Vector.map (\b -> OneColonnade (getHeader b) (getCell b)) . Vector.fromList . toList @@ -184,116 +184,116 @@ bool :: -> (a -> Bool) -- ^ Predicate -> (a -> c) -- ^ Contents when predicate is false -> (a -> c) -- ^ Contents when predicate is true - -> Encoding f c a + -> Colonnade f c a bool h p onTrue onFalse = singleton h (Data.Bool.bool <$> onFalse <*> onTrue <*> p) replaceWhen :: c -> (a -> Bool) - -> Encoding f c a - -> Encoding f c a -replaceWhen newContent p (Encoding v) = Encoding + -> Colonnade f c a + -> Colonnade f c a +replaceWhen newContent p (Colonnade v) = Colonnade ( Vector.map - (\(OneEncoding h encode) -> OneEncoding h $ \a -> + (\(OneColonnade h encode) -> OneColonnade h $ \a -> if p a then newContent else encode a ) v ) --- | 'Encoding' is covariant in its content type. Consequently, it can be +-- | 'Colonnade' is covariant in its content type. Consequently, it can be -- mapped over. There is no standard typeclass for types that are covariant -- in their second-to-last argument, so this function is provided for -- situations that require this. -mapContent :: Functor f => (c1 -> c2) -> Encoding f c1 a -> Encoding f c2 a -mapContent f (Encoding v) = Encoding - $ Vector.map (\(OneEncoding h c) -> (OneEncoding (fmap f h) (f . c))) v +mapContent :: Functor f => (c1 -> c2) -> Colonnade f c1 a -> Colonnade f c2 a +mapContent f (Colonnade v) = Colonnade + $ Vector.map (\(OneColonnade h c) -> (OneColonnade (fmap f h) (f . c))) v -- | 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) +runRow :: (c1 -> c2) -> Colonnade f c1 a -> a -> Vector c2 +runRow g (Colonnade v) a = flip Vector.map v $ + \(OneColonnade _ encode) -> g (encode a) runBothMonadic_ :: Monad m - => Encoding Headed content a + => Colonnade Headed content a -> (content -> content -> m b) -> a -> m () -runBothMonadic_ (Encoding v) g a = - forM_ v $ \(OneEncoding (Headed h) encode) -> g h (encode a) +runBothMonadic_ (Colonnade v) g a = + forM_ v $ \(OneColonnade (Headed h) encode) -> g h (encode a) runRowMonadic :: (Monad m, Monoid b) - => Encoding f content a + => Colonnade f content a -> (content -> m b) -> a -> m b -runRowMonadic (Encoding v) g a = +runRowMonadic (Colonnade v) g a = flip Internal.foldlMapM v - $ \e -> g (oneEncodingEncode e a) + $ \e -> g (oneColonnadeEncode e a) runRowMonadic_ :: Monad m - => Encoding f content a + => Colonnade f content a -> (content -> m b) -> a -> m () -runRowMonadic_ (Encoding v) g a = - forM_ v $ \e -> g (oneEncodingEncode e a) +runRowMonadic_ (Colonnade v) g a = + forM_ v $ \e -> g (oneColonnadeEncode e a) runRowMonadicWith :: (Monad m) => b -> (b -> b -> b) - -> Encoding f content a + -> Colonnade f content a -> (content -> m b) -> a -> m b -runRowMonadicWith bempty bappend (Encoding v) g a = +runRowMonadicWith bempty bappend (Colonnade v) g a = foldlM (\bl e -> do - br <- g (oneEncodingEncode e a) + br <- g (oneColonnadeEncode e a) return (bappend bl br) ) bempty v -runHeader :: (c1 -> c2) -> Encoding Headed c1 a -> Vector c2 -runHeader g (Encoding v) = - Vector.map (g . getHeaded . oneEncodingHead) v +runHeader :: (c1 -> c2) -> Colonnade Headed c1 a -> Vector c2 +runHeader g (Colonnade v) = + Vector.map (g . getHeaded . oneColonnadeHead) v -- | This function is a helper for abusing 'Foldable' to optionally -- render a header. Its future is uncertain. runHeaderMonadicGeneral :: (Monad m, Monoid b, Foldable h) - => Encoding h content a + => Colonnade h content a -> (content -> m b) -> m b -runHeaderMonadicGeneral (Encoding v) g = id +runHeaderMonadicGeneral (Colonnade v) g = id $ fmap (mconcat . Vector.toList) - $ Vector.mapM (Internal.foldlMapM g . oneEncodingHead) v + $ Vector.mapM (Internal.foldlMapM g . oneColonnadeHead) v runHeaderMonadic :: (Monad m, Monoid b) - => Encoding Headed content a + => Colonnade Headed content a -> (content -> m b) -> m b -runHeaderMonadic (Encoding v) g = - fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneEncodingHead) v +runHeaderMonadic (Colonnade v) g = + fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneColonnadeHead) v runHeaderMonadicGeneral_ :: (Monad m, Monoid b, Foldable h) - => Encoding h content a + => Colonnade h content a -> (content -> m b) -> m () -runHeaderMonadicGeneral_ (Encoding v) g = - Vector.mapM_ (Internal.foldlMapM g . oneEncodingHead) v +runHeaderMonadicGeneral_ (Colonnade v) g = + Vector.mapM_ (Internal.foldlMapM g . oneColonnadeHead) v runHeaderMonadic_ :: (Monad m) - => Encoding Headed content a + => Colonnade Headed content a -> (content -> m b) -> m () -runHeaderMonadic_ (Encoding v) g = Vector.mapM_ (g . getHeaded . oneEncodingHead) v +runHeaderMonadic_ (Colonnade v) g = Vector.mapM_ (g . getHeaded . oneColonnadeHead) v -- | Render a collection of rows as an ascii table. The table\'s columns are --- specified by the given 'Encoding'. This implementation is inefficient and +-- specified by the given 'Colonnade'. This implementation is inefficient and -- does not provide any wrapping behavior. It is provided so that users can -- try out @colonnade@ in ghci and so that @doctest@ can verify examples -- code in the haddocks. ascii :: Foldable f - => Encoding Headed String a -- ^ columnar encoding + => Colonnade Headed String a -- ^ columnar encoding -> f a -- ^ rows -> String ascii enc xs = diff --git a/colonnade/src/Colonnade/Encoding/ByteString/Char8.hs b/colonnade/src/Colonnade/Encoding/ByteString/Char8.hs deleted file mode 100644 index 54d3ca7..0000000 --- a/colonnade/src/Colonnade/Encoding/ByteString/Char8.hs +++ /dev/null @@ -1,24 +0,0 @@ -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 - diff --git a/colonnade/src/Colonnade/Encoding/Text.hs b/colonnade/src/Colonnade/Encoding/Text.hs deleted file mode 100644 index ad383a3..0000000 --- a/colonnade/src/Colonnade/Encoding/Text.hs +++ /dev/null @@ -1,24 +0,0 @@ -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" - diff --git a/colonnade/src/Colonnade/Types.hs b/colonnade/src/Colonnade/Types.hs index 8e7d0ac..984018e 100644 --- a/colonnade/src/Colonnade/Types.hs +++ b/colonnade/src/Colonnade/Types.hs @@ -3,16 +3,16 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GADTs #-} module Colonnade.Types - ( Encoding(..) - , Decoding(..) - , OneEncoding(..) + ( Colonnade(..) + , Decolonnade(..) + , OneColonnade(..) , Headed(..) , Headless(..) , Indexed(..) , HeadingErrors(..) - , DecodingCellError(..) - , DecodingRowError(..) - , DecodingCellErrors(..) + , DecolonnadeCellError(..) + , DecolonnadeRowError(..) + , DecolonnadeCellErrors(..) , RowError(..) ) where @@ -48,23 +48,23 @@ instance Monoid (HeadingErrors content) where mappend (HeadingErrors a1 b1) (HeadingErrors a2 b2) = HeadingErrors (a1 Vector.++ a2) (b1 Vector.++ b2) -data DecodingCellError f content = DecodingCellError +data DecolonnadeCellError f content = DecolonnadeCellError { decodingCellErrorContent :: !content , decodingCellErrorHeader :: !(Indexed f content) , decodingCellErrorMessage :: !String } deriving (Show,Read,Eq) --- instance (Show (f content), Typeable content) => Exception (DecodingError f content) +-- instance (Show (f content), Typeable content) => Exception (DecolonnadeError f content) -newtype DecodingCellErrors f content = DecodingCellErrors - { getDecodingCellErrors :: Vector (DecodingCellError f content) +newtype DecolonnadeCellErrors f content = DecolonnadeCellErrors + { getDecolonnadeCellErrors :: Vector (DecolonnadeCellError f content) } 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 +data DecolonnadeRowError f content = DecolonnadeRowError { decodingRowErrorRow :: !Int , decodingRowErrorError :: !(RowError f content) } deriving (Show,Read,Eq) @@ -73,14 +73,14 @@ data DecodingRowError f content = DecodingRowError -- currently use FlexibleContexts. data RowError f content = RowErrorParse !String -- ^ Error occurred parsing the document into cells - | RowErrorDecode !(DecodingCellErrors f content) -- ^ Error decoding the content + | RowErrorDecode !(DecolonnadeCellErrors 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) +-- instance (Show (f content), Typeable content) => Exception (DecolonnadeErrors f content) instance Contravariant Headless where contramap _ Headless = Headless @@ -90,31 +90,31 @@ instance Contravariant Headless where -- 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 - -> Decoding f content a - DecodingAp :: !(f content) -- header +data Decolonnade f content a where + DecolonnadePure :: !a -- function + -> Decolonnade f content a + DecolonnadeAp :: !(f content) -- header -> !(content -> Either String a) -- decoding function - -> !(Decoding f content (a -> b)) -- next decoding - -> Decoding f content b + -> !(Decolonnade f content (a -> b)) -- next decoding + -> Decolonnade f content b -instance Functor (Decoding f content) where - fmap f (DecodingPure a) = DecodingPure (f a) - fmap f (DecodingAp h c apNext) = DecodingAp h c ((f .) <$> apNext) +instance Functor (Decolonnade f content) where + fmap f (DecolonnadePure a) = DecolonnadePure (f a) + fmap f (DecolonnadeAp h c apNext) = DecolonnadeAp h c ((f .) <$> apNext) -instance Applicative (Decoding f content) where - pure = DecodingPure - DecodingPure f <*> y = fmap f y - DecodingAp h c y <*> z = DecodingAp h c (flip <$> y <*> z) +instance Applicative (Decolonnade f content) where + pure = DecolonnadePure + DecolonnadePure f <*> y = fmap f y + DecolonnadeAp h c y <*> z = DecolonnadeAp h c (flip <$> y <*> z) -- | Encodes a header and a cell. -data OneEncoding f content a = OneEncoding - { oneEncodingHead :: !(f content) - , oneEncodingEncode :: !(a -> content) +data OneColonnade f content a = OneColonnade + { oneColonnadeHead :: !(f content) + , oneColonnadeEncode :: !(a -> content) } -instance Contravariant (OneEncoding f content) where - contramap f (OneEncoding h e) = OneEncoding h (e . f) +instance Contravariant (OneColonnade f content) where + contramap f (OneColonnade h e) = OneColonnade h (e . f) -- | An columnar encoding of @a@. The type variable @f@ determines what -- is present in each column in the header row. It is typically instantiated @@ -126,25 +126,25 @@ instance Contravariant (OneEncoding f content) where -- that represent HTML with element attributes are provided that serve -- as the content type. -- --- Internally, an 'Encoding' is represented as a 'Vector' of individual +-- Internally, a 'Colonnade' is represented as a 'Vector' of individual -- column encodings. It is possible to use any collection type with -- 'Alternative' and 'Foldable' instances. However, 'Vector' was chosen to -- optimize the data structure for the use case of building the structure -- once and then folding over it many times. It is recommended that --- 'Encoding's are defined at the top-level so that GHC avoid reconstructing +-- 'Colonnade's are defined at the top-level so that GHC avoid reconstructing -- them every time they are used. -newtype Encoding f c a = Encoding - { getEncoding :: Vector (OneEncoding f c a) +newtype Colonnade f c a = Colonnade + { getColonnade :: Vector (OneColonnade f c a) } deriving (Monoid) -instance Contravariant (Encoding f content) where - contramap f (Encoding v) = Encoding +instance Contravariant (Colonnade f content) where + contramap f (Colonnade v) = Colonnade (Vector.map (contramap f) v) -instance Divisible (Encoding f content) where - conquer = Encoding Vector.empty - divide f (Encoding a) (Encoding b) = - Encoding $ (Vector.++) +instance Divisible (Colonnade f content) where + conquer = Colonnade Vector.empty + divide f (Colonnade a) (Colonnade b) = + Colonnade $ (Vector.++) (Vector.map (contramap (fst . f)) a) (Vector.map (contramap (snd . f)) b) -- (Vector.map (\(OneEncoding h c) -> (h,c . fst . f)) a) diff --git a/stack.yaml b/stack.yaml index d4193b3..6a662bd 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: lts-6.4 +resolver: lts-6.5 # User packages to be built. # Various formats can be used as shown in the example below. diff --git a/yesod-colonnade/src/Yesod/Colonnade.hs b/yesod-colonnade/src/Yesod/Colonnade.hs index 647812b..7cb3fda 100644 --- a/yesod-colonnade/src/Yesod/Colonnade.hs +++ b/yesod-colonnade/src/Yesod/Colonnade.hs @@ -2,20 +2,22 @@ {-# LANGUAGE QuasiQuotes #-} module Yesod.Colonnade - ( table - , tableHeadless - , definitionTable - , listItems - , Cell(..) + ( -- * Build Encoding + Cell(..) , cell , stringCell , textCell , builderCell , anchorCell + -- * Apply Encoding + , table + , tableHeadless + , definitionTable + , listItems ) where import Yesod.Core -import Colonnade.Types +import Colonnade.Types (Colonnade,Headed,Headless) import Data.Text (Text) import Control.Monad import Data.Monoid @@ -25,6 +27,8 @@ import qualified Data.Text as Text import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.Builder as TBuilder +-- | The attributes that will be applied to a @@ and +-- the HTML content that will go inside it. data Cell site = Cell { cellAttrs :: ![(Text,Text)] , cellContents :: !(WidgetT site IO ()) @@ -37,19 +41,29 @@ instance Monoid (Cell site) where mempty = Cell [] mempty mappend (Cell a1 c1) (Cell a2 c2) = Cell (mappend a1 a2) (mappend c1 c2) +-- | Create a 'Cell' from a 'Widget' cell :: WidgetT site IO () -> Cell site cell = Cell [] +-- | Create a 'Cell' from a 'String' stringCell :: String -> Cell site stringCell = cell . fromString +-- | Create a 'Cell' from a 'Text' textCell :: Text -> Cell site textCell = cell . toWidget . toHtml +-- | Create a 'Cell' from a text builder builderCell :: TBuilder.Builder -> Cell site builderCell = cell . toWidget . toHtml . LText.toStrict . TBuilder.toLazyText -anchorCell :: (a -> Route site) -> (a -> WidgetT site IO ()) -> a -> Cell site +-- | Creata a 'Cell' whose content is hyperlinked by wrapping +-- it in an @@. +anchorCell :: + (a -> Route site) -- ^ Route that will go in @href@ + -> (a -> WidgetT site IO ()) -- ^ Content wrapped by @@ + -> a -- ^ Value + -> Cell site anchorCell getRoute getContent a = cell $ do urlRender <- getUrlRender aTag [(Text.pack "href",urlRender (getRoute a))] (getContent a) @@ -62,7 +76,7 @@ listItems :: -- ^ Wrapper for items, often @ul@ -> (WidgetT site IO () -> WidgetT site IO () -> WidgetT site IO ()) -- ^ Combines header with data - -> Encoding Headed (Cell site) a + -> Colonnade Headed (Cell site) a -- ^ How to encode data as a row -> a -- ^ The value to display @@ -79,7 +93,7 @@ listItems ulWrap combine enc = definitionTable :: [(Text,Text)] -- ^ Attributes of @table@ element. - -> Encoding Headed (Cell site) a + -> Colonnade Headed (Cell site) a -- ^ How to encode data as a row -> a -- ^ The value to display @@ -97,7 +111,7 @@ definitionTable attrs enc a = tableEl attrs $ tbody [] $ -- > table [("class","table table-striped")] ... table :: Foldable f => [(Text,Text)] -- ^ Attributes of @table@ element - -> Encoding Headed (Cell site) a -- ^ How to encode data as a row + -> Colonnade Headed (Cell site) a -- ^ How to encode data as a row -> f a -- ^ Rows of data -> WidgetT site IO () table attrs enc xs = tableEl attrs $ do @@ -106,13 +120,13 @@ table attrs enc xs = tableEl attrs $ do tableHeadless :: Foldable f => [(Text,Text)] -- ^ Attributes of @table@ element - -> Encoding Headless (Cell site) a -- ^ How to encode data as a row + -> Colonnade Headless (Cell site) a -- ^ How to encode data as a row -> f a -- ^ Rows of data -> WidgetT site IO () tableHeadless attrs enc xs = tableEl attrs $ tableBody enc xs tableBody :: Foldable f - => Encoding h (Cell site) a -- ^ How to encode data as a row + => Colonnade h (Cell site) a -- ^ How to encode data as a row -> f a -- ^ Rows of data -> WidgetT site IO () tableBody enc xs = tbody [] $ do diff --git a/yesod-colonnade/yesod-colonnade.cabal b/yesod-colonnade/yesod-colonnade.cabal index 8a50738..5786d2b 100644 --- a/yesod-colonnade/yesod-colonnade.cabal +++ b/yesod-colonnade/yesod-colonnade.cabal @@ -1,5 +1,5 @@ name: yesod-colonnade -version: 0.1 +version: 0.2 synopsis: Helper functions for using yesod with colonnade description: Yesod and colonnade homepage: https://github.com/andrewthad/colonnade#readme @@ -18,7 +18,7 @@ library Yesod.Colonnade build-depends: base >= 4.7 && < 5 - , colonnade >= 0.4.6 && < 0.5 + , colonnade >= 0.5 && < 0.6 , yesod-core >= 1.4.0 && < 1.5 , text >= 1.0 && < 1.3 default-language: Haskell2010