mirror of
https://github.com/byteverse/colonnade.git
synced 2024-07-14 10:00:44 +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.*
|
||||
example
|
||||
example.hs
|
||||
example1
|
||||
example1.hs
|
||||
client_session_key.aes
|
||||
cabal.project.local
|
||||
|
@ -52,6 +52,10 @@ test-suite test
|
||||
base >= 4.7 && <= 5
|
||||
, colonnade
|
||||
, doctest
|
||||
, semigroupoids
|
||||
, ansi-wl-pprint
|
||||
, QuickCheck
|
||||
, fast-logger
|
||||
default-language: Haskell2010
|
||||
|
||||
source-repository head
|
||||
|
@ -37,6 +37,7 @@ module Reflex.Dom.Colonnade
|
||||
, dynamic
|
||||
, dynamicCapped
|
||||
, expandable
|
||||
, expandablePreloaded
|
||||
-- , expandableResizableTableless
|
||||
, sectioned
|
||||
, paginated
|
||||
@ -56,29 +57,31 @@ module Reflex.Dom.Colonnade
|
||||
, semUiFixedPagination
|
||||
) 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.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.Lazy 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.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
|
||||
{ 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)
|
||||
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
|
||||
-- between the rows.
|
||||
expandable :: (MonadWidget t m, Foldable f)
|
||||
|
@ -38,7 +38,7 @@ test-suite doctest
|
||||
, doctest >= 0.10
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite siphon-test
|
||||
test-suite test
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Test.hs
|
||||
|
@ -79,6 +79,15 @@ tests =
|
||||
]
|
||||
)
|
||||
) @?= ([(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)"
|
||||
$ ( runIdentity . SMP.toList )
|
||||
( S.decodeCsvUtf8 decodingF
|
||||
@ -149,6 +158,12 @@ decodingB = (,,)
|
||||
decodingF :: Siphon Headed ByteString ByteString
|
||||
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 = mconcat
|
||||
|
Loading…
Reference in New Issue
Block a user