module Data.Text.WordCount.Exec where
    
import Data.Monoid
import qualified Data.Text.IO as TLIO -- .Lazy.IO as TLIO
import Paths_wordchoice
import Options.Applicative
import Data.Maybe
import Data.Version
import Data.Text.WordCount
import Data.Text.WordCount.FileRead

-- | Program datatype to be parsed
data Program = Program { file :: FilePath 
                       , num :: Maybe Int 
                       , output :: Maybe FilePath } -- TODO add option for separators

-- | Command line argument parser
program :: Parser Program
program = Program
    <$> (argument str
        (metavar "FILEPATH"
        <> help "File to analyze"))
    <*> (optional (read <$> strOption
        (short 'n'
        <> long "number"
        <>  metavar "NUM"
        <> help "Top NUM words will be listed")))
    <*> (optional (strOption
        (short 'o'
        <> long "output"
        <>  metavar "OUTPUT"
        <> help "Filepath for output graph")))

-- | Parse for version info
versionInfo :: Parser (a -> a)
versionInfo = infoOption 
    ("wordchoice version: " ++ showVersion version) 
    (short 'v' <> long "version" <> help "Show version")

-- | Wraps parser with help parser
wrapper :: ParserInfo Program
wrapper = info (helper <*> versionInfo <*> program)
    (fullDesc
    <> progDesc "Word choice is a command-line meant to help you improve your writing. Simply point it to a file containing text and it will list your most frequently used words and their frequencies."
    <> header "Word choice command-line utility")

-- | Actual executable
exec :: IO ()
exec = execParser wrapper >>= pick

-- | Run parsed record
pick :: Program -> IO ()
pick rec = let n = fromMaybe 25 (num rec) in do
    contents <- processFile (file rec)
    TLIO.putStrLn . displayWords . topN n $ contents 
    case output rec of
        (Just out) -> flip makeFile out . topN n $ contents
        _ -> pure ()