aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/CommandLineOptions.hs17
-rw-r--r--src/Main.hs32
-rw-r--r--src/Model/Perfume.hs39
3 files changed, 59 insertions, 29 deletions
diff --git a/src/CommandLineOptions.hs b/src/CommandLineOptions.hs
index bb0ac8d..9f8d849 100644
--- a/src/CommandLineOptions.hs
+++ b/src/CommandLineOptions.hs
@@ -1,15 +1,20 @@
+{-# LANGUAGE OverloadedStrings #-}
+
module CommandLineOptions
- ( parseOptions
+ ( Options(..)
+ , parseOptions
) where
+import Data.Text (Text)
+
data Options = Options
- { materials :: [String]
- , ignoreMaterials :: [String]
- }
+ { materials :: [Text]
+ , ignoreMaterials :: [Text]
+ } deriving (Eq, Show)
-parseOptions :: [String] -> Options
+parseOptions :: [Text] -> Options
parseOptions args =
- case splitWhere (== "--ignore") args of
+ case splitWhere (== "--without") args of
(materials, ignoredMaterials) -> Options materials ignoredMaterials
splitWhere :: (a -> Bool) -> [a] -> ([a], [a])
diff --git a/src/Main.hs b/src/Main.hs
index 72e580d..d561419 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -18,7 +18,7 @@ import qualified Data.Text.IO as T
import Data.Text.Encoding (encodeUtf8)
import Data.Aeson (eitherDecodeStrict)
-import CommandLineOptions (parseOptions)
+import CommandLineOptions
import Model.URL
import Model.Json.Search
@@ -28,25 +28,31 @@ import PerfumeParser (parsePerfumes)
main :: IO ()
main = do
- args <- getArgs
- case args of
- [] -> do
+ options@(Options materials ignoredMaterials) <- (parseOptions . map T.pack) <$> getArgs
+ if null materials
+ then do
progName <- T.pack <$> getProgName
- T.putStrLn (T.concat ["Usage: ", progName, " material"])
- materials -> do
- eitherPages <- fmap sequence <$> sequence . map getHtmlPerfumes . map T.pack $ materials
- case eitherPages of
- Left error ->
+ T.putStrLn (T.concat ["Usage: ", progName, " materials… [--without materials…]"])
+ else do
+ eitherPerfumesSequences <- getPerfumesSequences materials
+ eitherIgnoredPerfumesSequences <- getPerfumesSequences ignoredMaterials
+ case (eitherPerfumesSequences, eitherIgnoredPerfumesSequences) of
+ (Left error, _) ->
+ T.putStrLn error
+ (_, Left error) ->
T.putStrLn error
- Right perfumesSequences ->
- let commonPerfumes = getCommonPerfumes perfumesSequences
+ (Right perfumesSequences, Right ignoredPerfumesSequences) ->
+ let commonPerfumes = mergePerfumes perfumesSequences ignoredPerfumesSequences
outputDirectory = "output"
- outputName = outputDirectory ++ "/" ++ (intercalate "-" materials) ++ ".csv"
+ outputName = outputDirectory ++ "/" ++ (T.unpack . fileName $ options) ++ ".csv"
in do
createDirectoryIfMissing True outputDirectory
T.writeFile outputName (csvPerfumes commonPerfumes)
putStrLn ("Successfully generated " ++ outputName)
+getPerfumesSequences :: [Text] -> IO (Either Text [[Perfume]])
+getPerfumesSequences = fmap sequence <$> sequence . map getHtmlPerfumes
+
getHtmlPerfumes :: Text -> IO (Either Text [Perfume])
getHtmlPerfumes material = do
eitherPage <- getPage (getIdURL material)
@@ -60,6 +66,6 @@ getHtmlPerfumes material = do
Right searches ->
case getMaterialIdentifier searches of
Nothing ->
- return . Left $ "No material identifier found"
+ return . Left $ T.concat [ "No material identifier found for ", material ]
Just identifier -> do
fmap parsePerfumes <$> getPage (getMaterialURL identifier)
diff --git a/src/Model/Perfume.hs b/src/Model/Perfume.hs
index 0f99b55..f12936f 100644
--- a/src/Model/Perfume.hs
+++ b/src/Model/Perfume.hs
@@ -3,12 +3,15 @@
module Model.Perfume
( Perfume(..)
, csvPerfumes
- , getCommonPerfumes
+ , mergePerfumes
+ , fileName
) where
import Data.Text (Text)
import qualified Data.Text as T
+import CommandLineOptions (Options(..))
+
import Model.URL
import CSV
@@ -21,16 +24,32 @@ data Perfume = Perfume
csvPerfumes :: [Perfume] -> Text
csvPerfumes = getCsv . map (\perfume -> [name perfume, url perfume])
-getCommonPerfumes :: [[Perfume]] -> [Perfume]
-getCommonPerfumes (perfumes1:perfumesSequences) =
+mergePerfumes :: [[Perfume]] -> [[Perfume]] -> [Perfume]
+mergePerfumes (perfumes1:perfumesSequences) (ignoredPerfumesSequences) =
filter
(\p1 ->
- all
- (\perfumes2 ->
- any
- (\p2 -> name p1 == name p2)
- perfumes2
- )
- perfumesSequences
+ ( all
+ (\perfumes2 ->
+ any
+ (\p2 -> name p1 == name p2)
+ perfumes2
+ )
+ perfumesSequences
+ && all
+ (\perfumes2 ->
+ all
+ (\p2 -> name p1 /= name p2)
+ perfumes2
+ )
+ ignoredPerfumesSequences
+ )
)
perfumes1
+
+fileName :: Options -> Text
+fileName (Options materials ignoredMaterials) =
+ let materialNames = T.intercalate "-" materials
+ ignoredMaterialNames = T.intercalate "-" ignoredMaterials
+ in if null ignoredMaterials
+ then materialNames
+ else T.concat [materialNames, "-without-", ignoredMaterialNames]