aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs32
1 files changed, 19 insertions, 13 deletions
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)