diff options
| -rw-r--r-- | src/CommandLineOptions.hs | 17 | ||||
| -rw-r--r-- | src/Main.hs | 32 | ||||
| -rw-r--r-- | 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] |