aboutsummaryrefslogtreecommitdiff
path: root/src/Model
diff options
context:
space:
mode:
authorJoris2015-08-30 21:17:27 +0200
committerJoris2015-08-30 21:17:27 +0200
commitc4eb771fa09e3972106d80ada6b3c4a023b85249 (patch)
tree9214b64628e34089b73ff6b4bdcb0edbc668a51e /src/Model
Fetch perfumes according to multiple materials
Diffstat (limited to 'src/Model')
-rw-r--r--src/Model/Json/Search.hs27
-rw-r--r--src/Model/Perfume.hs36
-rw-r--r--src/Model/URL.hs22
3 files changed, 85 insertions, 0 deletions
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"