diff options
author | Ben Sima <ben@bsima.me> | 2020-12-24 14:24:16 -0500 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2020-12-24 14:24:16 -0500 |
commit | 6eaaf3d8ce6025932990de6fa697d14c9651be76 (patch) | |
tree | 65ca4a0dd0393db98d9a6067bbbef789469e8122 /Biz/Ibb | |
parent | 6a4a8aa37044d578c95dea145b9605908b8dc28d (diff) |
linting fixes and cleanup
Diffstat (limited to 'Biz/Ibb')
-rw-r--r-- | Biz/Ibb/Client.hs | 2 | ||||
-rw-r--r-- | Biz/Ibb/Core.hs | 69 | ||||
-rw-r--r-- | Biz/Ibb/Influencers.hs | 14 | ||||
-rw-r--r-- | Biz/Ibb/Keep.hs | 31 | ||||
-rw-r--r-- | Biz/Ibb/Move.hs | 9 | ||||
-rw-r--r-- | Biz/Ibb/Server.hs | 52 |
6 files changed, 87 insertions, 90 deletions
diff --git a/Biz/Ibb/Client.hs b/Biz/Ibb/Client.hs index d0ed3e3..efe4e84 100644 --- a/Biz/Ibb/Client.hs +++ b/Biz/Ibb/Client.hs @@ -29,7 +29,7 @@ import Miso ) main :: IO () -main = miso $ \u -> App {model = init u, ..} +main = miso <| \u -> App {model = init u, ..} where initialAction = FetchPeople update = move diff --git a/Biz/Ibb/Core.hs b/Biz/Ibb/Core.hs index 007d835..ec6ef10 100644 --- a/Biz/Ibb/Core.hs +++ b/Biz/Ibb/Core.hs @@ -22,34 +22,32 @@ import Servant.Links -- * entity data types -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 - } +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, - -- | Amazon REF number, for creating affiliate links. - _amznref :: Text - } +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 @@ -62,11 +60,10 @@ type AppRoutes = Home type Home = View Action -data Model - = Model - { uri :: URI, - people :: WebData [Person] - } +data Model = Model + { uri :: URI, + people :: WebData [Person] + } deriving (Show, Eq) type WebData a = RemoteData MisoString a @@ -92,7 +89,7 @@ notfound :: View Action 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 = @@ -113,7 +110,7 @@ see m = ] ] ], - div_ [class_ "card-columns"] $ case people m of + div_ [class_ "card-columns"] <| case people m of NotAsked -> [text "Initializing..."] Loading -> [text "Loading..."] Failure err -> [text err] @@ -126,22 +123,22 @@ seePerson person = [class_ "card"] [ div_ [class_ "card-img"] - [img_ [class_ "card-img img-fluid", src_ $ ms $ _pic person]], + [img_ [class_ "card-img img-fluid", src_ <| ms <| _pic person]], div_ [class_ "card-body"] - [ h4_ [class_ "card-title"] [text $ ms $ _name person], + [ h4_ [class_ "card-title"] [text <| ms <| _name person], h6_ [] [ a_ [ class_ "fab fa-twitter", - href_ $ "https://twitter.com/" <> ms (_twitter person) + href_ <| "https://twitter.com/" <> ms (_twitter person) ] [], - a_ [class_ "fas fa-globe", href_ $ ms $ _website person] [] + a_ [class_ "fas fa-globe", href_ <| ms <| _website person] [] ], p_ [class_ "card-text"] - [text $ ms $ _blurb person, ul_ [] $ seeBook </ _books person] + [text <| ms <| _blurb person, ul_ [] <| seeBook </ _books person] ] ] @@ -151,7 +148,7 @@ seeBook book = [] [ a_ [ class_ "text-dark", - href_ $ "https://www.amazon.com/dp/" <> ms (_amznref book) + href_ <| "https://www.amazon.com/dp/" <> ms (_amznref book) ] - [text $ ms $ _title book] + [text <| ms <| _title book] ] diff --git a/Biz/Ibb/Influencers.hs b/Biz/Ibb/Influencers.hs index 08ce3e8..e41f5b1 100644 --- a/Biz/Ibb/Influencers.hs +++ b/Biz/Ibb/Influencers.hs @@ -81,7 +81,7 @@ allPeople = { _name = "Bill Gates", _pic = "https://pbs.twimg.com/profile_images/988775660163252226/XpgonN0X_400x400.jpg", _twitter = "BillGates", - _blurb = "Sharing things I'm learning through my foundation work and other interests. Founder of Microsoft and Bill & Melinda Gates Foundation", + _blurb = "Sharing things I'm learning through my foundation work and other interests. Founder of Microsoft and Bill |> Melinda Gates Foundation", _website = "https://www.gatesnotes.com", _books = [ Book @@ -138,7 +138,7 @@ allPeople = { _name = "Susan Cain", _pic = "https://pbs.twimg.com/profile_images/1474290079/SusanCain5smaller-1_400x400.jpg", _twitter = "susancain", - _blurb = "Bestselling author, award-winning speaker, http://Quietrev.com curator. Lover of bittersweet music & bittersweet chocolate, in equal measure.", + _blurb = "Bestselling author, award-winning speaker, http://Quietrev.com curator. Lover of bittersweet music |> bittersweet chocolate, in equal measure.", _website = "https://www.quietrev.com", _books = [ Book @@ -195,7 +195,7 @@ allPeople = { _name = "Luis Von Ahn", _pic = "https://pbs.twimg.com/profile_images/1020343581087678464/NIXD5MdC_400x400.jpg", _twitter = "LuisvonAhn", - _blurb = "CEO & co-founder of duolingo. Invented reCAPTCHA. Computer science professor at Carnegie Mellon. Proud Guatemalan", + _blurb = "CEO |> co-founder of duolingo. Invented reCAPTCHA. Computer science professor at Carnegie Mellon. Proud Guatemalan", _website = "https://www.duolingo.com/", _books = [ Book @@ -271,7 +271,7 @@ allPeople = { _name = "Allen Walton", _pic = "https://pbs.twimg.com/profile_images/1038905908678545409/yUbF9Ruc_400x400.jpg", _twitter = "allenthird", - _blurb = "Created http://SpyGuy.com and blogs about stuff at http://AllenWalton.com . All things ecommerce, personal dev, and Simpsons.", + _blurb = "Created http://SpyGuy.com and blogs about stuff at http://AllenWalton.com <. All things ecommerce, personal dev, and Simpsons.", _website = "https://www.allenwalton.com", _books = [ Book @@ -290,7 +290,7 @@ allPeople = { _name = "Peter Mallouk", _pic = "https://pbs.twimg.com/profile_images/713172266968715264/KsyDYghf_400x400.jpg", _twitter = "PeterMallouk", - _blurb = "President of Creative Planning. Author “5 Mistakes Every Investor Makes & How to Avoid Them”. Radically moderate.", + _blurb = "President of Creative Planning. Author “5 Mistakes Every Investor Makes |> How to Avoid Them”. Radically moderate.", _website = "https://creativeplanning.com", _books = [ Book @@ -423,7 +423,7 @@ allPeople = { _name = "Robert Herjavec", _pic = "https://pbs.twimg.com/profile_images/608643660876423170/DgxUW3eZ_400x400.jpg", _twitter = "robertherjavec", - _blurb = "Dad, Husband, Founder & CEO of global cybersecurity firm HerjavecGroup, Shark on ABC’s Shark Tank, Former Dragon, Author", + _blurb = "Dad, Husband, Founder |> CEO of global cybersecurity firm HerjavecGroup, Shark on ABC’s Shark Tank, Former Dragon, Author", _website = "https://www.robertherjavec.com/", _books = [ Book @@ -470,7 +470,7 @@ allPeople = _amznref = "1585424331" }, Book - { _title = "How to Win Friends & Influence People", + { _title = "How to Win Friends |> Influence People", _author = "Dale Carnegie", _amznref = "0671027034" } diff --git a/Biz/Ibb/Keep.hs b/Biz/Ibb/Keep.hs index c7dabb0..074a42a 100644 --- a/Biz/Ibb/Keep.hs +++ b/Biz/Ibb/Keep.hs @@ -28,10 +28,9 @@ import qualified Data.Text as Text -- * Keep -- | Main database. Need to think of a better name for this. -newtype IbbKeep - = IbbKeep - { _people :: IxSet Person - } +newtype IbbKeep = IbbKeep + { _people :: IxSet Person + } deriving (Data, Typeable) $(deriveSafeCopy 0 'base ''IbbKeep) @@ -51,20 +50,20 @@ newtype PersonBlurb instance Indexable Person where empty = ixSet - [ ixFun $ \p -> [PersonName $ _name p], - ixFun $ \p -> [_pic p], - ixFun $ \p -> [_twitter p], - ixFun $ \p -> [_website p], - ixFun $ \p -> [_books p], - ixFun $ \p -> [PersonBlurb $ _blurb p] + [ ixFun <| \p -> [PersonName <| _name p], + ixFun <| \p -> [_pic p], + ixFun <| \p -> [_twitter p], + ixFun <| \p -> [_website p], + ixFun <| \p -> [_books p], + ixFun <| \p -> [PersonBlurb <| _blurb p] ] -- | updates the `IbbKeep` with a new `Person` newPerson :: Text -> Text -> Update IbbKeep Person newPerson name blurb = do keep <- get - put $ - k + put + <| k { _people = IxSet.insert p (_people k) } return p @@ -97,16 +96,16 @@ newtype BookAuthor instance Indexable Book where empty = ixSet - [ ixFun $ \b -> [BookTitle $ _title b], - ixFun $ \b -> [BookAuthor $ _author b], - ixFun $ \b -> [_amznref b] + [ ixFun <| \b -> [BookTitle <| _title b], + ixFun <| \b -> [BookAuthor <| _author b], + ixFun <| \b -> [_amznref b] ] -- | updates the `IbbKeep` with a new `Book` -- newBook :: Text -> Text -> Text -> Update IbbKeep Book -- newBook title author amznref = do -- ibbKeep <- get --- put $ ibbKeep { _books = IxSet.insert b (_books ibbKeep) +-- put <| ibbKeep { _books = IxSet.insert b (_books ibbKeep) -- , _people = _people ibbKeep -- } -- return b diff --git a/Biz/Ibb/Move.hs b/Biz/Ibb/Move.hs index 0dec4e5..2135f85 100644 --- a/Biz/Ibb/Move.hs +++ b/Biz/Ibb/Move.hs @@ -27,8 +27,9 @@ import Network.RemoteData move :: Action -> Model -> Effect Action Model 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 (ChangeRoute u) m = + m <# do + pushURI u >> pure Nop move FetchPeople m = m <# (SetPeople </ fetchPeople) move (SetPeople ps) m = noEff m {people = ps} @@ -36,9 +37,9 @@ fetchPeople :: IO (WebData [Core.Person]) fetchPeople = do mjson <- contents </ xhrByteString req case mjson of - Nothing -> pure $ Failure "could not read from server" + Nothing -> pure <| Failure "could not read from server" Just a -> - pure $ fromEither $ either (Left . ms) pure $ eitherDecodeStrict a + pure <| fromEither <| either (Left <. ms) pure <| eitherDecodeStrict a where req = Request diff --git a/Biz/Ibb/Server.hs b/Biz/Ibb/Server.hs index 058bbdc..3e4b662 100644 --- a/Biz/Ibb/Server.hs +++ b/Biz/Ibb/Server.hs @@ -56,10 +56,10 @@ main :: IO () main = do say "rise: ibb" staticDir <- fromMaybe "static" <$> lookupEnv "STATIC_DIR" :: IO String - port <- (read . fromMaybe "3000" <$> lookupEnv "PORT") :: IO Int + port <- (read <. fromMaybe "3000" <$> lookupEnv "PORT") :: IO Int keep <- Keep.openLocal "_/keep/" say "port: 3000" - run port $ logStdout $ compress $ app staticDir keep + run port <| logStdout <| compress <| app staticDir keep where compress = gzip def {gzipFiles = GzipCompress} @@ -68,12 +68,13 @@ newtype HtmlPage a = HtmlPage a 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_ page + 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_ page where page = L.toHtml x jsRef href = @@ -94,18 +95,17 @@ type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action handle404 :: Application handle404 _ respond = respond - $ responseLBS status404 [("Content-Type", "text/html")] - $ renderBS - $ toHtml - $ HtmlPage notfound + <| responseLBS status404 [("Content-Type", "text/html")] + <| renderBS + <| toHtml + <| HtmlPage notfound -newtype CSS - = CSS - { unCSS :: Text - } +newtype CSS = CSS + { unCSS :: Text + } instance MimeRender CSS Text where - mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict + mimeRender _ = Lazy.encodeUtf8 <. Lazy.fromStrict instance Accept CSS where contentType _ = "text" // "css" /: ("charset", "utf-8") @@ -122,16 +122,16 @@ type Routes = :<|> Raw cssHandlers :: Server CssRoute -cssHandlers = return . Lazy.toStrict . Clay.render $ Look.main +cssHandlers = return <. Lazy.toStrict <. Clay.render <| Look.main app :: String -> AcidState Keep.IbbKeep -> Application app staticDir keep = - serve (Proxy @Routes) $ - static - :<|> cssHandlers - :<|> serverHandlers - :<|> apiHandlers keep - :<|> Tagged handle404 + serve (Proxy @Routes) + <| static + :<|> cssHandlers + :<|> serverHandlers + :<|> apiHandlers keep + :<|> Tagged handle404 where static = serveDirectoryWith (defaultWebAppSettings staticDir) @@ -140,9 +140,9 @@ type ApiRoutes = "people" :> Get '[JSON] [Person] serverHandlers :: Server ServerRoutes serverHandlers = homeHandler where - send f u = pure $ HtmlPage $ f Model {uri = u, people = NotAsked} + 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 |