Merge pull request #32 from haskell-works/newhogy/fix-show-compile-er…

…rors Fix show compile errors
haskell-works · Feb 26, 2025 · dd7c62b · dd7c62b
2 parents 331a76e + a82e030
commit dd7c62b
Show file tree

Hide file tree

Showing 11 changed files with 48 additions and 49 deletions.
diff --git a/app/App/AWS/Env.hs b/app/App/AWS/Env.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE BlockArguments    #-}
+{-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeApplications  #-}
 
 module App.AWS.Env
   ( awsLogger
@@ -10,23 +10,24 @@ module App.AWS.Env
   , setEnvEndpoint
   ) where
 
-import App.Show                     (tshow)
-import Control.Concurrent           (myThreadId)
-import Control.Monad                (when, forM_)
-import Data.ByteString              (ByteString)
-import Data.ByteString.Builder      (toLazyByteString)
-import Data.Function                ((&))
-import Data.Generics.Product.Any    (the)
-import Lens.Micro                   ((.~), (%~))
-import Network.HTTP.Client          (HttpException (..), HttpExceptionContent (..))
+import           Control.Concurrent         (myThreadId)
+import           Control.Monad              (forM_, when)
+import           Data.ByteString            (ByteString)
+import           Data.ByteString.Builder    (toLazyByteString)
+import           Data.Function              ((&))
+import           Data.Generics.Product.Any  (the)
+import           Data.RdsData.Internal.Show (tshow)
+import           Lens.Micro                 ((%~), (.~))
+import           Network.HTTP.Client        (HttpException (..),
+                                             HttpExceptionContent (..))
 
 import qualified Amazonka                   as AWS
+import qualified App.Console                as CIO
 import qualified Data.ByteString            as BS
 import qualified Data.ByteString.Lazy       as L
 import qualified Data.ByteString.Lazy       as LBS
 import qualified Data.ByteString.Lazy.Char8 as LC8
 import qualified Data.Text.Encoding         as T
-import qualified App.Console                as CIO
 import qualified System.IO                  as IO
 
 setEnvEndpoint :: Maybe (ByteString, Int, Bool) -> IO AWS.Env -> IO AWS.Env

diff --git a/app/App/Cli/Run/Down.hs b/app/App/Cli/Run/Down.hs
@@ -19,10 +19,10 @@ import qualified Amazonka                        as AWS
 import qualified App.Cli.Types                   as CLI
 import qualified App.Console                     as T
 import           Data.RdsData.Aws
+import           Data.RdsData.Internal.Show
 import           Data.RdsData.Polysemy.Core
 import           Data.RdsData.Polysemy.Error
 import           Data.RdsData.Polysemy.Migration
-import qualified Data.Text                       as T
 import           HaskellWorks.Polysemy
 import           HaskellWorks.Polysemy.Amazonka
 import           HaskellWorks.Polysemy.File
@@ -73,12 +73,12 @@ reportFatal (AppError msg) =
 runDownCmd :: CLI.DownCmd -> IO ()
 runDownCmd cmd = runApp cmd do
   initialiseDb
-    & trap @AWS.Error (throw . AppError . T.pack . show)
-    & trap @RdsDataError (throw . AppError . T.pack . show)
+    & trap @AWS.Error (throw . AppError . tshow)
+    & trap @RdsDataError (throw . AppError . tshow)
 
   migrateDown (cmd ^. the @"migrationFp")
-    & trap @AWS.Error (throw . AppError . T.pack . show)
-    & trap @IOException (throw . AppError . T.pack . show)
-    & trap @JsonDecodeError (throw . AppError . T.pack . show)
-    & trap @RdsDataError (throw . AppError . T.pack . show)
-    & trap @YamlDecodeError (throw . AppError . T.pack . show)
+    & trap @AWS.Error (throw . AppError . tshow)
+    & trap @IOException (throw . AppError . tshow)
+    & trap @JsonDecodeError (throw . AppError . tshow)
+    & trap @RdsDataError (throw . AppError . tshow)
+    & trap @YamlDecodeError (throw . AppError . tshow)
diff --git a/app/App/Cli/Run/Example.hs b/app/App/Cli/Run/Example.hs
@@ -19,6 +19,7 @@ import           Data.Generics.Product.Any
 import           Data.Int
 import           Data.Maybe
 import           Data.Monoid
+import           Data.RdsData.Internal.Show
 import           Data.RdsData.Types
 import           Data.Text                  (Text)
 import           Data.Time
@@ -242,7 +243,7 @@ runExampleCmd cmd = do
           )
         ]
 
