aboutsummaryrefslogtreecommitdiff
path: root/app
diff options
context:
space:
mode:
authorJacques Comeaux <jacquesrcomeaux@gmail.com>2022-05-29 16:07:59 -0500
committerJacques Comeaux <jacquesrcomeaux@gmail.com>2022-05-29 16:07:59 -0500
commit8a06c083fab9c66e754c7ed5a75dd4d89131c43e (patch)
tree28098c165bce0d8ebb5dda2d5390e63ddca1ab1e /app
parent399ab3ee1653bbc0da69e2cc299aa2a313e765b4 (diff)
Improve error reporting
Diffstat (limited to 'app')
-rw-r--r--app/Main.hs42
1 files changed, 6 insertions, 36 deletions
diff --git a/app/Main.hs b/app/Main.hs
index 27dcbae..d464aa8 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -6,52 +6,22 @@ import RIO
import Data.Conduit (runConduit, (.|))
import Data.Conduit.Attoparsec (sinkParser)
-import Network.HTTP.Req (defaultHttpConfig, runReq)
import Network.HTTP.Types (status200, status500)
import Network.Wai (responseBuilder, responseLBS, Response)
import Network.Wai.Conduit (sourceRequestBody)
import Network.Wai.Handler.Warp (run)
import System.Environment (getArgs)
-import Data.Message (InMessage (..))
-import Tomato.Post (postTomato)
+import Tomato.App (runApp)
+import Tomato.Bot (tomatoBot)
+import Tomato.Data.Except (DecodeException (..))
+import Tomato.Data.Message (InMessage (..))
import Tomato.Validate (isTomato)
-import Tomato.Retrieve (randomTomato)
import qualified Data.Aeson as Ae
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified RIO.List.Partial as L'
-
-
-data App = App
- { appLogFunc :: !LogFunc
- , appToken :: !Text
- , appBotId :: !Text
- }
-
-instance HasLogFunc App where
- logFuncL = lens appLogFunc (\x y -> x { appLogFunc = y })
-
-runApp :: RIO App a -> IO a
-runApp inner = do
- logOptions' <- logOptionsHandle stderr False
- let logOptions = setLogUseTime True $ setLogUseLoc True logOptions'
- -- let logOptions = logOptions'
- withLogFunc logOptions $ \logFunc -> do
- let app = App
- { appLogFunc = logFunc
- , appToken = "placeholder"
- , appBotId = "placeholder"
- }
- runRIO app inner
-
-tomatoBot :: RIO App ()
-tomatoBot = do
- logInfo $ "Fetching tomato"
- runReq defaultHttpConfig randomTomato
- logInfo $ "Posting tomato"
- runReq defaultHttpConfig postTomato
- logInfo $ "Done"
+import qualified RIO.Text as T
runServer :: Int -> IO ()
runServer port = run port $ \request send -> do
@@ -61,7 +31,7 @@ runServer port = run port $ \request send -> do
.| sinkParser Ae.json
case Ae.fromJSON val of
Ae.Success r -> return r
- Ae.Error _s -> error "handle this later"
+ Ae.Error s -> throwM $ DecodeException $ T.pack s
case eres of
Left e -> send $ errorResponse e
Right inMes -> do