{-# LANGUAGE OverloadedStrings #-} module Main ( main ) where import HTTP import System.Environment (getArgs, getProgName) import System.Directory (createDirectory) 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 outputDirectory = "output" outputName = outputDirectory ++ "/" ++ (intercalate "-" materials) ++ ".csv" in do createDirectory outputDirectory T.writeFile outputName (csvPerfumes commonPerfumes) putStrLn ("Successfully generated " ++ outputName) 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)