De-namespace Alpha

A bunch of formatting changes got in there too. Oops.

I will probably eventually de-namespace everything, mostly because I'm
tired of typing "Com.Whatever.Thing" all the time. A better namespacing
strategy might be to use normal Haskell namespacing (Data, Control,
Network, etc) for code that is not specific to biz activities (i.e. if I
could open-source it at any time), and use simply "Biz" for stuff that I
would never want to open-source.

5 files changed, 197 insertions, 171 deletions

diff --git a/Com/InfluencedByBooks/Client.hs b/Com/InfluencedByBooks/Client.hs
index a7da344..8c70a04 100644
--- a/Com/InfluencedByBooks/Client.hs
+++ b/Com/InfluencedByBooks/Client.hs
@@ -16,17 +16,23 @@
 -- : dep ghcjs-base
 module Com.InfluencedByBooks.Client where
 
-import Com.InfluencedByBooks.Core (Action(..), see, init)
-import Com.InfluencedByBooks.Move (move)
-import Com.Simatime.Alpha
-import Miso (App(..), defaultEvents, miso)
+import           Alpha
+import           Com.InfluencedByBooks.Core     ( Action(..)
+                                                , see
+                                                , init
+                                                )
+import           Com.InfluencedByBooks.Move     ( move )
+import           Miso                           ( App(..)
+                                                , defaultEvents
+                                                , miso
+                                                )
 
 main :: IO ()
 main = miso $ \u -> App { model = init u, .. }
-  where
-    initialAction = FetchPeople
-    update = move
-    view   = see
-    events = defaultEvents
-    subs   = []
-    mountPoint = Nothing
+ where
+  initialAction = FetchPeople
+  update        = move
+  view          = see
+  events        = defaultEvents
+  subs          = []
+  mountPoint    = Nothing
diff --git a/Com/InfluencedByBooks/Core.hs b/Com/InfluencedByBooks/Core.hs
index 6984004..2b98914 100644
--- a/Com/InfluencedByBooks/Core.hs
+++ b/Com/InfluencedByBooks/Core.hs
@@ -7,16 +7,18 @@
 -- | Main app logic
 module Com.InfluencedByBooks.Core where
 
-import Com.Simatime.Alpha
-import Com.Simatime.Network
-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           Com.Simatime.Network
+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
 
@@ -79,51 +81,63 @@ handlers :: Model -> View Action
 handlers = home
 
 notfound :: View Action
-notfound = div_ [] [ text "404" ]
+notfound = div_ [] [text "404"]
 
 goHome :: URI
-goHome = linkURI $ safeLink
-  (Proxy :: Proxy AppRoutes)
-  (Proxy :: Proxy Home)
+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) ] []
-             , a_ [ class_ "fas fa-globe", href_ $ ms $ _website person ] []
-             ]
-    , p_ [ class_ "card-text" ]
-      [ text $ ms $ _blurb person
-      , ul_ [] $ seeBook </ _books 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]
     ]
   ]
 
 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]
   ]
diff --git a/Com/InfluencedByBooks/Look.hs b/Com/InfluencedByBooks/Look.hs
index acc9e34..d904d3a 100644
--- a/Com/InfluencedByBooks/Look.hs
+++ b/Com/InfluencedByBooks/Look.hs
@@ -2,14 +2,14 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -- | The look and feel of Ibb
-module Com.InfluencedByBooks.Look  where
+module Com.InfluencedByBooks.Look where
 
+import           Alpha                   hiding ( Selector )
 import           Clay
-import qualified Clay.Flexbox as Flexbox
-import qualified Clay.Media as Media
-import qualified Clay.Render as Clay
-import qualified Clay.Stylesheet as Stylesheet
-import           Com.Simatime.Alpha hiding (Selector)
+import qualified Clay.Flexbox                  as Flexbox
+import qualified Clay.Media                    as Media
+import qualified Clay.Render                   as Clay
+import qualified Clay.Stylesheet               as Stylesheet
 
 main :: Css
 main = do
@@ -25,18 +25,16 @@ main = do
     display flex
     justifyContent center
     flexDirection column
-    fontFamily [ "GillSans"
-               , "Calibri"
-               , "Trebuchet"
-               ] [sansSerif]
+    fontFamily ["GillSans", "Calibri", "Trebuchet"] [sansSerif]
   headings ? do
-    fontFamily [ "Palatino"
-               , "Palatino Linotype"
-               , "Hoefler Text"
-               , "Times New Roman"
-               , "Times"
-               ] [serif]
+    fontFamily
+      [ "Palatino"
+      , "Palatino Linotype"
+      , "Hoefler Text"
+      , "Times New Roman"
+      , "Times"
+      ]
+      [serif]
 
 headings :: Selector
