From a45cffb45e751275b30f558109c21d8c6507e07d Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 1 Sep 2015 15:18:57 +0200
Subject: Add a command line option to ignore materials

---
 src/CommandLineOptions.hs | 17 +++++++++++------
 src/Main.hs               | 32 +++++++++++++++++++-------------
 src/Model/Perfume.hs      | 39 +++++++++++++++++++++++++++++----------
 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]
-- 
cgit v1.2.3