mirror of
https://github.com/byteverse/colonnade.git
synced 2024-09-11 06:45:41 +03:00
add expandablePreloaded
This commit is contained in:
parent
d17193baae
commit
df9443c763
3
.gitignore
vendored
3
.gitignore
vendored
@ -33,4 +33,7 @@ siphon-0.8.0-docs/
|
|||||||
.ghc.environment.*
|
.ghc.environment.*
|
||||||
example
|
example
|
||||||
example.hs
|
example.hs
|
||||||
|
example1
|
||||||
|
example1.hs
|
||||||
client_session_key.aes
|
client_session_key.aes
|
||||||
|
cabal.project.local
|
||||||
|
@ -52,6 +52,10 @@ test-suite test
|
|||||||
base >= 4.7 && <= 5
|
base >= 4.7 && <= 5
|
||||||
, colonnade
|
, colonnade
|
||||||
, doctest
|
, doctest
|
||||||
|
, semigroupoids
|
||||||
|
, ansi-wl-pprint
|
||||||
|
, QuickCheck
|
||||||
|
, fast-logger
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
|
@ -37,6 +37,7 @@ module Reflex.Dom.Colonnade
|
|||||||
, dynamic
|
, dynamic
|
||||||
, dynamicCapped
|
, dynamicCapped
|
||||||
, expandable
|
, expandable
|
||||||
|
, expandablePreloaded
|
||||||
-- , expandableResizableTableless
|
-- , expandableResizableTableless
|
||||||
, sectioned
|
, sectioned
|
||||||
, paginated
|
, paginated
|
||||||
@ -56,29 +57,31 @@ module Reflex.Dom.Colonnade
|
|||||||
, semUiFixedPagination
|
, semUiFixedPagination
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice,Headedness(..))
|
||||||
|
import Control.Applicative (liftA2)
|
||||||
|
import Control.Monad (forM)
|
||||||
|
import Control.Monad.Fix (MonadFix)
|
||||||
|
import Control.Monad.Trans.Reader (ReaderT)
|
||||||
|
import Data.Bool (bool)
|
||||||
|
import Data.Foldable (Foldable(..),for_,forM_,foldlM)
|
||||||
|
import Data.Map.Strict (Map)
|
||||||
|
import Data.Monoid (Sum(..))
|
||||||
|
import Data.Proxy
|
||||||
|
import Data.Semigroup (Semigroup(..))
|
||||||
import Data.String (IsString(..))
|
import Data.String (IsString(..))
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Traversable (for)
|
||||||
|
import Data.Vector (Vector)
|
||||||
|
import Reflex.Dom
|
||||||
|
|
||||||
|
import qualified Colonnade as C
|
||||||
|
import qualified Colonnade.Encode as E
|
||||||
|
import qualified Data.Map.Strict as M
|
||||||
|
import qualified Data.Profunctor as PF
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Lazy as LT
|
import qualified Data.Text.Lazy as LT
|
||||||
import qualified Data.Text.Lazy.Builder as LT
|
import qualified Data.Text.Lazy.Builder as LT
|
||||||
import qualified Data.Map.Strict as M
|
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import qualified Data.Profunctor as PF
|
|
||||||
import Data.Map.Strict (Map)
|
|
||||||
import Data.Vector (Vector)
|
|
||||||
import Data.Text (Text)
|
|
||||||
import Data.Foldable (Foldable(..),for_,forM_,foldlM)
|
|
||||||
import Data.Traversable (for)
|
|
||||||
import Data.Semigroup (Semigroup(..))
|
|
||||||
import Control.Applicative (liftA2)
|
|
||||||
import Reflex.Dom
|
|
||||||
import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice,Headedness(..))
|
|
||||||
import Data.Monoid (Sum(..))
|
|
||||||
import Data.Proxy
|
|
||||||
import Control.Monad.Fix (MonadFix)
|
|
||||||
import Control.Monad (forM)
|
|
||||||
import Control.Monad.Trans.Reader (ReaderT)
|
|
||||||
import qualified Colonnade as C
|
|
||||||
import qualified Colonnade.Encode as E
|
|
||||||
|
|
||||||
data Cell t m b = Cell
|
data Cell t m b = Cell
|
||||||
{ cellAttrs :: !(Dynamic t (M.Map T.Text T.Text))
|
{ cellAttrs :: !(Dynamic t (M.Map T.Text T.Text))
|
||||||
@ -621,6 +624,60 @@ dynamicCapped tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collection =
|
|||||||
_ <- encodeCorniceHeadDynamic headAttrs fascia (E.annotate cornice)
|
_ <- encodeCorniceHeadDynamic headAttrs fascia (E.annotate cornice)
|
||||||
dynamicBody bodyAttrs trAttrs (E.discard cornice) collection
|
dynamicBody bodyAttrs trAttrs (E.discard cornice) collection
|
||||||
|
|
||||||
|
-- | Start displaying the widget after the first time the event
|
||||||
|
-- fires. Subsequent fires of the event do not reconstruct the
|
||||||
|
-- widget. They update it in whatever way the lambda normally does.
|
||||||
|
dynAfter :: MonadWidget t m => Event t a -> (Dynamic t a -> m ()) -> m ()
|
||||||
|
dynAfter e f = do
|
||||||
|
e1 <- headE e
|
||||||
|
let em1 = fmap (\a1 -> holdDyn a1 e >>= f) e1
|
||||||
|
_ <- widgetHold blank em1
|
||||||
|
return ()
|
||||||
|
|
||||||
|
-- | Table with cells that can create expanded content between the rows.
|
||||||
|
-- The content between the rows is built when the vector changed.
|
||||||
|
expandablePreloaded :: forall t m a. MonadWidget t m
|
||||||
|
=> Bureau t Headed (M.Map T.Text T.Text)
|
||||||
|
-- ^ Table class settings
|
||||||
|
-> (Dynamic t a -> m ())
|
||||||
|
-- ^ Function to render the content under the row.
|
||||||
|
-> Int
|
||||||
|
-- ^ Number of rows
|
||||||
|
-> Colonnade Headed (Dynamic t a) (m (Event t Bool))
|
||||||
|
-- ^ Encoding into cells with events that can fire to display additional
|
||||||
|
-- content under the row.
|
||||||
|
-> Dynamic t (Vector a)
|
||||||
|
-- ^ Values
|
||||||
|
-> m ()
|
||||||
|
expandablePreloaded (Bureau tableAttrs (E.Headed (theadAttrs,theadRowAttrs)) bodyAttrs _trBuildAttrs) f n colonnade@(E.Colonnade v) xs = do
|
||||||
|
elDynAttr "table" tableAttrs $ do
|
||||||
|
_ <- elDynAttr "thead" theadAttrs $ elDynAttr "tr" theadRowAttrs $ E.headerMonadicGeneral_ colonnade (el "th")
|
||||||
|
ys <- sample (current xs)
|
||||||
|
elDynAttr "tbody" bodyAttrs $ forM_ (enumFromTo 0 (n - 1)) $ \ix -> do
|
||||||
|
let stream = fmapMaybe (V.!? ix) (updated xs)
|
||||||
|
let visible = fmap (\x -> V.length x > ix) xs
|
||||||
|
case ys V.!? ix of
|
||||||
|
Nothing -> dynAfter stream $ \a -> buildRow a visible
|
||||||
|
Just y -> do
|
||||||
|
a <- holdDyn y stream
|
||||||
|
buildRow a visible
|
||||||
|
where
|
||||||
|
vlen = V.length v
|
||||||
|
buildRow :: Dynamic t a -> Dynamic t Bool -> m ()
|
||||||
|
buildRow a visible = do
|
||||||
|
elist <- el "tr" $ E.rowMonadicWith [] (++) colonnade (fmap (\k -> [k]) . el "td") a
|
||||||
|
let e = leftmost elist
|
||||||
|
shouldDisplay1 <- foldDyn const False e
|
||||||
|
let shouldDisplay2 = zipDynWith (&&) shouldDisplay1 visible
|
||||||
|
el "tr" $ do
|
||||||
|
let attrs = fmap
|
||||||
|
( bool
|
||||||
|
(M.fromList [("style","display:none;")])
|
||||||
|
(M.fromList [("colspan",T.pack (show vlen))])
|
||||||
|
) shouldDisplay2
|
||||||
|
elDynAttr "td" attrs (f a)
|
||||||
|
|
||||||
|
|
||||||
-- | Table with cells that can create expanded content
|
-- | Table with cells that can create expanded content
|
||||||
-- between the rows.
|
-- between the rows.
|
||||||
expandable :: (MonadWidget t m, Foldable f)
|
expandable :: (MonadWidget t m, Foldable f)
|
||||||
|
@ -38,7 +38,7 @@ test-suite doctest
|
|||||||
, doctest >= 0.10
|
, doctest >= 0.10
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite siphon-test
|
test-suite test
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
hs-source-dirs: test
|
hs-source-dirs: test
|
||||||
main-is: Test.hs
|
main-is: Test.hs
|
||||||
|
@ -79,6 +79,15 @@ tests =
|
|||||||
]
|
]
|
||||||
)
|
)
|
||||||
) @?= ([(244,intToWord8 (ord 'z'),True)] :> Nothing)
|
) @?= ([(244,intToWord8 (ord 'z'),True)] :> Nothing)
|
||||||
|
, testCase "Headed Decoding (geolite)"
|
||||||
|
$ ( runIdentity . SMP.toList )
|
||||||
|
( S.decodeCsvUtf8 decodingGeolite
|
||||||
|
( SMP.yield $ BC8.pack $ concat
|
||||||
|
[ "network,autonomous_system_number,autonomous_system_organization\n"
|
||||||
|
, "1,z,y\n"
|
||||||
|
]
|
||||||
|
)
|
||||||
|
) @?= ([(1,intToWord8 (ord 'z'),intToWord8 (ord 'y'))] :> Nothing)
|
||||||
, testCase "Headed Decoding (escaped characters, one big chunk)"
|
, testCase "Headed Decoding (escaped characters, one big chunk)"
|
||||||
$ ( runIdentity . SMP.toList )
|
$ ( runIdentity . SMP.toList )
|
||||||
( S.decodeCsvUtf8 decodingF
|
( S.decodeCsvUtf8 decodingF
|
||||||
@ -149,6 +158,12 @@ decodingB = (,,)
|
|||||||
decodingF :: Siphon Headed ByteString ByteString
|
decodingF :: Siphon Headed ByteString ByteString
|
||||||
decodingF = S.headed "name" Just
|
decodingF = S.headed "name" Just
|
||||||
|
|
||||||
|
decodingGeolite :: Siphon Headed ByteString (Int,Word8,Word8)
|
||||||
|
decodingGeolite = (,,)
|
||||||
|
<$> S.headed "network" dbInt
|
||||||
|
<*> S.headed "autonomous_system_number" dbWord8
|
||||||
|
<*> S.headed "autonomous_system_organization" dbWord8
|
||||||
|
|
||||||
|
|
||||||
encodingA :: Colonnade Headless (Int,Char,Bool) ByteString
|
encodingA :: Colonnade Headless (Int,Char,Bool) ByteString
|
||||||
encodingA = mconcat
|
encodingA = mconcat
|
||||||
|
Loading…
Reference in New Issue
Block a user