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/executable/haskell/Service/AdListener.hs | 59 +++++++--------------------- src/executable/haskell/Utils/Either.hs | 7 ---- src/executable/haskell/Utils/HTTP.hs | 19 --------- 3 files changed, 15 insertions(+), 70 deletions(-) delete mode 100644 src/executable/haskell/Utils/Either.hs delete mode 100644 src/executable/haskell/Utils/HTTP.hs (limited to 'src/executable') diff --git a/src/executable/haskell/Service/AdListener.hs b/src/executable/haskell/Service/AdListener.hs index f0adbb8..bbd06d9 100644 --- a/src/executable/haskell/Service/AdListener.hs +++ b/src/executable/haskell/Service/AdListener.hs @@ -2,25 +2,20 @@ module Service.AdListener ( start ) where -import Control.Concurrent (threadDelay) -import Data.Either (rights) -import Data.Text.Encoding as T -import qualified Data.Text.IO as T -import Prelude hiding (error) +import Control.Concurrent (threadDelay) +import qualified Data.Text.IO as T +import Prelude hiding (error) -import Conf (Conf) +import Conf (Conf) import qualified Conf -import Model.Ad (Ad) -import qualified Model.Ad as Ad -import Model.Mail (Mail (Mail)) -import Model.URL (URL) -import qualified Parser.LeboncoinParser as LeboncoinParser -import qualified Parser.OuestFranceParser as OuestFranceParser -import qualified Parser.SeLogerParser as SeLogerParser -import qualified Service.MailService as MailService -import qualified Utils.HTTP as HTTP -import qualified Utils.Time as TimeUtils -import qualified View.Ad as Ad +import qualified FetchAd +import Model.Ad (Ad) +import qualified Model.Ad as Ad +import Model.Mail (Mail (Mail)) +import Model.URL (URL) +import qualified Service.MailService as MailService +import qualified Utils.Time as TimeUtils +import qualified View.Ad as Ad start :: Conf -> IO () start conf = do @@ -49,39 +44,15 @@ listenToNewAdsWithViewedURLs conf viewedURLs = do fetchAds :: Conf -> IO [Ad] fetchAds conf = do - leboncoinAds <- getLeboncoinAds conf - ouestFranceAds <- getOuestFranceAds conf - seLogerAds <- getSeLogerAds conf + leboncoinAds <- FetchAd.leboncoin (Conf.leboncoinUrls conf) + ouestFranceAds <- FetchAd.ouestFrance (Conf.ouestFranceUrls conf) + seLogerAds <- FetchAd.seLoger (Conf.seLogerUrls conf) let results = leboncoinAds ++ ouestFranceAds ++ seLogerAds if null results then T.putStrLn "Parsed 0 results!" else return () return results -getLeboncoinAds :: Conf -> IO [Ad] -getLeboncoinAds conf = - fmap (concat . map LeboncoinParser.parse . rights) - . sequence - . map (HTTP.get T.decodeLatin1) - . Conf.leboncoinUrls - $ conf - -getOuestFranceAds :: Conf -> IO [Ad] -getOuestFranceAds conf = - fmap (concat . map OuestFranceParser.parse . rights) - . sequence - . map (HTTP.get T.decodeUtf8) - . Conf.ouestFranceUrls - $ conf - -getSeLogerAds :: Conf -> IO [Ad] -getSeLogerAds conf = - fmap (concat . map SeLogerParser.parse . rights) - . sequence - . map (HTTP.get T.decodeUtf8) - . Conf.seLogerUrls - $ conf - sendMail :: Conf -> [Ad] -> IO () sendMail conf ads = let (title, plainBody) = Ad.renderAds ads diff --git a/src/executable/haskell/Utils/Either.hs b/src/executable/haskell/Utils/Either.hs deleted file mode 100644 index 5d62dcc..0000000 --- a/src/executable/haskell/Utils/Either.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Utils.Either - ( mapLeft - ) where - -mapLeft :: (a -> c) -> Either a b -> Either c b -mapLeft f (Left l) = Left (f l) -mapLeft _ (Right r) = (Right r) diff --git a/src/executable/haskell/Utils/HTTP.hs b/src/executable/haskell/Utils/HTTP.hs deleted file mode 100644 index 919e66d..0000000 --- a/src/executable/haskell/Utils/HTTP.hs +++ /dev/null @@ -1,19 +0,0 @@ -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 -import Utils.Either (mapLeft) - -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) -- cgit v1.2.3