{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.LCC.Read where

import Control.Applicative ((<*))
import Control.Monad (Monad(..))
import Data.Char (Char)
import Data.Either (Either(..))
import Data.Eq (Eq)
import Data.Function (($))
import Data.Functor ((<$>))
import Data.Map.Strict (Map)
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.Typeable ()
import System.FilePath (FilePath)
import System.IO (IO)
import Text.Show (Show)
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as Map
import qualified Data.Strict as S
import qualified Data.Text.Encoding as Enc
import qualified System.FilePath as FilePath
import qualified Text.Megaparsec as P

import Language.Symantic.Grammar
import qualified Language.Symantic as Sym
import Language.Symantic.Lib ()

import Hcompta.LCC.Journal
import Hcompta.LCC.Compta
import Hcompta.LCC.Posting
import Hcompta.LCC.Transaction

import Hcompta.LCC.Grammar
import Hcompta.LCC.Megaparsec ()
import qualified Hcompta.LCC.Lib.Strict as S

read ::
 forall ss src j e m a.
 Source src =>
 Monoid j =>
 Sym.Inj_Name2Type ss =>
 Sym.Inj_Modules src ss =>
 m ~ S.StateT (Context_Read src j) (S.StateT (Context_Sym src ss) IO) =>
 e ~ P.ParseError Char P.Dec =>
 CF (P.ParsecT P.Dec Text m) a ->
 FilePath -> Text ->
 IO ((Either e a, Context_Read src j), Context_Sym src ss)
read g fp inp =
	S.runState context_sym $
	S.runState context_read $
	P.runParserT (unCF $ g <* eoi) (FilePath.normalise fp) inp

readFile :: FilePath -> (FilePath -> Text -> IO a) -> IO a
readFile fp f = do
	content <- Enc.decodeUtf8 <$> BS.readFile fp
	f fp content

readJournal ::
 forall src ss j g.
 g ~ P.ParsecT P.Dec Text (S.StateT (Context_Read src j) (S.StateT (Context_Sym src ss) IO)) =>
 Monoid j =>
 Source src =>
 Show src =>
 Inj_Source (Sym.AST_Type src) src =>
 Inj_Source (Sym.KindK src) src =>
 Inj_Source (Sym.TypeVT src) src =>
 Gram_Source src g =>
 Sym.Gram_Term_Atoms src ss g =>
 Sym.Inj_Name2Type ss =>
 Sym.Inj_Modules src ss =>
 FilePath ->
 (Transaction -> j -> j) ->
 IO (( Either (P.ParseError Char P.Dec)
              (S.Either [At src (Error_Compta src)]
                        (CanonFile, Journal j))
     , Context_Read src j )
    , Context_Sym src ss )
readJournal path consTxn = readFile path $ read $ g_compta @ss consTxn

readCompta ::
 forall src ss j g.
 g ~ P.ParsecT P.Dec Text (S.StateT (Context_Read src j) (S.StateT (Context_Sym src ss) IO)) =>
 j ~ Map Date [Transaction] =>
 Monoid j =>
 Source src =>
 Show src =>
 Inj_Source (Sym.AST_Type src) src =>
 Inj_Source (Sym.KindK src) src =>
 Inj_Source (Sym.TypeVT src) src =>
 Gram_Source src g =>
 Sym.Gram_Term_Atoms src ss g =>
 Sym.Inj_Name2Type ss =>
 Sym.Inj_Modules src ss =>
 FilePath ->
 -- (Transaction -> j -> j) ->
 IO (Either (Error_Read src) (Compta src ss, [At src Warning_Compta]))
readCompta path = do
	((r, ctxRead), ctxSym) <-
		readFile path $ read $
		g_compta @ss (\t -> Map.insertWith (<>) (transaction_date t) [t])
	return $ case r of
	 Left err -> Left $ Error_Read_Syntax err
	 Right r' ->
		case r' of
		 S.Left err -> Left $ Error_Read_Semantic err
		 S.Right _r'' -> Right $ (,context_read_warnings ctxRead) Compta
			 { compta_journals      = context_read_journals      ctxRead
			 , compta_chart         = context_read_chart         ctxRead
			 , compta_style_amounts = context_read_style_amounts ctxRead
			 , compta_modules       = context_sym_modules        ctxSym
			 , compta_terms         = context_sym_terms          ctxSym
			 }

-- * Type 'Error_Read'
data Error_Read src
 =   Error_Read_Syntax   (P.ParseError Char P.Dec)
 |   Error_Read_Semantic [At src (Error_Compta src)]
 deriving (Eq, Show)

{-
readFile
 :: (Consable c j, Monoid j)
 => Context_Read c j
 -> FilePath
 -> ExceptT [R.Error Error_Read] IO (Journal j)
readFile ctx path =
	ExceptT
	 (Exn.catch
		 (Right <$> Text.IO.readFile path) $
		 \ko -> return $ Left $
			 [R.Error_Custom (R.initialPos path) $
				Error_Read_reading_file path ko])
	>>= liftIO . R.runParserTWithError
	 (read_journal path) ctx path
	>>= \x -> case x of
	 Left  ko -> throwE $ ko
	 Right ok -> ExceptT $ return $ Right ok
-}