Clean up imports with relude

iamdineshkumar · Feb 9, 2021 · b0ab898 · b0ab898
1 parent 433068c
commit b0ab898
Show file tree

Hide file tree

Showing 23 changed files with 162 additions and 246 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -5,10 +5,6 @@ where
 
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception.Safe (catchAny, try)
-import Control.Monad (forever, when)
-import Control.Monad.Trans.Except (ExceptT (..))
-import Data.Maybe (fromMaybe)
-import Data.Text (pack)
 import qualified GHC.IO.Encoding
 import qualified Haka.Api as Api
 import Haka.App
@@ -63,7 +59,7 @@ initApp settings unApp = do
   logenv <-
     Log.setupLogEnv
       (hakaRunEnv settings)
-      (fromMaybe InfoS (textToSeverity $ pack $ hakaLogLevel settings))
+      (fromMaybe InfoS (textToSeverity $ toText $ hakaLogLevel settings))
   let logState' =
         LogState
           { lsNamespace = Namespace {unNamespace = ["server"]},
@@ -83,7 +79,7 @@ initApp settings unApp = do
       runAppT appCtx Import.handleImportRequest
         `catchAny` ( \e -> do
                        runKatipT logenv $ Log.logMs ErrorS "Failed to execute import request"
-                       runKatipT logenv $ Log.logMs ErrorS (pack $ show e)
+                       runKatipT logenv $ Log.logMs ErrorS (show e)
                        threadDelay 1000000
                    )
 

diff --git a/cabal.project b/cabal.project
@@ -1,5 +1,8 @@
-index-state: 2020-09-26T11:49:41Z
+index-state: 2021-01-25T10:18:41Z
 packages: *.cabal
 
+package *
+  ghc-options: -fwrite-ide-info
+
 package hakatime
   optimization: 2
diff --git a/default.nix b/default.nix
@@ -2,12 +2,12 @@
 , bytestring, case-insensitive, containers, contravariant-extras
 , cookie, cryptonite, fakedata, file-embed, hasql, hasql-pool
 , hasql-queue, hasql-transaction, http-client, http-client-tls
-, http-media, http-types, katip, mr-env, mtl, optparse-applicative
+, http-media, http-types, katip, mr-env, optparse-applicative
 , polysemy, polysemy-plugin, postgresql-binary, random
-, raw-strings-qq, req, safe, safe-exceptions, servant
+, raw-strings-qq, relude, req, safe, safe-exceptions, servant
 , servant-client, servant-server, stdenv, system-filepath, text
-, time, transformers, unix, unliftio-core, uuid, uuid-types, wai
-, wai-cors, wai-extra, wai-logger, warp
+, time, unix, unliftio-core, uuid, uuid-types, wai, wai-cors
+, wai-extra, wai-logger, warp
 }:
 mkDerivation {
   pname = "hakatime";
@@ -19,18 +19,18 @@ mkDerivation {
     aeson base base64-bytestring bits blaze-builder bytestring
     case-insensitive containers contravariant-extras cookie cryptonite
     file-embed hasql hasql-pool hasql-queue hasql-transaction
-    http-client http-client-tls http-media http-types katip mr-env mtl
+    http-client http-client-tls http-media http-types katip mr-env
     optparse-applicative polysemy polysemy-plugin postgresql-binary
-    raw-strings-qq req safe safe-exceptions servant servant-server
-    system-filepath text time transformers unix unliftio-core uuid
-    uuid-types wai
+    raw-strings-qq relude req safe safe-exceptions servant
+    servant-server system-filepath text time unix unliftio-core uuid
+    uuid-types wai wai-extra
   ];
   executableHaskellDepends = [
-    aeson base base64-bytestring bytestring fakedata hasql hasql-pool
-    hasql-queue http-client http-client-tls katip mr-env mtl
-    optparse-applicative polysemy polysemy-plugin random
-    safe-exceptions servant servant-client servant-server text time
-    transformers unix wai wai-cors wai-extra wai-logger warp
+    aeson base base64-bytestring fakedata hasql hasql-pool hasql-queue
+    http-client http-client-tls katip mr-env optparse-applicative
+    polysemy polysemy-plugin random relude safe-exceptions servant
+    servant-client servant-server time unix wai wai-cors wai-extra
+    wai-logger warp
   ];
   testHaskellDepends = [ base ];
   doHaddock = false;

diff --git a/hakatime.cabal b/hakatime.cabal
@@ -18,11 +18,12 @@ source-repository head
 
 executable haka-data
   hs-source-dirs:      tools
+  mixins:              base hiding (Prelude)
+                     , relude (Relude as Prelude)
   main-is:             Main.hs
   build-depends:       base                 >= 4.9 && < 4.14
                      , aeson                >= 1.4
                      , base64-bytestring
-                     , bytestring
                      , fakedata
                      , polysemy             == 1.3.*
                      , polysemy-plugin      == 0.2.*
@@ -32,9 +33,9 @@ executable haka-data
                      , optparse-applicative >= 0.15
                      , servant              >= 0.17
                      , servant-client       >= 0.17
-                     , text
                      , time
                      , libhaka
+                     , relude               >= 0.6.0.0
 
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings
@@ -48,6 +49,8 @@ executable haka-data
 
 library libhaka
   hs-source-dirs:      src
+  mixins:              base hiding (Prelude)
+                     , relude (Relude as Prelude, Relude.Unsafe)
   exposed-modules:     Haka.Api
                      , Haka.Cli
                      , Haka.App
@@ -96,7 +99,6 @@ library libhaka
                      , mr-env               == 0.1.*
                      , req
                      , unix
-                     , mtl                  == 2.2.2
                      , optparse-applicative >= 0.15
                      , polysemy             == 1.3.*
                      , polysemy-plugin      == 0.2.*
@@ -109,14 +111,13 @@ library libhaka
                      , system-filepath
                      , text
                      , time
-                     , transformers
-                     -- https://github.com/Soostone/katip/issues/117
-                     , unliftio-core        >= 0.1 && < 0.2
+                     , unliftio-core
                      , uuid
                      , wai                  == 3.2.*
                      , wai-extra
                      , http-types
                      , blaze-builder
+                     , relude               >= 0.6.0.0
 
   ghc-options:         -Wall
                        -Wcompat
@@ -151,30 +152,29 @@ library libhaka
 
 executable hakatime
   hs-source-dirs:      app
+  mixins:              base hiding (Prelude)
+                     , relude (Relude as Prelude)
   main-is:             Main.hs
 
   build-depends:       base                 >= 4.9 && < 4.14
-                     , bytestring
                      , hasql                == 1.4.*
                      , hasql-pool           == 0.5.*
                      , hasql-queue          == 1.2.*
                      , katip                == 0.8.*
                      , libhaka
                      , mr-env               == 0.1.*
                      , unix
-                     , mtl                  == 2.2.2
                      , safe-exceptions
-                     , text
                      , optparse-applicative >= 0.15
                      , polysemy             == 1.3.*
                      , polysemy-plugin      == 0.2.*
                      , servant-server       == 0.17.*
-                     , transformers
                      , wai                  == 3.2.*
                      , wai-cors
                      , wai-extra
                      , wai-logger           == 2.3.*
                      , warp                 == 3.3.*
+                     , relude               >= 0.6.0.0
 
   ghc-options:         -Wall
                        -threaded

diff --git a/src/Haka/App.hs b/src/Haka/App.hs
@@ -16,11 +16,6 @@ module Haka.App
 where
 
 import Control.Exception.Safe (MonadThrow, throw)
-import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.Reader (MonadReader, asks, local)
-import Control.Monad.Trans.Reader (ReaderT (..), runReaderT)
-import qualified Data.ByteString as Bs
-import Data.Int (Int64)
 import qualified Haka.Logger as Log
 import qualified Hasql.Pool as HqPool
 import Katip as K
@@ -136,7 +131,7 @@ data ServerSettings = ServerSettings
     -- we'll have to adjust the Set-Cookie path.
     hakaApiPrefix :: String,
     -- | The external URL to be used for the badge generation.
-    hakaBadgeUrl :: Bs.ByteString,
+    hakaBadgeUrl :: ByteString,
     -- | Where to look for dashboard's static files.
     hakaDashboardPath :: FilePath,
     -- | Whether the registration is enabled.

diff --git a/src/Haka/Authentication.hs b/src/Haka/Authentication.hs
@@ -10,15 +10,10 @@ module Haka.Authentication
 where
 
 import Control.Exception.Safe (throw)
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Reader (asks)
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.ByteString.Char8 as Bs
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
 import Data.Time (addUTCTime)
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
-import GHC.Generics
 import Haka.App (AppCtx (..), AppM, RegistrationStatus (..), ServerSettings (..))
 import qualified Haka.DatabaseOperations as DbOps
 import qualified Haka.Errors as Err
@@ -32,6 +27,7 @@ import Katip
 import Polysemy (runM)
 import Polysemy.Error (runError)
 import Polysemy.IO (embedToMonadIO)
+import qualified Relude.Unsafe as Unsafe
 import Servant
 import Web.Cookie
 
@@ -144,7 +140,7 @@ mkRefreshTokenCookie tknData apiPrefix =
   where
     removeSlash p =
       Bs.pack $ case not $ null p of
-        True -> if last p == '/' then init p else p
+        True -> if Unsafe.last p == '/' then Unsafe.init p else p
         False -> p
 
 mkLoginResponse :: TokenData -> UTCTime -> LoginResponse

diff --git a/src/Haka/Badges.hs b/src/Haka/Badges.hs
@@ -7,18 +7,9 @@ module Haka.Badges
 where
 
 import Control.Exception.Safe (throw)
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Reader (asks)
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.ByteString as Bs
-import qualified Data.ByteString.Lazy as LBs
-import Data.Int (Int64)
-import Data.List (mapAccumR)
-import Data.Maybe (fromMaybe)
-import Data.Text (Text, unpack)
-import Data.Text.Encoding (decodeUtf8)
 import qualified Data.UUID.Types as UUID
-import GHC.Generics
 import Haka.App (AppCtx (..), AppM, ServerSettings (..))
 import qualified Haka.DatabaseOperations as DbOps
 import qualified Haka.Errors as Err
@@ -29,6 +20,7 @@ import Network.HTTP.Media ((//))
 import Polysemy (runM)
 import Polysemy.Error (runError)
 import Polysemy.IO (embedToMonadIO)
+import qualified Relude.Unsafe as Unsafe
 import Servant
 import Text.Printf (printf)
 
@@ -39,7 +31,7 @@ instance Accept SVG where
   contentType _ = "image" // "svg+xml"
 
 instance MimeRender SVG Bs.ByteString where
-  mimeRender _ = LBs.fromStrict
+  mimeRender _ = fromStrict
 
 type API = GetBadgeLink :<|> GetBadgeSvg
 
@@ -124,30 +116,30 @@ badgeSvgHandler badgeId daysParam = do
       ( hakaShieldsIOUrl ss
           <> "/static/v1?"
           <> "label="
-          <> unpack (badgeProject badgeRow)
-          <> "&message="
-          <> compoundDuration activityTime
+          <> toString (badgeProject badgeRow)
+          <> ("&message=" :: String)
+          <> toString (compoundDuration activityTime)
           <> "&color=blue"
       )
   response <- liftIO $ httpLbs request manager
 
-  return $ LBs.toStrict $ responseBody response
+  return $ toStrict $ responseBody response
 
 reduceBy :: Integral a => a -> [a] -> [a]
 n `reduceBy` xs = n' : ys where (n', ys) = mapAccumR quotRem n xs
 
-durLabs :: [(Int64, String)]
-durLabs = [(undefined, "wk"), (7, "day"), (24, "hrs"), (60, "min"), (60, "sec")]
+durLabs :: [(Int64, Text)]
+durLabs = [(0, "wk"), (7, "day"), (24, "hrs"), (60, "min"), (60, "sec")]
 
-computeDurations :: Int64 -> [(Int64, String)]
+computeDurations :: Int64 -> [(Int64, Text)]
 computeDurations t =
-  let ds = t `reduceBy` map fst (tail durLabs)
+  let ds = t `reduceBy` map fst (Unsafe.tail durLabs)
    in filter ((/= 0) . fst) $ zip ds (map snd durLabs)
 
-compoundDuration :: Maybe Int64 -> String
+compoundDuration :: Maybe Int64 -> Text
 compoundDuration Nothing = "no data"
 compoundDuration (Just v) =
   let durations = computeDurations v
    in if length durations > 0
-        then unwords $ map (uncurry $ printf "%d %s") $ init durations
+        then unwords $ map (toText . \(n, s) -> printf "%d %s" n s :: String) $ Unsafe.init durations
         else "no data"
diff --git a/src/Haka/Cli.hs b/src/Haka/Cli.hs
@@ -7,7 +7,6 @@ module Haka.Cli
 where
 
 import Data.Bits.Extras (w16)
-import Data.Text (Text, unpack)
 import Data.Version (showVersion)
 import qualified Haka.PasswordUtils as PasswordUtils
 import qualified Haka.Utils as Utils
@@ -16,7 +15,6 @@ import qualified Hasql.Pool as HasqlPool
 import qualified Options.Applicative as Opt
 import Paths_hakatime (version)
 import System.Environment.MrEnv (envAsInt)
-import System.Exit (die)
 import System.Posix.Env.ByteString (getEnvDefault)
 
 getDbSettings :: IO HasqlConn.Settings
@@ -92,22 +90,22 @@ handleCommand :: ServerCommand -> IO () -> IO ()
 handleCommand Run action = action
 handleCommand (CreateToken ops) _ = do
   dbSettings <- getDbSettings
-  pass <- Utils.passwordInput "Password: "
+  passwd <- Utils.passwordInput "Password: "
   pool <- HasqlPool.acquire (10, 1, dbSettings)
-  token <- PasswordUtils.createToken pool username pass
+  token <- PasswordUtils.createToken pool username passwd
   case token of
-    Left err -> die $ unpack err
+    Left err -> die $ toString err
     Right val ->
       putStrLn $
         "Please save the token. You won't be able to retrieve it again.\n"
-          <> unpack val
+          <> toString val
   where
     username = tUsername ops
 handleCommand (CreateUser ops) _ = do
   dbSettings <- getDbSettings
-  pass <- Utils.passwordInput "Set a password: "
+  passwd <- Utils.passwordInput "Set a password: "
   pool <- HasqlPool.acquire (10, 1, dbSettings)
-  hashUser <- PasswordUtils.mkUser username pass
+  hashUser <- PasswordUtils.mkUser username passwd
   case hashUser of
     Left err -> die (show err)
     Right user -> do
@@ -116,10 +114,10 @@ handleCommand (CreateUser ops) _ = do
         handleError
         ( \_ -> do
             putStrLn $ "User " <> show username <> " created."
-            putStrLn $ "Run \"hakatime create-token -u " <> unpack username <> "\" to generate a token."
+            putStrLn $ "Run \"hakatime create-token -u " <> toString username <> "\" to generate a token."
         )
         res
   where
     username = cUsername ops
     handleError :: HasqlPool.UsageError -> IO ()
-    handleError = die . unpack . Utils.toStrError
+    handleError = die . toString . Utils.toStrError