-headings =
-  h1 <> h2 <> h3 <> h4 <> h5 <> h6
+headings = h1 <> h2 <> h3 <> h4 <> h5 <> h6
diff --git a/Com/InfluencedByBooks/Move.hs b/Com/InfluencedByBooks/Move.hs
index d6cb12e..5d6f0c4 100644
--- a/Com/InfluencedByBooks/Move.hs
+++ b/Com/InfluencedByBooks/Move.hs
@@ -2,25 +2,32 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | App update logic
-module Com.InfluencedByBooks.Move (
-    move
+module Com.InfluencedByBooks.Move
+  ( move
   -- * Server interactions
   , fetchPeople
-  ) where
+  )
+where
 
-import Com.InfluencedByBooks.Core as Core
-import Com.Simatime.Alpha
-import Com.Simatime.Network
-import Data.Aeson
-import JavaScript.Web.XMLHttpRequest (Request(..), Method(GET), RequestData(NoData), contents, xhrByteString)
-import Miso
-import Miso.String
+import           Alpha
+import           Com.InfluencedByBooks.Core    as Core
+import           Com.Simatime.Network
+import           Data.Aeson
+import           JavaScript.Web.XMLHttpRequest  ( Request(..)
+                                                , Method(GET)
+                                                , RequestData(NoData)
+                                                , contents
+                                                , xhrByteString
+                                                )
+import           Miso
+import           Miso.String
 
 move :: Action -> Model -> Effect Action Model
-move Nop m = noEff m
+move Nop             m = noEff m
 move (HandleRoute u) m = m { uri = u } <# pure Nop
-move (ChangeRoute u) m = m <# do pushURI u >> pure Nop
-move FetchPeople m = m <# (SetPeople </ fetchPeople)
+move (ChangeRoute u) m = m <# do
+  pushURI u >> pure Nop
+move FetchPeople    m = m <# (SetPeople </ fetchPeople)
 move (SetPeople ps) m = noEff m { people = ps }
 
 fetchPeople :: IO (WebData [Core.Person])
@@ -28,16 +35,14 @@ fetchPeople = do
   mjson <- contents </ xhrByteString req
   case mjson of
     Nothing -> pure $ Failure "could not read from server"
-    Just a -> pure
-      $ fromEither
-      $ either (Left . ms) pure
-      $ eitherDecodeStrict a
-  where
-    req = Request { reqMethod = GET
-                  -- FIXME: can replace this hardcoding with a function?
-                  , reqURI = "/api/people"
-                  , reqLogin = Nothing
-                  , reqHeaders = []
-                  , reqWithCredentials = False
-                  , reqData = NoData
-                  }
+    Just a ->
+      pure $ fromEither $ either (Left . ms) pure $ eitherDecodeStrict a
+ where
+  req = Request { reqMethod          = GET
+                -- FIXME: can replace this hardcoding with a function?
+                , reqURI             = "/api/people"
+                , reqLogin           = Nothing
+                , reqHeaders         = []
+                , reqWithCredentials = False
+                , reqData            = NoData
+                }
diff --git a/Com/InfluencedByBooks/Server.hs b/Com/InfluencedByBooks/Server.hs
index 28a7471..244a7ca 100644
--- a/Com/InfluencedByBooks/Server.hs
+++ b/Com/InfluencedByBooks/Server.hs
@@ -27,21 +27,23 @@
 -- : dep text
 module Com.InfluencedByBooks.Server where
 
+import           Alpha
 import qualified Clay
 import           Com.InfluencedByBooks.Core
-import qualified Com.InfluencedByBooks.Keep as Keep
-import qualified Com.InfluencedByBooks.Look as Look
-import           Com.Simatime.Alpha
+import qualified Com.InfluencedByBooks.Keep    as Keep
+import qualified Com.InfluencedByBooks.Look    as Look
 import           Com.Simatime.Network
-import           Data.Acid (AcidState)
-import qualified Data.Acid.Abstract as Acid
-import           Data.Maybe (fromMaybe)
-import qualified Data.Text.Lazy as Lazy
-import qualified Data.Text.Lazy.Encoding as Lazy
-import qualified Lucid as L
+import           Data.Acid                      ( AcidState )
+import qualified Data.Acid.Abstract            as Acid
+import           Data.Maybe                     ( fromMaybe )
+import qualified Data.Text.Lazy                as Lazy
+import qualified Data.Text.Lazy.Encoding       as Lazy
+import qualified Lucid                         as L
 import           Lucid.Base
 import           Miso
