From c4eb771fa09e3972106d80ada6b3c4a023b85249 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 30 Aug 2015 21:17:27 +0200 Subject: Fetch perfumes according to multiple materials --- src/Model/Json/Search.hs | 27 +++++++++++++++++++++++++++ src/Model/Perfume.hs | 36 ++++++++++++++++++++++++++++++++++++ src/Model/URL.hs | 22 ++++++++++++++++++++++ 3 files changed, 85 insertions(+) create mode 100644 src/Model/Json/Search.hs create mode 100644 src/Model/Perfume.hs create mode 100644 src/Model/URL.hs (limited to 'src/Model') diff --git a/src/Model/Json/Search.hs b/src/Model/Json/Search.hs new file mode 100644 index 0000000..194a4c8 --- /dev/null +++ b/src/Model/Json/Search.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Model.Json.Search + ( Search(..) + , getMaterialIdentifier + ) where + +import Control.Monad (mzero) + +import Data.Aeson +import Data.Text (Text) +import Data.List (find) + +data Search = Search + { identifier :: Text + , kind :: Text + } deriving (Show) + +instance FromJSON Search where + parseJSON (Object v) = + Search <$> + v .: "id" <*> + v .: "type" + parseJSON _ = mzero + +getMaterialIdentifier :: [Search] -> Maybe Text +getMaterialIdentifier = fmap identifier . find ((==) "matiere" . kind) diff --git a/src/Model/Perfume.hs b/src/Model/Perfume.hs new file mode 100644 index 0000000..0f99b55 --- /dev/null +++ b/src/Model/Perfume.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Model.Perfume + ( Perfume(..) + , csvPerfumes + , getCommonPerfumes + ) where + +import Data.Text (Text) +import qualified Data.Text as T + +import Model.URL + +import CSV + +data Perfume = Perfume + { name :: Text + , url :: URL + } deriving (Eq, Show) + +csvPerfumes :: [Perfume] -> Text +csvPerfumes = getCsv . map (\perfume -> [name perfume, url perfume]) + +getCommonPerfumes :: [[Perfume]] -> [Perfume] +getCommonPerfumes (perfumes1:perfumesSequences) = + filter + (\p1 -> + all + (\perfumes2 -> + any + (\p2 -> name p1 == name p2) + perfumes2 + ) + perfumesSequences + ) + perfumes1 diff --git a/src/Model/URL.hs b/src/Model/URL.hs new file mode 100644 index 0000000..76a9e86 --- /dev/null +++ b/src/Model/URL.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Model.URL + ( URL + , getIdURL + , getMaterialURL + , site + ) where + +import Data.Text (Text) +import qualified Data.Text as T + +type URL = Text + +getIdURL :: Text -> URL +getIdURL material = T.concat [site, "/ajax/global.php?term=", material] + +getMaterialURL :: Text -> URL +getMaterialURL materialId = T.concat [site, "/fiche-matiere-", materialId, ".php"] + +site :: URL +site = "http://olfatheque.com" -- cgit v1.2.3