{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# 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 (($), flip)
import Data.Functor ((<$>))
import Data.Maybe (Maybe(..))
-- import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.Typeable
import Data.Void (Void)
import System.FilePath (FilePath)
import System.IO (IO, hPrint, stderr)
import Text.Show (Show(..))
import Prelude (error)
import qualified Data.List.NonEmpty as NonEmpty
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 qualified Control.Monad.Trans.State.Strict as SS
import Control.Monad.IO.Class (MonadIO(..))

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

import Hcompta.LCC.Journal
import Hcompta.LCC.Compta
import Hcompta.LCC.Transaction
import Hcompta.LCC.IO

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

read ::
 forall ss src e m j a.
 Sym.Source src =>
 Sym.ImportTypes ss =>
 Sym.ModulesTyInj ss =>
 Sym.ModulesInj src ss =>
 m ~ S.StateT (Context_Read src) (S.StateT (State_Sym src ss) IO) =>
 e ~ P.ParseError Char Void =>
 Typeable j =>
 H.Zeroable j =>
 (Transaction src -> j -> j) ->
 CF (P.ParsecT Void Text m) a ->
 FilePath -> Text ->
 IO ((Either e a, Context_Read src), State_Sym src ss)
read consTxn g fp inp =
	S.runState state_sym $
	S.runState (context_read consTxn) $
	P.runParserT (unCF $ g <* eoi) (FilePath.normalise fp) inp

readWithSym ::
 forall src e m j a.
 Sym.Source src =>
 m ~ S.StateT (Context_Read src) IO =>
 e ~ P.ParseError Char Void =>
 Typeable j =>
 H.Zeroable j =>
 (Transaction src -> j -> j) ->
 CF (P.ParsecT Void Text m) a ->
 FilePath -> Text ->
 IO (Either e a, Context_Read src)
readWithSym consTxn g fp inp =
	S.runState (context_read consTxn) $
	P.runParserT (unCF $ g <* eoi) (FilePath.normalise fp) inp

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


instance
 ( Gram_Source src (P.ParsecT Void Text (S.StateT (Context_Read src) IO))
 , Typeable src
 , Show src
 ) => FromFile (LCC src) where
	fromFile (PathFile p) =
		readLCC @src p >>= \case
		 Left err -> error $ show err
		 Right (a, warns) -> do
			liftIO $ hPrint stderr warns
			return a

readLCC ::
 forall src.
 Gram_Source src (P.ParsecT Void Text (S.StateT (Context_Read src) IO)) =>
 Sym.Source src =>
 Typeable src =>
 FilePath ->
 IO (Either (Error_Read src) (LCC src, [At src Warning_Compta]))
readLCC path = do
	(r, Context_Read{context_read_journals=(lcc_journals::Journals src j), ..}) <-
		readFile path $ readWithSym @src consTransactions $ g_compta @src
	case r of
	 Left err -> return $ Left $ Error_Read_Syntax err
	 Right r' | Just (Sym.Refl :: Transactions src Sym.:~: j) <- eqT ->
		return $ case r' of
		 S.Left err -> Left $ Error_Read_Semantic err
		 S.Right _r'' -> Right $ (,context_read_warnings) LCC
			 { lcc_journals
			 , lcc_chart = context_read_chart
			 , lcc_style = context_read_style_amounts
			 , lcc_base  = NonEmpty.head context_read_canonfiles
			 }
	 Right _r' -> do
		hPrint stderr $ typeRep (Proxy @Transactions)
		hPrint stderr $ typeRep (Proxy @j)
		error "[BUG] readLCC"















{-
consTransactions :: Transaction src -> Map Date [Transaction src] -> Map Date [Transaction src]
consTransactions t = Map.insertWith (<>) (transaction_date t) [t]
-}
consTransactions :: Transaction src -> Transactions src -> Transactions src
consTransactions t (Transactions ts) = Transactions $ Map.insertWith (flip (<>)) (transaction_date t) [t] ts

{-

type ComptaT src ss =
 P.ParsecT Void Text
           (S.StateT (Context_Read src)
                     (S.StateT (State_Sym src ({-Sym.Proxy (Compta src ss) ':-} ss))
                               IO))


instance Loadable src ss =>
         FromFile (Compta src ss (Map Date [Transaction])) where
	fromFile (PathFile p) =
		readLCC 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 Void)
 |   Error_Read_Semantic [At src (Error_Compta src)]
 deriving (Eq, Show)

{-
fromFile
 :: (Consable c j, Monoid j)
 => Context_Read c j
 -> FilePath
 -> ExceptT [R.Error Error_Read] IO (Journal j)
fromFile ctx path =
	ExceptT
	 (Exn.catch
		 (Right <$> Text.IO.fromFile 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
-}


{-
readLCC ::
 forall src ss.
 Loadable src ss =>
 Sym.NameTyOf (Code src ss) =>
 Sym.FixityOf (Code src ss) =>
 Sym.ClassInstancesFor (Code src ss) =>
 Sym.TypeInstancesFor (Code src ss) =>
 Sym.ModuleFor src (Sym.Proxy (Code src ss) : ss) (Code src ss) =>
 Sym.ModulesInj src (Sym.Proxy (Code src ss) : ss) =>
 Show src =>
 FilePath ->
 IO (Either (Error_Read src) (LCC, [At src Warning_Compta]))
readLCC path = do
	((r, Context_Read{context_read_journals=(lcc_journals::Journals j), ..}), State_Sym{..}) <-
		fromFile path (read @(Sym.Proxy (Code src ss) ': ss) @src consTransactions $
			g_compta @(Sym.Proxy (Code src ss) ': ss) @src)
	return $ case r of
	 Left err -> Left $ Error_Read_Syntax err
	 Right r' | Just (Sym.Refl :: Transactions Sym.:~: j) <- eqT ->
		case r' of
		 S.Left err -> Left $ Error_Read_Semantic err
		 S.Right _r'' -> Right $ (,context_read_warnings) LCC
			 { lcc_journals
			 , lcc_chart = context_read_chart
			 , lcc_style = context_read_style_amounts
			 -- , lcc_modules       = context_sym_modules
			 -- , lcc_terms         = context_sym_terms
			 }
-}
{-
newtype ComptaG src ss a = ComptaG (forall j. P.ParsecT Void Text (S.StateT (Context_Read src j) (S.StateT (State_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 Void Text (S.StateT (Context_Read src) (S.StateT (State_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 Void)
              (S.Either [At src (Error_Compta src)] CanonFile)
     , Context_Read src )
    , State_Sym src ss )
readJournal path consTxn = fromFile path $ read consTxn $ g_compta @ss

type Loadable src ss =
 ( Sym.Source src
 , Show src
 , SourceInj (Sym.AST_Type src) src
 , SourceInj (Sym.KindK src) src
 , SourceInj (Sym.TypeVT src) src
 , Gram_Source src (P.ParsecT Void Text (S.StateT (Context_Read src)
                                         (S.StateT (State_Sym src (Sym.Proxy (Code src ss) ': ss)) IO)))
 , Sym.Gram_Term_Atoms src (Sym.Proxy (Code src ss) ': ss)
                           (P.ParsecT Void Text (S.StateT (Context_Read src)
                                                 (S.StateT (State_Sym src (Sym.Proxy (Code src ss) ': ss)) IO)))
 -- , 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 Void Text (S.StateT (Context_Read src j) (S.StateT (State_Sym src (Sym.Proxy (Compta src ss) : ss)) IO))) (Compta src ss)
 , Sym.ImportTypes    (Sym.Proxy (Code src ss) ': ss)
 , Sym.ModulesTyInj   (Sym.Proxy (Code src ss) ': ss)
 , Sym.ModulesInj src (Sym.Proxy (Code src ss) ': ss)
 , Typeable ss
 , Typeable src
 )
-}