{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Hcompta.CLI.Format where

import           Control.Monad.Trans.Except (runExceptT)
import           Data.Either (Either(..))
import           Data.Function (($), (.))
import           Data.Functor (Functor, (<$>))
import           Data.Monoid (Monoid(..))
import           System.IO (FilePath, IO)
import           Text.Show (Show)
import qualified Text.Parsec.Error.Custom as R

import qualified Hcompta.CLI.Lang as Lang
import qualified Text.WalderLeijen.ANSI.Text as W

import qualified Hcompta.JCC as JCC
import qualified Hcompta.Ledger as Ledger

import           Hcompta.Lib.Consable (Consable)
import qualified Hcompta.CLI.Lib.Leijen.Table as Leijen.Table

import Hcompta.CLI.Convert

-- * Type 'Format'

data Format jcc ledger
 =   Format_JCC    jcc
 |   Format_Ledger ledger
 deriving (Show)
type Formats = Format () ()

instance
 ( Convert jcc ledger
 , Convert ledger jcc
 , Monoid jcc
 , Monoid ledger
 ) => Monoid (Format jcc ledger) where
	mempty = Format_JCC mempty
	mappend x y =
		case x of
		 Format_JCC xj ->
			Format_JCC $
			case y of
			 Format_JCC    yj -> mappend xj yj
			 Format_Ledger yj -> mappend xj (convert yj)
		 Format_Ledger xj ->
			Format_Ledger $
			case y of
			 Format_JCC    yj -> mappend xj (convert yj)
			 Format_Ledger yj -> mappend xj yj

format :: Formats
format = Format_JCC ()

-- * Type family 'Journal_Account'
type family   Journal_Account (j:: * -> *)
type instance Journal_Account    JCC.Journal =    JCC.Account
type instance Journal_Account Ledger.Journal = Ledger.Account

-- * Type family 'Journal_Account_Section'
type family   Journal_Account_Section (j:: * -> *)
type instance Journal_Account_Section    JCC.Journal =    JCC.Account_Section
type instance Journal_Account_Section Ledger.Journal = Ledger.Account_Section

-- * Type family 'Journal_Charted'
type family   Journal_Charted (j:: * -> *) :: * -> *
type instance Journal_Charted    JCC.Journal =    JCC.Charted
type instance Journal_Charted Ledger.Journal = Ledger.Charted

-- * Type family 'Journal_Quantity'
type family   Journal_Quantity (j:: * -> *)
type instance Journal_Quantity    JCC.Journal =    JCC.Quantity
type instance Journal_Quantity Ledger.Journal = Ledger.Quantity

-- * Type family 'Journal_Unit'
type family   Journal_Unit (j:: * -> *)
type instance Journal_Unit    JCC.Journal =    JCC.Unit
type instance Journal_Unit Ledger.Journal = Ledger.Unit

-- * Type family 'Journal_Posting'
type family   Journal_Posting (j:: * -> *)
type instance Journal_Posting    JCC.Journal =    JCC.Posting
type instance Journal_Posting Ledger.Journal = Ledger.Posting

-- * Type family 'Journal_Transaction'
type family   Journal_Transaction (j:: * -> *)
type instance Journal_Transaction    JCC.Journal =    JCC.Transaction
type instance Journal_Transaction Ledger.Journal = Ledger.Transaction

-- * Class 'Journal'

class Journal j where
	type Journal_Format j
	journal_format
	 :: j -> Journal_Format j

-- * Class 'Journal_Empty'

class Journal_Empty j where
	journal_empty :: Formats -> j

-- * Class 'Journal_Files'

class Journal_Files j where
	journal_files :: forall m. j m -> [FilePath]
instance Journal_Files JCC.Journal where
	journal_files = JCC.journal_files
instance Journal_Files Ledger.Journal where
	journal_files = Ledger.journal_files

-- * Class 'Journal_Read'

class Journal_Read (j:: * -> *) where
	type Journal_Read_Error       j
	type Journal_Read_Transaction j
	journal_read
	 :: forall c m. (Monoid m, Consable c m)
	 => (Journal_Read_Transaction j -> c)
	 -> FilePath
	 -> IO (Either (Journal_Read_Error j) (j m))
instance Journal_Read JCC.Journal where
	type Journal_Read_Error JCC.Journal
	 = [R.Error JCC.Error_Read]
	type Journal_Read_Transaction JCC.Journal
	 = JCC.Charted JCC.Transaction
	journal_read cons =
		runExceptT . JCC.read_file
		 (JCC.context_read cons JCC.journal)
instance Journal_Read Ledger.Journal where
	type Journal_Read_Error Ledger.Journal
	 = [R.Error Ledger.Error_Read]
	type Journal_Read_Transaction Ledger.Journal
	 = Ledger.Charted Ledger.Transaction
	journal_read cons =
		runExceptT . Ledger.read_file
		 (Ledger.context_read cons Ledger.journal)

{-
-- * Class 'Journal_Chart'

class Journal_Chart (j:: * -> *) where
	journal_chart
	 :: forall m. j m
	 -> Chart.Chart (NonEmpty (Journal_Account_Section j))
instance Journal_Chart JCC.Journal where
	journal_chart = JCC.journal_chart
instance Journal_Chart Ledger.Journal where
	journal_chart = Ledger.journal_chart
-}

-- * Class 'Journal_Monoid'

class Journal_Monoid j where
	journal_flatten :: j -> j
	journal_fold    :: (j -> a -> a) -> j -> a -> a
instance Monoid m => Journal_Monoid (JCC.Journal m) where
	journal_flatten = JCC.journal_flatten
	journal_fold    = JCC.journal_fold
instance Monoid m => Journal_Monoid (Ledger.Journal m) where
	journal_flatten = Ledger.journal_flatten
	journal_fold    = Ledger.journal_fold

-- * Class 'Journal_Filter'

class Functor j => Journal_Filter context j m where
	journal_filter
	 :: context -> j m -> j m

-- * Class 'Journal_Functor'

class Journal_Functor x y where
	journal_functor_map :: x -> y
	journal_fmap :: forall j. Functor j => j x -> j y
	journal_fmap = (journal_functor_map <$>)

-- * Class 'Journal_Table'

-- | A class to render a journal
--   into 'Leijen.Table.Cell's.
class Journal_Leijen_Table_Cells j m where
	journal_leijen_table_cells
	 :: j m
	 -> [[Leijen.Table.Cell]]
	 -> [[Leijen.Table.Cell]]


-- * Class 'Journal_Wrap'

-- | A class dedicated to transform a journal
--   to another one using existential quantification
--   to gather multiple journals under a single type,
--   by writing instances between fully monomorphic types,
--   which ease a lot meeting the requirements
--   of the constraints in the wrap type.
class Journal_Wrap j wrap where
	journal_wrap :: j -> wrap

class Journal_Content j where
	journal_content :: forall m. j m -> m
instance Journal_Content JCC.Journal where
	journal_content = JCC.journal_content
instance Journal_Content Ledger.Journal where
	journal_content = Ledger.journal_content

-- * Type 'Message'

-- data Journal jnl m = forall j. jnl j => Journal (j m)
data Message w = forall msg. Lang.Translate msg w => Message msg
instance Lang.Translate (Message W.Doc) W.Doc where
	translate lang (Message x) = Lang.translate lang x