mirror of
https://github.com/byteverse/colonnade.git
synced 2024-10-26 08:03:25 +03:00
Merge pull request #18 from goolord/paginatedExpandableLazy
fix nix & add paginatedExpandableLazy function
This commit is contained in:
commit
e20a15832b
8
colonnade/default.nix
Normal file
8
colonnade/default.nix
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
{ frontend ? false }:
|
||||||
|
let
|
||||||
|
pname = "colonnade";
|
||||||
|
main = (import ../nix/default.nix {
|
||||||
|
inherit frontend;
|
||||||
|
});
|
||||||
|
in
|
||||||
|
main.${pname}
|
1
colonnade/shell.nix
Normal file
1
colonnade/shell.nix
Normal file
@ -0,0 +1 @@
|
|||||||
|
(import ./. {}).env
|
106
nix/default.nix
106
nix/default.nix
@ -1,47 +1,73 @@
|
|||||||
{ package, test ? true, frontend ? false }:
|
{ frontend ? false }:
|
||||||
let bootstrap = import <nixpkgs> {};
|
|
||||||
|
let _nixpkgs = import <nixpkgs> {};
|
||||||
|
nixpkgs = _nixpkgs.fetchFromGitHub {
|
||||||
|
owner = "NixOS";
|
||||||
|
repo = "nixpkgs";
|
||||||
|
rev = "5c4a404b0d0e5125070dde5c1787210149157e83";
|
||||||
|
sha256 = "0a478l0dxzy5hglavkilxjkh45zfg31q50hgkv1npninc4lpv5f7";
|
||||||
|
};
|
||||||
|
pkgs = import nixpkgs { config = {}; overlays = []; };
|
||||||
|
|
||||||
fetch-github-json = owner: repo: path:
|
fetch-github-json = owner: repo: path:
|
||||||
let commit = builtins.fromJSON (builtins.readFile path);
|
let commit = builtins.fromJSON (builtins.readFile path);
|
||||||
in bootstrap.fetchFromGitHub {
|
in pkgs.fetchFromGitHub {
|
||||||
inherit owner repo;
|
name = "${repo}-${commit.rev}";
|
||||||
inherit (commit) rev sha256;
|
inherit owner repo;
|
||||||
|
inherit (commit) rev sha256;
|
||||||
};
|
};
|
||||||
reflex-platform = import (fetch-github-json "reflex-frp" "reflex-platform" ./reflex-platform.json) {};
|
|
||||||
compiler = if frontend then "ghcjs" else "ghc";
|
reflex-platform = import (fetch-github-json "layer-3-communications" "reflex-platform" ./reflex-platform.json) {};
|
||||||
overrides = (builtins.getAttr compiler reflex-platform).override {
|
jsaddle-src = fetch-github-json "ghcjs" "jsaddle" ./jsaddle.json;
|
||||||
|
compiler = "ghc8_2_1";
|
||||||
|
|
||||||
|
filterPredicate = p: type:
|
||||||
|
let path = baseNameOf p; in !(
|
||||||
|
(type == "directory" && pkgs.lib.hasPrefix "dist" path)
|
||||||
|
|| (type == "symlink" && pkgs.lib.hasPrefix "result" path)
|
||||||
|
|| pkgs.lib.hasPrefix ".ghc" path
|
||||||
|
|| pkgs.lib.hasPrefix ".git" path
|
||||||
|
|| pkgs.lib.hasSuffix "~" path
|
||||||
|
|| pkgs.lib.hasSuffix ".o" path
|
||||||
|
|| pkgs.lib.hasSuffix ".so" path
|
||||||
|
|| pkgs.lib.hasSuffix ".nix" path);
|
||||||
|
|
||||||
|
overrides = reflex-platform.${compiler}.override {
|
||||||
overrides = self: super:
|
overrides = self: super:
|
||||||
with reflex-platform;
|
with reflex-platform;
|
||||||
let options = pkg: lib.overrideCabal pkg (drv: { doCheck = test; });
|
with reflex-platform.lib;
|
||||||
filterPredicate = p: type:
|
with reflex-platform.nixpkgs.haskell.lib;
|
||||||
let path = baseNameOf p; in
|
with reflex-platform.nixpkgs.haskellPackages;
|
||||||
!builtins.any (x: x)
|
let
|
||||||
[(type == "directory" && path == "dist")
|
cp = file: (self.callPackage (./deps + "/${file}.nix") {});
|
||||||
(type == "symlink" && path == "result")
|
build-from-json = name: str: self.callCabal2nix name str {};
|
||||||
(type == "directory" && path == ".git")];
|
build = name: path: self.callCabal2nix name (builtins.filterSource filterPredicate path) {};
|
||||||
in {
|
in
|
||||||
mkDerivation = args: super.mkDerivation (args //
|
{
|
||||||
(if nixpkgs.stdenv.isDarwin && !frontend then {
|
gtk2hs-buildtools = self.callPackage ./gtk2hs-buildtools.nix {};
|
||||||
postCompileBuildDriver = ''
|
colonnade = build "colonnade" ../colonnade;
|
||||||
echo "Patching dynamic library dependencies"
|
siphon = build "siphon" ../siphon;
|
||||||
# 1. Link all dylibs from 'dynamic-library-dirs's in package confs to $out/lib/links
|
reflex-dom-colonnade = build "reflex-dom-colonnade" ../reflex-dom-colonnade;
|
||||||
mkdir -p $out/lib/links
|
lucid-colonnade = build "lucid-colonnade" ../lucid-colonnade;
|
||||||
for d in $(grep dynamic-library-dirs $packageConfDir/*|awk '{print $2}'); do
|
blaze-colonnade = build "blaze-colonnade" ../blaze-colonnade;
|
||||||
ln -s $d/*.dylib $out/lib/links
|
yesod-colonnade = build "yesod-colonnade" ../yesod-colonnade;
|
||||||
done
|
} //
|
||||||
|
{
|
||||||
|
jsaddle = doJailbreak (build-from-json "jsaddle" "${jsaddle-src}/jsaddle");
|
||||||
|
jsaddle-webkitgtk = doJailbreak (build-from-json "jsaddle-webkitgtk" "${jsaddle-src}/jsaddle-webkitgtk");
|
||||||
|
jsaddle-webkit2gtk = doJailbreak (build-from-json "jsaddle-webkit2gtk" "${jsaddle-src}/jsaddle-webkit2gtk");
|
||||||
|
jsaddle-wkwebview = doJailbreak (build-from-json "jsaddle-wkwebview" "${jsaddle-src}/jsaddle-wkwebview");
|
||||||
|
jsaddle-clib = doJailbreak (build-from-json "jsaddle-clib" "${jsaddle-src}/jsaddle-clib");
|
||||||
|
jsaddle-warp = dontCheck (doJailbreak (build-from-json "jsaddle-warp" "${jsaddle-src}/jsaddle-warp"));
|
||||||
|
};
|
||||||
|
|
||||||
# 2. Patch 'dynamic-library-dirs' in package confs to point to the symlink dir
|
|
||||||
for f in $packageConfDir/*.conf; do
|
|
||||||
sed -i "s,dynamic-library-dirs: .*,dynamic-library-dirs: $out/lib/links," $f
|
|
||||||
done
|
|
||||||
|
|
||||||
# 3. Recache package database
|
|
||||||
ghc-pkg --package-db="$packageConfDir" recache
|
|
||||||
'';
|
|
||||||
} else {}));
|
|
||||||
} // import ./overrides.nix { inherit options filterPredicate lib cabal2nixResult self super; };
|
|
||||||
};
|
};
|
||||||
drv = builtins.getAttr package overrides;
|
in rec {
|
||||||
in if reflex-platform.nixpkgs.lib.inNixShell then
|
inherit reflex-platform fetch-github-json overrides nixpkgs pkgs;
|
||||||
reflex-platform.workOn overrides drv
|
colonnade = overrides.colonnade;
|
||||||
else
|
siphon = overrides.siphon;
|
||||||
drv
|
reflex-dom-colonnade = overrides.reflex-dom-colonnade;
|
||||||
|
lucid-colonnade = overrides.lucid-colonnade;
|
||||||
|
blaze-colonnade = overrides.blaze-colonnade;
|
||||||
|
yesod-colonnade = overrides.yesod-colonnade;
|
||||||
|
}
|
||||||
|
20
nix/gtk2hs-buildtools.nix
Normal file
20
nix/gtk2hs-buildtools.nix
Normal file
@ -0,0 +1,20 @@
|
|||||||
|
{ mkDerivation, alex, array, base, Cabal, containers, directory
|
||||||
|
, filepath, happy, hashtables, pretty, process, random, stdenv
|
||||||
|
}:
|
||||||
|
mkDerivation {
|
||||||
|
pname = "gtk2hs-buildtools";
|
||||||
|
version = "0.13.4.0";
|
||||||
|
sha256 = "0f3e6ba90839efd43efe8cecbddb6478a55e2ce7788c57a0add4df477dede679";
|
||||||
|
isLibrary = true;
|
||||||
|
isExecutable = true;
|
||||||
|
enableSeparateDataOutput = true;
|
||||||
|
libraryHaskellDepends = [
|
||||||
|
array base Cabal containers directory filepath hashtables pretty
|
||||||
|
process random
|
||||||
|
];
|
||||||
|
libraryToolDepends = [ alex happy ];
|
||||||
|
executableHaskellDepends = [ base ];
|
||||||
|
homepage = "http://projects.haskell.org/gtk2hs/";
|
||||||
|
description = "Tools to build the Gtk2Hs suite of User Interface libraries";
|
||||||
|
license = stdenv.lib.licenses.gpl2;
|
||||||
|
}
|
6
nix/jsaddle.json
Normal file
6
nix/jsaddle.json
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
{
|
||||||
|
"owner": "ghcjs",
|
||||||
|
"repo": "jsaddle",
|
||||||
|
"rev": "b423436565fce7f69a65d843c71fc52dc455bf54",
|
||||||
|
"sha256": "09plndkh5wnbqi34x3jpaz0kjdjgyf074faf5xk97rsm81vhz8kk"
|
||||||
|
}
|
@ -1,5 +1,8 @@
|
|||||||
{ test ? "true" }:
|
{ frontend ? false }:
|
||||||
let parseBool = str: with builtins;
|
let
|
||||||
let json = fromJSON str; in if isBool json then json else throw "nix parseBool: ${str} is not a bool.";
|
pname = "reflex-dom-colonnade";
|
||||||
|
main = (import ../nix/default.nix {
|
||||||
|
inherit frontend;
|
||||||
|
});
|
||||||
in
|
in
|
||||||
import ../nix/default.nix { package = "reflex-dom-colonnade"; frontend = false; test = parseBool test; }
|
main.${pname}
|
||||||
|
1
reflex-dom-colonnade/shell.nix
Normal file
1
reflex-dom-colonnade/shell.nix
Normal file
@ -0,0 +1 @@
|
|||||||
|
(import ./. {}).env
|
@ -41,6 +41,7 @@ module Reflex.Dom.Colonnade
|
|||||||
, sectioned
|
, sectioned
|
||||||
, paginated
|
, paginated
|
||||||
, paginatedExpandable
|
, paginatedExpandable
|
||||||
|
, paginatedExpandableLazy
|
||||||
, paginatedCapped
|
, paginatedCapped
|
||||||
-- * Cell Functions
|
-- * Cell Functions
|
||||||
, cell
|
, cell
|
||||||
@ -56,29 +57,29 @@ 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.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))
|
||||||
@ -171,11 +172,13 @@ class Sizable t b h | h -> b where
|
|||||||
sizableSize :: h a -> Dynamic t Int
|
sizableSize :: h a -> Dynamic t Int
|
||||||
sizableCast :: Proxy t -> h a -> b a
|
sizableCast :: Proxy t -> h a -> b a
|
||||||
|
|
||||||
-- instance (Headedness h, Reflex t) => Headedness (Resizable t h) where
|
instance (Headedness h, Reflex t) => Headedness (Resizable t h) where
|
||||||
-- headednessPure = Resizable (pure 1) . headednessPure
|
headednessPure = Resizable (pure 1) . headednessPure
|
||||||
-- headednessContents = do
|
headednessExtract = do
|
||||||
-- f <- headednessContents
|
f <- headednessExtract
|
||||||
-- Just (\(Resizable _ a) -> f a)
|
Just (\(Resizable _ a) -> f a)
|
||||||
|
headednessExtractForall = headednessExtractForall
|
||||||
|
|
||||||
|
|
||||||
instance (Headedness h, Reflex t) => Sizable t h (Resizable t h) where
|
instance (Headedness h, Reflex t) => Sizable t h (Resizable t h) where
|
||||||
sizableSize = resizableSize
|
sizableSize = resizableSize
|
||||||
@ -308,7 +311,7 @@ bodyResizableLazy bodyAttrs trAttrs colonnade collection = do
|
|||||||
_ <- dyn $ flip fmap largestSizes $ \s -> do
|
_ <- dyn $ flip fmap largestSizes $ \s -> do
|
||||||
let colonnade' = E.Colonnade (V.map snd (V.filter (\(sz,_) -> sz > 0) (V.zip s (E.getColonnade colonnade))))
|
let colonnade' = E.Colonnade (V.map snd (V.filter (\(sz,_) -> sz > 0) (V.zip s (E.getColonnade colonnade))))
|
||||||
bodyResizable bodyAttrs trAttrs colonnade' collection
|
bodyResizable bodyAttrs trAttrs colonnade' collection
|
||||||
return ()
|
pure ()
|
||||||
|
|
||||||
setColspanOrHide :: Int -> Map Text Text -> Map Text Text
|
setColspanOrHide :: Int -> Map Text Text -> Map Text Text
|
||||||
setColspanOrHide i m
|
setColspanOrHide i m
|
||||||
@ -431,7 +434,7 @@ capped tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collection =
|
|||||||
elAttr "table" tableAttrs $ do
|
elAttr "table" tableAttrs $ do
|
||||||
h <- encodeCorniceHead headAttrs fascia (E.annotate cornice)
|
h <- encodeCorniceHead headAttrs fascia (E.annotate cornice)
|
||||||
b <- body (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection
|
b <- body (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection
|
||||||
return (h `mappend` b)
|
pure (h `mappend` b)
|
||||||
|
|
||||||
-- | This is useful when you want to be able to toggle the visibility
|
-- | This is useful when you want to be able to toggle the visibility
|
||||||
-- of columns after the table has been built. In additon to the
|
-- of columns after the table has been built. In additon to the
|
||||||
@ -456,7 +459,7 @@ cappedResizable tableAttrs headAttrs bodyAttrs beneathBody trAttrs fascia cornic
|
|||||||
_ <- encodeCorniceResizableHead headAttrs fascia annCornice
|
_ <- encodeCorniceResizableHead headAttrs fascia annCornice
|
||||||
bodyResizableLazy (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection
|
bodyResizableLazy (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection
|
||||||
c <- beneathBody
|
c <- beneathBody
|
||||||
return (c, E.size annCornice)
|
pure (c, E.size annCornice)
|
||||||
|
|
||||||
-- | Same as 'cappedResizable' but without the @\<table\>@ wrapping it.
|
-- | Same as 'cappedResizable' but without the @\<table\>@ wrapping it.
|
||||||
-- Also, it does not take extra content to go beneath the @\<tbody\>@.
|
-- Also, it does not take extra content to go beneath the @\<tbody\>@.
|
||||||
@ -473,9 +476,9 @@ cappedResizableTableless headAttrs bodyAttrs trAttrs fascia cornice collection =
|
|||||||
let annCornice = dynamicAnnotate cornice
|
let annCornice = dynamicAnnotate cornice
|
||||||
_ <- encodeCorniceResizableHead headAttrs fascia annCornice
|
_ <- encodeCorniceResizableHead headAttrs fascia annCornice
|
||||||
bodyResizableLazy (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection
|
bodyResizableLazy (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection
|
||||||
return (E.size annCornice)
|
pure (E.size annCornice)
|
||||||
|
|
||||||
cappedTableless ::
|
cappedTableless :: forall t b h m f e c p a.
|
||||||
(Headedness b, Sizable t b h, MonadWidget t m, Foldable f, Monoid e, Cellular t m c)
|
(Headedness b, Sizable t b h, MonadWidget t m, Foldable f, Monoid e, Cellular t m c)
|
||||||
=> Dynamic t (Map Text Text) -- ^ @\<thead\>@ tag attributes
|
=> Dynamic t (Map Text Text) -- ^ @\<thead\>@ tag attributes
|
||||||
-> Dynamic t (Map Text Text) -- ^ @\<tbody\>@ tag attributes
|
-> Dynamic t (Map Text Text) -- ^ @\<tbody\>@ tag attributes
|
||||||
@ -485,13 +488,14 @@ cappedTableless ::
|
|||||||
-> f a -- ^ Collection of data
|
-> f a -- ^ Collection of data
|
||||||
-> m (Dynamic t Int)
|
-> m (Dynamic t Int)
|
||||||
cappedTableless headAttrs bodyAttrs trAttrs fascia cornice collection = do
|
cappedTableless headAttrs bodyAttrs trAttrs fascia cornice collection = do
|
||||||
let annCornice = dynamicAnnotateGeneral cornice
|
let annCornice :: E.AnnotatedCornice (Dynamic t Int) b p a (c e)
|
||||||
|
annCornice = dynamicAnnotateGeneral cornice
|
||||||
_ <- encodeCorniceHeadGeneral headAttrs fascia annCornice
|
_ <- encodeCorniceHeadGeneral headAttrs fascia annCornice
|
||||||
bodyResizableLazy bodyAttrs trAttrs
|
bodyResizableLazy bodyAttrs trAttrs
|
||||||
(C.mapHeadedness sizedToResizable (E.uncapAnnotated annCornice))
|
(C.mapHeadedness sizedToResizable (E.uncapAnnotated annCornice))
|
||||||
collection
|
collection
|
||||||
return (E.size annCornice)
|
pure (E.size annCornice)
|
||||||
|
|
||||||
sizedToResizable :: E.Sized (Dynamic t Int) h a -> Resizable t h a
|
sizedToResizable :: E.Sized (Dynamic t Int) h a -> Resizable t h a
|
||||||
sizedToResizable (E.Sized sz h) = Resizable sz h
|
sizedToResizable (E.Sized sz h) = Resizable sz h
|
||||||
|
|
||||||
@ -559,7 +563,7 @@ cappedTraversing tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collectio
|
|||||||
elAttr "table" tableAttrs $ do
|
elAttr "table" tableAttrs $ do
|
||||||
_ <- encodeCorniceHead headAttrs fascia (E.annotate cornice)
|
_ <- encodeCorniceHead headAttrs fascia (E.annotate cornice)
|
||||||
b <- bodyTraversing bodyAttrs trAttrs (E.discard cornice) collection
|
b <- bodyTraversing bodyAttrs trAttrs (E.discard cornice) collection
|
||||||
return b
|
pure b
|
||||||
|
|
||||||
dynamicBody :: (DomBuilder t m, PostBuild t m, Foldable f, Semigroup e, Monoid e)
|
dynamicBody :: (DomBuilder t m, PostBuild t m, Foldable f, Semigroup e, Monoid e)
|
||||||
=> Dynamic t (M.Map T.Text T.Text)
|
=> Dynamic t (M.Map T.Text T.Text)
|
||||||
@ -642,11 +646,11 @@ expandable tableAttrs tdExpandedAttrs as encoding@(E.Colonnade v) = do
|
|||||||
elist <- E.rowMonadicWith [] (++) encoding (fmap (\k -> [k]) . elFromCell "td") a
|
elist <- E.rowMonadicWith [] (++) encoding (fmap (\k -> [k]) . elFromCell "td") a
|
||||||
let e = leftmost elist
|
let e = leftmost elist
|
||||||
e' = flip fmap e $ \mwidg -> case mwidg of
|
e' = flip fmap e $ \mwidg -> case mwidg of
|
||||||
Nothing -> return ()
|
Nothing -> pure ()
|
||||||
Just widg -> el "tr" $ do
|
Just widg -> el "tr" $ do
|
||||||
elDynAttr "td" (M.insert "colspan" (T.pack (show vlen)) <$> tdExpandedAttrs) widg
|
elDynAttr "td" (M.insert "colspan" (T.pack (show vlen)) <$> tdExpandedAttrs) widg
|
||||||
return e'
|
pure e'
|
||||||
widgetHold (return ()) e'
|
widgetHold (pure ()) e'
|
||||||
|
|
||||||
-- expandableResizableTableless :: forall t m f a b. (MonadWidget t m, Foldable f)
|
-- expandableResizableTableless :: forall t m f a b. (MonadWidget t m, Foldable f)
|
||||||
-- => f a -- ^ Values
|
-- => f a -- ^ Values
|
||||||
@ -687,7 +691,7 @@ paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize
|
|||||||
makeVals page = V.generate pageSize $ \ix -> do
|
makeVals page = V.generate pageSize $ \ix -> do
|
||||||
p <- page
|
p <- page
|
||||||
v <- vecD
|
v <- vecD
|
||||||
return (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
|
pure (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
|
||||||
totalPages :: Dynamic t Int
|
totalPages :: Dynamic t Int
|
||||||
totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD
|
totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD
|
||||||
hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
|
hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
|
||||||
@ -698,7 +702,7 @@ paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize
|
|||||||
trAttrsLifted d = do
|
trAttrsLifted d = do
|
||||||
Visible isVisible a <- d
|
Visible isVisible a <- d
|
||||||
attrs <- trAttrs a
|
attrs <- trAttrs a
|
||||||
return (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs)
|
pure (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs)
|
||||||
size :: Dynamic t Int
|
size :: Dynamic t Int
|
||||||
size = coerceDynamic (foldMap (\x -> coerceDynamic (sizableSize (E.oneColonnadeHead x)) :: Dynamic t (Sum Int)) (E.getColonnade col))
|
size = coerceDynamic (foldMap (\x -> coerceDynamic (sizableSize (E.oneColonnadeHead x)) :: Dynamic t (Sum Int)) (E.getColonnade col))
|
||||||
elDynAttr "table" tableAttrs $ case arrange of
|
elDynAttr "table" tableAttrs $ case arrange of
|
||||||
@ -711,15 +715,15 @@ paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize
|
|||||||
let attrs = zipDynWith insertSizeAttr size tfootThAttrs
|
let attrs = zipDynWith insertSizeAttr size tfootThAttrs
|
||||||
elDynAttr "th" attrs $ do
|
elDynAttr "th" attrs $ do
|
||||||
makePagination totalPages
|
makePagination totalPages
|
||||||
return e
|
pure e
|
||||||
_ -> error "Reflex.Dom.Colonnade: paginated: write this code"
|
_ -> error "Reflex.Dom.Colonnade: paginated: write this code"
|
||||||
|
|
||||||
-- dynAfter :: forall t m a b. MonadWidget t m => Event t a -> (Dynamic t a -> m (Event t b)) -> m (Event t b)
|
-- dynAfter :: forall t m a b. MonadWidget t m => Event t a -> (Dynamic t a -> m (Event t b)) -> m (Event t b)
|
||||||
-- dynAfter e f = do
|
-- dynAfter e f = do
|
||||||
-- e1 <- headE e
|
-- e1 <- headE e
|
||||||
-- let em1 = fmap (\a1 -> holdDyn a1 e >>= f) e1
|
-- let em1 = fmap (\a1 -> holdDyn a1 e >>= f) e1
|
||||||
-- de <- widgetHold (return never) em1
|
-- de <- widgetHold (pure never) em1
|
||||||
-- return (switch (current de))
|
-- pure (switch (current de))
|
||||||
|
|
||||||
-- paginatedCappedLazy :: forall t b h m a c p e.
|
-- paginatedCappedLazy :: forall t b h m a c p e.
|
||||||
-- (Sizable t b h, Cellular t m c, Headedness b, MonadFix m, Functor h, MonadHold t m, Monoid e)
|
-- (Sizable t b h, Cellular t m c, Headedness b, MonadFix m, Functor h, MonadHold t m, Monoid e)
|
||||||
@ -740,7 +744,7 @@ paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize
|
|||||||
-- makeVals page = V.generate pageSize $ \ix -> do
|
-- makeVals page = V.generate pageSize $ \ix -> do
|
||||||
-- p <- page
|
-- p <- page
|
||||||
-- v <- vecD
|
-- v <- vecD
|
||||||
-- return (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
|
-- pure (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
|
||||||
-- totalPages :: Dynamic t Int
|
-- totalPages :: Dynamic t Int
|
||||||
-- totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD
|
-- totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD
|
||||||
-- hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
|
-- hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
|
||||||
@ -751,7 +755,7 @@ paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize
|
|||||||
-- trAttrsLifted d = do
|
-- trAttrsLifted d = do
|
||||||
-- Visible isVisible a <- d
|
-- Visible isVisible a <- d
|
||||||
-- attrs <- trAttrs a
|
-- attrs <- trAttrs a
|
||||||
-- return (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs)
|
-- pure (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs)
|
||||||
-- elDynAttr "table" tableAttrs $ case arrange of
|
-- elDynAttr "table" tableAttrs $ case arrange of
|
||||||
-- ArrangementFooter tfootAttrs tfootTrAttrs tfootThAttrs -> mdo
|
-- ArrangementFooter tfootAttrs tfootTrAttrs tfootThAttrs -> mdo
|
||||||
-- let vals = makeVals page
|
-- let vals = makeVals page
|
||||||
@ -761,7 +765,7 @@ paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize
|
|||||||
-- let attrs = zipDynWith insertSizeAttr size tfootThAttrs
|
-- let attrs = zipDynWith insertSizeAttr size tfootThAttrs
|
||||||
-- elDynAttr "th" attrs $ do
|
-- elDynAttr "th" attrs $ do
|
||||||
-- makePagination totalPages
|
-- makePagination totalPages
|
||||||
-- return e
|
-- pure e
|
||||||
-- _ -> error "Reflex.Dom.Colonnade: paginatedCapped: write this code"
|
-- _ -> error "Reflex.Dom.Colonnade: paginatedCapped: write this code"
|
||||||
|
|
||||||
|
|
||||||
@ -780,7 +784,7 @@ paginatedCapped (Chest tableAttrs theadAttrs fascia bodyAttrs trAttrs) (Paginati
|
|||||||
makeVals page = V.generate pageSize $ \ix -> do
|
makeVals page = V.generate pageSize $ \ix -> do
|
||||||
p <- page
|
p <- page
|
||||||
v <- vecD
|
v <- vecD
|
||||||
return (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
|
pure (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
|
||||||
totalPages :: Dynamic t Int
|
totalPages :: Dynamic t Int
|
||||||
totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD
|
totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD
|
||||||
hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
|
hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
|
||||||
@ -791,7 +795,7 @@ paginatedCapped (Chest tableAttrs theadAttrs fascia bodyAttrs trAttrs) (Paginati
|
|||||||
trAttrsLifted d = do
|
trAttrsLifted d = do
|
||||||
Visible isVisible a <- d
|
Visible isVisible a <- d
|
||||||
attrs <- trAttrs a
|
attrs <- trAttrs a
|
||||||
return (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs)
|
pure (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs)
|
||||||
elDynAttr "table" tableAttrs $ case arrange of
|
elDynAttr "table" tableAttrs $ case arrange of
|
||||||
ArrangementFooter tfootAttrs tfootTrAttrs tfootThAttrs -> mdo
|
ArrangementFooter tfootAttrs tfootTrAttrs tfootThAttrs -> mdo
|
||||||
let vals = makeVals page
|
let vals = makeVals page
|
||||||
@ -801,9 +805,8 @@ paginatedCapped (Chest tableAttrs theadAttrs fascia bodyAttrs trAttrs) (Paginati
|
|||||||
let attrs = zipDynWith insertSizeAttr size tfootThAttrs
|
let attrs = zipDynWith insertSizeAttr size tfootThAttrs
|
||||||
elDynAttr "th" attrs $ do
|
elDynAttr "th" attrs $ do
|
||||||
makePagination totalPages
|
makePagination totalPages
|
||||||
return ()
|
pure ()
|
||||||
_ -> error "Reflex.Dom.Colonnade: paginatedCapped: write this code"
|
_ -> error "Reflex.Dom.Colonnade: paginatedCapped: write this code"
|
||||||
|
|
||||||
|
|
||||||
-- | A paginated table with a fixed number of rows. Each row can
|
-- | A paginated table with a fixed number of rows. Each row can
|
||||||
-- expand a section beneath it, represented as an additional
|
-- expand a section beneath it, represented as an additional
|
||||||
@ -828,7 +831,7 @@ paginatedExpandable (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination
|
|||||||
makeVals page = V.generate pageSize $ \ix -> do
|
makeVals page = V.generate pageSize $ \ix -> do
|
||||||
p <- page
|
p <- page
|
||||||
v <- vecD
|
v <- vecD
|
||||||
return (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
|
pure (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
|
||||||
totalPages :: Dynamic t Int
|
totalPages :: Dynamic t Int
|
||||||
totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD
|
totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD
|
||||||
hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
|
hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
|
||||||
@ -839,7 +842,7 @@ paginatedExpandable (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination
|
|||||||
trAttrsLifted d = do
|
trAttrsLifted d = do
|
||||||
Visible isVisible a <- d
|
Visible isVisible a <- d
|
||||||
attrs <- trAttrs a
|
attrs <- trAttrs a
|
||||||
return (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs)
|
pure (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs)
|
||||||
size :: Dynamic t Int
|
size :: Dynamic t Int
|
||||||
size = coerceDynamic (foldMap (\x -> coerceDynamic (sizableSize (E.oneColonnadeHead x)) :: Dynamic t (Sum Int)) (E.getColonnade col))
|
size = coerceDynamic (foldMap (\x -> coerceDynamic (sizableSize (E.oneColonnadeHead x)) :: Dynamic t (Sum Int)) (E.getColonnade col))
|
||||||
elDynAttr "table" tableAttrs $ case arrange of
|
elDynAttr "table" tableAttrs $ case arrange of
|
||||||
@ -852,21 +855,70 @@ paginatedExpandable (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination
|
|||||||
let attrs = zipDynWith insertSizeAttr size tfootThAttrs
|
let attrs = zipDynWith insertSizeAttr size tfootThAttrs
|
||||||
elDynAttr "th" attrs $ do
|
elDynAttr "th" attrs $ do
|
||||||
makePagination totalPages
|
makePagination totalPages
|
||||||
return ()
|
pure ()
|
||||||
_ -> error "Reflex.Dom.Colonnade: paginated: write this code"
|
_ -> error "Reflex.Dom.Colonnade: paginatedExpandable: write this code"
|
||||||
|
|
||||||
|
-- | A paginated table with a fixed number of rows. Each row can
|
||||||
|
-- expand a section beneath it, represented as an additional
|
||||||
|
-- table row. CSS rules that give the table a striped appearance
|
||||||
|
-- are unlikely to work since there are hidden rows.
|
||||||
|
paginatedExpandableLazy :: forall t b h m a c.
|
||||||
|
(Sizable t b h, Cellular t m c, Headedness b, MonadFix m, Functor h, Functor c, MonadHold t m, MonadWidget t m, Headedness h, h ~ b)
|
||||||
|
=> Bureau t b a -- ^ table class settings
|
||||||
|
-> Pagination t m -- ^ pagination settings
|
||||||
|
-> a -- ^ An inhabitant of type @a@ only used for the cells in hidden rows.
|
||||||
|
-> (Dynamic t a -> m ()) -- expandable extra content
|
||||||
|
-> Colonnade (Resizable t h) (Dynamic t a) (c (Dynamic t Bool))
|
||||||
|
-- ^ Column blueprint. The boolean event enables and disables the expansion.
|
||||||
|
-> Dynamic t (Vector a) -- ^ table row data
|
||||||
|
-> m ()
|
||||||
|
paginatedExpandableLazy (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize arrange makePagination) aDef expansion col vecD = do
|
||||||
|
let colLifted :: Colonnade (Resizable t h) (Dynamic t (Visible a)) (c (Dynamic t Bool))
|
||||||
|
colLifted = PF.lmap (fmap (\(Visible _ a) -> a)) col
|
||||||
|
expansionLifted :: Dynamic t (Visible a) -> m ()
|
||||||
|
expansionLifted = expansion . fmap (\(Visible _ a) -> a)
|
||||||
|
makeVals :: Dynamic t Int -> Vector (Dynamic t (Visible a))
|
||||||
|
makeVals page = V.generate pageSize $ \ix -> do
|
||||||
|
p <- page
|
||||||
|
v <- vecD
|
||||||
|
pure (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
|
||||||
|
totalPages :: Dynamic t Int
|
||||||
|
totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD
|
||||||
|
hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
|
||||||
|
hideWhenUnipage = zipDynWith
|
||||||
|
( \ct attrs -> if ct > 1 then attrs else M.insert "style" "display:none;" attrs
|
||||||
|
) totalPages
|
||||||
|
trAttrsLifted :: Dynamic t (Visible a) -> Dynamic t (Map Text Text)
|
||||||
|
trAttrsLifted d = do
|
||||||
|
Visible isVisible a <- d
|
||||||
|
attrs <- trAttrs a
|
||||||
|
pure (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs)
|
||||||
|
size :: Dynamic t Int
|
||||||
|
size = coerceDynamic (foldMap (\x -> coerceDynamic (sizableSize (E.oneColonnadeHead x)) :: Dynamic t (Sum Int)) (E.getColonnade col))
|
||||||
|
elDynAttr "table" tableAttrs $ case arrange of
|
||||||
|
ArrangementFooter tfootAttrs tfootTrAttrs tfootThAttrs -> mdo
|
||||||
|
tableHeader theadAttrs colLifted
|
||||||
|
let vals = makeVals page
|
||||||
|
tableBodyExpandableLazy size expansionLifted bodyAttrs trAttrsLifted colLifted vals (Visible True aDef)
|
||||||
|
page <- elDynAttr "tfoot" (hideWhenUnipage tfootAttrs) $ do
|
||||||
|
elDynAttr "tr" tfootTrAttrs $ do
|
||||||
|
let attrs = zipDynWith insertSizeAttr size tfootThAttrs
|
||||||
|
elDynAttr "th" attrs $ do
|
||||||
|
makePagination totalPages
|
||||||
|
pure ()
|
||||||
|
_ -> error "Reflex.Dom.Colonnade: paginatedExpandableLazy: write this code"
|
||||||
|
|
||||||
divRoundUp :: Int -> Int -> Int
|
divRoundUp :: Int -> Int -> Int
|
||||||
divRoundUp a b = case divMod a b of
|
divRoundUp a b = case divMod a b of
|
||||||
(x,y) -> if y == 0 then x else x + 1
|
(x,y) -> if y == 0 then x else x + 1
|
||||||
|
|
||||||
tableHeader :: forall t b h c a m x.
|
tableHeader :: forall t b h c a m x.
|
||||||
(Reflex t, Sizable t b h, Cellular t m c, Headedness b)
|
(Reflex t, Sizable t b h, Cellular t m c, Headedness b)
|
||||||
=> b (Dynamic t (Map Text Text), Dynamic t (Map Text Text))
|
=> b (Dynamic t (Map Text Text), Dynamic t (Map Text Text))
|
||||||
-> Colonnade h a (c x)
|
-> Colonnade h a (c x)
|
||||||
-> m ()
|
-> m ()
|
||||||
tableHeader theadAttrsWrap col = case headednessExtractForall of
|
tableHeader theadAttrsWrap col = case headednessExtractForall of
|
||||||
Nothing -> return ()
|
Nothing -> pure ()
|
||||||
Just extractForall -> do
|
Just extractForall -> do
|
||||||
let (theadAttrs,trAttrs) = extract theadAttrsWrap
|
let (theadAttrs,trAttrs) = extract theadAttrsWrap
|
||||||
elDynAttr "thead" theadAttrs $ do
|
elDynAttr "thead" theadAttrs $ do
|
||||||
@ -875,7 +927,7 @@ tableHeader theadAttrsWrap col = case headednessExtractForall of
|
|||||||
where
|
where
|
||||||
extract :: forall y. b y -> y
|
extract :: forall y. b y -> y
|
||||||
extract = E.runExtractForall extractForall
|
extract = E.runExtractForall extractForall
|
||||||
|
|
||||||
tableBody :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e, Cellular t m c, Sizable t b h)
|
tableBody :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e, Cellular t m c, Sizable t b h)
|
||||||
=> Dynamic t (M.Map T.Text T.Text)
|
=> Dynamic t (M.Map T.Text T.Text)
|
||||||
-> (a -> Dynamic t (M.Map T.Text T.Text))
|
-> (a -> Dynamic t (M.Map T.Text T.Text))
|
||||||
@ -885,9 +937,35 @@ tableBody :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e, Cellular t m
|
|||||||
tableBody bodyAttrs trAttrs col collection =
|
tableBody bodyAttrs trAttrs col collection =
|
||||||
elDynAttr "tbody" bodyAttrs $ foldlM (\m a -> do
|
elDynAttr "tbody" bodyAttrs $ foldlM (\m a -> do
|
||||||
e <- elDynAttr "tr" (trAttrs a) (rowSizable col a)
|
e <- elDynAttr "tr" (trAttrs a) (rowSizable col a)
|
||||||
return (mappend m e)
|
pure (mappend m e)
|
||||||
) mempty collection
|
) mempty collection
|
||||||
|
|
||||||
|
-- | As of now, the *expandable* content is only as lazy as tableBodyExpandable is, meaning it is still generated with the initial value.
|
||||||
|
tableBodyExpandableLazy :: forall t m c b a h. (Headedness h, MonadFix m, DomBuilder t m, MonadHold t m, PostBuild t m, Cellular t m c, Sizable t b h)
|
||||||
|
=> Dynamic t Int -- ^ number of visible columns in the table
|
||||||
|
-> (Dynamic t a -> m ())
|
||||||
|
-> Dynamic t (Map Text Text)
|
||||||
|
-> (Dynamic t a -> Dynamic t (Map Text Text))
|
||||||
|
-> Colonnade (Resizable t h) (Dynamic t a) (c (Dynamic t Bool))
|
||||||
|
-> Vector (Dynamic t a)
|
||||||
|
-> a -- ^ initial value, a hack
|
||||||
|
-> m ()
|
||||||
|
tableBodyExpandableLazy colCount renderExpansion bodyAttrs trAttrs colonnade collection a0 = do
|
||||||
|
let sizeVec :: Vector (Dynamic t Int)
|
||||||
|
sizeVec = V.map (resizableSize . E.oneColonnadeHead) (E.getColonnade colonnade)
|
||||||
|
let sizeVecD :: Dynamic t (Vector Int)
|
||||||
|
sizeVecD = fmap V.fromList (distributeListOverDynPure (V.toList sizeVec))
|
||||||
|
sizeVec0 :: Vector Int <- sample (current sizeVecD)
|
||||||
|
largestSizes :: Dynamic t (Vector Int) <- foldDynMaybe
|
||||||
|
( \incoming largest ->
|
||||||
|
let v = V.zipWith max incoming largest
|
||||||
|
in if v == largest then Nothing else Just v
|
||||||
|
) sizeVec0 (updated sizeVecD)
|
||||||
|
_ <- dyn $ flip fmap largestSizes $ \s -> do
|
||||||
|
let colonnade' = E.Colonnade (V.map snd (V.filter (\(sz,_) -> sz > 0) (V.zip s (E.getColonnade colonnade))))
|
||||||
|
tableBodyExpandable colCount renderExpansion bodyAttrs trAttrs colonnade' collection a0
|
||||||
|
pure ()
|
||||||
|
|
||||||
-- | This function has a implementation that is careful to only
|
-- | This function has a implementation that is careful to only
|
||||||
-- redraw the expansion rows, which are usually hidden, when
|
-- redraw the expansion rows, which are usually hidden, when
|
||||||
-- it is necessary to do so.
|
-- it is necessary to do so.
|
||||||
@ -903,8 +981,8 @@ tableBodyExpandable :: forall t m c b a h. (DomBuilder t m, MonadHold t m, PostB
|
|||||||
tableBodyExpandable colCount renderExpansion bodyAttrs trAttrs col collection a0 =
|
tableBodyExpandable colCount renderExpansion bodyAttrs trAttrs col collection a0 =
|
||||||
elDynAttr "tbody" bodyAttrs $ mapM_ (\a -> do
|
elDynAttr "tbody" bodyAttrs $ mapM_ (\a -> do
|
||||||
let attrs = trAttrs a
|
let attrs = trAttrs a
|
||||||
expanded <- elDynAttr "tr" attrs (rowSizableReified (return False) (zipDynWith (||)) col a)
|
expanded :: Dynamic t Bool <- elDynAttr "tr" attrs (rowSizableReified (pure False) (zipDynWith (||)) col a)
|
||||||
visibleVal <- gateDynamic expanded a0 a
|
visibleVal :: Dynamic t a <- gateDynamic expanded a0 a
|
||||||
elDynAttr "tr" (zipDynWith insertVisibilityAttr expanded attrs) $ do
|
elDynAttr "tr" (zipDynWith insertVisibilityAttr expanded attrs) $ do
|
||||||
-- TODO: possibly provide a way to customize these attributes
|
-- TODO: possibly provide a way to customize these attributes
|
||||||
let expansionTdAttrs = pure M.empty
|
let expansionTdAttrs = pure M.empty
|
||||||
@ -945,7 +1023,7 @@ rowSizableReified theEmpty theAppend (E.Colonnade v) a = V.foldM (\m oc -> do
|
|||||||
attrs = zipDynWith insertSizeAttr sz (cellularAttrs c)
|
attrs = zipDynWith insertSizeAttr sz (cellularAttrs c)
|
||||||
e <- elDynAttr "td" attrs $ do
|
e <- elDynAttr "td" attrs $ do
|
||||||
cellularContents c
|
cellularContents c
|
||||||
return (theAppend m e)
|
pure (theAppend m e)
|
||||||
) theEmpty v
|
) theEmpty v
|
||||||
|
|
||||||
rowSizable :: (Sizable t b h, Cellular t m c, Monoid e)
|
rowSizable :: (Sizable t b h, Cellular t m c, Monoid e)
|
||||||
@ -958,7 +1036,7 @@ rowSizable (E.Colonnade v) a = V.foldM (\m oc -> do
|
|||||||
attrs = zipDynWith insertSizeAttr sz (cellularAttrs c)
|
attrs = zipDynWith insertSizeAttr sz (cellularAttrs c)
|
||||||
e <- elDynAttr "td" attrs $ do
|
e <- elDynAttr "td" attrs $ do
|
||||||
cellularContents c
|
cellularContents c
|
||||||
return (mappend m e)
|
pure (mappend m e)
|
||||||
) mempty v
|
) mempty v
|
||||||
|
|
||||||
insertVisibilityAttr :: Bool -> Map Text Text -> Map Text Text
|
insertVisibilityAttr :: Bool -> Map Text Text -> Map Text Text
|
||||||
@ -986,7 +1064,7 @@ semUiFixedPagination :: MonadWidget t m
|
|||||||
semUiFixedPagination maxPageCount extraClass pageCount = do
|
semUiFixedPagination maxPageCount extraClass pageCount = do
|
||||||
elClass "div" (T.append "ui pagination menu " extraClass) $ mdo
|
elClass "div" (T.append "ui pagination menu " extraClass) $ mdo
|
||||||
(bckEl,()) <- elClass' "a" "icon item" $ do
|
(bckEl,()) <- elClass' "a" "icon item" $ do
|
||||||
elClass "i" "left chevron icon" (return ())
|
elClass "i" "left chevron icon" (pure ())
|
||||||
let bck = Backward <$ domEvent Click bckEl
|
let bck = Backward <$ domEvent Click bckEl
|
||||||
posList <- forM (enumFromTo 0 (maxPageCount - 1)) $ \i -> do
|
posList <- forM (enumFromTo 0 (maxPageCount - 1)) $ \i -> do
|
||||||
let attrs = zipDynWith (\ct pg -> M.unionsWith (<>)
|
let attrs = zipDynWith (\ct pg -> M.unionsWith (<>)
|
||||||
@ -996,16 +1074,16 @@ semUiFixedPagination maxPageCount extraClass pageCount = do
|
|||||||
]
|
]
|
||||||
) pageCount page
|
) pageCount page
|
||||||
(pageEl, ()) <- elDynAttr' "a" attrs (text (T.pack (show (i + 1))))
|
(pageEl, ()) <- elDynAttr' "a" attrs (text (T.pack (show (i + 1))))
|
||||||
return (Position i <$ domEvent Click pageEl)
|
pure (Position i <$ domEvent Click pageEl)
|
||||||
(fwdEl,()) <- elClass' "a" "icon item" $ do
|
(fwdEl,()) <- elClass' "a" "icon item" $ do
|
||||||
elClass "i" "right chevron icon" (return ())
|
elClass "i" "right chevron icon" (pure ())
|
||||||
let fwd = Forward <$ domEvent Click fwdEl
|
let fwd = Forward <$ domEvent Click fwdEl
|
||||||
let moveEv = leftmost (fwd : bck : (Position 0 <$ updated pageCount) : posList)
|
let moveEv = leftmost (fwd : bck : (Position 0 <$ updated pageCount) : posList)
|
||||||
page <- foldDynM (\move oldPage -> case move of
|
page <- foldDynM (\move oldPage -> case move of
|
||||||
Backward -> return (max 0 (oldPage - 1))
|
Backward -> pure (max 0 (oldPage - 1))
|
||||||
Forward -> do
|
Forward -> do
|
||||||
nowPageCount <- sample (current pageCount)
|
nowPageCount <- sample (current pageCount)
|
||||||
return (min (nowPageCount - 1) (oldPage + 1))
|
pure (min (nowPageCount - 1) (oldPage + 1))
|
||||||
Position updatedPage -> return updatedPage
|
Position updatedPage -> pure updatedPage
|
||||||
) 0 moveEv
|
) 0 moveEv
|
||||||
holdUniqDyn page
|
holdUniqDyn page
|
||||||
|
Loading…
Reference in New Issue
Block a user