From 6eaaf3d8ce6025932990de6fa697d14c9651be76 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Thu, 24 Dec 2020 14:24:16 -0500 Subject: linting fixes and cleanup --- Biz/App.hs | 2 +- Biz/Auth.hs | 4 ++- Biz/Bild/Deps/Haskell.nix | 1 - Biz/Ibb/Client.hs | 2 +- Biz/Ibb/Core.hs | 69 +++++++++++++++++++++++------------------------ Biz/Ibb/Influencers.hs | 14 +++++----- Biz/Ibb/Keep.hs | 31 +++++++++++---------- Biz/Ibb/Move.hs | 9 ++++--- Biz/Ibb/Server.hs | 52 +++++++++++++++++------------------ Biz/Pie.hs | 14 +++++----- Biz/Que/Host.hs | 14 +++++----- 11 files changed, 105 insertions(+), 107 deletions(-) (limited to 'Biz') diff --git a/Biz/App.hs b/Biz/App.hs index 5759499..5e66f71 100644 --- a/Biz/App.hs +++ b/Biz/App.hs @@ -29,7 +29,7 @@ instance Accept CSS where contentType _ = "text" // "css" /: ("charset", "utf-8") instance MimeRender CSS Text where - mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict + mimeRender _ = Lazy.encodeUtf8 <. Lazy.fromStrict -- | The manifest describes your app for web app thumbnails, iPhone tiles, etc. data Manifest = Manifest diff --git a/Biz/Auth.hs b/Biz/Auth.hs index 2f4d17a..3648395 100644 --- a/Biz/Auth.hs +++ b/Biz/Auth.hs @@ -2,7 +2,8 @@ module Biz.Auth ( Error (..), Password, Username, - ) where + ) +where import Data.ByteString (ByteString) import Data.Text (Text) @@ -13,4 +14,5 @@ data Error | BadPassword type Password = MisoString + type Username = MisoString diff --git a/Biz/Bild/Deps/Haskell.nix b/Biz/Bild/Deps/Haskell.nix index 78ae6b2..1153e28 100644 --- a/Biz/Bild/Deps/Haskell.nix +++ b/Biz/Bild/Deps/Haskell.nix @@ -5,7 +5,6 @@ "aeson" "async" "bytestring" - # "capability" # broken deps "clay" "cmark" "config-ini" 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 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 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 diff --git a/Biz/Pie.hs b/Biz/Pie.hs index d3fca5f..7df794f 100644 --- a/Biz/Pie.hs +++ b/Biz/Pie.hs @@ -70,18 +70,18 @@ main = do addCommand "new" "start new a weekly sprint" - (const . move New) + (const <. move New) (pure mempty) addCommand "update" "submit weekly update for a namespace" - (move . Update) - (optNamespace) + (move <. Update) + optNamespace addCommand "feedback" "submit user feedback for a namespace" - (move . Feedback) - (optNamespace) + (move <. Feedback) + optNamespace cwd <- Directory.getCurrentDirectory root <- Env.getEnv "BIZ_ROOT" let fullNamespace = @@ -101,7 +101,7 @@ optNamespace = <> short 'n' <> value "Devalloc" -data Form = Form {roll :: [Entry]} +newtype Form = Form {roll :: [Entry]} deriving (Generic, Aeson.ToJSON, Aeson.FromJSON, Show) instance Monoid Form where @@ -136,7 +136,7 @@ data Move move :: Move -> Form -> IO Form move mov form = case mov of New -> do - week <- Time.getCurrentTime >>= return . Time.formatTime Time.defaultTimeLocale "%V" + week <- Time.getCurrentTime >>= return <. Time.formatTime Time.defaultTimeLocale "%V" let branch = "sprint-" <> week proc <- Process.spawnProcess "git" ["show-ref", branch] Process.waitForProcess proc >>= \case diff --git a/Biz/Que/Host.hs b/Biz/Que/Host.hs index 4817fd6..3668a29 100644 --- a/Biz/Que/Host.hs +++ b/Biz/Que/Host.hs @@ -63,7 +63,7 @@ main = Exception.bracket startup shutdown <| uncurry Warp.run putText <| "skey: " <> (show <| queSkey c) return (quePort c, waiapp) shutdown :: a -> IO a - shutdown = pure . identity + shutdown = pure <. identity newtype App a = App { runApp :: ReaderT (STM.TVar AppState) IO a @@ -129,9 +129,9 @@ routes cfg = do Scotty.get (Scotty.regex quepath) <| do (ns, qp) <- extract guardNs ns ["pub", "_"] - app . modify <| upsertNamespace ns + app <. modify <| upsertNamespace ns q <- app <| que ns qp - poll <- Scotty.param "poll" !: (pure . const False) + poll <- Scotty.param "poll" !: (pure <. const False) if poll then Scotty.stream <| streamQue q else do @@ -151,7 +151,7 @@ routes cfg = do >> Scotty.finish guardNs ns ["pub", "_"] -- passed all auth checks - app . modify <| upsertNamespace ns + app <. modify <| upsertNamespace ns q <- app <| que ns qp qdata <- Scotty.body _ <- liftIO <| Go.write q <| BSL.toStrict qdata @@ -184,7 +184,7 @@ streamQue q write _ = loop q where loop c = Go.read c - >>= (write . Builder.byteStringInsert) + >>= (write <. Builder.byteStringInsert) >> loop c -- | Gets the thing from the Hashmap. Call's 'error' if key doesn't exist. @@ -218,11 +218,11 @@ app = lift -- | Get something from the app state gets :: (AppState -> b) -> App b -gets f = ask >>= liftIO . STM.readTVarIO >>= return >= liftIO <. STM.readTVarIO >>= return AppState) -> App () -modify f = ask >>= liftIO . atomically . flip STM.modifyTVar' f +modify f = ask >>= liftIO <. atomically <. flip STM.modifyTVar' f -- | housing for a set of que paths type Namespace = Text.Lazy.Text -- cgit v1.2.3