mirror of
https://github.com/byteverse/colonnade.git
synced 2024-09-11 06:45:41 +03:00
add blaze support
This commit is contained in:
parent
75b2431b5c
commit
eb29b10c39
1
.gitignore
vendored
1
.gitignore
vendored
@ -35,6 +35,7 @@ tags
|
||||
TAGS
|
||||
|
||||
docs/db/unthreat
|
||||
ex1.hs
|
||||
|
||||
geolite-csv/data/large
|
||||
geolite-lmdb/data/large
|
||||
|
30
blaze-colonnade/LICENSE
Normal file
30
blaze-colonnade/LICENSE
Normal file
@ -0,0 +1,30 @@
|
||||
Copyright Andrew Martin (c) 2016
|
||||
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials provided
|
||||
with the distribution.
|
||||
|
||||
* Neither the name of Andrew Martin nor the names of other
|
||||
contributors may be used to endorse or promote products derived
|
||||
from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
2
blaze-colonnade/Setup.hs
Normal file
2
blaze-colonnade/Setup.hs
Normal file
@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
29
blaze-colonnade/blaze-colonnade.cabal
Normal file
29
blaze-colonnade/blaze-colonnade.cabal
Normal file
@ -0,0 +1,29 @@
|
||||
name: blaze-colonnade
|
||||
version: 0.1
|
||||
synopsis: Helper functions for using blaze-html with colonnade
|
||||
description: Blaze HTML and colonnade
|
||||
homepage: https://github.com/andrewthad/colonnade#readme
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Andrew Martin
|
||||
maintainer: andrew.thaddeus@gmail.com
|
||||
copyright: 2017 Andrew Martin
|
||||
category: web
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
|
||||
library
|
||||
hs-source-dirs: src
|
||||
exposed-modules:
|
||||
Text.Blaze.Colonnade
|
||||
build-depends:
|
||||
base >= 4.7 && < 5
|
||||
, colonnade >= 1.0 && < 1.1
|
||||
, blaze-markup >= 0.7 && < 0.9
|
||||
, blaze-html >= 0.8 && < 0.10
|
||||
, text >= 1.0 && < 1.3
|
||||
default-language: Haskell2010
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/andrewthad/colonnade
|
48
blaze-colonnade/hackage-docs.sh
Executable file
48
blaze-colonnade/hackage-docs.sh
Executable file
@ -0,0 +1,48 @@
|
||||
#!/bin/bash
|
||||
set -e
|
||||
|
||||
if [ "$#" -ne 1 ]; then
|
||||
echo "Usage: scripts/hackage-docs.sh HACKAGE_USER"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
user=$1
|
||||
|
||||
cabal_file=$(find . -maxdepth 1 -name "*.cabal" -print -quit)
|
||||
if [ ! -f "$cabal_file" ]; then
|
||||
echo "Run this script in the top-level package directory"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
pkg=$(awk -F ":[[:space:]]*" 'tolower($1)=="name" { print $2 }' < "$cabal_file")
|
||||
ver=$(awk -F ":[[:space:]]*" 'tolower($1)=="version" { print $2 }' < "$cabal_file")
|
||||
|
||||
if [ -z "$pkg" ]; then
|
||||
echo "Unable to determine package name"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ -z "$ver" ]; then
|
||||
echo "Unable to determine package version"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
echo "Detected package: $pkg-$ver"
|
||||
|
||||
dir=$(mktemp -d build-docs.XXXXXX)
|
||||
trap 'rm -r "$dir"' EXIT
|
||||
|
||||
# cabal haddock --hoogle --hyperlink-source --html-location='/package/$pkg-$version/docs' --contents-location='/package/$pkg-$version'
|
||||
stack haddock
|
||||
|
||||
cp -R .stack-work/dist/x86_64-linux/Cabal-1.22.5.0/doc/html/$pkg/ $dir/$pkg-$ver-docs
|
||||
# /home/andrew/.stack/snapshots/x86_64-linux/lts-5.17/7.10.3/doc/index.html
|
||||
|
||||
tar cvz -C $dir --format=ustar -f $dir/$pkg-$ver-docs.tar.gz $pkg-$ver-docs
|
||||
|
||||
curl -X PUT \
|
||||
-H 'Content-Type: application/x-tar' \
|
||||
-H 'Content-Encoding: gzip' \
|
||||
-u "$user" \
|
||||
--data-binary "@$dir/$pkg-$ver-docs.tar.gz" \
|
||||
"https://hackage.haskell.org/package/$pkg-$ver/docs"
|
168
blaze-colonnade/src/Text/Blaze/Colonnade.hs
Normal file
168
blaze-colonnade/src/Text/Blaze/Colonnade.hs
Normal file
@ -0,0 +1,168 @@
|
||||
-- | Build HTML tables using @blaze-html@ and @colonnade@.
|
||||
--
|
||||
module Text.Blaze.Colonnade
|
||||
( -- * Apply
|
||||
-- $build
|
||||
encodeHeadedHtmlTable
|
||||
, encodeHeadlessHtmlTable
|
||||
, encodeHeadedCellTable
|
||||
, encodeHeadlessCellTable
|
||||
, encodeTable
|
||||
-- * Cell
|
||||
-- $build
|
||||
, Cell(..)
|
||||
, htmlCell
|
||||
, stringCell
|
||||
, textCell
|
||||
, lazyTextCell
|
||||
, builderCell
|
||||
-- * Discussion
|
||||
-- $discussion
|
||||
) where
|
||||
|
||||
import Text.Blaze (Attribute,(!))
|
||||
import Text.Blaze.Html (Html, toHtml)
|
||||
import Colonnade (Colonnade,Headed,Headless)
|
||||
import Data.Text (Text)
|
||||
import Control.Monad
|
||||
import Data.Monoid
|
||||
import Data.Foldable
|
||||
import Data.String (IsString(..))
|
||||
import qualified Text.Blaze as Blaze
|
||||
import qualified Text.Blaze.Html5 as H
|
||||
import qualified Text.Blaze.Html5.Attributes as HA
|
||||
import qualified Colonnade.Encode as Encode
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lazy as LText
|
||||
import qualified Data.Text.Lazy.Builder as TBuilder
|
||||
|
||||
-- $build
|
||||
--
|
||||
-- The 'Cell' type is used to build a 'Colonnade' that
|
||||
-- has 'Html' content inside table cells and may optionally
|
||||
-- have attributes added to the @<td>@ or @<th>@ elements
|
||||
-- that wrap this HTML content.
|
||||
|
||||
-- | The attributes that will be applied to a @<td>@ and
|
||||
-- the HTML content that will go inside it.
|
||||
data Cell = Cell
|
||||
{ cellAttributes :: !Attribute
|
||||
, cellHtml :: !Html
|
||||
}
|
||||
|
||||
instance IsString Cell where
|
||||
fromString = stringCell
|
||||
|
||||
instance Monoid Cell where
|
||||
mempty = Cell mempty mempty
|
||||
mappend (Cell a1 c1) (Cell a2 c2) = Cell (mappend a1 a2) (mappend c1 c2)
|
||||
|
||||
-- | Create a 'Cell' from a 'Widget'
|
||||
htmlCell :: Html -> Cell
|
||||
htmlCell = Cell mempty
|
||||
|
||||
-- | Create a 'Cell' from a 'String'
|
||||
stringCell :: String -> Cell
|
||||
stringCell = htmlCell . fromString
|
||||
|
||||
-- | Create a 'Cell' from a 'Text'
|
||||
textCell :: Text -> Cell
|
||||
textCell = htmlCell . toHtml
|
||||
|
||||
-- | Create a 'Cell' from a lazy text
|
||||
lazyTextCell :: LText.Text -> Cell
|
||||
lazyTextCell = textCell . LText.toStrict
|
||||
|
||||
-- | Create a 'Cell' from a text builder
|
||||
builderCell :: TBuilder.Builder -> Cell
|
||||
builderCell = lazyTextCell . TBuilder.toLazyText
|
||||
|
||||
encodeTable ::
|
||||
(Foldable f, Foldable h)
|
||||
=> Maybe Attribute -- ^ Attributes of @<thead>@, pass 'Nothing' to omit @<thead>@
|
||||
-> Attribute -- ^ Attributes of @<tbody>@ element
|
||||
-> (a -> Attribute) -- ^ Attributes of each @<tr>@ element
|
||||
-> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html'
|
||||
-> Attribute -- ^ Attributes of @<table>@ element
|
||||
-> Colonnade h c a -- ^ How to encode data as a row
|
||||
-> f a -- ^ Collection of data
|
||||
-> Html
|
||||
encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =
|
||||
H.table ! tableAttrs $ do
|
||||
for_ mtheadAttrs $ \theadAttrs -> do
|
||||
H.thead ! theadAttrs $ do
|
||||
Encode.headerMonadicGeneral_ colonnade (wrapContent H.th)
|
||||
H.tbody ! tbodyAttrs $ do
|
||||
forM_ xs $ \x -> do
|
||||
H.tr ! trAttrs x $ Encode.rowMonadic_ colonnade (wrapContent H.td) x
|
||||
|
||||
encodeHeadedCellTable ::
|
||||
Foldable f
|
||||
=> Attribute -- ^ Attributes of @<table>@ element
|
||||
-> Colonnade Headed Cell a -- ^ How to encode data as columns
|
||||
-> f a -- ^ Collection of data
|
||||
-> Html
|
||||
encodeHeadedCellTable = encodeTable
|
||||
(Just mempty) mempty (const mempty) htmlFromCell
|
||||
|
||||
encodeHeadlessCellTable ::
|
||||
Foldable f
|
||||
=> Attribute -- ^ Attributes of @<table>@ element
|
||||
-> Colonnade Headless Cell a -- ^ How to encode data as columns
|
||||
-> f a -- ^ Collection of data
|
||||
-> Html
|
||||
encodeHeadlessCellTable = encodeTable
|
||||
Nothing mempty (const mempty) htmlFromCell
|
||||
|
||||
encodeHeadedHtmlTable ::
|
||||
Foldable f
|
||||
=> Attribute -- ^ Attributes of @<table>@ element
|
||||
-> Colonnade Headed Html a -- ^ How to encode data as columns
|
||||
-> f a -- ^ Collection of data
|
||||
-> Html
|
||||
encodeHeadedHtmlTable = encodeTable
|
||||
(Just mempty) mempty (const mempty) ($)
|
||||
|
||||
encodeHeadlessHtmlTable ::
|
||||
Foldable f
|
||||
=> Attribute -- ^ Attributes of @<table>@ element
|
||||
-> Colonnade Headless Html a -- ^ How to encode data as columns
|
||||
-> f a -- ^ Collection of data
|
||||
-> Html
|
||||
encodeHeadlessHtmlTable = encodeTable
|
||||
Nothing mempty (const mempty) ($)
|
||||
|
||||
tableBody :: Foldable f
|
||||
=> Colonnade h Cell a -- ^ How to encode data as a row
|
||||
-> f a -- ^ Rows of data
|
||||
-> Html
|
||||
tableBody enc xs = H.tbody $ do
|
||||
forM_ xs $ \x -> do
|
||||
H.tr $ Encode.rowMonadic enc (htmlFromCell H.td) x
|
||||
|
||||
htmlFromCell :: (Html -> Html) -> Cell -> Html
|
||||
htmlFromCell f (Cell attr content) = f ! attr $ content
|
||||
|
||||
-- $discussion
|
||||
--
|
||||
-- In this module, some of the functions for applying a 'Colonnade' to
|
||||
-- some values to build a table have roughly this type signature:
|
||||
--
|
||||
-- > Foldable a => Colonnade Headedness Cell a -> f a -> Html
|
||||
--
|
||||
-- The 'Colonnade'\'s content type is 'Cell', but the content
|
||||
-- type of the result is 'Html'. It may not be immidiately clear why
|
||||
-- this is useful done. Another strategy, which this library also
|
||||
-- uses, is to write
|
||||
-- these functions to take a 'Colonnade' whose content is 'Html':
|
||||
--
|
||||
-- > Foldable a => Colonnade Headedness Html a -> f a -> Html
|
||||
--
|
||||
-- When the 'Colonnade'\'s content type is 'Html', then the header
|
||||
-- content is rendered as the child of a @<th>@ and the row
|
||||
-- content the child of a @<td>@. However, it is not possible
|
||||
-- to add attributes to these parent elements. To accomodate this
|
||||
-- situation, it is necessary to introduce 'Cell', which includes
|
||||
-- the possibility of attributes on the parent node.
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: colonnade
|
||||
version: 0.5
|
||||
version: 1.0.0
|
||||
synopsis: Generic types and functions for columnar encoding and decoding
|
||||
description:
|
||||
The `colonnade` package provides a way to to talk about
|
||||
@ -29,6 +29,7 @@ library
|
||||
hs-source-dirs: src
|
||||
exposed-modules:
|
||||
Colonnade
|
||||
Colonnade.Encode
|
||||
Colonnade.Internal
|
||||
build-depends:
|
||||
base >= 4.7 && < 5
|
||||
|
@ -17,23 +17,12 @@ module Colonnade
|
||||
, bool
|
||||
, replaceWhen
|
||||
, mapContent
|
||||
-- * Render
|
||||
-- $render
|
||||
, runRow
|
||||
, runRowMonadic
|
||||
, runRowMonadic_
|
||||
, runRowMonadicWith
|
||||
, runHeader
|
||||
, runHeaderMonadic
|
||||
, runHeaderMonadic_
|
||||
, runHeaderMonadicGeneral
|
||||
, runHeaderMonadicGeneral_
|
||||
, runBothMonadic_
|
||||
-- * Ascii Table
|
||||
, ascii
|
||||
) where
|
||||
|
||||
import Colonnade.Internal
|
||||
import qualified Colonnade.Encode as Encode
|
||||
import Data.Vector (Vector)
|
||||
import Data.Foldable
|
||||
import Data.Monoid (Endo(..))
|
||||
@ -211,94 +200,6 @@ 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
|
||||
|
||||
-- $render
|
||||
--
|
||||
-- The rendering functions, which by convention begin with
|
||||
-- the word @run@, are provided as a convenience for for
|
||||
-- apply a columnar encoding.
|
||||
|
||||
|
||||
|
||||
-- | Consider providing a variant the produces a list
|
||||
-- instead. It may allow more things to get inlined
|
||||
-- in to a loop.
|
||||
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
|
||||
=> Colonnade Headed content a
|
||||
-> (content -> content -> m b)
|
||||
-> a
|
||||
-> m ()
|
||||
runBothMonadic_ (Colonnade v) g a =
|
||||
forM_ v $ \(OneColonnade (Headed h) encode) -> g h (encode a)
|
||||
|
||||
runRowMonadic :: (Monad m, Monoid b)
|
||||
=> Colonnade f content a
|
||||
-> (content -> m b)
|
||||
-> a
|
||||
-> m b
|
||||
runRowMonadic (Colonnade v) g a =
|
||||
flip foldlMapM v
|
||||
$ \e -> g (oneColonnadeEncode e a)
|
||||
|
||||
runRowMonadic_ :: Monad m
|
||||
=> Colonnade f content a
|
||||
-> (content -> m b)
|
||||
-> a
|
||||
-> m ()
|
||||
runRowMonadic_ (Colonnade v) g a =
|
||||
forM_ v $ \e -> g (oneColonnadeEncode e a)
|
||||
|
||||
runRowMonadicWith :: (Monad m)
|
||||
=> b
|
||||
-> (b -> b -> b)
|
||||
-> Colonnade f content a
|
||||
-> (content -> m b)
|
||||
-> a
|
||||
-> m b
|
||||
runRowMonadicWith bempty bappend (Colonnade v) g a =
|
||||
foldlM (\bl e -> do
|
||||
br <- g (oneColonnadeEncode e a)
|
||||
return (bappend bl br)
|
||||
) bempty 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)
|
||||
=> Colonnade h content a
|
||||
-> (content -> m b)
|
||||
-> m b
|
||||
runHeaderMonadicGeneral (Colonnade v) g = id
|
||||
$ fmap (mconcat . Vector.toList)
|
||||
$ Vector.mapM (foldlMapM g . oneColonnadeHead) v
|
||||
|
||||
runHeaderMonadic :: (Monad m, Monoid b)
|
||||
=> Colonnade Headed content a
|
||||
-> (content -> m b)
|
||||
-> m b
|
||||
runHeaderMonadic (Colonnade v) g =
|
||||
fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneColonnadeHead) v
|
||||
|
||||
runHeaderMonadicGeneral_ :: (Monad m, Monoid b, Foldable h)
|
||||
=> Colonnade h content a
|
||||
-> (content -> m b)
|
||||
-> m ()
|
||||
runHeaderMonadicGeneral_ (Colonnade v) g =
|
||||
Vector.mapM_ (foldlMapM g . oneColonnadeHead) v
|
||||
|
||||
runHeaderMonadic_ ::
|
||||
(Monad m)
|
||||
=> Colonnade Headed content a
|
||||
-> (content -> m b)
|
||||
-> m ()
|
||||
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 'Colonnade'. This implementation is inefficient and
|
||||
-- does not provide any wrapping behavior. It is provided so that users can
|
||||
@ -310,9 +211,9 @@ ascii :: Foldable f
|
||||
-> String
|
||||
ascii enc xs =
|
||||
let theHeader :: [(Int,String)]
|
||||
theHeader = (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ")) (toList (runHeader id enc))
|
||||
theHeader = (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ")) (toList (Encode.header id enc))
|
||||
theBody :: [[(Int,String)]]
|
||||
theBody = map (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ") . toList . runRow id enc) (toList xs)
|
||||
theBody = map (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ") . toList . Encode.row id enc) (toList xs)
|
||||
sizes :: [Int]
|
||||
sizes = ($ replicate (length theHeader) 1) $ appEndo $ mconcat
|
||||
[ foldMap (\(i,str) -> Endo (replaceAt i (length str))) theHeader
|
||||
@ -354,8 +255,23 @@ 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
|
||||
-- data Company = Company String String Int
|
||||
--
|
||||
-- data Company = Company
|
||||
-- { companyName :: String
|
||||
-- , companyCountry :: String
|
||||
-- , companyValue :: Int
|
||||
-- } deriving (Show)
|
||||
--
|
||||
-- myCompanies :: [Company]
|
||||
-- myCompanies =
|
||||
-- [ Company "eCommHub" "United States" 50
|
||||
-- , Company "Layer 3 Communications" "United States" 10000000
|
||||
-- , Company "Microsoft" "England" 500000000
|
||||
-- ]
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
132
colonnade/src/Colonnade/Encode.hs
Normal file
132
colonnade/src/Colonnade/Encode.hs
Normal file
@ -0,0 +1,132 @@
|
||||
-- | Most users of this library do not need this module. The functions
|
||||
-- here are used to build functions that apply a 'Colonnade'
|
||||
-- to a collection of values, building a table from them. Ultimately,
|
||||
-- a function that applies a @Colonnade Headed MyCell a@
|
||||
-- to data will have roughly the following type:
|
||||
--
|
||||
-- > myTableRenderer :: Foldable g => Colonnade Headed MyCell a -> g a -> MyContent
|
||||
--
|
||||
-- In the companion packages @yesod-colonnade@ and
|
||||
-- @reflex-dom-colonnade@, functions with
|
||||
-- similar type signatures are readily available.
|
||||
-- These packages use the functions provided here
|
||||
-- in the implementations of their rendering functions.
|
||||
-- It is recommended that users who believe they may need
|
||||
-- this module look at the source of the companion packages
|
||||
-- to see an example of how this module\'s functions are used.
|
||||
-- Other backends are encouraged to use these functions
|
||||
-- to build monadic or monoidal content from a 'Colonnade'.
|
||||
--
|
||||
-- The functions exported here take a 'Colonnade' and
|
||||
-- convert it to a fragment of content. The functions whose
|
||||
-- names start with @row@ take at least a @Colonnade f c a@ and an @a@
|
||||
-- value to generate a row of content. The functions whose names
|
||||
-- start with @header@ need the @Colonnade f c a@ but not
|
||||
-- an @a@ value since a value is not needed to build a header.
|
||||
--
|
||||
module Colonnade.Encode
|
||||
( row
|
||||
, rowMonadic
|
||||
, rowMonadic_
|
||||
, rowMonadicWith
|
||||
, header
|
||||
, headerMonadic
|
||||
, headerMonadic_
|
||||
, headerMonadicGeneral
|
||||
, headerMonadicGeneral_
|
||||
, bothMonadic_
|
||||
) where
|
||||
|
||||
import Colonnade.Internal
|
||||
import Data.Vector (Vector)
|
||||
import Data.Foldable
|
||||
import qualified Data.Vector as Vector
|
||||
|
||||
-- | Consider providing a variant the produces a list
|
||||
-- instead. It may allow more things to get inlined
|
||||
-- in to a loop.
|
||||
row :: (c1 -> c2) -> Colonnade f c1 a -> a -> Vector c2
|
||||
row g (Colonnade v) a = flip Vector.map v $
|
||||
\(OneColonnade _ encode) -> g (encode a)
|
||||
|
||||
bothMonadic_ :: Monad m
|
||||
=> Colonnade Headed content a
|
||||
-> (content -> content -> m b)
|
||||
-> a
|
||||
-> m ()
|
||||
bothMonadic_ (Colonnade v) g a =
|
||||
forM_ v $ \(OneColonnade (Headed h) encode) -> g h (encode a)
|
||||
|
||||
rowMonadic ::
|
||||
(Monad m, Monoid b)
|
||||
=> Colonnade f content a
|
||||
-> (content -> m b)
|
||||
-> a
|
||||
-> m b
|
||||
rowMonadic (Colonnade v) g a =
|
||||
flip foldlMapM v
|
||||
$ \e -> g (oneColonnadeEncode e a)
|
||||
|
||||
rowMonadic_ ::
|
||||
Monad m
|
||||
=> Colonnade f content a
|
||||
-> (content -> m b)
|
||||
-> a
|
||||
-> m ()
|
||||
rowMonadic_ (Colonnade v) g a =
|
||||
forM_ v $ \e -> g (oneColonnadeEncode e a)
|
||||
|
||||
rowMonadicWith ::
|
||||
(Monad m)
|
||||
=> b
|
||||
-> (b -> b -> b)
|
||||
-> Colonnade f content a
|
||||
-> (content -> m b)
|
||||
-> a
|
||||
-> m b
|
||||
rowMonadicWith bempty bappend (Colonnade v) g a =
|
||||
foldlM (\bl e -> do
|
||||
br <- g (oneColonnadeEncode e a)
|
||||
return (bappend bl br)
|
||||
) bempty v
|
||||
|
||||
header :: (c1 -> c2) -> Colonnade Headed c1 a -> Vector c2
|
||||
header 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.
|
||||
headerMonadicGeneral :: (Monad m, Monoid b, Foldable h)
|
||||
=> Colonnade h content a
|
||||
-> (content -> m b)
|
||||
-> m b
|
||||
headerMonadicGeneral (Colonnade v) g = id
|
||||
$ fmap (mconcat . Vector.toList)
|
||||
$ Vector.mapM (foldlMapM g . oneColonnadeHead) v
|
||||
|
||||
headerMonadic ::
|
||||
(Monad m, Monoid b)
|
||||
=> Colonnade Headed content a
|
||||
-> (content -> m b)
|
||||
-> m b
|
||||
headerMonadic (Colonnade v) g =
|
||||
fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneColonnadeHead) v
|
||||
|
||||
headerMonadicGeneral_ ::
|
||||
(Monad m, Foldable h)
|
||||
=> Colonnade h content a
|
||||
-> (content -> m b)
|
||||
-> m ()
|
||||
headerMonadicGeneral_ (Colonnade v) g =
|
||||
Vector.mapM_ (mapM_ g . oneColonnadeHead) v
|
||||
|
||||
headerMonadic_ ::
|
||||
(Monad m)
|
||||
=> Colonnade Headed content a
|
||||
-> (content -> m b)
|
||||
-> m ()
|
||||
headerMonadic_ (Colonnade v) g = Vector.mapM_ (g . getHeaded . oneColonnadeHead) v
|
||||
|
||||
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
|
||||
|
@ -46,15 +46,15 @@ instance Contravariant Headless where
|
||||
contramap _ Headless = Headless
|
||||
|
||||
-- | Encodes a header and a cell.
|
||||
data OneColonnade f content a = OneColonnade
|
||||
{ oneColonnadeHead :: !(f content)
|
||||
data OneColonnade h content a = OneColonnade
|
||||
{ oneColonnadeHead :: !(h content)
|
||||
, oneColonnadeEncode :: !(a -> content)
|
||||
}
|
||||
|
||||
instance Contravariant (OneColonnade f content) where
|
||||
instance Contravariant (OneColonnade h content) where
|
||||
contramap f (OneColonnade h e) = OneColonnade h (e . f)
|
||||
|
||||
-- | An columnar encoding of @a@. The type variable @f@ determines what
|
||||
-- | An columnar encoding of @a@. The type variable @h@ determines what
|
||||
-- is present in each column in the header row. It is typically instantiated
|
||||
-- to 'Headed' and occasionally to 'Headless'. There is nothing that
|
||||
-- restricts it to these two types, although they satisfy the majority
|
||||
@ -62,7 +62,17 @@ instance Contravariant (OneColonnade f content) where
|
||||
-- be @Text@, @String@, or @ByteString@. In the companion libraries
|
||||
-- @reflex-dom-colonnade@ and @yesod-colonnade@, additional types
|
||||
-- that represent HTML with element attributes are provided that serve
|
||||
-- as the content type.
|
||||
-- as the content type. Presented more visually:
|
||||
--
|
||||
-- > +---- Content (Text, ByteString, Html, etc.)
|
||||
-- > |
|
||||
-- > v
|
||||
-- > Colonnade h c a
|
||||
-- > ^ ^
|
||||
-- > | |
|
||||
-- > | +-- Value consumed to build a row
|
||||
-- > |
|
||||
-- > +------ Headedness (Headed or Headless)
|
||||
--
|
||||
-- Internally, a 'Colonnade' is represented as a 'Vector' of individual
|
||||
-- column encodings. It is possible to use any collection type with
|
||||
@ -71,20 +81,18 @@ instance Contravariant (OneColonnade f content) where
|
||||
-- once and then folding over it many times. It is recommended that
|
||||
-- 'Colonnade's are defined at the top-level so that GHC avoids reconstructing
|
||||
-- them every time they are used.
|
||||
newtype Colonnade f c a = Colonnade
|
||||
{ getColonnade :: Vector (OneColonnade f c a)
|
||||
newtype Colonnade h c a = Colonnade
|
||||
{ getColonnade :: Vector (OneColonnade h c a)
|
||||
} deriving (Monoid)
|
||||
|
||||
instance Contravariant (Colonnade f content) where
|
||||
instance Contravariant (Colonnade h content) where
|
||||
contramap f (Colonnade v) = Colonnade
|
||||
(Vector.map (contramap f) v)
|
||||
|
||||
instance Divisible (Colonnade f content) where
|
||||
instance Divisible (Colonnade h 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)
|
||||
-- (Vector.map (\(OneEncoding h c) -> (h,c . snd . f)) b)
|
||||
|
||||
|
@ -15,7 +15,7 @@
|
||||
# resolver:
|
||||
# name: custom-snapshot
|
||||
# location: "./custom-snapshot.yaml"
|
||||
resolver: lts-6.5
|
||||
resolver: lts-7.18
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
@ -39,6 +39,7 @@ packages:
|
||||
- 'colonnade'
|
||||
- 'yesod-colonnade'
|
||||
- 'reflex-dom-colonnade'
|
||||
- 'blaze-colonnade'
|
||||
- 'siphon'
|
||||
- 'geolite-csv'
|
||||
# Dependency packages to be pulled from upstream that are not in the resolver
|
||||
@ -47,12 +48,9 @@ extra-deps:
|
||||
- 'reflex-dom-0.3'
|
||||
- 'ref-tf-0.4'
|
||||
- 'reflex-0.4.0'
|
||||
- 'aeson-0.9.0.1'
|
||||
- 'haskell-src-exts-1.16.0.1'
|
||||
- 'syb-0.5.1'
|
||||
- 'ip-0.8.4'
|
||||
- 'lmdb-0.2.5'
|
||||
|
||||
|
||||
# Override default flag values for local packages and extra-deps
|
||||
flags: {}
|
||||
|
@ -2,14 +2,14 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Yesod.Colonnade
|
||||
( -- * Build Encoding
|
||||
( -- * Build
|
||||
Cell(..)
|
||||
, cell
|
||||
, stringCell
|
||||
, textCell
|
||||
, builderCell
|
||||
, anchorCell
|
||||
-- * Apply Encoding
|
||||
-- * Apply
|
||||
, table
|
||||
, tableHeadless
|
||||
, definitionTable
|
||||
@ -17,12 +17,12 @@ module Yesod.Colonnade
|
||||
) where
|
||||
|
||||
import Yesod.Core
|
||||
import Colonnade.Types (Colonnade,Headed,Headless)
|
||||
import Colonnade (Colonnade,Headed,Headless)
|
||||
import Data.Text (Text)
|
||||
import Control.Monad
|
||||
import Data.Monoid
|
||||
import Data.String (IsString(..))
|
||||
import qualified Colonnade.Encoding as Encoding
|
||||
import qualified Colonnade.Encode as Encode
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lazy as LText
|
||||
import qualified Data.Text.Lazy.Builder as TBuilder
|
||||
@ -60,8 +60,8 @@ builderCell = cell . toWidget . toHtml . LText.toStrict . TBuilder.toLazyText
|
||||
-- | Creata a 'Cell' whose content is hyperlinked by wrapping
|
||||
-- it in an @<a>@.
|
||||
anchorCell ::
|
||||
(a -> Route site) -- ^ Route that will go in @href@
|
||||
-> (a -> WidgetT site IO ()) -- ^ Content wrapped by @<a>@
|
||||
(a -> Route site) -- ^ Route that will go in @href@ attribute
|
||||
-> (a -> WidgetT site IO ()) -- ^ Content wrapped by @<a>@ tag
|
||||
-> a -- ^ Value
|
||||
-> Cell site
|
||||
anchorCell getRoute getContent a = cell $ do
|
||||
@ -82,7 +82,7 @@ listItems ::
|
||||
-- ^ The value to display
|
||||
-> WidgetT site IO ()
|
||||
listItems ulWrap combine enc =
|
||||
ulWrap . Encoding.runBothMonadic_ enc
|
||||
ulWrap . Encode.bothMonadic_ enc
|
||||
(\(Cell ha hc) (Cell ba bc) ->
|
||||
li (ha ++ ba) (combine hc bc)
|
||||
)
|
||||
@ -99,7 +99,7 @@ definitionTable ::
|
||||
-- ^ The value to display
|
||||
-> WidgetT site IO ()
|
||||
definitionTable attrs enc a = tableEl attrs $ tbody [] $
|
||||
Encoding.runBothMonadic_ enc
|
||||
Encode.bothMonadic_ enc
|
||||
(\theKey theValue -> tr [] $ do
|
||||
widgetFromCell td theKey
|
||||
widgetFromCell td theValue
|
||||
@ -115,7 +115,7 @@ table :: Foldable f
|
||||
-> f a -- ^ Rows of data
|
||||
-> WidgetT site IO ()
|
||||
table attrs enc xs = tableEl attrs $ do
|
||||
thead [] $ Encoding.runHeaderMonadic enc (widgetFromCell th)
|
||||
thead [] $ Encode.headerMonadic enc (widgetFromCell th)
|
||||
tableBody enc xs
|
||||
|
||||
tableHeadless :: Foldable f
|
||||
@ -131,7 +131,7 @@ tableBody :: Foldable f
|
||||
-> WidgetT site IO ()
|
||||
tableBody enc xs = tbody [] $ do
|
||||
forM_ xs $ \x -> do
|
||||
tr [] $ Encoding.runRowMonadic enc (widgetFromCell td) x
|
||||
tr [] $ Encode.rowMonadic enc (widgetFromCell td) x
|
||||
|
||||
widgetFromCell ::
|
||||
([(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ())
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: yesod-colonnade
|
||||
version: 0.2
|
||||
version: 0.3
|
||||
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.5 && < 0.6
|
||||
, colonnade >= 1.0 && < 1.1
|
||||
, yesod-core >= 1.4.0 && < 1.5
|
||||
, text >= 1.0 && < 1.3
|
||||
default-language: Haskell2010
|
||||
|
Loading…
Reference in New Issue
Block a user