summaryrefslogtreecommitdiff
path: root/Biz/Ibb/Core.hs
blob: fb82ff08d28f739f1f0de5c3d65c23a3a3680227 (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
92
93
94
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
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}

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

import           Alpha
import           Network.RemoteData
import           Data.Aeson              hiding ( Success )
import           Data.Data                      ( Data
                                                , Typeable
                                                )
import           Data.Text                      ( Text )
import           GHC.Generics                   ( Generic )
import           Miso
import           Miso.String
import           Servant.API
import           Servant.Links

-- * entity data types

data Person = Person
  { _name :: Text
  -- ^ Their full name.
  , _pic :: Text
  -- ^ A link to their picture.
  , _twitter :: Text
  -- ^ Their twitter handle, without the `@` prefix.
  , _website :: Text
  -- ^ Their main website, fully formed: `https://example.com`
  , _books :: [Book]
  -- ^ A short list of the books they recommend.
  , _blurb :: Text
  -- ^ A short "about" section, like you would see on the jacket flap of a book.
  } deriving (Generic, Show, Eq, Typeable, Data, Ord)

instance FromJSON Person
instance ToJSON Person

data Book = Book
  { _title :: Text
  , _author :: Text
  , _amznref :: Text
  -- ^ Amazon REF number, for creating affiliate links.
  } deriving (Generic, Show, Eq, Typeable, Data, Ord)

instance FromJSON Book
instance ToJSON Book

-- * app data types

type AppRoutes = 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 AppRoutes) (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]
  ]