react-haskell/example/src/Slide.hs at ebc0a60b1ffb2d1c0b47527ef3a86e1cbe8c0eca · joelburget/react-haskell · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
{-# LANGUAGE OverloadedStrings, TypeFamilies, ExtendedDefaultRules,
  LiberalTypeSynonyms #-}
module Slide (slideClass) where

import Control.Applicative

import Haste
import Haste.JSON
import Lens.Family2 hiding (view)
import React
import React.Anim
import React.Anim.Class


-- model

data SlideState = Open | Closed
data Toggle = Toggle deriving Show
type Slide a = a SlideState Toggle Double

initialClassState :: SlideState
initialClassState = Closed

initialAnimationState :: Double
initialAnimationState = 0

-- update

paneWidth = 200

slide :: Double -> AnimConfig Toggle Double
slide from = AnimConfig
    { duration = 1000
    , lens = id
    , endpoints = (from, 0)
    , easing = EaseInOutQuad
    , onComplete = const Nothing
    }

transition :: Toggle -> SlideState -> (SlideState, [AnimConfig Toggle Double])
transition Toggle Open = (Closed, [ slide paneWidth ])
transition Toggle Closed = (Open, [ slide (-paneWidth) ])


-- view

view :: SlideState -> Double -> Slide ReactA'
view slid animWidth = div_ [ class_ "slider-container" ] $ do

    let inherentWidth = case slid of
            Open -> paneWidth
            Closed -> 0

    div_ $ button_ [ class_ "btn btn--m btn--gray-border", onClick (const (Just Toggle)) ] "toggle"
    div_ [ class_ "slider"
         , style_ (Dict [("width", Num (inherentWidth + animWidth))])
         ]
         ""

slideClass :: IO (Slide ReactClassA')
slideClass =
    createClass view transition initialClassState initialAnimationState []