{-# LANGUAGE OverloadedStrings #-} module Main ( main ) where import HTTP import Control.Applicative ((<$>)) import System.Environment (getArgs, getProgName) import System.Directory (createDirectoryIfMissing) 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 CommandLineOptions import Model.URL import Model.Json.Search import Model.Perfume import PerfumeParser (parsePerfumes) main :: IO () main = 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, " 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, Right ignoredPerfumesSequences) -> let commonPerfumes = mergePerfumes perfumesSequences ignoredPerfumesSequences outputDirectory = "output" 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) 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 $ T.concat [ "No material identifier found for ", material ] Just identifier -> do fmap parsePerfumes <$> getPage (getMaterialURL identifier)