mirror of
https://github.com/byteverse/colonnade.git
synced 2024-09-11 06:45:41 +03:00
fix merge conflicts
This commit is contained in:
commit
c1e237e608
@ -1,5 +1,5 @@
|
||||
name: colonnade
|
||||
version: 0.1
|
||||
version: 0.3
|
||||
synopsis: Generic types and functions for columnar encoding and decoding
|
||||
description: Please see README.md
|
||||
homepage: https://github.com/andrewthad/colonnade#readme
|
||||
|
@ -62,7 +62,7 @@ uncheckedRun dc v = getEitherWrap (go dc)
|
||||
rcurrent = mapLeft (DecodingCellErrors . Vector.singleton . DecodingCellError content ixed) (decode content)
|
||||
in rnext <*> (EitherWrap rcurrent)
|
||||
|
||||
headlessToIndexed :: forall c a.
|
||||
headlessToIndexed :: forall c a.
|
||||
Decoding Headless c a -> Decoding (Indexed Headless) c a
|
||||
headlessToIndexed = go 0 where
|
||||
go :: forall b. Int -> Decoding Headless c b -> Decoding (Indexed Headless) c b
|
||||
@ -71,7 +71,7 @@ headlessToIndexed = go 0 where
|
||||
DecodingAp (Indexed ix Headless) decode (go (ix + 1) apNext)
|
||||
|
||||
length :: forall f c a. Decoding f c a -> Int
|
||||
length = go 0 where
|
||||
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
|
||||
|
@ -21,27 +21,27 @@ headed h f = Encoding (Vector.singleton (OneEncoding (Headed h) f))
|
||||
-- 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 $
|
||||
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 ->
|
||||
runRowMonadic :: (Monad m, Monoid b)
|
||||
=> Encoding f content a
|
||||
-> (content -> m b)
|
||||
-> a
|
||||
-> m b
|
||||
runRowMonadic (Encoding v) g a = fmap (mconcat . Vector.toList) $ Vector.forM v $ \e ->
|
||||
g (oneEncodingEncode e a)
|
||||
|
||||
runHeader :: (c1 -> c2) -> Encoding Headed c1 a -> Vector c2
|
||||
runHeader g (Encoding v) =
|
||||
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
|
||||
runHeaderMonadic :: (Monad m, Monoid b)
|
||||
=> Encoding Headed content a
|
||||
-> (content -> m b)
|
||||
-> m b
|
||||
runHeaderMonadic (Encoding v) g =
|
||||
fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneEncodingHead) v
|
||||
|
||||
|
||||
|
||||
|
@ -107,7 +107,7 @@ 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)
|
||||
{ getEncoding :: Vector (OneEncoding f content a)
|
||||
} deriving (Monoid)
|
||||
|
||||
instance Contravariant (Encoding f content) where
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: reflex-dom-colonnade
|
||||
version: 0.2
|
||||
version: 0.3
|
||||
synopsis: Use colonnade with reflex-dom
|
||||
description: Please see README.md
|
||||
homepage: https://github.com/andrewthad/colonnade#readme
|
||||
@ -18,12 +18,13 @@ library
|
||||
Reflex.Dom.Colonnade
|
||||
build-depends:
|
||||
base >= 4.7 && < 5
|
||||
, colonnade
|
||||
, colonnade >= 0.3
|
||||
, contravariant
|
||||
, vector
|
||||
, reflex
|
||||
, reflex-dom
|
||||
, containers
|
||||
, semigroups
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
||||
|
@ -2,26 +2,28 @@ module Reflex.Dom.Colonnade where
|
||||
|
||||
import Colonnade.Types
|
||||
import Control.Monad
|
||||
import Reflex (Dynamic)
|
||||
import Data.Foldable
|
||||
import Reflex (Dynamic,Event,switchPromptly,never)
|
||||
import Reflex.Dynamic (mapDyn)
|
||||
import Reflex.Dom (MonadWidget)
|
||||
import Reflex.Dom.Widget.Basic
|
||||
import Data.Map (Map)
|
||||
import Data.Semigroup (Semigroup)
|
||||
import qualified Colonnade.Encoding as Encoding
|
||||
import qualified Data.Map as Map
|
||||
|
||||
cell :: m () -> Cell m
|
||||
cell :: m b -> Cell m b
|
||||
cell = Cell Map.empty
|
||||
|
||||
data Cell m = Cell
|
||||
{ cellAttrs :: Map String String
|
||||
, cellContents :: m ()
|
||||
data Cell m b = Cell
|
||||
{ cellAttrs :: !(Map String String)
|
||||
, cellContents :: !(m b)
|
||||
}
|
||||
|
||||
basic :: (MonadWidget t m, Foldable f)
|
||||
=> Map String String -- ^ Table element attributes
|
||||
-> f a -- ^ Values
|
||||
-> Encoding Headed (Cell m) a -- ^ Encoding of a value into cells
|
||||
-> Encoding Headed (Cell m ()) a -- ^ Encoding of a value into cells
|
||||
-> m ()
|
||||
basic tableAttrs as encoding = do
|
||||
elAttr "table" tableAttrs $ do
|
||||
@ -29,17 +31,17 @@ basic tableAttrs as encoding = do
|
||||
el "tbody" $ forM_ as $ \a -> do
|
||||
el "tr" $ mapM_ (Encoding.runRowMonadic encoding (elFromCell "td")) as
|
||||
|
||||
elFromCell :: MonadWidget t m => String -> Cell m -> m ()
|
||||
elFromCell :: MonadWidget t m => String -> Cell m b -> m b
|
||||
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"
|
||||
theadBuild :: (MonadWidget t m, Monoid b) => Encoding Headed (Cell m b) a -> m b
|
||||
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
|
||||
-> Encoding Headed (Cell m ()) a -- ^ Encoding of a value into cells
|
||||
-> m ()
|
||||
dynamic tableAttrs as encoding@(Encoding v) = do
|
||||
elAttr "table" tableAttrs $ do
|
||||
@ -52,3 +54,21 @@ dynamic tableAttrs as encoding@(Encoding v) = do
|
||||
_ <- elDynAttr "td" dynAttrs $ dyn dynContent
|
||||
return ()
|
||||
|
||||
dynamicEventful :: (MonadWidget t m, Traversable f, Semigroup e)
|
||||
=> Map String String -- ^ Table element attributes
|
||||
-> f (Dynamic t a) -- ^ Dynamic values
|
||||
-> Encoding Headed (Cell m (Event t e)) a -- ^ Encoding of a value into cells
|
||||
-> m (Event t e)
|
||||
dynamicEventful tableAttrs as encoding@(Encoding v) = do
|
||||
elAttr "table" tableAttrs $ do
|
||||
b1 <- theadBuild encoding
|
||||
b2 <- el "tbody" $ forM as $ \a -> do
|
||||
el "tr" $ forM v $ \(OneEncoding _ encode) -> do
|
||||
dynPair <- mapDyn encode a
|
||||
dynAttrs <- mapDyn cellAttrs dynPair
|
||||
dynContent <- mapDyn cellContents dynPair
|
||||
e <- elDynAttr "td" dynAttrs $ dyn dynContent
|
||||
-- TODO: This might actually be wrong. Revisit this.
|
||||
switchPromptly never e
|
||||
return (mappend b1 (mconcat $ toList $ mconcat $ toList b2))
|
||||
|
||||
|
@ -4,7 +4,7 @@ module Siphon where
|
||||
-- encode
|
||||
-- decode :: Pipe (Vector c) a m x
|
||||
|
||||
-- encode ::
|
||||
-- encode ::
|
||||
|
||||
-- row :: Vector (Escaped Text) -> Text
|
||||
-- row = Vector.
|
||||
|
@ -1,4 +1,4 @@
|
||||
module Siphon.Content
|
||||
module Siphon.Content
|
||||
( byteStringChar8
|
||||
) where
|
||||
|
||||
|
@ -17,7 +17,7 @@ import qualified Data.ByteString.Char8 as ByteString
|
||||
import qualified Data.Attoparsec.Types as Atto
|
||||
|
||||
-- unrow :: c1 -> (Vector c2,c1)
|
||||
--
|
||||
--
|
||||
-- row :: _
|
||||
-- -> Decoding (Indexed f) c a
|
||||
-- -> Vector c
|
||||
@ -27,7 +27,7 @@ import qualified Data.Attoparsec.Types as Atto
|
||||
-- Monad m
|
||||
-- => Decoding (Indexed f) c a
|
||||
-- -> Pipe (Vector c) a m ()
|
||||
-- decodeVectorPipe
|
||||
-- decodeVectorPipe
|
||||
|
||||
mkParseError :: Int -> [String] -> String -> DecodingRowError f content
|
||||
mkParseError i ctxs msg = id
|
||||
@ -55,7 +55,7 @@ indexedPipe :: Monad m
|
||||
-> Decoding (Indexed Headless) c a
|
||||
-> Pipe c a m (DecodingRowError Headless c)
|
||||
indexedPipe sd decoding = do
|
||||
(firstRow, mleftovers) <- consumeGeneral sd mkParseError
|
||||
(firstRow, mleftovers) <- consumeGeneral sd mkParseError
|
||||
let req = Decoding.maxIndex decoding
|
||||
vlen = Vector.length firstRow
|
||||
if vlen < req
|
||||
@ -72,28 +72,28 @@ headedPipe :: (Monad m, Eq c)
|
||||
-> Decoding Headed c a
|
||||
-> Pipe c a m (DecodingRowError Headed c)
|
||||
headedPipe sd decoding = do
|
||||
(headers, mleftovers) <- consumeGeneral sd mkParseError
|
||||
(headers, mleftovers) <- consumeGeneral sd mkParseError
|
||||
case Decoding.headedToIndexed headers decoding of
|
||||
Left headingErrs -> return (DecodingRowError 0 (RowErrorHeading headingErrs))
|
||||
Right indexedDecoding ->
|
||||
Right indexedDecoding ->
|
||||
let requiredLength = Vector.length headers
|
||||
in uncheckedPipe requiredLength 1 sd indexedDecoding mleftovers
|
||||
|
||||
|
||||
|
||||
uncheckedPipe :: Monad m
|
||||
=> Int -- ^ expected length of each row
|
||||
-> Int -- ^ index of first row, usually zero or one
|
||||
-> Siphon c
|
||||
-> Siphon c
|
||||
-> Decoding (Indexed f) c a
|
||||
-> Maybe c
|
||||
-> Pipe c a m (DecodingRowError f c)
|
||||
uncheckedPipe requiredLength ix sd d mleftovers =
|
||||
uncheckedPipe requiredLength ix sd d mleftovers =
|
||||
pipeGeneral ix sd mkParseError checkedRunWithRow mleftovers
|
||||
where
|
||||
checkedRunWithRow rowIx v =
|
||||
checkedRunWithRow rowIx v =
|
||||
let vlen = Vector.length v in
|
||||
if vlen /= requiredLength
|
||||
then Left $ DecodingRowError rowIx
|
||||
then Left $ DecodingRowError rowIx
|
||||
$ RowErrorSize requiredLength vlen
|
||||
else Decoding.uncheckedRunWithRow rowIx d v
|
||||
|
||||
@ -110,7 +110,7 @@ pipeGeneral :: Monad m
|
||||
-> (Int -> Vector c -> Either e a)
|
||||
-> Maybe c -- ^ leftovers that should be handled first
|
||||
-> Pipe c a m e
|
||||
pipeGeneral initIx (Siphon _ _ parse isNull) wrapParseError decodeRow mleftovers =
|
||||
pipeGeneral initIx (Siphon _ _ parse isNull) wrapParseError decodeRow mleftovers =
|
||||
case mleftovers of
|
||||
Nothing -> go1 initIx
|
||||
Just leftovers -> handleResult initIx (parse leftovers)
|
||||
@ -138,6 +138,6 @@ awaitSkip :: Monad m
|
||||
awaitSkip f = go where
|
||||
go = do
|
||||
a <- await
|
||||
if f a then go else return a
|
||||
if f a then go else return a
|
||||
|
||||
|
||||
|
@ -7,27 +7,27 @@ import qualified Pipes.Prelude as Pipes
|
||||
import qualified Colonnade.Encoding as Encoding
|
||||
|
||||
row :: Siphon c
|
||||
-> Encoding f c a
|
||||
-> a
|
||||
-> Encoding f c a
|
||||
-> a
|
||||
-> c
|
||||
row (Siphon escape intercalate _ _) e =
|
||||
intercalate . Encoding.runRow escape e
|
||||
|
||||
header :: Siphon c
|
||||
-> Encoding Headed c a
|
||||
-> Encoding Headed c a
|
||||
-> c
|
||||
header (Siphon escape intercalate _ _) e =
|
||||
intercalate (Encoding.runHeader escape e)
|
||||
|
||||
pipe :: Monad m
|
||||
pipe :: Monad m
|
||||
=> Siphon c
|
||||
-> Encoding f c a
|
||||
-> Encoding f c a
|
||||
-> Pipe a c m x
|
||||
pipe siphon encoding = Pipes.map (row siphon encoding)
|
||||
|
||||
headedPipe :: Monad m
|
||||
=> Siphon c
|
||||
-> Encoding Headed c a
|
||||
headedPipe :: Monad m
|
||||
=> Siphon c
|
||||
-> Encoding Headed c a
|
||||
-> Pipe a c m x
|
||||
headedPipe siphon encoding = do
|
||||
yield (header siphon encoding)
|
||||
|
@ -40,8 +40,8 @@ import Control.Applicative
|
||||
import Data.Monoid
|
||||
|
||||
byteStringChar8 :: Siphon ByteString
|
||||
byteStringChar8 = Siphon
|
||||
escape
|
||||
byteStringChar8 = Siphon
|
||||
escape
|
||||
encodeRow
|
||||
(A.parse (row comma))
|
||||
B.null
|
||||
@ -54,7 +54,7 @@ encodeRow = id
|
||||
. coerce
|
||||
|
||||
escape :: ByteString -> Escaped ByteString
|
||||
escape t = case B.find (\c -> c == newline || c == comma || c == doubleQuote) t of
|
||||
escape t = case B.find (\c -> c == newline || c == cr || c == comma || c == doubleQuote) t of
|
||||
Nothing -> Escaped t
|
||||
Just _ -> escapeAlways t
|
||||
|
||||
|
@ -31,6 +31,6 @@ data SiphonDecoding c1 c2 = SiphonDecoding
|
||||
-- }
|
||||
|
||||
-- data SiphonDecodingError
|
||||
-- { clarify
|
||||
-- { clarify
|
||||
-- }
|
||||
|
||||
|
@ -32,9 +32,9 @@ main = defaultMain tests
|
||||
|
||||
tests :: [Test]
|
||||
tests =
|
||||
[ testGroup "ByteString encode/decode"
|
||||
[ testGroup "ByteString encode/decode"
|
||||
[ testCase "Headless Encoding (int,char,bool)" testEncodingA
|
||||
, testProperty "Headless Isomorphism (int,char,bool)"
|
||||
, testProperty "Headless Isomorphism (int,char,bool)"
|
||||
$ propIsoPipe $
|
||||
(SE.pipe SC.byteStringChar8 encodingA)
|
||||
>->
|
||||
@ -42,7 +42,6 @@ tests =
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
decodingA :: Decoding Headless ByteString (Int,Char,Bool)
|
||||
decodingA = (,,)
|
||||
<$> Decoding.headless CDB.int
|
||||
@ -63,8 +62,8 @@ propIsoPipe :: Eq a => Pipe a a Identity () -> [a] -> Bool
|
||||
propIsoPipe p as = (Pipes.toList $ each as >-> p) == as
|
||||
|
||||
testEncodingA :: Assertion
|
||||
testEncodingA =
|
||||
( ByteString.concat $ Pipes.toList $
|
||||
testEncodingA =
|
||||
( ByteString.concat $ Pipes.toList $
|
||||
Pipes.yield (4,'c',False) >-> SE.pipe SC.byteStringChar8 encodingA
|
||||
) @?= "4,c,false\n"
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user