diff options
author | Joris | 2015-08-30 21:17:27 +0200 |
---|---|---|
committer | Joris | 2015-08-30 21:17:27 +0200 |
commit | c4eb771fa09e3972106d80ada6b3c4a023b85249 (patch) | |
tree | 9214b64628e34089b73ff6b4bdcb0edbc668a51e /src/Model |
Fetch perfumes according to multiple materials
Diffstat (limited to 'src/Model')
-rw-r--r-- | src/Model/Json/Search.hs | 27 | ||||
-rw-r--r-- | src/Model/Perfume.hs | 36 | ||||
-rw-r--r-- | src/Model/URL.hs | 22 |
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" |