-    liftIO $ IO.putStrLn $ "===> " <> show req
+    liftIO $ T.putStrLn $ "===> " <> tshow req
 
     res <- AWS.send envAws req
 

diff --git a/app/App/Cli/Run/LocalStack.hs b/app/App/Cli/Run/LocalStack.hs
@@ -27,6 +27,7 @@ import           Data.Acquire                                      (ReleaseType
 import           Data.Generics.Product.Any
 import           Data.RdsData.Aws
 import           Data.RdsData.Default
+import           Data.RdsData.Internal.Show
 import           Data.RdsData.Polysemy.Test.Cluster
 import           Data.RdsData.Polysemy.Test.Env
 import           GHC.IORef                                         (IORef)
@@ -118,7 +119,7 @@ runLocalStackCmd _ = do
           lsEp <- getLocalStackEndpoint container
           jotShow_ lsEp -- Localstack endpoint
           let port = lsEp ^. the @"port"
-          let exampleCmd = "awslocal --endpoint-url=http://localhost:" <> show port <> " s3 ls"
+          let exampleCmd = "awslocal --endpoint-url=http://localhost:" <> tshow port <> " s3 ls"
           -- Example awslocal command:
           jot_ exampleCmd
           jotShowM_ $ ask @StatementContext

diff --git a/app/App/Cli/Run/Up.hs b/app/App/Cli/Run/Up.hs
@@ -20,7 +20,6 @@ import           Data.RdsData.Aws
 import           Data.RdsData.Polysemy.Core
 import           Data.RdsData.Polysemy.Error
 import           Data.RdsData.Polysemy.Migration
-import qualified Data.Text                       as T
 import           HaskellWorks.Polysemy
 import           HaskellWorks.Polysemy.Amazonka
 import           HaskellWorks.Polysemy.File
@@ -71,12 +70,12 @@ reportFatal (AppError msg) =
 runUpCmd :: CLI.UpCmd -> IO ()
 runUpCmd cmd = runApp cmd do
   initialiseDb
-    & trap @AWS.Error (throw . AppError . T.pack . show)
-    & trap @RdsDataError (throw . AppError . T.pack . show)
+    & trap @AWS.Error (throw . AppError . tshow)
+    & trap @RdsDataError (throw . AppError . tshow)
 
   migrateUp (cmd ^. the @"migrationFp")
-    & trap @AWS.Error (throw . AppError . T.pack . show)
-    & trap @IOException (throw . AppError . T.pack . show)
-    & trap @JsonDecodeError (throw . AppError . T.pack . show)
-    & trap @RdsDataError (throw . AppError . T.pack . show)
-    & trap @YamlDecodeError (throw . AppError . T.pack . show)
+    & trap @AWS.Error (throw . AppError . tshow)
+    & trap @IOException (throw . AppError . tshow)
+    & trap @JsonDecodeError (throw . AppError . tshow)
+    & trap @RdsDataError (throw . AppError . tshow)
+    & trap @YamlDecodeError (throw . AppError . tshow)
diff --git a/app/App/Show.hs b/app/App/Show.hs
diff --git a/rds-data.cabal b/rds-data.cabal
@@ -106,6 +106,7 @@ library codecs
                       , bytestring
                       , contravariant
                       , generic-lens
+                      , hw-prelude
                       , microlens
                       , mtl
                       , text
@@ -130,6 +131,7 @@ library codecs
                         Data.RdsData.Internal.Aeson
                         Data.RdsData.Internal.Convert
                         Data.RdsData.Internal.Maybe
+                        Data.RdsData.Internal.Show
                         Data.RdsData.Migration
                         Data.RdsData.Migration.Types
                         Data.RdsData.Orphans
@@ -254,7 +256,6 @@ executable rds-data
                         App.Config
                         App.Console
                         App.Options
-                        App.Show
   hs-source-dirs:       app
   ghc-options:          -threaded "-with-rtsopts=-I0 -A16m -N2 --disable-delayed-os-memory-return"
 

diff --git a/src/Data/RdsData/Decode/Row.hs b/src/Data/RdsData/Decode/Row.hs
@@ -46,6 +46,7 @@ import           Data.ByteString               (ByteString)
 import           Data.Functor.Identity         (Identity)
 import           Data.Int
 import           Data.RdsData.Decode.Value     (DecodeValue)
+import           Data.RdsData.Internal.Show
 import           Data.RdsData.Types.Value
 import           Data.Text
 import           Data.Time
@@ -192,7 +193,7 @@ timeOfDay = do
   t <- text
   case parseTimeM True defaultTimeLocale "%H:%M:%S%Q" (T.unpack t) of
     Just a  -> pure a
-    Nothing -> throwError $ "Failed to parse TimeOfDay: " <> T.pack (show t)
+    Nothing -> throwError $ "Failed to parse TimeOfDay: " <> tshow t
 
 ulid :: DecodeRow ULID
 ulid = do
@@ -206,21 +207,21 @@ utcTime = do
   t <- text
   case parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M:%S" (T.unpack t) of
     Just a  -> pure a
-    Nothing -> throwError $ "Failed to parse UTCTime: " <> T.pack (show t)
+    Nothing -> throwError $ "Failed to parse UTCTime: " <> tshow t
 
 uuid :: DecodeRow UUID
 uuid = do
   t <- text
   case UUID.fromString (T.unpack t) of
     Just a  -> pure a
-    Nothing -> throwError $ "Failed to parse UUID: " <> T.pack (show t)
+    Nothing -> throwError $ "Failed to parse UUID: " <> tshow t
 
 day :: DecodeRow Day
 day = do
   t <- text
   case parseTimeM True defaultTimeLocale "%Y-%m-%d" (T.unpack t) of
     Just a  -> pure a
-    Nothing -> throwError $ "Failed to parse Day: " <> T.pack (show t)
+    Nothing -> throwError $ "Failed to parse Day: " <> tshow t
 
 ignore :: DecodeRow ()
 ignore =

diff --git a/src/Data/RdsData/Decode/Value.hs b/src/Data/RdsData/Decode/Value.hs
@@ -51,6 +51,7 @@ import           Data.ByteString               (ByteString)
 import           Data.Int
 import           Data.RdsData.Decode.Array     (DecodeArray (..))
 import           Data.RdsData.Internal.Aeson
+import           Data.RdsData.Internal.Show
 import           Data.RdsData.Types.Value
 import           Data.Text                     (Text)
 import           Data.Time
@@ -288,8 +289,8 @@ timeOfDay :: DecodeValue TimeOfDay
 timeOfDay = do
   t <- text
   case parseTimeM True defaultTimeLocale "%H:%M:%S%Q" (T.unpack t) of
-    Just a -> pure a
-    Nothing -> decodeValueFailed "timeOfDay" "TimeOfDay" (Just (T.pack (show t)))
+    Just a  -> pure a
+    Nothing -> decodeValueFailed "timeOfDay" "TimeOfDay" (Just (tshow t))
 
 utcTime :: DecodeValue UTCTime
 utcTime = do

diff --git a/src/Data/RdsData/Internal/Show.hs b/src/Data/RdsData/Internal/Show.hs
@@ -0,0 +1,5 @@
+module Data.RdsData.Internal.Show
+  ( tshow
+  ) where
+
+import           HaskellWorks.Prelude
diff --git a/src/Data/RdsData/Orphans.hs b/src/Data/RdsData/Orphans.hs
@@ -21,4 +21,3 @@ instance FromJSON ULID where
 
 instance ToJSON ULID where
   toJSON = J.toJSON . show
-
Original file line number	Diff line number	Diff line change
Expand Up		@@ -21,4 +21,3 @@ instance FromJSON ULID where

		instance ToJSON ULID where
		toJSON = J.toJSON . show