byteverse/colonnade
1
1
Fork 0
mirror of https://github.com/byteverse/colonnade.git synced 2024-08-15 09:40:46 +03:00
Code Issues Packages Projects Releases Wiki Activity

add blaze support

Browse Source
This commit is contained in:
Andrew Martin 2017-02-06 09:03:10 -05:00
parent 75b2431b5c
commit eb29b10c39
13 changed files with 467 additions and 134 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -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
View 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
View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

29
blaze-colonnade/blaze-colonnade.cabal Normal file
View 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
View 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
View 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.

3
colonnade/colonnade.cabal
View File

@ -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

124
colonnade/src/Colonnade.hs
View File

@ -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
View 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

30
colonnade/src/Colonnade/Internal.hs
View File

@ -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)

6
stack.yaml
View File

@ -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: {}

20
yesod-colonnade/src/Yesod/Colonnade.hs
View File

@ -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 ())

8
yesod-colonnade/yesod-colonnade.cabal
View File

@ -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
@ -13,15 +13,15 @@ build-type: Simple
cabal-version: >=1.10
library
hs-source-dirs: src
hs-source-dirs: src
exposed-modules:
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
default-language: Haskell2010
source-repository head
type: git