Added progress bar for reading list documents

backend/src/Handler/WebSocketHandler/KanjiBrowser.hs

@@ -286,7 +286,7 @@ addEditNewDocumentCommon dId docContent = do
 
  ret <- transactSrsDB $ runStateWithNothing $ upFun
 
- ret & _Just . _5 . each . _2 %%~ fixFuriganaVisibility
+ ret & _Just . readerDocumentData_slice . each . _2 %%~ fixFuriganaVisibility
 
 getQuickAnalyzeText :: QuickAnalyzeText
  -> WsHandlerM [(Int, AnnotatedPara)]
@@ -352,7 +352,7 @@ getViewDocument (ViewDocument i paraNum) = do
  ret :: Maybe ReaderDocumentData
  ret = flip (getReaderDocumentData booksDb articlesDb) paraNum <$> s
 
- ret & _Just . _5 . each . _2 %%~ fixFuriganaVisibility
+ ret & _Just . readerDocumentData_slice . each . _2 %%~ fixFuriganaVisibility
 
 getViewDocument req = do
  rs <- transactReadOnlySrsDB $ \rd ->
@@ -376,10 +376,15 @@ getReaderDocumentData
  -> Array ArticleId (Text, AnnotatedDocument)
  -> ReaderDocumentTree t0
  -> Maybe Int
- -> (ReaderDocumentId, Text, (Int, Maybe Int), Int,
- [(Int, AnnotatedPara)])
-getReaderDocumentData booksDb articlesDb r paraNum =
- (r ^. readerDocId, title, pg, endParaNum, slice)
+ -> ReaderDocumentData 
+getReaderDocumentData booksDb articlesDb r paraNum = 
+ ReaderDocumentData 
+ {_readerDocumentData_id = r ^. readerDocId,
+ _readerDocumentData_title = title,
+ _readerDocumentData_pg = pg,
+ _readerDocumentData_totalParaNum = endParaNum,
+ _readerDocumentData_slice = slice}
+-- (r ^. readerDocId, title, pg, endParaNum, slice)
  where
  (title, c) = case r ^. readerDoc of
  (MyDocument t c') -> (t,c')

common/src/Message.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
 module Message
  where
 
@@ -326,9 +327,13 @@ data ViewDocument
 instance WebSocketMessage AppRequest ViewDocument where
  type ResponseT AppRequest ViewDocument = (Maybe (ReaderDocumentData))
 
-type ReaderDocumentData =
- (ReaderDocumentId, Text, (Int, Maybe Int), Int
- , [(Int, AnnotatedPara)])
+data ReaderDocumentData = ReaderDocumentData
+ { _readerDocumentData_id :: ReaderDocumentId
+ , _readerDocumentData_title :: Text
+ , _readerDocumentData_pg :: (Int, Maybe Int)
+ , _readerDocumentData_totalParaNum :: Int
+ , _readerDocumentData_slice :: [(Int, AnnotatedPara)]
+ } deriving (Generic, Show, ToJSON, FromJSON)
 
 ----------------------------------------------------------------
 data ViewRawDocument = ViewRawDocument ReaderDocumentId
@@ -447,6 +452,8 @@ instance WebSocketMessage AppRequest ImportData where
  type ResponseT AppRequest ImportData = ()
 
 ----------------------------------------------------------------
+makeLenses ''ReaderDocumentData
+
 -- makeLenses ''ReviewItem
 reviewItemField :: Lens' ReviewItem SrsEntryField
 reviewItemField

frontend/src/ReadingPane.hs

@@ -187,7 +187,7 @@ verticalReader :: forall t m . AppMonad t m
  -> Event t ()
  -> (ReaderDocumentData)
  -> AppMonadT t m ()
-verticalReader rs eh fullScrEv (docId, _, startParaMaybe, endParaNum, annText) = do
+verticalReader rs eh fullScrEv readerDocumentData = do
  (evVisible, action) <- newTriggerEvent
 
  visDyn <- holdDyn (0,Nothing) evVisible
