From 63300e541d64633dba72d4ad91cf15be36a91ca2 Mon Sep 17 00:00:00 2001
From: Morgan Thomas <morgan.a.s.thomas@gmail.com>
Date: Tue, 27 Apr 2021 06:10:49 -0400
Subject: [PATCH 1/9] lazy loading tables (first attempt, untested)

---
 widgets/Shpadoinkle-widgets.cabal         |   1 +
 widgets/Shpadoinkle/Widgets/Table/Lazy.hs | 179 +++++++++++++++++-----
 2 files changed, 143 insertions(+), 37 deletions(-)

diff --git a/widgets/Shpadoinkle-widgets.cabal b/widgets/Shpadoinkle-widgets.cabal
index 9406542b..2758ebe6 100644
--- a/widgets/Shpadoinkle-widgets.cabal
+++ b/widgets/Shpadoinkle-widgets.cabal
@@ -74,6 +74,7 @@ library
     , stm >=2.5.0 && <2.6
     , template-haskell >=2.14.0 && <2.17
     , text >=1.2.3 && <1.3
+    , transformers >=0.5.0 && <0.6
     , unliftio >=0.2.12 && <0.3
 
   if flag(testing)
diff --git a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
index 814f75f4..5afca37f 100644
--- a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
+++ b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
@@ -18,6 +18,11 @@ module Shpadoinkle.Widgets.Table.Lazy
   , LazyTable (..)
   , DebounceScroll
   , LazyTableScrollConfig (..)
+  , Offset (..)
+  , Length (..)
+  , Page (..)
+  , Paginator (..)
+  , lazyLoadingTable
   , lazyTable
   ) where
 
@@ -25,6 +30,7 @@ module Shpadoinkle.Widgets.Table.Lazy
 import           Prelude                     hiding (div)
 
 import           Control.Arrow               (second)
+import           Control.Monad.Trans.Class   (lift)
 import           Data.Aeson
 import           Data.List                   (sortBy)
 import           Data.Maybe                  (fromMaybe)
@@ -41,15 +47,33 @@ import           Shpadoinkle.Widgets.Types
 default (Text)
 
 
+second3 :: (b -> b') -> (a, b, c) -> (a, b', c)
+second3 f (x, y, z) = (x, f y, z)
+
+
 class Tabular a => LazyTabular a where
   countRows :: a -> Int
 
 
-data LazyTable a = LazyTable a AssumedTableHeight AssumedRowHeight CurrentScrollY RowsToShow (SortCol a) [Row (LazyTable a)]
+data LazyTable a = LazyTable a AssumedTableHeight AssumedRowHeight CurrentScrollY RowsToShow RowsLoaded (SortCol a) [Row (LazyTable a)]
+
+
+newtype RowsToShow = RowsToShow { unRowsToShow :: Int }
+  deriving (Eq, Ord, Num, Real, Bounded, Enum, Read, Show, Generic, NFData)
+
+instance ToJSON    RowsToShow
+instance FromJSON  RowsToShow
+instance ToJSVal   RowsToShow
+instance FromJSVal RowsToShow
 
 
-newtype RowsToShow = RowsToShow Int
-  deriving (Eq, Ord, Num, Real, Bounded, Enum, Read, Show, ToJSON, FromJSON, Generic, NFData)
+newtype RowsLoaded = RowsLoaded { unRowsLoaded :: Int }
+  deriving (Eq, Ord, Num, Real, Bounded, Enum, Read, Show, Generic, NFData)
+
+instance ToJSON    RowsLoaded
+instance FromJSON  RowsLoaded
+instance ToJSVal   RowsLoaded
+instance FromJSVal RowsLoaded
 
 
 data instance (Row (LazyTable a)) = LazyRow (Row a) | FakeRow
@@ -82,8 +106,8 @@ instance Ord (Column a) => Ord (Column (LazyTable a)) where
 
 instance Tabular a => Tabular (LazyTable a) where
   type Effect (LazyTable a) m = Effect a m
-  toRows (LazyTable _ _ _ _ _ _ rows) = rows ++ [FakeRow]
-  toCell (LazyTable xs _ _ _ _ _ _) (LazyRow r) (LazyColumn c) =
+  toRows (LazyTable _ _ _ _ _ _ _ rows) = rows ++ [FakeRow]
+  toCell (LazyTable xs _ _ _ _ _ _ _) (LazyRow r) (LazyColumn c) =
     mapToLazyTable <$> toCell xs r c
   toCell _ FakeRow _ = []
   sortTable sc (LazyRow a) (LazyRow b) = sortTable (fromLazySortCol sc) a b
@@ -111,7 +135,7 @@ type DebounceScroll m a = (RawNode -> RawEvent -> JSM (Continuation m a))
                        -> (RawNode -> RawEvent -> JSM (Continuation m a))
 
 
-data LazyTableScrollConfig m a b = ContainerIsScrollable (DebounceScroll m (b, CurrentScrollY))
+data LazyTableScrollConfig m a b = ContainerIsScrollable (DebounceScroll m (b, CurrentScrollY, RowsLoaded))
                                  | TbodyIsScrollable (DebounceScroll m (LazyTable a, SortCol (LazyTable a)))
   deriving Generic
 
@@ -125,47 +149,88 @@ fromLazySortCol (SortCol (LazyColumn c') s') = SortCol c' s'
 
 
 mapFromLazyTableSc :: Tabular a => Functor m => Continuous f
-                 => LazyTable a
-                 -> f m (LazyTable a, SortCol (LazyTable a)) -> f m ((a, SortCol a), CurrentScrollY)
-mapFromLazyTableSc (LazyTable _ tableHeight rowHeight _ _ _ _) = liftC
-  (\(LazyTable tab _ _ sy _ _ _, sc') _ -> ((tab, fromLazySortCol sc'), sy))
-  (\((tab, sc), sy) -> ( toLazyTable tableHeight rowHeight sy tab sc
-                       , toLazySortCol sc ))
+                   => LazyTable a
+                   -> f m (LazyTable a, SortCol (LazyTable a)) -> f m ((a, SortCol a), CurrentScrollY, RowsLoaded)
+mapFromLazyTableSc (LazyTable _ tableHeight rowHeight _ _ _ _ _) = liftC
+  (\(LazyTable tab _ _ sy _ rl _ _, sc') _ -> ((tab, fromLazySortCol sc'), sy, rl))
+  (\((tab, sc), sy, rl) -> ( toLazyTable tableHeight rowHeight sy rl tab sc
+                           , toLazySortCol sc ))
 
 
 mapToLazyTable :: Functor m => Continuous f => Tabular a
                => f m a -> f m (LazyTable a)
 mapToLazyTable = liftC
-  (\tab (LazyTable _ tableHeight rowHeight scrollY _ sc _)
-    -> toLazyTable tableHeight rowHeight scrollY tab sc)
-  (\(LazyTable tab _ _ _ _ _ _) -> tab)
+  (\tab (LazyTable _ tableHeight rowHeight scrollY _ rowsLoaded sc _)
+    -> toLazyTable tableHeight rowHeight scrollY rowsLoaded tab sc)
+  (\(LazyTable tab _ _ _ _ _ _ _) -> tab)
 
 
 mapToLazyTableSc :: Functor m => Continuous f => Tabular a
                  => f m (a, SortCol a) -> f m (LazyTable a, SortCol (LazyTable a))
 mapToLazyTableSc = liftC
