Improve error reporting

1 files changed, 19 insertions, 15 deletions

diff --git a/src/Tomato/Retrieve.hs b/src/Tomato/Retrieve.hs
index 80bdac6..2f7f20b 100644
--- a/src/Tomato/Retrieve.hs
+++ b/src/Tomato/Retrieve.hs
@@ -10,49 +10,53 @@ import Network.HTTP.Req
     ( jsonResponse
     , bsResponse
     , req
+    , Req
+    , runReq
+    , defaultHttpConfig
     , NoReqBody (..)
     , (/:)
     , (=:)
-    , Req
     , GET (..)
     , https
     , responseBody
     )
 
-import Data.Tomato (Tomato (..), Links (..))
+import Tomato.App (App (..))
+import Tomato.Data.Except (DecodeException (..))
+import Tomato.Data.Tomato (Tomato (..), Links (..))
 
 import qualified Data.Aeson as Ae
 import qualified RIO.ByteString as B
+import qualified RIO.Text as T
 
 
--- TODO global config reader monad
-tomatoFile :: FilePath
-tomatoFile = "tomato.png"
-
-clientId :: Text
-clientId = "FbzqI-oR7277JwL1ZGsyUw7yG1F5U0U3WhQ3kOW71Do"
-
 -- | Get a random tomato
-randomTomato :: Req ()
+randomTomato :: RIO App ()
 randomTomato = queryTomato >>= downloadTomato
 
 -- | Ask for a tomato
-queryTomato :: Req Tomato
+queryTomato :: RIO App Tomato
 queryTomato = do
+    clientId <- asks appClientId
     let url = https "api.unsplash.com" /: "photos" /: "random"
-    js <- req GET url NoReqBody jsonResponse $
+    js <- rr $ req GET url NoReqBody jsonResponse $
         "query" =: ("tomato" :: Text) <>
         "client_id" =: clientId
     tomato <- case Ae.fromJSON (responseBody js) of
         Ae.Success r -> pure r
-        Ae.Error _s  -> error "deal with this later"
+        Ae.Error s -> throwM $ DecodeException $ T.pack s
     return tomato
 
 -- | Download a specific tomato
-downloadTomato :: Tomato -> Req ()
+downloadTomato :: Tomato -> RIO App ()
 downloadTomato tom = do
+    tomatoFile <- asks appFile
+    clientId <- asks appClientId
     let url = download (links tom)
-    bs <- req GET url NoReqBody bsResponse $
+    bs <- rr $ req GET url NoReqBody bsResponse $
         "query" =: ("tomato" :: Text) <>
         "client_id" =: clientId
     B.writeFile tomatoFile (responseBody bs)
+
+rr :: Req a -> RIO App a
+rr = runReq defaultHttpConfig