From 149a0470b73781022e584aaeaa7ce871d6f4173b Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 19 Jun 2018 22:49:16 +0200
Subject: Add automatic tests on remote pages

---
 src/lib/haskell/Utils/HTTP.hs | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)
 create mode 100644 src/lib/haskell/Utils/HTTP.hs

(limited to 'src/lib/haskell/Utils/HTTP.hs')

diff --git a/src/lib/haskell/Utils/HTTP.hs b/src/lib/haskell/Utils/HTTP.hs
new file mode 100644
index 0000000..87635ce
--- /dev/null
+++ b/src/lib/haskell/Utils/HTTP.hs
@@ -0,0 +1,22 @@
+module Utils.HTTP
+  ( get
+  ) where
+
+import           Control.Exception    (SomeException, try)
+import           Data.ByteString      (ByteString)
+import qualified Data.ByteString.Lazy as BS
+import           Data.Text            (Text)
+import qualified Data.Text            as T
+import           Network.HTTP.Conduit
+
+import           Model.URL
+
+get :: (ByteString -> Text) -> URL -> IO (Either Text Text)
+get decode url = mapLeft (T.pack . show) <$> (try (unsafeGetPage decode url) :: IO (Either SomeException Text))
+
+unsafeGetPage :: (ByteString -> Text) -> URL -> IO Text
+unsafeGetPage decode url = (decode . BS.toStrict) <$> simpleHttp (T.unpack url)
+
+mapLeft :: (a -> c) -> Either a b -> Either c b
+mapLeft f (Left l)  = Left (f l)
+mapLeft _ (Right r) = (Right r)
-- 
cgit v1.2.3