From: Julien Moutinho Date: Sat, 14 Aug 2021 09:12:18 +0000 (+0200) Subject: init X-Git-Url: https://git.sourcephile.fr/haskell/symantic-compta.git/commitdiff_plain init --- f88b3f79eca74893b3f6aaf591d4ea2f706dd2ba 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