aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/AdListener.hs105
-rw-r--r--src/Conf.hs32
-rw-r--r--src/Config.hs106
-rw-r--r--src/Fetch.hs21
-rw-r--r--src/Mail.hs51
-rw-r--r--src/Main.hs17
-rw-r--r--src/Model/Config.hs13
-rw-r--r--src/Model/Mail.hs14
-rw-r--r--src/Model/Resume.hs3
-rw-r--r--src/Page.hs13
-rw-r--r--src/Parser/Detail.hs12
-rw-r--r--src/Parser/Resume.hs20
-rw-r--r--src/Parser/Utils.hs14
-rw-r--r--src/View/Html/Ad.hs48
-rw-r--r--src/View/Html/Design.hs1
-rw-r--r--src/View/Plain/Ad.hs38
16 files changed, 216 insertions, 292 deletions
diff --git a/src/AdListener.hs b/src/AdListener.hs
index a52e188..9946d9e 100644
--- a/src/AdListener.hs
+++ b/src/AdListener.hs
@@ -1,14 +1,15 @@
{-# LANGUAGE OverloadedStrings #-}
module AdListener
- ( listenToNewAds
+ ( start
) where
-import Data.List (intersperse)
+import Prelude hiding (error)
+
import Data.Text (Text)
-import qualified Data.Text as T
import qualified Data.Text.IO as T
-import Data.Time.Clock (getCurrentTime, diffUTCTime, UTCTime)
+import qualified Data.Text.Lazy as LT
+import Data.Text.Lazy.Builder (toLazyText, fromText)
import Control.Concurrent (threadDelay)
@@ -21,84 +22,72 @@ import Model.Resume
import qualified View.Plain.Ad as P
import qualified View.Html.Ad as H
-import Page
-import Parser.Detail
-
-import Mail (sendMail)
+import Mail
+import Model.Mail (Mail(Mail))
-import Config (Config)
-import qualified Config as C
+import Conf (Conf)
+import qualified Conf
import Time (getCurrentFormattedTime)
-listenToNewAds :: Config -> IO ()
-listenToNewAds config = do
- eitherResumes <- fetchResumes (C.url config)
+start :: Conf -> IO ()
+start conf = do
+ eitherResumes <- fetchResumes (Conf.url conf)
case eitherResumes of
Left error ->
- showErrorAndListenBack config [] error
- Right resumes ->
+ showErrorAndListenBack conf [] error
+ Right resumes -> do
let newURLs = map url resumes
- in do
- putStrLn "Listening for new ads…"
- waitOneMinute
- listenToNewAdsWithViewedURLs config newURLs
-
-listenToNewAdsWithViewedURLs :: Config -> [URL] -> IO ()
-listenToNewAdsWithViewedURLs config viewedURLs = do
- eitherResumes <- fetchResumes (C.url config)
+ putStrLn "Listening to new ads…"
+ waitListenInterval conf
+ listenToNewAdsWithViewedURLs conf newURLs
+
+listenToNewAdsWithViewedURLs :: Conf -> [URL] -> IO ()
+listenToNewAdsWithViewedURLs conf viewedURLs = do
+ eitherResumes <- fetchResumes (Conf.url conf)
case eitherResumes of
Left error ->
- showErrorAndListenBack config viewedURLs error
+ showErrorAndListenBack conf viewedURLs error
Right resumes ->
- listenToNewAdsWithResumes config viewedURLs resumes
+ listenToNewAdsWithResumes conf viewedURLs resumes
-listenToNewAdsWithResumes :: Config -> [URL] -> [Resume] -> IO ()
-listenToNewAdsWithResumes config viewedURLs resumes =
+listenToNewAdsWithResumes :: Conf -> [URL] -> [Resume] -> IO ()
+listenToNewAdsWithResumes conf viewedURLs resumes =
let (newURLs, newResumes) = getNewResumes viewedURLs resumes
in do
eitherNewAds <- fetchAds newResumes
case eitherNewAds of
Left error ->
- showErrorAndListenBack config viewedURLs error
+ showErrorAndListenBack conf viewedURLs error
Right newAds ->
do
time <- getCurrentFormattedTime
if not (null newAds)
then
- let message = P.renderConsoleAds config time newAds
+ let message = P.renderConsoleAds conf time newAds
in do
T.putStrLn message
- trySendMail config newAds
+ trySendMail conf newAds
else
return ()
- waitOneMinute
- listenToNewAdsWithViewedURLs config (viewedURLs ++ newURLs)
-
-trySendMail :: Config -> [Ad] -> IO ()
-trySendMail config ads =
- case C.mailTo config of
- [] ->
- return ()
- mailTo ->
- let (title, plainBody) = P.renderAds config ads
- htmlBody = H.renderAds config ads
- in do
- eitherMailSuccess <- sendMail mailTo title plainBody htmlBody
- case eitherMailSuccess of
- Right () ->
- putStrLn "\nMail sent."
- Left error ->
- T.putStrLn . T.concat $
- [ "\nError sending mail: "
- , error
- ]
-
-showErrorAndListenBack :: Config -> [URL] -> Text -> IO ()
-showErrorAndListenBack config viewedURLs error = do
+ waitListenInterval conf
+ listenToNewAdsWithViewedURLs conf (viewedURLs ++ newURLs)
+
+trySendMail :: Conf -> [Ad] -> IO ()
+trySendMail conf ads =
+ let (title, plainBody) = P.renderAds conf ads
+ htmlBody = H.renderAds conf ads
+ mail = Mail (Conf.mailFrom conf) (Conf.mailTo conf) title (strictToLazy plainBody) (strictToLazy htmlBody)
+ in Mail.send mail >> return ()
+
+strictToLazy :: Text -> LT.Text
+strictToLazy = toLazyText . fromText
+
+showErrorAndListenBack :: Conf -> [URL] -> Text -> IO ()
+showErrorAndListenBack conf viewedURLs error = do
T.putStrLn error
- waitOneMinute
- listenToNewAdsWithViewedURLs config viewedURLs
+ waitListenInterval conf
+ listenToNewAdsWithViewedURLs conf viewedURLs
-waitOneMinute :: IO ()
-waitOneMinute = threadDelay (1000 * 1000 * 60)
+waitListenInterval :: Conf -> IO ()
+waitListenInterval = threadDelay . (*) 1000000 . round . Conf.listenInterval
diff --git a/src/Conf.hs b/src/Conf.hs
new file mode 100644
index 0000000..fccf2a5
--- /dev/null
+++ b/src/Conf.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Conf
+ ( parse
+ , Conf(..)
+ ) where
+
+import Data.Text (Text)
+import qualified Data.ConfigManager as Conf
+import Data.Time.Clock (NominalDiffTime)
+
+import Model.URL
+
+data Conf = Conf
+ { url :: URL
+ , mailFrom :: Text
+ , mailTo :: [Text]
+ , properties :: [Text]
+ , listenInterval :: NominalDiffTime
+ } deriving Show
+
+parse :: FilePath -> IO (Either Text Conf)
+parse path =
+ (flip fmap) (Conf.readConfig path) (\configOrError -> do
+ conf <- configOrError
+ Conf <$>
+ Conf.lookup "url" conf <*>
+ Conf.lookup "mailFrom" conf <*>
+ Conf.lookup "mailTo" conf <*>
+ Conf.lookup "properties" conf <*>
+ Conf.lookup "listenInterval" conf
+ )
diff --git a/src/Config.hs b/src/Config.hs
deleted file mode 100644
index 0a80183..0000000
--- a/src/Config.hs
+++ /dev/null
@@ -1,106 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Config
- ( configUsage
- , Config(..)
- , getConfig
- ) where
-
-import Data.Maybe (catMaybes, isJust, fromMaybe)
-import Data.Map (Map)
-import qualified Data.Map as M
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.IO as T
-import Data.Text.Read (decimal)
-
-import Control.Monad (guard)
-
-import System.Directory (doesFileExist)
-
-import Model.URL
-import Model.Config
-
-import Utils.Text
-
-configUsage :: Text
-configUsage =
- T.intercalate "\n"
- [ ""
- , T.concat
- [ " Some information is required in the file `"
- , T.pack configPath
- , "`:"
- ]
- , ""
- , " - url (required)"
- , " - mailTo (optional)"
- , " - properties (optional)"
- , ""
- , " Example:"
- , ""
- , " # Lines beginning with '#' are ignored"
- , ""
- , " # The url field is required"
- , " url = http://www.leboncoin.fr/locations/offres/ile_de_france/?f=a&th=1"
- , ""
- , " # The mailTo field is an optional list"
- , " # mailTo = jean.dupont@mail.fr, john.smith@mail.com"
- , ""
- , " # The properties field is an optional list"
- , " # properties = cp, city, surface, ges"
- ]
-
-configPath :: FilePath
-configPath = "conf"
-
-getConfig :: IO (Maybe Config)
-getConfig = do
- exists <- doesFileExist configPath
- if exists
- then
- configFromFile <$> T.readFile configPath
- else
- return Nothing
-
-configFromFile :: Text -> Maybe Config
-configFromFile =
- configFromMap
- . M.fromList
- . catMaybes
- . map lineConfig
- . filter (not . T.null)
- . filter (not . startsWith "#")
- . map T.strip
- . T.lines
-
-configFromMap :: Map Text Text -> Maybe Config
-configFromMap map = do
- url <- M.lookup "url" map
- let config =
- Config
- { url = url
- , mailTo = fieldValues "mailTo" map
- , properties = fieldValues "properties" map
- }
- return config
-
-fieldValues :: Text -> Map Text Text -> [Text]
-fieldValues field map = fromMaybe [] $ fmap T.strip . T.splitOn "," <$> M.lookup field map
-
-lineConfig :: Text -> Maybe (Text, Text)
-lineConfig line = do
- (key, value) <- keyValue line
- guard (T.length key > 0)
- return (key, value)
-
-keyValue :: Text -> Maybe (Text, Text)
-keyValue line =
- let sep = '='
- in if isJust (T.find (== sep) line)
- then
- let key = T.takeWhile (/= sep) line
- value = T.drop 1 . T.dropWhile (/= sep) $ line
- in Just (T.strip key, T.strip value)
- else
- Nothing
diff --git a/src/Fetch.hs b/src/Fetch.hs
index a4e8c94..c80a980 100644
--- a/src/Fetch.hs
+++ b/src/Fetch.hs
@@ -4,20 +4,19 @@ module Fetch
) where
import Data.Text (Text)
-import qualified Data.Text as T
-import Page (getPage)
+import Page
-import Model.Ad
-import Model.Resume
-import Model.Detail
-import Model.URL
+import Model.Ad (Ad(Ad))
+import Model.Resume (Resume)
+import qualified Model.Resume as Resume
+import Model.URL (URL)
-import Parser.Resume
-import Parser.Detail
+import qualified Parser.Resume as Resume
+import qualified Parser.Detail as Detail
fetchResumes :: URL -> IO (Either Text [Resume])
-fetchResumes url = fmap parseResumes <$> getPage url
+fetchResumes url = fmap Resume.parse <$> Page.get url
fetchAds :: [Resume] -> IO (Either Text [Ad])
fetchAds resumes = do
@@ -25,6 +24,4 @@ fetchAds resumes = do
return $ sequence xs
fetchAd :: Resume -> IO (Either Text Ad)
-fetchAd resume = do
- page <- getPage (url resume)
- fmap (\page -> Ad { resume = resume, detail = parseDetail page}) <$> getPage (url resume)
+fetchAd resume = fmap (\ad -> Ad resume (Detail.parse ad)) <$> Page.get (Resume.url resume)
diff --git a/src/Mail.hs b/src/Mail.hs
index 83a2bbd..bf1516e 100644
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -1,42 +1,45 @@
{-# LANGUAGE OverloadedStrings #-}
module Mail
- ( sendMail
+ ( send
) where
import Data.Text (Text)
import qualified Data.Text as T
-import qualified Data.Text.Lazy as LT
-import Data.Text.Lazy.Builder (toLazyText, fromText)
+import Data.Either (isLeft)
import Control.Exception (SomeException, try)
+import Control.Arrow (left)
-import Network.Mail.Mime
+import qualified Network.Mail.Mime as Mime
-import Utils.Either (mapLeft)
+import Model.Mail (Mail)
+import qualified Model.Mail as Mail
-sendMail :: [Text] -> Text -> Text -> Text -> IO (Either Text ())
-sendMail mailTo subject plainBody htmlBody = safeSendMail (mail mailTo subject plainBody htmlBody)
+send :: Mail -> IO (Either Text ())
+send mail = do
+ result <- left (T.pack . show) <$> (try (Mime.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ()))
+ if isLeft result
+ then putStrLn ("Error sending the following email:" ++ (show mail))
+ else return ()
+ return result
-safeSendMail :: Mail -> IO (Either Text ())
-safeSendMail mail =
- mapLeft (T.pack . show) <$> (try (renderSendMail mail) :: IO (Either SomeException ()))
-
-mail :: [Text] -> Text -> Text -> Text -> Mail
-mail mailTo subject plainBody htmlBody =
- let fromMail = emptyMail (address "no-reply@leboncoin-listener.com")
+getMimeMail :: Mail -> Mime.Mail
+getMimeMail mail =
+ let fromMail = Mime.emptyMail . address . Mail.from $ mail
in fromMail
- { mailTo = map address mailTo
- , mailParts =
- [ [ plainPart . strictToLazy $ plainBody
- , htmlPart . strictToLazy $ htmlBody
+ { Mime.mailTo = map address . Mail.to $ mail
+ , Mime.mailParts =
+ [ [ Mime.plainPart . Mail.plainBody $ mail
+ , Mime.htmlPart . Mail.htmlBody $ mail
]
]
- , mailHeaders = [("Subject", subject)]
+ , Mime.mailHeaders = [("Subject", Mail.subject mail)]
}
-strictToLazy :: Text -> LT.Text
-strictToLazy = toLazyText . fromText
-
-address :: Text -> Address
-address mail = Address { addressName = Nothing, addressEmail = mail }
+address :: Text -> Mime.Address
+address addressEmail =
+ Mime.Address
+ { Mime.addressName = Nothing
+ , Mime.addressEmail = addressEmail
+ }
diff --git a/src/Main.hs b/src/Main.hs
index f38646b..27dcfa5 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -6,16 +6,15 @@ module Main
import qualified Data.Text.IO as T
-import AdListener (listenToNewAds)
+import qualified AdListener
-import Config (Config)
-import qualified Config as C
+import qualified Conf
main :: IO ()
main = do
- maybeConfig <- C.getConfig
- case maybeConfig of
- Just config ->
- listenToNewAds config
- Nothing ->
- T.putStrLn C.configUsage
+ eitherConfig <- Conf.parse "application.conf"
+ case eitherConfig of
+ Right config ->
+ AdListener.start config
+ Left message ->
+ T.putStrLn message
diff --git a/src/Model/Config.hs b/src/Model/Config.hs
deleted file mode 100644
index 42b390e..0000000
--- a/src/Model/Config.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Model.Config
- ( Config(..)
- ) where
-
-import Data.Text
-
-import Model.URL
-
-data Config = Config
- { url :: URL
- , mailTo :: [Text]
- , properties :: [Text]
- } deriving (Eq, Read, Show)
diff --git a/src/Model/Mail.hs b/src/Model/Mail.hs
new file mode 100644
index 0000000..20addee
--- /dev/null
+++ b/src/Model/Mail.hs
@@ -0,0 +1,14 @@
+module Model.Mail
+ ( Mail(..)
+ ) where
+
+import Data.Text (Text)
+import qualified Data.Text.Lazy as LT
+
+data Mail = Mail
+ { from :: Text
+ , to :: [Text]
+ , subject :: Text
+ , plainBody :: LT.Text
+ , htmlBody :: LT.Text
+ } deriving (Eq, Show)
diff --git a/src/Model/Resume.hs b/src/Model/Resume.hs
index 46d07a1..3e3cd82 100644
--- a/src/Model/Resume.hs
+++ b/src/Model/Resume.hs
@@ -6,9 +6,8 @@ module Model.Resume
import Data.List ((\\))
import Data.Text (Text)
-import qualified Data.Text as T
-import Model.URL
+import Model.URL (URL)
data Resume = Resume
{ name :: Text
diff --git a/src/Page.hs b/src/Page.hs
index 443f768..8a8ebea 100644
--- a/src/Page.hs
+++ b/src/Page.hs
@@ -1,21 +1,22 @@
module Page
- ( getPage
+ ( get
) where
import Control.Exception (SomeException, try)
import Data.Text (Text)
import qualified Data.Text as T
+import Data.Text.Encoding as T
+import Data.ByteString.Lazy as BS
-import Network.HTTP (simpleHTTP, getRequest, getResponseBody)
+import Network.HTTP.Conduit
import Model.URL
import Utils.Either (mapLeft)
-getPage :: URL -> IO (Either Text Text)
-getPage url =
- mapLeft (T.pack . show) <$> (try (unsafeGetPage url) :: IO (Either SomeException Text))
+get :: URL -> IO (Either Text Text)
+get url = mapLeft (T.pack . show) <$> (try (unsafeGetPage url) :: IO (Either SomeException Text))
unsafeGetPage :: URL -> IO Text
-unsafeGetPage url = simpleHTTP (getRequest (T.unpack url)) >>= (\x -> T.pack <$> getResponseBody x)
+unsafeGetPage url = (T.decodeLatin1 . BS.toStrict) <$> simpleHttp (T.unpack url)
diff --git a/src/Parser/Detail.hs b/src/Parser/Detail.hs
index 3f424e9..2418d07 100644
--- a/src/Parser/Detail.hs
+++ b/src/Parser/Detail.hs
@@ -1,5 +1,5 @@
module Parser.Detail
- ( parseDetail
+ ( parse
) where
import Data.Text (Text)
@@ -16,18 +16,18 @@ import Model.Detail
import Parser.Utils
-parseDetail :: Text -> Detail
-parseDetail page =
+parse :: Text -> Detail
+parse page =
let tags = parseTags page
in Detail
{ description = parseDescription tags
- , images = getTagAttributes "<meta itemprop=image>" (T.pack "content") tags
+ , images = map (\url -> T.concat [T.pack "https:", url]) $ getTagAttributes "<meta itemprop=image>" (T.pack "content") tags
, properties = parseProperties tags
}
parseDescription :: [Tag Text] -> Maybe Text
parseDescription tags =
- let descriptionTags = getTagsBetween "<div itemprop=description>" "</div>" tags
+ let descriptionTags = getTagsBetween "<p itemprop=description>" "</p>" tags
in if null descriptionTags
then
Nothing
@@ -37,7 +37,7 @@ parseDescription tags =
parseProperties :: [Tag Text] -> Map Text Text
parseProperties tags =
- let mbUtagData = getTagTextAfter "<script>" . getTagsAfter "<body>" $ tags
+ let mbUtagData = getTagTextAfter "<script>" . getTagsAfter "</script>" . getTagsAfter "<body>" $ tags
in fromMaybe M.empty (fmap parseUtagData mbUtagData)
parseUtagData :: Text -> Map Text Text
diff --git a/src/Parser/Resume.hs b/src/Parser/Resume.hs
index 76faca4..f300ec3 100644
--- a/src/Parser/Resume.hs
+++ b/src/Parser/Resume.hs
@@ -1,5 +1,5 @@
module Parser.Resume
- ( parseResumes
+ ( parse
) where
import Data.Maybe (catMaybes)
@@ -8,22 +8,22 @@ import qualified Data.Text as T
import Text.HTML.TagSoup
-import Model.Resume
+import Model.Resume (Resume(Resume))
import Parser.Utils
-parseResumes :: Text -> [Resume]
-parseResumes page =
- case sections (~== "<div class=list-lbc>") (parseTags page) of
+parse :: Text -> [Resume]
+parse page =
+ case dropWhile (not . hasClass (T.pack "section") (T.pack "tabsContent")) (parseTags page) of
[] ->
[]
- sectionTags : _ ->
- let lbcTags = takeWhile (~/= "<div id=alertesCartouche>") sectionTags
+ sectionTags ->
+ let lbcTags = takeWhile (not . hasClass (T.pack "div") (T.pack "information-immo")) sectionTags
in catMaybes . fmap parseResume $ partitions (~== "<a>") lbcTags
parseResume :: [Tag Text] -> Maybe Resume
parseResume item = do
- name <- getTagTextAfter "<h2 class=title>" item
- let price = getTagTextAfter "<div class=price>" item
+ name <- getTagTextAfter "<h2 class=item_title>" item
+ let price = getTagTextAfter "<h3 class=item_price>" item
url <- getTagAttribute "<a>" (T.pack "href") item
- return Resume { name = name, price = price, url = url }
+ return (Resume name price (T.concat [T.pack "https:", url]))
diff --git a/src/Parser/Utils.hs b/src/Parser/Utils.hs
index d72a1ce..98694bb 100644
--- a/src/Parser/Utils.hs
+++ b/src/Parser/Utils.hs
@@ -5,14 +5,16 @@ module Parser.Utils
, getTagAttributes
, getTagAttribute
, getTagTextAfter
+ , hasClass
) where
import Data.List (find, findIndex)
-import Data.Maybe (listToMaybe, catMaybes)
+import Data.Maybe (listToMaybe, catMaybes, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Text.HTML.TagSoup
+import Text.HTML.TagSoup.Match (tagOpen)
getTagsBefore :: String -> [Tag Text] -> [Tag Text]
getTagsBefore selector = takeWhile (~/= selector)
@@ -43,7 +45,15 @@ getTagTextAfter selector tags =
maybeTagAttribute :: Text -> Tag Text -> Maybe Text
maybeTagAttribute name (TagOpen _ xs) =
fmap snd . find (\(x, _) -> x == name) $ xs
-maybeTagAttribute attribute _ = Nothing
+maybeTagAttribute _ _ = Nothing
safeGetAt :: Int -> [a] -> Maybe a
safeGetAt index = listToMaybe . drop index
+
+hasClass :: Text -> Text -> Tag Text -> Bool
+hasClass selector className =
+ tagOpen ((==) selector) (isJust . find matchClass)
+ where matchClass (name, values) =
+ ( name == (T.pack "class")
+ && (isJust . find ((==) className) . T.words $ values)
+ )
diff --git a/src/View/Html/Ad.hs b/src/View/Html/Ad.hs
index 2d6bdb5..d8a3bae 100644
--- a/src/View/Html/Ad.hs
+++ b/src/View/Html/Ad.hs
@@ -7,8 +7,7 @@ module View.Html.Ad
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Lazy (toStrict)
-import Data.Maybe (fromMaybe, catMaybes)
-import Data.String (fromString)
+import Data.Maybe (catMaybes)
import Data.List (intersperse)
import Data.Map (Map)
import qualified Data.Map as M
@@ -20,39 +19,40 @@ import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Text.Blaze.Internal (textValue)
-import Model.Ad
-import qualified Model.Ad as A
+import Model.Ad (Ad)
+import qualified Model.Ad as Ad
import Model.Resume (Resume)
-import qualified Model.Resume as R
+import qualified Model.Resume as Resume
import Model.Detail (Detail)
-import qualified Model.Detail as D
+import qualified Model.Detail as Detail
import Model.URL
-import Model.Config
+import Conf (Conf)
+import qualified Conf
import View.Html.Design
-renderAds :: Config -> [Ad] -> Text
-renderAds config = toStrict . renderHtml . (adsHtml config)
+renderAds :: Conf -> [Ad] -> Text
+renderAds conf = toStrict . renderHtml . (adsHtml conf)
-adsHtml :: Config -> [Ad] -> Html
-adsHtml config ads = do mapM_ (adHtml config) ads
+adsHtml :: Conf -> [Ad] -> Html
+adsHtml conf ads = do mapM_ (adHtml conf) ads
-adHtml :: Config -> Ad -> Html
-adHtml config ad =
- let resume = A.resume ad
- detail = A.detail ad
+adHtml :: Conf -> Ad -> Html
+adHtml conf ad =
+ let resume = Ad.resume ad
+ detail = Ad.detail ad
in do
resumeHtml resume
- detailHtml config detail
+ detailHtml conf detail
resumeHtml :: Resume -> Html
resumeHtml resume = do
H.h1 $ do
- (toHtml . R.name $ resume)
- case R.price resume of
+ (toHtml . Resume.name $ resume)
+ case Resume.price resume of
Just price ->
H.span
! A.class_ "price"
@@ -60,17 +60,17 @@ resumeHtml resume = do
$ toHtml price
Nothing ->
H.span ""
- linkHtml (R.url resume)
+ linkHtml (Resume.url resume)
-detailHtml :: Config -> Detail -> Html
-detailHtml config detail = do
- propertiesHtml (properties config) (D.properties detail)
- case D.description detail of
+detailHtml :: Conf -> Detail -> Html
+detailHtml conf detail = do
+ propertiesHtml (Conf.properties conf) (Detail.properties detail)
+ case Detail.description detail of
Just description ->
descriptionHtml description
Nothing ->
H.div ""
- mapM_ imageLinkHtml (D.images detail)
+ mapM_ imageLinkHtml (Detail.images detail)
propertiesHtml :: [Text] -> Map Text Text -> Html
propertiesHtml keys properties =
diff --git a/src/View/Html/Design.hs b/src/View/Html/Design.hs
index c33d991..6ef5659 100644
--- a/src/View/Html/Design.hs
+++ b/src/View/Html/Design.hs
@@ -8,7 +8,6 @@ module View.Html.Design
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
-import Data.Monoid ((<>))
import Clay
diff --git a/src/View/Plain/Ad.hs b/src/View/Plain/Ad.hs
index 5120226..75e35e2 100644
--- a/src/View/Plain/Ad.hs
+++ b/src/View/Plain/Ad.hs
@@ -5,7 +5,6 @@ module View.Plain.Ad
, renderAds
) where
-import Data.List (intersperse)
import Data.Maybe (fromMaybe, catMaybes)
import Data.Map (Map)
import qualified Data.Map as M
@@ -22,12 +21,13 @@ import qualified Model.Resume as Resume
import Model.Detail (Detail)
import qualified Model.Detail as Detail
-import Model.URL
-import Model.Config
+import Model.URL (URL)
+import Conf (Conf)
+import qualified Conf
-renderConsoleAds :: Config -> Text -> [Ad] -> Text
-renderConsoleAds config time ads =
- let (title, message) = renderAds config ads
+renderConsoleAds :: Conf -> Text -> [Ad] -> Text
+renderConsoleAds conf time ads =
+ let (title, message) = renderAds conf ads
titleWithTime =
T.concat
[ "\n["
@@ -44,10 +44,10 @@ renderConsoleAds config time ads =
, message
]
-renderAds :: Config -> [Ad] -> (Text, Text)
-renderAds config ads =
+renderAds :: Conf -> [Ad] -> (Text, Text)
+renderAds conf ads =
let titleMessage = renderTitle $ length ads
- adsMessage = T.intercalate "\n\n" . map (renderAd config) $ ads
+ adsMessage = T.intercalate "\n\n" . map (renderAd conf) $ ads
in (titleMessage, adsMessage)
renderTitle :: Int -> Text
@@ -63,31 +63,31 @@ renderTitle count =
, if count > 1 then "s" else ""
]
-renderAd :: Config -> Ad -> Text
-renderAd config ad =
+renderAd :: Conf -> Ad -> Text
+renderAd conf ad =
T.concat
[ renderResume (Ad.resume ad)
, "\n"
- , renderDetail config (Ad.detail ad)
+ , renderDetail conf (Ad.detail ad)
]
renderResume :: Resume -> Text
renderResume resume =
let formatPrice price = T.concat [" - ", price]
- price = fromMaybe "" . fmap formatPrice . Resume.price $ resume
- titleLine = T.concat [Resume.name resume, price]
+ getPrice = fromMaybe "" . fmap formatPrice . Resume.price $ resume
+ titleLine = T.concat [Resume.name resume, getPrice]
in T.intercalate "\n" [titleLine, Resume.url resume]
-renderDetail :: Config -> Detail -> Text
-renderDetail config detail =
+renderDetail :: Conf -> Detail -> Text
+renderDetail conf detail =
T.concat
- [ renderProperties (properties config) (Detail.properties detail)
+ [ renderProperties (Conf.properties conf) (Detail.properties detail)
, fromMaybe "−" (Detail.description detail)
, renderURLs "\n\nImages:" (Detail.images detail)
]
renderProperties :: [Text] -> Map Text Text -> Text
-renderProperties [] properties = ""
+renderProperties [] _ = ""
renderProperties keys properties =
T.concat
[ "\n"
@@ -102,6 +102,6 @@ renderProperty properties key =
(M.lookup key properties)
renderURLs :: Text -> [URL] -> Text
-renderURLs title [] = ""
+renderURLs _ [] = ""
renderURLs title urls =
T.intercalate "\n" (title:urls)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 14:33:36 +0000