diff options
Diffstat (limited to 'Biz/Ibb/Core.hs')
| -rw-r--r-- | Biz/Ibb/Core.hs | 184 |
1 files changed, 99 insertions, 85 deletions
diff --git a/Biz/Ibb/Core.hs b/Biz/Ibb/Core.hs index fb82ff0..2c1fbae 100644 --- a/Biz/Ibb/Core.hs +++ b/Biz/Ibb/Core.hs @@ -1,53 +1,59 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} -- | 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 +import Alpha +import Data.Aeson hiding (Success) +import Data.Data + ( Data, + Typeable, + ) +import Data.Text (Text) +import GHC.Generics (Generic) +import Miso +import Miso.String +import Network.RemoteData +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) +data Person + = Person + { -- | Their full name. + _name :: Text, + -- | A link to their picture. + _pic :: Text, + -- | Their twitter handle, without the `@` prefix. + _twitter :: Text, + -- | Their main website, fully formed: `https://example.com` + _website :: Text, + -- | A short list of the books they recommend. + _books :: [Book], + -- | A short "about" section, like you would see on the jacket flap of a book. + _blurb :: Text + } + 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) +data Book + = Book + { _title :: Text, + _author :: Text, + -- | Amazon REF number, for creating affiliate links. + _amznref :: Text + } + deriving (Generic, Show, Eq, Typeable, Data, Ord) instance FromJSON Book + instance ToJSON Book -- * app data types @@ -56,10 +62,12 @@ type AppRoutes = Home type Home = View Action -data Model = Model - { uri :: URI - , people :: WebData [Person] - } deriving (Show, Eq) +data Model + = Model + { uri :: URI, + people :: WebData [Person] + } + deriving (Show, Eq) type WebData a = RemoteData MisoString a @@ -87,57 +95,63 @@ 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." - ] - ] +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 ] - , 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) +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] ] - [] - , 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] - ] +seeBook book = + li_ + [] + [ a_ + [ class_ "text-dark", + href_ $ "https://www.amazon.com/dp/" <> (ms $ _amznref book) + ] + [text $ ms $ _title book] + ] |