mirror of
https://github.com/byteverse/colonnade.git
synced 2024-10-26 08:03:25 +03:00
added new implementation of siphon
This commit is contained in:
parent
3a4d54c8c8
commit
db725eba69
@ -1,6 +0,0 @@
|
||||
module Main where
|
||||
|
||||
import Lib
|
||||
|
||||
main :: IO ()
|
||||
main = someFunc
|
@ -24,6 +24,8 @@ headless f = DecodingAp Headless f (DecodingPure id)
|
||||
headed :: content -> (content -> Either String a) -> Decoding Headed content a
|
||||
headed h f = DecodingAp (Headed h) f (DecodingPure id)
|
||||
|
||||
-- | This function does not check to make sure that the indicies in
|
||||
-- the 'Decoding' are in the 'Vector'.
|
||||
uncheckedRun :: forall content a f.
|
||||
Vector content
|
||||
-> Decoding (Indexed f) content a
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Colonnade.Encoding where
|
||||
|
||||
import Colonnade.Types
|
||||
import Data.Vector (Vector)
|
||||
import qualified Data.Vector as Vector
|
||||
|
||||
mapContent :: Functor f => (c1 -> c2) -> Encoding f c1 a -> Encoding f c2 a
|
||||
@ -13,3 +14,34 @@ headless f = Encoding (Vector.singleton (OneEncoding Headless f))
|
||||
headed :: content -> (a -> content) -> Encoding Headed content a
|
||||
headed h f = Encoding (Vector.singleton (OneEncoding (Headed h) f))
|
||||
|
||||
-- runRow' :: Encoding f content a -> a -> Vector content
|
||||
-- runRow' = runRow id
|
||||
|
||||
-- | 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)
|
||||
|
||||
runRowMonadic :: Monad m
|
||||
=> Encoding f content a
|
||||
-> (content -> m ())
|
||||
-> a
|
||||
-> m ()
|
||||
runRowMonadic (Encoding v) g a = Vector.forM_ v $ \e ->
|
||||
g (oneEncodingEncode e a)
|
||||
|
||||
runHeader :: (c1 -> c2) -> Encoding Headed c1 a -> Vector c2
|
||||
runHeader g (Encoding v) =
|
||||
Vector.map (g . getHeaded . oneEncodingHead) v
|
||||
|
||||
runHeaderMonadic :: Monad m
|
||||
=> Encoding Headed content a
|
||||
-> (content -> m ())
|
||||
-> m ()
|
||||
runHeaderMonadic (Encoding v) g =
|
||||
Vector.mapM_ (g . getHeaded . oneEncodingHead) v
|
||||
|
||||
|
||||
|
||||
|
@ -91,8 +91,8 @@ instance Contravariant (OneEncoding f content) where
|
||||
contramap f (OneEncoding h e) = OneEncoding h (e . f)
|
||||
|
||||
newtype Encoding f content a = Encoding
|
||||
{ getEncoding :: Vector (OneEncoding f content a) }
|
||||
deriving (Monoid)
|
||||
{ getEncoding :: Vector (OneEncoding f content a)
|
||||
} deriving (Monoid)
|
||||
|
||||
instance Contravariant (Encoding f content) where
|
||||
contramap f (Encoding v) = Encoding
|
||||
|
@ -24,7 +24,8 @@ library
|
||||
, reflex
|
||||
, reflex-dom
|
||||
, containers
|
||||
default-language: Haskell2010
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
|
@ -7,6 +7,7 @@ import Reflex.Dynamic (mapDyn)
|
||||
import Reflex.Dom (MonadWidget)
|
||||
import Reflex.Dom.Widget.Basic
|
||||
import Data.Map (Map)
|
||||
import qualified Colonnade.Encoding as Encoding
|
||||
import qualified Data.Map as Map
|
||||
|
||||
cell :: m () -> Cell m
|
||||
@ -22,26 +23,27 @@ basic :: (MonadWidget t m, Foldable f)
|
||||
-> f a -- ^ Values
|
||||
-> Encoding Headed (Cell m) a -- ^ Encoding of a value into cells
|
||||
-> m ()
|
||||
basic tableAttrs as (Encoding v) = do
|
||||
basic tableAttrs as encoding = do
|
||||
elAttr "table" tableAttrs $ do
|
||||
el "thead" $ el "tr" $
|
||||
forM_ v $ \(OneEncoding (Headed (Cell attrs contents)) _) ->
|
||||
elAttr "th" attrs contents
|
||||
theadBuild encoding
|
||||
el "tbody" $ forM_ as $ \a -> do
|
||||
el "tr" $ forM_ v $ \(OneEncoding _ encode) -> do
|
||||
let Cell attrs contents = encode a
|
||||
elAttr "td" attrs contents
|
||||
el "tr" $ mapM_ (Encoding.runRowMonadic encoding (elFromCell "td")) as
|
||||
|
||||
elFromCell :: MonadWidget t m => String -> Cell m -> m ()
|
||||
elFromCell name (Cell attrs contents) = elAttr name attrs contents
|
||||
|
||||
theadBuild :: MonadWidget t m => Encoding Headed (Cell m) a -> m ()
|
||||
theadBuild encoding = el "thead" . el "tr"
|
||||
$ Encoding.runHeaderMonadic encoding (elFromCell "th")
|
||||
|
||||
dynamic :: (MonadWidget t m, Foldable f)
|
||||
=> Map String String -- ^ Table element attributes
|
||||
-> f (Dynamic t a) -- ^ Dynamic values
|
||||
-> Encoding Headed (Cell m) a -- ^ Encoding of a value into cells
|
||||
-> m ()
|
||||
dynamic tableAttrs as (Encoding v) = do
|
||||
dynamic tableAttrs as encoding@(Encoding v) = do
|
||||
elAttr "table" tableAttrs $ do
|
||||
el "thead" $ el "tr" $
|
||||
forM_ v $ \(OneEncoding (Headed (Cell attrs contents)) _) ->
|
||||
elAttr "th" attrs contents
|
||||
theadBuild encoding
|
||||
el "tbody" $ forM_ as $ \a -> do
|
||||
el "tr" $ forM_ v $ \(OneEncoding _ encode) -> do
|
||||
dynPair <- mapDyn encode a
|
||||
|
30
siphon/LICENSE
Normal file
30
siphon/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
siphon/Setup.hs
Normal file
2
siphon/Setup.hs
Normal file
@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
35
siphon/siphon.cabal
Normal file
35
siphon/siphon.cabal
Normal file
@ -0,0 +1,35 @@
|
||||
name: siphon
|
||||
version: 0.1
|
||||
synopsis: Generic types and functions for columnar encoding and decoding
|
||||
description: Please see README.md
|
||||
homepage: https://github.com/andrewthad/colonnade#readme
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Andrew Martin
|
||||
maintainer: andrew.thaddeus@gmail.com
|
||||
copyright: 2016 Andrew Martin
|
||||
category: web
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
|
||||
library
|
||||
hs-source-dirs: src
|
||||
exposed-modules:
|
||||
Siphon.Text
|
||||
Siphon.ByteString.Char8
|
||||
Siphon
|
||||
Siphon.Types
|
||||
Siphon.Encoding
|
||||
build-depends:
|
||||
base >= 4.7 && < 5
|
||||
, colonnade
|
||||
, text
|
||||
, bytestring
|
||||
, contravariant
|
||||
, vector
|
||||
, pipes
|
||||
default-language: Haskell2010
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/andrewthad/colonnade
|
11
siphon/src/Siphon.hs
Normal file
11
siphon/src/Siphon.hs
Normal file
@ -0,0 +1,11 @@
|
||||
module Siphon where
|
||||
|
||||
-- encode :: Pipe a (Vector c) m x
|
||||
-- encode
|
||||
-- decode :: Pipe (Vector c) a m x
|
||||
|
||||
-- encode ::
|
||||
|
||||
-- row :: Vector (Escaped Text) -> Text
|
||||
-- row = Vector.
|
||||
|
1
siphon/src/Siphon/ByteString/Char8.hs
Normal file
1
siphon/src/Siphon/ByteString/Char8.hs
Normal file
@ -0,0 +1 @@
|
||||
module Siphon.ByteString.Char8 where
|
10
siphon/src/Siphon/Decoding.hs
Normal file
10
siphon/src/Siphon/Decoding.hs
Normal file
@ -0,0 +1,10 @@
|
||||
module Siphon.Decoding where
|
||||
|
||||
import Siphon.Types
|
||||
|
||||
-- unrow :: c1 -> (Vector c2,c1)
|
||||
--
|
||||
-- row :: _
|
||||
-- -> Decoding (Indexed f) c a
|
||||
-- -> Vector c
|
||||
-- -> Either DecodingErrors a
|
29
siphon/src/Siphon/Encoding.hs
Normal file
29
siphon/src/Siphon/Encoding.hs
Normal file
@ -0,0 +1,29 @@
|
||||
module Siphon.Encoding where
|
||||
|
||||
import Siphon.Types
|
||||
import Colonnade.Types
|
||||
import Pipes (Pipe,yield)
|
||||
import qualified Pipes.Prelude as Pipes
|
||||
import qualified Colonnade.Encoding as Encoding
|
||||
|
||||
row :: Siphon c1 c2
|
||||
-> Encoding f c1 a
|
||||
-> a
|
||||
-> c2
|
||||
row (Siphon escape intercalate) e =
|
||||
intercalate . Encoding.runRow escape e
|
||||
|
||||
header :: Siphon c1 c2
|
||||
-> Encoding Headed c1 a
|
||||
-> c2
|
||||
header (Siphon escape intercalate) e =
|
||||
intercalate (Encoding.runHeader escape e)
|
||||
|
||||
pipe :: Monad m => Siphon c1 c2 -> Encoding f c1 a -> Pipe a c2 m x
|
||||
pipe siphon encoding = Pipes.map (row siphon encoding)
|
||||
|
||||
pipeWithHeader :: Monad m => Siphon c1 c2 -> Encoding Headed c1 a -> Pipe a c2 m x
|
||||
pipeWithHeader siphon encoding = do
|
||||
yield (header siphon encoding)
|
||||
pipe siphon encoding
|
||||
|
32
siphon/src/Siphon/Text.hs
Normal file
32
siphon/src/Siphon/Text.hs
Normal file
@ -0,0 +1,32 @@
|
||||
module Siphon.Text where
|
||||
|
||||
import Siphon.Types
|
||||
import Data.Text (Text)
|
||||
import Data.Vector (Vector)
|
||||
import Data.Coerce (coerce)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Vector as Vector
|
||||
|
||||
siphon :: Siphon Text Text
|
||||
siphon = Siphon escape encodeRow
|
||||
|
||||
encodeRow :: Vector (Escaped Text) -> Text
|
||||
encodeRow = id
|
||||
. Text.intercalate (Text.pack ",")
|
||||
. Vector.toList
|
||||
. coerce
|
||||
|
||||
escape :: Text -> Escaped Text
|
||||
escape t = case Text.find (\c -> c == '\n' || c == ',' || c == '"') t of
|
||||
Nothing -> Escaped t
|
||||
Just _ -> escapeAlways t
|
||||
|
||||
escapeAlways :: Text -> Escaped Text
|
||||
escapeAlways t = Escaped $ Text.concat
|
||||
[ Text.singleton '"'
|
||||
, Text.replace (Text.pack "\"") (Text.pack "\"\"") t
|
||||
, Text.singleton '"'
|
||||
]
|
||||
|
||||
|
||||
|
17
siphon/src/Siphon/Types.hs
Normal file
17
siphon/src/Siphon/Types.hs
Normal file
@ -0,0 +1,17 @@
|
||||
module Siphon.Types where
|
||||
|
||||
import Data.Vector (Vector)
|
||||
|
||||
newtype Escaped c = Escaped { getEscaped :: c }
|
||||
|
||||
-- | Consider changing out the use of 'Vector' here
|
||||
-- with the humble list instead. It might fuse away
|
||||
-- better. Not sure though.
|
||||
data Siphon c1 c2 = Siphon
|
||||
{ siphonEscape :: !(c1 -> Escaped c2)
|
||||
, siphonIntercalate :: !(Vector (Escaped c2) -> c2)
|
||||
}
|
||||
|
||||
-- data Clarify = Clarify
|
||||
-- { clarify
|
||||
-- }
|
@ -38,6 +38,7 @@ resolver: lts-6.4
|
||||
packages:
|
||||
- 'colonnade'
|
||||
- 'reflex-dom-colonnade'
|
||||
- 'siphon'
|
||||
# Dependency packages to be pulled from upstream that are not in the resolver
|
||||
# (e.g., acme-missiles-0.3)
|
||||
extra-deps:
|
||||
|
Loading…
Reference in New Issue
Block a user