colonnade 1.1.1 → 1.2.0

raw patch · 3 files changed

+180/−80 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• colonnade.cabal +3/−1
• src/Colonnade.hs +41/−23
• src/Colonnade/Encode.hs +136/−56

@@ -1,5 +1,5 @@ name:                colonnade-version:             1.1.1+version:             1.2.0 synopsis:            Generic types and functions for columnar encoding and decoding description:   The `colonnade` package provides a way to to talk about@@ -9,6 +9,8 @@   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:+  .+  * <https://hackage.haskell.org/package/lucid-colonnade lucid-colonnade> for `lucid` html tables   .   * <https://hackage.haskell.org/package/blaze-colonnade blaze-colonnade> for `blaze` html tables   .

@@ -12,6 +12,8 @@     Colonnade   , Headed(..)   , Headless(..)+    -- * Typeclasses+  , E.Headedness(..)     -- * Create   , headed   , headless@@ -272,7 +274,7 @@ --    --   >>> let cor = mconcat [cap "Person" colPersonFst, cap "House" colHouseSnd] --   >>> :t cor---   cor :: Cornice ('Cap 'Base) (Person, House) [Char]+--   cor :: Cornice Headed ('Cap 'Base) (Person, House) [Char] --   >>> putStr (asciiCapped cor personHomePairs) --   +-------------+-----------------+ --   | Person      | House           |@@ -284,7 +286,7 @@ --   | Sonia | 12  | Green | $150000 | --   +-------+-----+-------+---------+ --   -cap :: c -> Colonnade Headed a c -> Cornice (Cap Base) a c+cap :: c -> Colonnade h a c -> Cornice h (Cap Base) a c cap h = E.CorniceCap . Vector.singleton . E.OneCornice h . E.CorniceBase  -- | Add another cap to a cornice. There is no limit to how many times@@ -319,11 +321,11 @@ --   | Weekday | $8 | $8 | $8 | $6   | $7    | $8 | $8 | $8 | $6   | $7    | --   | Weekend | $9 | $9 | $9 | $7   | $8    | $9 | $9 | $9 | $7   | $8    | --   +---------+----+----+----+------+-------+----+----+----+------+-------+-recap :: c -> Cornice p a c -> Cornice (Cap p) a c+recap :: c -> Cornice h p a c -> Cornice h (Cap p) a c recap h cor = E.CorniceCap (Vector.singleton (E.OneCornice h cor))  asciiCapped :: Foldable f-  => Cornice p a String -- ^ columnar encoding+  => Cornice Headed p a String -- ^ columnar encoding   -> f a -- ^ rows   -> String asciiCapped cor xs =@@ -332,8 +334,16 @@       sizedCol = E.uncapAnnotated annCor    in E.headersMonoidal         Nothing -        [ (\sz _ -> hyphens (sz + 2) ++ "+", \s -> "+" ++ s ++ "\n")-        , (\sz c -> " " ++ rightPad sz ' ' c ++ " |", \s -> "|" ++ s ++ "\n")+        [ ( \msz _ -> case msz of+              Just sz -> "+" ++ hyphens (sz + 2)+              Nothing -> ""+          , \s -> s ++ "+\n"+          )+        , ( \msz c -> case msz of+              Just sz -> "| " ++ rightPad sz ' ' c ++ " "+              Nothing -> ""+          , \s -> s ++ "|\n"+          )         ] annCor ++ asciiBody sizedCol xs        @@ -349,41 +359,49 @@ ascii col xs =    let sizedCol = E.sizeColumns List.length xs col       divider = concat-        [ "+" -        , E.headerMonoidalFull sizedCol -             (\(E.Sized sz _) -> hyphens (sz + 2) ++ "+")-        , "\n"+        [ E.headerMonoidalFull sizedCol +             (\(E.Sized msz _) -> case msz of+               Just sz -> "+" ++ hyphens (sz + 2)+               Nothing -> ""+             )+        , "+\n"         ]    in List.concat       [ divider       , concat-         [ "|"-         , E.headerMonoidalFull sizedCol-             (\(E.Sized s (Headed h)) -> " " ++ rightPad s ' ' h ++ " |")-         , "\n"+         [ E.headerMonoidalFull sizedCol+             (\(E.Sized msz (Headed h)) -> case msz of+               Just sz -> "| " ++ rightPad sz ' ' h ++ " "+               Nothing -> ""+             )+         , "|\n"          ]       , asciiBody sizedCol xs       ]  asciiBody :: Foldable f-  => Colonnade (E.Sized Headed) a String+  => Colonnade (E.Sized (Maybe Int) Headed) a String   -> f a   -> String asciiBody sizedCol xs =   let divider = concat-        [ "+" -        , E.headerMonoidalFull sizedCol -             (\(E.Sized sz _) -> hyphens (sz + 2) ++ "+")-        , "\n"+        [ E.headerMonoidalFull sizedCol +             (\(E.Sized msz _) -> case msz of+               Just sz -> "+" ++ hyphens (sz + 2)+               Nothing -> ""+             )+        , "+\n"         ]       rowContents = foldMap         (\x -> concat-           [ "|"-           , E.rowMonoidalHeader +           [ E.rowMonoidalHeader                 sizedCol-               (\(E.Sized sz _) c -> " " ++ rightPad sz ' ' c ++ " |")+               (\(E.Sized msz _) c -> case msz of+                 Nothing -> ""+                 Just sz -> "| " ++ rightPad sz ' ' c ++ " "+               )                x-           , "\n"+           , "|\n"            ]         ) xs    in List.concat

@@ -44,6 +44,9 @@   , Headed(..)   , Headless(..)   , Sized(..)+  , ExtractForall(..)+    -- ** Typeclasses+  , Headedness(..)     -- ** Row   , row   , rowMonadic@@ -175,7 +178,7 @@   => (c -> Int) -- ^ Get size from content   -> f a   -> Colonnade h a c-  -> Colonnade (Sized h) a c+  -> Colonnade (Sized (Maybe Int) h) a c sizeColumns toSize rows colonnade = runST $ do   mcol <- newMutableSizedColonnade colonnade   headerUpdateSize toSize mcol @@ -187,14 +190,14 @@   mv <- MVU.replicate (V.length v) 0   return (MutableSizedColonnade v mv) -freezeMutableSizedColonnade :: MutableSizedColonnade s h a c -> ST s (Colonnade (Sized h) a c)+freezeMutableSizedColonnade :: MutableSizedColonnade s h a c -> ST s (Colonnade (Sized (Maybe Int) h) a c) freezeMutableSizedColonnade (MutableSizedColonnade v mv) =   if MVU.length mv /= V.length v     then error "rowMonoidalSize: vector sizes mismatched"     else do       sizeVec <- VU.freeze mv       return $ Colonnade-        $ V.map (\(OneColonnade h enc,sz) -> OneColonnade (Sized sz h) enc)+        $ V.map (\(OneColonnade h enc,sz) -> OneColonnade (Sized (Just sz) h) enc)         $ V.zip v (GV.convert sizeVec)  rowMonadicWith :: @@ -234,12 +237,13 @@   fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneColonnadeHead) v  headerMonadicGeneral_ :: -     (Monad m, Foldable h)+     (Monad m, Headedness h)   => Colonnade h a c   -> (c -> m b)   -> m ()-headerMonadicGeneral_ (Colonnade v) g =-  Vector.mapM_ (mapM_ g . oneColonnadeHead) v+headerMonadicGeneral_ (Colonnade v) g = case headednessExtract of+  Nothing -> return ()+  Just f -> Vector.mapM_ (g . f . oneColonnadeHead) v  headerMonoidalGeneral ::      (Monoid m, Foldable h)@@ -266,37 +270,41 @@ 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 -discard :: Cornice p a c -> Colonnade Headed a c+discard :: Cornice h p a c -> Colonnade h a c discard = go where-  go :: forall p a c. Cornice p a c -> Colonnade Headed a c+  go :: forall h p a c. Cornice h p a c -> Colonnade h a c   go (CorniceBase c) = c   go (CorniceCap children) = Colonnade (getColonnade . go . oneCorniceBody =<< children) -endow :: forall p a c. (c -> c -> c) -> Cornice p a c -> Colonnade Headed a c+endow :: forall p a c. (c -> c -> c) -> Cornice Headed p a c -> Colonnade Headed a c endow f x = case x of   CorniceBase colonnade -> colonnade   CorniceCap v -> Colonnade (V.concatMap (\(OneCornice h b) -> go h b) v)   where-  go :: forall p'. c -> Cornice p' a c -> Vector (OneColonnade Headed a c)+  go :: forall p'. c -> Cornice Headed p' a c -> Vector (OneColonnade Headed a c)   go c (CorniceBase (Colonnade v)) = V.map (mapOneColonnadeHeader (f c)) v   go c (CorniceCap v) = V.concatMap (\(OneCornice h b) -> go (f c h) b) v -uncapAnnotated :: forall p a c. AnnotatedCornice p a c -> Colonnade (Sized Headed) a c+uncapAnnotated :: forall sz p a c h.+     AnnotatedCornice sz h p a c+  -> Colonnade (Sized sz h) a c uncapAnnotated x = case x of   AnnotatedCorniceBase _ colonnade -> colonnade   AnnotatedCorniceCap _ v -> Colonnade (V.concatMap (\(OneCornice _ b) -> go b) v)   where-  go :: forall p'. AnnotatedCornice p' a c -> Vector (OneColonnade (Sized Headed) a c)+  go :: forall p'. +       AnnotatedCornice sz h p' a c+    -> Vector (OneColonnade (Sized sz h) a c)   go (AnnotatedCorniceBase _ (Colonnade v)) = v   go (AnnotatedCorniceCap _ v) = V.concatMap (\(OneCornice _ b) -> go b) v -annotate :: Cornice p a c -> AnnotatedCornice p a c+annotate :: Cornice Headed p a c -> AnnotatedCornice (Maybe Int) Headed p a c annotate = go where-  go :: forall p a c. Cornice p a c -> AnnotatedCornice p a c+  go :: forall p a c. Cornice Headed p a c -> AnnotatedCornice (Maybe Int) Headed p a c   go (CorniceBase c) = let len = V.length (getColonnade c) in     AnnotatedCorniceBase       (if len > 0 then (Just len) else Nothing)-      (mapHeadedness (Sized 1) c)+      (mapHeadedness (Sized (Just 1)) c)   go (CorniceCap children) =     let annChildren = fmap (mapOneCorniceBody go) children      in AnnotatedCorniceCap @@ -324,8 +332,8 @@   -> (Int -> Int) -- ^ finalize   -> (c -> Int) -- ^ Get size from content   -> f a-  -> Cornice p a c -  -> AnnotatedCornice p a c+  -> Cornice Headed p a c +  -> AnnotatedCornice (Maybe Int) Headed p a c annotateFinely g finish toSize xs cornice = runST $ do   m <- newMutableSizedCornice cornice   sizeColonnades toSize xs m@@ -352,16 +360,18 @@      (Int -> Int -> Int) -- ^ fold function   -> (Int -> Int) -- ^ finalize   -> MutableSizedCornice s p a c -  -> ST s (AnnotatedCornice p a c)+  -> ST s (AnnotatedCornice (Maybe Int) Headed p a c) freezeMutableSizedCornice step finish = go   where-  go :: forall p' a' c'. MutableSizedCornice s p' a' c' -> ST s (AnnotatedCornice p' a' c')+  go :: forall p' a' c'.+       MutableSizedCornice s p' a' c' +    -> ST s (AnnotatedCornice (Maybe Int) Headed p' a' c')   go (MutableSizedCorniceBase msc) = do     szCol <- freezeMutableSizedColonnade msc     let sz =            ( mapJustInt finish            . V.foldl' (combineJustInt step) Nothing -          . V.map (Just . sizedSize . oneColonnadeHead)+          . V.map (sizedSize . oneColonnadeHead)           ) (getColonnade szCol)     return (AnnotatedCorniceBase sz szCol)   go (MutableSizedCorniceCap v1) = do@@ -374,10 +384,10 @@     return $ AnnotatedCorniceCap sz v2  newMutableSizedCornice :: forall s p a c.-     Cornice p a c +     Cornice Headed p a c    -> ST s (MutableSizedCornice s p a c) newMutableSizedCornice = go where-  go :: forall p'. Cornice p' a c -> ST s (MutableSizedCornice s p' a c)+  go :: forall p'. Cornice Headed p' a c -> ST s (MutableSizedCornice s p' a c)   go (CorniceBase c) = fmap MutableSizedCorniceBase (newMutableSizedColonnade c)   go (CorniceCap v) = fmap MutableSizedCorniceCap (V.mapM (traverseOneCorniceBody go) v)     @@ -390,7 +400,7 @@   -- | This is an O(1) operation, sort of-size :: AnnotatedCornice p a c -> Maybe Int+size :: AnnotatedCornice sz h p a c -> sz size x = case x of   AnnotatedCorniceBase m _ -> m   AnnotatedCorniceCap sz _ -> sz@@ -401,33 +411,32 @@ mapOneColonnadeHeader :: Functor h => (c -> c) -> OneColonnade h a c -> OneColonnade h a c mapOneColonnadeHeader f (OneColonnade h b) = OneColonnade (fmap f h) b -headersMonoidal :: forall r m c p a.-     Monoid m+headersMonoidal :: forall sz r m c p a h.+     (Monoid m, Headedness h)   => Maybe (Fascia p r, r -> m -> m) -- ^ Apply the Fascia header row content-  -> [(Int -> c -> m, m -> m)] -- ^ Build content from cell content and size-  -> AnnotatedCornice p a c+  -> [(sz -> c -> m, m -> m)] -- ^ Build content from cell content and size+  -> AnnotatedCornice sz h p a c   -> m headersMonoidal wrapRow fromContentList = go wrapRow   where-  go :: forall p'. Maybe (Fascia p' r, r -> m -> m) -> AnnotatedCornice p' a c -> m+  go :: forall p'. Maybe (Fascia p' r, r -> m -> m) -> AnnotatedCornice sz h p' a c -> m   go ef (AnnotatedCorniceBase _ (Colonnade v)) =      let g :: m -> m         g m = case ef of           Nothing -> m           Just (FasciaBase r, f) -> f r m-     in g $ foldMap (\(fromContent,wrap) -> wrap -          (foldMap (\(OneColonnade (Sized sz (Headed h)) _) -> -            (fromContent sz h)) v)) fromContentList+     in case headednessExtract of+          Just unhead -> g $ foldMap (\(fromContent,wrap) -> wrap +            (foldMap (\(OneColonnade (Sized sz h) _) -> +              (fromContent sz (unhead h))) v)) fromContentList+          Nothing -> mempty   go ef (AnnotatedCorniceCap _ v) =      let g :: m -> m         g m = case ef of           Nothing -> m           Just (FasciaCap r _, f) -> f r m      in g (foldMap (\(fromContent,wrap) -> wrap (foldMap (\(OneCornice h b) -> -          (case size b of-            Nothing -> mempty-            Just sz -> fromContent sz h)-          ) v)) fromContentList)+          (fromContent (size b) h)) v)) fromContentList)           <> case ef of                Nothing -> case flattenAnnotated v of                  Nothing -> mempty@@ -436,23 +445,33 @@                  Nothing -> mempty                  Just annCoreNext -> go (Just (fn,f)) annCoreNext -flattenAnnotated :: Vector (OneCornice AnnotatedCornice p a c) -> Maybe (AnnotatedCornice p a c)+flattenAnnotated ::+     Vector (OneCornice (AnnotatedCornice sz h) p a c)+  -> Maybe (AnnotatedCornice sz h p a c) flattenAnnotated v = case v V.!? 0 of    Nothing -> Nothing   Just (OneCornice _ x) -> Just $ case x of     AnnotatedCorniceBase m _ -> flattenAnnotatedBase m v     AnnotatedCorniceCap m _ -> flattenAnnotatedCap m v -flattenAnnotatedBase :: Maybe Int -> Vector (OneCornice AnnotatedCornice Base a c) -> AnnotatedCornice Base a c+flattenAnnotatedBase ::+     sz+  -> Vector (OneCornice (AnnotatedCornice sz h) Base a c)+  -> AnnotatedCornice sz h Base a c flattenAnnotatedBase msz = AnnotatedCorniceBase msz   . Colonnade    . V.concatMap      (\(OneCornice _ (AnnotatedCorniceBase _ (Colonnade v))) -> v) -flattenAnnotatedCap :: Maybe Int -> Vector (OneCornice AnnotatedCornice (Cap p) a c) -> AnnotatedCornice (Cap p) a c+flattenAnnotatedCap ::+     sz+  -> Vector (OneCornice (AnnotatedCornice sz h) (Cap p) a c)+  -> AnnotatedCornice sz h (Cap p) a c flattenAnnotatedCap m = AnnotatedCorniceCap m . V.concatMap getTheVector -getTheVector :: OneCornice AnnotatedCornice (Cap p) a c -> Vector (OneCornice AnnotatedCornice p a c)+getTheVector :: +     OneCornice (AnnotatedCornice sz h) (Cap p) a c +  -> Vector (OneCornice (AnnotatedCornice sz h) p a c) getTheVector (OneCornice _ (AnnotatedCorniceCap _ v)) = v  data MutableSizedCornice s (p :: Pillar) a c where@@ -480,6 +499,10 @@ newtype Headed a = Headed { getHeaded :: a }   deriving (Eq,Ord,Functor,Show,Read,Foldable) +instance Applicative Headed where+  pure = Headed+  Headed f <*> Headed a = Headed (f a)+ -- | As the first argument to the 'Colonnade' type  --   constructor, this indictates that the columnar encoding does not have  --   a header. This type is isomorphic to 'Proxy' but is @@ -492,8 +515,12 @@ data Headless a = Headless   deriving (Eq,Ord,Functor,Show,Read,Foldable) -data Sized f a = Sized-  { sizedSize :: {-# UNPACK #-} !Int+instance Applicative Headless where+  pure _ = Headless+  Headless <*> Headless = Headless++data Sized sz f a = Sized+  { sizedSize :: !sz   , sizedContent :: !(f a)   } deriving (Functor, Foldable) @@ -554,7 +581,7 @@ data Pillar = Cap !Pillar | Base  class ToEmptyCornice (p :: Pillar) where-  toEmptyCornice :: Cornice p a c+  toEmptyCornice :: Cornice h p a c  instance ToEmptyCornice Base where   toEmptyCornice = CorniceBase mempty@@ -569,43 +596,96 @@ data OneCornice k (p :: Pillar) a c = OneCornice   { oneCorniceHead :: !c   , oneCorniceBody :: !(k p a c)-  }+  } deriving (Functor) -data Cornice (p :: Pillar) a c where-  CorniceBase :: !(Colonnade Headed a c) -> Cornice Base a c-  CorniceCap :: {-# UNPACK #-} !(Vector (OneCornice Cornice p a c)) -> Cornice (Cap p) a c+data Cornice h (p :: Pillar) a c where+  CorniceBase :: !(Colonnade h a c) -> Cornice h Base a c+  CorniceCap :: {-# UNPACK #-} !(Vector (OneCornice (Cornice h) p a c)) -> Cornice h (Cap p) a c -instance Semigroup (Cornice p a c) where+instance Functor h => Functor (Cornice h p a) where+  fmap f x = case x of+    CorniceBase c -> CorniceBase (fmap f c)+    CorniceCap c -> CorniceCap (mapVectorCornice f c)++instance Functor h => Profunctor (Cornice h p) where+  rmap = fmap+  lmap f x = case x of+    CorniceBase c -> CorniceBase (lmap f c)+    CorniceCap c -> CorniceCap (contramapVectorCornice f c)++instance Semigroup (Cornice h p a c) where   CorniceBase a <> CorniceBase b = CorniceBase (mappend a b)   CorniceCap a <> CorniceCap b = CorniceCap (a Vector.++ b)   sconcat xs@(x :| _) = case x of     CorniceBase _ -> CorniceBase (Colonnade (vectorConcatNE (fmap (getColonnade . getCorniceBase) xs)))     CorniceCap _ -> CorniceCap (vectorConcatNE (fmap getCorniceCap xs)) -instance ToEmptyCornice p => Monoid (Cornice p a c) where+instance ToEmptyCornice p => Monoid (Cornice h p a c) where   mempty = toEmptyCornice   mappend = (Semigroup.<>)   mconcat xs1 = case xs1 of     [] -> toEmptyCornice     x : xs2 -> Semigroup.sconcat (x :| xs2) -getCorniceBase :: Cornice Base a c -> Colonnade Headed a c+mapVectorCornice :: Functor h => (c -> d) -> Vector (OneCornice (Cornice h) p a c) -> Vector (OneCornice (Cornice h) p a d)+mapVectorCornice f = V.map (fmap f)++contramapVectorCornice :: Functor h => (b -> a) -> Vector (OneCornice (Cornice h) p a c) -> Vector (OneCornice (Cornice h) p b c)+contramapVectorCornice f = V.map (lmapOneCornice f)++lmapOneCornice :: Functor h => (b -> a) -> OneCornice (Cornice h) p a c -> OneCornice (Cornice h) p b c+lmapOneCornice f (OneCornice theHead theBody) = OneCornice theHead (lmap f theBody) ++getCorniceBase :: Cornice h Base a c -> Colonnade h a c getCorniceBase (CorniceBase c) = c -getCorniceCap :: Cornice (Cap p) a c -> Vector (OneCornice Cornice p a c)+getCorniceCap :: Cornice h (Cap p) a c -> Vector (OneCornice (Cornice h) p a c) getCorniceCap (CorniceCap c) = c -data AnnotatedCornice (p :: Pillar) a c where-  AnnotatedCorniceBase :: !(Maybe Int) -> !(Colonnade (Sized Headed) a c) -> AnnotatedCornice Base a c+data AnnotatedCornice sz h (p :: Pillar) a c where+  AnnotatedCorniceBase ::+       !sz+    -> !(Colonnade (Sized sz h) a c)+    -> AnnotatedCornice sz h Base a c   AnnotatedCorniceCap :: -       !(Maybe Int)-    -> {-# UNPACK #-} !(Vector (OneCornice AnnotatedCornice p a c))-    -> AnnotatedCornice (Cap p) a c+       !sz+    -> {-# UNPACK #-} !(Vector (OneCornice (AnnotatedCornice sz h) p a c))+    -> AnnotatedCornice sz h (Cap p) a c  -- data MaybeInt = JustInt {-# UNPACK #-} !Int | NothingInt --- | This is provided with vector-0.12, but we include a copy here +-- | This is provided with @vector-0.12@, but we include a copy here  --   for compatibility. vectorConcatNE :: NonEmpty (Vector a) -> Vector a vectorConcatNE = Vector.concat . toList++-- | This class communicates that a container holds either zero+--   elements or one element. Furthermore, all inhabitants of+--   the type must hold the same number of elements. Both+--   'Headed' and 'Headless' have instances. The following+--   law accompanies any instances:+--+--   > maybe x (\f -> f (headednessPure x)) headednessContents == x+--   > todo: come up with another law that relates to Traversable+--+--   Consequently, there is no instance for 'Maybe', which cannot+--   satisfy the laws since it has inhabitants which hold different+--   numbers of elements. 'Nothing' holds 0 elements and 'Just' holds+--   1 element.+class Headedness h where+  headednessPure :: a -> h a+  headednessExtract :: Maybe (h a -> a)+  headednessExtractForall :: Maybe (ExtractForall h)++instance Headedness Headed where+  headednessPure = Headed+  headednessExtract = Just getHeaded +  headednessExtractForall = Just (ExtractForall getHeaded)++instance Headedness Headless where+  headednessPure _ = Headless+  headednessExtract = Nothing+  headednessExtractForall = Nothing++newtype ExtractForall h = ExtractForall { runExtractForall :: forall a. h a -> a }