Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix show compile errors #32

Merged
merged 1 commit into from
Feb 26, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 14 additions & 13 deletions app/App/AWS/Env.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeApplications #-}

module App.AWS.Env
( awsLogger
Expand All @@ -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
Expand Down
16 changes: 8 additions & 8 deletions app/App/Cli/Run/Down.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
3 changes: 2 additions & 1 deletion app/App/Cli/Run/Example.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -242,7 +243,7 @@ runExampleCmd cmd = do
)
]

liftIO $ IO.putStrLn $ "===> " <> show req
liftIO $ T.putStrLn $ "===> " <> tshow req

res <- AWS.send envAws req

Expand Down
3 changes: 2 additions & 1 deletion app/App/Cli/Run/LocalStack.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
15 changes: 7 additions & 8 deletions app/App/Cli/Run/Up.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
10 changes: 0 additions & 10 deletions app/App/Show.hs

This file was deleted.

3 changes: 2 additions & 1 deletion rds-data.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,7 @@ library codecs
, bytestring
, contravariant
, generic-lens
, hw-prelude
, microlens
, mtl
, text
Expand All @@ -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
Expand Down Expand Up @@ -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"

Expand Down
9 changes: 5 additions & 4 deletions src/Data/RdsData/Decode/Row.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 =
Expand Down
5 changes: 3 additions & 2 deletions src/Data/RdsData/Decode/Value.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
5 changes: 5 additions & 0 deletions src/Data/RdsData/Internal/Show.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
module Data.RdsData.Internal.Show
( tshow
) where

import HaskellWorks.Prelude
1 change: 0 additions & 1 deletion src/Data/RdsData/Orphans.hs
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

Loading