--{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE PostfixOperators #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Symantic.Compta.Lang
  ( module Symantic.Compta.Lang
  , module Symantic.Compta.Lang.Math
  , module Symantic.Compta.Lang.Rebindable
  ) where
import Control.Applicative (Applicative(..))
import Control.DeepSeq (NFData(..))
import Control.Monad (Monad(..))
import Data.Decimal (Decimal)
import Data.Eq (Eq)
import Data.Function (($), (.), id)
import Data.Functor (Functor, (<$>))
import Data.Int (Int)
import Data.Kind
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.Maybe (Maybe)
import Data.Ord (Ord)
import Data.Semigroup (Semigroup(..))
import Data.Monoid (Monoid)
import Data.String (String)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import GHC.TypeLits (Symbol, ErrorMessage(..))
import Numeric.Natural (Natural)
import Prelude (Integer, Enum(..))
import Text.Show (Show(..))
import Type.Reflection
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.String as String
import qualified Data.Time.Calendar as Time
import qualified GHC.Exts as GHC
import qualified Prelude

import Symantic.Compta.Lang.Math
import Symantic.Compta.Lang.Rebindable
import Symantic.Compta.Utils.Error

data TyQuantity
data TyUnit
data TyAmount = TyAmount
data TyAccount = TyAccount
data TyAccountSection
data TyPost = TyPost deriving (Show)
data TyPosts = TyPosts deriving (Show)
data TyMove = TyMove deriving (Show)
data TyMoves = TyMoves deriving (Show, Semigroup, Monoid)
type family Tr (repr::Type -> Type) (ty::Type) :: Type


type Repr = Type -> Type

--type ErrorNumAmount (unit::Symbol) = 'Text "err unit:" ':$$: 'ShowType unit
--instance TypeError (ErrorNumAmount unit) => Num (AmountOf unit repr)

-- | Usual syntax for type-preserving term-abstraction.
class Abstractable repr where
  -- | Lambda term (abstract).
  lam :: (repr a -> repr b) -> repr (a -> b)
  -- | Term application (unabstract).
  (.@) :: repr (a -> b) -> repr a -> repr b; infixl 9 .@

type DataRepr = Type -> Type
data family Data (able :: DataRepr -> Constraint) :: DataRepr -> DataRepr
data SomeData repr a = forall able. (Unliftable (Data able) repr, Typeable able) => SomeData (Data able repr a)
-- | @(unSomeData c :: 'Maybe' ('Data' able repr a))@
-- extract the data-constructor from the given 'SomeData'
-- iif. it belongs to the @('Data' able repr a)@ data-instance.
unSomeData ::
  forall able repr a.
  Typeable able =>
  SomeData repr a -> Maybe (Data able repr a)
unSomeData (SomeData (c::Data c repr a)) =
  case typeRep @able `eqTypeRep` typeRep @c of
    Maybe.Just HRefl -> Maybe.Just c
    Maybe.Nothing -> Maybe.Nothing
-- | Convenient utility to pattern-match a 'SomeData'.
pattern Data :: Typeable able => Data able repr a -> SomeData repr a
pattern Data x <- (unSomeData -> Maybe.Just x)

class Unliftable r repr where
  unlift :: r repr a -> repr a
class Liftable r repr where
  lift :: repr a -> r repr a
class Trans from to where
  trans :: from a -> to a

type family Ty (repr::Type -> Type) (a::Type) :: Type

class Accountable repr where
  account :: Ty repr TyAccount -> repr TyAccount
class Amountable repr where
  amount :: Ty repr TyAmount -> repr TyAmount

class Inject a repr ty where
  inject :: a -> repr ty

{-
type family AccountOf (t::k) :: Type
type family AccountSectionOf (t::k) :: Type
type family AmountOf (t::k) :: Type
type family QuantityOf (t::k) :: Type
type family UnitOf (t::k) :: Type
type family PostOf (t::k) :: Type
type family MoveOf (t::k) :: Type
type family TransactionsOf (t::k) :: Type
type family ChartSectionOf (t::k) :: Type
type family ChartOf (t::k) :: Type
type instance UnitOf (Maybe amt) = UnitOf amt
type instance QuantityOf (Maybe amt) = QuantityOf amt
type instance UnitOf (Map unit qty) = unit
type instance QuantityOf (Map unit qty) = qty
-}
{-
type family AccountOf (repr::Repr) :: Type
type family AccountSectionOf (repr::Repr) :: Type
type family AmountOf (repr::Repr) :: Type
type family QuantityOf (repr::Repr) :: Type
type family UnitOf (repr::Repr) :: Type
type family PostOf (repr::Repr) :: Type
type family MoveOf (repr::Repr) :: Type
type family TransactionsOf (repr::Repr) :: Type
type family ChartSectionOf (repr::Repr) :: Type
type family ChartOf (repr::Repr) :: Type

-- * Class 'Accountable'
class Accountable repr where
  account :: AccountOf repr -> repr (AccountOf repr)
class Amountable repr where
  amount :: AmountOf repr -> repr (AmountOf repr)
-}
  --account :: acct -> repr a -> repr a
  --accountFromStrings :: [String] -> repr (AccountOf repr)
  --accountFromNatural :: Natural -> repr (AccountOf repr)
--class Literable repr where
--  lit :: a -> repr a

-- * Class 'Postable'
class Postable repr where
  post :: HasCallStack => repr TyAccount -> repr TyAmount -> repr TyPost
infixr 4 -=, +=
(-=) ::
  HasCallStack =>
  Postable repr => Negable (repr TyAmount) =>
  repr TyAccount -> repr TyAmount -> repr TyPost
(+=) ::
  HasCallStack => Postable repr =>
  repr TyAccount -> repr TyAmount -> repr TyPost
(-=) acct = post acct . negate
(+=) = post

--(>>) = cons

-- * Class 'Moveable'
class Moveable repr where
  move :: HasCallStack => repr [TyPost] -> repr TyMove

{-
class Postingable repr where
  (+=) :: repr (AccountOf repr) -> repr (AmountOf repr) -> repr (PostingsOf repr); infix 5 +=
  (-=) :: repr (AccountOf repr) -> repr (AmountOf repr) -> repr (PostingsOf repr); infix 5 -=
-}

-- * Class 'Transactionable'
{-
class Transactionable repr where
  txn :: String -> repr (PostingsOf repr) -> repr (TransactionsOf repr)
-}

-- * Class 'Datable'
type Year = Natural
data Month = January | February | March | April | May | June | July | September | October | November | December
  deriving (Enum, Show)
type Day = Time.Day
class Datable a repr where
  year :: Year -> repr a -> repr a
  month :: Month -> repr a -> repr a
  day :: Int -> repr a -> repr a
  date :: Year -> Month -> Int -> repr a -> repr a

-- * Class 'Chartable'
class Chartable chart section repr where
  section :: HasCallStack => section -> repr chart -> repr chart
class ChartableLeaf chart repr where
  anySection :: HasCallStack => repr chart

-- * Class 'Descriptionable'
class Descriptionable repr where
  description :: HasCallStack => String -> repr ()

-- * Class 'Namable'
class Namable repr where
  name :: HasCallStack => String -> repr ()

{-
-- * Class 'Journalable'
class
  ( EUR repr
  , USD repr
  , Functor repr
  , Applicative repr
  , Monad repr
  , Accountable repr
  , Datable (PostingsOf repr) repr
  , Datable (TransactionsOf repr) repr
  , FromInteger (repr (AccountOf repr))
  , IsString (repr (AccountOf repr))
  , Postingable repr
  , Transactionable repr
  ) => Journalable repr
instance
  ( EUR repr
  , USD repr
  , Functor repr
  , Applicative repr
  , Monad repr
  , Accountable repr
  , Datable (PostingsOf repr) repr
  , Datable (TransactionsOf repr) repr
  , FromInteger (repr (AccountOf repr))
  , IsString (repr (AccountOf repr))
  , Postingable repr
  , Transactionable repr
  ) => Journalable repr


t0 :: Journalable repr => repr (TransactionsOf repr)
t0 =
  year 2020 do
    month January do
      day 1 $ do
        txn "w0" do
          accountFromStrings ["A"] -= eur 10
          accountFromStrings ["B"] += usd 5
          accountFromStrings ["C"] += (5€)
        txn "w1" do
          "A" -= eur 10
          "B" += eur 10
        txn "w2" do
          accountFromNatural 511 -= eur 10
          701 += eur 10
        txn "w3" do
          "Capital/Tiers" -= eur 10
          --["Capital","Tiers"] -= eur 10
          "B" += eur 10
          "B" += eur 10
-}

(&) r f = f r
infix 0 &