Re-namespacing

Moving away from the DNS-driven namespacing toward more condensed names,
mostly because I don't like typing so much.

1 files changed, 143 insertions, 0 deletions

diff --git a/Biz/Ibb/Core.hs b/Biz/Ibb/Core.hs
new file mode 100644
index 0000000..fb82ff0
--- /dev/null
+++ b/Biz/Ibb/Core.hs
@@ -0,0 +1,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]
+  ]