From f88b3f79eca74893b3f6aaf591d4ea2f706dd2ba Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Sat, 14 Aug 2021 11:12:18 +0200 Subject: [PATCH 1/1] init --- .envrc | 14 + .gitignore | 16 + Makefile | 6 + cabal.project | 1 + default.nix | 34 + flake.lock | 38 + flake.nix | 12 + hie.yaml | 6 + shell.nix | 1 + src/Symantic/Compta.hs | 10 + src/Symantic/Compta/Calc.hs | 10 + src/Symantic/Compta/Calc/Balance.hs | 388 ++++++++ src/Symantic/Compta/Calc/Chart.hs | 141 +++ src/Symantic/Compta/Calc/Flow.hs | 113 +++ src/Symantic/Compta/Calc/Unit.hs | 430 +++++++++ src/Symantic/Compta/Data.hs | 22 + src/Symantic/Compta/Demo.hs | 161 ++++ src/Symantic/Compta/Eval.hs | 151 +++ src/Symantic/Compta/HLint.hs | 16 + src/Symantic/Compta/Input.hs | 6 + src/Symantic/Compta/Input/Chart.hs | 42 + src/Symantic/Compta/Input/Journal.hs | 326 +++++++ src/Symantic/Compta/Lang.hs | 282 ++++++ src/Symantic/Compta/Lang/Math.hs | 121 +++ src/Symantic/Compta/Lang/Rebindable.hs | 136 +++ src/Symantic/Compta/Norm/PCG.hs | 6 + src/Symantic/Compta/Norm/PCG/Chart.hs | 1180 +++++++++++++++++++++++ src/Symantic/Compta/Norm/PCG/Journal.hs | 308 ++++++ src/Symantic/Compta/Norm/PCG/Lang.hs | 37 + src/Symantic/Compta/Utils/Error.hs | 10 + src/Symantic/Compta/Utils/Foldable.hs | 41 + src/Symantic/Compta/Utils/Monoid.hs | 10 + src/Symantic/Compta/View.hs | 28 + symantic-compta.cabal | 137 +++ 34 files changed, 4240 insertions(+) create mode 100644 .envrc create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 cabal.project create mode 100644 default.nix create mode 100644 flake.lock create mode 100644 flake.nix create mode 100644 hie.yaml create mode 100644 shell.nix create mode 100644 src/Symantic/Compta.hs create mode 100644 src/Symantic/Compta/Calc.hs create mode 100644 src/Symantic/Compta/Calc/Balance.hs create mode 100644 src/Symantic/Compta/Calc/Chart.hs create mode 100644 src/Symantic/Compta/Calc/Flow.hs create mode 100644 src/Symantic/Compta/Calc/Unit.hs create mode 100644 src/Symantic/Compta/Data.hs create mode 100644 src/Symantic/Compta/Demo.hs create mode 100644 src/Symantic/Compta/Eval.hs create mode 100644 src/Symantic/Compta/HLint.hs create mode 100644 src/Symantic/Compta/Input.hs create mode 100644 src/Symantic/Compta/Input/Chart.hs create mode 100644 src/Symantic/Compta/Input/Journal.hs create mode 100644 src/Symantic/Compta/Lang.hs create mode 100644 src/Symantic/Compta/Lang/Math.hs create mode 100644 src/Symantic/Compta/Lang/Rebindable.hs create mode 100644 src/Symantic/Compta/Norm/PCG.hs create mode 100644 src/Symantic/Compta/Norm/PCG/Chart.hs create mode 100644 src/Symantic/Compta/Norm/PCG/Journal.hs create mode 100644 src/Symantic/Compta/Norm/PCG/Lang.hs create mode 100644 src/Symantic/Compta/Utils/Error.hs create mode 100644 src/Symantic/Compta/Utils/Foldable.hs create mode 100644 src/Symantic/Compta/Utils/Monoid.hs create mode 100644 src/Symantic/Compta/View.hs create mode 100644 symantic-compta.cabal diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..406e743 --- /dev/null +++ b/.envrc @@ -0,0 +1,14 @@ +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 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..886d3f4 --- /dev/null +++ b/.gitignore @@ -0,0 +1,16 @@ +*.actual.* +*.eventlog +*.eventlog +*.eventlog.html +*.eventlog.json +*.hi +*.hp +*.o +*.prof +*.root +.direnv/ +.ghc.environment.* +.stack-work/ +dist-newstyle/ +dump-core/ +result* diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..7825d53 --- /dev/null +++ b/Makefile @@ -0,0 +1,6 @@ +all: + cabal run +ghci: + cabal repl +ghcid: + ghcid -c 'cabal repl --ghc-options -ignore-dot-ghci' --reverse-errors diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..dc68224 --- /dev/null +++ b/cabal.project @@ -0,0 +1 @@ +packages:. diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..ad03a6e --- /dev/null +++ b/default.nix @@ -0,0 +1,34 @@ +{ pkgs ? import {} +, 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; + }; +} diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..9142f87 --- /dev/null +++ b/flake.lock @@ -0,0 +1,38 @@ +{ + "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 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..494305f --- /dev/null +++ b/flake.nix @@ -0,0 +1,12 @@ +{ +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; + } + ); +} diff --git a/hie.yaml b/hie.yaml new file mode 100644 index 0000000..b9847a7 --- /dev/null +++ b/hie.yaml @@ -0,0 +1,6 @@ +cradle: + cabal: + - path: "./" + component: "symantic-compta" + - path: "./demo" + component: "symantic-compta:symantic-compta-demo" diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..0d9af5e --- /dev/null +++ b/shell.nix @@ -0,0 +1 @@ +(import ./. {}).shell diff --git a/src/Symantic/Compta.hs b/src/Symantic/Compta.hs new file mode 100644 index 0000000..0372494 --- /dev/null +++ b/src/Symantic/Compta.hs @@ -0,0 +1,10 @@ +{-# 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 diff --git a/src/Symantic/Compta/Calc.hs b/src/Symantic/Compta/Calc.hs new file mode 100644 index 0000000..f7358de --- /dev/null +++ b/src/Symantic/Compta/Calc.hs @@ -0,0 +1,10 @@ +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 diff --git a/src/Symantic/Compta/Calc/Balance.hs b/src/Symantic/Compta/Calc/Balance.hs new file mode 100644 index 0000000..f386214 --- /dev/null +++ b/src/Symantic/Compta/Calc/Balance.hs @@ -0,0 +1,388 @@ +{-# 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) diff --git a/src/Symantic/Compta/Calc/Chart.hs b/src/Symantic/Compta/Calc/Chart.hs new file mode 100644 index 0000000..89c6c46 --- /dev/null +++ b/src/Symantic/Compta/Calc/Chart.hs @@ -0,0 +1,141 @@ +{-# 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 diff --git a/src/Symantic/Compta/Calc/Flow.hs b/src/Symantic/Compta/Calc/Flow.hs new file mode 100644 index 0000000..02cdbd1 --- /dev/null +++ b/src/Symantic/Compta/Calc/Flow.hs @@ -0,0 +1,113 @@ +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 +-} diff --git a/src/Symantic/Compta/Calc/Unit.hs b/src/Symantic/Compta/Calc/Unit.hs new file mode 100644 index 0000000..1de55f0 --- /dev/null +++ b/src/Symantic/Compta/Calc/Unit.hs @@ -0,0 +1,430 @@ +{-# 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 "" + +-- | unit of currency. +chfUnit :: Unit +chfUnit = Unit "CHF" + +-- | unit of currency. +cnyUnit :: Unit +cnyUnit = Unit "Ұ" + +-- | unit of currency. +eurUnit :: Unit +eurUnit = Unit "€" + +-- | unit of currency. +gbpUnit :: Unit +gbpUnit = Unit "£" + +-- | unit of currency. +inrUnit :: Unit +inrUnit = Unit "₹" + +-- | unit of currency. +jpyUnit :: Unit +jpyUnit = Unit "¥" + +-- | unit of currency. +rubUnit :: Unit +rubUnit = Unit "₽" + +-- | 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 +-} diff --git a/src/Symantic/Compta/Data.hs b/src/Symantic/Compta/Data.hs new file mode 100644 index 0000000..139bbbf --- /dev/null +++ b/src/Symantic/Compta/Data.hs @@ -0,0 +1,22 @@ +{-# 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 diff --git a/src/Symantic/Compta/Demo.hs b/src/Symantic/Compta/Demo.hs new file mode 100644 index 0000000..782653b --- /dev/null +++ b/src/Symantic/Compta/Demo.hs @@ -0,0 +1,161 @@ +{-# 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"] + ] + -} diff --git a/src/Symantic/Compta/Eval.hs b/src/Symantic/Compta/Eval.hs new file mode 100644 index 0000000..5ce52cf --- /dev/null +++ b/src/Symantic/Compta/Eval.hs @@ -0,0 +1,151 @@ +{-# 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] +-} diff --git a/src/Symantic/Compta/HLint.hs b/src/Symantic/Compta/HLint.hs new file mode 100644 index 0000000..3cb2542 --- /dev/null +++ b/src/Symantic/Compta/HLint.hs @@ -0,0 +1,16 @@ +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 diff --git a/src/Symantic/Compta/Input.hs b/src/Symantic/Compta/Input.hs new file mode 100644 index 0000000..bcc09f3 --- /dev/null +++ b/src/Symantic/Compta/Input.hs @@ -0,0 +1,6 @@ +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 diff --git a/src/Symantic/Compta/Input/Chart.hs b/src/Symantic/Compta/Input/Chart.hs new file mode 100644 index 0000000..995b929 --- /dev/null +++ b/src/Symantic/Compta/Input/Chart.hs @@ -0,0 +1,42 @@ +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 diff --git a/src/Symantic/Compta/Input/Journal.hs b/src/Symantic/Compta/Input/Journal.hs new file mode 100644 index 0000000..f53d7a3 --- /dev/null +++ b/src/Symantic/Compta/Input/Journal.hs @@ -0,0 +1,326 @@ +{-# 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) + +-} diff --git a/src/Symantic/Compta/Lang.hs b/src/Symantic/Compta/Lang.hs new file mode 100644 index 0000000..fa46402 --- /dev/null +++ b/src/Symantic/Compta/Lang.hs @@ -0,0 +1,282 @@ +--{-# 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 & diff --git a/src/Symantic/Compta/Lang/Math.hs b/src/Symantic/Compta/Lang/Math.hs new file mode 100644 index 0000000..a8a76c0 --- /dev/null +++ b/src/Symantic/Compta/Lang/Math.hs @@ -0,0 +1,121 @@ +{-# 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) diff --git a/src/Symantic/Compta/Lang/Rebindable.hs b/src/Symantic/Compta/Lang/Rebindable.hs new file mode 100644 index 0000000..f4eb322 --- /dev/null +++ b/src/Symantic/Compta/Lang/Rebindable.hs @@ -0,0 +1,136 @@ +{-# 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 +-} diff --git a/src/Symantic/Compta/Norm/PCG.hs b/src/Symantic/Compta/Norm/PCG.hs new file mode 100644 index 0000000..217305f --- /dev/null +++ b/src/Symantic/Compta/Norm/PCG.hs @@ -0,0 +1,6 @@ +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 diff --git a/src/Symantic/Compta/Norm/PCG/Chart.hs b/src/Symantic/Compta/Norm/PCG/Chart.hs new file mode 100644 index 0000000..5d442fb --- /dev/null +++ b/src/Symantic/Compta/Norm/PCG/Chart.hs @@ -0,0 +1,1180 @@ +{-# 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@]*>Classe *\(\d*\) *: *\(\( *[^ <]\+\)\+\).*@compte \1 SystemAbrege "\2"@ +-- %s@]*>\(\d*\) *[-–] *\(\( *[^ <]\+\)\+\).*@compte SystemAbrege \1 "\2"@ +-- %s@]*>\(\d*\) *[-–] *\(\( *[^ <]\+\)\+\).*@compte \1 SystemDeBase "\2"@ +-- %s@]*>\(\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" + -- 61/62 - Autres charges externes + , 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" + ] diff --git a/src/Symantic/Compta/Norm/PCG/Journal.hs b/src/Symantic/Compta/Norm/PCG/Journal.hs new file mode 100644 index 0000000..9e2fc3a --- /dev/null +++ b/src/Symantic/Compta/Norm/PCG/Journal.hs @@ -0,0 +1,308 @@ +{-# 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) + diff --git a/src/Symantic/Compta/Norm/PCG/Lang.hs b/src/Symantic/Compta/Norm/PCG/Lang.hs new file mode 100644 index 0000000..d4648cf --- /dev/null +++ b/src/Symantic/Compta/Norm/PCG/Lang.hs @@ -0,0 +1,37 @@ +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' diff --git a/src/Symantic/Compta/Utils/Error.hs b/src/Symantic/Compta/Utils/Error.hs new file mode 100644 index 0000000..377e1f4 --- /dev/null +++ b/src/Symantic/Compta/Utils/Error.hs @@ -0,0 +1,10 @@ +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) diff --git a/src/Symantic/Compta/Utils/Foldable.hs b/src/Symantic/Compta/Utils/Foldable.hs new file mode 100644 index 0000000..c09c6f4 --- /dev/null +++ b/src/Symantic/Compta/Utils/Foldable.hs @@ -0,0 +1,41 @@ +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) diff --git a/src/Symantic/Compta/Utils/Monoid.hs b/src/Symantic/Compta/Utils/Monoid.hs new file mode 100644 index 0000000..3eeb767 --- /dev/null +++ b/src/Symantic/Compta/Utils/Monoid.hs @@ -0,0 +1,10 @@ +{-# 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` []) diff --git a/src/Symantic/Compta/View.hs b/src/Symantic/Compta/View.hs new file mode 100644 index 0000000..ad7042c --- /dev/null +++ b/src/Symantic/Compta/View.hs @@ -0,0 +1,28 @@ +{-# 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 diff --git a/symantic-compta.cabal b/symantic-compta.cabal new file mode 100644 index 0000000..46089ed --- /dev/null +++ b/symantic-compta.cabal @@ -0,0 +1,137 @@ +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 +maintainer: Julien Moutinho +copyright: Julien Moutinho +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 -- 2.47.0