-  (\(tab, sc) (LazyTable _ tableHeight rowHeight scrollY _ _ _, _)
-    -> ( toLazyTable tableHeight rowHeight scrollY tab sc
+  (\(tab, sc) (LazyTable _ tableHeight rowHeight scrollY _ rowsLoaded _ _, _)
+    -> ( toLazyTable tableHeight rowHeight scrollY rowsLoaded tab sc
        , toLazySortCol sc ))
-  (\(LazyTable tab _ _ _ _ _ _, sc) -> (tab, fromLazySortCol sc))
+  (\(LazyTable tab _ _ _ _ _ _ _, sc) -> (tab, fromLazySortCol sc))
 
 
 toLazyTable :: Tabular a
   => AssumedTableHeight -> AssumedRowHeight -> CurrentScrollY
-  -> a -> SortCol a -> LazyTable a
-toLazyTable tabh@(AssumedTableHeight height) rowh@(AssumedRowHeight rowHeight) sy@(CurrentScrollY scrollY) xs sc
-  = LazyTable xs tabh rowh sy (RowsToShow rowsToShow) sc
+  -> RowsLoaded -> a -> SortCol a -> LazyTable a
+toLazyTable tabh rowh sy rowsLoaded xs sc
+  = LazyTable xs tabh rowh sy (RowsToShow numRows) rowsLoaded sc
                  . fmap LazyRow
-                 . take rowsToShow
+                 . take numRows
                  . sortBy (sortTable sc)
                  . filter (toFilter xs)
                  $ toRows xs
+  where numRows = rowsToShow tabh rowh sy
+
+
+rowsToShow :: AssumedTableHeight -> AssumedRowHeight -> CurrentScrollY
+           -> Int
+rowsToShow (AssumedTableHeight height) (AssumedRowHeight rowHeight) (CurrentScrollY scrollY) =
+    1 + truncate (pixelsToFill / fromIntegral rowHeight)
   where
     pixelsToFill :: Double
     -- TODO: make these coefficients (8 and 1.5) configurable?
     pixelsToFill = 8 * fromIntegral height + 1.5 * fromIntegral scrollY
 
-    rowsToShow :: Int = 1 + truncate (pixelsToFill / fromIntegral rowHeight)
+
+newtype Offset = Offset Int
+  deriving (Eq, Ord, Generic, Read, Show, Num, Enum, Real, Integral)
+
+instance ToJSON    Offset
+instance FromJSON  Offset
+instance ToJSVal   Offset
+instance FromJSVal Offset
+
+
+newtype Length = Length Int
+  deriving (Eq, Ord, Generic, Read, Show, Num, Enum, Real, Integral)
+
+instance ToJSON    Length
+instance FromJSON  Length
+instance ToJSVal   Length
+instance FromJSVal Length
+
+
+data Page = Page { pageOffset :: Offset, pageLength :: Length }
+  deriving (Eq, Ord, Generic, Read, Show)
+
+instance ToJSON    Page
+instance FromJSON  Page
+instance ToJSVal   Page
+instance FromJSVal Page
+
+
+-- A Paginator takes a tabular data type and a page and returns an action which yields a new tabular value with the values in the given page range included.
+newtype Paginator m a = Paginator { unPaginator :: a -> Page -> m a }
+
+
+-- A trivialPaginator is a no-op paginator, for when the data is all there already.
+trivialPaginator :: Applicative m => Paginator m a
+trivialPaginator = Paginator (\x _ -> pure x)
 
 
 lazyTable :: forall m a b.
@@ -185,7 +250,40 @@ lazyTable :: forall m a b.
   -> SortCol a
   -> CurrentScrollY
   -> Html m (b, CurrentScrollY)
-lazyTable theme tableHeight rowHeight@(AssumedRowHeight rowHeight')
+lazyTable theme tableHeight rowHeight scrollConfig container xs sc scrollY
+  = removeRowsLoaded $
+    lazyLoadingTable trivialPaginator (RowsLoaded 0) theme tableHeight rowHeight scrollConfig
+      liftedContainer xs sc scrollY
+  where
+    liftedContainer = addRowsLoaded . container . removeRowsLoaded
+
+    addRowsLoaded :: Continuous f => f m (x, y) -> f m (x, y, RowsLoaded)
+    addRowsLoaded = liftC (\(x,y) (_,_,r) -> (x,y,r)) (\(x,y,_) -> (x,y))
+
+    removeRowsLoaded :: Continuous f => f m (x, y, RowsLoaded) -> f m (x, y)
+    removeRowsLoaded = liftC (\(x,y,_) _ -> (x,y)) (\(x,y) -> (x,y,0))
+
+
+lazyLoadingTable :: forall m a b.
+  ( LazyTabular a
+  , Effect a m
+  , MonadJSM m
+  , Humanize (Column a)
+  , Bounded  (Column a)
+  , Ord      (Column a)
+  , Enum     (Column a) )
+  => Paginator m (LazyTable a)
+  -> RowsLoaded
+  -> Theme m a
+  -> AssumedTableHeight
+  -> AssumedRowHeight
+  -> LazyTableScrollConfig m a b
+  -> (Html m ((a, SortCol a), CurrentScrollY, RowsLoaded) -> Html m (b, CurrentScrollY, RowsLoaded))
+  -> a
+  -> SortCol a
+  -> CurrentScrollY
+  -> Html m (b, CurrentScrollY, RowsLoaded)
+lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHeight rowHeight')
           scrollConfig container xs sc@(SortCol c s) scrollY =
     addContainerScrollHandler
   . container
@@ -193,7 +291,7 @@ lazyTable theme tableHeight rowHeight@(AssumedRowHeight rowHeight')
   . mapFromLazyTableSc lazyTab
   $ viewWith lazyTheme lazyTab (SortCol (LazyColumn c) s)
   where
-    lazyTab@LazyTable {} = toLazyTable tableHeight rowHeight scrollY xs sc
+    lazyTab@LazyTable {} = toLazyTable tableHeight rowHeight scrollY rowsLoaded xs sc
 
     totalRows = countRows xs
 
@@ -207,13 +305,20 @@ lazyTable theme tableHeight rowHeight@(AssumedRowHeight rowHeight')
       TbodyIsScrollable _ -> id
 
     scrollHandlerContainer (RawNode n) _ =
-      pur . second . const . CurrentScrollY . fromMaybe 0
+      pur . second3 . const . CurrentScrollY . fromMaybe 0
         <$> (fromJSVal =<< n ! "scrollTop")
 
-    scrollHandlerTbody :: RawNode -> RawEvent -> JSM (Continuation m (LazyTable a, SortCol (LazyTable a)))
-    scrollHandlerTbody (RawNode n) _ = do
+    scrollHandlerTbody :: RowsLoaded -> RawNode -> RawEvent -> JSM (Continuation m (LazyTable a, SortCol (LazyTable a)))
+    scrollHandlerTbody _rowsLoaded' (RawNode n) _ = do
       sy <- CurrentScrollY . fromMaybe 0 <$> (fromJSVal =<< n ! "scrollTop")
-      return . pur $ \(LazyTable t th rh _ rts sc' rs, sc'') -> (LazyTable t th rh sy rts sc' rs, sc'')
+      let totalRows' = rowsToShow tableHeight rowHeight sy
+          offset     = Offset $ unRowsLoaded rowsLoaded
+          newRows    = Length $ totalRows' - unRowsLoaded rowsLoaded
+      if newRows > 0
+      then return . voidRunContinuationT $ do
+        xs' <- lift $ unPaginator paginator lazyTab (Page offset newRows)
+        commit . pur $ \(LazyTable t th rh _ _ _ sc' _, sc'') -> (LazyTable t th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') sc' (toRows xs'), sc'')
+      else return . pur $ \(LazyTable t th rh _ rts rl sc' rs, sc'') -> (LazyTable t th rh sy rts rl sc' rs, sc'')
 
     fakeHeightStyle =
       "height: " <> pack (show (totalRows * rowHeight')) <> "px;"
@@ -224,25 +329,25 @@ lazyTable theme tableHeight rowHeight@(AssumedRowHeight rowHeight')
     lazyTheme :: Theme m (LazyTable a)
     lazyTheme = case theme of
       Theme tp hp hrp rp thp bp dp -> Theme
-        { tableProps = \(LazyTable xs' _ _ _ _ _ _) sc' ->
+        { tableProps = \(LazyTable xs' _ _ _ _ _ _ _) sc' ->
             second mapToLazyTableSc <$> tp xs' (fromLazySortCol sc')
-        , headProps = \(LazyTable xs' _ _ _ _ _ _) sc' ->
+        , headProps = \(LazyTable xs' _ _ _ _ _ _ _) sc' ->
             second mapToLazyTableSc <$> hp xs' (fromLazySortCol sc')
-        , htrProps = \(LazyTable xs' _ _ _ _ _ _) sc' ->
+        , htrProps = \(LazyTable xs' _ _ _ _ _ _ _) sc' ->
             second mapToLazyTableSc <$> hrp xs' (fromLazySortCol sc')
-        , trProps = \(LazyTable xs' _ _ _ rts _ _) sc' r ->
+        , trProps = \(LazyTable xs' _ _ _ rts _ _ _) sc' r ->
             case r of
               LazyRow r' -> second mapToLazyTableSc <$> rp xs' (fromLazySortCol sc') r'
               FakeRow -> [("style", textProp (fakeRowHeightStyle (countRows xs') rts))]
-        , thProps = \(LazyTable xs' _ _ _ _ _ _) sc' (LazyColumn c') ->
+        , thProps = \(LazyTable xs' _ _ _ _ _ _ _) sc' (LazyColumn c') ->
             second mapToLazyTableSc <$> thp xs' (fromLazySortCol sc') c'
-        , bodyProps = \(LazyTable xs' _ _ _ _ _ _) sc' ->
+        , bodyProps = \(LazyTable xs' _ _ _ _ rowsLoaded' _ _) sc' ->
             (second mapToLazyTableSc <$> bp xs' (fromLazySortCol sc'))
             ++
             (case scrollConfig of
               ContainerIsScrollable _ -> []
-              TbodyIsScrollable debounceScroll -> [ listenRaw "scroll" $ debounceScroll scrollHandlerTbody ])
-        , tdProps = \(LazyTable xs' _ _ _ _ _ _) sc' r (LazyColumn c') ->
+              TbodyIsScrollable debounceScroll -> [ listenRaw "scroll" $ debounceScroll (scrollHandlerTbody rowsLoaded') ])
+        , tdProps = \(LazyTable xs' _ _ _ _ _ _ _) sc' r (LazyColumn c') ->
             case r of
               LazyRow r' -> second mapToLazyTable <$> dp xs' (fromLazySortCol sc') r' c'
               FakeRow -> [] }
-- 
GitLab


From 1bc0baeb7465c524c51c322a9362325d7654ab5e Mon Sep 17 00:00:00 2001
From: Morgan Thomas <morgan.a.s.thomas@gmail.com>
Date: Tue, 27 Apr 2021 14:30:36 -0400
Subject: [PATCH 2/9] add To/FromHttpApiData instances for Page

---
 widgets/Shpadoinkle-widgets.cabal         |  3 +++
 widgets/Shpadoinkle/Widgets/Table/Lazy.hs | 20 +++++++++++++++++---
 2 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/widgets/Shpadoinkle-widgets.cabal b/widgets/Shpadoinkle-widgets.cabal
index 2758ebe6..dfd74bd4 100644
--- a/widgets/Shpadoinkle-widgets.cabal
+++ b/widgets/Shpadoinkle-widgets.cabal
@@ -63,14 +63,17 @@ library
   build-depends:
       Shpadoinkle
     , Shpadoinkle-html
+    , attoparsec >=0.13 && <0.15
     , aeson >=1.4.4 && <1.6
     , base >=4.12.0 && <4.16
     , compactable >=0.1.2 && <0.2
     , containers >=0.6.0 && <0.7
     , edit-distance >=0.2.2 && <0.3
+    , either >=5.0 && <5.1
     , email-validate >=2.3.2 && <2.4
     , jsaddle >=0.9.7 && <0.20
     , mtl >=2.2.2 && <2.3
+    , servant >=0.16 && <0.19
     , stm >=2.5.0 && <2.6
     , template-haskell >=2.14.0 && <2.17
     , text >=1.2.3 && <1.3
diff --git a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
index 5afca37f..26b82954 100644
--- a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
+++ b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
@@ -32,13 +32,16 @@ import           Prelude                     hiding (div)
 import           Control.Arrow               (second)
 import           Control.Monad.Trans.Class   (lift)
 import           Data.Aeson
+import qualified Data.Attoparsec.Text        as A
+import           Data.Either.Combinators     (mapLeft)
 import           Data.List                   (sortBy)
 import           Data.Maybe                  (fromMaybe)
 import           Data.Proxy
 import           Data.Text                   hiding (filter, find, take)
 import           GHC.Generics
-
 import           Language.Javascript.JSaddle hiding (JSM, MonadJSM)
+import           Servant.API                 (ToHttpApiData (..), FromHttpApiData (..))
+
 import           Shpadoinkle
 import           Shpadoinkle.Html            (div)
 import           Shpadoinkle.Widgets.Table
@@ -198,7 +201,7 @@ rowsToShow (AssumedTableHeight height) (AssumedRowHeight rowHeight) (CurrentScro
 
 
 newtype Offset = Offset Int
-  deriving (Eq, Ord, Generic, Read, Show, Num, Enum, Real, Integral)
+  deriving (Eq, Ord, Generic, Read, Show, Num, Enum, Real, Integral, ToHttpApiData, FromHttpApiData)
 
 instance ToJSON    Offset
 instance FromJSON  Offset
@@ -207,7 +210,7 @@ instance FromJSVal Offset
 
 
 newtype Length = Length Int
-  deriving (Eq, Ord, Generic, Read, Show, Num, Enum, Real, Integral)
+  deriving (Eq, Ord, Generic, Read, Show, Num, Enum, Real, Integral, ToHttpApiData, FromHttpApiData)
 
 instance ToJSON    Length
 instance FromJSON  Length
@@ -223,6 +226,17 @@ instance FromJSON  Page
 instance ToJSVal   Page
 instance FromJSVal Page
 
+instance ToHttpApiData Page where
+  toUrlPiece (Page off len) = toUrlPiece off <> "," <> toUrlPiece len
+  toQueryParam pg = toUrlPiece pg
+
+instance FromHttpApiData Page where
+  parseUrlPiece = (mapLeft pack .) . A.parseOnly $ do
+    off <- Offset <$> A.signed A.decimal
+    _ <- A.char ','
+    len <- Length <$> A.signed A.decimal
+    return $ Page off len
+
 
 -- A Paginator takes a tabular data type and a page and returns an action which yields a new tabular value with the values in the given page range included.
 newtype Paginator m a = Paginator { unPaginator :: a -> Page -> m a }
-- 
GitLab


From e5ef341a2359a46d2b649d113422022cebd16d38 Mon Sep 17 00:00:00 2001
From: Morgan Thomas <morgan.a.s.thomas@gmail.com>
Date: Wed, 28 Apr 2021 07:42:37 -0400
Subject: [PATCH 3/9] usability improvements

---
 widgets/Shpadoinkle/Widgets/Table/Lazy.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
index 26b82954..4d5fedba 100644
--- a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
+++ b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
@@ -21,6 +21,8 @@ module Shpadoinkle.Widgets.Table.Lazy
   , Offset (..)
   , Length (..)
   , Page (..)
+  , RowsToShow (..)
+  , RowsLoaded (..)
   , Paginator (..)
   , lazyLoadingTable
   , lazyTable
@@ -286,7 +288,7 @@ lazyLoadingTable :: forall m a b.
   , Bounded  (Column a)
   , Ord      (Column a)
   , Enum     (Column a) )
-  => Paginator m (LazyTable a)
+  => Paginator m a
   -> RowsLoaded
   -> Theme m a
   -> AssumedTableHeight
@@ -330,8 +332,8 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
           newRows    = Length $ totalRows' - unRowsLoaded rowsLoaded
       if newRows > 0
       then return . voidRunContinuationT $ do
-        xs' <- lift $ unPaginator paginator lazyTab (Page offset newRows)
-        commit . pur $ \(LazyTable t th rh _ _ _ sc' _, sc'') -> (LazyTable t th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') sc' (toRows xs'), sc'')
+        xs' <- lift $ unPaginator paginator xs (Page offset newRows)
+        commit . pur $ \(LazyTable t th rh _ _ _ sc' _, sc'') -> (LazyTable t th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') sc' (LazyRow <$> toRows xs'), sc'')
       else return . pur $ \(LazyTable t th rh _ rts rl sc' rs, sc'') -> (LazyTable t th rh sy rts rl sc' rs, sc'')
 
     fakeHeightStyle =
-- 
GitLab


From 5307661a17061754c802f3c9a70746342987a89e Mon Sep 17 00:00:00 2001
From: Morgan Thomas <morgan.a.s.thomas@gmail.com>
Date: Wed, 28 Apr 2021 08:09:22 -0400
Subject: [PATCH 4/9] bugfix

---
 widgets/Shpadoinkle/Widgets/Table/Lazy.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
index 4d5fedba..4cd27e3e 100644
--- a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
+++ b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
@@ -333,7 +333,7 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
       if newRows > 0
       then return . voidRunContinuationT $ do
         xs' <- lift $ unPaginator paginator xs (Page offset newRows)
-        commit . pur $ \(LazyTable t th rh _ _ _ sc' _, sc'') -> (LazyTable t th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') sc' (LazyRow <$> toRows xs'), sc'')
+        commit . pur $ \(LazyTable _ th rh _ _ _ sc' _, sc'') -> (LazyTable xs' th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') sc' (LazyRow <$> toRows xs'), sc'')
       else return . pur $ \(LazyTable t th rh _ rts rl sc' rs, sc'') -> (LazyTable t th rh sy rts rl sc' rs, sc'')
 
     fakeHeightStyle =
-- 
GitLab


From 18f2907412d8f2a1971539bb9fcca9a2105fe6b7 Mon Sep 17 00:00:00 2001
From: Morgan Thomas <morgan.a.s.thomas@gmail.com>
Date: Wed, 28 Apr 2021 08:23:29 -0400
Subject: [PATCH 5/9] add sort order to paginator

---
 widgets/Shpadoinkle/Widgets/Table/Lazy.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
index 4cd27e3e..a87ed5eb 100644
--- a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
+++ b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
@@ -240,13 +240,13 @@ instance FromHttpApiData Page where
     return $ Page off len
 
 
--- A Paginator takes a tabular data type and a page and returns an action which yields a new tabular value with the values in the given page range included.
-newtype Paginator m a = Paginator { unPaginator :: a -> Page -> m a }
+-- A Paginator takes a tabular data type and a sort order and a page and returns an action which yields a new tabular value with the values in the given page range included.
+newtype Paginator m a = Paginator { unPaginator :: a -> SortCol a -> Page -> m a }
 
 
 -- A trivialPaginator is a no-op paginator, for when the data is all there already.
 trivialPaginator :: Applicative m => Paginator m a
-trivialPaginator = Paginator (\x _ -> pure x)
+trivialPaginator = Paginator (\x _ _ -> pure x)
 
 
 lazyTable :: forall m a b.
@@ -332,7 +332,7 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
           newRows    = Length $ totalRows' - unRowsLoaded rowsLoaded
       if newRows > 0
       then return . voidRunContinuationT $ do
-        xs' <- lift $ unPaginator paginator xs (Page offset newRows)
+        xs' <- lift $ unPaginator paginator xs sc (Page offset newRows)
         commit . pur $ \(LazyTable _ th rh _ _ _ sc' _, sc'') -> (LazyTable xs' th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') sc' (LazyRow <$> toRows xs'), sc'')
       else return . pur $ \(LazyTable t th rh _ rts rl sc' rs, sc'') -> (LazyTable t th rh sy rts rl sc' rs, sc'')
 
-- 
GitLab


From 3a435e117ebc8fda630f8e9ac45df72485d04df3 Mon Sep 17 00:00:00 2001
From: Morgan Thomas <morgan.a.s.thomas@gmail.com>
Date: Wed, 28 Apr 2021 08:48:55 -0400
Subject: [PATCH 6/9] HttpApiData instances for SortCol

---
 widgets/Shpadoinkle-widgets.cabal    |  1 +
 widgets/Shpadoinkle/Widgets/Table.hs | 10 ++++++++++
 2 files changed, 11 insertions(+)

diff --git a/widgets/Shpadoinkle-widgets.cabal b/widgets/Shpadoinkle-widgets.cabal
index dfd74bd4..d0aeb271 100644
--- a/widgets/Shpadoinkle-widgets.cabal
+++ b/widgets/Shpadoinkle-widgets.cabal
@@ -66,6 +66,7 @@ library
     , attoparsec >=0.13 && <0.15
     , aeson >=1.4.4 && <1.6
     , base >=4.12.0 && <4.16
+    , bytestring >=0.10.8 && <0.12
     , compactable >=0.1.2 && <0.2
     , containers >=0.6.0 && <0.7
     , edit-distance >=0.2.2 && <0.3
diff --git a/widgets/Shpadoinkle/Widgets/Table.hs b/widgets/Shpadoinkle/Widgets/Table.hs
index 88d199b9..c6d2658f 100644
--- a/widgets/Shpadoinkle/Widgets/Table.hs
+++ b/widgets/Shpadoinkle/Widgets/Table.hs
@@ -31,11 +31,14 @@ module Shpadoinkle.Widgets.Table
 
 import           Control.Arrow             (second)
 import           Data.Aeson
+import qualified Data.ByteString.Lazy      as BSL
 import           Data.Kind
 import           Data.List                 (sortBy)
 import           Data.Proxy
 import           Data.Text
+import           Data.Text.Encoding        (decodeUtf8, encodeUtf8)
 import           GHC.Generics
+import           Servant.API               (ToHttpApiData (..), FromHttpApiData (..))
 
 import           Shpadoinkle
 import           Shpadoinkle.Html          hiding (a, a', max, min, s, s', u,
@@ -68,6 +71,13 @@ instance NFData (Column a) => NFData (SortCol a)
 instance (ToJSON   (Column a)) => ToJSON   (SortCol a)
 instance (FromJSON (Column a)) => FromJSON (SortCol a)
 
+instance ToJSON (Column a) => ToHttpApiData (SortCol a) where
+  toUrlPiece = decodeUtf8 . BSL.toStrict . encode
+  toQueryParam = toUrlPiece
+
+instance FromJSON (Column a) => FromHttpApiData (SortCol a) where
+  parseUrlPiece = maybe (Left "could not decode SortCol JSON") Right . decode . BSL.fromStrict . encodeUtf8
+
 
 instance Ord (Column a) => Semigroup (SortCol a) where
   SortCol a s <> SortCol a' s' = SortCol (max a a') (min s s')
-- 
GitLab


From 4f42c74c0a062d012d6f5eff64c5323852b535e8 Mon Sep 17 00:00:00 2001
From: Morgan Thomas <morgan.a.s.thomas@gmail.com>
Date: Wed, 28 Apr 2021 10:14:22 -0400
Subject: [PATCH 7/9] wip fetch on sort

---
 widgets/Shpadoinkle/Widgets/Table.hs      | 10 +++-
 widgets/Shpadoinkle/Widgets/Table/Lazy.hs | 72 +++++++++++++----------
 2 files changed, 49 insertions(+), 33 deletions(-)

diff --git a/widgets/Shpadoinkle/Widgets/Table.hs b/widgets/Shpadoinkle/Widgets/Table.hs
index c6d2658f..945a70f2 100644
--- a/widgets/Shpadoinkle/Widgets/Table.hs
+++ b/widgets/Shpadoinkle/Widgets/Table.hs
@@ -60,7 +60,7 @@ negateSort ASC  = DESC
 negateSort DESC = ASC
 
 
-data SortCol a = SortCol (Column a) Sort
+data SortCol m a = SortCol (Column a) Sort
 deriving instance Show (Column a) => Show (SortCol a)
 deriving instance Read (Column a) => Read (SortCol a)
 deriving instance Eq   (Column a) => Eq   (SortCol a)
@@ -111,6 +111,8 @@ class Tabular a where
   ascendingIcon _ = text "↑"
   descendingIcon :: Functor m => Effect a m => Proxy a -> Html m (a, SortCol a)
   descendingIcon _ = text "↓"
+  handleSort     :: Effect a m => a -> SortCol a -> Continuation m (a, SortCol a)
+  handleSort  _ _  = pur id
 
 
 toggleSort :: Eq (Column a) => Column a -> SortCol a -> SortCol a
@@ -175,7 +177,11 @@ viewWith Theme {..} xs s@(SortCol sorton sortorder) =
 
   addDisplayNoneStyle = (<> [("style",  textProp "display: none")])
 
-  cth_ c = th (thProps xs s c) . pure . Html.a [ second rightC . onClick $ toggleSort c ]
+  cth_ c = th (thProps xs s c) . pure . Html.a
+              [ onClickC . voidRunContinuationT $ do
+                  commit . pur . second $ toggleSort c
+                  commit . kleisli $ \(xs', s') -> return $ handleSort xs' s'
+              ]
          . mappend [ text (humanize c) ] . pure $
           if c == sorton then
             case sortorder of ASC -> ascendingIcon Proxy; DESC -> descendingIcon Proxy
diff --git a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
index a87ed5eb..af64e789 100644
--- a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
+++ b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE UndecidableInstances       #-}
 {-# OPTIONS_GHC -Wno-type-defaults      #-}
 
 
@@ -60,7 +61,7 @@ class Tabular a => LazyTabular a where
   countRows :: a -> Int
 
 
-data LazyTable a = LazyTable a AssumedTableHeight AssumedRowHeight CurrentScrollY RowsToShow RowsLoaded (SortCol a) [Row (LazyTable a)]
+data LazyTable m a = LazyTable a AssumedTableHeight AssumedRowHeight CurrentScrollY RowsToShow RowsLoaded (Paginator m a) (SortCol a) [Row (LazyTable m a)]
 
 
 newtype RowsToShow = RowsToShow { unRowsToShow :: Int }
@@ -81,38 +82,42 @@ instance ToJSVal   RowsLoaded
 instance FromJSVal RowsLoaded
 
 
-data instance (Row (LazyTable a)) = LazyRow (Row a) | FakeRow
+data instance (Row (LazyTable m a)) = LazyRow (Row a) | FakeRow
 
 
-newtype instance (Column (LazyTable a)) = LazyColumn (Column a)
+newtype instance (Column (LazyTable m a)) = LazyColumn (Column a)
 
 
-instance Humanize (Column a) => Humanize (Column (LazyTable a)) where
+unLazySortCol :: SortCol (LazyTable m a) -> SortCol a
+unLazySortCol (SortCol (LazyColumn col) ord) = SortCol col ord
+
+
+instance Humanize (Column a) => Humanize (Column (LazyTable m a)) where
   humanize (LazyColumn c) = humanize c
 
 
-instance Bounded (Column a) => Bounded (Column (LazyTable a)) where
+instance Bounded (Column a) => Bounded (Column (LazyTable m a)) where
   minBound = LazyColumn minBound
   maxBound = LazyColumn maxBound
 
 
-instance Eq (Column a) => Eq (Column (LazyTable a)) where
+instance Eq (Column a) => Eq (Column (LazyTable m a)) where
   (LazyColumn a) == (LazyColumn b) = a == b
 
 
-instance Enum (Column a) => Enum (Column (LazyTable a)) where
+instance Enum (Column a) => Enum (Column (LazyTable m a)) where
   toEnum = LazyColumn . toEnum
   fromEnum (LazyColumn c) = fromEnum c
 
 
-instance Ord (Column a) => Ord (Column (LazyTable a)) where
+instance Ord (Column a) => Ord (Column (LazyTable m a)) where
   compare (LazyColumn a) (LazyColumn b) = compare a b
 
 
-instance Tabular a => Tabular (LazyTable a) where
-  type Effect (LazyTable a) m = Effect a m
-  toRows (LazyTable _ _ _ _ _ _ _ rows) = rows ++ [FakeRow]
-  toCell (LazyTable xs _ _ _ _ _ _ _) (LazyRow r) (LazyColumn c) =
+instance ( Tabular a, Monad m, Effect a m ) => Tabular (LazyTable m a) where
+  type Effect (LazyTable m a) m = Effect a m
+  toRows (LazyTable _ _ _ _ _ _ _ _ rows) = rows ++ [FakeRow]
+  toCell (LazyTable xs _ _ _ _ _ _ _ _) (LazyRow r) (LazyColumn c) =
     mapToLazyTable <$> toCell xs r c
   toCell _ FakeRow _ = []
   sortTable sc (LazyRow a) (LazyRow b) = sortTable (fromLazySortCol sc) a b
@@ -121,6 +126,9 @@ instance Tabular a => Tabular (LazyTable a) where
   sortTable _ FakeRow _                = GT
   ascendingIcon _ = mapToLazyTableSc $ ascendingIcon Proxy
   descendingIcon _ = mapToLazyTableSc $ descendingIcon Proxy
+  handleSort (LazyTable xs th rh sy rts rl paginator _ _) sc = voidRunContinuationT $ do
+    xs' <- lift $ unPaginator paginator xs (unLazySortCol sc) (Page 0 (Length (unRowsToShow rts)))
+    commit . pur $ \(LazyTable _ th' rh' sy' rts' _ paginator' _ _, sc') -> (LazyTable xs' th' rh' sy' rts' (RowsLoaded (unRowsToShow rts)) paginator' (unLazySortCol sc') (LazyRow <$> toRows xs'), sc')
 
 
 -- Require the user to provide assumptions about the height of each row and the height of the container rather than querying the DOM for this information. Also make the assumption that all rows have equal height.
@@ -141,49 +149,50 @@ type DebounceScroll m a = (RawNode -> RawEvent -> JSM (Continuation m a))
 
 
 data LazyTableScrollConfig m a b = ContainerIsScrollable (DebounceScroll m (b, CurrentScrollY, RowsLoaded))
-                                 | TbodyIsScrollable (DebounceScroll m (LazyTable a, SortCol (LazyTable a)))
+                                 | TbodyIsScrollable (DebounceScroll m (LazyTable m a, SortCol (LazyTable m a)))
   deriving Generic
 
 
-toLazySortCol :: SortCol a -> SortCol (LazyTable a)
+toLazySortCol :: SortCol a -> SortCol (LazyTable m a)
 toLazySortCol (SortCol c' s') = SortCol (LazyColumn c') s'
 
 
-fromLazySortCol :: SortCol (LazyTable a) -> SortCol a
+fromLazySortCol :: SortCol (LazyTable m a) -> SortCol a
 fromLazySortCol (SortCol (LazyColumn c') s') = SortCol c' s'
 
 
 mapFromLazyTableSc :: Tabular a => Functor m => Continuous f
-                   => LazyTable a
-                   -> f m (LazyTable a, SortCol (LazyTable a)) -> f m ((a, SortCol a), CurrentScrollY, RowsLoaded)
-mapFromLazyTableSc (LazyTable _ tableHeight rowHeight _ _ _ _ _) = liftC
+                   => LazyTable m a
+                   -> f m (LazyTable m a, SortCol (LazyTable m a))
+                   -> f m ((a, SortCol a), CurrentScrollY, RowsLoaded)
+mapFromLazyTableSc (LazyTable _xs tableHeight rowHeight _sy _rts _rl paginator _sc _rs) = liftC
   (\(LazyTable tab _ _ sy _ rl _ _, sc') _ -> ((tab, fromLazySortCol sc'), sy, rl))
-  (\((tab, sc), sy, rl) -> ( toLazyTable tableHeight rowHeight sy rl tab sc
+  (\((tab, sc), sy, rl) -> ( toLazyTable tableHeight rowHeight sy rl tab paginator sc
                            , toLazySortCol sc ))
 
 
 mapToLazyTable :: Functor m => Continuous f => Tabular a
-               => f m a -> f m (LazyTable a)
+               => f m a -> f m (LazyTable m a)
 mapToLazyTable = liftC
-  (\tab (LazyTable _ tableHeight rowHeight scrollY _ rowsLoaded sc _)
-    -> toLazyTable tableHeight rowHeight scrollY rowsLoaded tab sc)
+  (\tab (LazyTable _ tableHeight rowHeight scrollY _ rowsLoaded paginator sc _)
+    -> toLazyTable tableHeight rowHeight scrollY rowsLoaded paginator tab sc)
   (\(LazyTable tab _ _ _ _ _ _ _) -> tab)
 
 
 mapToLazyTableSc :: Functor m => Continuous f => Tabular a
-                 => f m (a, SortCol a) -> f m (LazyTable a, SortCol (LazyTable a))
+                 => f m (a, SortCol a) -> f m (LazyTable m a, SortCol (LazyTable m a))
 mapToLazyTableSc = liftC
-  (\(tab, sc) (LazyTable _ tableHeight rowHeight scrollY _ rowsLoaded _ _, _)
-    -> ( toLazyTable tableHeight rowHeight scrollY rowsLoaded tab sc
+  (\(tab, sc) (LazyTable _ tableHeight rowHeight scrollY _ rowsLoaded paginator _ _, _)
+    -> ( toLazyTable tableHeight rowHeight scrollY rowsLoaded paginator tab sc
        , toLazySortCol sc ))
-  (\(LazyTable tab _ _ _ _ _ _ _, sc) -> (tab, fromLazySortCol sc))
+  (\(LazyTable tab _ _ _ _ _ _ _ _, sc) -> (tab, fromLazySortCol sc))
 
 
 toLazyTable :: Tabular a
   => AssumedTableHeight -> AssumedRowHeight -> CurrentScrollY
-  -> RowsLoaded -> a -> SortCol a -> LazyTable a
-toLazyTable tabh rowh sy rowsLoaded xs sc
-  = LazyTable xs tabh rowh sy (RowsToShow numRows) rowsLoaded sc
+  -> RowsLoaded -> Paginator m a -> a -> SortCol a -> LazyTable m a
+toLazyTable tabh rowh sy rowsLoaded paginator xs sc
+  = LazyTable xs tabh rowh sy (RowsToShow numRows) rowsLoaded paginator sc
                  . fmap LazyRow
                  . take numRows
                  . sortBy (sortTable sc)
@@ -294,7 +303,8 @@ lazyLoadingTable :: forall m a b.
   -> AssumedTableHeight
   -> AssumedRowHeight
   -> LazyTableScrollConfig m a b
-  -> (Html m ((a, SortCol a), CurrentScrollY, RowsLoaded) -> Html m (b, CurrentScrollY, RowsLoaded))
+  -> (Html m ((a, SortCol a), CurrentScrollY, RowsLoaded)
+       -> Html m (b, CurrentScrollY, RowsLoaded))
   -> a
   -> SortCol a
   -> CurrentScrollY
@@ -333,7 +343,7 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
       if newRows > 0
       then return . voidRunContinuationT $ do
         xs' <- lift $ unPaginator paginator xs sc (Page offset newRows)
-        commit . pur $ \(LazyTable _ th rh _ _ _ sc' _, sc'') -> (LazyTable xs' th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') sc' (LazyRow <$> toRows xs'), sc'')
+        commit . pur $ \(LazyTable _ th rh _ _ _ _ _, sc') -> (LazyTable xs' th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') sc' (LazyRow <$> toRows xs'), sc')
       else return . pur $ \(LazyTable t th rh _ rts rl sc' rs, sc'') -> (LazyTable t th rh sy rts rl sc' rs, sc'')
 
     fakeHeightStyle =
-- 
GitLab


From 17641abd5c741048b0b1e96439cb097c1e485f1f Mon Sep 17 00:00:00 2001
From: Morgan Thomas <morgan.a.s.thomas@gmail.com>
Date: Wed, 28 Apr 2021 10:37:20 -0400
Subject: [PATCH 8/9] fetch on sort

---
 widgets/Shpadoinkle/Widgets/Table.hs      |  98 +++++++++----------
 widgets/Shpadoinkle/Widgets/Table/Lazy.hs | 114 +++++++++++-----------
 2 files changed, 107 insertions(+), 105 deletions(-)

diff --git a/widgets/Shpadoinkle/Widgets/Table.hs b/widgets/Shpadoinkle/Widgets/Table.hs
index 945a70f2..6d0c6097 100644
--- a/widgets/Shpadoinkle/Widgets/Table.hs
+++ b/widgets/Shpadoinkle/Widgets/Table.hs
@@ -60,33 +60,33 @@ negateSort ASC  = DESC
 negateSort DESC = ASC
 
 
-data SortCol m a = SortCol (Column a) Sort
-deriving instance Show (Column a) => Show (SortCol a)
-deriving instance Read (Column a) => Read (SortCol a)
-deriving instance Eq   (Column a) => Eq   (SortCol a)
-deriving instance Ord  (Column a) => Ord  (SortCol a)
-deriving instance Functor Column => Functor SortCol
-deriving instance Generic (SortCol a)
-instance NFData (Column a) => NFData (SortCol a)
-instance (ToJSON   (Column a)) => ToJSON   (SortCol a)
-instance (FromJSON (Column a)) => FromJSON (SortCol a)
-
-instance ToJSON (Column a) => ToHttpApiData (SortCol a) where
+data SortCol m a = SortCol (Column m a) Sort
+deriving instance Show (Column m a) => Show (SortCol m a)
+deriving instance Read (Column m a) => Read (SortCol m a)
+deriving instance Eq   (Column m a) => Eq   (SortCol m a)
+deriving instance Ord  (Column m a) => Ord  (SortCol m a)
+deriving instance Functor (Column m) => Functor (SortCol m)
+deriving instance Generic (SortCol m a)
+instance NFData (Column m a) => NFData (SortCol m a)
+instance (ToJSON   (Column m a)) => ToJSON   (SortCol m a)
+instance (FromJSON (Column m a)) => FromJSON (SortCol m a)
+
+instance ToJSON (Column m a) => ToHttpApiData (SortCol m a) where
   toUrlPiece = decodeUtf8 . BSL.toStrict . encode
   toQueryParam = toUrlPiece
 
-instance FromJSON (Column a) => FromHttpApiData (SortCol a) where
+instance FromJSON (Column m a) => FromHttpApiData (SortCol m a) where
   parseUrlPiece = maybe (Left "could not decode SortCol JSON") Right . decode . BSL.fromStrict . encodeUtf8
 
 
-instance Ord (Column a) => Semigroup (SortCol a) where
+instance Ord (Column m a) => Semigroup (SortCol m a) where
   SortCol a s <> SortCol a' s' = SortCol (max a a') (min s s')
 
 
-instance ( Bounded (Column a)
-         , Ord (Column a)
-         , Enum (Column a)
-         ) => Monoid (SortCol a) where
+instance ( Bounded (Column m a)
+         , Ord (Column m a)
+         , Enum (Column m a)
+         ) => Monoid (SortCol m a) where
   mempty = SortCol minBound maxBound
 
 
@@ -95,38 +95,38 @@ compareOn DESC = compare
 compareOn ASC  = flip compare
 
 
-data family Column (a :: Type) :: Type
-data family Row    (a :: Type) :: Type
+data family Column (m :: Type -> Type) (a :: Type) :: Type
+data family Row    (m :: Type -> Type) (a :: Type) :: Type
 
 
-class Tabular a where
+class Tabular m a where
   type Effect a (m :: Type -> Type) :: Constraint
   type Effect a m = Applicative m
-  toRows         :: a -> [Row a]
-  toFilter       :: a -> (Row a -> Bool)
+  toRows         :: a -> [Row m a]
+  toFilter       :: a -> (Row m a -> Bool)
   toFilter = const (const True)
-  toCell         :: Functor m => Effect a m => a -> Row a -> Column a -> [Html m a]
-  sortTable      :: SortCol a -> Row a -> Row a -> Ordering
-  ascendingIcon  :: Functor m => Effect a m => Proxy a -> Html m (a, SortCol a)
+  toCell         :: Functor m => Effect a m => a -> Row m a -> Column m a -> [Html m a]
+  sortTable      :: SortCol m a -> Row m a -> Row m a -> Ordering
+  ascendingIcon  :: Functor m => Effect a m => Proxy a -> Html m (a, SortCol m a)
   ascendingIcon _ = text "↑"
-  descendingIcon :: Functor m => Effect a m => Proxy a -> Html m (a, SortCol a)
+  descendingIcon :: Functor m => Effect a m => Proxy a -> Html m (a, SortCol m a)
   descendingIcon _ = text "↓"
-  handleSort     :: Effect a m => a -> SortCol a -> Continuation m (a, SortCol a)
+  handleSort     :: Effect a m => a -> SortCol m a -> Continuation m (a, SortCol m a)
   handleSort  _ _  = pur id
 
 
-toggleSort :: Eq (Column a) => Column a -> SortCol a -> SortCol a
+toggleSort :: Eq (Column m a) => Column m a -> SortCol m a -> SortCol m a
 toggleSort c (SortCol c' s) = if c == c' then SortCol c $ negateSort s else SortCol c mempty
 
 
 data Theme m a = Theme
-  { tableProps :: a -> SortCol a ->                      [(Text, Prop m (a, SortCol a))]
-  , headProps  :: a -> SortCol a ->                      [(Text, Prop m (a, SortCol a))]
-  , htrProps   :: a -> SortCol a ->                      [(Text, Prop m (a, SortCol a))]
-  , trProps    :: a -> SortCol a -> Row a ->             [(Text, Prop m (a, SortCol a))]
-  , thProps    :: a -> SortCol a ->          Column a -> [(Text, Prop m (a, SortCol a))]
-  , bodyProps  :: a -> SortCol a ->                      [(Text, Prop m (a, SortCol a))]
-  , tdProps    :: a -> SortCol a -> Row a -> Column a -> [(Text, Prop m a)]
+  { tableProps :: a -> SortCol m a ->                          [(Text, Prop m (a, SortCol m a))]
+  , headProps  :: a -> SortCol m a ->                          [(Text, Prop m (a, SortCol m a))]
+  , htrProps   :: a -> SortCol m a ->                          [(Text, Prop m (a, SortCol m a))]
+  , trProps    :: a -> SortCol m a -> Row m a ->               [(Text, Prop m (a, SortCol m a))]
+  , thProps    :: a -> SortCol m a ->            Column m a -> [(Text, Prop m (a, SortCol m a))]
+  , bodyProps  :: a -> SortCol m a ->                          [(Text, Prop m (a, SortCol m a))]
+  , tdProps    :: a -> SortCol m a -> Row m a -> Column m a -> [(Text, Prop m a)]
   } deriving Generic
 
 
@@ -138,26 +138,26 @@ instance Monoid (Theme m a) where
 
 
 view :: forall m a.
-  ( Tabular a
+  ( Tabular m a
   , Effect a m
   , Monad m
-  , Humanize (Column a)
-  , Bounded  (Column a)
-  , Ord      (Column a)
-  , Enum     (Column a) )
-  => a -> SortCol a -> Html m (a, SortCol a)
+  , Humanize (Column m a)
+  , Bounded  (Column m a)
+  , Ord      (Column m a)
+  , Enum     (Column m a) )
+  => a -> SortCol m a -> Html m (a, SortCol m a)
 view = viewWith mempty
 
 
 viewWith :: forall m a.
-  ( Tabular a
+  ( Tabular m a
   , Effect a m
   , Monad m
-  , Humanize (Column a)
-  , Bounded  (Column a)
-  , Ord      (Column a)
-  , Enum     (Column a) )
-  => Theme m a -> a -> SortCol a -> Html m (a, SortCol a)
+  , Humanize (Column m a)
+  , Bounded  (Column m a)
+  , Ord      (Column m a)
+  , Enum     (Column m a) )
+  => Theme m a -> a -> SortCol m a -> Html m (a, SortCol m a)
 viewWith Theme {..} xs s@(SortCol sorton sortorder) =
   table (tableProps xs s)
     [ thead (headProps xs s) [ tr (htrProps xs s) $ cth_ <$> [minBound..maxBound] ]
@@ -171,7 +171,7 @@ viewWith Theme {..} xs s@(SortCol sorton sortorder) =
 
   f = toFilter xs
 
-  filterRow :: Row a -> Html m (a, SortCol a) -> Html m (a, SortCol a)
+  filterRow :: Row m a -> Html m (a, SortCol m a) -> Html m (a, SortCol m a)
   filterRow row el = if f row then el
     else mapProps addDisplayNoneStyle el
 
diff --git a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
index af64e789..5759d97a 100644
--- a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
+++ b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
@@ -3,9 +3,11 @@
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE UndecidableInstances       #-}
 {-# OPTIONS_GHC -Wno-type-defaults      #-}
@@ -57,11 +59,11 @@ second3 :: (b -> b') -> (a, b, c) -> (a, b', c)
 second3 f (x, y, z) = (x, f y, z)
 
 
-class Tabular a => LazyTabular a where
-  countRows :: a -> Int
+class Tabular m a => LazyTabular m a where
+  countRows :: Proxy m -> a -> Int
 
 
-data LazyTable m a = LazyTable a AssumedTableHeight AssumedRowHeight CurrentScrollY RowsToShow RowsLoaded (Paginator m a) (SortCol a) [Row (LazyTable m a)]
+data LazyTable m a = LazyTable a AssumedTableHeight AssumedRowHeight CurrentScrollY RowsToShow RowsLoaded (Paginator m a) (SortCol m a) [Row m (LazyTable m a)]
 
 
 newtype RowsToShow = RowsToShow { unRowsToShow :: Int }
@@ -82,39 +84,39 @@ instance ToJSVal   RowsLoaded
 instance FromJSVal RowsLoaded
 
 
-data instance (Row (LazyTable m a)) = LazyRow (Row a) | FakeRow
+data instance (Row m (LazyTable m a)) = LazyRow (Row m a) | FakeRow
 
 
-newtype instance (Column (LazyTable m a)) = LazyColumn (Column a)
+newtype instance (Column m (LazyTable m a)) = LazyColumn (Column m a)
 
 
-unLazySortCol :: SortCol (LazyTable m a) -> SortCol a
+unLazySortCol :: SortCol m (LazyTable m a) -> SortCol m a
 unLazySortCol (SortCol (LazyColumn col) ord) = SortCol col ord
 
 
-instance Humanize (Column a) => Humanize (Column (LazyTable m a)) where
+instance Humanize (Column m a) => Humanize (Column m (LazyTable m a)) where
   humanize (LazyColumn c) = humanize c
 
 
-instance Bounded (Column a) => Bounded (Column (LazyTable m a)) where
+instance Bounded (Column m a) => Bounded (Column m (LazyTable m a)) where
   minBound = LazyColumn minBound
   maxBound = LazyColumn maxBound
 
 
-instance Eq (Column a) => Eq (Column (LazyTable m a)) where
+instance Eq (Column m a) => Eq (Column m (LazyTable m a)) where
   (LazyColumn a) == (LazyColumn b) = a == b
 
 
-instance Enum (Column a) => Enum (Column (LazyTable m a)) where
+instance Enum (Column m a) => Enum (Column m (LazyTable m a)) where
   toEnum = LazyColumn . toEnum
   fromEnum (LazyColumn c) = fromEnum c
 
 
-instance Ord (Column a) => Ord (Column (LazyTable m a)) where
+instance Ord (Column m a) => Ord (Column m (LazyTable m a)) where
   compare (LazyColumn a) (LazyColumn b) = compare a b
 
 
-instance ( Tabular a, Monad m, Effect a m ) => Tabular (LazyTable m a) where
+instance ( Tabular m a, Monad m, Effect a m ) => Tabular m (LazyTable m a) where
   type Effect (LazyTable m a) m = Effect a m
   toRows (LazyTable _ _ _ _ _ _ _ _ rows) = rows ++ [FakeRow]
   toCell (LazyTable xs _ _ _ _ _ _ _ _) (LazyRow r) (LazyColumn c) =
@@ -126,7 +128,7 @@ instance ( Tabular a, Monad m, Effect a m ) => Tabular (LazyTable m a) where
   sortTable _ FakeRow _                = GT
   ascendingIcon _ = mapToLazyTableSc $ ascendingIcon Proxy
   descendingIcon _ = mapToLazyTableSc $ descendingIcon Proxy
-  handleSort (LazyTable xs th rh sy rts rl paginator _ _) sc = voidRunContinuationT $ do
+  handleSort (LazyTable xs _ _ _ rts _ paginator _ _) sc = voidRunContinuationT $ do
     xs' <- lift $ unPaginator paginator xs (unLazySortCol sc) (Page 0 (Length (unRowsToShow rts)))
     commit . pur $ \(LazyTable _ th' rh' sy' rts' _ paginator' _ _, sc') -> (LazyTable xs' th' rh' sy' rts' (RowsLoaded (unRowsToShow rts)) paginator' (unLazySortCol sc') (LazyRow <$> toRows xs'), sc')
 
@@ -149,38 +151,38 @@ type DebounceScroll m a = (RawNode -> RawEvent -> JSM (Continuation m a))
 
 
 data LazyTableScrollConfig m a b = ContainerIsScrollable (DebounceScroll m (b, CurrentScrollY, RowsLoaded))
-                                 | TbodyIsScrollable (DebounceScroll m (LazyTable m a, SortCol (LazyTable m a)))
+                                 | TbodyIsScrollable (DebounceScroll m (LazyTable m a, SortCol m (LazyTable m a)))
   deriving Generic
 
 
-toLazySortCol :: SortCol a -> SortCol (LazyTable m a)
+toLazySortCol :: SortCol m a -> SortCol m (LazyTable m a)
 toLazySortCol (SortCol c' s') = SortCol (LazyColumn c') s'
 
 
-fromLazySortCol :: SortCol (LazyTable m a) -> SortCol a
+fromLazySortCol :: SortCol m (LazyTable m a) -> SortCol m a
 fromLazySortCol (SortCol (LazyColumn c') s') = SortCol c' s'
 
 
-mapFromLazyTableSc :: Tabular a => Functor m => Continuous f
+mapFromLazyTableSc :: Tabular m a => Functor m => Continuous f
                    => LazyTable m a
-                   -> f m (LazyTable m a, SortCol (LazyTable m a))
-                   -> f m ((a, SortCol a), CurrentScrollY, RowsLoaded)
+                   -> f m (LazyTable m a, SortCol m (LazyTable m a))
+                   -> f m ((a, SortCol m a), CurrentScrollY, RowsLoaded)
 mapFromLazyTableSc (LazyTable _xs tableHeight rowHeight _sy _rts _rl paginator _sc _rs) = liftC
-  (\(LazyTable tab _ _ sy _ rl _ _, sc') _ -> ((tab, fromLazySortCol sc'), sy, rl))
-  (\((tab, sc), sy, rl) -> ( toLazyTable tableHeight rowHeight sy rl tab paginator sc
+  (\(LazyTable tab _ _ sy _ rl _ _ _, sc') _ -> ((tab, fromLazySortCol sc'), sy, rl))
+  (\((tab, sc), sy, rl) -> ( toLazyTable tableHeight rowHeight sy rl paginator tab sc
                            , toLazySortCol sc ))
 
 
-mapToLazyTable :: Functor m => Continuous f => Tabular a
+mapToLazyTable :: Functor m => Continuous f => Tabular m a
                => f m a -> f m (LazyTable m a)
 mapToLazyTable = liftC
   (\tab (LazyTable _ tableHeight rowHeight scrollY _ rowsLoaded paginator sc _)
     -> toLazyTable tableHeight rowHeight scrollY rowsLoaded paginator tab sc)
-  (\(LazyTable tab _ _ _ _ _ _ _) -> tab)
+  (\(LazyTable tab _ _ _ _ _ _ _ _) -> tab)
 
 
-mapToLazyTableSc :: Functor m => Continuous f => Tabular a
-                 => f m (a, SortCol a) -> f m (LazyTable m a, SortCol (LazyTable m a))
+mapToLazyTableSc :: Functor m => Continuous f => Tabular m a
+                 => f m (a, SortCol m a) -> f m (LazyTable m a, SortCol m (LazyTable m a))
 mapToLazyTableSc = liftC
   (\(tab, sc) (LazyTable _ tableHeight rowHeight scrollY _ rowsLoaded paginator _ _, _)
     -> ( toLazyTable tableHeight rowHeight scrollY rowsLoaded paginator tab sc
@@ -188,9 +190,9 @@ mapToLazyTableSc = liftC
   (\(LazyTable tab _ _ _ _ _ _ _ _, sc) -> (tab, fromLazySortCol sc))
 
 
-toLazyTable :: Tabular a
+toLazyTable :: Tabular m a
   => AssumedTableHeight -> AssumedRowHeight -> CurrentScrollY
-  -> RowsLoaded -> Paginator m a -> a -> SortCol a -> LazyTable m a
+  -> RowsLoaded -> Paginator m a -> a -> SortCol m a -> LazyTable m a
 toLazyTable tabh rowh sy rowsLoaded paginator xs sc
   = LazyTable xs tabh rowh sy (RowsToShow numRows) rowsLoaded paginator sc
                  . fmap LazyRow
@@ -250,7 +252,7 @@ instance FromHttpApiData Page where
 
 
 -- A Paginator takes a tabular data type and a sort order and a page and returns an action which yields a new tabular value with the values in the given page range included.
-newtype Paginator m a = Paginator { unPaginator :: a -> SortCol a -> Page -> m a }
+newtype Paginator m a = Paginator { unPaginator :: a -> SortCol m a -> Page -> m a }
 
 
 -- A trivialPaginator is a no-op paginator, for when the data is all there already.
@@ -259,20 +261,20 @@ trivialPaginator = Paginator (\x _ _ -> pure x)
 
 
 lazyTable :: forall m a b.
-  ( LazyTabular a
+  ( LazyTabular m a
   , Effect a m
   , MonadJSM m
-  , Humanize (Column a)
-  , Bounded  (Column a)
-  , Ord      (Column a)
-  , Enum     (Column a) )
+  , Humanize (Column m a)
+  , Bounded  (Column m a)
+  , Ord      (Column m a)
+  , Enum     (Column m a) )
   => Theme m a
   -> AssumedTableHeight
   -> AssumedRowHeight
   -> LazyTableScrollConfig m a b
-  -> (Html m ((a, SortCol a), CurrentScrollY) -> Html m (b, CurrentScrollY))
+  -> (Html m ((a, SortCol m a), CurrentScrollY) -> Html m (b, CurrentScrollY))
   -> a
-  -> SortCol a
+  -> SortCol m a
   -> CurrentScrollY
   -> Html m (b, CurrentScrollY)
 lazyTable theme tableHeight rowHeight scrollConfig container xs sc scrollY
@@ -290,23 +292,23 @@ lazyTable theme tableHeight rowHeight scrollConfig container xs sc scrollY
 
 
 lazyLoadingTable :: forall m a b.
-  ( LazyTabular a
+  ( LazyTabular m a
   , Effect a m
   , MonadJSM m
-  , Humanize (Column a)
-  , Bounded  (Column a)
-  , Ord      (Column a)
-  , Enum     (Column a) )
+  , Humanize (Column m a)
+  , Bounded  (Column m a)
+  , Ord      (Column m a)
+  , Enum     (Column m a) )
   => Paginator m a
   -> RowsLoaded
   -> Theme m a
   -> AssumedTableHeight
   -> AssumedRowHeight
   -> LazyTableScrollConfig m a b
-  -> (Html m ((a, SortCol a), CurrentScrollY, RowsLoaded)
+  -> (Html m ((a, SortCol m a), CurrentScrollY, RowsLoaded)
        -> Html m (b, CurrentScrollY, RowsLoaded))
   -> a
-  -> SortCol a
+  -> SortCol m a
   -> CurrentScrollY
   -> Html m (b, CurrentScrollY, RowsLoaded)
 lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHeight rowHeight')
@@ -317,9 +319,9 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
   . mapFromLazyTableSc lazyTab
   $ viewWith lazyTheme lazyTab (SortCol (LazyColumn c) s)
   where
-    lazyTab@LazyTable {} = toLazyTable tableHeight rowHeight scrollY rowsLoaded xs sc
+    lazyTab@LazyTable {} = toLazyTable tableHeight rowHeight scrollY rowsLoaded paginator xs sc
 
-    totalRows = countRows xs
+    totalRows = countRows (Proxy @m) xs
 
     addContainerFakeHeight = case scrollConfig of
       ContainerIsScrollable _ -> div [("style", textProp fakeHeightStyle)] . (:[])
@@ -334,7 +336,7 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
       pur . second3 . const . CurrentScrollY . fromMaybe 0
         <$> (fromJSVal =<< n ! "scrollTop")
 
-    scrollHandlerTbody :: RowsLoaded -> RawNode -> RawEvent -> JSM (Continuation m (LazyTable a, SortCol (LazyTable a)))
+    scrollHandlerTbody :: RowsLoaded -> RawNode -> RawEvent -> JSM (Continuation m (LazyTable m a, SortCol m (LazyTable m a)))
     scrollHandlerTbody _rowsLoaded' (RawNode n) _ = do
       sy <- CurrentScrollY . fromMaybe 0 <$> (fromJSVal =<< n ! "scrollTop")
       let totalRows' = rowsToShow tableHeight rowHeight sy
@@ -343,8 +345,8 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
       if newRows > 0
       then return . voidRunContinuationT $ do
         xs' <- lift $ unPaginator paginator xs sc (Page offset newRows)
-        commit . pur $ \(LazyTable _ th rh _ _ _ _ _, sc') -> (LazyTable xs' th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') sc' (LazyRow <$> toRows xs'), sc')
-      else return . pur $ \(LazyTable t th rh _ rts rl sc' rs, sc'') -> (LazyTable t th rh sy rts rl sc' rs, sc'')
+        commit . pur $ \(LazyTable _ th rh _ _ _ paginator' _ _, sc') -> (LazyTable xs' th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') paginator' (unLazySortCol sc') (LazyRow <$> toRows xs'), sc')
+      else return . pur $ \(LazyTable t th rh _ rts rl paginator' sc' rs, sc'') -> (LazyTable t th rh sy rts rl paginator' sc' rs, sc'')
 
     fakeHeightStyle =
       "height: " <> pack (show (totalRows * rowHeight')) <> "px;"
@@ -352,28 +354,28 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
     fakeRowHeightStyle totalRows' (RowsToShow rts) =
       "height: " <> pack (show ((totalRows' - rts) * rowHeight')) <> "px;"
 
-    lazyTheme :: Theme m (LazyTable a)
+    lazyTheme :: Theme m (LazyTable m a)
     lazyTheme = case theme of
       Theme tp hp hrp rp thp bp dp -> Theme
-        { tableProps = \(LazyTable xs' _ _ _ _ _ _ _) sc' ->
+        { tableProps = \(LazyTable xs' _ _ _ _ _ _ _ _) sc' ->
             second mapToLazyTableSc <$> tp xs' (fromLazySortCol sc')
-        , headProps = \(LazyTable xs' _ _ _ _ _ _ _) sc' ->
+        , headProps = \(LazyTable xs' _ _ _ _ _ _ _ _) sc' ->
             second mapToLazyTableSc <$> hp xs' (fromLazySortCol sc')
-        , htrProps = \(LazyTable xs' _ _ _ _ _ _ _) sc' ->
+        , htrProps = \(LazyTable xs' _ _ _ _ _ _ _ _) sc' ->
             second mapToLazyTableSc <$> hrp xs' (fromLazySortCol sc')
-        , trProps = \(LazyTable xs' _ _ _ rts _ _ _) sc' r ->
+        , trProps = \(LazyTable xs' _ _ _ rts _ _ _ _) sc' r ->
             case r of
               LazyRow r' -> second mapToLazyTableSc <$> rp xs' (fromLazySortCol sc') r'
-              FakeRow -> [("style", textProp (fakeRowHeightStyle (countRows xs') rts))]
-        , thProps = \(LazyTable xs' _ _ _ _ _ _ _) sc' (LazyColumn c') ->
+              FakeRow -> [("style", textProp (fakeRowHeightStyle (countRows (Proxy @m) xs') rts))]
+        , thProps = \(LazyTable xs' _ _ _ _ _ _ _ _) sc' (LazyColumn c') ->
             second mapToLazyTableSc <$> thp xs' (fromLazySortCol sc') c'
-        , bodyProps = \(LazyTable xs' _ _ _ _ rowsLoaded' _ _) sc' ->
+        , bodyProps = \(LazyTable xs' _ _ _ _ rowsLoaded' _ _ _) sc' ->
             (second mapToLazyTableSc <$> bp xs' (fromLazySortCol sc'))
             ++
             (case scrollConfig of
               ContainerIsScrollable _ -> []
               TbodyIsScrollable debounceScroll -> [ listenRaw "scroll" $ debounceScroll (scrollHandlerTbody rowsLoaded') ])
-        , tdProps = \(LazyTable xs' _ _ _ _ _ _ _) sc' r (LazyColumn c') ->
+        , tdProps = \(LazyTable xs' _ _ _ _ _ _ _ _) sc' r (LazyColumn c') ->
             case r of
               LazyRow r' -> second mapToLazyTable <$> dp xs' (fromLazySortCol sc') r' c'
               FakeRow -> [] }
-- 
GitLab


From 2fa88d6adffc0badcf044284a5a6675a9183a0bc Mon Sep 17 00:00:00 2001
From: Morgan Thomas <morgan.a.s.thomas@gmail.com>
Date: Wed, 28 Apr 2021 11:46:41 -0400
Subject: [PATCH 9/9] use two monads to avoid an infinite type in the call site

---
 widgets/Shpadoinkle/Widgets/Table.hs      | 103 ++++++++--------
 widgets/Shpadoinkle/Widgets/Table/Lazy.hs | 137 ++++++++++++----------
 2 files changed, 126 insertions(+), 114 deletions(-)

diff --git a/widgets/Shpadoinkle/Widgets/Table.hs b/widgets/Shpadoinkle/Widgets/Table.hs
index 6d0c6097..cc7dcad0 100644
--- a/widgets/Shpadoinkle/Widgets/Table.hs
+++ b/widgets/Shpadoinkle/Widgets/Table.hs
@@ -8,10 +8,13 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE PolyKinds             #-}
+{-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE StandaloneDeriving    #-}
+{-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
 
@@ -99,88 +102,90 @@ data family Column (m :: Type -> Type) (a :: Type) :: Type
 data family Row    (m :: Type -> Type) (a :: Type) :: Type
 
 
-class Tabular m a where
-  type Effect a (m :: Type -> Type) :: Constraint
-  type Effect a m = Applicative m
-  toRows         :: a -> [Row m a]
-  toFilter       :: a -> (Row m a -> Bool)
-  toFilter = const (const True)
-  toCell         :: Functor m => Effect a m => a -> Row m a -> Column m a -> [Html m a]
-  sortTable      :: SortCol m a -> Row m a -> Row m a -> Ordering
-  ascendingIcon  :: Functor m => Effect a m => Proxy a -> Html m (a, SortCol m a)
+class Tabular m' m a where
+  type Effect a (n :: Type -> Type) :: Constraint
+  type Effect a n = Applicative n
+  toRows         :: Proxy m -> a -> [Row m' a]
+  toFilter       :: Proxy m -> a -> (Row m' a -> Bool)
+  toFilter _ = const (const True)
+  toCell         :: Functor m => Effect a m' => a -> Row m' a -> Column m' a -> [Html m a]
+  sortTable      :: Proxy m -> SortCol m' a -> Row m' a -> Row m' a -> Ordering
+  ascendingIcon  :: Functor m => Effect a m' => Proxy a -> Html m (a, SortCol m' a)
   ascendingIcon _ = text "↑"
-  descendingIcon :: Functor m => Effect a m => Proxy a -> Html m (a, SortCol m a)
+  descendingIcon :: Functor m => Effect a m' => Proxy a -> Html m (a, SortCol m' a)
   descendingIcon _ = text "↓"
-  handleSort     :: Effect a m => a -> SortCol m a -> Continuation m (a, SortCol m a)
-  handleSort  _ _  = pur id
+  handleSort     :: Effect a m' => Proxy m -> a -> SortCol m' a -> Continuation m' (a, SortCol m' a)
+  handleSort _ _ _ = pur id
 
 
 toggleSort :: Eq (Column m a) => Column m a -> SortCol m a -> SortCol m a
 toggleSort c (SortCol c' s) = if c == c' then SortCol c $ negateSort s else SortCol c mempty
 
 
-data Theme m a = Theme
-  { tableProps :: a -> SortCol m a ->                          [(Text, Prop m (a, SortCol m a))]
-  , headProps  :: a -> SortCol m a ->                          [(Text, Prop m (a, SortCol m a))]
-  , htrProps   :: a -> SortCol m a ->                          [(Text, Prop m (a, SortCol m a))]
-  , trProps    :: a -> SortCol m a -> Row m a ->               [(Text, Prop m (a, SortCol m a))]
-  , thProps    :: a -> SortCol m a ->            Column m a -> [(Text, Prop m (a, SortCol m a))]
-  , bodyProps  :: a -> SortCol m a ->                          [(Text, Prop m (a, SortCol m a))]
-  , tdProps    :: a -> SortCol m a -> Row m a -> Column m a -> [(Text, Prop m a)]
+data Theme m' m a = Theme
+  { tableProps :: a -> SortCol m' a ->                            [(Text, Prop m (a, SortCol m' a))]
+  , headProps  :: a -> SortCol m' a ->                            [(Text, Prop m (a, SortCol m' a))]
+  , htrProps   :: a -> SortCol m' a ->                            [(Text, Prop m (a, SortCol m' a))]
+  , trProps    :: a -> SortCol m' a -> Row m' a ->                [(Text, Prop m (a, SortCol m' a))]
+  , thProps    :: a -> SortCol m' a ->             Column m' a -> [(Text, Prop m (a, SortCol m' a))]
+  , bodyProps  :: a -> SortCol m' a ->                            [(Text, Prop m (a, SortCol m' a))]
+  , tdProps    :: a -> SortCol m' a -> Row m' a -> Column m' a -> [(Text, Prop m a)]
   } deriving Generic
 
 
-instance Semigroup (Theme m a) where
+instance Semigroup (Theme m' m a) where
   Theme t u v w x y z <> Theme t' u' v' w' x' y' z' =
     Theme (t <> t') (u <> u') (v <> v') (w <> w') (x <> x') (y <> y') (z <> z')
-instance Monoid (Theme m a) where
+instance Monoid (Theme m' m a) where
   mempty = Theme mempty mempty mempty mempty mempty mempty mempty
 
 
-view :: forall m a.
-  ( Tabular m a
-  , Effect a m
-  , Monad m
-  , Humanize (Column m a)
-  , Bounded  (Column m a)
-  , Ord      (Column m a)
-  , Enum     (Column m a) )
-  => a -> SortCol m a -> Html m (a, SortCol m a)
-view = viewWith mempty
-
-
-viewWith :: forall m a.
-  ( Tabular m a
-  , Effect a m
-  , Monad m
-  , Humanize (Column m a)
-  , Bounded  (Column m a)
-  , Ord      (Column m a)
-  , Enum     (Column m a) )
-  => Theme m a -> a -> SortCol m a -> Html m (a, SortCol m a)
-viewWith Theme {..} xs s@(SortCol sorton sortorder) =
+view :: forall m m' a.
+  ( Tabular m' m a
+  , Effect a m'
+  , Monad m'
+  , Functor m
+  , Humanize (Column m' a)
+  , Bounded  (Column m' a)
+  , Ord      (Column m' a)
+  , Enum     (Column m' a) )
+  => (m' ~> m) -> a -> SortCol m' a -> Html m (a, SortCol m' a)
+view lft = viewWith lft mempty
+
+
+viewWith :: forall m' m a.
+  ( Tabular m' m a
+  , Effect a m'
+  , Monad m'
+  , Functor m
+  , Humanize (Column m' a)
+  , Bounded  (Column m' a)
+  , Ord      (Column m' a)
+  , Enum     (Column m' a) )
+  => (m' ~> m) -> Theme m' m a -> a -> SortCol m' a -> Html m (a, SortCol m' a)
+viewWith lft Theme {..} xs s@(SortCol sorton sortorder) =
   table (tableProps xs s)
     [ thead (headProps xs s) [ tr (htrProps xs s) $ cth_ <$> [minBound..maxBound] ]
     , tbody (bodyProps xs s) $ do
-        row <- sortBy (sortTable s) (toRows xs)
+        row <- sortBy (sortTable (Proxy @m) s) (toRows (Proxy @m) xs)
         return . filterRow row . tr (trProps xs s row) . fmap leftC $
           (\c -> td (tdProps xs s row c) $ toCell xs row c) <$> [minBound..maxBound]
     ]
 
   where
 
-  f = toFilter xs
+  f = toFilter (Proxy @m) xs
 
-  filterRow :: Row m a -> Html m (a, SortCol m a) -> Html m (a, SortCol m a)
+  filterRow :: Row m' a -> Html m (a, SortCol m' a) -> Html m (a, SortCol m' a)
   filterRow row el = if f row then el
     else mapProps addDisplayNoneStyle el
 
   addDisplayNoneStyle = (<> [("style",  textProp "display: none")])
 
   cth_ c = th (thProps xs s c) . pure . Html.a
-              [ onClickC . voidRunContinuationT $ do
+              [ onClickC . hoist lft . voidRunContinuationT $ do
                   commit . pur . second $ toggleSort c
-                  commit . kleisli $ \(xs', s') -> return $ handleSort xs' s'
+                  commit . kleisli $ \(xs', s') -> return $ handleSort (Proxy @m) xs' s'
               ]
          . mappend [ text (humanize c) ] . pure $
           if c == sorton then
diff --git a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
index 5759d97a..656808e8 100644
--- a/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
+++ b/widgets/Shpadoinkle/Widgets/Table/Lazy.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE UndecidableInstances       #-}
 {-# OPTIONS_GHC -Wno-type-defaults      #-}
@@ -59,8 +60,8 @@ second3 :: (b -> b') -> (a, b, c) -> (a, b', c)
 second3 f (x, y, z) = (x, f y, z)
 
 
-class Tabular m a => LazyTabular m a where
-  countRows :: Proxy m -> a -> Int
+class Tabular m' m a => LazyTabular m' m a where
+  countRows :: Proxy m' -> Proxy m -> a -> Int
 
 
 data LazyTable m a = LazyTable a AssumedTableHeight AssumedRowHeight CurrentScrollY RowsToShow RowsLoaded (Paginator m a) (SortCol m a) [Row m (LazyTable m a)]
@@ -116,21 +117,21 @@ instance Ord (Column m a) => Ord (Column m (LazyTable m a)) where
   compare (LazyColumn a) (LazyColumn b) = compare a b
 
 
-instance ( Tabular m a, Monad m, Effect a m ) => Tabular m (LazyTable m a) where
-  type Effect (LazyTable m a) m = Effect a m
-  toRows (LazyTable _ _ _ _ _ _ _ _ rows) = rows ++ [FakeRow]
+instance ( Tabular m' m a, Monad m, Monad m', Effect a m ) => Tabular m' m (LazyTable m' a) where
+  type Effect (LazyTable m' a) n = Effect a n
+  toRows _ (LazyTable _ _ _ _ _ _ _ _ rows) = rows ++ [FakeRow]
   toCell (LazyTable xs _ _ _ _ _ _ _ _) (LazyRow r) (LazyColumn c) =
     mapToLazyTable <$> toCell xs r c
   toCell _ FakeRow _ = []
-  sortTable sc (LazyRow a) (LazyRow b) = sortTable (fromLazySortCol sc) a b
-  sortTable _ FakeRow FakeRow          = EQ
-  sortTable _ _ FakeRow                = LT
-  sortTable _ FakeRow _                = GT
+  sortTable pxy sc (LazyRow a) (LazyRow b) = sortTable pxy (fromLazySortCol sc) a b
+  sortTable _ _ FakeRow FakeRow          = EQ
+  sortTable _ _ _ FakeRow                = LT
+  sortTable _ _ FakeRow _                = GT
   ascendingIcon _ = mapToLazyTableSc $ ascendingIcon Proxy
   descendingIcon _ = mapToLazyTableSc $ descendingIcon Proxy
-  handleSort (LazyTable xs _ _ _ rts _ paginator _ _) sc = voidRunContinuationT $ do
+  handleSort pxy (LazyTable xs _ _ _ rts _ paginator _ _) sc = voidRunContinuationT $ do
     xs' <- lift $ unPaginator paginator xs (unLazySortCol sc) (Page 0 (Length (unRowsToShow rts)))
-    commit . pur $ \(LazyTable _ th' rh' sy' rts' _ paginator' _ _, sc') -> (LazyTable xs' th' rh' sy' rts' (RowsLoaded (unRowsToShow rts)) paginator' (unLazySortCol sc') (LazyRow <$> toRows xs'), sc')
+    commit . pur $ \(LazyTable _ th' rh' sy' rts' _ paginator' _ _, sc') -> (LazyTable xs' th' rh' sy' rts' (RowsLoaded (unRowsToShow rts)) paginator' (unLazySortCol sc') (LazyRow <$> toRows pxy xs'), sc')
 
 
 -- Require the user to provide assumptions about the height of each row and the height of the container rather than querying the DOM for this information. Also make the assumption that all rows have equal height.
@@ -150,8 +151,8 @@ type DebounceScroll m a = (RawNode -> RawEvent -> JSM (Continuation m a))
                        -> (RawNode -> RawEvent -> JSM (Continuation m a))
 
 
-data LazyTableScrollConfig m a b = ContainerIsScrollable (DebounceScroll m (b, CurrentScrollY, RowsLoaded))
-                                 | TbodyIsScrollable (DebounceScroll m (LazyTable m a, SortCol m (LazyTable m a)))
+data LazyTableScrollConfig m' m a b = ContainerIsScrollable (DebounceScroll m (b, CurrentScrollY, RowsLoaded))
+                                 | TbodyIsScrollable (DebounceScroll m (LazyTable m' a, SortCol m' (LazyTable m' a)))
   deriving Generic
 
 
@@ -163,43 +164,43 @@ fromLazySortCol :: SortCol m (LazyTable m a) -> SortCol m a
 fromLazySortCol (SortCol (LazyColumn c') s') = SortCol c' s'
 
 
-mapFromLazyTableSc :: Tabular m a => Functor m => Continuous f
-                   => LazyTable m a
-                   -> f m (LazyTable m a, SortCol m (LazyTable m a))
-                   -> f m ((a, SortCol m a), CurrentScrollY, RowsLoaded)
+mapFromLazyTableSc :: forall f m' m a. Tabular m' m a => Functor m => Continuous f
+                   => LazyTable m' a
+                   -> f m (LazyTable m' a, SortCol m' (LazyTable m' a))
+                   -> f m ((a, SortCol m' a), CurrentScrollY, RowsLoaded)
 mapFromLazyTableSc (LazyTable _xs tableHeight rowHeight _sy _rts _rl paginator _sc _rs) = liftC
   (\(LazyTable tab _ _ sy _ rl _ _ _, sc') _ -> ((tab, fromLazySortCol sc'), sy, rl))
-  (\((tab, sc), sy, rl) -> ( toLazyTable tableHeight rowHeight sy rl paginator tab sc
+  (\((tab, sc), sy, rl) -> ( toLazyTable (Proxy @m) tableHeight rowHeight sy rl paginator tab sc
                            , toLazySortCol sc ))
 
 
-mapToLazyTable :: Functor m => Continuous f => Tabular m a
-               => f m a -> f m (LazyTable m a)
+mapToLazyTable :: forall f m' m a. Functor m => Continuous f => Tabular m' m a
+               => f m a -> f m (LazyTable m' a)
 mapToLazyTable = liftC
   (\tab (LazyTable _ tableHeight rowHeight scrollY _ rowsLoaded paginator sc _)
-    -> toLazyTable tableHeight rowHeight scrollY rowsLoaded paginator tab sc)
+    -> toLazyTable (Proxy @m) tableHeight rowHeight scrollY rowsLoaded paginator tab sc)
   (\(LazyTable tab _ _ _ _ _ _ _ _) -> tab)
 
 
-mapToLazyTableSc :: Functor m => Continuous f => Tabular m a
-                 => f m (a, SortCol m a) -> f m (LazyTable m a, SortCol m (LazyTable m a))
+mapToLazyTableSc :: forall f m' m a. Functor m => Continuous f => Tabular m' m a
+                 => f m (a, SortCol m' a) -> f m (LazyTable m' a, SortCol m' (LazyTable m' a))
 mapToLazyTableSc = liftC
   (\(tab, sc) (LazyTable _ tableHeight rowHeight scrollY _ rowsLoaded paginator _ _, _)
-    -> ( toLazyTable tableHeight rowHeight scrollY rowsLoaded paginator tab sc
+    -> ( toLazyTable (Proxy @m) tableHeight rowHeight scrollY rowsLoaded paginator tab sc
        , toLazySortCol sc ))
   (\(LazyTable tab _ _ _ _ _ _ _ _, sc) -> (tab, fromLazySortCol sc))
 
 
-toLazyTable :: Tabular m a
-  => AssumedTableHeight -> AssumedRowHeight -> CurrentScrollY
-  -> RowsLoaded -> Paginator m a -> a -> SortCol m a -> LazyTable m a
-toLazyTable tabh rowh sy rowsLoaded paginator xs sc
+toLazyTable :: forall m' m a. Tabular m' m a
+  => Proxy m -> AssumedTableHeight -> AssumedRowHeight -> CurrentScrollY
+  -> RowsLoaded -> Paginator m' a -> a -> SortCol m' a -> LazyTable m' a
+toLazyTable _ tabh rowh sy rowsLoaded paginator xs sc
   = LazyTable xs tabh rowh sy (RowsToShow numRows) rowsLoaded paginator sc
                  . fmap LazyRow
                  . take numRows
-                 . sortBy (sortTable sc)
-                 . filter (toFilter xs)
-                 $ toRows xs
+                 . sortBy (sortTable (Proxy @m) sc)
+                 . filter (toFilter (Proxy @m) xs)
+                 $ toRows (Proxy @m) xs
   where numRows = rowsToShow tabh rowh sy
 
 
@@ -260,26 +261,29 @@ trivialPaginator :: Applicative m => Paginator m a
 trivialPaginator = Paginator (\x _ _ -> pure x)
 
 
-lazyTable :: forall m a b.
-  ( LazyTabular m a
+lazyTable :: forall m' m a b.
+  ( LazyTabular m' m a
   , Effect a m
-  , MonadJSM m
-  , Humanize (Column m a)
-  , Bounded  (Column m a)
-  , Ord      (Column m a)
-  , Enum     (Column m a) )
-  => Theme m a
+  , Effect a m'
+  , Monad m
+  , MonadJSM m'
+  , Humanize (Column m' a)
+  , Bounded  (Column m' a)
+  , Ord      (Column m' a)
+  , Enum     (Column m' a) )
+  => (m' ~> m)
+  -> Theme m' m a
   -> AssumedTableHeight
   -> AssumedRowHeight
-  -> LazyTableScrollConfig m a b
-  -> (Html m ((a, SortCol m a), CurrentScrollY) -> Html m (b, CurrentScrollY))
+  -> LazyTableScrollConfig m' m a b
+  -> (Html m ((a, SortCol m' a), CurrentScrollY) -> Html m (b, CurrentScrollY))
   -> a
-  -> SortCol m a
+  -> SortCol m' a
   -> CurrentScrollY
   -> Html m (b, CurrentScrollY)
-lazyTable theme tableHeight rowHeight scrollConfig container xs sc scrollY
+lazyTable lft theme tableHeight rowHeight scrollConfig container xs sc scrollY
   = removeRowsLoaded $
-    lazyLoadingTable trivialPaginator (RowsLoaded 0) theme tableHeight rowHeight scrollConfig
+    lazyLoadingTable lft trivialPaginator (RowsLoaded 0) theme tableHeight rowHeight scrollConfig
       liftedContainer xs sc scrollY
   where
     liftedContainer = addRowsLoaded . container . removeRowsLoaded
@@ -291,37 +295,40 @@ lazyTable theme tableHeight rowHeight scrollConfig container xs sc scrollY
     removeRowsLoaded = liftC (\(x,y,_) _ -> (x,y)) (\(x,y) -> (x,y,0))
 
 
-lazyLoadingTable :: forall m a b.
-  ( LazyTabular m a
+lazyLoadingTable :: forall m' m a b.
+  ( LazyTabular m' m a
   , Effect a m
-  , MonadJSM m
-  , Humanize (Column m a)
-  , Bounded  (Column m a)
-  , Ord      (Column m a)
-  , Enum     (Column m a) )
-  => Paginator m a
+  , Effect a m'
+  , Monad m
+  , MonadJSM m'
+  , Humanize (Column m' a)
+  , Bounded  (Column m' a)
+  , Ord      (Column m' a)
+  , Enum     (Column m' a) )
+  => (m' ~> m)
+  -> Paginator m' a
   -> RowsLoaded
-  -> Theme m a
+  -> Theme m' m a
   -> AssumedTableHeight
   -> AssumedRowHeight
-  -> LazyTableScrollConfig m a b
-  -> (Html m ((a, SortCol m a), CurrentScrollY, RowsLoaded)
+  -> LazyTableScrollConfig m' m a b
+  -> (Html m ((a, SortCol m' a), CurrentScrollY, RowsLoaded)
        -> Html m (b, CurrentScrollY, RowsLoaded))
   -> a
-  -> SortCol m a
+  -> SortCol m' a
   -> CurrentScrollY
   -> Html m (b, CurrentScrollY, RowsLoaded)
-lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHeight rowHeight')
+lazyLoadingTable lft paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHeight rowHeight')
           scrollConfig container xs sc@(SortCol c s) scrollY =
     addContainerScrollHandler
   . container
   . addContainerFakeHeight
   . mapFromLazyTableSc lazyTab
-  $ viewWith lazyTheme lazyTab (SortCol (LazyColumn c) s)
+  $ viewWith lft lazyTheme lazyTab (SortCol (LazyColumn c) s)
   where
-    lazyTab@LazyTable {} = toLazyTable tableHeight rowHeight scrollY rowsLoaded paginator xs sc
+    lazyTab@LazyTable {} = toLazyTable (Proxy @m) tableHeight rowHeight scrollY rowsLoaded paginator xs sc
 
-    totalRows = countRows (Proxy @m) xs
+    totalRows = countRows (Proxy @m') (Proxy @m) xs
 
     addContainerFakeHeight = case scrollConfig of
       ContainerIsScrollable _ -> div [("style", textProp fakeHeightStyle)] . (:[])
@@ -336,7 +343,7 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
       pur . second3 . const . CurrentScrollY . fromMaybe 0
         <$> (fromJSVal =<< n ! "scrollTop")
 
-    scrollHandlerTbody :: RowsLoaded -> RawNode -> RawEvent -> JSM (Continuation m (LazyTable m a, SortCol m (LazyTable m a)))
+    scrollHandlerTbody :: RowsLoaded -> RawNode -> RawEvent -> JSM (Continuation m (LazyTable m' a, SortCol m' (LazyTable m' a)))
     scrollHandlerTbody _rowsLoaded' (RawNode n) _ = do
       sy <- CurrentScrollY . fromMaybe 0 <$> (fromJSVal =<< n ! "scrollTop")
       let totalRows' = rowsToShow tableHeight rowHeight sy
@@ -344,8 +351,8 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
           newRows    = Length $ totalRows' - unRowsLoaded rowsLoaded
       if newRows > 0
       then return . voidRunContinuationT $ do
-        xs' <- lift $ unPaginator paginator xs sc (Page offset newRows)
-        commit . pur $ \(LazyTable _ th rh _ _ _ paginator' _ _, sc') -> (LazyTable xs' th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') paginator' (unLazySortCol sc') (LazyRow <$> toRows xs'), sc')
+        xs' <- lift . lft $ unPaginator paginator xs sc (Page offset newRows)
+        commit . pur $ \(LazyTable _ th rh _ _ _ paginator' _ _, sc') -> (LazyTable xs' th rh sy (RowsToShow totalRows') (RowsLoaded totalRows') paginator' (unLazySortCol sc') (LazyRow <$> toRows (Proxy @m) xs'), sc')
       else return . pur $ \(LazyTable t th rh _ rts rl paginator' sc' rs, sc'') -> (LazyTable t th rh sy rts rl paginator' sc' rs, sc'')
 
     fakeHeightStyle =
@@ -354,7 +361,7 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
     fakeRowHeightStyle totalRows' (RowsToShow rts) =
       "height: " <> pack (show ((totalRows' - rts) * rowHeight')) <> "px;"
 
-    lazyTheme :: Theme m (LazyTable m a)
+    lazyTheme :: Theme m' m (LazyTable m' a)
     lazyTheme = case theme of
       Theme tp hp hrp rp thp bp dp -> Theme
         { tableProps = \(LazyTable xs' _ _ _ _ _ _ _ _) sc' ->
@@ -366,7 +373,7 @@ lazyLoadingTable paginator rowsLoaded theme tableHeight rowHeight@(AssumedRowHei
         , trProps = \(LazyTable xs' _ _ _ rts _ _ _ _) sc' r ->
             case r of
               LazyRow r' -> second mapToLazyTableSc <$> rp xs' (fromLazySortCol sc') r'
-              FakeRow -> [("style", textProp (fakeRowHeightStyle (countRows (Proxy @m) xs') rts))]
+              FakeRow -> [("style", textProp (fakeRowHeightStyle (countRows (Proxy @m') (Proxy @m) xs') rts))]
         , thProps = \(LazyTable xs' _ _ _ _ _ _ _ _) sc' (LazyColumn c') ->
             second mapToLazyTableSc <$> thp xs' (fromLazySortCol sc') c'
         , bodyProps = \(LazyTable xs' _ _ _ _ rowsLoaded' _ _ _) sc' ->
-- 
GitLab