add expandablePreloaded

.gitignore

@@ -33,4 +33,7 @@ siphon-0.8.0-docs/
 .ghc.environment.*
 example
 example.hs
+example1
+example1.hs
 client_session_key.aes
+cabal.project.local

colonnade/colonnade.cabal

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

reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs

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

siphon/siphon.cabal

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

siphon/test/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