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

import           Control.Applicative (Const(..))
import           Data.Bool (Bool(..), not)
import qualified Data.Char as Char
import           Data.Decimal (Decimal)
import           Data.Function (($), (.), id)
import           Data.Functor (Functor(..), (<$>))
import qualified Data.List as List
import           Data.List.NonEmpty (NonEmpty(..))
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import           Data.Ord (Ord(..))
import           Data.Sequence (Seq)
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.TreeMap.Strict (TreeMap)
import qualified Data.TreeMap.Strict as TreeMap

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

import qualified Hcompta.Lib.Strict as Strict

-- * Class 'Convert'

-- | Generic class dedicated to transform any type
--   into another one encoding more or less
--   the same data.
class Convert from to where
	convert :: from -> to

instance Convert () () where
	convert = id

-- Journal
instance
 ( Convert ledger jcc
 , Monoid jcc
 , Monoid ledger
 )
 => Convert (Ledger.Journal ledger) (JCC.Journal jcc) where
	convert Ledger.Journal{..} =
		JCC.Journal
		 { JCC.journal_amount_styles = convert journal_amount_styles
		 , JCC.journal_chart = convert journal_chart
		 , JCC.journal_files
		 , JCC.journal_includes = convert <$> journal_includes
		 , JCC.journal_last_read_time
		 , JCC.journal_content = convert journal_content
		 }
instance
 ( Convert jcc ledger
 , Monoid jcc
 , Monoid ledger
 )
 => Convert (JCC.Journal jcc) (Ledger.Journal ledger) where
	convert JCC.Journal{..} =
		Ledger.Journal
		 { Ledger.journal_amount_styles = convert journal_amount_styles
		 , Ledger.journal_chart = convert journal_chart
		 , Ledger.journal_files
		 , Ledger.journal_includes = convert <$> journal_includes
		 , Ledger.journal_last_read_time
		 , Ledger.journal_content = convert journal_content
		 }
instance Convert ledger jcc
 => Convert
 (H.Journal ledger)
 (H.Journal jcc)
 where
	convert (H.Journal j) =
		H.Journal $
		convert <$>
		Map.mapKeysMonotonic convert j

-- Unit
instance Convert Ledger.Unit JCC.Unit where
	convert (Ledger.Unit u) =
		JCC.Unit $
		Text.map
		 (\c -> case Char.generalCategory c of
			Char.CurrencySymbol  -> c
			Char.LowercaseLetter -> c
			Char.ModifierLetter  -> c
			Char.OtherLetter     -> c
			Char.TitlecaseLetter -> c
			Char.UppercaseLetter -> c
			_ -> '_') u
instance Convert JCC.Unit Ledger.Unit where
	convert (JCC.Unit u) =
		Ledger.Unit u

-- Account
instance Convert H.Account_Anchor H.Account_Anchor where
	convert = id
instance Convert H.Account_Tags H.Account_Tags where
	convert = id

-- Amount Style
instance Convert Ledger.Amount_Styles JCC.Amount_Styles where
	convert (Ledger.Amount_Styles sty) =
		JCC.Amount_Styles $ convert sty
instance Convert JCC.Amount_Styles Ledger.Amount_Styles where
	convert (JCC.Amount_Styles sty) =
		Ledger.Amount_Styles $ convert sty
instance Convert Ledger.Amount_Style JCC.Amount_Style where
	convert Ledger.Amount_Style{..} =
		JCC.Amount_Style
		 { JCC.amount_style_fractioning
		 , JCC.amount_style_grouping_integral =
			(<$> amount_style_grouping_integral) $
			 \(Ledger.Amount_Style_Grouping c l) ->
				JCC.Amount_Style_Grouping c l
		 , JCC.amount_style_grouping_fractional =
			(<$> amount_style_grouping_fractional) $
			 \(Ledger.Amount_Style_Grouping c l) ->
				JCC.Amount_Style_Grouping c l
		 , JCC.amount_style_unit_side =
			(<$> amount_style_unit_side) $ \s ->
				case s of
				 Ledger.Amount_Style_Side_Left  -> JCC.Amount_Style_Side_Left
				 Ledger.Amount_Style_Side_Right -> JCC.Amount_Style_Side_Right
		 , JCC.amount_style_unit_spaced
		 }
