Tabview.purs 5.63 KB
Newer Older
Abinaya Sudhir's avatar
Abinaya Sudhir committed
1 2
module Tabview where

3 4 5
import Authorview as AV
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
Abinaya Sudhir's avatar
Abinaya Sudhir committed
6
import Data.Array (fold)
7
import Data.Either (Either(..))
Abinaya Sudhir's avatar
Abinaya Sudhir committed
8
import Data.Lens (Lens', Prism', lens, over, prism, view)
9 10
import DocView as DV
import Network.HTTP.Affjax (AJAX)
Abinaya Sudhir's avatar
Abinaya Sudhir committed
11
import Prelude hiding (div)
Abinaya Sudhir's avatar
Abinaya Sudhir committed
12 13
import React.DOM (a, div, li, text, ul)
import React.DOM.Props (_data, _id, aria, className, href, role)
14 15
import Sourceview as SV
import Termsview as TV
Abinaya Sudhir's avatar
Abinaya Sudhir committed
16
import Thermite (Render, Spec, _performAction, _render, defaultPerformAction, defaultRender, focus, focusState, simpleSpec, withState)
17 18 19 20 21 22

data Action
  =  DocviewA DV.Action
  | SourceviewA SV.Action
  | AuthorviewA AV.Action
  | TermsviewA TV.Action
Abinaya Sudhir's avatar
Abinaya Sudhir committed
23
  | ChangeTab
24
  | NoOp
Abinaya Sudhir's avatar
Abinaya Sudhir committed
25 26

data TabTitle = TabTitle String Int
27

Abinaya Sudhir's avatar
Abinaya Sudhir committed
28
newtype TabTitleState = TabTitleState {tabTitles :: Array TabTitle, selectedTab :: Int}
29

Abinaya Sudhir's avatar
Abinaya Sudhir committed
30 31 32 33 34 35 36
type State =
  { docview :: DV.State
  , authorview :: AV.State
  , sourceview :: SV.State
  , termsview :: TV.State
  , tabTitle :: TabTitleState
  }
37 38

initialState :: State
Abinaya Sudhir's avatar
Abinaya Sudhir committed
39 40 41 42 43 44 45
initialState =
  { docview : DV.tdata
  , authorview : AV.initialState
  , sourceview : SV.initialState
  , termsview : TV.initialState
  , tabTitle : TabTitleState
    { selectedTab : 1
Abinaya Sudhir's avatar
Abinaya Sudhir committed
46
    , tabTitles : [TabTitle "Documentsview" 1, TabTitle "Sourceview" 2, TabTitle "Authorview" 3, TabTitle "Termsview" 4]
Abinaya Sudhir's avatar
Abinaya Sudhir committed
47 48 49 50 51 52 53 54 55 56 57 58 59
    }
  }

_doclens :: Lens' State DV.State
_doclens = lens (\s -> s.docview) (\s ss -> s {docview = ss})


_authorlens :: Lens' State AV.State
_authorlens = lens (\s -> s.authorview) (\s ss -> s {authorview = ss})


_sourcelens :: Lens' State SV.State
_sourcelens = lens (\s -> s.sourceview) (\s ss -> s {sourceview = ss})
60 61


Abinaya Sudhir's avatar
Abinaya Sudhir committed
62 63 64 65 66 67
_termslens :: Lens' State TV.State
_termslens = lens (\s -> s.termsview) (\s ss -> s {termsview = ss})


_tabtitlelens :: Lens' State TabTitleState
_tabtitlelens = lens (\s -> s.tabTitle) (\s ss -> s {tabTitle = ss})
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94


_docAction :: Prism' Action DV.Action
_docAction = prism DocviewA \ action ->
  case action of
    DocviewA laction -> Right laction
    _-> Left action

_sourceAction :: Prism' Action SV.Action
_sourceAction = prism SourceviewA \ action ->
  case action of
    SourceviewA laction -> Right laction
    _-> Left action

_authorAction :: Prism' Action AV.Action
_authorAction = prism AuthorviewA \ action ->
  case action of
    AuthorviewA laction -> Right laction
    _-> Left action


_termsAction :: Prism' Action TV.Action
_termsAction = prism TermsviewA \ action ->
  case action of
    TermsviewA laction -> Right laction
    _-> Left action

Abinaya Sudhir's avatar
Abinaya Sudhir committed
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
docPageSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
docPageSpec = focus _doclens _docAction DV.layoutDocview

authorPageSpec :: forall eff props. Spec (dom :: DOM, console::CONSOLE, ajax :: AJAX | eff) State  props Action
authorPageSpec = focus _authorlens _authorAction AV.authorSpec

sourcePageSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
sourcePageSpec = focus _sourcelens _sourceAction SV.sourceSpec

termsPageSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
termsPageSpec = focus _termslens _termsAction TV.termsSpec

docPageActionSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
docPageActionSpec = simpleSpec (view _performAction docPageSpec) defaultRender

sourcePagesActionSpec :: forall eff props. Spec (dom :: DOM, console::CONSOLE, ajax :: AJAX | eff) State props Action
sourcePagesActionSpec = simpleSpec (view _performAction sourcePageSpec) defaultRender

authorPageActionSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
authorPageActionSpec = simpleSpec (view _performAction authorPageSpec) defaultRender

termsPageActionSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
termsPageActionSpec = simpleSpec (view _performAction termsPageSpec) defaultRender

tabSpec' :: forall eff props. Spec eff State props Action
tabSpec' = container $ fold
      [ withState $ wrapSpec docPageSpec
      , withState $ wrapSpec authorPageSpec
      , withState $ wrapSpec sourcePageSpec
      , withState $ wrapSpec termsPageSpec
      ]
  where
    container :: Spec eff State props Action -> Spec eff State props Action
    container = over _render \render d p s c ->
      [ div [className "tab-content"] $ render d p s c ]
    containerTabContent st = over _render \render d p s c ->
      [ div [className "tab-pane fade"] $ render d p s c ]
    wrapSpec spec st =
      simpleSpec defaultPerformAction (view _render spec)

tabSpec :: forall eff props. Spec (dom :: DOM, console::CONSOLE, ajax :: AJAX | eff) State props  Action
tabSpec = fold
            [ focusState _tabtitlelens tabTitleSpec
            , tabSpec'
            , docPageActionSpec
            , sourcePagesActionSpec
            , authorPageActionSpec
            , termsPageActionSpec
            ]


tabTitleSpec :: forall eff props. Spec eff TabTitleState  props Action
tabTitleSpec = simpleSpec defaultPerformAction render
  where
    render :: Render TabTitleState  props Action
    render dispatch _ state@(TabTitleState st)_ =
      [ ul [className "nav nav-tabs", _id "myTab", role "tablist"]
        (map (item st.selectedTab) st.tabTitles)
      ]
      where
        item sid (TabTitle title iid) =
          li [className "nav-item"]
          [ a [className (if sid == iid then "nav-link active" else "nav-link"), _id ("tv-page-tab-item-" <> show iid), _data {toggle : "tab"}, href "", role "tab", aria {controls : title, selected : (if sid == iid then "true" else "false")}]
            [ text title]
          ]