{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Hcompta.CLI.Command.Journals where

import           Control.Monad (liftM, forM_)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.Except (runExceptT)
import qualified Data.Either
import qualified Data.Foldable
import           Data.Monoid ((<>))
import           System.Console.GetOpt
                 ( ArgDescr(..)
                 , OptDescr(..)
                 , usageInfo )
import           System.Environment as Env (getProgName)
import           System.Exit (exitSuccess)
import qualified System.IO as IO

import qualified Hcompta.CLI.Args as Args
import qualified Hcompta.CLI.Context as Context
import           Hcompta.CLI.Context (Context)
import qualified Hcompta.CLI.Format.Ledger as CLI.Ledger
import qualified Hcompta.CLI.Write as Write
import qualified Hcompta.Format.Ledger as Ledger
import qualified Hcompta.Format.Ledger.Journal as Ledger.Journal
import qualified Hcompta.Format.Ledger.Read as Ledger.Read
import qualified Hcompta.Lib.Leijen as W
import           Hcompta.Lib.Consable (Consable(..))

data Ctx
 =   Ctx
 { ctx_input              :: [FilePath]
 } deriving (Show)

nil :: Ctx
nil =
	Ctx
	 { ctx_input = []
	 }

usage :: IO String
usage = do
	bin <- Env.getProgName
	let pad = replicate (length bin) ' '
	return $unlines $
		[ "SYNTAX "
		, "  "++bin++" stats [-i JOURNAL_FILE]"
		, "  "++pad++"       [JOURNAL_FILE] [...]"
		, ""
		, usageInfo "OPTIONS" options
		]

options :: Args.Options Ctx
options =
	[ Option "h" ["help"]
	 (NoArg (\_context _ctx -> do
		usage >>= IO.hPutStr IO.stderr
		exitSuccess))
	 "show this help"
	, Option "i" ["input"]
	 (ReqArg (\s _context ctx -> do
		return $ ctx{ctx_input=s:ctx_input ctx}) "FILE")
	 "read data from given file, multiple uses merge the data as would a concatenation do"
	]

run :: Context.Context -> [String] -> IO ()
run context args = do
	(ctx, inputs) <- Args.parse context usage options (nil, args)
	read_journals <-
		liftM Data.Either.partitionEithers $ do
		CLI.Ledger.paths context $ ctx_input ctx ++ inputs
		>>= do
			mapM $ \path -> do
				liftIO $ runExceptT $ Ledger.Read.file
				 (Ledger.Read.context () Ledger.journal)
				 path
				>>= \x -> case x of
				 Left  ko -> return $ Left (path, ko)
				 Right ok -> return $ Right ok
	case read_journals of
	 (errs@(_:_), _journals) ->
		forM_ errs $ \(_path, err) -> do
			Write.fatal context $ err
	 ([], journals) -> do
		let files = ledger_journals ctx journals
		style_color <- Write.with_color context IO.stdout
		W.displayIO IO.stdout $ do
		W.renderPretty style_color 1.0 maxBound $ do
		doc_journals context ctx files

newtype Journals t = Journals ()
 deriving (Show)
instance Monoid (Journals t) where
	mempty = Journals ()
	mappend _ _ = mempty

instance Consable () Journals t where
	mcons () _t !_js = mempty

ledger_journals
 :: Ctx
 -> [ Ledger.Journal (Journals Ledger.Transaction) ]
 -> [FilePath]
ledger_journals _ctx =
	Data.Foldable.foldl'
	 (flip $ Ledger.Journal.fold
		 (\Ledger.Journal{Ledger.journal_file=f} ->
			mappend [f]))
	 mempty

doc_journals
 :: Context
 -> Ctx
 -> [FilePath]
 -> W.Doc
doc_journals _context _ctx =
	foldr
	 (\file doc -> doc <> W.toDoc () file <> W.line)
	 W.empty