@@ -196,6 +196,10 @@ verticalReader rs eh fullScrEv (docId, _, startParaMaybe, endParaNum, annText) =
 #endif
 
  let
+ docId = _readerDocumentData_id readerDocumentData
+ startParaMaybe = _readerDocumentData_pg readerDocumentData
+ endParaNum = _readerDocumentData_totalParaNum readerDocumentData
+ annText = _readerDocumentData_slice readerDocumentData
  divAttr' = (\rs1 fs -> ("class" =: "col-xs-10") <> ("style" =:
  ("font-size: " <> tshow (_fontSize rs1) <>"%;"
  <> "line-height: " <> tshow (_lineHeight rs1) <> "%;"
@@ -384,6 +388,31 @@ verticalReader rs eh fullScrEv (docId, _, startParaMaybe, endParaNum, annText) =
  (e,_) <- elDynAttr' "button" rightBtrAttr $ text ">"
  return (domEvent Click e, cEv)
 
+ let
+ lastParaNumOfCurrentPage :: Dynamic t ParaNum = fst <$> lastDisplayedPara
+ isVerticalMode :: Dynamic t Bool = _verticalMode <$> rs
+ isFullScreenMode :: Dynamic t Bool = fullscreenDyn
+
+ --showDocProgress :: DomBuilder t m1 => Dynamic t ParaNum -> Dynamic t Bool -> m1 ()
+ showDocProgressIfNotFullScreen c v f = do
+ let
+ tmp :: Dynamic t (ParaNum, Bool) = zipDyn c v
+ attrMapDynamicValues :: Dynamic t ((ParaNum, Bool), Bool) = zipDyn tmp f
+ attrMap = getAttrMap <$> attrMapDynamicValues
+ elDynAttr "progress" attrMap $ return()
+
+ getAttrMap :: ((ParaNum, Bool), Bool) -> Map Text Text
+ getAttrMap ((c, v), f) = do
+ let
+ attrMap = ("value" =: (tshow . unParaNum $ c)) <> ("max" =: (tshow totalParaNum)) <>
+ ("class" =: (rotateBy180OrNot<>" "<>"col-sm-12")) <> ("style" =: ("visibility: "<>visibleOrNot))
+ totalParaNum = endParaNum
+ rotateBy180OrNot = if v then "rotate-by-180" else ""
+ visibleOrNot = if f then "hidden" else "visible"
+ attrMap
+
+ showDocProgressIfNotFullScreen lastParaNumOfCurrentPage isVerticalMode isFullScreenMode
+
  let
  -- The button on left is next in vertical and prev in horizontal
  next1 = switch . current $ ffor (_verticalMode <$> rs) $ \v -> if v
@@ -454,11 +483,12 @@ fetchMoreContentF docId annText endParaNum pageChangeEv = do
  | f > 0 && d == BackwardGrow && (n - f < 30) = Just (max 0 (f - 60))
  | otherwise = Nothing
 
- moreContentEv <- getWebSocketResponse $
+ (moreContentEv :: (Event t (Maybe ReaderDocumentData)))<- getWebSocketResponse $
  (\p -> ViewDocument docId (Just p)) <$> (leftmost [hitEndEv, hitStartEv])
 
- textContent <- foldDyn moreContentAccF annText ((\(_,_,_,_,c) -> c) <$>
- (fmapMaybe identity moreContentEv))
+ let sliceEv = fmapMaybe (fmap _readerDocumentData_slice) moreContentEv
+
+ textContent <- foldDyn moreContentAccF annText sliceEv
 
 #if defined (DEBUG)
  -- text "("

frontend/src/custom.css

@@ -51,3 +51,7 @@
  color: #000;
  padding: 0.1em;
 }
+
+.rotate-by-180 {
+ transform: rotate(180deg);
+}