instance Convert JCC.Amount_Style Ledger.Amount_Style where
	convert JCC.Amount_Style{..} =
		Ledger.Amount_Style
		 { Ledger.amount_style_fractioning
		 , Ledger.amount_style_grouping_integral =
			(<$> amount_style_grouping_integral) $
			 \(JCC.Amount_Style_Grouping c l) ->
				Ledger.Amount_Style_Grouping c l
		 , Ledger.amount_style_grouping_fractional =
			(<$> amount_style_grouping_fractional) $
			 \(JCC.Amount_Style_Grouping c l) ->
				Ledger.Amount_Style_Grouping c l
		 , Ledger.amount_style_unit_side =
			(<$> amount_style_unit_side) $ \s ->
				case s of
				 JCC.Amount_Style_Side_Left  -> Ledger.Amount_Style_Side_Left
				 JCC.Amount_Style_Side_Right -> Ledger.Amount_Style_Side_Right
		 , Ledger.amount_style_unit_spaced
		 }

-- Transaction
instance Convert Ledger.Transaction JCC.Transaction where
	convert Ledger.Transaction{..} =
		JCC.Transaction
		 { JCC.transaction_anchors = mempty
		 , JCC.transaction_comments =
			List.filter (not . Text.all Char.isSpace) $
			Ledger.comments_without_tags $
				mappend
				 transaction_comments_before
				 transaction_comments_after
		 , JCC.transaction_dates
		 , JCC.transaction_postings = (convert <$>) <$> transaction_postings
		 , JCC.transaction_sourcepos
		 , JCC.transaction_tags =
			(case transaction_code of
			 t | Text.null t -> id
			 t -> H.transaction_tag_cons (H.transaction_tag ("Code":|[]) t)
			) $
			if transaction_status
			 then H.transaction_tag_cons
				 (H.transaction_tag ("Status":|[]) "")
				 transaction_tags
			 else transaction_tags
		 , JCC.transaction_wording
		 }
instance Convert JCC.Transaction Ledger.Transaction where
	convert JCC.Transaction{..} =
		let H.Transaction_Tags (H.Tags tags) = transaction_tags in
		Ledger.Transaction
		 { Ledger.transaction_code = mconcat $ Map.findWithDefault [""] ("Code":|[]) tags
		 , Ledger.transaction_comments_after = mempty
		 , Ledger.transaction_comments_before = transaction_comments
		 , Ledger.transaction_dates
		 , Ledger.transaction_postings = (convert <$>) <$> transaction_postings
		 , Ledger.transaction_sourcepos
		 , Ledger.transaction_status =
			case Map.lookup ("Status":|[]) tags of
			 Nothing -> False
			 Just _ -> True
		 , Ledger.transaction_tags =
			H.Transaction_Tags $ H.Tags $
			Map.delete ("Code":|[]) $
			Map.delete ("Status":|[]) $
			tags
		 , Ledger.transaction_wording
		 }

-- Posting
instance Convert Ledger.Posting JCC.Posting where
	convert Ledger.Posting{..} =
		JCC.Posting
		 { JCC.posting_account
		 , JCC.posting_account_anchor = Nothing
		 , JCC.posting_amounts =
			convert <$>
			Map.mapKeysMonotonic convert posting_amounts
		 , JCC.posting_anchors = mempty
		 , JCC.posting_comments =
			List.filter (not . Text.all Char.isSpace) $
			Ledger.comments_without_tags posting_comments
		 , JCC.posting_dates
		 , JCC.posting_sourcepos
		 , JCC.posting_tags =
			if posting_status
			 then H.posting_tag_cons
				 (H.Posting_Tag $ H.tag ("Status":|[]) "")
				 posting_tags
			 else posting_tags
		 }