-import           Network.HTTP.Media ((//), (/:))
+import           Network.HTTP.Media             ( (//)
+                                                , (/:)
+                                                )
 import           Network.HTTP.Types
 import           Network.Wai
 import           Network.Wai.Application.Static
@@ -49,58 +51,57 @@ import           Network.Wai.Handler.Warp
 import           Network.Wai.Middleware.Gzip
 import           Network.Wai.Middleware.RequestLogger
 import           Servant
-import           System.Environment (lookupEnv)
+import           System.Environment             ( lookupEnv )
 
 main :: IO ()
 main = do
   say "rise: ibb"
-  staticDir <- fromMaybe "static"
-    <$> lookupEnv "STATIC_DIR" :: IO [Char]
-  port <- read
-    <$> fromMaybe "3000"
-    <$> lookupEnv "PORT" :: IO Int
-  keep <- Keep.openLocal "_keep/"
+  staticDir <- fromMaybe "static" <$> lookupEnv "STATIC_DIR" :: IO [Char]
+  port      <- read <$> fromMaybe "3000" <$> lookupEnv "PORT" :: IO Int
+  keep      <- Keep.openLocal "_keep/"
   say "port: 3000"
   run port $ logStdout $ compress $ app staticDir $ keep
-    where
-      compress = gzip def { gzipFiles = GzipCompress }
+  where compress = gzip def { gzipFiles = GzipCompress }
 
 newtype HtmlPage a = HtmlPage a
   deriving (Show, Eq)
 
 instance L.ToHtml a => L.ToHtml (HtmlPage a) where
   toHtmlRaw = L.toHtml
-  toHtml (HtmlPage x) =
-    L.doctypehtml_ $ do
-      L.head_ $ do
-        L.meta_ [L.charset_ "utf-8"]
-        jsRef "/static/ibb.js"
-        cssRef "/css/main.css"
-      L.body_ $ do
-        page
-    where
-      page = L.toHtml x
-      jsRef href = L.with (L.script_ mempty)
-        [ makeAttribute "src" href
-        , makeAttribute "type" "text/javascript"
-        , makeAttribute "async" mempty
-        , makeAttribute "defer" mempty
-        ]
-      cssRef href = L.with
-        (L.link_ mempty)
-        [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href]
+  toHtml (HtmlPage x) = L.doctypehtml_ $ do
+    L.head_ $ do
+      L.meta_ [L.charset_ "utf-8"]
+      jsRef "/static/ibb.js"
+      cssRef "/css/main.css"
+    L.body_ $ do
+      page
+   where
+    page = L.toHtml x
+    jsRef href = L.with
+      (L.script_ mempty)
+      [ makeAttribute "src"   href
+      , makeAttribute "type"  "text/javascript"
+      , makeAttribute "async" mempty
+      , makeAttribute "defer" mempty
+      ]
+    cssRef href = L.with
+      (L.link_ mempty)
+      [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href]
 
 type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action
 
 handle404 :: Application
-handle404 _ respond = respond
-  $ responseLBS status404 [("Content-Type", "text/html")]
-  $ renderBS
-  $ toHtml
-  $ HtmlPage
-  $ notfound
-
-newtype CSS = CSS { unCSS :: Text }
+handle404 _ respond =
+  respond
+    $ responseLBS status404 [("Content-Type", "text/html")]
+    $ renderBS
+    $ toHtml
+    $ HtmlPage
+    $ notfound
+
+newtype CSS = CSS
+  { unCSS :: Text
+  }
 
 instance MimeRender CSS Text where
   mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict
@@ -111,39 +112,41 @@ instance Accept CSS where
 type CssRoute = "css" :> "main.css" :> Get '[CSS] Text
 
 type Routes
-  = "static" :> Raw
-  :<|> CssRoute
-  :<|> ServerRoutes
-  :<|> "api" :> ApiRoutes
-  :<|> Raw
+  = "static"
+      :>
+      Raw
+      :<|>
+      CssRoute
+      :<|>
+      ServerRoutes
+      :<|>
+      "api"
+      :>
+      ApiRoutes
+      :<|>
+      Raw
 
 cssHandlers :: Server CssRoute
-cssHandlers = return . Lazy.toStrict . Clay.render
-    $ Look.main
+cssHandlers = return . Lazy.toStrict . Clay.render $ Look.main
 
 app :: [Char] -> AcidState Keep.IbbKeep -> Application
-app staticDir keep = serve
-  (Proxy @Routes)
-  $ static
-  :<|> cssHandlers
-  :<|> serverHandlers
-  :<|> apiHandlers keep
-  :<|> Tagged handle404
-  where
-    static = serveDirectoryWith
-      (defaultWebAppSettings $ staticDir)
-
-type ApiRoutes =
-  "people" :> Get '[JSON] [Person]
+app staticDir keep =
+  serve (Proxy @Routes)
+    $    static
+    :<|> cssHandlers
+    :<|> serverHandlers
+    :<|> apiHandlers keep
+    :<|> Tagged handle404
+  where static = serveDirectoryWith (defaultWebAppSettings $ staticDir)
+
+type ApiRoutes = "people" :> Get '[JSON] [Person]
 
 serverHandlers :: Server ServerRoutes
 serverHandlers = homeHandler
-  where
-    send f u =
-      pure $ HtmlPage $ f Model { uri = u, people = NotAsked }
-    homeHandler = send home goHome
+ where
+  send f u = pure $ HtmlPage $ f Model { uri = u, people = NotAsked }
+  homeHandler = send home goHome
 
 -- | for now we just have one api endpoint, which returns all the people
 apiHandlers :: AcidState Keep.IbbKeep -> Server ApiRoutes
-apiHandlers keep =
-  Acid.query' keep $ Keep.GetPeople 20
+apiHandlers keep = Acid.query' keep $ Keep.GetPeople 20