summaryrefslogtreecommitdiff
path: root/lore/Biz/Ibb/Core.hs
blob: 39f506ce9da813c2de6f53eeea95473434fa0637 (plain)
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}

-- | Main app logic
module Biz.Ibb.Core where

import Alpha
import Biz.Ibb.Influencers
import Miso
import Miso.String
import Network.RemoteData
import Servant.API
import Servant.Links

type Routes = Home

type Home = View Action

data Model = Model
  { uri :: URI
  , people :: WebData [Person]
  } deriving (Show, Eq)

type WebData a = RemoteData MisoString a

init :: URI -> Model
init u = Model u Loading

data Action
  = Nop
  | ChangeRoute URI
  | HandleRoute URI
  | FetchPeople
  | SetPeople (WebData [Person])
  deriving (Show, Eq)

home :: Model -> View Action
home m = see m

handlers :: Model -> View Action
handlers = home

notfound :: View Action
notfound = div_ [] [ text "404" ]

goHome :: URI
goHome = linkURI $ safeLink
  (Proxy :: Proxy Routes)
  (Proxy :: Proxy Home)

see :: Model -> View Action
see m = div_ [ class_ "container mt-5" ]
  [ div_ [ class_ "jumbotron" ]
      [ h1_ [ class_ "display-4" ] [ text "Influenced by books" ]
      , p_ [ class_ "lead" ] [ text "Influential people and the books that made them." ]
      , p_ [ class_ "lead" ]
        [ a_ [ href_ "http://eepurl.com/ghBFjv" ]
            [ text "Get new book recommendations from the world's influencers in your email." ]
        ]
      ]
  , div_ [ class_ "card-columns" ] $ case people m of
      NotAsked -> [ text "Initializing..." ]
      Loading -> [ text "Loading..." ]
      Failure err -> [ text err ]
      Success ps -> seePerson /@ ps
  ]

seePerson :: Person -> View Action
seePerson person = div_ [ class_ "card" ]
  [ div_ [ class_ "card-img" ]
    [ img_ [ class_ "card-img img-fluid", src_ $ ms $ _pic person ]]
  , div_ [ class_ "card-body" ]
    [ h4_ [ class_ "card-title" ] [ text $ ms $ _name person ]
    , h6_ [] [ a_ [ class_ "fab fa-twitter"
                  , href_ $ "https://twitter.com/" <> (ms $ _twitter person) ] []
             , a_ [ class_ "fas fa-globe", href_ $ ms $ _website person ] []
             ]
    , p_ [ class_ "card-text" ]
      [ text $ ms $ _blurb person
      , ul_ [] $ seeBook /@ _books person
      ]
    ]
  ]

seeBook :: Book -> View Action
seeBook book = li_ []
  [ a_ [ class_ "text-dark"
       , href_ $ "https://www.amazon.com/dp/" <> (ms $ _amznref book)
       ]
    [ text $ ms $ _title book ]
  ]