instance Convert JCC.Posting Ledger.Posting where
	convert JCC.Posting{..} =
		let H.Posting_Tags (H.Tags tags) = posting_tags in
		Ledger.Posting
		 { Ledger.posting_account
		 , Ledger.posting_amounts =
			convert <$>
			Map.mapKeysMonotonic convert posting_amounts
		 , Ledger.posting_comments
		 , Ledger.posting_dates
		 , Ledger.posting_status =
			case Map.lookup ("Status":|[]) tags of
			 Nothing -> False
			 Just _ -> True
		 , Ledger.posting_sourcepos
		 , Ledger.posting_tags =
			H.Posting_Tags $ H.Tags $
			Map.delete ("Status":|[]) $
			tags
		 }

-- Chart
instance Convert JCC.Chart Ledger.Chart where
	convert JCC.Chart{..} =
		Ledger.Chart
		 { Ledger.chart_accounts = chart_accounts
		 }
instance Convert Ledger.Chart JCC.Chart where
	convert Ledger.Chart{..} =
		JCC.Chart
		 { JCC.chart_accounts = chart_accounts
		 , JCC.chart_anchors  = mempty
		 }
{-
instance Convert (Chart.Chart x) (Chart.Chart x) where
	convert = id
instance
 ( Convert (Chart.Chart a0) (Chart.Chart a1)
 , Convert x y
 ) => Convert (Chart.Charted a0 x) (Chart.Charted a1 y) where
	convert (Chart.Charted a x) =
		Chart.Charted (convert a) (convert x)
-}
{-
instance Convert (Chart.Chart JCC.Account) (Chart.Chart Ledger.Account) where
	convert Chart.Chart
	 { Chart.chart_accounts
	 , Chart.chart_anchors
	 } =
		Chart.Chart
		 { Chart.chart_accounts = convert chart_accounts
		 , Chart.chart_anchors  = convert chart_anchors
		 }
-}

instance Convert x y => Convert (JCC.Charted x) (Ledger.Charted y) where
	convert (JCC.Charted c x) =
		Ledger.Charted (convert c) (convert x)

instance Convert x y => Convert (Ledger.Charted x) (JCC.Charted y) where
	convert (Ledger.Charted c x) =
		JCC.Charted (convert c) (convert x)

-- Balance
instance
 ( Convert unit unit_
 , Convert quantity quantity_
 ) => Convert (H.Balance_by_Account_Sum unit quantity)
              (H.Balance_by_Account_Sum unit_ quantity_) where
	convert (H.Balance_by_Account_Sum m) =
		H.Balance_by_Account_Sum $
		convert <$>
		Map.mapKeysMonotonic convert m

-- * GL

-- ** Class 'GL'
class
 ( Convert (H.Account_Section (H.Posting_Account (H.Transaction_Posting x)))
           (H.Account_Section (H.Posting_Account (H.Transaction_Posting y)))
 ) => GL x y
instance GL    JCC.Transaction Ledger.Transaction
instance GL Ledger.Transaction    JCC.Transaction

instance GL (   JCC.Charted    JCC.Transaction)
            (Ledger.Charted Ledger.Transaction)
instance GL (Ledger.Charted Ledger.Transaction)
            (JCC.Charted       JCC.Transaction)

instance
 ( GL x y
 , GL_Line x y
 , H.GL_Transaction x
 , H.GL_Transaction y
 , Convert x y
 ) => Convert (H.GL x)
              (H.GL y) where
	convert (H.GL m)
	 = H.GL $ TreeMap.map_monotonic convert (convert <$>) m
	 -- NOTE: Date does not need to be converted,
	 -- thus avoid a useless Map.mapKeysMonotonic
	 -- from the Convert instance on Map.

-- *** Class 'GL_Line'

class
 ( Convert (H.GL_Transaction_Line x)
           (H.GL_Transaction_Line y)
 , Convert (H.Transaction_Posting x)
           (H.Transaction_Posting y)
 , Convert (H.GL_Posting_Quantity (H.Transaction_Posting x))
           (H.GL_Posting_Quantity (H.Transaction_Posting y))
 ) => GL_Line x y
