{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.LCC.Read
 ( module Hcompta.LCC.Read
 , module Hcompta.LCC.Read.Compta
 , module Hcompta.LCC.Read.Megaparsec
 ) where

import Control.Applicative (Applicative(..), (<*))
import Control.Monad (Monad(..))
import Data.Char (Char)
import Data.Either (Either(..))
import Data.Eq (Eq)
import Data.Function (($), (.))
import Data.Functor (Functor(..), (<$>))
import Data.Map.Strict (Map)
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.Typeable (Typeable, eqT)
import System.FilePath (FilePath)
import System.IO (IO, hPrint, stderr)
import Text.Show (Show(..))
import Prelude (error)
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.IO
-- import Hcompta.LCC.Sym.Compta ()

import Hcompta.LCC.Read.Compta
import Hcompta.LCC.Read.Megaparsec
import qualified Hcompta.LCC.Lib.Strict as S
import qualified Hcompta as H

-- import qualified Control.Monad.Classes as MC

read ::
 forall ss src e m j a.
 Source src =>
 Sym.ImportTypes ss =>
 Sym.ModulesTyInj ss =>
 Sym.ModulesInj src ss =>
 m ~ S.StateT (Context_Read src) (S.StateT (Context_Sym src ss) IO) =>
 e ~ P.ParseError Char P.Dec =>
 Typeable j =>
 H.Zeroable j =>
 (Transaction -> j -> j) ->
 CF (P.ParsecT P.Dec Text m) a ->
 FilePath -> Text ->
 IO ((Either e a, Context_Read src), Context_Sym src ss)
read consTxn g fp inp =
	S.runState context_sym $
	S.runState (context_read consTxn) $
	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

{-
newtype ComptaG src ss a = ComptaG (forall j. P.ParsecT P.Dec Text (S.StateT (Context_Read src j) (S.StateT (Context_Sym src ss) IO)) a)
instance Functor     (ComptaG src ss) where
	fmap f (ComptaG m) = ComptaG (fmap f m)
instance Applicative (ComptaG src ss) where
	pure a = ComptaG (pure a)
	ComptaG f <*> ComptaG a = ComptaG (f <*> a)
instance Monad (ComptaG src ss) where
	return = pure
	ComptaG m >>= f = ComptaG (m >>= \a -> case f a of ComptaG b -> b)
-}

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

readCompta ::
 forall src ss j.
 Comptable src ss =>
 Show src =>
 Typeable j =>
 H.Zeroable j =>
 (Transaction -> j -> j) ->
 FilePath ->
 IO (Either (Error_Read src) (Compta src ss j, [At src Warning_Compta]))
readCompta consTxn path = do
	((r, Context_Read{context_read_journals=(compta_journals::Journals j'), ..}), Context_Sym{..}) <-
		readFile path (read @(Sym.Proxy (Compta src ss) ': ss) @src consTxn $ g_compta @(Sym.Proxy (Compta src ss) ': ss) @src)
	return $ case r of
	 Left err -> Left $ Error_Read_Syntax err
	 Right r' | Just (Sym.Refl :: j Sym.:~: j') <- eqT ->
		case r' of
		 S.Left err -> Left $ Error_Read_Semantic err
		 S.Right _r'' -> Right $ (,context_read_warnings) Compta
			 { compta_journals
			 , compta_chart         = context_read_chart
			 , compta_style_amounts = context_read_style_amounts
			 , compta_modules       = context_sym_modules
			 , compta_terms         = context_sym_terms
			 }

consTransactions :: Transaction -> Map Date [Transaction] -> Map Date [Transaction]
consTransactions t = Map.insertWith (<>) (transaction_date t) [t]

type ComptaT src ss =
 P.ParsecT P.Dec Text
           (S.StateT (Context_Read src)
                     (S.StateT (Context_Sym src (Sym.Proxy (Compta src ss) ': ss))
                               IO))

type Comptable src ss =
 ( Source src
 , Show src
 , SourceInj (Sym.AST_Type src) src
 , SourceInj (Sym.KindK src) src
 , SourceInj (Sym.TypeVT src) src
 , Gram_Source src (ComptaT src ss)
 , Sym.Gram_Term_Atoms src (Sym.Proxy (Compta src ss) ': ss) (ComptaT src ss)
 -- , Sym.Gram_Term_AtomsFor src (Sym.Proxy (Compta src ss) : ss) (ComptaT src ss j) (Compta src ss)
 -- , Sym.Gram_Term_AtomsR   src (Sym.Proxy (Compta src ss) : ss) ss (ComptaT src ss j)
   -- (P.ParsecT P.Dec Text (S.StateT (Context_Read src j) (S.StateT (Context_Sym src (Sym.Proxy (Compta src ss) : ss)) IO))) (Compta src ss)
 , Sym.ImportTypes         (Sym.Proxy (Compta src ss) ': ss)
 , Sym.ModulesTyInj        (Sym.Proxy (Compta src ss) ': ss)
 , Sym.ModulesInj src      (Sym.Proxy (Compta src ss) ': ss)
 , Typeable ss
 , Typeable src
 )

instance Comptable src ss =>
         FromFile (Compta src ss (Map Date [Transaction])) where
	fromFile (PathFile p) =
		readCompta consTransactions p >>= \case
		 Left err -> error $ show err
		 Right (a, warns) -> do
			hPrint stderr warns
			return a

-- * 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
-}