diff --git a/src/AddCorpusview.purs b/src/AddCorpusview.purs
index ca244406195e9eb049440dcedcec6f303a3f3760..610d03ba2eb27608191042ae16d19064bce9508c 100644
--- a/src/AddCorpusview.purs
+++ b/src/AddCorpusview.purs
@@ -15,8 +15,11 @@ import DOM.WebStorage.Storage (getItem, setItem)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
+import Data.Lens (Lens', Prism', lens, over)
+import Data.List (List, fold, fromFoldable, toUnfoldable)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.MediaType.Common (applicationJSON)
+import Data.Tuple (Tuple(..))
import Network.HTTP.Affjax (AJAX, affjax, defaultRequest)
import Network.HTTP.RequestHeader (RequestHeader(..))
import Prelude hiding (div)
@@ -24,10 +27,11 @@ import React (ReactElement)
import React.DOM (a, button, div, form, h2, h3, h4, i, input, label, li, p, span, text, ul)
import React.DOM.Props (_id, _type, className, href, maxLength, name, onClick, onInput, placeholder, target, value)
import Routing.Hash.Aff (setHash)
-import Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec)
+import Thermite (PerformAction, Render, Spec, _render, cotransform, focus, foreach, modifyState, simpleSpec, withState)
import Unsafe.Coerce (unsafeCoerce)
+
type State =
{ select_database :: Boolean
, unselect_database :: Boolean -- dummy state
@@ -54,6 +58,7 @@ data Action
| SelectDatabase Boolean
| UnselectDatabase Boolean
| LoadDatabaseDetails
+ | ResponseAction
performAction :: forall eff props. PerformAction (console :: CONSOLE, ajax :: AJAX,dom::DOM | eff) State props Action
@@ -74,6 +79,8 @@ performAction (LoadDatabaseDetails) _ _ = void do
Right resData -> do
cotransform $ \(state) -> state {response = resData}
+performAction ResponseAction _ _ = void do
+ modifyState id
@@ -96,25 +103,29 @@ addcorpusviewSpec = simpleSpec performAction render
[
h3 [] [text "Corpusview"]
, ul [className "list-group"] $ map fn1 state.response
- , button [] [text "GO"]
]
]
]
]
]
+ where
+ fn1 (Response o) =
+ li [className "list-group-item justify-content-between"]
+ [
+ span [] [text o.name]
+ , span [className "badge badge-default badge-pill"] [ text $ show o.count]
+ ]
-fn1 :: Response -> ReactElement
-fn1 (Response o) =
- li [className "list-group-item justify-content-between"]
- [
- a [ href "#"]
- [ span [] [text o.name]
- , span [className "badge badge-default badge-pill"] [ text $ show o.count]
- ]
- ]
+-- fn1 :: Response -> ReactElement
+-- fn1 (Response o) =
+-- li [className "list-group-item justify-content-between"]
+-- [
+-- span [] [text o.name]
+-- , span [className "badge badge-default badge-pill"] [ text $ show o.count]
+-- ]
newtype QueryString = QueryString
diff --git a/src/DocView.purs b/src/DocView.purs
new file mode 100644
index 0000000000000000000000000000000000000000..ea8318efd43283763e354f9674a206fdcb77c874
--- /dev/null
+++ b/src/DocView.purs
@@ -0,0 +1,347 @@
+module DocView where
+
+import Data.Argonaut
+
+import Control.Monad.Aff (Aff, attempt)
+import Control.Monad.Aff.Class (liftAff)
+import Control.Monad.Aff.Console (CONSOLE, log)
+import Control.Monad.Cont.Trans (lift)
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Class (liftEff)
+import Control.Monad.Eff.Console (CONSOLE)
+import DOM (DOM)
+import DOM.HTML (window) as DOM
+import DOM.HTML.Types (htmlDocumentToParentNode) as DOM
+import DOM.HTML.Window (document) as DOM
+import DOM.Node.ParentNode (QuerySelector(..))
+import DOM.Node.ParentNode (querySelector) as DOM
+import Data.Array (filter, replicate)
+import Data.Either (Either(..))
+import Data.HTTP.Method (Method(..))
+import Data.Maybe (fromJust)
+import Data.MediaType.Common (applicationJSON)
+import Network.HTTP.Affjax (AJAX, affjax, defaultRequest)
+import Network.HTTP.RequestHeader (RequestHeader(..))
+import Partial.Unsafe (unsafePartial)
+import Prelude hiding (div)
+import React (ReactElement)
+import React as R
+import React.DOM (a, b, b', br', div, dt, input, option, select, span, table, tbody, td, text, thead, tr)
+import React.DOM.Props (_type, href, onChange, onClick, selected, value)
+import ReactDOM as RDOM
+import Thermite (PerformAction, Render, Spec, cotransform, createReactSpec, defaultPerformAction, modifyState, simpleSpec)
+import Unsafe.Coerce (unsafeCoerce)
+
+main :: forall e. Eff (dom:: DOM, console :: CONSOLE, ajax :: AJAX | e) Unit
+main = do
+ case createReactSpec spec tdata of
+ { spec, dispatcher } -> void $ do
+ document <- DOM.window >>= DOM.document
+ container <- unsafePartial (fromJust <$> DOM.querySelector (QuerySelector "#app") (DOM.htmlDocumentToParentNode document))
+ RDOM.render (R.createFactory (R.createClass spec) {}) container
+
+-- main :: forall e. Eff (console :: CONSOLE | e) Unit
+-- main = do
+-- log "Hello sailor!"
+
+-- TODO: Pagination Details are not available from the BackEnd
+-- TODO: PageSize Change manually sets the totalPages, need to get from backend and reload the data
+-- TODO: Search is pending
+-- TODO: Delete is pending
+-- TODO: Fav is pending
+-- TODO: Sort is Pending
+-- TODO: Filter is Pending
+-- TODO: When a pagination link is clicked, reload data. Right now it doesn't make sense to reload mock data.
+
+newtype Response = Response
+ { cid :: Int
+ , created :: String
+ , favorite :: Boolean
+ , ngramCount :: Int
+ , hyperdata :: Hyperdata
+ }
+
+newtype Hyperdata = Hyperdata
+ {
+ title :: String
+ , abstract :: String
+ }
+
+type State = CorpusTableData
+data Action
+ = ChangePageSize PageSizes
+ | ChangePage Int
+ | LoadData
+
+
+instance decodeHyperdata :: DecodeJson Hyperdata where
+ decodeJson json = do
+ obj <- decodeJson json
+ title <- obj .? "title"
+ abstract <- obj .? "abstract"
+ pure $ Hyperdata { title,abstract }
+
+
+
+instance decodeResponse :: DecodeJson Response where
+ decodeJson json = do
+ obj <- decodeJson json
+ cid <- obj .? "id"
+ created <- obj .? "created"
+ favorite <- obj .? "favorite"
+ ngramCount <- obj .? "ngramCount"
+ hyperdata <- obj .? "hyperdata"
+ pure $ Response { cid,created,favorite,ngramCount,hyperdata }
+
+
+spec :: Spec _ State _ Action
+spec = simpleSpec performAction render
+ where
+ render :: Render State _ Action
+ render dispatch _ state@(TableData d) _ =
+ [ div []
+ [ div [] [b [] [text d.title]]
+ , div [] [ text "Search "
+ , input [] []
+ ]
+ , sizeDD d.pageSize dispatch
+ , br' []
+ , br' []
+ , textDescription d.currentPage d.pageSize d.totalRecords
+ , br' []
+ , br' []
+ , pagination dispatch d.totalPages d.currentPage
+ , br' []
+ , br' []
+ , table []
+ [thead [] [tr []
+ [ td [] [ b' [text "Date"]]
+ , td [] [ b' [text "Title"]]
+ , td [] [ b' [text "Source"]]
+ , td [] [ b' [text "Fav"]]
+ , td [] [ b' [text "Delete"]]
+ ]]
+ , tbody [] $ map showRow d.rows
+ ]
+ ]
+ ]
+
+performAction :: PerformAction _ State _ Action
+performAction (ChangePageSize ps) _ _ = void (cotransform (\state -> changePageSize ps state ))
+performAction (ChangePage p) _ _ = void (cotransform (\(TableData td) -> TableData $ td { currentPage = p} ))
+performAction _ _ _ = void (cotransform id)
+performAction LoadData _ _ = void do
+ res <- lift $ loadData
+ case res of
+ Left err -> cotransform $ \(state) -> state
+ Right resData -> do
+ cotransform id -- \(state) -> state {response = resData}
+
+
+
+changePageSize :: PageSizes -> CorpusTableData -> CorpusTableData
+changePageSize ps (TableData td) = TableData $ td { pageSize = ps, totalPages = td.totalRecords / pageSizes2Int ps, currentPage = 1}
+
+
+data PageSizes = PS10 | PS20 | PS50 | PS100
+
+derive instance eqPageSizes :: Eq PageSizes
+
+instance showPageSize :: Show PageSizes where
+ show PS10 = "10"
+ show PS20 = "20"
+ show PS50 = "50"
+ show PS100 = "100"
+
+pageSizes2Int :: PageSizes -> Int
+pageSizes2Int PS10 = 10
+pageSizes2Int PS20 = 20
+pageSizes2Int PS50 = 50
+pageSizes2Int PS100 = 100
+
+aryPS :: Array PageSizes
+aryPS = [PS10, PS20, PS50, PS100]
+
+string2PageSize :: String -> PageSizes
+string2PageSize "10" = PS10
+string2PageSize "20" = PS20
+string2PageSize "50" = PS50
+string2PageSize "100" = PS100
+string2PageSize _ = PS10
+
+sizeDD :: PageSizes -> _ -> ReactElement
+sizeDD ps d
+ = span []
+ [ text "Show : "
+ , select [onChange (\e -> d (ChangePageSize $ string2PageSize $ (unsafeCoerce e).target.value))] $ map (optps ps) aryPS
+ ]
+
+optps :: PageSizes -> PageSizes -> ReactElement
+optps cv val = option [ selected (cv == val), value $ show val ] [text $ show val]
+
+
+textDescription :: Int -> PageSizes -> Int -> ReactElement
+textDescription currPage pageSize totalRecords
+ = text $ "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords
+ where
+ start = (currPage - 1) * pageSizes2Int pageSize + 1
+ end' = currPage * pageSizes2Int pageSize
+ end = if end' > totalRecords then totalRecords else end'
+
+
+pagination :: _ -> Int -> Int -> ReactElement
+pagination d tp cp
+ = span [] $
+ [ text "Pages: "
+ , prev
+ , first
+ , ldots
+ ]
+ <>
+ lnums
+ <>
+ [b' [text $ " " <> show cp <> " "]]
+ <>
+ rnums
+ <>
+ [ rdots
+ , last
+ , next
+ ]
+ where
+ prev = if cp == 1 then
+ text " Previous "
+ else
+ span []
+ [ text " "
+ , a [href "javascript:void()", onClick (\e -> d $ ChangePage $ cp - 1)] [text "Previous"]
+ , text " "
+ ]
+ next = if cp == tp then
+ text " Next "
+ else
+ span []
+ [ text " "
+ , a [href "javascript:void()", onClick (\e -> d $ ChangePage $ cp + 1)] [text "Next"]
+ , text " "
+ ]
+ first = if cp == 1 then
+ text ""
+ else
+ span []
+ [ text " "
+ , a [href "javascript:void()", onClick (\e -> d $ ChangePage 1)] [text "1"]
+ , text " "
+ ]
+ last = if cp == tp then
+ text ""
+ else
+ span []
+ [ text " "
+ , a [href "javascript:void()", onClick (\e -> d $ ChangePage tp)] [text $ show tp]
+ , text " "
+ ]
+ ldots = if cp >= 5 then
+ text " ... "
+ else
+ text ""
+ rdots = if cp + 3 < tp then
+ text " ... "
+ else
+ text ""
+ lnums = map (\i -> fnmid d i) $ filter (lessthan 1) [cp - 2, cp - 1]
+ rnums = map (\i -> fnmid d i) $ filter (greaterthan tp) [cp + 1, cp + 2]
+
+fnmid :: _ -> Int -> ReactElement
+fnmid d i
+ = span []
+ [ text " "
+ , a [href "javascript:void()", onClick (\e -> d $ ChangePage i)] [text $ show i]
+ , text " "
+ ]
+
+
+lessthan :: forall t28. Ord t28 => t28 -> t28 -> Boolean
+lessthan x y = x < y
+
+greaterthan :: forall t28. Ord t28 => t28 -> t28 -> Boolean
+greaterthan x y = x > y
+
+newtype TableData a
+ = TableData
+ { rows :: Array {row :: a, delete :: Boolean}
+ , totalPages :: Int
+ , currentPage :: Int
+ , pageSize :: PageSizes
+ , totalRecords :: Int
+ , title :: String
+ }
+
+newtype Corpus
+ = Corpus
+ { _id :: Int
+ , url :: String
+ , date :: String
+ , title :: String
+ , source :: String
+ , fav :: Boolean
+ }
+type CorpusTableData = TableData Corpus
+
+sampleData' :: Corpus
+sampleData' = Corpus {_id : 1, url : "", date : "date", title : "title", source : "source", fav : false}
+
+sampleData :: Array Corpus
+sampleData = replicate 10 sampleData'
+
+data' :: Array Corpus -> Array {row :: Corpus, delete :: Boolean}
+data' = map {row : _, delete : false}
+
+sdata :: Array { row :: Corpus, delete :: Boolean }
+sdata = data' sampleData
+
+tdata :: CorpusTableData
+tdata = TableData
+ { rows : sdata
+ , totalPages : 10
+ , currentPage : 1
+ , pageSize : PS10
+ , totalRecords : 100
+ , title : "Publications by title"
+ }
+
+
+showRow :: {row :: Corpus, delete :: Boolean} -> ReactElement
+showRow {row : (Corpus c), delete} =
+ tr []
+ [ td [] [text c.date]
+ , td [] [text c.title]
+ , td [] [text c.source]
+ , td [] [text $ show c.fav]
+ , td [] [ input [ _type "checkbox"] []]
+ ]
+
+
+
+
+loadData :: forall eff. Aff ( console :: CONSOLE, ajax :: AJAX| eff) (Either String Response)
+loadData = do
+ -- liftEff $ log $ "GET /api response: "
+ affResp <- liftAff $ attempt $ affjax defaultRequest
+ { method = Left GET
+ , url = "http://localhost:8009/corpus/1/facet/documents/table"
+ , headers = [ ContentType applicationJSON
+ , Accept applicationJSON
+ -- , RequestHeader "Authorization" $ "Bearer " <> token
+ ]
+ -- , content = Just $ encodeJson reqBody
+ }
+ case affResp of
+ Left err -> do
+ --liftEff $ log $ "Error" <> show err
+ pure $ Left $ show err
+ Right a -> do
+ --liftEff $ log $ "POST method Completed"
+ --liftEff $ log $ "GET /api response: " <> show a.response
+ let res = decodeJson a.response
+ pure res
diff --git a/src/Navigation.purs b/src/Navigation.purs
index 07ff26c6a26535ee0cde618e61fe30846e334bf2..9fcb333f0fd5640af1ce8b66db1b0758da4ea10f 100644
--- a/src/Navigation.purs
+++ b/src/Navigation.purs
@@ -19,6 +19,8 @@ import Prelude hiding (div)
import React.DOM (a, div, i, img, li, span, text, ul)
import React.DOM.Props (_data, _id, aria, className, href, role, src, style, tabIndex, target, title)
import Thermite (PerformAction, Render, Spec, _render, defaultRender, focus, modifyState, simpleSpec, withState)
+import DocView as DV
+
type E e = (dom :: DOM, ajax :: AJAX, console :: CONSOLE | e)
@@ -27,6 +29,7 @@ type AppState =
, landingState :: L.State
, loginState :: LN.State
, addCorpusState :: AC.State
+ , docViewState :: DV.State
}
initAppState :: AppState
@@ -35,6 +38,7 @@ initAppState =
, landingState : L.initialState
, loginState : LN.initialState
, addCorpusState : AC.initialState
+ , docViewState : DV.tdata
}
@@ -44,6 +48,7 @@ data Action
| LoginA LN.Action
| SetRoute Routes
| AddCorpusA AC.Action
+ | DocViewA DV.Action
performAction :: forall eff props. PerformAction (dom :: DOM |eff) AppState props Action
@@ -92,6 +97,18 @@ _addCorpusAction = prism AddCorpusA \action ->
+_docViewState:: Lens' AppState DV.State
+_docViewState = lens (\s -> s.docViewState) (\s ss -> s{docViewState = ss})
+
+
+_docViewAction :: Prism' Action DV.Action
+_docViewAction = prism DocViewA \action ->
+ case action of
+ DocViewA caction -> Right caction
+ _-> Left action
+
+
+
pagesComponent :: forall props eff. AppState -> Spec (E eff) AppState props Action
pagesComponent s =
case s.currentRoute of
@@ -104,6 +121,7 @@ pagesComponent s =
selectSpec Home = wrap $ focus _landingState _landingAction L.loginSpec
selectSpec Login = focus _loginState _loginAction LN.renderSpec
selectSpec AddCorpus = wrap $ focus _addCorpusState _addCorpusAction AC.addcorpusviewSpec
+ selectSpec DocView = wrap $ focus _docViewState _docViewAction DV.spec
routingSpec :: forall props eff. Spec (dom :: DOM |eff) AppState props Action
routingSpec = simpleSpec performAction defaultRender
@@ -240,3 +258,8 @@ dispatchAction dispatcher _ AddCorpus = do
_ <- dispatcher $ SetRoute $ AddCorpus
_ <- dispatcher $ AddCorpusA $ AC.LoadDatabaseDetails
pure unit
+
+dispatchAction dispatcher _ DocView = do
+ _ <- dispatcher $ SetRoute $ DocView
+ _ <- dispatcher $ DocViewA $ DV.LoadData
+ pure unit
diff --git a/src/PageRouter.purs b/src/PageRouter.purs
index 9bbf268d106504551e7618e17c4f637943953e76..fe1089e6576c7c2ad3930a7081dd730f6e8b3cf3 100644
--- a/src/PageRouter.purs
+++ b/src/PageRouter.purs
@@ -18,11 +18,13 @@ data Routes
= Home
| Login
| AddCorpus
+ | DocView
instance showRoutes :: Show Routes where
show Home = "Home"
show Login = "Login"
show AddCorpus = "AddCorpus"
+ show DocView = "DocView"
int :: Match Int
int = floor <$> num
@@ -31,8 +33,10 @@ routing :: Match Routes
routing =
loginRoute
<|> addcorpusRoute
+ <|> docviewRoute
<|> home
where
+ docviewRoute = DocView <$ route "docView"
addcorpusRoute = AddCorpus <$ route "addCorpus"
loginRoute = Login <$ route "login"
home = Home <$ lit ""