Fetch perfumes according to multiple materials

1 files changed, 56 insertions, 0 deletions

diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..cf557a0
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main
+  ( main
+  ) where
+
+import HTTP
+
+import System.Environment (getArgs, getProgName)
+
+import Data.List (intercalate)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Data.Text.Encoding (encodeUtf8)
+import Data.Aeson (eitherDecodeStrict)
+
+import Model.URL
+import Model.Json.Search
+import Model.Perfume
+
+import PerfumeParser (parsePerfumes)
+
+main :: IO ()
+main = do
+  args <- getArgs
+  case args of
+    [] -> 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 error
+        Right perfumesSequences ->
+          let commonPerfumes = getCommonPerfumes perfumesSequences
+              outputName = (intercalate "-" materials) ++ ".csv"
+          in  T.writeFile outputName (csvPerfumes commonPerfumes)
+
+getHtmlPerfumes :: Text -> IO (Either Text [Perfume])
+getHtmlPerfumes material = do
+  eitherPage <- getPage (getIdURL material)
+  case eitherPage of
+    Left error ->
+      return . Left $ error
+    Right page ->
+      case eitherDecodeStrict (encodeUtf8 page) :: Either String [Search] of
+        Left error ->
+          return . Left . T.pack $ error
+        Right searches ->
+          case getMaterialIdentifier searches of
+            Nothing ->
+              return . Left $ "No material identifier found"
+            Just identifier -> do
+              fmap parsePerfumes <$> getPage (getMaterialURL identifier)