--- /dev/null
+use flake
+
+#use_flake() {
+# watch_file flake.nix
+# watch_file flake.lock
+# watch_file default.nix
+# watch_file shell.nix
+# profile="$(direnv_layout_dir)"/flake-profile
+# mkdir -p "$(direnv_layout_dir)"
+# eval "$(time nix print-dev-env --show-trace --profile "$profile" || echo false)" &&
+# nix-store --add-root "shell.root" --indirect --realise "$profile" &&
+# nix-env --delete-generations +1 --profile "$profile"
+#}
+#use flake
--- /dev/null
+*.actual.*
+*.eventlog
+*.eventlog
+*.eventlog.html
+*.eventlog.json
+*.hi
+*.hp
+*.o
+*.prof
+*.root
+.direnv/
+.ghc.environment.*
+.stack-work/
+dist-newstyle/
+dump-core/
+result*
--- /dev/null
+all:
+ cabal run
+ghci:
+ cabal repl
+ghcid:
+ ghcid -c 'cabal repl --ghc-options -ignore-dot-ghci' --reverse-errors
--- /dev/null
+packages:.
--- /dev/null
+{ pkgs ? import <nixpkgs> {}
+, ghc ? null
+, withHoogle ? false
+}:
+let
+ haskellPackages =
+ if ghc == null
+ then pkgs.haskellPackages
+ else pkgs.haskell.packages.${ghc};
+ hs = haskellPackages.extend (with pkgs.haskell.lib; hself: hsuper:
+ {
+ symantic-compta = buildFromSdist (hself.callCabal2nix "symantic-compta" ./. {});
+ symantic-document = buildFromSdist (hself.callCabal2nix "symantic-document"
+ (pkgs.fetchgit {
+ url = "git://git.sourcephile.fr/haskell/symantic-document.git";
+ rev = "refs/heads/master";
+ sha256 = "sha256-h2mzSKDWNSFs879qE8kma0z1vgWA32LWERRf9I+PqmE=";
+ }) {});
+ }
+ );
+in hs.symantic-compta // {
+ shell = hs.shellFor {
+ #doBenchmark = true;
+ packages = p: [ p.symantic-compta ];
+ nativeBuildInputs = [
+ hs.cabal-install
+ hs.ghcid
+ hs.haskell-language-server
+ ];
+ buildInputs = [
+ ];
+ inherit withHoogle;
+ };
+}
--- /dev/null
+{
+ "nodes": {
+ "flake-utils": {
+ "locked": {
+ "lastModified": 1623875721,
+ "narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=",
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "rev": "f7e004a55b120c02ecb6219596820fcd32ca8772",
+ "type": "github"
+ },
+ "original": {
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "type": "github"
+ }
+ },
+ "nixpkgs": {
+ "locked": {
+ "narHash": "sha256-UkSV2fnX4ZRMyh/m0udqzFsCDyRgKh44fEkrW0JiDdY=",
+ "path": "/nix/store/2dd3vs864c1pgl9y6rk9k9lgq9ifjgaj-nixpkgs-patched",
+ "type": "path"
+ },
+ "original": {
+ "id": "nixpkgs",
+ "type": "indirect"
+ }
+ },
+ "root": {
+ "inputs": {
+ "flake-utils": "flake-utils",
+ "nixpkgs": "nixpkgs"
+ }
+ }
+ },
+ "root": "root",
+ "version": 7
+}
--- /dev/null
+{
+inputs.nixpkgs.url = "flake:nixpkgs";
+inputs.flake-utils.url = "github:numtide/flake-utils";
+outputs = inputs:
+ inputs.flake-utils.lib.eachDefaultSystem (system: let
+ pkgs = inputs.nixpkgs.legacyPackages.${system};
+ in {
+ defaultPackage = import ./default.nix { inherit pkgs; };
+ devShell = (import ./default.nix { inherit pkgs; }).shell;
+ }
+ );
+}
--- /dev/null
+cradle:
+ cabal:
+ - path: "./"
+ component: "symantic-compta"
+ - path: "./demo"
+ component: "symantic-compta:symantic-compta-demo"
--- /dev/null
+(import ./. {}).shell
--- /dev/null
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+module Symantic.Compta
+ ( module Symantic.Compta.Lang
+ , module Symantic.Compta.Calc
+ --, module Symantic.Compta.Eval
+ ) where
+import Symantic.Compta.Lang
+import Symantic.Compta.Calc
+--import Symantic.Compta.Eval
--- /dev/null
+module Symantic.Compta.Calc
+ ( module Symantic.Compta.Calc.Balance
+ , module Symantic.Compta.Calc.Chart
+ , module Symantic.Compta.Calc.Flow
+ , module Symantic.Compta.Calc.Unit
+ ) where
+import Symantic.Compta.Calc.Balance
+import Symantic.Compta.Calc.Chart
+import Symantic.Compta.Calc.Flow
+import Symantic.Compta.Calc.Unit
--- /dev/null
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE NoOverloadedLists #-}
+{-# LANGUAGE DataKinds #-}
+--{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Symantic.Compta.Calc.Balance where
+
+import Control.DeepSeq (NFData)
+import Data.Kind (Type)
+import Data.Bool
+import Data.Coerce (coerce)
+import Data.Either (Either(..), rights, lefts)
+import Data.Eq (Eq(..))
+import Data.Function (($), (.), id, const)
+import Data.Functor ((<$), (<$>))
+import Data.Map.Strict (Map)
+import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe, catMaybes)
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (String)
+import Data.Typeable ()
+import GHC.Generics (Generic)
+import Text.Show (Show(..))
+import qualified Data.List as List
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Map.Strict as Map
+
+import Symantic.Compta.Lang
+import Symantic.Compta.Calc.Flow
+import qualified Symantic.Compta.Calc.Chart as Chart
+
+-- * Type 'BalanceRepr'
+data Balance section unit qty amt = Balance
+ { balanceByAccount :: !(Chart.Chart section amt)
+ , balanceByUnit :: !(Map unit (SumForUnit (Chart.ChartPath section) qty))
+ } deriving (Eq, Show, Generic, NFData)
+
+-- | 'BalanceReprByAccount' and 'BalanceReprByUnit' of some 'TyPost'.
+data BalanceRepr f (repr::Type->Type) a where
+ BalanceReprAny ::
+ Balanceable a ~ 'False =>
+ Ty (BalanceRepr f repr) a -> BalanceRepr f repr a
+ BalanceRepr ::
+ Balanceable a ~ 'True =>
+ { unBal :: Balance (Ty repr TyAccountSection)
+ (Ty repr TyUnit)
+ (Ty repr TyQuantity)
+ (f (Ty (BalanceRepr f repr) TyAmount))
+ } -> BalanceRepr f repr a
+--type instance Tr (BalanceRepr f repr) TyAmount = Map (Tr repr TyUnit) (Tr repr TyQuantity)
+--type instance Tr (BalanceRepr f repr) TyAccount = Chart.ChartPath (Tr repr TyAccountSection)
+instance
+ ( unit ~ Ty repr TyUnit
+ , qty ~ Ty repr TyQuantity
+ ) => Inject (Map unit qty) (BalanceRepr f repr) TyAmount where
+ inject = BalanceReprAny
+instance
+ ( section ~ Ty repr TyAccountSection
+ ) => Inject (Chart.ChartPath section) (BalanceRepr f repr) TyAccount where
+ inject = BalanceReprAny
+
+runBalanceRepr :: forall f repr a.
+ Balanceable a ~ 'True =>
+ BalanceRepr f repr a ->
+ Balance (Ty repr TyAccountSection)
+ (Ty repr TyUnit)
+ (Ty repr TyQuantity)
+ (f (Ty (BalanceRepr f repr) TyAmount))
+runBalanceRepr = unBal
+
+type instance Ty (BalanceRepr f repr) TyAmount = Map (Ty repr TyUnit) (Ty repr TyQuantity)
+type instance Ty (BalanceRepr f repr) TyAccount = Chart.ChartPath (Ty repr TyAccountSection)
+type instance Ty (BalanceRepr f repr) TyAccountSection = Ty repr TyAccountSection
+
+instance Amountable (BalanceRepr f repr) where
+ amount = BalanceReprAny
+instance Accountable (BalanceRepr f repr) where
+ account = BalanceReprAny
+
+type family Balanceable a :: Bool
+type instance Balanceable TyQuantity = 'False
+type instance Balanceable TyAccount = 'False
+type instance Balanceable TyAmount = 'False
+type instance Balanceable (Map k a) = 'False -- Balanceable a
+type instance Balanceable TyMove = 'True
+type instance Balanceable TyPost = 'True
+type instance Balanceable [a] = 'True -- Balanceable a
+
+{-
+deriving instance
+ ( Eq (Ty repr TyUnit)
+ , Eq (Ty repr TyQuantity)
+ , Eq (Ty repr TyAccountSection)
+ , Eq (f (AmountOf (BalanceRepr f repr)))
+ ) => Eq (BalanceRepr f repr a)
+deriving instance
+ ( Show (Ty repr TyUnit)
+ , Show (Ty repr TyQuantity)
+ , Show (Ty repr TyAccountSection)
+ , Show (f (AmountOf (BalanceRepr f repr)))
+ ) => Show (BalanceRepr f repr a)
+--deriving instance (NFData (Ty repr TyUnit), NFData (Ty repr TyQuantity)) => NFData (BalanceRepr section repr a)
+-}
+
+instance Zeroable (Balance acct unit aty amt) where
+ zero = Balance (Chart.Chart Map.empty) Map.empty
+instance (Addable amt, Addable qty, Ord acct, Ord unit) => Addable (Balance acct unit qty amt) where
+ Balance xa xu + Balance ya yu = Balance (xa + ya) (xu + yu)
+instance
+ ( Addable (Ty repr TyQuantity)
+ , Addable (f (Map (Ty repr TyUnit) (Ty repr TyQuantity)))
+ , Ord (Ty repr TyAccountSection)
+ , Ord (Ty repr TyUnit)
+ ) => Listable (BalanceRepr f repr) where
+ nil = BalanceRepr zero
+ cons (BalanceRepr x) (BalanceRepr y) = BalanceRepr (x + y)
+ concat (BalanceRepr x) (BalanceRepr y) = BalanceRepr (x + y)
+instance
+ ( Ord (Ty repr TyUnit)
+ , Ord (Ty repr TyAccountSection)
+ , Addable (Ty repr TyQuantity)
+ , Addable (f (Ty (BalanceRepr f repr) TyAmount))
+ ) => Addable (BalanceRepr f repr TyPost) where
+ BalanceRepr (Balance xa xu) + BalanceRepr (Balance ya yu) =
+ BalanceRepr (Balance (xa + ya) (xu + yu))
+instance
+ ( Ord (Ty repr TyUnit)
+ , Addable (Ty repr TyQuantity)
+ ) => Addable (BalanceRepr f repr [a]) where
+ x + y = coerce x + y
+instance Balanceable a ~ 'True => Zeroable (BalanceRepr f repr a) where
+ zero = BalanceRepr zero
+instance
+ ( Ord (Ty repr TyAccountSection)
+ ) => Postable (BalanceRepr Maybe repr) where
+ post (BalanceReprAny acct) (BalanceReprAny amt) = BalanceRepr Balance
+ { balanceByAccount = Chart.singleton Nothing acct (Just amt)
+ , balanceByUnit = Map.map (\qty -> SumForUnit
+ { sumForUnitQuantity = qty
+ , sumForUnitAccounts = Map.singleton acct ()
+ }) amt
+ }
+instance Moveable (BalanceRepr f repr) where
+ move (BalanceRepr bal) = BalanceRepr bal
+ --move = coerce
+
+{-
+instance Nullable qty => Nullable (BalanceRepr section unit qty) where
+ null (BalanceRepr a u) = TM.null a && null u
+instance (Ord section, Ord unit, Addable qty) =>
+ Sumable (BalanceRepr section unit qty)
+ (TM.Path section, SumByAccount unit qty) where
+ BalanceRepr a u += x = BalanceRepr (a += x) (u += x)
+-}
+
+tableBalanceRepr ::
+ Ord section =>
+ Show section =>
+ Show unit =>
+ Show qty =>
+ Addable qty =>
+ Balance section unit qty (Trickle (Map unit (Flow qty))) ->
+ [[String]]
+tableBalanceRepr Balance{..} =
+ Chart.foldrWithPath
+ (\acct Trickle{inclusive=amt} -> (
+ [ show acct
+ , List.intercalate "+" $ catMaybes $ (\(u,q) -> show . (u,) <$> flowIn q) <$> Map.toList amt
+ , List.intercalate "+" $ catMaybes $ (\(u,q) -> show . (u,) <$> flowOut q) <$> Map.toList amt
+ --, show (unFlow <$> amt)
+ ] :))
+ []
+ balanceByAccount
+
+{-
+-- * Type 'BalanceReprByAccount'
+type BalanceReprByAccount f section unit qty =
+ Chart.Chart section (f (SumByAccount unit qty))
+
+-- ** Type 'SumByAccount'
+-- | A sum of quantities, concerning a single account.
+type SumByAccount = Map
+
+-- * Type 'BalanceReprByUnit'
+type BalanceReprByUnit section unit qty =
+ Map unit (SumForUnit (Chart.ChartPath section) qty)
+-}
+
+-- ** Type 'SumForUnit'
+-- | A sum of quantities with their accounts involved,
+-- concerning a single @unit@.
+data SumForUnit acct qty
+ = SumForUnit
+ { sumForUnitQuantity :: !qty
+ -- ^ The sum of quantities for a single @unit@.
+ , sumForUnitAccounts :: !(Map acct ())
+ -- ^ The accounts either involved to build 'sumForUnitQuantity',
+ -- or *not* involved when inside a 'DeviationByUnit'.
+ } deriving (Eq, Ord, Show, Generic, NFData)
+instance Zeroable qty => Zeroable (SumForUnit acct qty) where
+ zero = SumForUnit zero Map.empty
+instance (Ord acct, Addable qty) => Addable (SumForUnit acct qty) where
+ x + y = SumForUnit
+ (sumForUnitQuantity x + sumForUnitQuantity y)
+ (sumForUnitAccounts x + sumForUnitAccounts y)
+instance (Ord acct, Negable qty) => Negable (SumForUnit acct qty) where
+ negate x = SumForUnit
+ { sumForUnitQuantity = negate (sumForUnitQuantity x)
+ , sumForUnitAccounts = negate (sumForUnitAccounts x)
+ }
+instance (Ord acct, Subable qty) => Subable (SumForUnit acct qty) where
+ x - y = SumForUnit
+ { sumForUnitQuantity = sumForUnitQuantity x - sumForUnitQuantity y
+ , sumForUnitAccounts = sumForUnitAccounts x - sumForUnitAccounts y
+ }
+
+-- ** BalanceRepr 'equilibrium'
+-- | Return the 'BalanceRepr' (adjusted by inferred quantities)
+-- of the given @post@s and either:
+--
+-- * 'Left': the @unit@s which have a non null 'SumForUnit'
+-- and for which no equibrating account can be inferred.
+-- * 'Right': the given @post@s with inferred quantities inserted.
+equilibrium ::
+ forall repr.
+ Ord (Ty repr TyUnit) =>
+ Ord (Ty repr TyAccountSection) =>
+ Nullable (Ty repr TyQuantity) =>
+ Addable (Ty repr TyQuantity) =>
+ Negable (Ty repr TyQuantity) =>
+ Show (Ty repr TyUnit) =>
+ Show (Ty repr TyQuantity) =>
+ Trans repr (BalanceRepr Maybe repr) =>
+ Trans repr (InferPost repr) =>
+ Postable repr =>
+ repr [TyPost] ->
+ Either
+ [(Ty repr TyUnit, SumForUnit (Chart.ChartPath (Ty repr TyAccountSection))
+ (Ty repr TyQuantity))]
+ (repr [TyPost])
+equilibrium posts =
+ let BalanceRepr Balance{..} = move (trans posts) :: BalanceRepr Maybe repr TyMove in
+ let balanceAccounts = Map.filter isJust $ Chart.flatten id balanceByAccount in
+ let eithers = Map.foldrWithKey
+ (\unt sfu@SumForUnit{..} ->
+ let unusedAccounts = balanceAccounts `Map.difference` sumForUnitAccounts in
+ case Map.size unusedAccounts of
+ 0 | null sumForUnitQuantity -> id
+ 1 ->
+ -- The quantity can be inferred since having an equilibrated balance
+ -- means it must be the opposite of the quantity for that unit on other accounts.
+ (:) $ Right $ Map.singleton unt (negate sumForUnitQuantity)
+ <$ Map.elemAt 0 unusedAccounts
+ _ ->
+ -- There is more than one account not specifying a quantity for that unit
+ -- hence those cannot be inferred.
+ (:) $ Left (unt, sfu)
+ ) [] balanceByUnit in
+ case lefts eithers of
+ [] -> Right $ (`unInferPost` Map.fromListWith (+) (rights eithers)) $ trans posts
+ ls -> Left ls
+
+-- *** Type 'InferPost'
+data InferPost repr a where
+ InferPostAccount :: Ty (BalanceRepr Maybe repr) TyAccount -> InferPost repr TyAccount
+ InferPostAmount :: Ty (BalanceRepr Maybe repr) TyAmount -> InferPost repr TyAmount
+ InferPost ::
+ Balanceable a ~ 'True =>
+ { unInferPost :: Map (Ty (BalanceRepr Maybe repr) TyAccount)
+ (Ty (BalanceRepr Maybe repr) TyAmount) -> repr a } ->
+ InferPost repr a
+instance
+ ( Postable repr
+ , Accountable repr
+ , Amountable repr
+ , Addable (Ty repr TyAmount)
+ , Ord (Ty repr TyAccountSection)
+ , Ty repr TyAccount ~ Chart.ChartPath (Ty repr TyAccountSection)
+ , Ty repr TyAmount ~ Map (Ty repr TyUnit) (Ty repr TyQuantity)
+ ) => Postable (InferPost repr) where
+ post (InferPostAccount acct) (InferPostAmount amt) = InferPost $ \env ->
+ post (account acct) $ amount $ maybe amt (amt +) $ Map.lookup acct env
+instance Listable repr => Listable (InferPost repr) where
+ nil = InferPost (const nil)
+ cons x xs = InferPost $ \env ->
+ cons
+ (unInferPost x env)
+ (unInferPost xs env)
+ concat xs ys = InferPost $ \env ->
+ concat
+ (unInferPost xs env)
+ (unInferPost ys env)
+instance
+ ( Moveable repr
+ ) => Moveable (InferPost repr) where
+ move ps = InferPost $ \env ->
+ move (unInferPost ps env)
+instance
+ ( unit ~ Ty repr TyUnit
+ , qty ~ Ty repr TyQuantity
+ ) => Inject (Map unit qty) (InferPost repr) TyAmount where
+ inject = InferPostAmount
+instance
+ ( section ~ Ty repr TyAccountSection
+ ) => Inject (Chart.ChartPath section) (InferPost repr) TyAccount where
+ inject = InferPostAccount
+
+{-
+-- | Return 'True' if and only if the given 'DeviationByUnit' maps no @unit@.
+isEquilibrium :: DeviationByUnit section unit qty -> Bool
+isEquilibrium (DeviationByUnit dev) = Map.null dev
+
+-- | Return 'True' if and only if the given 'DeviationByUnit'
+-- maps only to 'SumForUnit's whose 'sumForUnitAccounts'
+-- maps exactly one account.
+isEquilibriumInferrable :: DeviationByUnit section unit qty -> Bool
+isEquilibriumInferrable (DeviationByUnit dev) =
+ Fold.all ((== 1) . Map.size . sumForUnitAccounts) dev
+
+-- | {Ex,In}clusive 'BalanceReprByAccount':
+-- descending propagation of quantities accross accounts.
+-}
+
+-- * Type 'Trickle'
+-- A data type to calculate an 'inclusive' value
+-- (through some propagation mecanism,
+-- eg. incorporating the values of the children of a tree node),
+-- while keeping the original 'exclusive' value
+-- (eg. the original value of a tree node).
+--
+-- * 'exclusive': contains the original 'SumByAccount'.
+-- * 'inclusive': contains ('+') folded
+-- over 'exclusive' and 'inclusive' of children.
+data Trickle amt = Trickle
+ { exclusive :: !amt
+ , inclusive :: !amt
+ } deriving (Eq, Show, Generic, NFData)
+instance Semigroup a => Semigroup (Trickle a) where
+ Trickle e0 i0 <> Trickle e1 i1 =
+ Trickle (e0<>e1) (i0<>i1)
+instance Monoid a => Monoid (Trickle a) where
+ mempty = Trickle mempty mempty
+ mappend = (<>)
+--type instance Ty (Trickle amt) TyUnit = Ty amt TyUnit
+--type instance Ty (Trickle amt) TyQuantity = Ty amt TyQuantity
+instance Addable amt => Addable (Trickle amt) where
+ x + y = Trickle
+ { exclusive = exclusive x + exclusive y
+ , inclusive = inclusive x + inclusive y
+ }
+
+-- | Return the given 'BalanceReprByAccount' with:
+--
+-- * all missing parent accounts inserted;
+-- * and every mapped @qty@ added with any @qty@
+-- of the account for which it is a parent.
+trickleBalanceRepr ::
+ forall repr a.
+ Balanceable a ~ 'True =>
+ Addable (Ty repr TyQuantity) =>
+ Ord (Ty repr TyAccountSection) =>
+ Ord (Ty repr TyUnit) =>
+ BalanceRepr Maybe repr a ->
+ BalanceRepr Trickle repr a
+trickleBalanceRepr (BalanceRepr bal) = BalanceRepr Balance
+ { balanceByAccount = balByAccount
+ , balanceByUnit = balByUnit [] (balanceByUnit bal) balByAccount
+ } where
+ balByUnit ks ini =
+ Map.foldrWithKey
+ (\k (amt, ch) acc ->
+ let acct = NonEmpty.reverse (k NonEmpty.:| ks) in
+ acc + balanceByUnit (unBal (post (account acct) (amount (inclusive amt)) ::
+ BalanceRepr Maybe repr TyPost))
+ ) ini . Chart.unChart
+ balByAccount =
+ Chart.mapByDepthFirst (\ch a ->
+ let exclusive = fromMaybe Map.empty a in
+ Trickle
+ { exclusive
+ , inclusive =
+ Map.foldl'
+ (\acc (sba, _ch) -> acc + inclusive sba)
+ exclusive
+ (Chart.unChart ch)
+ }
+ ) (balanceByAccount bal)
--- /dev/null
+{-# LANGUAGE NoRebindableSyntax #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Symantic.Compta.Calc.Chart where
+
+import Control.Applicative (Applicative(..))
+import Control.DeepSeq (NFData(..))
+import Data.Bool
+import Data.Traversable (Traversable(..))
+import Data.Eq (Eq(..))
+import Data.Function (($), (.), const, flip)
+import Data.Functor (Functor(..), (<$>))
+import Data.Foldable (Foldable(..), all)
+import Data.Map.Strict (Map)
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.Maybe (Maybe(..), isNothing)
+import Data.Monoid (Monoid(..))
+import Text.Show (Show(..))
+import Data.String (String)
+import Data.Tuple (fst, snd)
+import qualified Data.List as List
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.Map.Strict as Map
+
+--import Symantic.Compta.Lang.Rebindable
+import Symantic.Compta.Lang.Math
+
+-- * Type 'Chart'
+newtype Chart k a = Chart { unChart :: Map.Map k (a, Chart k a) }
+ deriving newtype (Eq, NFData)
+instance (Show k, Show a) => Show (Chart k a) where
+ show = List.unlines . drawMap where
+ drawNode :: (k, (a, Chart k a)) -> [String]
+ drawNode (k, (a, ts0)) =
+ List.zipWith (<>) (List.lines (show k)) (" " <> show a : List.repeat "") <>
+ drawMap ts0
+ drawMap = go . Map.toList . unChart where
+ go [] = []
+ go [t] = shift "` " " " (drawNode t)
+ go (t:ts) = shift "+ " "| " (drawNode t) <> go ts
+ shift ind0 ind = List.zipWith (<>) (ind0 : List.repeat ind)
+instance Functor (Chart k) where
+ fmap f = Chart . fmap (\(a, ch) -> (f a, fmap f ch)) . unChart
+instance Foldable (Chart k) where
+ foldMap f = foldMap (\(a, ch) -> f a <> foldMap f ch) . unChart
+instance Traversable (Chart k) where
+ traverse f =
+ (Chart <$>) .
+ traverse (\(a, ch) -> (,) <$> f a <*> traverse f ch) .
+ unChart
+instance (Semigroup a, Ord k) => Semigroup (Chart k a) where
+ x <> y = Chart $ Map.unionWith
+ (\new old -> (fst old<>fst new, snd old<>snd new))
+ (unChart x) (unChart y)
+instance (Semigroup a, Ord k) => Monoid (Chart k a) where
+ mempty = Chart Map.empty
+instance (Ord k, Addable a) => Addable (Chart k a) where
+ x + y = Chart $ Map.unionWith
+ (\(ym, ya) (xm, xa) -> (xm + ym, xa + ya))
+ (unChart x) (unChart y)
+instance (Ord k, Subable a) => Subable (Chart k a) where
+ x - y = Chart $ Map.unionWith
+ (\(ym, ya) (xm, xa) -> (xm - ym, xa - ya))
+ (unChart x) (unChart y)
+
+-- ** Type 'ChartPath'
+type ChartPath = NonEmpty.NonEmpty
+
+insert :: Ord k => a -> (a -> a -> a) -> ChartPath k -> a -> Chart k a -> Chart k a
+insert init merge p a ch = go ch p
+ where
+ go (Chart m) = \case
+ k:|[] -> Chart $ Map.insertWith
+ (\_new (old, c) -> (merge a old, c))
+ k (a, empty) m
+ k:|k1:ks -> Chart $ Map.insertWith
+ (\_new (old, c) -> (old, go c (k1:|ks)))
+ k (init, go empty (k1:|ks)) m
+
+-- | Return the value (if any) associated with the given 'Path'.
+lookup :: Ord k => ChartPath k -> Chart k a -> Maybe a
+lookup (k:|ks) (Chart m) = do
+ (a, ms) <- Map.lookup k m
+ case ks of
+ [] -> Just a
+ (k':ks') -> lookup (k':|ks') ms
+
+filter :: Ord k => (a -> Bool) -> Chart k a -> Chart k (Maybe a)
+filter f =
+ Chart . Map.mapMaybe (\(x, m) ->
+ let fx = f x in
+ let fm = filter f m in
+ if not fx && all isNothing fm
+ then Nothing
+ else Just (if fx then Just x else Nothing, fm)
+ ) . unChart
+
+empty :: Chart k a
+empty = Chart Map.empty
+
+singleton :: Ord k => a -> ChartPath k -> a -> Chart k a
+singleton init ks a = insert init const ks a empty
+
+-- | Return a 'Map' associating each 'ChartPath' in the given 'Chart',
+-- with its value mapped by the given function.
+flatten :: Ord k => (x -> y) -> Chart k x -> Map (ChartPath k) y
+flatten = flattenWithPath . const
+
+flattenWithPath :: Ord k => ([k] -> x -> y) -> Chart k x -> Map (ChartPath k) y
+flattenWithPath = go [] where
+ go p f ch =
+ Map.unions $
+ Map.mapKeysMonotonic (NonEmpty.reverse . flip (:|) p) (
+ Map.mapWithKey (\k (a, children) -> f (List.reverse (k : p)) a) (unChart ch)
+ ) :
+ Map.foldrWithKey
+ (\k (_a, children) -> (go (k:p) f children :))
+ [] (unChart ch)
+
+mapByDepthFirst :: Ord k => (Chart k b -> a -> b) -> Chart k a -> Chart k b
+mapByDepthFirst f =
+ Chart . Map.map
+ (\(a, ch) -> let m = mapByDepthFirst f ch in (f m a, m)) .
+ unChart
+
+foldrPath :: Ord k => (ChartPath k -> a -> acc -> acc) -> ChartPath k -> Chart k a -> acc -> acc
+foldrPath f = go [] . NonEmpty.toList where
+ go _ [] _m acc = acc
+ go p (k:ks) (Chart m) acc =
+ case Map.lookup k m of
+ Just (a, ch) -> f (NonEmpty.reverse (k:|p)) a $ go (k:p) ks ch acc
+ Nothing -> acc
+
+foldrWithPath :: Ord k => (ChartPath k -> a -> acc -> acc) -> acc -> Chart k a -> acc
+foldrWithPath f = go [] where
+ go p acc =
+ Map.foldrWithKey (\k (a, ch) acc' ->
+ f (NonEmpty.reverse (k:|p)) a
+ (go (k:p) acc' ch)
+ ) acc . unChart
--- /dev/null
+module Symantic.Compta.Calc.Flow where
+
+import Control.DeepSeq (NFData)
+import Data.Bool
+import Data.Eq (Eq)
+import Data.Functor (Functor)
+import Data.Maybe (Maybe(..))
+import Data.Ord (Ord(..))
+import GHC.Generics (Generic)
+import Text.Show (Show(..))
+
+import Symantic.Compta.Lang
+
+-- ** Type 'Flow'
+-- | A 'Flow keeps track separatly of what goes 'In'
+-- and what goes 'Out' of an account.
+data Flow a
+ = In !a
+ | Out !a
+ | Bidir !a !a
+ deriving (Eq, Show, Generic, NFData, Functor)
+
+instance FromInteger qty => FromInteger (Flow qty) where
+ fromInteger i | i <= 0 = Out (fromInteger i)
+ | otherwise = In (fromInteger i)
+
+flowIn :: Flow a -> Maybe a
+flowIn = \case
+ In i -> Just i
+ Out _ -> Nothing
+ Bidir _ i -> Just i
+
+flowOut :: Flow a -> Maybe a
+flowOut = \case
+ In _ -> Nothing
+ Out o -> Just o
+ Bidir o _ -> Just o
+
+flow :: Flowable a => a -> Flow a
+flow f =
+ case (outOf f, inOf f) of
+ (Just o, Nothing) -> Out o
+ (Nothing, Just i) -> In i
+ (Just o, Just i) -> Bidir o i
+ (Nothing, Nothing) -> Bidir f f
+unFlow :: Addable a => Flow a -> a
+unFlow = \case
+ In i -> i
+ Out o -> o
+ Bidir o i -> o + i
+
+instance Zeroable a => Zeroable (Flow a) where
+ zero = In zero
+instance (Nullable a, Addable a) => Nullable (Flow a) where
+ null = \case
+ Out o -> null o
+ In i -> null i
+ Bidir o i -> null (o + i)
+instance Addable a => Addable (Flow a) where
+ In i + Out o = Bidir o i
+ In ix + In py = In (ix + py)
+ In i + Bidir ny py = Bidir ny (i + py)
+
+ Out ox + Out ny = Out (ox + ny)
+ Out o + In i = Bidir o i
+ Out ox + Bidir ny i = Bidir (ox + ny) i
+
+ Bidir ox ix + Out o = Bidir (ox + o) ix
+ Bidir ox ix + In py = Bidir ox (ix + py)
+ Bidir ox ix + Bidir ny py = Bidir (ox + ny) (ix + py)
+instance Negable a => Negable (Flow a) where
+ negate = \case
+ In i -> Out (negate i)
+ Out o -> In (negate o)
+ Bidir o i -> Bidir (negate i) (negate o)
+instance Flowable (Flow a) where
+ outOf f = case f of
+ In _ -> Nothing
+ Out _ -> Just f
+ Bidir n _ -> Just (Out n)
+ inOf f = case f of
+ In _ -> Just f
+ Out _ -> Nothing
+ Bidir _ p -> Just (In p)
+--instance Eq
+
+-- * Class 'Flowable'
+class Flowable a where
+ outOf :: a -> Maybe a
+ inOf :: a -> Maybe a
+{-
+instance Flowable Decimal where
+ outOf q =
+ case q of
+ _ | q < 0 -> Just q
+ _ -> Nothing
+ inOf q =
+ case q of
+ _ | q <= 0 -> Nothing
+ _ -> Just q
+instance Flowable a => Flowable (Map k a) where
+ inOf q =
+ case Map.mapMaybe inOf q of
+ m | Map.null m -> Nothing
+ m -> Just m
+ outOf q =
+ case Map.mapMaybe outOf q of
+ m | Map.null m -> Nothing
+ m -> Just m
+instance Flowable a => Flowable (k, a) where
+ inOf (u, q) = (u,) <$> inOf q
+ outOf (u, q) = (u,) <$> outOf q
+-}
--- /dev/null
+{-# LANGUAGE NoOverloadedLists #-}
+module Symantic.Compta.Calc.Unit where
+
+import Control.DeepSeq (NFData)
+--import Data.Word (Word8)
+import Data.Bool (Bool(..))
+import Data.Char (Char)
+import Data.Int (Int)
+import Data.Eq (Eq)
+import Data.Ord (Ord)
+import GHC.Stack (HasCallStack)
+import GHC.Generics (Generic)
+import Data.String (String)
+import Data.Functor ((<$>))
+import Data.Monoid (Monoid(..))
+import Data.Function (flip)
+import Data.Semigroup (Semigroup(..))
+import Text.Show (Show)
+import qualified Data.Map.Strict as Map
+import qualified Data.Char as Char
+
+import Symantic.Compta.Lang
+import Symantic.Compta.Utils.Error
+
+data EUR
+
+-- * Class 'Unitable'
+class Unitable repr where
+ unit :: HasCallStack => Ty repr TyUnit -> repr a -> repr a
+ --withUnit :: repr U -> repr a -> repr a
+
+--withEuro :: repr a -> repr a
+--withEuro = withUnit euro
+
+-- ** Class 'EURable'
+class EURable repr where
+ eur :: repr TyQuantity -> repr TyAmount
+(€) :: EURable repr => repr TyQuantity -> repr TyAmount
+(€) = eur
+-- ** Class 'USDable'
+class USDable repr where
+ usd :: repr TyQuantity -> repr TyAmount
+--($) = usd
+
+-- * Type 'Unit'
+newtype Unit = Unit String
+ deriving newtype (Eq, Ord, Show, NFData)
+ deriving anyclass (Generic)
+instance IsString Unit where
+ fromString = \case
+ s@[c] | Char.CurrencySymbol <- Char.generalCategory c -> Unit s
+ [] -> Unit ""
+ _ -> errorWithStack "Unit"
+
+-- * Type 'Quantity'
+newtype Quantity qty = Quantity qty
+ deriving newtype (Eq, Show, NFData, Zeroable, Nullable, Addable, Negable, FromInteger, FromRational)
+instance Addable a => Semigroup (Quantity a) where
+ Quantity x <> Quantity y = Quantity (x + y)
+instance (Zeroable a, Addable a) => Monoid (Quantity a) where
+ mempty = Quantity zero
+
+-- * Type 'Amounts'
+newtype Amounts unit qty = Amounts (Map.Map unit qty)
+ deriving newtype (Eq, Show, NFData)
+{-
+instance Zeroable (Amounts a) where
+ zero = Amounts Map.empty
+instance Nullable (Amounts a) where
+ null (Amounts x) = Foldable.all null x
+-}
+instance (Ord unit, Semigroup qty) => Semigroup (Amounts unit qty) where
+ Amounts x <> Amounts y = Amounts (Map.unionWith (flip (<>)) x y)
+instance (Ord unit, Semigroup qty) => Monoid (Amounts unit qty) where
+ mempty = Amounts Map.empty
+instance Negable qty => Negable (Amounts unit qty) where
+ negate (Amounts x) = Amounts (negate <$> x)
+
+-- * Type 'AmountStyle'
+data AmountStyle = AmountStyle
+ { amountStyleFractioning :: Char
+ , amountStyleGroupingIntegral :: (Char, [Int])
+ , amountStyleGroupingFractional :: (Char, [Int])
+ , amountStyleUnitSideLeft :: Bool
+ , amountStyleUnitSpaced :: Bool
+ -- TODO: , amountStyleSignPlus :: Bool
+ } deriving (Eq, Show, Generic, NFData)
+
+-- ** Type 'AmountStylePrecision'
+--type AmountStylePrecision = Natural
+{-
+amountStyles :: Map.Map Unit AmountStyle
+amountStyles = Map.fromList
+ [ (scalarUnit, AmountStyle
+ { amountStyleFractioning = '.'
+ , amountStyleGroupingFractional = (',', [3])
+ , amountStyleGroupingIntegral = (',', [3])
+ , amountStyleUnitSideLeft = False
+ , amountStyleUnitSpaced = False
+ })
+ , (chfUnit, AmountStyle
+ { amountStyleFractioning = ','
+ , amountStyleGroupingFractional = ('.', [3])
+ , amountStyleGroupingIntegral = ('.', [3])
+ , amountStyleUnitSideLeft = False
+ , amountStyleUnitSpaced = False
+ })
+ , (cnyUnit, AmountStyle
+ { amountStyleFractioning = ','
+ , amountStyleGroupingFractional = ('.', [3])
+ , amountStyleGroupingIntegral = ('.', [3])
+ , amountStyleUnitSideLeft = False
+ , amountStyleUnitSpaced = False
+ })
+ , (eurUnit, AmountStyle
+ { amountStyleFractioning = ','
+ , amountStyleGroupingFractional = ('.', [3])
+ , amountStyleGroupingIntegral = ('.', [3])
+ , amountStyleUnitSideLeft = False
+ , amountStyleUnitSpaced = False
+ })
+ , (gbpUnit, AmountStyle
+ { amountStyleFractioning = '.'
+ , amountStyleGroupingFractional = (',', [3])
+ , amountStyleGroupingIntegral = (',', [3])
+ , amountStyleUnitSideLeft = True
+ , amountStyleUnitSpaced = False
+ })
+ , (inrUnit, AmountStyle
+ { amountStyleFractioning = ','
+ , amountStyleGroupingFractional = ('.', [3])
+ , amountStyleGroupingIntegral = ('.', [3])
+ , amountStyleUnitSideLeft = False
+ , amountStyleUnitSpaced = False
+ })
+ , (jpyUnit, AmountStyle
+ { amountStyleFractioning = '.'
+ , amountStyleGroupingFractional = (',', [3])
+ , amountStyleGroupingIntegral = (',', [3])
+ , amountStyleUnitSideLeft = True
+ , amountStyleUnitSpaced = False
+ })
+ , (rubUnit, AmountStyle
+ { amountStyleFractioning = '.'
+ , amountStyleGroupingFractional = (',', [3])
+ , amountStyleGroupingIntegral = (',', [3])
+ , amountStyleUnitSideLeft = True
+ , amountStyleUnitSpaced = False
+ })
+ , (usdUnit, AmountStyle
+ { amountStyleFractioning = '.'
+ , amountStyleGroupingFractional = (',', [3])
+ , amountStyleGroupingIntegral = (',', [3])
+ , amountStyleUnitSideLeft = True
+ , amountStyleUnitSpaced = False
+ })
+ ]
+-}
+
+scalarUnit :: Unit
+scalarUnit = Unit ""
+
+-- | <https://en.wikipedia.org/wiki/Swiss_franc Swiss franc> unit of currency.
+chfUnit :: Unit
+chfUnit = Unit "CHF"
+
+-- | <https://en.wikipedia.org/wiki/Yuan Yuan> unit of currency.
+cnyUnit :: Unit
+cnyUnit = Unit "Ұ"
+
+-- | <https://en.wikipedia.org/wiki/Euro Euro> unit of currency.
+eurUnit :: Unit
+eurUnit = Unit "€"
+
+-- | <https://en.wikipedia.org/wiki/Pound_sterling Pound sterling> unit of currency.
+gbpUnit :: Unit
+gbpUnit = Unit "£"
+
+-- | <https://en.wikipedia.org/wiki/Indian_rupee Indian rupee> unit of currency.
+inrUnit :: Unit
+inrUnit = Unit "₹"
+
+-- | <https://en.wikipedia.org/wiki/Japanese_yen Japanese yen> unit of currency.
+jpyUnit :: Unit
+jpyUnit = Unit "¥"
+
+-- | <https://en.wikipedia.org/wiki/Russian_ruble Russian ruble> unit of currency.
+rubUnit :: Unit
+rubUnit = Unit "₽"
+
+-- | <https://en.wikipedia.org/wiki/United_States_dollar United States dollar> unit of currency.
+usdUnit :: Unit
+usdUnit = Unit "$"
+
+
+
+{-
+import Control.DeepSeq
+import Data.Bool
+import Data.Char (Char)
+import Data.Data
+import Data.Decimal (Decimal, roundTo)
+import Data.Eq (Eq(..))
+import Data.Function (($), (.), const, flip)
+import Data.Map.Strict (Map)
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.Strict.Maybe
+import Data.String (IsString)
+import Data.Text (Text)
+import Data.Typeable ()
+import Data.Word (Word8)
+import Prelude (Int, seq)
+import Text.Show (Show(..))
+import qualified Data.Map.Strict as Map
+import qualified Data.MonoTraversable as MT
+import qualified Data.Strict as S
+import qualified Data.Text as T
+
+import qualified Hcompta as H
+
+-- * Type 'Amount'
+data Amount
+ = Amount
+ { amount_unit :: !Unit
+ , amount_quantity :: !Quantity
+ } deriving (Data, Eq, Ord, Show, Typeable)
+
+-- type instance H.UnitFor Amount = Unit
+-- type instance H.QuantityFor Amount = H.Polarized Quantity
+
+instance NFData Amount where
+ rnf (Amount q u) = rnf q `seq` rnf u
+-- instance H.Amount Amount
+
+{-
+type instance H.Unit H.:@ Amount = Unit
+instance H.GetI H.Unit Amount where
+ getI = amount_unit
+instance H.SetI H.Unit Amount where
+ setI amount_unit a = a{amount_unit}
+
+type instance H.Quantity H.:@ Amount = Quantity
+instance H.GetI H.Quantity Amount where
+ getI = amount_quantity
+instance H.SetI H.Quantity Amount where
+ setI amount_quantity a = a{amount_quantity}
+-}
+
+instance H.Zeroable Amount where
+ zero = Amount "" H.zero
+instance H.Nullable Amount where
+ null = H.null . amount_quantity
+ -- NOTE: the 'Amount'’s 'amount_quantity' MUST already be rounded
+ -- at 'Amount'’s 'amount_style'’s 'style_amount_precision'.
+instance H.Signable Amount where
+ sign = H.sign . amount_quantity
+
+amount :: Amount
+amount =
+ Amount
+ { amount_unit = ""
+ , amount_quantity = H.zero
+ }
+
+amount_style :: Style_Amounts -> Amount -> Style_Amount
+amount_style styles = style_amount_find styles . amount_unit
+
+-- * Type 'Quantity'
+type Quantity = Decimal
+
+quantity_round :: Word8 -> Quantity -> Quantity
+quantity_round = Data.Decimal.roundTo
+
+-- * Type 'Unit'
+newtype Unit
+ = Unit Text
+ deriving (Data, Eq, IsString, Ord, Show, Typeable)
+instance H.Zeroable Unit where
+ zero = Unit ""
+instance H.Nullable Unit where
+ null (Unit x) = T.null x
+{-
+instance H.Unit Unit where
+ noUnit = Unit ""
+ textUnit (Unit t) = t
+-}
+instance NFData Unit where
+ rnf (Unit t) = rnf t
+
+-- ** Example 'Unit's
+
+
+-- * Type 'Style_Amount'
+data Style_Amount
+ = Style_Amount
+ { amountStyleFractioning :: !(S.Maybe Style_Amount_Fractioning)
+ , amountStyleGroupingIntegral :: !(S.Maybe AmountStyleGrouping)
+ , amountStyleGroupingFractional :: !(S.Maybe AmountStyleGrouping)
+ , amountStyleUnitSideLeft :: !(S.Maybe LR)
+ , amountStyleUnitSpaced :: !(S.Maybe Style_Amount_Spacing)
+ -- TODO: , style_amount_sign_plus :: S.Maybe Bool
+ } deriving (Data, Eq, Ord, Show, Typeable)
+instance NFData Style_Amount where
+ rnf (Style_Amount f gi gf ui up) =
+ rnf f `seq`
+ rnf gi `seq`
+ rnf gf `seq`
+ rnf ui `seq`
+ rnf up
+instance Semigroup Style_Amount where
+ (<>) = style_amount_union
+instance Monoid Style_Amount where
+ mempty = style_amount
+ mappend = (<>)
+
+style_amount :: Style_Amount
+style_amount =
+ Style_Amount
+ { amountStyleFractioning = Nothing
+ , amountStyleGroupingIntegral = Nothing
+ , amountStyleGroupingFractional = Nothing
+ , amountStyleUnitSideLeft = Nothing
+ , amountStyleUnitSpaced = Nothing
+ }
+
+style_amount_union
+ :: Style_Amount
+ -> Style_Amount
+ -> Style_Amount
+style_amount_union
+ sty@Style_Amount
+ { amountStyleFractioning=f
+ , amountStyleGroupingIntegral=gi
+ , amountStyleGroupingFractional=gf
+ , amountStyleUnitSideLeft=side
+ , amountStyleUnitSpaced=spaced
+ }
+ sty'@Style_Amount
+ { amountStyleFractioning=f'
+ , amountStyleGroupingIntegral=gi'
+ , amountStyleGroupingFractional=gf'
+ , amountStyleUnitSideLeft=side'
+ , amountStyleUnitSpaced=spaced'
+ } =
+ if sty == sty'
+ then sty'
+ else
+ Style_Amount
+ { amountStyleFractioning = S.maybe f' (const f) f
+ , amountStyleGroupingIntegral = S.maybe gi' (const gi) gi
+ , amountStyleGroupingFractional = S.maybe gf' (const gf) gf
+ , amountStyleUnitSideLeft = S.maybe side' (const side) side
+ , amountStyleUnitSpaced = S.maybe spaced' (const spaced) spaced
+ }
+
+-- ** Type 'Style_Amount_Fractioning'
+type Style_Amount_Fractioning
+ = Char
+
+-- ** Type 'AmountStyleGrouping'
+data AmountStyleGrouping
+ = AmountStyleGrouping Char [Int]
+ deriving (Data, Eq, Ord, Show, Typeable)
+instance NFData AmountStyleGrouping where
+ rnf (AmountStyleGrouping s d) = rnf s `seq` rnf d
+
+-- ** Type 'Style_Amount_Precision'
+type Style_Amount_Precision
+ = Word8
+
+-- ** Type 'Style_Amount_Spacing'
+type Style_Amount_Spacing
+ = Bool
+
+-- ** Type 'LR'
+data LR = L | R
+ deriving (Data, Eq, Ord, Show, Typeable)
+instance NFData LR where
+ rnf L = ()
+ rnf R = ()
+
+-- ** Type 'Style_Amounts'
+newtype Style_Amounts
+ = Style_Amounts (Map Unit Style_Amount)
+ deriving (Data, Eq, NFData, Ord, Show, Typeable)
+
+-- type instance H.UnitFor Amounts = Unit
+-- type instance H.QuantityFor Amounts = Quantity
+
+instance Semigroup Style_Amounts where
+ Style_Amounts x <> Style_Amounts y =
+ Style_Amounts (Map.unionWith (flip (<>)) x y)
+instance Monoid Style_Amounts where
+ mempty = Style_Amounts mempty
+ mappend = (<>)
+instance H.Zeroable Style_Amounts where
+ zero = Style_Amounts mempty
+instance H.Sumable Style_Amounts (Unit, Style_Amount) where
+ Style_Amounts ss += (u, s) = Style_Amounts $ Map.insertWith (flip (<>)) u s ss
+
+unStyle_Amounts :: Style_Amounts -> Map Unit Style_Amount
+unStyle_Amounts (Style_Amounts fp) = fp
+
+style_amount_find :: Style_Amounts -> Unit -> Style_Amount
+style_amount_find (Style_Amounts s) u = Map.findWithDefault mempty u s
+
+-- *** Example 'Style_Amounts'
+amountStyles :: Style_Amounts
+
+-- ** Type 'Styled_Amount'
+type Styled_Amount t = (Style_Amount, t)
+
+styled_amount :: Style_Amounts -> Amount -> Styled_Amount Amount
+styled_amount styles amt = (amount_style styles amt, amt)
+
+-- * Type 'Amounts'
+newtype Amounts = Amounts (Map Unit Quantity)
+ deriving (Data, Eq, NFData, Ord, Show, Typeable
+ , H.Addable, H.Negable, H.Subable)
+unAmounts :: Amounts -> Map Unit Quantity
+unAmounts (Amounts a) = a
+
+type instance MT.Element Amounts = Amount
+-- instance H.Amounts Amounts
+
+-- instance H.Get (H.Balance_Amounts Unit Quantity) Amounts where
+-- get (Amounts a) = a
+-}
--- /dev/null
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+module Symantic.Compta.Data where
+import Data.String
+import Data.Decimal
+import Data.Map.Strict (Map)
+
+newtype Unit = Unit String
+newtype Quantity = Quantity Decimal
+data Amounts = Map Unit Quantity
+--data Postings = Postings [String]
+--data Transaction
--- /dev/null
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+module Symantic.Compta.Demo where
+
+import Data.Eq (Eq(..))
+import Data.Maybe (Maybe(..))
+import Control.Monad (Monad(..))
+import Data.Function (($))
+import Data.Functor ((<$>))
+import qualified Control.Monad as Monad
+import qualified System.IO as IO
+
+import Symantic.Compta
+import Symantic.Compta.Calc
+import qualified Symantic.Compta.Calc.Chart as Chart
+import qualified Symantic.Compta.Eval as Eval
+import qualified Symantic.Compta.Norm.PCG as PCG
+import qualified Symantic.Compta.View as View
+
+{-
+evalChart :: Tree.Forest (Account Tree.Tree) -> Tree.Forest (Account Tree.Tree)
+evalChart = id
+journalTree :: [Eval (Transaction Eval)] -> [Eval (Transaction Eval)]
+journalTree = id
+--data Balance amt account where
+
+instance Applicative repr => Minusable Year Month (Year,Month) repr where
+ y-m = (,) <$> y <*> m
+instance Applicative repr => Minusable (Year,Month) DayOfMonth Day repr where
+ dy-dom = (\(d,y) -> Time.fromGregorianValid) <$> dy <*> dom
+
+j = day 01 do
+ get @Day
+
+j2020 :: [Eval (Transaction Eval)]
+j2020 =
+ [ year 2020 \= [
+ month 03 \= [
+ day 01 \=
+ [ c1_Capital -= 32
+ , c2_Immo += 32
+ ]
+ ]
+ ]
+ ]
+-}
+
+{-
+j =
+ --year 2020 do
+ --month 03 do
+ day 01 do
+ transaction "libellé" do
+ c1_Capital -= 32
+ c2_Immo += 32
+-}
+--demo = chartTree pcf
+--demo :: [Transaction Eval]
+--demo = j2020
+--demo = ()
+{-
+p0s ::
+ Postable post acct amt repr =>
+ EUR amt qty repr =>
+ --Literable repr =>
+ IsString section =>
+ acct ~ Account =>
+ amt ~ Amount =>
+ qty ~ Quantity Decimal =>
+ section ~ AccountSegment =>
+ unit ~ Unit =>
+ Liftable (Balance section unit qty) repr =>
+ [repr post]
+-}
+--p0s :: [R () Amount AccountSegment ()]
+--p0s_ = runJournalM chart p0
+--p0s = runJournalM chart (p0 :: JournalM (Chart.ChartPath AccountSegment) Amount R [TyPost])
+
+{-
+p0 ::
+ forall repr post acct section amt unit qty.
+ amt ~ Map unit qty =>
+ Negable qty =>
+ FromInteger (JournalM post acct section amt unit qty repr qty) =>
+ FromInteger (JournalM post acct section amt unit qty repr acct) =>
+ Postable post acct amt (JournalM post acct section amt unit qty repr) =>
+ EUR amt (JournalM post acct section amt unit qty repr) =>
+ JournalM post acct section amt unit qty repr post
+-}
+{-
+p0 = unit ("$"::Unit) do
+ 1 -= 10
+ 31
+ --1 += (eur 10 + usd 10)
+ --2 -= eur @_ @qty (neg <$> 10)
+ --2 -= (JournalM (return Map.empty) + eur 5)
+ --"Tiers/Client" -= eur 10
+ --"Tiers" += eur 10
+p1 = [ 1 -= 42, 2 ]
+j = year 2020 do
+ 1 -= 3
+ 2 += 3
+07/02 Alimentation ; F:Sitis
+ Tiers:Julien:Dépense -4,78
+ Charge:Achat:Fourniture:Alimentation 4,78
+-}
+t0 = {-unit ("$"::Unit)-} do
+ --move (cons (101 -= 10) (cons 41 nil))
+ move do
+ 101 -= 10
+ 41
+ move do
+ 101 -= 10
+ 41
+ move [ 631 -= 42, 41 ]
+ move [ 1018 -= 5, 41 ]
+t1 = unit ("$"::Unit)
+ --move (cons (101 -= 10) (cons 41 nil))
+ [ move [ 631 -= 42, 41 ]
+ , move [ 1018 -= 5, 41 ]
+ , move do
+ 1018 -= 5
+ 41
+ ]
+
+{-
+instance IsList (repr [TyPost acct amt]) where
+ type Item (repr [TyPost acct amt]) =
+ repr (TyPost acct amt)
+-}
+
+t0s = PCG.journal @Eval.Journal PCG.chart t0
+--t1s = PCG.journal PCG.chart t1
+
+b0 = PCG.balance t0s
+
+demo = do
+ IO.print ()
+ --IO.print PCG.chart
+ --IO.putStrLn $ Tree.drawForest $ (show <$>) <$> chart
+ --IO.print p0s
+ --IO.print (Chart.filter (\s -> PCG.sectionSystem s == Just PCG.SystemAbrege) PCG.chart)
+ IO.print t0s
+ IO.print b0
+ --IO.print $ tableBalance tb0
+ --IO.putStrLn $ View.table (tableBalance tb0)
+ {-
+ IO.putStrLn $ View.table
+ [ ["compte", "débit", "crédit", "solde"]
+ , ["1", "-10", "+30", "20"]
+ , ["-3", "+2", "0"]
+ , ["1", "2", "3", "40000", "5000", "6"]
+ , ["420000000"]
+ ]
+ -}
--- /dev/null
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoOverloadedLists #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+module Symantic.Compta.Eval where
+import Control.Applicative (Applicative(..))
+import Control.Monad (Monad(..), sequence)
+import Data.Decimal (Decimal)
+import Data.Either (Either(..))
+import Data.Function (($), (.), id)
+import Data.Functor (Functor, (<$>))
+import Data.Int (Int)
+import Data.Kind
+import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
+import Data.Map.Strict (Map)
+import Data.Maybe (Maybe(..))
+import Data.Monoid (Monoid(..), Endo(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (String)
+import Data.Typeable
+import Numeric.Natural (Natural)
+import Prelude (Enum(..), fromIntegral, Integer)
+import Text.Show (Show(..))
+import qualified Control.Monad.Classes as MC
+import qualified Control.Monad.Trans.Reader as MT
+import qualified Data.Foldable as Foldable
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.Time.Calendar as Time
+import qualified Data.Tree as Tree
+
+import Symantic.Compta.Utils.Monoid ()
+import Symantic.Compta.Lang
+import Symantic.Compta.Calc
+import Symantic.Compta.Norm.PCG
+
+-- * Type 'Journal'
+data Journal a where
+ JournalList :: Endo [Journal a] -> Journal [a]
+ JournalMove :: Journal [TyPost] -> Journal TyMove
+ JournalPost :: Journal TyAccount -> Journal TyAmount -> Journal TyPost
+ JournalAccount :: Ty Journal TyAccount -> Journal TyAccount
+ JournalAmount :: Ty Journal TyAmount -> Journal TyAmount
+deriving instance Show (Journal a)
+type instance Ty Journal TyAccount = ChartPath AccountCode
+type instance Ty Journal TyAmount = Map Unit (Quantity (Flow Decimal))
+type instance Ty Journal TyUnit = Unit
+type instance Ty Journal TyQuantity = Quantity (Flow Decimal)
+type instance Ty Journal TyAccountSection = AccountCode
+instance Inject (ChartPath AccountCode) Journal TyAccount where
+ inject = JournalAccount
+instance Inject (Map Unit (Quantity (Flow Decimal))) Journal TyAmount where
+ inject = JournalAmount
+instance Zeroable (Journal TyAmount) where
+ zero = JournalAmount zero
+instance Negable (Journal TyAmount) where
+ negate (JournalAmount x) = JournalAmount (negate x)
+instance Negable (Journal TyPost) where
+ negate (JournalPost acct amt) = JournalPost acct (negate amt)
+instance Negable (Journal TyMove) where
+ negate (JournalMove x) = JournalMove (negate x)
+instance Negable (Journal a) => Negable (Journal [a]) where
+ negate (JournalList x) = JournalList (negate x)
+instance Listable Journal where
+ nil = JournalList (Endo id)
+ cons x (JournalList xs) = JournalList (Endo (x :) <> xs)
+ concat (JournalList xs) (JournalList ys) = JournalList (xs <> ys)
+instance Accountable Journal where
+ account = JournalAccount
+instance Amountable Journal where
+ amount = JournalAmount
+instance Postable Journal where
+ post = JournalPost
+instance Moveable Journal where
+ move = JournalMove
+instance
+ ( Listable repr
+ , Postable repr
+ , Moveable repr
+ , Inject (Ty Journal TyAccount) repr TyAccount
+ , Inject (Ty Journal TyAmount) repr TyAmount
+ ) => Trans Journal repr where
+ trans = \case
+ JournalList xs -> Foldable.foldr (cons . trans) nil (appEndo xs [])
+ JournalMove ps -> move (trans ps)
+ JournalPost acct amt -> post (trans acct) (trans amt)
+ JournalAccount x -> inject x
+ JournalAmount x -> inject x
+
+{-
+-- * Eval
+data Error
+ = Error_Date Year Month Int
+ deriving (Show)
+newtype Eval a = Eval { unEval :: Either Error a }
+ deriving (Functor, Applicative, Monad, Show)
+type instance Account Eval = [String]
+type instance Unit Eval = String
+type instance Quantity Eval = Decimal
+type instance Amount Eval = (Unit Eval, Quantity Eval)
+type instance Amounts Eval = Map (Unit Eval) (Quantity Eval)
+type instance Date Eval = Time.Day
+type instance Wording Eval = String
+type instance PolarizedAmount Eval = Decimal
+type instance Posting Eval = (Account Eval, Map (Unit Eval) (Quantity Eval))
+type instance Transaction Eval =
+ ( Date Eval
+ , Wording Eval
+ , [Posting Eval]
+ )
+--type instance YearDo (Eval repr) = MT.Reader Year repr
+instance Dateable Eval where
+ day i kd = \m y -> Eval $
+ case Time.fromGregorianValid (fromIntegral y) (fromEnum m) i of
+ Nothing -> Left $ Error_Date y m i
+ Just d -> unEval (MT.runReaderT kd (Day d))
+instance Postingable Eval where
+ act -= amts = (,) <$> act <*> amts
+ act += amts = (,) <$> act <*> amts
+instance Transactionable Eval where
+ transaction rw rps = do
+ w <- rw
+ ps <- sequence rps
+ return (w, ps)
+
+type instance Account Eval = [String]
+type instance AccountSection Eval = String
+type instance Chart Eval = Tree.Tree (String{-, [(String, String)]-})
+--type instance Transaction Tree.Tree = Tree (Day, Wording)
+--instance Fieldable Eval where
+ --x|=v =
+instance Chartable Eval where
+ section n ss = Eval (Right ss)
+type instance Merge String (Tree.Tree String) = Tree.Tree String
+instance Nodable String (Tree.Tree String) Eval where
+ sct \= acts = Tree.Node <$> sct <*> sequence acts
+ --List.foldr (\a acc -> [Tree.Node a acc]) acts act
+ --x ./ y = Tree.Node (Tree.rootLabel x) [y]
+ --x .| y = Tree.Node (0,"") [x,y]
+-}
--- /dev/null
+import "hint" HLint.HLint
+ignore "Move brackets to avoid $"
+ignore "Reduce duplication"
+ignore "Redundant $"
+ignore "Redundant bracket"
+ignore "Redundant do"
+ignore "Use camelCase"
+ignore "Use const"
+ignore "Use fmap"
+ignore "Use if"
+ignore "Use import/export shortcut"
+ignore "Use list literal pattern"
+ignore "Use list literal"
+
+-- BEGIN: generated hints
+-- END: generated hints
--- /dev/null
+module Symantic.Compta.Input
+ ( module Symantic.Compta.Input.Chart
+ , module Symantic.Compta.Input.Journal
+ ) where
+import Symantic.Compta.Input.Chart
+import Symantic.Compta.Input.Journal
--- /dev/null
+module Symantic.Compta.Input.Chart where
+
+import Control.Applicative (Applicative(..))
+import Control.Monad (Monad(..))
+import Data.Foldable (foldr)
+import Data.Functor (Functor)
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Prelude (error)
+import qualified Control.Monad.Trans.Writer as MT
+import qualified GHC.Exts as GHC
+
+import Symantic.Compta.Lang.Rebindable
+import Symantic.Compta.Lang
+import Symantic.Compta.Calc.Chart
+
+-- * Type 'ChartM'
+-- | A 'Monad' to construct a 'Chart'.
+newtype ChartM k v m a = ChartM { unChartM ::
+ MT.WriterT (v, Chart k v) m a
+ } deriving newtype (Functor, Applicative, Monad)
+
+runChartM :: Monad m => ChartM k v m a -> m (Chart k v)
+runChartM chM = do
+ (_a, (_v, ch)) <- MT.runWriterT (unChartM chM)
+ return ch
+
+instance (Ord k, Monoid v, Monad m) => Semigroup (ChartM k v m a) where
+ (<>) = (Control.Monad.>>)
+instance (Ord k, Monoid v, Monad m, Monoid a) => Monoid (ChartM k v m a) where
+ mempty = return mempty
+instance
+ ( Ord k
+ , Monoid v
+ , Monad m
+ , Monoid a
+ ) => GHC.IsList (ChartM k v m a) where
+ type Item (ChartM k v m a) = ChartM k v m a
+ fromList = mconcat
+ fromListN _n = mconcat
+ toList = return
--- /dev/null
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+{-# LANGUAGE NoOverloadedLists #-}
+{-# LANGUAGE UndecidableInstances #-}
+--{-# LANGUAGE QualifiedDo #-}
+{-# LANGUAGE StandaloneDeriving #-}
+module Symantic.Compta.Input.Journal where
+
+import Control.Applicative (Applicative(..), liftA2)
+import Control.Monad (Monad(..))
+--import Data.Either (Either(..))
+import Data.Bool
+import Data.Function (($), (.))
+import Data.Functor (Functor(..), (<$>))
+--import Data.Map.Strict (Map)
+--import Data.Maybe (Maybe(..))
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import GHC.Stack (HasCallStack)
+import Prelude (undefined)
+import Text.Show (Show(..))
+--import qualified Control.Monad.Trans.Class as MT
+import qualified Control.Monad.Trans.Writer as MT
+--import qualified Data.Map.Strict as Map
+
+import Symantic.Compta.Lang as List
+import Symantic.Compta.Calc.Balance
+--import Symantic.Compta.Calc.Chart
+import Symantic.Compta.Calc.Unit
+
+import Debug.Trace
+
+-- * Type 'JournalDo'
+-- | This 'Monad' enables the 'do' syntax for entering 'move's and 'post's,
+-- which is less verbose than the list syntax.
+newtype JournalDo repr a = JournalDo { unJournalDo ::
+ MT.Writer (JournalGenerator repr) a
+ } deriving newtype (Functor, Applicative, Monad)
+type instance Ty (JournalDo repr) TyUnit = Ty repr TyUnit
+instance Unitable repr => Unitable (JournalDo repr) where
+ unit u = JournalDo . MT.mapWriter (go <$>) . unJournalDo
+ where
+ go JournalGenerator{..} = JournalGenerator
+ { moves = unit u moves
+ , posts = unit u posts
+ }
+
+runJournalDo :: HasCallStack => JournalDo repr a -> repr [TyMove]
+runJournalDo p =
+ let (_a, out) = MT.runWriter (unJournalDo p) in
+ moves out
+
+-- ** Type 'JournalGenerator'
+data JournalGenerator repr = JournalGenerator
+ { moves :: repr [TyMove]
+ , posts :: repr [TyPost]
+ }
+instance Listable repr => Semigroup (JournalGenerator repr) where
+ x <> y = JournalGenerator
+ { moves = moves x `concat` moves y
+ , posts = posts x `concat` posts y
+ }
+instance Listable repr => Monoid (JournalGenerator repr) where
+ mempty = JournalGenerator
+ { moves = nil
+ , posts = nil
+ }
+instance
+ ( Negable (repr [TyMove])
+ , Negable (repr [TyPost])
+ ) => Negable (JournalGenerator repr) where
+ negate JournalGenerator{..} = JournalGenerator
+ { moves = negate moves
+ , posts = negate posts
+ }
+
+data JournalRepr repr a where
+ JournalReprAny ::
+ Balanceable a ~ 'False =>
+ repr a -> JournalRepr repr a
+ JournalRepr ::
+ --Balanceable a ~ 'True =>
+ JournalDo repr a -> JournalRepr repr a
+
+instance Functor (JournalRepr repr) where
+ fmap f = \case
+ JournalRepr fx -> JournalRepr (fmap f fx)
+instance Listable repr => Applicative (JournalRepr repr) where
+ pure = JournalRepr . pure
+ JournalRepr fa <*> JournalRepr fb = JournalRepr (fa <*> fb)
+instance Listable repr => Monad (JournalRepr repr) where
+ return = JournalRepr . return
+ JournalRepr ma >>= f = JournalRepr $ ma >>= \a ->
+ case f a of
+ JournalRepr mb -> mb
+
+type instance Ty (JournalRepr repr) TyUnit = Ty repr TyUnit
+
+runJournalRepr :: JournalRepr repr TyMove -> repr [TyMove]
+runJournalRepr = \case
+ JournalRepr j -> runJournalDo j
+instance
+ Unitable repr =>
+ Unitable (JournalRepr repr) where
+ unit u = \case
+ JournalReprAny x -> JournalReprAny (unit u x)
+ JournalRepr x -> JournalRepr (unit u x)
+
+{-
+instance
+ ( Listable repr
+ , Monad m
+ ) => IsList (JournalRepr acct amt repr [a]) where
+ type Item (JournalRepr acct amt repr [a]) = JournalRepr acct amt repr a
+ fromList = Foldable.foldr cons nil
+ toList x = error "toList"
+ fromListN _len = fromList
+-}
+instance Listable repr => Listable (JournalRepr repr) where
+ nil = JournalRepr $ return []
+ cons (JournalRepr x) (JournalRepr xs) = JournalRepr $ liftA2 (:) x xs
+ -- NOTE: those two should never be needed, but Balanceable can't rule them out
+ cons (JournalReprAny x) (JournalRepr xs) = JournalRepr $
+ liftA2 (:) (JournalDo (return undefined)) xs
+ concat (JournalRepr xs) (JournalRepr ys) = JournalRepr $ liftA2 (<>) xs ys
+instance Zeroable (repr TyAmount) => Zeroable (JournalRepr repr TyAmount) where
+ zero = JournalReprAny zero
+instance Addable (repr TyAmount) => Addable (JournalRepr repr TyAmount) where
+ JournalReprAny x + JournalReprAny y = JournalReprAny (x + y)
+instance
+ ( Negable (repr [TyMove])
+ , Negable (repr [TyPost])
+ , Negable (repr a)
+ ) => Negable (JournalRepr repr a) where
+ negate (JournalReprAny x) = JournalReprAny (negate x)
+ negate (JournalRepr x) = JournalRepr $ JournalDo $
+ MT.mapWriter (negate <$>) $ unJournalDo x
+instance
+ ( Listable repr
+ , FromInteger (repr TyAmount)
+ ) => FromInteger (JournalRepr repr TyAmount) where
+ fromInteger = JournalReprAny . fromInteger
+instance
+ ( Listable repr
+ , FromInteger (repr TyAccount)
+ ) => FromInteger (JournalRepr repr TyAccount) where
+ fromInteger = JournalReprAny . fromInteger
+instance
+ ( Listable repr
+ , Accountable repr
+ , Amountable repr
+ , Postable repr
+ , Zeroable (repr TyAmount)
+ , FromInteger (repr TyAccount)
+ ) => FromInteger (JournalRepr repr TyPost) where
+ fromInteger i = post (fromInteger i) zero
+instance
+ ( Listable repr
+ , Accountable repr
+ , Amountable repr
+ , Postable repr
+ , Zeroable (repr TyAmount)
+ , FromInteger (repr TyAccount)
+ ) => FromInteger (JournalRepr repr [TyPost]) where
+ fromInteger i = post (fromInteger i) zero `cons` nil
+{-
+instance
+ ( Postable repr
+ , FromInteger (JournalRepr repr acct)
+ , Listable repr
+ , Monad m
+ ) => FromInteger (JournalRepr repr [TyPost]) where
+ fromInteger i = cons (fromInteger i) nil
+instance
+ ( Postable repr
+ , IsString (JournalRepr repr acct)
+ , Listable repr
+ , Monad m
+ ) => IsString (JournalRepr repr TyPost) where
+ fromString s = do
+ acct :: acct <- fromString s
+ post acct (Map.empty :: Map unit qty)
+instance
+ ( Postable repr
+ , IsString (JournalRepr repr acct)
+ , Listable repr
+ , Monad m
+ ) => IsString (JournalRepr repr [TyPost]) where
+ fromString s = do
+ acct :: acct <- fromString s
+ cons (post acct (Map.empty :: Map unit qty)) nil
+instance
+ ( FromRational qty
+ , Listable repr
+ , Monad m
+ ) => FromRational (JournalRepr repr qty) where
+ fromRational = JournalRepr . return . fromRational
+type instance QuantityOf (Map unit qty) = qty
+instance
+ ( IsString unit
+ , Monad m
+ ) => EURable (Map unit qty) (JournalRepr repr) where
+ eur = (Map.singleton "€" <$>)
+-}
+instance EURable repr => EURable (JournalRepr repr) where
+ eur (JournalReprAny x) = JournalReprAny (eur x)
+instance USDable repr => USDable (JournalRepr repr) where
+ usd (JournalReprAny x) = JournalReprAny (usd x)
+
+instance
+ ( Listable repr
+ , Accountable repr
+ , Amountable repr
+ , Postable repr
+ ) => Postable (JournalRepr repr) where
+ post (JournalReprAny acct) (JournalReprAny amt) = JournalRepr $ JournalDo $
+ MT.writer (TyPost, mempty{posts = post acct amt `cons` nil})
+instance
+ ( Addable (Ty repr TyQuantity)
+ , Listable repr
+ , Moveable repr
+ , Negable (Ty repr TyQuantity)
+ , Nullable (Ty repr TyQuantity)
+ , Ord (Ty repr TyAccountSection)
+ , Ord (Ty repr TyUnit)
+ , Postable repr
+ , Show (Ty repr TyAccountSection)
+ , Show (Ty repr TyQuantity)
+ , Show (Ty repr TyUnit)
+ ) => Moveable (JournalRepr repr) where
+ move (JournalRepr ps) = JournalRepr $ JournalDo $
+ (`MT.mapWriterT` unJournalDo ps) $ fmap $ \(_ps, out) ->
+ ( TyMove, out
+ { moves = move (posts out) `cons` moves out
+ , posts = nil
+ }
+ )
+
+{-
+instance FromInteger (JournalRepr acct amt repr AccountCode) where
+ fromInteger i = JournalRepr do
+ env <- MT.ask
+ let ac = if 0 <= i then AccountCode (fromInteger i) else error ("Invalid AccountCode: "<>show i)
+ case HashMap.lookup ac (accountByCode env) of
+ Just{} -> return ac
+ _ -> error ("Chart does not allow AccountCode: "<>show ac<>" "<>show (accountByCode env))
+-}
+--instance FromInteger qty => FromInteger (JournalRepr acct amt repr qty) where
+-- fromInteger = JournalRepr . return . fromInteger
+{-
+type instance AccountSectionOf (ChartPath section) = section
+type instance UnitOf (Map unit qty) = unit
+type instance AmountOf () = Map Unit Q
+type instance AccountOf () = NonEmpty AccountSegment
+
+type Account = AccountCode
+type AccountPath = ChartPath AccountSegment
+type Amount = Map Unit Q
+type Q = Quantity (Flow Decimal)
+
+instance FromInteger qty => FromInteger (Flow qty) where
+ fromInteger i | i <= 0 = Out (fromInteger i)
+ | otherwise = In (fromInteger i)
+
+instance
+ Listable repr =>
+ IsString (JournalRepr acct amt repr (ChartPath AccountSegment)) where
+ fromString s = JournalRepr $ MT.ReaderT $ \env -> do
+ case nonEmpty (fromString s) of
+ Just acct | HashMap.member acct (accountByName env) -> MT.writer (acct, mempty)
+ Just acct -> error ("AccountPath is not allowed by given Chart: "<>show acct)
+ Nothing -> error "Invalid empty AccountPath"
+instance
+ Listable repr =>
+ FromInteger (JournalRepr acct amt repr (ChartPath AccountSegment)) where
+ fromInteger i = JournalRepr $ MT.ReaderT $ \env -> do
+ let ac = if 0 <= i then AccountCode (fromInteger i) else error ("Invalid AccountCode: "<>show i)
+ case HashMap.lookup ac (accountByCode env) of
+ Just (Just acct, _) -> MT.writer (acct, mempty)
+ _ -> error ("Chart does not allow AccountCode: "<>show ac<>" "<>show (accountByCode env))
+instance
+ Listable repr =>
+ IsString (JournalRepr acct amt repr AccountCode) where
+ fromString s = JournalRepr $ MT.ReaderT $ \env -> do
+ case nonEmpty (fromString s) of
+ Just acct | Just (ac, _) <- HashMap.lookup acct (accountByName env) -> MT.writer (ac, mempty)
+ Just acct -> error ("AccountPath is not allowed by given Chart: "<>show acct)
+ Nothing -> error "Invalid empty AccountPath"
+
+-- ** Type 'JournalEnv'
+data JournalEnv unit = JournalEnv
+ { accountByCode :: HashMap.HashMap AccountCode (Maybe AccountPath, ChartNode)
+ , accountByName :: HashMap.HashMap AccountPath (AccountCode, ChartNode)
+ , defaultUnit :: unit
+ }
+journalEnv ch = JournalEnv
+ { accountByCode = HashMap.fromList byCode
+ , accountByName = HashMap.fromList byName
+ , defaultUnit = inject ""
+ } where
+ (byCode, byName) = goChart (AccountCode 0, []) ch
+ goChart p = Map.foldMapWithKey (goNode p) . unChart
+ goNode (AccountCode kc, kn) n (node, children) =
+ let keyCode = AccountCode (kc Prelude.* 10 Prelude.^ digitNumber n Prelude.+ n) in
+ let keyName = kn <> maybeToList (sectionName node) in
+ let (bc, bn) = goChart (keyCode, keyName) children in
+ ( (keyCode, (nonEmpty keyName, node)) : bc
+ , case nonEmpty keyName of
+ Just k -> (k, (keyCode, node)) : bn
+ Nothing -> bn
+ )
+instance
+ ( FromInteger qty
+ , Listable repr
+ ) => FromInteger (JournalRepr acct (Map unit qty) repr (Map unit qty)) where
+ fromInteger i = JournalRepr $
+ --qty <- unJournalDo (fromInteger i :: JournalRepr acct (Map unit qty) repr qty)
+ MT.writer (Map.singleton (defaultUnit env) (fromInteger i), mempty)
+
+-- | @('digitNumber' n)@ retourne le nombre de digits nécessaires pour encoder 'n'.
+digitNumber :: Natural -> Natural
+digitNumber = go where
+ go n | n < 10 = 1
+ | otherwise = 1 Prelude.+ go (n`Prelude.div`10)
+
+-}
--- /dev/null
+--{-# 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 &
--- /dev/null
+{-# LANGUAGE DefaultSignatures #-}
+module Symantic.Compta.Lang.Math where
+
+import Data.Bool
+import Data.Function ((.), flip)
+import Data.Decimal (Decimal, DecimalRaw(..), roundTo)
+import Data.Eq (Eq(..))
+import Data.Map.Strict (Map)
+import Data.Maybe (Maybe(..))
+import Data.Functor ((<$>))
+import Data.Monoid (Endo(..))
+import Data.String (String)
+import Data.Ord (Ord(..), Ordering(..))
+import Data.Word (Word8)
+import Data.Int (Int)
+import Prelude (Integral, Integer, fromIntegral)
+import qualified Data.Map.Strict as Map
+import qualified Prelude
+
+import Symantic.Compta.Lang.Rebindable
+
+-- * Class 'Zeroable'
+class Zeroable a where
+ zero :: a
+instance Zeroable String where
+ zero = ""
+instance Zeroable Decimal where
+ zero = 0
+instance Zeroable (Map.Map k a) where
+ zero = Map.empty
+
+{-
+instance Zeroable Decimal where
+ zero = 0
+instance Zeroable (Map k a) where
+ zero = Map.empty
+-}
+
+-- * Class 'Nullable'
+class Nullable a where
+ null :: a -> Bool
+ default null :: Zeroable a => Eq a => a -> Bool
+ null = (== zero)
+instance Nullable String
+instance Nullable Decimal
+
+{-
+instance Nullable Decimal where
+ null = (==) zero
+instance Nullable a => Nullable (Map k a) where
+ null = Foldable.all null
+-}
+
+-- * Class 'Signable'
+class Signable a where
+ sign :: a -> Ordering
+ default sign :: Zeroable a => Nullable a => Ord a => a -> Ordering
+ sign a =
+ case () of
+ _ | null a -> EQ
+ _ | a < zero -> LT
+ _ -> GT
+--instance Signable Decimal
+
+-- * Class 'Addable'
+class Addable a where
+ (+) :: a -> a -> a; infixl 6 +
+ default (+) :: Prelude.Num a => a -> a -> a
+ (+) = (Prelude.+)
+-- | For @'Addable' ('Map' k ())@.
+instance Addable () where
+ (+) () () = ()
+instance (Ord k, Addable a) => Addable (Map k a) where
+ (+) = Map.unionWith (flip (+))
+instance Addable a => Addable (Maybe a) where
+ Nothing + Nothing = Nothing
+ Just x + Nothing = Just x
+ Nothing + Just y = Just y
+ Just x + Just y = Just (x + y)
+instance Addable Decimal where
+ (+) x y = Decimal e (fromIntegral (nx Prelude.+ ny))
+ where (e, nx, ny) = roundMinDecimal x y
+-- | Round the two 'DecimalRaw' values to the smallest exponent.
+roundMinDecimal :: Integral i => DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
+roundMinDecimal d1@(Decimal e1 _) d2@(Decimal e2 _) = (e, n1, n2)
+ where
+ e = min e1 e2
+ Decimal _ n1 = roundTo e d1
+ Decimal _ n2 = roundTo e d2
+
+-- * Class 'Negable'
+class Negable a where
+ negate :: a -> a
+ default negate :: Prelude.Num a => a -> a
+ negate = Prelude.negate
+-- | For @'Negable' ('Map' k ())@.
+instance Negable () where
+ negate () = ()
+instance Negable Int
+instance Negable Integer
+instance Negable Decimal
+instance Negable a => Negable (Map k a) where
+ negate = Map.map negate
+instance Negable a => Negable (Endo a) where
+ negate (Endo f) = Endo (f . negate)
+instance Negable a => Negable [a] where
+ negate = (negate <$>)
+
+-- * Class 'Subable'
+class Subable a where
+ (-) :: a -> a -> a; infixl 6 -
+ default (-) :: Prelude.Num a => a -> a -> a
+ (-) = (Prelude.-)
+-- | For @'Subable' ('Map' k ())@.
+instance Subable () where
+ (-) () () = ()
+instance Subable Int
+instance Subable Integer
+instance Subable Decimal
+instance (Ord k, Addable a, Negable a) => Subable (Map k a) where
+ (-) x y = Map.unionWith (flip (+)) x (negate y)
--- /dev/null
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE RebindableSyntax #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PostfixOperators #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UnicodeSyntax #-}
+--{-# LANGUAGE ApplicativeDo #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+module Symantic.Compta.Lang.Rebindable where
+
+--import Data.Map.Strict (Map)
+--import GHC.Exts (IsList(..))
+--import GHC.Num (Integer)
+--import qualified Control.Monad.Trans.Reader as MT
+--import qualified Data.Time.Clock as Time
+import Control.Applicative (Applicative(..))
+import Control.Monad (Monad(..))
+import Data.Bool (Bool(..))
+import Data.Decimal (Decimal)
+import Data.Foldable (foldr)
+import Data.Function (($), (.), id)
+import Data.Functor (Functor, (<$>))
+import Data.Int (Int)
+import Data.Kind
+import Data.Ratio (Rational)
+import Data.Semigroup (Semigroup(..))
+import Data.String (String)
+import Data.Typeable
+import GHC.Stack
+import GHC.TypeLits (Symbol, ErrorMessage(..))
+import Numeric.Natural (Natural)
+import Prelude (Integer, error)
+import Text.Show (Show(..))
+import qualified Data.List as List
+import qualified Data.String as String
+import qualified Data.Time.Calendar as Time
+import qualified GHC.Exts as GHC
+import qualified Prelude
+
+ifThenElse :: Bool -> a -> a -> a
+ifThenElse True x _ = x
+ifThenElse False _ y = y
+
+-- * Class 'IsString'
+-- | Like 'String.IsString' but with an 'HasCallStack' constraint
+-- to report the location of the 'String'.
+-- This is to be used with the @OverloadedStrings@ and @RebindableSyntax@ extensions
+-- to replace literal strings by this 'fromString'.
+class IsString a where
+ fromString :: HasCallStack => String -> a
+ default fromString ::
+ String.IsString a =>
+ HasCallStack => String -> a
+ fromString = String.fromString
+instance IsString String.String
+
+-- * Class 'FromInteger'
+class FromInteger a where
+ fromInteger :: HasCallStack => Prelude.Integer -> a
+ default fromInteger :: Prelude.Num a => Prelude.Integer -> a
+ fromInteger = Prelude.fromInteger
+instance FromInteger Int
+instance FromInteger Integer
+instance FromInteger Natural
+instance FromInteger Decimal
+
+-- * Class 'FromRational'
+class FromRational a where
+ fromRational :: HasCallStack => Prelude.Rational -> a
+ default fromRational :: Prelude.Fractional a => Prelude.Rational -> a
+ fromRational = Prelude.fromRational
+instance FromRational Decimal
+instance FromRational Rational
+
+-- * Class 'IsList'
+{-
+class IsList a where
+ type Item a :: Type
+ type Item a = GHC.Item a
+ fromList :: HasCallStack => [Item a] -> a
+ fromListN :: HasCallStack => Prelude.Int -> [Item a] -> a
+ toList :: HasCallStack => a -> [Item a]
+ default fromList :: GHC.Item a ~ Item a => GHC.IsList a => [Item a] -> a
+ default fromListN :: GHC.Item a ~ Item a => GHC.IsList a => Prelude.Int -> [Item a] -> a
+ default toList :: GHC.Item a ~ Item a => GHC.IsList a => a -> [Item a]
+ fromList = GHC.fromList
+ fromListN = GHC.fromListN
+ toList = GHC.toList
+instance IsList [a]
+-}
+class Listable repr where
+ cons :: repr a -> repr [a] -> repr [a]
+ nil :: repr [a]
+ concat :: repr [a] -> repr [a] -> repr [a]
+class IsList repr where
+ fromList :: HasCallStack => [repr a] -> repr [a]
+ fromListN :: HasCallStack => Int -> [repr a] -> repr [a]
+ --toList :: HasCallStack => repr [a] -> [repr a]
+ {-
+ default fromList :: GHC.Item a ~ Item a => GHC.IsList a => [Item a] -> a
+ default fromListN :: GHC.Item a ~ Item a => GHC.IsList a => Prelude.Int -> [Item a] -> a
+ default toList :: GHC.Item a ~ Item a => GHC.IsList a => a -> [Item a]
+ fromList = GHC.fromList
+ fromListN = GHC.fromListN
+ toList = GHC.toList
+ -}
+instance Listable repr => IsList repr where
+ fromList = foldr cons nil
+ fromListN n = foldr cons nil
+ --toList = error "toList"
+
+{-
+class Applicative repr where
+ fmap :: (a->b) -> repr a -> repr b
+ pure :: a -> repr a
+ (<*>) :: repr (a->b) -> repr a -> repr b
+ join :: repr (repr a) -> repr a
+-}
--- /dev/null
+module Symantic.Compta.Norm.PCG
+ ( module Symantic.Compta.Norm.PCG.Chart
+ , module Symantic.Compta.Norm.PCG.Journal
+ ) where
+import Symantic.Compta.Norm.PCG.Chart
+import Symantic.Compta.Norm.PCG.Journal
--- /dev/null
+{-# LANGUAGE NoRebindableSyntax #-} -- For []
+{-# LANGUAGE OverloadedLists #-} -- For planDesComptes
+{-# OPTIONS_GHC -Wno-unused-do-bind #-} -- For planDesComptes
+module Symantic.Compta.Norm.PCG.Chart where
+
+import Control.Applicative (Alternative(..))
+import Control.DeepSeq (NFData)
+import Control.Monad (Monad(..))
+import Data.Bool
+import Data.Eq (Eq(..))
+import Data.Function (($))
+import Data.Functor ((<$>))
+import Data.Functor.Identity (Identity(..))
+import Data.Hashable (Hashable)
+import Data.Maybe (Maybe(..))
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (String)
+import GHC.Stack (HasCallStack)
+import Numeric.Natural (Natural)
+import Prelude (divMod, error)
+import Text.Show (Show(..))
+import qualified Control.Monad.Trans.Writer as MT
+--import qualified Control.Monad.Trans.Class as MT
+--import qualified Control.Monad.Trans.Reader as MT
+--import qualified Control.Monad.Trans.State as MT
+import qualified Data.Map.Strict as Map
+
+import Symantic.Compta.Lang
+import Symantic.Compta.Input.Chart
+import qualified Symantic.Compta.Calc.Chart as Chart
+
+-- * Type 'ChartBuilder'
+type ChartBuilder = ChartM ChartSection ChartNode Identity
+
+-- * Type 'Chart'
+type Chart = Chart.Chart ChartSection ChartNode
+
+instance ChartableLeaf Chart ChartBuilder where
+ anySection = return mempty
+instance Chartable Chart ChartSection ChartBuilder where
+ section sct childrenM = ChartM do
+ let (a, (chartNode, children)) =
+ MT.runWriter (unChartM childrenM)
+ MT.tell
+ ( mempty
+ , Chart.Chart (Map.singleton sct (chartNode, children))
+ )
+ return a
+instance Descriptionable ChartBuilder where
+ description desc = ChartM do
+ MT.tell (mempty{sectionDescription=Just desc}, mempty)
+instance Namable ChartBuilder where
+ --name "" = return ()
+ name s = do
+ --n <- fromString s
+ ChartM do
+ MT.tell (mempty{sectionName = Just s}, mempty)
+
+compte ::
+ HasCallStack =>
+ Natural -> System -> String -> String ->
+ ChartBuilder Chart
+compte num chartSectionSystem chartSectionName desc =
+ go (digitsOfNatural num)
+ where
+ go [] = []
+ go [c] = section (AccountCode c) do
+ description desc
+ system chartSectionSystem
+ name chartSectionName
+ []
+ go (c:ds) = section (AccountCode c) (go ds)
+
+-- ** Type 'ChartSection'
+type ChartSection = AccountCode
+{-
+data ChartSection = ChartSection
+ { chartSectionCode :: Natural
+ --, chartSectionName :: String
+ --, chartSectionSystem :: System
+ } deriving (Show)
+instance Eq ChartSection where
+ (==) = (==) `on` chartSectionCode
+instance Ord ChartSection where
+ compare = compare `on` chartSectionCode
+chartSection :: Natural -> ChartSection
+chartSection chartSectionCode = ChartSection
+ { chartSectionCode
+ --, chartSectionName = ""
+ --, chartSectionSystem = SystemDeveloppe
+ }
+-}
+
+-- ** Type 'ChartNode'
+data ChartNode = ChartNode
+ { sectionDescription :: Maybe String
+ , sectionSystem :: Maybe System
+ , sectionName :: Maybe String
+ } deriving (Show)
+instance Semigroup ChartNode where
+ x <> y = ChartNode
+ { sectionDescription = sectionDescription x <|> sectionDescription y
+ , sectionSystem = sectionSystem x <|> sectionSystem y
+ , sectionName = sectionName x <|> sectionName y
+ }
+instance Monoid ChartNode where
+ mempty = ChartNode
+ { sectionDescription = Nothing
+ , sectionSystem = Nothing
+ , sectionName = Nothing
+ }
+
+-- ** Type 'System'
+class Systemable repr where
+ system :: HasCallStack => System -> repr ()
+instance Systemable ChartBuilder where
+ system sys = ChartM do
+ MT.tell (mempty{sectionSystem=Just sys}, mempty)
+data System
+ = SystemDeBase
+ | SystemAbrege
+ | SystemDeveloppe
+ deriving (Eq, Show)
+
+-- ** Type 'ChartEnv'
+newtype ChartEnv = ChartEnv
+ { chartEnvSystem :: System
+ }
+
+-- ** Type 'AccountCode'
+newtype AccountCode = AccountCode Natural
+ deriving newtype (Eq, Ord, Show, Hashable, NFData)
+
+{-
+-- ** Type 'AccountSegment'
+newtype AccountSegment = AccountSegment String
+ deriving newtype (Eq, Ord, Show, Hashable, NFData)
+instance IsString AccountSegment where
+fromString s
+ | _:_ <- s
+ , Foldable.all (\c -> c /= '/' && Char.isAlphaNum c) s
+ = AccountSegment s
+ | otherwise = errorWithStack ("Invalid AccountSegment: "<>show s)
+instance IsString [AccountSegment] where
+ fromString s = go s
+ where
+ go :: String -> [AccountSegment]
+ go inp = fromString got :
+ case rest of
+ [] -> []
+ _:cs -> go cs
+ where
+ (got,rest) = List.break (== '/') inp
+instance IsString (ChartBuilder AccountSegment) where
+ fromString = ChartM . return . fromString
+-}
+
+
+-- | @digitsOfNatural n@ retourne les digits encodant le nombre 'n'.
+digitsOfNatural :: Natural -> [Natural]
+digitsOfNatural n | 0<=n = go [] n
+ | otherwise = error "invalid Int"
+ where go acc j | j == 0 = acc
+ | otherwise = go (r : acc) q
+ where (q,r) = j`divMod`10
+
+chart :: Chart
+chart = runIdentity (runChartM planDesComptes)
+
+-- wget https://www.anc.gouv.fr/files/live/sites/anc/files/contributed/ANC/1_Normes_fran%c3%a7aises/Reglements/Recueils/PCG_Janvier2019/PCG_2019.pdf
+-- pdftohtml -xml PCG_2019.pdf
+-- %s@<text .*height="18"[^>]*><b>Classe *\(\d*\) *: *\(\( *[^ <]\+\)\+\).*@compte \1 SystemAbrege "\2"@
+-- %s@<text .*height="18"[^>]*><b>\(\d*\) *[-–] *\(\( *[^ <]\+\)\+\).*@compte SystemAbrege \1 "\2"@
+-- %s@<text .*height="18"[^>]*>\(\d*\) *[-–] *\(\( *[^ <]\+\)\+\).*@compte \1 SystemDeBase "\2"@
+-- %s@<text .*height="19"[^>]*>\(\d*\) *[-–] *\(\( *[^ <]\+\)\+\).*@compte \1 SystemDeveloppe "\2"@
+-- %s@ *@ @g
+
+planDesComptes :: ChartBuilder Chart
+planDesComptes =
+ -- Note: using the list-notation instead of
+ -- the do-notation to avoid over-stressing GHC's simplifier
+ -- with a big number of bindings.
+ [ compte 1 SystemAbrege "" "Comptes de capitaux"
+ , compte 10 SystemDeBase "" "Capital et réserves"
+ , compte 101 SystemAbrege "" "Capital"
+ , compte 1011 SystemDeveloppe "" "Capital souscrit - non appelé"
+ , compte 1012 SystemDeveloppe "" "Capital souscrit - appelé, non versé"
+ , compte 1013 SystemDeveloppe "" "Capital souscrit - appelé, versé"
+ , compte 10131 SystemDeveloppe "" "Capital non amorti"
+ , compte 10132 SystemDeveloppe "" "Capital amorti"
+ , compte 1018 SystemDeveloppe "" "Capital souscrit soumis à des réglementations particulières"
+ , compte 102 SystemDeBase "" "Fonds fiduciaires"
+ , compte 104 SystemDeBase "" "Primes liées au capital social"
+ , compte 1041 SystemDeveloppe "" "Primes d'émission"
+ , compte 1042 SystemDeveloppe "" "Primes de fusion"
+ , compte 1043 SystemDeveloppe "" "Primes d'apport"
+ , compte 1044 SystemDeveloppe "" "Primes de conversion d'obligations en actions"
+ , compte 1045 SystemDeveloppe "" "Bons de souscription d'actions"
+ , compte 105 SystemAbrege "" "Ecarts de réévaluation"
+ , compte 1051 SystemDeveloppe "" "Réserve spéciale de réévaluation"
+ , compte 1052 SystemDeveloppe "" "Ecart de réévaluation libre"
+ , compte 1053 SystemDeveloppe "" "Réserve de réévaluation"
+ , compte 1055 SystemDeveloppe "" "Ecarts de réévaluation (autres opérations légales)"
+ , compte 1057 SystemDeveloppe "" "Autres écarts de réévaluation en France"
+ , compte 1058 SystemDeveloppe "" "Autres écarts de réévaluation à l'Etranger"
+ , compte 106 SystemDeBase "" "Réserves"
+ , compte 1061 SystemAbrege "" "Réserve légale"
+ , compte 10611 SystemDeveloppe "" "Réserve légale proprement dite"
+ , compte 10612 SystemDeveloppe "" "Plus-values nettes à long terme"
+ , compte 1062 SystemDeBase "" "Réserves indisponibles"
+ , compte 1063 SystemAbrege "" "Réserves statutaires ou contractuelles"
+ , compte 1064 SystemAbrege "" "Réserves réglementées"
+ , compte 10641 SystemDeveloppe "" "Plus-values nettes à long terme"
+ , compte 10643 SystemDeveloppe "" "Réserves consécutives à l'octroi de subventions d'investissement"
+ , compte 10648 SystemDeveloppe "" "Autres réserves réglementées"
+ , compte 1068 SystemAbrege "" "Autres réserves"
+ , compte 10681 SystemDeveloppe "" "Réserve de propre assureur"
+ , compte 10688 SystemDeveloppe "" "Réserves diverses"
+ , compte 107 SystemDeBase "" "Ecart d'équivalence"
+ , compte 108 SystemAbrege "" ", compte de l'exploitant"
+ , compte 109 SystemDeBase "" "Actionnaires : Capital souscrit - non appelé"
+ , compte 11 SystemDeBase "" "Report à nouveau (solde créditeur ou débiteur)"
+ , compte 110 SystemDeveloppe "" "Report à nouveau (solde créditeur)"
+ , compte 119 SystemDeveloppe "" "Report à nouveau (solde débiteur)"
+ , compte 12 SystemAbrege "" "Résultat de l'exercice (bénéfice ou perte)"
+ , compte 120 SystemDeveloppe "" "Résultat de l'exercice (bénéfice)"
+ , compte 129 SystemDeveloppe "" "Résultat de l'exercice (perte)"
+ , compte 13 SystemDeBase "" "Subventions d'investissement"
+ , compte 131 SystemDeBase "" "Subventions d'équipement"
+ , compte 1311 SystemDeveloppe "" "Etat"
+ , compte 1312 SystemDeveloppe "" "Régions"
+ , compte 1313 SystemDeveloppe "" "Départements"
+ , compte 1314 SystemDeveloppe "" "Communes"
+ , compte 1315 SystemDeveloppe "" "Collectivités publiques"
+ , compte 1316 SystemDeveloppe "" "Entreprises publiques"
+ , compte 1317 SystemDeveloppe "" "Entreprises et organismes privés"
+ , compte 1318 SystemDeveloppe "" "Autres"
+ , compte 138 SystemDeBase "" "Autres subventions d’investissement (même ventilation que celle du , compte 131)"
+ , compte 139 SystemDeBase "" "Subventions d'investissement inscrites au , compte de résultat"
+ , compte 1391 SystemDeBase "" "Subventions d'équipement"
+ , compte 13911 SystemDeveloppe "" "Etat"
+ , compte 13912 SystemDeveloppe "" "Régions"
+ , compte 13913 SystemDeveloppe "" "Départements"
+ , compte 13914 SystemDeveloppe "" "Communes"
+ , compte 13915 SystemDeveloppe "" "Collectivités publiques"
+ , compte 13916 SystemDeveloppe "" "Entreprises publiques"
+ , compte 13917 SystemDeveloppe "" "Entreprises et organismes privés"
+ , compte 13918 SystemDeveloppe "" "Autres"
+ , compte 1398 SystemDeBase "" "Autres subventions d’investissement (même ventilation que celle du , compte 1391)"
+ , compte 14 SystemDeBase "" "Provisions réglementées"
+ , compte 142 SystemDeBase "" "Provisions réglementées relatives aux immobilisations"
+ , compte 1423 SystemDeveloppe "" "Provisions pour reconstitution des gisements miniers et pétroliers"
+ , compte 1424 SystemDeveloppe "" "Provisions pour investissement (participation des salariés)"
+ , compte 143 SystemDeBase "" "Provisions réglementées relatives aux stocks"
+ , compte 1431 SystemDeveloppe "" "Hausse des prix"
+ , compte 1432 SystemDeveloppe "" "Fluctuation des cours"
+ , compte 144 SystemDeBase "" "Provisions réglementées relatives aux autres éléments de l'actif"
+ , compte 145 SystemAbrege "" "Amortissements dérogatoires"
+ , compte 146 SystemAbrege "" "Provision spéciale de réévaluation"
+ , compte 147 SystemAbrege "" "Plus-values réinvesties"
+ , compte 148 SystemAbrege "" "Autres provisions réglementées"
+ , compte 15 SystemAbrege "" "Provisions"
+ , compte 151 SystemDeBase "" "Provisions pour risques"
+ , compte 1511 SystemDeveloppe "" "Provisions pour litiges"
+ , compte 1512 SystemDeveloppe "" "Provisions pour garanties données aux clients"
+ , compte 1513 SystemDeveloppe "" "Provisions pour pertes sur marchés à terme"
+ , compte 1514 SystemDeveloppe "" "Provisions pour amendes et pénalités"
+ , compte 1515 SystemDeveloppe "" "Provisions pour pertes de change"
+ , compte 1516 SystemDeveloppe "" "Provisions pour pertes sur contrats"
+ , compte 1518 SystemDeveloppe "" "Autres provisions pour risques"
+ , compte 153 SystemDeBase "" "Provisions pour pensions et obligations similaires"
+ , compte 154 SystemDeBase "" "Provisions pour restructurations"
+ , compte 155 SystemDeBase "" "Provisions pour impôts"
+ , compte 156 SystemDeBase "" "Provisions pour renouvellement des immobilisations (entreprises concessionnaires)"
+ , compte 157 SystemDeBase "" "Provisions pour charges à répartir sur plusieurs exercices"
+ , compte 1572 SystemDeveloppe "" "Provisions pour gros entretien ou grandes révisions"
+ , compte 158 SystemDeBase "" "Autres provisions pour charges"
+ , compte 1581 SystemDeveloppe "" "Provisions pour remises en état"
+ , compte 16 SystemAbrege "" "Emprunts et dettes assimilées"
+ , compte 161 SystemDeBase "" "Emprunts obligataires convertibles"
+ , compte 162 SystemDeBase "" "Obligations représentatives de passifs nets remis en fiducie"
+ , compte 163 SystemDeBase "" "Autres emprunts obligataires"
+ , compte 164 SystemDeBase "" "Emprunts auprès des établissements de crédit"
+ , compte 165 SystemDeBase "" "Dépôts et cautionnements reçus"
+ , compte 1651 SystemDeveloppe "" "Dépôts"
+ , compte 1655 SystemDeveloppe "" "Cautionnements"
+ , compte 166 SystemDeveloppe "" "Participation des salariés aux résultats"
+ , compte 1661 SystemDeveloppe "" "Comptes bloqués"
+ , compte 1662 SystemDeveloppe "" "Fonds de participation"
+ , compte 167 SystemDeBase "" "Emprunts et dettes assortis de conditions particulières"
+ , compte 1671 SystemDeBase "" "Emissions de titres participatifs"
+ , compte 1674 SystemDeBase "" "Avances conditionnées de l'Etat"
+ , compte 1675 SystemDeBase "" "Emprunts participatifs"
+ , compte 168 SystemDeBase "" "Autres emprunts et dettes assimilées"
+ , compte 1681 SystemDeveloppe "" "Autres emprunts"
+ , compte 1685 SystemDeveloppe "" "Rentes viagères capitalisées"
+ , compte 1687 SystemDeveloppe "" "Autres dettes"
+ , compte 1688 SystemDeveloppe "" "Intérêts courus"
+ , compte 16881 SystemDeveloppe "" "sur emprunts obligataires convertibles"
+ , compte 16883 SystemDeveloppe "" "sur autres emprunts obligataires"
+ , compte 16884 SystemDeveloppe "" "sur emprunts auprès des établissements de crédit"
+ , compte 16885 SystemDeveloppe "" "sur dépôts et cautionnements reçus"
+ , compte 16886 SystemDeveloppe "" "sur participation des salariés aux résultats"
+ , compte 16887 SystemDeveloppe "" "sur emprunts et dettes assortis de conditions particulières"
+ , compte 16888 SystemDeveloppe "" "sur autres emprunts et dettes assimilées"
+ , compte 169 SystemDeBase "" "Primes de remboursement des obligations"
+ , compte 17 SystemDeBase "" "Dettes rattachées à des participations"
+ , compte 171 SystemDeBase "" "Dettes rattachées à des participations (groupe)"
+ , compte 174 SystemDeBase "" "Dettes rattachées à des participations (hors groupe)"
+ , compte 178 SystemDeBase "" "Dettes rattachées à des sociétés en participation"
+ , compte 1781 SystemDeveloppe "" "Principal"
+ , compte 1788 SystemDeveloppe "" "Intérêts courus"
+ , compte 18 SystemDeBase "" "Comptes de liaison des établissements et sociétés en participation"
+ , compte 181 SystemDeveloppe "" "Comptes de liaison des établissements"
+ , compte 186 SystemDeveloppe "" "Biens et prestations de services échangés entre établissements (charges)"
+ , compte 187 SystemDeveloppe "" "Biens et prestations de services échangés entre établissements (produits)"
+ , compte 188 SystemDeveloppe "" "Comptes de liaison des sociétés en participation"
+ , compte 2 SystemAbrege "" "Comptes d’immobilisations"
+ , compte 20 SystemAbrege "" "Immobilisations incorporelles"
+ , compte 201 SystemAbrege "" "Frais d'établissement"
+ , compte 2011 SystemDeveloppe "" "Frais de constitution"
+ , compte 2012 SystemDeveloppe "" "Frais de premier établissement"
+ , compte 20121 SystemDeveloppe "" "Frais de prospection"
+ , compte 20122 SystemDeveloppe "" "Frais de publicité"
+ , compte 2013 SystemDeveloppe "" "Frais d'augmentation de capital et d'opérations diverses (fusions, scissions, transformations)"
+ , compte 203 SystemDeBase "" "Frais de recherche et de développement"
+ , compte 205 SystemDeBase "" "Concessions et droits similaires, brevets, licences, marques, procédés, logiciels, droits et valeurs similaires"
+ , compte 206 SystemAbrege "" "Droit au bail"
+ , compte 207 SystemAbrege "" "Fonds commercial"
+ , compte 208 SystemAbrege "" "Autres immobilisations incorporelles"
+ , compte 2081 SystemDeBase "" "Mali de fusion sur actifs incorporels"
+ , compte 21 SystemAbrege "" "Immobilisations corporelles"
+ , compte 211 SystemDeBase "" "Terrains"
+ , compte 2111 SystemDeBase "" "Terrains nus"
+ , compte 2112 SystemDeBase "" "Terrains aménagés"
+ , compte 2113 SystemDeBase "" "Sous - sols et sursols"
+ , compte 2114 SystemDeBase "" "Terrains de carrières (Tréfonds)"
+ , compte 2115 SystemDeBase "" "Terrains bâtis"
+ , compte 21151 SystemDeveloppe "" "Ensembles immobiliers industriels (A, B)"
+ , compte 21155 SystemDeveloppe "" "Ensembles immobiliers administratifs et commerciaux (A, B)"
+ , compte 21158 SystemDeveloppe "" "Autres ensembles immobiliers"
+ , compte 211581 SystemDeveloppe "" "affectés aux opérations professionnelles (A, B)"
+ , compte 211588 SystemDeveloppe "" "affectés aux opérations non professionnelles (A, B)"
+ , compte 2116 SystemDeBase "" ", compte d'ordre sur immobilisations"
+ , compte 212 SystemDeBase "" "Agencements et aménagements de terrains (même ventilation que celle du , compte 211)"
+ , compte 213 SystemDeBase "" "Constructions"
+ , compte 2131 SystemDeBase "" "Bâtiments"
+ , compte 21311 SystemDeveloppe "" "Ensembles immobiliers industriels (A, B)"
+ , compte 21315 SystemDeveloppe "" "Ensembles immobiliers administratifs et commerciaux (A, B)"
+ , compte 21318 SystemDeveloppe "" "Autres ensembles immobiliers"
+ , compte 213181 SystemDeveloppe "" "affectés aux opérations professionnelles (A, B)"
+ , compte 213188 SystemDeveloppe "" "affectés aux opérations non professionnelles (A, B)"
+ , compte 2135 SystemDeBase "" "Installations générales - agencements – aménagements des constructions"
+ , compte 21351 SystemDeveloppe "" "Ensembles immobiliers industriels (A, B)"
+ , compte 21355 SystemDeveloppe "" "Ensembles immobiliers administratifs et commerciaux (A, B)"
+ , compte 21358 SystemDeveloppe "" "Autres ensembles immobiliers"
+ , compte 213581 SystemDeveloppe "" "affectés aux opérations professionnelles (A, B)"
+ , compte 213588 SystemDeveloppe "" "affectés aux opérations non professionnelles (A, B)"
+ , compte 2138 SystemDeBase "" "Ouvrages d'infrastructure"
+ , compte 21381 SystemDeveloppe "" "Voies de terre"
+ , compte 21382 SystemDeveloppe "" "Voies de fer"
+ , compte 21383 SystemDeveloppe "" "Voies d'eau"
+ , compte 21384 SystemDeveloppe "" "Barrages"
+ , compte 21385 SystemDeveloppe "" "Pistes d'aérodromes"
+ , compte 214 SystemDeBase "" "Constructions sur sol d'autrui (même ventilation que celle du , compte 213)"
+ , compte 215 SystemDeBase "" "Installations techniques, matériels et outillage industriels"
+ , compte 2151 SystemDeBase "" "Installations complexes spécialisées"
+ , compte 21511 SystemDeveloppe "" "sur sol propre"
+ , compte 21514 SystemDeveloppe "" "sur sol d'autrui"
+ , compte 2153 SystemDeBase "" "Installations à caractère spécifique"
+ , compte 21531 SystemDeveloppe "" "sur sol propre"
+ , compte 21534 SystemDeveloppe "" "sur sol d'autrui"
+ , compte 2154 SystemDeBase "" "Matériel industriel"
+ , compte 2155 SystemDeBase "" "Outillage industriel"
+ , compte 2157 SystemDeBase "" "Agencements et aménagements du matériel et outillage industriels"
+ , compte 218 SystemDeBase "" "Autres immobilisations corporelles"
+ , compte 2181 SystemDeBase "" "Installations générales, agencements, aménagements divers"
+ , compte 2182 SystemDeBase "" "Matériel de transport"
+ , compte 2183 SystemDeBase "" "Matériel de bureau et matériel informatique"
+ , compte 2184 SystemDeBase "" "Mobilier"
+ , compte 2185 SystemDeBase "" "Cheptel"
+ , compte 2186 SystemDeBase "" "Emballages récupérables"
+ , compte 2187 SystemDeBase "" "Mali de fusions sur actifs corporels"
+ , compte 22 SystemDeBase "" "Immobilisations mises en concession"
+ , compte 23 SystemAbrege "" "Immobilisations en cours"
+ , compte 231 SystemDeBase "" "Immobilisations corporelles en cours"
+ , compte 2312 SystemDeveloppe "" "Terrains"
+ , compte 2313 SystemDeveloppe "" "Constructions"
+ , compte 2315 SystemDeveloppe "" "Installations techniques, matériel et outillage industriels"
+ , compte 2318 SystemDeveloppe "" "Autres immobilisations corporelles"
+ , compte 232 SystemDeBase "" "Immobilisations incorporelles en cours"
+ , compte 237 SystemDeBase "" "Avances et acomptes versés sur immobilisations incorporelles"
+ , compte 238 SystemDeBase "" "Avances et acomptes versés sur commandes d'immobilisations corporelles"
+ , compte 2382 SystemDeveloppe "" "Terrains"
+ , compte 2383 SystemDeveloppe "" "Constructions"
+ , compte 2385 SystemDeveloppe "" "Installations techniques, matériel et outillage industriels"
+ , compte 2388 SystemDeBase "" "Autres immobilisations corporelles"
+ , compte 25 SystemDeBase "" "Parts dans des entreprises liées et créances sur des entreprises liées"
+ , compte 26 SystemDeBase "" "Participations et créances rattachées à des participations"
+ , compte 261 SystemDeBase "" "Titres de participation"
+ , compte 2611 SystemDeveloppe "" "Actions"
+ , compte 2618 SystemDeveloppe "" "Autres titres"
+ , compte 266 SystemDeBase "" "Autres formes de participation"
+ , compte 2661 SystemDeveloppe "" "Droits représentatifs d’actifs nets remis en fiducie"
+ , compte 267 SystemDeBase "" "Créances rattachées à des participations"
+ , compte 2671 SystemDeveloppe "" "Créances rattachées à des participations (groupe)"
+ , compte 2674 SystemDeveloppe "" "Créances rattachées à des participations (hors groupe)"
+ , compte 2675 SystemDeveloppe "" "Versements représentatifs d'apports non capitalisés (appel de fonds)"
+ , compte 2676 SystemDeveloppe "" "Avances consolidables"
+ , compte 2677 SystemDeveloppe "" "Autres créances rattachées à des participations"
+ , compte 2678 SystemDeveloppe "" "Intérêts courus"
+ , compte 268 SystemDeBase "" "Créances rattachées à des sociétés en participation"
+ , compte 2681 SystemDeveloppe "" "Principal"
+ , compte 2688 SystemDeveloppe "" "Intérêts courus"
+ , compte 269 SystemDeBase "" "Versements restant à effectuer sur titres de participation non libérés"
+ , compte 27 SystemAbrege "" "Autres immobilisations financières"
+ , compte 271 SystemDeBase "" "Titres immobilisés autres que les titres immobilisés de l'activité de portefeuille (droit de propriété)"
+ , compte 2711 SystemDeveloppe "" "Actions"
+ , compte 2718 SystemDeveloppe "" "Autres titres"
+ , compte 272 SystemDeBase "" "Titres immobilisés (droit de créance)"
+ , compte 2721 SystemDeveloppe "" "Obligations"
+ , compte 2722 SystemDeveloppe "" "Bons"
+ , compte 273 SystemDeBase "" "Titres immobilisés de l'activité de portefeuille"
+ , compte 274 SystemDeBase "" "Prêts"
+ , compte 2741 SystemDeveloppe "" "Prêts participatifs"
+ , compte 2742 SystemDeveloppe "" "Prêts aux associés"
+ , compte 2743 SystemDeveloppe "" "Prêts au personnel"
+ , compte 2748 SystemDeveloppe "" "Autres prêts"
+ , compte 275 SystemDeBase "" "Dépôts et cautionnements versés"
+ , compte 2751 SystemDeveloppe "" "Dépôts"
+ , compte 2755 SystemDeveloppe "" "Cautionnements"
+ , compte 276 SystemDeBase "" "Autres créances immobilisées"
+ , compte 2761 SystemDeveloppe "" "Créances diverses"
+ , compte 2768 SystemDeveloppe "" "Intérêts courus"
+ , compte 27682 SystemDeveloppe "" "sur titres immobilisés (droit de créance)"
+ , compte 27684 SystemDeveloppe "" "sur prêts"
+ , compte 27685 SystemDeveloppe "" "sur dépôts et cautionnements"
+ , compte 27688 SystemDeveloppe "" "sur créances diverses"
+ , compte 277 SystemDeBase "" "(Actions propres ou parts propres)"
+ , compte 2771 SystemDeveloppe "" "Actions propres ou parts propres"
+ , compte 2772 SystemDeveloppe "" "Actions propres ou parts propres en voie d’annulation"
+ , compte 278 SystemDeBase "" "Mali de fusion sur actifs financiers"
+ , compte 279 SystemDeBase "" "Versements restant à effectuer sur titres immobilisés non libérés"
+ , compte 28 SystemDeBase "" "Amortissements des immobilisations"
+ , compte 280 SystemAbrege "" "Amortissements des immobilisations incorporelles"
+ , compte 2801 SystemDeBase "" "Frais d'établissement (même ventilation que celle du , compte 201)"
+ , compte 2803 SystemDeBase "" "Frais de recherche et de développement"
+ , compte 2805 SystemDeBase "" "Concessions et droits similaires, brevets, licences, logiciels, droits et valeurs similaires"
+ , compte 2807 SystemDeBase "" "Fonds commercial"
+ , compte 2808 SystemDeBase "" "Autres immobilisations incorporelles"
+ , compte 28081 SystemDeBase "" "Amortissements du mali de fusion sur actifs incorporels"
+ , compte 281 SystemAbrege "" "Amortissements des immobilisations corporelles"
+ , compte 2812 SystemDeBase "" "Agencements, aménagements de terrains (même ventilation que celle du , compte 212)"
+ , compte 2813 SystemDeBase "" "Constructions (même ventilation que celle du , compte 213)"
+ , compte 2814 SystemDeBase "" "Constructions sur sol d'autrui (même ventilation que celle du , compte 214)"
+ , compte 2815 SystemDeBase "" "Installations, matériel et outillage industriels (même ventilation que celle du , compte 215)"
+ , compte 2818 SystemDeBase "" "Autres immobilisations corporelles (même ventilation que celle du , compte 218)"
+ , compte 28187 SystemDeBase "" "Amortissement du mali de fusion sur actifs corporels"
+ , compte 282 SystemDeBase "" "Amortissements des immobilisations mises en concession"
+ , compte 29 SystemDeBase "" "Dépréciations des immobilisations"
+ , compte 290 SystemAbrege "" "Dépréciations des immobilisations incorporelles"
+ , compte 2905 SystemDeBase "" "Marques, procédés, droits et valeurs similaires"
+ , compte 2906 SystemDeBase "" "Droit au bail"
+ , compte 2907 SystemDeBase "" "Fonds commercial"
+ , compte 2908 SystemDeBase "" "Autres immobilisations incorporelles"
+ , compte 29081 SystemDeBase "" "Dépréciation du mali de fusion sur actifs incorporels"
+ , compte 291 SystemAbrege "" "Dépréciations des immobilisations corporelles (même ventilation que celle du , compte 21)"
+ , compte 29187 SystemDeBase "" "Dépréciation du mali de fusion sur actifs corporels"
+ , compte 292 SystemDeBase "" "Dépréciations des immobilisations mises en concession"
+ , compte 293 SystemDeBase "" "Dépréciations des immobilisations en cours"
+ , compte 2931 SystemDeBase "" "Immobilisations corporelles en cours"
+ , compte 2932 SystemDeBase "" "Immobilisations incorporelles en cours"
+ , compte 296 SystemDeBase "" "Dépréciations des participations et créances rattachées à des participations"
+ , compte 2961 SystemDeBase "" "Titres de participation"
+ , compte 2966 SystemDeBase "" "Autres formes de participation"
+ , compte 2967 SystemDeBase "" "Créances rattachées à des participations (même ventilation que celle du , compte 267)"
+ , compte 2968 SystemDeBase "" "Créances rattachées à des sociétés en participation (même ventilation que celle du , compte 268)"
+ , compte 297 SystemAbrege "" "Dépréciations des autres immobilisations financières"
+ , compte 2971 SystemDeBase "" "Titres immobilisés autres que les titres immobilisés de l'activité de portefeuille – droit de propriété (même ventilation que celle du , compte 271)"
+ , compte 2972 SystemDeBase "" "Droit de créance (même ventilation que celle du , compte 272)"
+ , compte 2973 SystemDeBase "" "Titres immobilisés de l'activité de portefeuille"
+ , compte 2974 SystemDeBase "" "Prêts (même ventilation que celle du , compte 274)"
+ , compte 2975 SystemDeBase "" "Dépôts et cautionnements versés (même ventilation que celle du , compte 275)"
+ , compte 2976 SystemDeBase "" "Autres créances immobilisées (même ventilation que celle du , compte 276)"
+ , compte 29787 SystemDeBase "" "Dépréciation du mali de fusion sur actifs financiers"
+ , compte 3 SystemAbrege "" "Comptes de stocks et en-cours"
+ , compte 31 SystemAbrege "" "Matières premières (et fournitures)"
+ , compte 311 SystemDeBase "" "Matières (ou groupe) A"
+ , compte 312 SystemDeBase "" "Matières (ou groupe) B"
+ , compte 317 SystemDeBase "" "Fournitures A, B, C,"
+ , compte 32 SystemAbrege "" "Autres approvisionnements"
+ , compte 321 SystemDeBase "" "Matières consommables"
+ , compte 3211 SystemDeveloppe "" "Matières (ou groupe) C"
+ , compte 3212 SystemDeveloppe "" "Matières (ou groupe) D"
+ , compte 322 SystemDeBase "" "Fournitures consommables"
+ , compte 3221 SystemDeveloppe "" "Combustibles"
+ , compte 3222 SystemDeveloppe "" "Produits d'entretien"
+ , compte 3223 SystemDeveloppe "" "Fournitures d'atelier et d'usine"
+ , compte 3224 SystemDeveloppe "" "Fournitures de magasin"
+ , compte 3225 SystemDeveloppe "" "Fournitures de bureau"
+ , compte 326 SystemDeBase "" "Emballages"
+ , compte 3261 SystemDeveloppe "" "Emballages perdus"
+ , compte 3265 SystemDeveloppe "" "Emballages récupérables non identifiables"
+ , compte 3267 SystemDeveloppe "" "Emballages à usage mixte"
+ , compte 33 SystemAbrege "" "En-cours de production de biens"
+ , compte 331 SystemDeBase "" "Produits en cours"
+ , compte 3311 SystemDeveloppe "" "Produits en cours P 1"
+ , compte 3312 SystemDeveloppe "" "Produits en cours P 2"
+ , compte 335 SystemDeBase "" "Travaux en cours"
+ , compte 3351 SystemDeveloppe "" "Travaux en cours T 1"
+ , compte 3352 SystemDeveloppe "" "Travaux en cours T 2"
+ , compte 34 SystemAbrege "" "En-cours de production de services"
+ , compte 341 SystemDeBase "" "Etudes en cours"
+ , compte 3411 SystemDeveloppe "" "Etudes en cours E 1"
+ , compte 3412 SystemDeveloppe "" "Etudes en cours E 2"
+ , compte 345 SystemDeBase "" "Prestations de services en cours"
+ , compte 3451 SystemDeveloppe "" "Prestations de services S 1"
+ , compte 3452 SystemDeveloppe "" "Prestations de services S 2"
+ , compte 35 SystemAbrege "" "Stocks de produits"
+ , compte 351 SystemDeBase "" "Produits intermédiaires"
+ , compte 3511 SystemDeveloppe "" "Produits intermédiaires (ou groupe) A"
+ , compte 3512 SystemDeveloppe "" "Produits intermédiaires (ou groupe) B"
+ , compte 355 SystemDeBase "" "Produits finis"
+ , compte 3551 SystemDeveloppe "" "Produits finis (ou groupe) A"
+ , compte 3552 SystemDeveloppe "" "Produits finis (ou groupe) B"
+ , compte 358 SystemDeBase "" "Produits résiduels (ou matières de récupération)"
+ , compte 3581 SystemDeveloppe "" "Déchets"
+ , compte 3585 SystemDeveloppe "" "Rebuts"
+ , compte 3586 SystemDeveloppe "" "Matières de récupération"
+ , compte 36 SystemDeBase "" "(, compte à ouvrir, le cas échéant, sous l'intitulé \"Stocks provenant d'immobilisations\")"
+ , compte 37 SystemAbrege "" "Stocks de marchandises"
+ , compte 371 SystemDeveloppe "" "Marchandises (ou groupe) A"
+ , compte 372 SystemDeveloppe "" "Marchandises (ou groupe) B"
+ , compte 38 SystemDeBase "" "(lorsque l'entité tient un inventaire permanent en comptabilité générale, le , compte 38 peut être utilisé pour comptabiliser les stocks en voie d'acheminement, mis en dépôt ou donnés en consignation)"
+ , compte 39 SystemDeBase "" "Dépréciations des stocks et en-cours"
+ , compte 391 SystemAbrege "" "Dépréciations des matières premières (et fournitures)"
+ , compte 3911 SystemDeveloppe "" "Matières (ou groupe) A"
+ , compte 3912 SystemDeveloppe "" "Matières (ou groupe) B"
+ , compte 3917 SystemDeveloppe "" "Fournitures A, B, C,"
+ , compte 392 SystemAbrege "" "Dépréciations des autres approvisionnements"
+ , compte 3921 SystemDeveloppe "" "Matières consommables (même ventilation que celle du , compte 321)"
+ , compte 3922 SystemDeveloppe "" "Fournitures consommables (même ventilation que celle du , compte 322)"
+ , compte 3926 SystemDeveloppe "" "Emballages (même ventilation que celle du , compte 326)"
+ , compte 393 SystemAbrege "" "Dépréciations des en-cours de production de biens"
+ , compte 3931 SystemDeveloppe "" "Produits en cours (même ventilation que celle du , compte 331)"
+ , compte 3935 SystemDeveloppe "" "Travaux en cours (même ventilation que celle du , compte 335)"
+ , compte 394 SystemAbrege "" "Dépréciations des en-cours de production de services"
+ , compte 3941 SystemDeveloppe "" "Etudes en cours (même ventilation que celle du , compte 341)"
+ , compte 3945 SystemDeveloppe "" "Prestations de services en cours (même ventilation que celle du , compte 345)"
+ , compte 395 SystemAbrege "" "Dépréciations des stocks de produits"
+ , compte 3951 SystemDeveloppe "" "Produits intermédiaires (même ventilation que celle du , compte 351)"
+ , compte 3955 SystemDeveloppe "" "Produits finis (même ventilation que celle du , compte 355)"
+ , compte 397 SystemAbrege "" "Dépréciations des stocks de marchandises"
+ , compte 3971 SystemDeveloppe "" "Marchandise (ou groupe) A"
+ , compte 3972 SystemDeveloppe "" "Marchandise (ou groupe) B"
+ , compte 4 SystemAbrege "" "Comptes de tiers"
+ , compte 40 SystemDeBase "" "Fournisseurs et comptes rattachés"
+ , compte 400 SystemAbrege "" "Fournisseurs et comptes rattachés"
+ , compte 401 SystemDeBase "" "Fournisseurs"
+ , compte 4011 SystemDeveloppe "" "Fournisseurs - Achats de biens et prestations de services"
+ , compte 4017 SystemDeveloppe "" "Fournisseurs - Retenues de garantie"
+ , compte 403 SystemDeBase "" "Fournisseurs - Effets à payer"
+ , compte 404 SystemDeBase "" "Fournisseurs d'immobilisations"
+ , compte 4041 SystemDeveloppe "" "Fournisseurs - Achats d'immobilisations"
+ , compte 4047 SystemDeveloppe "" "Fournisseurs d'immobilisations – Retenues de garantie"
+ , compte 405 SystemDeBase "" "Fournisseurs d'immobilisations - Effets à payer"
+ , compte 408 SystemDeBase "" "Fournisseurs - Factures non parvenues"
+ , compte 4081 SystemDeveloppe "" "Fournisseurs"
+ , compte 4084 SystemDeveloppe "" "Fournisseurs d'immobilisations"
+ , compte 4088 SystemDeveloppe "" "Fournisseurs – Intérêts courus"
+ , compte 409 SystemAbrege "" "Fournisseurs débiteurs"
+ , compte 4091 SystemDeBase "" "Fournisseurs - Avances et acomptes versés sur commandes"
+ , compte 4096 SystemDeBase "" "Fournisseurs - Créances pour emballages et matériel à rendre"
+ , compte 4097 SystemDeBase "" "Fournisseurs - Autres avoirs"
+ , compte 40971 SystemDeveloppe "" "Fournisseurs d'exploitation"
+ , compte 40974 SystemDeveloppe "" "Fournisseurs d'immobilisations"
+ , compte 4098 SystemDeBase "" "Rabais, remises, ristournes à obtenir et autres avoirs non encore reçus"
+ , compte 41 SystemDeBase "" "Clients et comptes rattachés"
+ , compte 410 SystemAbrege "" "Clients et comptes rattachés"
+ , compte 411 SystemDeBase "" "Clients"
+ , compte 4111 SystemDeveloppe "" "Clients - Ventes de biens ou de prestations de services"
+ , compte 4117 SystemDeveloppe "" "Clients - Retenues de garantie"
+ , compte 413 SystemDeBase "" "Clients - Effets à recevoir"
+ , compte 416 SystemDeBase "" "Clients douteux ou litigieux"
+ , compte 418 SystemDeBase "" "Clients - Produits non encore facturés"
+ , compte 4181 SystemDeveloppe "" "Clients - Factures à établir"
+ , compte 4188 SystemDeveloppe "" "Clients - Intérêts courus"
+ , compte 419 SystemAbrege "" "Clients créditeurs"
+ , compte 4191 SystemDeBase "" "Clients - Avances et acomptes reçus sur commandes"
+ , compte 4196 SystemDeBase "" "Clients - Dettes sur emballages et matériels consignés"
+ , compte 4197 SystemDeBase "" "Clients - Autres avoirs"
+ , compte 4198 SystemDeBase "" "Rabais, remises, ristournes à accorder et autres avoirs à établir"
+ , compte 42 SystemDeBase "" "Personnel et comptes rattachés"
+ , compte 421 SystemAbrege "" "Personnel - Rémunérations dues"
+ , compte 422 SystemDeBase "" "Comités d'entreprises, d'établissement, …"
+ , compte 424 SystemDeBase "" "Participation des salariés aux résultats"
+ , compte 4246 SystemDeveloppe "" "Réserve spéciale"
+ , compte 4248 SystemDeveloppe "" "Comptes courants"
+ , compte 425 SystemDeBase "" "Personnel - Avances et acomptes"
+ , compte 426 SystemDeBase "" "Personnel - Dépôts"
+ , compte 427 SystemDeBase "" "Personnel - Oppositions"
+ , compte 428 SystemAbrege "" "Personnel - Charges à payer et produits à recevoir"
+ , compte 4282 SystemDeveloppe "" "Dettes provisionnées pour congés à payer"
+ , compte 4284 SystemDeveloppe "" "Dettes provisionnées pour participation des salariés aux résultats"
+ , compte 4286 SystemDeveloppe "" "Autres charges à payer"
+ , compte 4287 SystemDeveloppe "" "Produits à recevoir"
+ , compte 43 SystemAbrege "" "Sécurité sociale et autres organismes sociaux"
+ , compte 431 SystemDeBase "" "Sécurité sociale"
+ , compte 437 SystemDeBase "" "Autres organismes sociaux"
+ , compte 438 SystemDeBase "" "Organismes sociaux - Charges à payer et produits à recevoir"
+ , compte 4382 SystemDeveloppe "" "Charges sociales sur congés à payer"
+ , compte 4386 SystemDeveloppe "" "Autres charges à payer"
+ , compte 4387 SystemDeveloppe "" "Produits à recevoir"
+ , compte 44 SystemDeBase "" "État et autres collectivités publiques"
+ , compte 441 SystemDeBase "" "État - Subventions à recevoir"
+ , compte 4411 SystemDeveloppe "" "Subventions d'investissement"
+ , compte 4417 SystemDeveloppe "" "Subventions d'exploitation"
+ , compte 4418 SystemDeveloppe "" "Subventions d'équilibre"
+ , compte 4419 SystemDeveloppe "" "Avances sur subventions"
+ , compte 442 SystemDeBase "" "Contributions, impôts et taxes recouvrés pour le , compte de l’Etat"
+ , compte 4421 SystemDeBase "" "Prélèvements à la source (Impôt sur le revenu)"
+ , compte 4422 SystemDeBase "" "Prélèvements forfaitaires non libératoires"
+ , compte 4423 SystemDeBase "" "Retenues et prélèvements sur les distributions"
+ , compte 4424 SystemDeveloppe "" "Obligataires"
+ , compte 4425 SystemDeveloppe "" "Associés"
+ , compte 443 SystemDeBase "" "Opérations particulières avec l'Etat les collectivités publiques, les organismes internationaux"
+ , compte 4431 SystemDeBase "" "Créances sur l'Etat résultant de la suppression de la règle du décalage d'un mois en matière de TVA"
+ , compte 4438 SystemDeBase "" "Intérêts courus sur créances figurant au 4431"
+ , compte 444 SystemAbrege "" "Etat - Impôts sur les bénéfices"
+ , compte 445 SystemAbrege "" "Etat - Taxes sur le chiffre d'affaires"
+ , compte 4452 SystemDeBase "" "TVA due intracommunautaire"
+ , compte 4455 SystemDeBase "" "Taxes sur le chiffre d'affaires à décaisser"
+ , compte 44551 SystemDeveloppe "" "TVA à décaisser"
+ , compte 44558 SystemDeveloppe "" "Taxes assimilées à la TVA"
+ , compte 4456 SystemDeBase "" "Taxes sur le chiffre d'affaires déductibles"
+ , compte 44562 SystemDeveloppe "" "TVA sur immobilisations"
+ , compte 44563 SystemDeveloppe "" "TVA transférée par d'autres entreprises"
+ , compte 44566 SystemDeveloppe "" "TVA sur autres biens et services"
+ , compte 44567 SystemDeveloppe "" "Crédit de TVA à reporter"
+ , compte 44568 SystemDeveloppe "" "Taxes assimilées à la TVA"
+ , compte 4457 SystemDeBase "" "Taxes sur le chiffre d'affaires collectées par l'entreprise"
+ , compte 44571 SystemDeveloppe "" "TVA collectée"
+ , compte 44578 SystemDeveloppe "" "Taxes assimilées à la TVA"
+ , compte 4458 SystemDeBase "" "Taxes sur le chiffre d'affaires à régulariser ou en attente"
+ , compte 44581 SystemDeveloppe "" "Acomptes - Régime simplifié d'imposition"
+ , compte 44582 SystemDeveloppe "" "Acomptes - Régime de forfait"
+ , compte 44583 SystemDeveloppe "" "Remboursement de taxes sur le chiffre d'affaires demandé"
+ , compte 44584 SystemDeveloppe "" "TVA récupérée d'avance"
+ , compte 44586 SystemDeveloppe "" "Taxes sur le chiffre d'affaires sur factures non parvenues"
+ , compte 44587 SystemDeveloppe "" "Taxes sur le chiffre d'affaires sur factures à établir"
+ , compte 446 SystemDeBase "" "Obligations cautionnées"
+ , compte 447 SystemAbrege "" "Autres impôts, taxes et versements assimilés"
+ , compte 448 SystemDeBase "" "Etat - Charges à payer et produits à recevoir"
+ , compte 4482 SystemDeveloppe "" "Charges fiscales sur congés à payer"
+ , compte 4486 SystemDeveloppe "" "Charges à payer"
+ , compte 4487 SystemDeveloppe "" "Produits à recevoir"
+ , compte 449 SystemDeBase "" "Quotas d’émission à acquérir"
+ , compte 45 SystemAbrege "" "Groupe et associés"
+ , compte 451 SystemDeBase "" "Groupe"
+ , compte 455 SystemAbrege "" "Associés - Comptes courants"
+ , compte 4551 SystemDeveloppe "" "Principal"
+ , compte 4558 SystemDeveloppe "" "Intérêts courus"
+ , compte 456 SystemDeBase "" "Associés - Opérations sur le capital"
+ , compte 4561 SystemDeveloppe "" "Associés - Comptes d'apport en société"
+ , compte 45611 SystemDeveloppe "" "Apports en nature"
+ , compte 45615 SystemDeveloppe "" "Apports en numéraire"
+ , compte 4562 SystemDeveloppe "" "Apporteurs - Capital appelé, non versé"
+ , compte 45621 SystemDeveloppe "" "Actionnaires - Capital souscrit et appelé, non versé"
+ , compte 45625 SystemDeveloppe "" "Associés - Capital appelé, non versé"
+ , compte 4563 SystemDeveloppe "" "Associés - Versements reçus sur augmentation de capital"
+ , compte 4564 SystemDeveloppe "" "Associés - Versements anticipés"
+ , compte 4566 SystemDeveloppe "" "Actionnaires défaillants"
+ , compte 4567 SystemDeveloppe "" "Associés - Capital à rembourser"
+ , compte 457 SystemDeBase "" "Associés - Dividendes à payer"
+ , compte 458 SystemDeBase "" "Associés - Opérations faites en commun et en GIE"
+ , compte 4581 SystemDeveloppe "" "Opérations courantes"
+ , compte 4588 SystemDeveloppe "" "Intérêts courus"
+ , compte 46 SystemAbrege "" "Débiteurs divers et créditeurs divers"
+ , compte 462 SystemDeveloppe "" "Créances sur cessions d'immobilisations"
+ , compte 464 SystemDeveloppe "" "Dettes sur acquisitions de valeurs mobilières de placement"
+ , compte 465 SystemDeveloppe "" "Créances sur cessions de valeurs mobilières de placement"
+ , compte 467 SystemDeveloppe "" "Autres comptes débiteurs ou créditeurs"
+ , compte 468 SystemDeveloppe "" "Divers - Charges à payer et produits à recevoir"
+ , compte 4686 SystemDeveloppe "" "Charges à payer"
+ , compte 4687 SystemDeveloppe "" "Produits à recevoir"
+ , compte 47 SystemAbrege "" "Comptes transitoires ou d'attente"
+ , compte 471 SystemDeBase "" "Comptes d'attente"
+ , compte 472 SystemDeBase "" "Comptes d'attente"
+ , compte 473 SystemDeBase "" "Comptes d'attente"
+ , compte 474 SystemDeBase "" "Différences d’évaluation de jetons sur des passifs"
+ , compte 4746 SystemDeveloppe "" "Différence d’évaluation de jetons sur des passifs – ACTIF"
+ , compte 4747 SystemDeveloppe "" "Différence d’évaluation de jetons sur des passifs – PASSIF"
+ , compte 475 SystemDeBase "" "Comptes d'attente"
+ , compte 476 SystemDeBase "" "Différence de conversion - Actif"
+ , compte 4761 SystemDeveloppe "" "Diminution des créances"
+ , compte 4762 SystemDeveloppe "" "Augmentation des dettes"
+ , compte 4768 SystemDeveloppe "" "Différences compensées par couverture de change"
+ , compte 477 SystemDeBase "" "Différences de conversion - Passif"
+ , compte 4771 SystemDeveloppe "" "Augmentation des créances"
+ , compte 4772 SystemDeveloppe "" "Diminution des dettes"
+ , compte 4778 SystemDeveloppe "" "Différences compensées par couverture de change"
+ , compte 478 SystemDeBase "" "Autres comptes transitoires"
+ , compte 47861 SystemDeveloppe "" "Différences d’évaluation sur instruments financier à terme – ACTIF"
+ , compte 47862 SystemDeveloppe "" "Différences d’évaluation sur jetons détenus – ACTIF"
+ , compte 47871 SystemDeveloppe "" "Différences d’évaluation sur instruments financier à terme – PASSIF"
+ , compte 47872 SystemDeveloppe "" "Différences d’évaluation sur jetons détenus – PASSIF"
+ , compte 48 SystemDeBase "" "Comptes de régularisation"
+ , compte 481 SystemAbrege "" "Charges à répartir sur plusieurs exercices"
+ , compte 4816 SystemDeveloppe "" "Frais d'émission des emprunts"
+ , compte 486 SystemAbrege "" "Charges constatées d'avance"
+ , compte 487 SystemAbrege "" "Produits constatés d'avance"
+ , compte 4871 SystemDeBase "" "Produits constatés d’avance sur jetons émis"
+ , compte 488 SystemDeBase "" "Comptes de répartition périodique des charges et des produits"
+ , compte 4886 SystemDeveloppe "" "Charges"
+ , compte 4887 SystemDeveloppe "" "Produits"
+ , compte 49 SystemDeBase "" "Dépréciations des comptes de tiers"
+ , compte 491 SystemAbrege "" "Dépréciations des comptes de clients"
+ , compte 495 SystemDeBase "" "Dépréciations des comptes du groupe et des associés"
+ , compte 4951 SystemDeBase "" "Comptes du groupe"
+ , compte 4955 SystemDeBase "" "Comptes courants des associés"
+ , compte 4958 SystemDeBase "" "Opérations faites en commun et en GIE"
+ , compte 496 SystemAbrege "" "Dépréciations des comptes de débiteurs divers"
+ , compte 4962 SystemDeveloppe "" "Créances sur cessions d'immobilisations"
+ , compte 4965 SystemDeveloppe "" "Créances sur cessions de valeurs mobilières de placement"
+ , compte 4967 SystemDeveloppe "" "Autres comptes débiteurs"
+ , compte 5 SystemAbrege "" "Comptes financiers"
+ , compte 50 SystemAbrege "" "Valeurs mobilières de placement"
+ , compte 501 SystemDeBase "" "Parts dans des entreprises liées"
+ , compte 502 SystemDeBase "" "Actions propres"
+ , compte 5021 SystemDeveloppe "" "Actions destinées à être attribuées aux employés et affectées à des plans déterminés"
+ , compte 5022 SystemDeveloppe "" "Actions disponibles pour être attribuées aux employés ou pour la régularisation des cours de bourse"
+ , compte 503 SystemDeBase "" "Actions"
+ , compte 5031 SystemDeveloppe "" "Titres cotés"
+ , compte 5035 SystemDeveloppe "" "Titres non cotés"
+ , compte 504 SystemDeBase "" "Autres titres conférant un droit de propriété"
+ , compte 505 SystemDeBase "" "Obligations et bons émis par la société et rachetés par elle"
+ , compte 506 SystemDeBase "" "Obligations"
+ , compte 5061 SystemDeveloppe "" "Titres cotés"
+ , compte 5065 SystemDeveloppe "" "Titres non cotés"
+ , compte 507 SystemDeBase "" "Bons du Trésor et bons de caisse à court terme"
+ , compte 508 SystemDeBase "" "Autres valeurs mobilières de placement et autres créances assimilées"
+ , compte 5081 SystemDeveloppe "" "Autres valeurs mobilières"
+ , compte 5082 SystemDeveloppe "" "Bons de souscription"
+ , compte 5088 SystemDeveloppe "" "Intérêts courus sur obligations, bons et valeurs assimilés"
+ , compte 509 SystemDeBase "" "Versements restant à effectuer sur valeurs mobilières de placement non libérées"
+ , compte 51 SystemAbrege "" "Banques, établissements financiers et assimilés"
+ , compte 511 SystemDeBase "" "Valeurs à l'encaissement"
+ , compte 5111 SystemDeveloppe "" "Coupons échus à l'encaissement"
+ , compte 5112 SystemDeveloppe "" "Chèques à encaisser"
+ , compte 5113 SystemDeveloppe "" "Effets à l'encaissement"
+ , compte 5114 SystemDeveloppe "" "Effets à l'escompte"
+ , compte 512 SystemDeBase "" "Banques"
+ , compte 5121 SystemDeveloppe "" "Comptes en monnaie nationale"
+ , compte 5124 SystemDeveloppe "" "Comptes en devises"
+ , compte 514 SystemDeBase "" "Chèques postaux"
+ , compte 515 SystemDeBase "" "" Caisses " du Trésor et des établissements publics"
+ , compte 516 SystemDeBase "" "Sociétés de bourse"
+ , compte 517 SystemDeBase "" "Autres organismes financiers"
+ , compte 518 SystemDeBase "" "Intérêts courus"
+ , compte 5181 SystemDeveloppe "" "Intérêts courus à payer"
+ , compte 5188 SystemDeveloppe "" "Intérêts courus à recevoir"
+ , compte 519 SystemDeBase "" "Concours bancaires courants"
+ , compte 5191 SystemDeveloppe "" "Crédit de mobilisation de créances commerciales"
+ , compte 5193 SystemDeveloppe "" "Mobilisation de créances nées à l'étranger"
+ , compte 5198 SystemDeveloppe "" "Intérêts courus sur concours bancaires courants"
+ , compte 52 SystemDeBase "" "Instruments financiers à terme et jetons détenus"
+ , compte 521 SystemDeveloppe "" "Instruments financiers à terme"
+ , compte 522 SystemDeveloppe "" "Jetons détenus"
+ , compte 523 SystemDeveloppe "" "Jetons auto-détenus"
+ , compte 53 SystemAbrege "" "Caisse"
+ , compte 531 SystemDeBase "" "Caisse siège social"
+ , compte 5311 SystemDeveloppe "" "Caisse en monnaie nationale"
+ , compte 5314 SystemDeveloppe "" "Caisse en devises"
+ , compte 532 SystemDeveloppe "" "Caisse succursale (ou usine) A"
+ , compte 533 SystemDeveloppe "" "Caisse succursale (ou usine) B"
+ , compte 54 SystemAbrege "" "Régies d'avance et accréditifs"
+ , compte 58 SystemAbrege "" "Virements internes"
+ , compte 59 SystemDeBase "" "Dépréciations des comptes financiers"
+ , compte 590 SystemAbrege "" "Dépréciations des valeurs mobilières de placement"
+ , compte 5903 SystemDeBase "" "Actions"
+ , compte 5904 SystemDeBase "" "Autres titres conférant un droit de propriété"
+ , compte 5906 SystemDeBase "" "Obligations"
+ , compte 5908 SystemDeBase "" "Autres valeurs mobilières de placement et créances assimilées"
+ , compte 6 SystemAbrege "" "Comptes de charges"
+ , compte 60 SystemAbrege "" "Achats (sauf 603)"
+ , compte 601 SystemDeBase "" "Achats stockés - Matières premières (et fournitures)"
+ , compte 6011 SystemDeveloppe "" "Matières (ou groupe) A"
+ , compte 6012 SystemDeveloppe "" "Matières (ou groupe) B"
+ , compte 6017 SystemDeveloppe "" "Fournitures A, B, C,"
+ , compte 602 SystemDeBase "" "Achats stockés - Autres approvisionnements"
+ , compte 6021 SystemDeBase "" "Matières consommables"
+ , compte 60211 SystemDeveloppe "" "Matières (ou groupe) C"
+ , compte 60212 SystemDeveloppe "" "Matières (ou groupe) D"
+ , compte 6022 SystemDeBase "" "Fournitures consommables"
+ , compte 60221 SystemDeveloppe "" "Combustibles"
+ , compte 60222 SystemDeveloppe "" "Produits d'entretien"
+ , compte 60223 SystemDeveloppe "" "Fournitures d'atelier et d'usine"
+ , compte 60224 SystemDeveloppe "" "Fournitures de magasin"
+ , compte 60225 SystemDeveloppe "" "Fourniture de bureau"
+ , compte 6026 SystemDeBase "" "Emballages"
+ , compte 60261 SystemDeveloppe "" "Emballages perdus"
+ , compte 60265 SystemDeveloppe "" "Emballages récupérables non identifiables"
+ , compte 60267 SystemDeveloppe "" "Emballages à usage mixte"
+ , compte 604 SystemDeBase "" "Achats d'études et prestations de services"
+ , compte 605 SystemDeBase "" "Achats de matériel, équipements et travaux"
+ , compte 606 SystemDeBase "" "Achats non stockés de matière et fournitures"
+ , compte 6061 SystemDeveloppe "" "Fournitures non stockables (eau, énergie, …)"
+ , compte 6063 SystemDeveloppe "" "Fournitures d'entretien et de petit équipement"
+ , compte 6064 SystemDeveloppe "" "Fournitures administratives"
+ , compte 6068 SystemDeveloppe "" "Autres matières et fournitures"
+ , compte 607 SystemDeBase "" "Achats de marchandises"
+ , compte 6071 SystemDeveloppe "" "Marchandise (ou groupe) A"
+ , compte 6072 SystemDeveloppe "" "Marchandise (ou groupe) B"
+ , compte 608 SystemDeBase "" "(, compte réservé, le cas échéant, à la récapitulation des frais accessoires incorporés aux achats)"
+ , compte 609 SystemDeBase "" "Rabais, remises et ristournes obtenus sur achats"
+ , compte 6091 SystemDeveloppe "" "de matières premières (et fournitures)"
+ , compte 6092 SystemDeveloppe "" "d'autres approvisionnements stockés"
+ , compte 6094 SystemDeveloppe "" "d'études et prestations de services"
+ , compte 6095 SystemDeveloppe "" "de matériel, équipements et travaux"
+ , compte 6096 SystemDeveloppe "" "d'approvisionnements non stockés"
+ , compte 6097 SystemDeveloppe "" "de marchandises"
+ , compte 6098 SystemDeveloppe "" "Rabais, remises et ristournes non affectés"
+ , compte 603 SystemAbrege "" "Variations des stocks (approvisionnements et marchandises)"
+ , compte 6031 SystemDeBase "" "Variation des stocks de matières premières (et fournitures)"
+ , compte 6032 SystemDeBase "" "Variation des stocks des autres approvisionnements"
+ , compte 6037 SystemDeBase "" "Variation des stocks de marchandises"
+ -- <text top="" "486" left="106" width="218" height="18" font="1">61/62 - Autres charges externes </text>
+ , compte 61 SystemAbrege "" "Services extérieurs"
+ , compte 611 SystemDeBase "" "Sous-traitance générale"
+ , compte 612 SystemDeBase "" "Redevances de crédit-bail"
+ , compte 6122 SystemDeBase "" "Crédit-bail mobilier"
+ , compte 6125 SystemDeBase "" "Crédit-bail immobilier"
+ , compte 613 SystemDeBase "" "Locations"
+ , compte 6132 SystemDeveloppe "" "Locations immobilières"
+ , compte 6135 SystemDeveloppe "" "Locations mobilières"
+ , compte 6136 SystemDeveloppe "" "Malis sur emballages"
+ , compte 614 SystemDeBase "" "Charges locatives et de copropriété"
+ , compte 615 SystemDeBase "" "Entretien et réparations"
+ , compte 6152 SystemDeveloppe "" "sur biens immobiliers"
+ , compte 6155 SystemDeveloppe "" "sur biens mobiliers"
+ , compte 6156 SystemDeveloppe "" "Maintenance"
+ , compte 616 SystemDeBase "" "Primes d'assurances"
+ , compte 6161 SystemDeveloppe "" "Multirisques"
+ , compte 6162 SystemDeveloppe "" "Assurance obligatoire dommage construction"
+ , compte 6163 SystemDeveloppe "" "Assurance - transport"
+ , compte 61636 SystemDeveloppe "" "sur achats"
+ , compte 61637 SystemDeveloppe "" "sur ventes"
+ , compte 61638 SystemDeveloppe "" "sur autres biens"
+ , compte 6164 SystemDeveloppe "" "Risques d'exploitation"
+ , compte 6165 SystemDeveloppe "" "Insolvabilité clients"
+ , compte 617 SystemDeBase "" "Etudes et recherches"
+ , compte 618 SystemDeBase "" "Divers"
+ , compte 6181 SystemDeveloppe "" "Documentation générale"
+ , compte 6183 SystemDeveloppe "" "Documentation technique"
+ , compte 6185 SystemDeveloppe "" "Frais de colloques, séminaires, conférences"
+ , compte 619 SystemDeBase "" "Rabais, remises et ristournes obtenus sur services extérieurs"
+ , compte 62 SystemAbrege "" "Autres services extérieurs"
+ , compte 621 SystemDeBase "" "Personnel extérieur à l'entreprise"
+ , compte 6211 SystemDeveloppe "" "Personnel intérimaire"
+ , compte 6214 SystemDeveloppe "" "Personnel détaché ou prêté à l'entreprise"
+ , compte 622 SystemDeBase "" "Rémunérations d'intermédiaires et honoraires"
+ , compte 6221 SystemDeveloppe "" "Commissions et courtages sur achats"
+ , compte 6222 SystemDeveloppe "" "Commissions et courtages sur ventes"
+ , compte 6224 SystemDeveloppe "" "Rémunérations des transitaires"
+ , compte 6225 SystemDeveloppe "" "Rémunérations d'affacturage"
+ , compte 6226 SystemDeveloppe "" "Honoraires"
+ , compte 6227 SystemDeveloppe "" "Frais d'actes et de contentieux"
+ , compte 6228 SystemDeveloppe "" "Divers"
+ , compte 623 SystemDeBase "" "Publicité, publications, relations publiques"
+ , compte 6231 SystemDeveloppe "" "Annonces et insertions"
+ , compte 6232 SystemDeveloppe "" "Echantillons"
+ , compte 6233 SystemDeveloppe "" "Foires et expositions"
+ , compte 6234 SystemDeveloppe "" "Cadeaux à la clientèle"
+ , compte 6235 SystemDeveloppe "" "Primes"
+ , compte 6236 SystemDeveloppe "" "Catalogues et imprimés"
+ , compte 6237 SystemDeveloppe "" "Publications"
+ , compte 6238 SystemDeveloppe "" "Divers (pourboires, dons courants, …)"
+ , compte 624 SystemDeBase "" "Transports de biens et transports collectifs du personnel"
+ , compte 6241 SystemDeveloppe "" "Transports sur achats"
+ , compte 6242 SystemDeveloppe "" "Transports sur ventes"
+ , compte 6243 SystemDeveloppe "" "Transports entre établissements ou chantiers"
+ , compte 6244 SystemDeveloppe "" "Transports administratifs"
+ , compte 6247 SystemDeveloppe "" "Transports collectifs du personnel"
+ , compte 6248 SystemDeveloppe "" "Divers"
+ , compte 625 SystemDeBase "" "Déplacements, missions et réceptions"
+ , compte 6251 SystemDeveloppe "" "Voyages et déplacements"
+ , compte 6255 SystemDeveloppe "" "Frais de déménagement"
+ , compte 6256 SystemDeveloppe "" "Missions"
+ , compte 6257 SystemDeveloppe "" "Réceptions"
+ , compte 626 SystemDeBase "" "Frais postaux et de télécommunications"
+ , compte 627 SystemDeBase "" "Services bancaires et assimilés"
+ , compte 6271 SystemDeveloppe "" "Frais sur titres (achat, vente, garde)"
+ , compte 6272 SystemDeveloppe "" "Commissions et frais sur émission d'emprunts"
+ , compte 6275 SystemDeveloppe "" "Frais sur effets"
+ , compte 6276 SystemDeveloppe "" "Location de coffres"
+ , compte 6278 SystemDeveloppe "" "Autres frais et commissions sur prestations de services"
+ , compte 628 SystemDeBase "" "Divers"
+ , compte 6281 SystemDeveloppe "" "Concours divers (cotisations, )"
+ , compte 6284 SystemDeveloppe "" "Frais de recrutement de personnel"
+ , compte 629 SystemDeBase "" "Rabais, remises et ristournes obtenus sur autres services extérieurs"
+ , compte 63 SystemAbrege "" "Impôts, taxes et versements assimilés"
+ , compte 631 SystemDeBase "" "Impôts, taxes et versements assimilés sur rémunérations (administrations des impôts)"
+ , compte 6311 SystemDeveloppe "" "Taxe sur les salaires"
+ , compte 6312 SystemDeveloppe "" "Taxe d'apprentissage"
+ , compte 6313 SystemDeveloppe "" "Participation des employeurs à la formation professionnelle continue"
+ , compte 6314 SystemDeveloppe "" "Cotisation pour défaut d'investissement obligatoire dans la construction"
+ , compte 6318 SystemDeveloppe "" "Autres"
+ , compte 633 SystemDeBase "" "Impôts, taxes et versements assimilés sur rémunérations (autres organismes)"
+ , compte 6331 SystemDeveloppe "" "Versement de transport"
+ , compte 6332 SystemDeveloppe "" "Allocations logement"
+ , compte 6333 SystemDeveloppe "" "Participation des employeurs à la formation professionnelle continue"
+ , compte 6334 SystemDeveloppe "" "Participation des employeurs à l'effort de construction"
+ , compte 6335 SystemDeveloppe "" "Versements libératoires ouvrant droit à l'exonération de la taxe d'apprentissage"
+ , compte 6338 SystemDeveloppe "" "Autres"
+ , compte 635 SystemDeBase "" "Autres impôts, taxes et versements assimilés (administrations des impôts)"
+ , compte 6351 SystemDeveloppe "" "Impôts directs (sauf impôts sur les bénéfices)"
+ , compte 63511 SystemDeveloppe "" "Contribution économique territoriale"
+ , compte 63512 SystemDeveloppe "" "Taxes foncières"
+ , compte 63513 SystemDeveloppe "" "Autres impôts locaux"
+ , compte 63514 SystemDeveloppe "" "Taxe sur les véhicules des sociétés"
+ , compte 6352 SystemDeveloppe "" "Taxe sur le chiffre d'affaires non récupérables"
+ , compte 6353 SystemDeveloppe "" "Impôts indirects"
+ , compte 6354 SystemDeveloppe "" "Droits d'enregistrement et de timbre"
+ , compte 63541 SystemDeveloppe "" "Droits de mutation"
+ , compte 6358 SystemDeBase "" "Autres droits"
+ , compte 637 SystemDeBase "" "Autres impôts, taxes et versements assimilés (autres organismes)"
+ , compte 6371 SystemDeveloppe "" "Contribution sociale de solidarité à la charge des sociétés"
+ , compte 6372 SystemDeveloppe "" "Taxes perçues par les organismes publics internationaux"
+ , compte 6374 SystemDeveloppe "" "Impôts et taxes exigibles à l'Etranger"
+ , compte 6378 SystemDeveloppe "" "Taxes diverses"
+ , compte 64 SystemDeBase "" "Charges de personnel"
+ , compte 641 SystemAbrege "" "Rémunérations du personnel"
+ , compte 6411 SystemDeveloppe "" "Salaires, appointements"
+ , compte 6412 SystemDeveloppe "" "Congés payés"
+ , compte 6413 SystemDeveloppe "" "Primes et gratifications"
+ , compte 6414 SystemDeveloppe "" "Indemnités et avantages divers"
+ , compte 6415 SystemDeveloppe "" "Supplément familial"
+ , compte 644 SystemAbrege "" "Rémunération du travail de l'exploitant"
+ , compte 645 SystemAbrege "" "Charges de sécurité sociale et de prévoyance"
+ , compte 6451 SystemDeveloppe "" "Cotisations à l'URSSAF"
+ , compte 6452 SystemDeveloppe "" "Cotisations aux mutuelles"
+ , compte 6453 SystemDeveloppe "" "Cotisations aux caisses de retraites"
+ , compte 6454 SystemDeveloppe "" "Cotisations aux ASSEDIC"
+ , compte 6458 SystemDeveloppe "" "Cotisations aux autres organismes sociaux"
+ , compte 646 SystemAbrege "" "Cotisations sociales personnelles de l'exploitant"
+ , compte 647 SystemDeBase "" "Autres charges sociales"
+ , compte 6471 SystemDeveloppe "" "Prestations directes"
+ , compte 6472 SystemDeveloppe "" "Versements aux comités d'entreprise et d'établissement"
+ , compte 6473 SystemDeveloppe "" "Versements aux comités d'hygiène et de sécurité"
+ , compte 6474 SystemDeveloppe "" "Versements aux autres œuvres sociales"
+ , compte 6475 SystemDeveloppe "" "Médecine du travail, pharmacie"
+ , compte 648 SystemDeBase "" "Autres charges de personnel"
+ , compte 65 SystemAbrege "" "Autres charges de gestion courante"
+ , compte 651 SystemDeBase "" "Redevances pour concessions, brevets, licences, marques, procédés, logiciels, droits et valeurs similaires"
+ , compte 6511 SystemDeveloppe "" "Redevances pour concessions, brevets, licences, marques, procédés, logiciels"
+ , compte 6516 SystemDeveloppe "" "Droits d'auteur et de reproduction"
+ , compte 6518 SystemDeveloppe "" "Autres droits et valeurs similaires"
+ , compte 653 SystemDeBase "" "Jetons de présence"
+ , compte 654 SystemDeBase "" "Pertes sur créances irrécouvrables"
+ , compte 6541 SystemDeveloppe "" "Créances de l'exercice"
+ , compte 6544 SystemDeveloppe "" "Créances des exercices antérieurs"
+ , compte 655 SystemDeBase "" "Quote-part de résultat sur opérations faites en commun"
+ , compte 6551 SystemDeveloppe "" "Quote-part de bénéfice transférée (comptabilité du gérant)"
+ , compte 6555 SystemDeveloppe "" "Quote-part de perte supportée (comptabilité des associés non gérants)"
+ , compte 656 SystemDeBase "" "Pertes de change sur créances commerciales"
+ , compte 658 SystemDeBase "" "Charges diverses de gestion courante"
+ , compte 66 SystemAbrege "" "Charges financières"
+ , compte 661 SystemDeBase "" "Charges d'intérêts"
+ , compte 6611 SystemDeveloppe "" "Intérêts des emprunts et dettes"
+ , compte 66116 SystemDeveloppe "" "des emprunts et dettes assimilées"
+ , compte 66117 SystemDeveloppe "" "des dettes rattachées à des participations"
+ , compte 6612 SystemDeveloppe "" "Charges de la fiducie, résultat de la période"
+ , compte 6615 SystemDeveloppe "" "Intérêts des comptes courants et des dépôts créditeurs"
+ , compte 6616 SystemDeveloppe "" "Intérêts bancaires et sur opérations de financement (escompte,...)"
+ , compte 6617 SystemDeveloppe "" "Intérêts des obligations cautionnées"
+ , compte 6618 SystemDeveloppe "" "Intérêts des autres dettes"
+ , compte 66181 SystemDeveloppe "" "des dettes commerciales"
+ , compte 66188 SystemDeveloppe "" "des dettes diverses"
+ , compte 664 SystemDeBase "" "Pertes sur créances liées à des participations"
+ , compte 665 SystemDeBase "" "Escomptes accordés"
+ , compte 666 SystemDeBase "" "Pertes de change financières"
+ , compte 667 SystemDeBase "" "Charges nettes sur cessions de valeurs mobilières de placement"
+ , compte 668 SystemDeBase "" "Autres charges financières"
+ , compte 67 SystemAbrege "" "Charges exceptionnelles"
+ , compte 671 SystemDeBase "" "Charges exceptionnelles sur opérations de gestion"
+ , compte 6711 SystemDeveloppe "" "Pénalités sur marchés (et dédits payés sur achats et ventes)"
+ , compte 6712 SystemDeveloppe "" "Pénalités, amendes fiscales et pénales"
+ , compte 6713 SystemDeveloppe "" "Dons, libéralités"
+ , compte 6714 SystemDeveloppe "" "Créances devenues irrécouvrables dans l'exercice"
+ , compte 6715 SystemDeveloppe "" "Subventions accordées"
+ , compte 6717 SystemDeveloppe "" "Rappel d'impôts (autres qu'impôts sur les bénéfices)"
+ , compte 6718 SystemDeveloppe "" "Autres charges exceptionnelles sur opérations de gestion"
+ , compte 672 SystemDeBase "" "(, compte à la disposition des entités pour enregistrer, en cours d'exercice, les charges sur exercices antérieurs)"
+ , compte 674 SystemDeBase "" "Opérations de constitution ou liquidation des fiducies"
+ , compte 6741 SystemDeveloppe "" "Opérations liées à la constitution de fiducie – Transfert des éléments"
+ , compte 6742 SystemDeveloppe "" "Opérations liées à la liquidation de la fiducie"
+ , compte 675 SystemDeBase "" "Valeurs comptables des éléments d'actif cédés"
+ , compte 6751 SystemDeveloppe "" "Immobilisations incorporelles"
+ , compte 6752 SystemDeveloppe "" "Immobilisations corporelles"
+ , compte 6756 SystemDeveloppe "" "Immobilisations financières"
+ , compte 6758 SystemDeveloppe "" "Autres éléments d'actif"
+ , compte 678 SystemDeBase "" "Autres charges exceptionnelles"
+ , compte 6781 SystemDeveloppe "" "Malis provenant de clauses d'indexation"
+ , compte 6782 SystemDeveloppe "" "Lots"
+ , compte 6783 SystemDeveloppe "" "Malis provenant du rachat par l'entreprise d'actions et obligations émises par elle-même"
+ , compte 6788 SystemDeveloppe "" "Charges exceptionnelles diverses"
+ , compte 68 SystemDeBase "" "Dotations aux amortissements, aux dépréciations et aux provisions"
+ , compte 681 SystemAbrege "" "Dotations aux amortissements, aux dépréciations et aux provisions - Charges d'exploitation"
+ , compte 6811 SystemDeBase "" "Dotations aux amortissements sur immobilisations incorporelles et corporelles"
+ , compte 68111 SystemDeveloppe "" "Immobilisations incorporelles"
+ , compte 68112 SystemDeveloppe "" "Immobilisations corporelles"
+ , compte 6812 SystemDeBase "" "Dotations aux amortissements des charges d'exploitation à répartir"
+ , compte 6815 SystemDeBase "" "Dotations aux provisions d'exploitation"
+ , compte 6816 SystemDeBase "" "Dotations pour dépréciations des immobilisations incorporelles et corporelles"
+ , compte 68161 SystemDeveloppe "" "Immobilisations incorporelles"
+ , compte 68162 SystemDeveloppe "" "Immobilisations corporelles"
+ , compte 6817 SystemDeBase "" "Dotations pour dépréciations des actifs circulants"
+ , compte 68173 SystemDeveloppe "" "Stocks et en-cours"
+ , compte 68174 SystemDeveloppe "" "Créances"
+ , compte 686 SystemAbrege "" "Dotations aux amortissements, aux dépréciations et aux provisions - Charges financières"
+ , compte 6861 SystemDeBase "" "Dotations aux amortissements des primes de remboursement des obligations"
+ , compte 6865 SystemDeBase "" "Dotations aux provisions financières"
+ , compte 6866 SystemDeBase "" "Dotations pour dépréciations des éléments financiers"
+ , compte 68662 SystemDeveloppe "" "Immobilisations financières"
+ , compte 68665 SystemDeveloppe "" "Valeurs mobilières de placement"
+ , compte 6868 SystemDeBase "" "Autres dotations"
+ , compte 687 SystemAbrege "" "Dotations aux amortissements, aux dépréciations et aux provisions - Charges exceptionnelles"
+ , compte 6871 SystemDeBase "" "Dotations aux amortissements exceptionnels des immobilisations"
+ , compte 6872 SystemDeBase "" "Dotations aux provisions réglementées (immobilisations)"
+ , compte 68725 SystemDeveloppe "" "Amortissements dérogatoires"
+ , compte 6873 SystemDeBase "" "Dotations aux provisions réglementées (stocks)"
+ , compte 6874 SystemDeBase "" "Dotations aux autres provisions réglementées"
+ , compte 6875 SystemDeBase "" "Dotations aux provisions exceptionnelles"
+ , compte 6876 SystemDeBase "" "Dotations pour dépréciations exceptionnelles"
+ , compte 69 SystemDeBase "" "Participation des salariés - Impôts sur les bénéfices et assimilés"
+ , compte 691 SystemAbrege "" "Participation des salariés aux résultats"
+ , compte 695 SystemAbrege "" "Impôts sur les bénéfices"
+ , compte 6951 SystemDeveloppe "" "Impôts dus en France"
+ , compte 6952 SystemDeveloppe "" "Contribution additionnelle à l'impôt sur les bénéfices"
+ , compte 6954 SystemDeveloppe "" "Impôts dus à l'étranger"
+ , compte 696 SystemDeBase "" "Suppléments d'impôt sur les sociétés liés aux distributions"
+ , compte 698 SystemDeBase "" "Intégration fiscale"
+ , compte 6981 SystemDeBase "" "Intégration fiscale - Charges"
+ , compte 6989 SystemDeBase "" "Intégration fiscale - Produits"
+ , compte 699 SystemAbrege "" "Produits - Reports en arrière des déficits"
+ , compte 7 SystemAbrege "" "Comptes de produits"
+ , compte 70 SystemDeBase "" "Ventes de produits fabriqués, prestations de services, marchandises"
+ , compte 701 SystemAbrege "" "Ventes de produits finis"
+ , compte 7011 SystemDeveloppe "" "Produits finis (ou groupe) A"
+ , compte 7012 SystemDeveloppe "" "Produits finis (ou groupe) B"
+ , compte 702 SystemDeBase "" "Ventes de produits intermédiaires"
+ , compte 703 SystemDeBase "" "Ventes de produits résiduels"
+ , compte 704 SystemDeBase "" "Travaux"
+ , compte 7041 SystemDeBase "" "Travaux de catégorie (ou activité) A"
+ , compte 7042 SystemDeBase "" "Travaux de catégorie (ou activité) B"
+ , compte 705 SystemDeBase "" "Etudes"
+ , compte 706 SystemAbrege "" "Prestations de services"
+ , compte 707 SystemAbrege "" "Ventes de marchandises"
+ , compte 7071 SystemDeveloppe "" "Marchandises (ou groupe) A"
+ , compte 7072 SystemDeveloppe "" "Marchandises (ou groupe) B"
+ , compte 708 SystemAbrege "" "Produits des activités annexes"
+ , compte 7081 SystemDeveloppe "" "Produits des services exploités dans l'intérêt du personnel"
+ , compte 7082 SystemDeveloppe "" "Commissions et courtages"
+ , compte 7083 SystemDeveloppe "" "Locations diverses"
+ , compte 7084 SystemDeveloppe "" "Mise à disposition de personnel facturée"
+ , compte 7085 SystemDeveloppe "" "Ports et frais accessoires facturés"
+ , compte 7086 SystemDeveloppe "" "Bonis sur reprises d'emballages consignés"
+ , compte 7087 SystemDeveloppe "" "Bonifications obtenues des clients et primes sur ventes"
+ , compte 7088 SystemDeveloppe "" "Autres produits d'activités annexes (cessions d'approvisionnements,)"
+ , compte 709 SystemAbrege "" "Rabais, remises et ristournes accordés par l'entreprise"
+ , compte 7091 SystemDeveloppe "" "sur ventes de produits finis"
+ , compte 7092 SystemDeveloppe "" "sur ventes de produits intermédiaires"
+ , compte 7094 SystemDeveloppe "" "sur travaux"
+ , compte 7095 SystemDeveloppe "" "sur études"
+ , compte 7096 SystemDeveloppe "" "sur prestations de services"
+ , compte 7097 SystemDeveloppe "" "sur ventes de marchandises"
+ , compte 7098 SystemDeveloppe "" "sur produits des activités annexes"
+ , compte 71 SystemDeBase "" "Production stockée (ou déstockage)"
+ , compte 713 SystemAbrege "" "Variation des stocks (en-cours de production, produits)"
+ , compte 7133 SystemDeBase "" "Variation des en-cours de production de biens"
+ , compte 71331 SystemDeveloppe "" "Produits en cours"
+ , compte 71335 SystemDeveloppe "" "Travaux en cours"
+ , compte 7134 SystemDeBase "" "Variation des en-cours de production de services"
+ , compte 71341 SystemDeveloppe "" "Etudes en cours"
+ , compte 71345 SystemDeveloppe "" "Prestations de services en cours"
+ , compte 7135 SystemDeBase "" "Variation des stocks de produits"
+ , compte 71351 SystemDeveloppe "" "Produits intermédiaires"
+ , compte 71355 SystemDeveloppe "" "Produits finis"
+ , compte 71358 SystemDeveloppe "" "Produits résiduels"
+ , compte 72 SystemAbrege "" "Production immobilisée"
+ , compte 721 SystemDeBase "" "Immobilisations incorporelles"
+ , compte 722 SystemDeBase "" "Immobilisations corporelles"
+ , compte 74 SystemAbrege "" "Subventions d'exploitation"
+ , compte 75 SystemAbrege "" "Autres produits de gestion courante"
+ , compte 751 SystemDeBase "" "Redevances pour concessions, brevets, licences, marques, procédés, logiciels, droits et valeurs"
+ , compte 7511 SystemDeveloppe "" "Redevances pour concessions, brevets, licences, marques, procédés, logiciels"
+ , compte 7516 SystemDeveloppe "" "Droits d'auteur et de reproduction"
+ , compte 7518 SystemDeveloppe "" "Autres droits et valeurs similaires"
+ , compte 752 SystemDeBase "" "Revenus des immeubles non affectés à des activités professionnelles"
+ , compte 753 SystemAbrege "" "Jetons de présence et rémunérations d'administrateurs, gérants,"
+ , compte 754 SystemAbrege "" "Ristournes perçues des coopératives (provenant des excédents)"
+ , compte 755 SystemAbrege "" "Quote-parts de résultat sur opérations faites en commun"
+ , compte 7551 SystemDeveloppe "" "Quote-part de perte transférée (comptabilité du gérant)"
+ , compte 7555 SystemDeveloppe "" "Quote-part de bénéfice attribuée (comptabilité des associés non - gérants)"
+ , compte 756 SystemDeBase "" "Gains de change sur créances commerciales"
+ , compte 758 SystemDeBase "" "Produits divers de gestion courante"
+ , compte 76 SystemAbrege "" "Produits financiers"
+ , compte 761 SystemDeBase "" "Produits de participations"
+ , compte 7611 SystemDeveloppe "" "Revenus des titres de participation"
+ , compte 7612 SystemDeveloppe "" "Produits de la fiducie, résultat de la période"
+ , compte 7616 SystemDeveloppe "" "Revenus sur autres formes de participation"
+ , compte 7617 SystemDeveloppe "" "Revenus des créances rattachées à des participations"
+ , compte 762 SystemDeBase "" "Produits des autres immobilisations financières"
+ , compte 7621 SystemDeveloppe "" "Revenus des titres immobilisés"
+ , compte 7626 SystemDeveloppe "" "Revenus des prêts"
+ , compte 7627 SystemDeveloppe "" "Revenus des créances immobilisées"
+ , compte 763 SystemDeBase "" "Revenus des autres créances"
+ , compte 7631 SystemDeveloppe "" "Revenus des créances commerciales"
+ , compte 7638 SystemDeveloppe "" "Revenus des créances diverses"
+ , compte 764 SystemDeBase "" "Revenus des valeurs mobilières de placement"
+ , compte 765 SystemDeBase "" "Escomptes obtenus"
+ , compte 766 SystemDeBase "" "Gains de change financiers"
+ , compte 767 SystemDeBase "" "Produits nets sur cessions de valeurs mobilières de placement"
+ , compte 768 SystemDeBase "" "Autres produits financiers"
+ , compte 77 SystemAbrege "" "Produits exceptionnels"
+ , compte 771 SystemDeBase "" "Produits exceptionnels sur opérations de gestion"
+ , compte 7711 SystemDeveloppe "" "Dédits et pénalités perçus sur achats et sur ventes"
+ , compte 7713 SystemDeveloppe "" "Libéralités reçues"
+ , compte 7714 SystemDeveloppe "" "Rentrées sur créances amorties"
+ , compte 7715 SystemDeveloppe "" "Subventions d'équilibre"
+ , compte 7717 SystemDeveloppe "" "Dégrèvements d'impôts autres qu'impôts sur les bénéfices"
+ , compte 7718 SystemDeveloppe "" "Autres produits exceptionnels sur opérations de gestion"
+ , compte 772 SystemDeBase "" "(, compte à la disposition des entités pour enregistrer, en cours d'exercice, les produits sur exercices antérieurs)"
+ , compte 774 SystemDeBase "" "Opérations de constitution ou liquidation des fiducies"
+ , compte 7741 SystemDeveloppe "" "Opérations liées à la constitution de fiducie – Transfert des éléments"
+ , compte 7742 SystemDeveloppe "" "Opérations liées à la liquidation de la fiducie"
+ , compte 775 SystemDeBase "" "Produits des cessions d'éléments d'actif"
+ , compte 7751 SystemDeveloppe "" "Immobilisations incorporelles"
+ , compte 7752 SystemDeveloppe "" "Immobilisations corporelles"
+ , compte 7756 SystemDeveloppe "" "Immobilisations financières"
+ , compte 7758 SystemDeveloppe "" "Autres éléments d'actif"
+ , compte 777 SystemDeBase "" "Quote-part des subventions d'investissement virée au résultat de l'exercice"
+ , compte 778 SystemDeBase "" "Autres produits exceptionnels"
+ , compte 7781 SystemDeveloppe "" "Bonis provenant de clauses d'indexation"
+ , compte 7782 SystemDeveloppe "" "Lots"
+ , compte 7783 SystemDeveloppe "" "Bonis provenant du rachat par l'entreprise d'actions et d'obligations émises par elle - même"
+ , compte 7788 SystemDeveloppe "" "Produits exceptionnels divers"
+ , compte 78 SystemDeBase "" "Reprises sur amortissements, dépréciations et provisions"
+ , compte 781 SystemAbrege "" "Reprises sur amortissements, dépréciations et provisions (à inscrire dans les produits d'exploitation)"
+ , compte 7811 SystemDeBase "" "Reprises sur amortissements des immobilisations incorporelles et corporelles"
+ , compte 78111 SystemDeveloppe "" "Immobilisations incorporelles"
+ , compte 78112 SystemDeveloppe "" "Immobilisations corporelles"
+ , compte 7815 SystemDeBase "" "Reprises sur provisions d'exploitation"
+ , compte 7816 SystemDeBase "" "Reprises sur dépréciations des immobilisations incorporelles et corporelles"
+ , compte 78161 SystemDeveloppe "" "Immobilisations incorporelles"
+ , compte 78162 SystemDeveloppe "" "Immobilisations corporelles"
+ , compte 7817 SystemDeBase "" "Reprises sur dépréciations des actifs circulants"
+ , compte 78173 SystemDeveloppe "" "Stocks et en-cours"
+ , compte 78174 SystemDeveloppe "" "Créances"
+ , compte 786 SystemAbrege "" "Reprises sur provisions pour risques et dépréciations (à inscrire dans les produits financiers)"
+ , compte 7865 SystemDeBase "" "Reprises sur provisions financières"
+ , compte 7866 SystemDeBase "" "Reprises sur dépréciations des éléments financiers"
+ , compte 78662 SystemDeveloppe "" "Immobilisations financières"
+ , compte 78665 SystemDeveloppe "" "Valeurs mobilières de placements"
+ , compte 787 SystemAbrege "" "Reprises sur provisions et dépréciations (à inscrire dans les produits exceptionnels)"
+ , compte 7872 SystemDeBase "" "Reprises sur provisions réglementées (immobilisations)"
+ , compte 78725 SystemDeveloppe "" "Amortissements dérogatoires"
+ , compte 78726 SystemDeveloppe "" "Provision spéciale de réévaluation"
+ , compte 78727 SystemDeveloppe "" "Plus-values réinvesties"
+ , compte 7873 SystemDeBase "" "Reprises sur provisions réglementées (stocks)"
+ , compte 7874 SystemDeBase "" "Reprises sur autres provisions réglementées"
+ , compte 7875 SystemDeBase "" "Reprises sur provisions exceptionnelles"
+ , compte 7876 SystemDeBase "" "Reprises sur dépréciations exceptionnelles"
+ , compte 79 SystemAbrege "" "Transferts de charges"
+ , compte 791 SystemDeBase "" "Transferts de charges d'exploitation"
+ , compte 796 SystemDeBase "" "Transferts de charges financières"
+ , compte 797 SystemDeBase "" "Transferts de charges exceptionnelles"
+ ]
--- /dev/null
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+{-# LANGUAGE UndecidableInstances #-}
+--{-# LANGUAGE QualifiedDo #-}
+module Symantic.Compta.Norm.PCG.Journal where
+
+import Control.Applicative (Applicative(..), liftA2)
+import Control.DeepSeq (NFData)
+import Control.Monad (Monad(..), forM)
+import Data.Bool
+import Data.Decimal (Decimal)
+import Data.Either (Either(..))
+import Data.Eq (Eq(..))
+import Data.Function (($), (.), id)
+import Data.Functor (Functor, (<$>), (<$))
+import Data.Hashable (Hashable)
+import Data.Kind (Type)
+import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
+import Data.Map.Strict (Map)
+import Data.Maybe (Maybe(..), maybeToList)
+import Data.Monoid (Monoid(..), Endo(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (String)
+import Data.Tuple (uncurry)
+import GHC.Generics (Generic)
+import GHC.Stack (HasCallStack)
+import GHC.TypeLits (Symbol)
+import Numeric.Natural (Natural)
+import Prelude (error)
+import Text.Show (Show(..), showString)
+import qualified Control.Monad as Monad (Monad(..), forM)
+import qualified Control.Monad.Trans.Class as MT
+import qualified Control.Monad.Trans.Reader as MT
+import qualified Control.Monad.Trans.State as MT
+import qualified Control.Monad.Trans.Writer as MT
+import qualified Data.Char as Char
+import qualified Data.Foldable as Foldable
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.List as List
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Map.Strict as Map
+import qualified Data.Tree as Tree
+import qualified Prelude
+
+import Symantic.Compta.Input.Journal
+import Symantic.Compta.Calc.Balance
+import Symantic.Compta.Calc.Flow
+import Symantic.Compta.Calc.Unit
+import Symantic.Compta.Lang
+import Symantic.Compta.Norm.PCG.Chart
+import Symantic.Compta.Utils.Error
+import qualified Symantic.Compta.Calc.Chart as Chart
+
+-- * Type 'JournalPCG'
+newtype JournalPCG repr a = JournalPCG { unJournalPCG ::
+ MT.Reader (JournalEnv repr) (repr {-Ty (JournalPCG repr)-} a)
+ } deriving anyclass (Functor, Applicative, Monad)
+type instance Ty (JournalPCG repr) TyAccountSection = Ty repr TyAccountSection
+type instance Ty (JournalPCG repr) TyAccount = Ty repr TyAccount
+type instance Ty (JournalPCG repr) TyAmount = Ty repr TyAmount
+type instance Ty (JournalPCG repr) TyUnit = Ty repr TyUnit
+type instance Ty (JournalPCG repr) TyQuantity = Ty repr TyQuantity
+
+--instance Trans (JournalPCG repr) repr where
+ --trans (JournalPCG m) = _e m
+
+journal ::
+ IsString (Ty repr TyUnit) =>
+ Chart -> JournalRepr (JournalPCG repr) TyMove -> repr [TyMove]
+journal ch jnl = MT.runReader (unJournalPCG (runJournalRepr jnl)) (journalEnv ch)
+
+-- ** Type 'JournalEnv'
+data JournalEnv (repr::Type -> Type) = JournalEnv
+ { journalChart :: Chart
+ --, accountByCode :: HashMap.HashMap AccountCode ChartNode
+ --, accountByName :: HashMap.HashMap AccountPath (AccountCode, ChartNode)
+ , defaultUnit :: Ty repr TyUnit
+ }
+journalEnv ::
+ IsString (Ty repr TyUnit) =>
+ Chart -> JournalEnv repr
+journalEnv ch = JournalEnv
+ { journalChart = ch
+ --, accountByCode = HashMap.fromList byCode
+ --, accountByName = HashMap.fromList byName
+ , defaultUnit = fromString ""
+ }
+ -- where
+ -- (byCode{-, byName-}) = goChart (AccountCode 0{-, []-}) ch
+ -- goChart p = Map.foldMapWithKey (goNode p) . Chart.unChart
+ -- goNode (AccountCode kc{-, kn-}) n (node, children) =
+ -- let keyCode = AccountCode (kc Prelude.* 10 Prelude.^ digitNumber n Prelude.+ n) in
+ -- --let keyName = kn <> maybeToList (sectionName node) in
+ -- let (bc{-, bn-}) = goChart (keyCode{-, keyName-}) children in
+ -- ( (keyCode, ({-nonEmpty keyName,-} node)) : bc
+ -- {-
+ -- , case nonEmpty keyName of
+ -- Just k -> (k, (keyCode, node)) : bn
+ -- Nothing -> bn
+ -- -}
+ -- )
+
+-- | @('digitNumber' n)@ retourne le nombre de digits nécessaires pour encoder 'n'.
+digitNumber :: Natural -> Natural
+digitNumber = go where
+ go n | n < 10 = 1
+ | otherwise = 1 Prelude.+ go (n`Prelude.div`10)
+
+instance
+ ( Postable repr
+ , Listable repr
+ ) => IsString (JournalPCG repr TyAccount) where
+ fromString = error ""
+instance
+ ( Postable repr
+ , Listable repr
+ , Zeroable (repr TyAmount)
+ ) => IsString (JournalPCG repr TyPost) where
+ fromString s = JournalPCG do
+ acct <- unJournalPCG $ fromString s
+ return $ post acct zero
+instance
+ ( Postable repr
+ , Listable repr
+ , Zeroable (repr TyAmount)
+ , Inject (Chart.ChartPath AccountCode) repr TyAccount
+ --, FromInteger (JournalPCG repr TyPost)
+ ) => FromInteger (JournalPCG repr TyPost) where
+ fromInteger i = JournalPCG do
+ acct <- unJournalPCG $ fromInteger i
+ return $ post acct zero
+instance
+ Zeroable (repr TyAmount) =>
+ Zeroable (JournalPCG repr TyAmount) where
+ zero = JournalPCG (return zero)
+instance Addable a => Addable (JournalPCG repr a) where
+ x + y = (+) <$> x <*> y
+instance Listable repr => Listable (JournalPCG repr) where
+ nil = JournalPCG (return nil)
+ cons (JournalPCG x) (JournalPCG xs) = JournalPCG (liftA2 cons x xs)
+ concat (JournalPCG xs) (JournalPCG ys) = JournalPCG (concat <$> xs <*> ys)
+instance Postable repr => Postable (JournalPCG repr) where
+ post (JournalPCG acct) (JournalPCG amt) = JournalPCG do
+ post <$> acct <*> amt
+instance
+ ( Addable (Ty repr TyQuantity)
+ , Moveable repr
+ , Negable (Ty repr TyQuantity)
+ , Nullable (Ty repr TyQuantity)
+ , Ord (Ty repr TyAccountSection)
+ , Ord (Ty repr TyUnit)
+ , Postable repr
+ , Show (Ty repr TyAccountSection)
+ , Show (Ty repr TyQuantity)
+ , Show (Ty repr TyUnit)
+ , Trans repr (BalanceRepr Maybe repr)
+ , Trans repr (InferPost repr)
+ ) => Moveable (JournalPCG repr) where
+ move (JournalPCG ps) = JournalPCG $ go <$> ps
+ where
+ go ps =
+ case equilibrium ps of
+ Right eps -> move eps
+ Left errs -> error ("equilibrium: "<>show errs)
+instance Accountable repr => Accountable (JournalPCG repr) where
+ account = JournalPCG . return . account
+instance Amountable repr => Amountable (JournalPCG repr) where
+ amount = JournalPCG . return . amount
+instance Negable (repr qty) => Negable (JournalPCG repr qty) where
+ negate = JournalPCG . (negate <$>) . unJournalPCG
+{-
+instance
+ ( Postable repr
+ , Listable repr
+ ) => Postable acct amt (JournalPCG repr) where
+ post acct amt = JournalPCG $ MT.ReaderT $ \_env -> post acct amt
+instance
+ ( Postable acct (Map unit qty) repr
+ , FromInteger (JournalPCG acct (Map unit qty) repr acct)
+ , Listable repr
+ ) => FromInteger (JournalPCG acct (Map unit qty) repr [TyPost]) where
+ fromInteger i = cons (fromInteger i) nil
+instance
+ ( Postable acct (Map unit qty) repr
+ , IsString (JournalPCG acct (Map unit qty) repr acct)
+ , Listable repr
+ ) => IsString (JournalPCG acct (Map unit qty) repr [TyPost]) where
+ fromString s = do
+ acct :: acct <- fromString s
+ cons (post acct (Map.empty :: Map unit qty)) nil
+-}
+{-
+instance
+ ( FromRational qty
+ , Listable repr
+ ) => FromRational (JournalPCG repr qty) where
+ fromRational i = JournalPCG $ MT.ReaderT $ \_env ->
+ fromRational i
+instance FromInteger (JournalPCG repr AccountCode) where
+ fromInteger i = JournalPCG do
+ env <- MT.ask
+ let ac = if 0 <= i then AccountCode (fromInteger i) else error ("Invalid AccountCode: "<>show i)
+ case HashMap.lookup ac (accountByCode env) of
+ Just{} -> return ac
+ _ -> error ("Chart does not allow AccountCode: "<>show ac<>" "<>show (accountByCode env))
+-}
+{-
+instance
+ Listable repr =>
+ IsString (JournalPCG repr (Chart.ChartPath AccountSegment)) where
+ fromString s = JournalM $ do
+ env <- MT.lift MT.ask
+ case nonEmpty (fromString s) of
+ Just acct | HashMap.member acct (accountByName env) -> return acct
+ Just acct -> error ("AccountPath is not allowed by given Chart: "<>show acct)
+ Nothing -> error "Invalid empty AccountPath"
+instance
+ Listable repr =>
+ FromInteger (JournalPCG repr (Chart.ChartPath AccountSegment)) where
+ fromInteger i = JournalM $ do
+ env <- MT.lift MT.ask
+ let ac = if 0 <= i then AccountCode (fromInteger i) else error ("Invalid AccountCode: "<>show i)
+ case HashMap.lookup ac (accountByCode env) of
+ Just (Just acct, _) -> return acct
+ _ -> error ("Chart does not allow AccountCode: "<>show ac)
+-}
+instance
+ ( Listable repr
+ --, Ty repr TyAccount ~ Chart.ChartPath Natural --AccountCodeSegment
+ , Inject (Chart.ChartPath AccountCode) repr TyAccount
+ ) => FromInteger (JournalPCG repr TyAccount) where
+ fromInteger i = JournalPCG $ do
+ env <- MT.ask
+ let code = if 0 <= i then fromInteger i else error ("Invalid AccountCode: "<>show code)
+ let path = {-chartSection <$>-} NonEmpty.fromList (AccountCode <$> digitsOfNatural code)
+ case Chart.lookup path (journalChart env) of
+ Just{} -> return $ inject path
+ _ -> error ("Chart does not allow AccountCode: "<>show code)
+--instance FromInteger qty => FromInteger (JournalPCG repr qty) where
+-- fromInteger = JournalPCG . return . fromInteger
+--type instance QuantityOf (Map unit qty) = qty
+instance
+ ( Listable repr
+ , Inject (Map (Ty repr TyUnit) (Ty repr TyQuantity)) repr TyAmount
+ , FromInteger (Ty repr TyQuantity)
+ ) => FromInteger (JournalPCG repr TyAmount) where
+ fromInteger i = JournalPCG $ do
+ env <- MT.ask
+ --qty <- unJournalM (fromInteger i :: JournalPCG acct (Map unit qty) repr qty)
+ --q <- unJournalPCG $ fromInteger i
+ return $ inject $ Map.singleton (defaultUnit env) (fromInteger i::Ty repr TyQuantity)
+instance Unitable (JournalPCG repr) where
+ unit u = JournalPCG . MT.local (\env -> env{defaultUnit=u}) . unJournalPCG
+instance EURable repr => EURable (JournalPCG repr) where
+ eur qty = JournalPCG $ eur <$> unJournalPCG qty
+instance USDable repr => USDable (JournalPCG repr) where
+ usd qty = JournalPCG $ usd <$> unJournalPCG qty
+{-
+instance
+ Listable repr =>
+ IsString (JournalPCG repr AccountCode) where
+ fromString s = JournalM $ do
+ env <- MT.lift MT.ask
+ case nonEmpty (fromString s) of
+ Just acct | Just (ac, _) <- HashMap.lookup acct (accountByName env) -> return ac
+ Just acct -> error ("AccountPath is not allowed by given Chart: "<>show acct)
+ Nothing -> error "Invalid empty AccountPath"
+-}
+
+
+balance :: forall repr a.
+ Balanceable a ~ 'True =>
+ Addable (Ty repr TyQuantity) =>
+ Ord (Ty repr TyAccountSection) =>
+ Ord (Ty repr TyUnit) =>
+ Trans repr (BalanceRepr Maybe repr) =>
+ repr a ->
+ Balance (Ty repr TyAccountSection)
+ (Ty repr TyUnit)
+ (Ty repr TyQuantity)
+ (Trickle (Ty (BalanceRepr Trickle repr) TyAmount))
+balance =
+ runBalanceRepr @Trickle .
+ trickleBalanceRepr .
+ trans @_ @(BalanceRepr Maybe repr)
+
+{-
+instance Listable repr => Listable (JournalPCG repr) where
+ nil = Monad.return []
+ cons = liftA2 (:)
+ concat = liftA2 (<>)
+-}
+
+--type instance AccountSectionOf (Chart.ChartPath section) = section
+--type instance UnitOf (Map unit qty) = unit
+--type instance AmountOf () = Map Unit Q
+--type instance AccountOf () = NonEmpty AccountCode
+
+--type Account = AccountCode
+--type AccountCodeSegment = AccountCode
+--type AccountPath = Chart.ChartPath AccountSegment
+--type Amount = Map Unit Q
+--type Q = (Flow Decimal)
+
--- /dev/null
+module Symantic.Compta.Norm.PCG.Lang
+ ( module Symantic.Compta.Norm.PCG.Lang
+ , module Symantic.Compta.Lang
+ ) where
+import Control.Applicative (Applicative(..))
+import Control.Monad (Monad(..))
+import Data.Bool
+import Data.Decimal (Decimal)
+import Data.Eq (Eq(..))
+import Data.Function (($), (.))
+import Data.Functor (Functor, (<$>))
+import Data.Hashable (Hashable)
+import Data.Kind (Type)
+import Data.Maybe (Maybe(..))
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (String)
+import Data.Tuple (uncurry)
+import GHC.Stack
+import GHC.TypeLits (Symbol)
+import Numeric.Natural (Natural)
+import Prelude (error)
+import Text.Show (Show(..))
+import qualified Control.Monad.Trans.Reader as MT
+import qualified Control.Monad.Trans.State as MT
+import qualified Control.Monad.Trans.Writer as MT
+import qualified Data.Char as Char
+import qualified Data.Foldable as Foldable
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.List as List
+import qualified Data.Tree as Tree
+import qualified Prelude
+import qualified System.IO as IO
+
+import Symantic.Compta.Lang
+-- ** Class 'Descriptionable'
--- /dev/null
+module Symantic.Compta.Utils.Error where
+--import Data.Semigroup (Semigroup(..))
+import GHC.Stack
+import Data.String (String)
+import Prelude (error)
+
+--import Symantic.Compta.Lang.Rebindable
+
+errorWithStack :: HasCallStack => String -> a
+errorWithStack = error -- (msg <> "\n" <> prettyCallStack callStack)
--- /dev/null
+module Symantic.Compta.Utils.Foldable where
+
+import Data.Either (Either(..), either)
+import Data.Foldable (Foldable(..))
+import Data.Function ((.))
+import Data.Maybe (Maybe(..), listToMaybe, maybeToList)
+import Data.Monoid (Monoid(..))
+
+-- | Return the first non-'Nothing' returned by the given function
+-- applied on the elements of a 'Foldable'.
+find :: Foldable t => (a -> Maybe b) -> t a -> Maybe b
+find f = listToMaybe . foldMap (maybeToList . f)
+
+-- | Like 'Data.Either.partitionEithers' but generalized
+-- to work on a 'Foldable' containing 'Monoid's.
+--
+-- NOTE: any lazyness on resulting 'Monoid's is preserved.
+partitionEithers ::
+ Foldable t => Monoid r => Monoid l =>
+ t (Either l r) -> (l, r)
+partitionEithers =
+ foldr (either left right) (mempty, mempty)
+ where
+ left a ~(l, r) = (a`mappend`l, r)
+ right a ~(l, r) = (l, a`mappend`r)
+
+-- | Return a tuple of accumulated 'Left's and folded 'Right's
+-- in the given 'Foldable'.
+--
+-- * NOTE: any lazyness on resulting 'Monoid's is preserved.
+-- * WARNING: beware that given an infinite 'Foldable',
+-- the initial 'Right' accumulator will never be appended
+-- to the final 'Right' accumulator.
+accumLeftsAndFoldrRights ::
+ Foldable t => Monoid l =>
+ (r -> ra -> ra) -> ra -> t (Either l r) -> (l, ra)
+accumLeftsAndFoldrRights f rempty =
+ foldr (either left right) (mempty, rempty)
+ where
+ left a ~(l, r) = (a`mappend`l, r)
+ right a ~(l, r) = (l, f a r)
--- /dev/null
+{-# LANGUAGE NoRebindableSyntax #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Symantic.Compta.Utils.Monoid where
+
+import Data.Function ((.))
+import Data.Monoid (Endo(..))
+import Text.Show (Show(..))
+
+instance Show a => Show (Endo [a]) where
+ showsPrec p = showsPrec p . (`appEndo` [])
--- /dev/null
+{-# LANGUAGE NoOverloadedLists #-}
+module Symantic.Compta.View where
+
+import Data.String (String)
+import Data.Semigroup (Semigroup(..))
+import Prelude (Int, max)
+import Symantic.Compta.Lang
+import qualified Data.List as List
+import Text.Show (Show(..))
+--import qualified Symantic.Document as Doc
+
+table :: [[String]] -> String
+table cells = List.unlines (List.map show rows)
+ where
+ maxCols :: Int
+ maxWidths :: [Int]
+ rows :: [[String]]
+ (maxCols, maxWidths, rows) = List.foldr go (0, List.repeat 0, []) cells
+
+ go :: [String] -> (Int, [Int], [[String]]) -> (Int, [Int], [[String]])
+ go row (accMaxCols, accMaxWidths, accRows) =
+ ( max accMaxCols (List.length row)
+ , List.zipWith max accMaxWidths (List.map List.length row <> List.repeat 0)
+ , List.take maxCols (List.zipWith align row maxWidths) : accRows
+ )
+
+ align :: String -> Int -> String
+ align s n = List.replicate (n - List.length s) ' ' <> s
--- /dev/null
+cabal-version: 2.4
+name: symantic-compta
+version: 0.0.0
+synopsis: Accounting combinators
+description: Accounting in Haskell.
+license: GPL-3.0-or-later
+author: Julien Moutinho <julm+symantic-compta@sourcephile.fr>
+maintainer: Julien Moutinho <julm+symantic-compta@sourcephile.fr>
+copyright: Julien Moutinho <julm+symantic-compta@sourcephile.fr>
+bug-reports: https://mails.sourcephile.fr/inbox/symantic-compta
+stability: experimental
+category: Accounting
+extra-doc-files:
+ -- ChangeLog.md
+ -- Hacking.md
+ -- ReadMe.md
+ -- ToDo.md
+extra-source-files:
+ cabal.project
+ default.nix
+ .envrc
+ flake.lock
+ flake.nix
+ Makefile
+ shell.nix
+extra-tmp-files:
+build-type: Simple
+-- tested-with: GHC==9.0.1
+
+source-repository head
+ type: git
+ location: git://git.sourcephile.fr/haskell/symantic-compta
+
+library
+ default-language: Haskell2010
+ default-extensions:
+ NoImplicitPrelude
+ ghc-options:
+ -Wall
+ -Wincomplete-uni-patterns
+ -Wincomplete-record-updates
+ ---Wpartial-fields
+ -fhide-source-paths
+ -- -freverse-errors
+ -fprint-potential-instances
+ -- REMOVE THOSE:
+ -Wno-unused-matches
+ -Wno-missing-methods
+ ghc-prof-options: -eventlog -fprof-auto
+ -- -fprof-auto-calls
+ hs-source-dirs: src
+ exposed-modules:
+ Symantic.Compta
+ Symantic.Compta.Lang
+ Symantic.Compta.Lang.Rebindable
+ Symantic.Compta.Lang.Math
+ Symantic.Compta.Eval
+ Symantic.Compta.Input
+ Symantic.Compta.Input.Chart
+ Symantic.Compta.Input.Journal
+ Symantic.Compta.Calc
+ Symantic.Compta.Calc.Balance
+ Symantic.Compta.Calc.Chart
+ Symantic.Compta.Calc.Flow
+ Symantic.Compta.Calc.Unit
+ Symantic.Compta.Demo
+ Symantic.Compta.Norm.PCG
+ Symantic.Compta.Norm.PCG.Chart
+ Symantic.Compta.Norm.PCG.Journal
+ Symantic.Compta.Utils.Error
+ Symantic.Compta.Utils.Foldable
+ Symantic.Compta.Utils.Monoid
+ Symantic.Compta.View
+ default-extensions:
+ BangPatterns,
+ BlockArguments,
+ DataKinds,
+ DeriveAnyClass,
+ DeriveFunctor,
+ DeriveGeneric,
+ DerivingStrategies,
+ FlexibleContexts,
+ FlexibleInstances,
+ GADTs,
+ GeneralizedNewtypeDeriving,
+ LambdaCase,
+ MultiParamTypeClasses,
+ NamedFieldPuns,
+ NoMonomorphismRestriction
+ --OverloadedLists,
+ --OverloadedStrings,
+ RankNTypes,
+ RebindableSyntax,
+ RecordWildCards,
+ ScopedTypeVariables,
+ StandaloneDeriving,
+ TupleSections,
+ TypeApplications,
+ TypeFamilies,
+ TypeOperators
+ build-depends:
+ base >=4.10 && <5,
+ symantic-document,
+ --array,
+ --bytestring,
+ containers,
+ Decimal >= 0.4,
+ deepseq >= 1.4,
+ --ghc-prim,
+ hashable,
+ monad-classes,
+ --template-haskell >= 2.15,
+ text,
+ time >= 1.6,
+ transformers,
+ unordered-containers
+
+executable symantic-compta-demo
+ type: exitcode-stdio-1.0
+ default-language: Haskell2010
+ ghc-options:
+ -Wall
+ -Wincomplete-uni-patterns
+ -Wincomplete-record-updates
+ -Wpartial-fields
+ -Wno-type-defaults
+ -Wno-missing-signatures
+ -fprint-potential-instances
+ hs-source-dirs: demo
+ main-is: Main.hs
+ other-modules:
+ build-depends:
+ symantic-compta,
+ base >= 4.6 && < 5,
+ containers,
+ --template-haskell >= 2.14,
+ transformers >= 0.5
sourcephile / git / haskell / symantic-compta.git / commitdiff