instance GL_Line    JCC.Transaction Ledger.Transaction
instance GL_Line Ledger.Transaction    JCC.Transaction

instance GL_Line (   JCC.Charted    JCC.Transaction)
                 (Ledger.Charted Ledger.Transaction)
instance GL_Line (Ledger.Charted Ledger.Transaction)
                 (JCC.Charted       JCC.Transaction)

instance
 ( GL_Line x y
 , H.GL_Transaction x
 , H.GL_Transaction y
 , Convert x y
 ) => Convert (H.GL_Line x)
              (H.GL_Line y) where
	convert H.GL_Line{..} =
		H.GL_Line
		 { H.gl_line_transaction = convert gl_line_transaction
		 , H.gl_line_posting     = convert gl_line_posting
		 , H.gl_line_sum         = convert gl_line_sum
		 }

-- Class 'GL_Expanded'

instance
 ( GL x y
 , GL_Line x y
 , H.GL_Transaction x
 , H.GL_Transaction y
 , Convert x y
 ) => Convert (H.GL_Expanded x)
              (H.GL_Expanded y) where
	convert (H.GL_Expanded m)
	 = H.GL_Expanded $ convert m

-- Class 'GL_Line_Expanded'

instance
 Convert x y
 => Convert (Strict.Clusive x)
            (Strict.Clusive y) where
	convert Strict.Clusive{..} =
		Strict.Clusive
		 { Strict.exclusive = convert exclusive
		 , Strict.inclusive = convert inclusive
		 }

-- Const
instance Convert x y
 => Convert (Const x w) (Const y w_) where
	convert (Const x) = Const $ convert x

-- Polarized
instance
 Convert x y
 => Convert (H.Polarized x)
            (H.Polarized y) where
	convert = (convert <$>)

-- Date
instance Convert H.Date H.Date where
	convert = id

-- Quantity
instance Convert Decimal Decimal where
	convert = id

-- Text
instance Convert Text Text where
	convert = id

-- List
instance Convert x y => Convert [x] [y] where
	convert = fmap convert
instance Convert x y => Convert (NonEmpty x) (NonEmpty y) where
	convert = fmap convert

-- TreeMap

instance (Convert kx ky, Convert x y, Ord kx, Ord ky)
 => Convert (TreeMap kx x) (TreeMap ky y) where
	convert = TreeMap.map_monotonic convert convert

-- Map
instance (Convert kx ky, Convert x y, Ord kx)
 => Convert (Map kx x) (Map ky y) where
	convert = Map.mapKeysMonotonic convert . fmap convert

-- Seq
instance Convert x y => Convert (Seq x) (Seq y) where
	convert = fmap convert

-- * Stats

-- ** Class 'Stats'
class
 ( Convert (H.Posting_Account (H.Transaction_Posting x))
           (H.Posting_Account (H.Transaction_Posting y))
 , Convert (H.Amount_Unit (H.Posting_Amount (H.Transaction_Posting x)))
           (H.Amount_Unit (H.Posting_Amount (H.Transaction_Posting y)))
 ) => Stats x y

instance Stats    JCC.Transaction Ledger.Transaction
instance Stats Ledger.Transaction    JCC.Transaction

instance Stats (   JCC.Charted    JCC.Transaction)
               (Ledger.Charted Ledger.Transaction)
instance Stats (Ledger.Charted Ledger.Transaction)
               (JCC.Charted       JCC.Transaction)

instance
 ( Stats x y
 , H.Stats_Transaction x
 , H.Stats_Transaction y
 ) => Convert (H.Stats x) (H.Stats y) where
	convert s@H.Stats{..} =
		s
		 { H.stats_accounts = Map.mapKeysMonotonic convert stats_accounts
		 , H.stats_units    = Map.mapKeysMonotonic convert stats_units
		 }