Specs.purs 4.25 KB
Newer Older
1 2 3 4
module Gargantext.Pages.Home.Specs where

import Prelude hiding (div)

5 6 7 8
import Data.Lens (re)
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Newtype (unwrap)

9 10 11 12
import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Data.Lang (Lang(..))
13
import Gargantext.Pages.Home.States (State, initialState)
Sudhir Kumar's avatar
Sudhir Kumar committed
14
import Gargantext.Pages.Home.Actions (Action, performAction)
15 16 17 18

import React (ReactElement)
import React.DOM (a, div, h3, i, img, p, span, text)
import React.DOM.Props (Props, _id, aria, className, href, src, target, title)
19
import Thermite (Render, Spec, simpleSpec, hideState, focusState)
20 21 22 23


-- Layout |

24 25 26 27 28
landingData :: Lang -> LandingData
landingData FR = Fr.landingData
landingData EN = En.landingData

layoutLanding :: Lang -> Spec {} {} Void
29
layoutLanding = hideState (const $ unwrap initialState)
30 31
            <<< focusState (re _Newtype)
            <<< layoutLanding' <<< landingData
32 33 34

------------------------------------------------------------------------

35
layoutLanding' :: LandingData -> Spec State {} Action
36 37
layoutLanding' hd = simpleSpec performAction render
  where
38
    render :: Render State {} Action
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
    render dispatch _ state _ =
      [ div [ className "container1" ] [ jumboTitle hd false                 ]
      , div [ className "container1" ] [] -- put research here
      , div [ className "container1" ] [ blocksRandomText' hd                ]
      ]
------------------------------------------------------------------------

blocksRandomText' :: LandingData -> ReactElement
blocksRandomText' (LandingData hd) = blocksRandomText hd.blockTexts


blocksRandomText :: BlockTexts -> ReactElement
blocksRandomText (BlockTexts bt) =
  div [ className "row" ] ( map showBlock bt.blocks )
    where
      showBlock :: BlockText -> ReactElement
      showBlock (BlockText b) =
        div [ className "col-md-4 content" ]
              [ h3 [] [ a [ href b.href, title b.title]
                          [ i [className b.icon] []
                          , text ("   " <> b.titleText)
                          ]
                      ]
              , p [] [ text b.text ]
              , p [] [ docButton b.docButton ]
              ]

docButton :: Button -> ReactElement
docButton (Button b) = a [ className "btn btn-outline-primary btn-sm spacing-class"
              , href b.href
              , target "blank"
              , title b.title
              ] [ span [ aria {hidden : true}
                       , className "glyphicon glyphicon-hand-right"
                       ]  []
                , text b.text
                ]

jumboTitle :: LandingData -> Boolean -> ReactElement
jumboTitle (LandingData hd) b = div jumbo
                   [ div [className "row"             ]
                     [ div [ className "col-md-8 content"]
81
                           [ div [ className "left" ]
82 83 84
                               [ div [_id "logo-designed" ]
                                 [ img [ src "images/logo.png"
                                       , title hd.logoTitle
Sudhir Kumar's avatar
Sudhir Kumar committed
85
                                       ]
86 87 88 89 90 91 92 93
                                 ]
                               ]
                           ]
                     , div [ className "col-md-4 content"]
                           [ img [ src "images/Gargantextuel.jpg"
                                   , _id "funnyimg"
                                   , title hd.imageTitle
                                   ]
Sudhir Kumar's avatar
Sudhir Kumar committed
94

95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
                           ]
                     ]
                   ]
                  where
                    jumbo = case b of
                                 true  -> [className "jumbotron"]
                                 false -> []

imageEnter :: LandingData -> Props -> ReactElement
imageEnter (LandingData hd) action =  div [className "row"]
                           [ div [className "col-md-offset-5 col-md-6 content"]
                             [ img [ src "images/Gargantextuel-212x300.jpg"
                                   , _id "funnyimg"
                                   , title hd.imageTitle
                                   , action
                                   ]
                             ]
                           ]