]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Account.hs
Correction : rétro support de GHC 7.6.3 (Debian/jessie).
[comptalang.git] / lib / Hcompta / Account.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE StandaloneDeriving #-}
5 {-# LANGUAGE TypeFamilies #-}
6 module Hcompta.Account where
7
8 import Control.DeepSeq (NFData(..))
9 import Data.Data (Data)
10 import qualified Data.Foldable
11 import Data.List.NonEmpty (NonEmpty(..))
12 import qualified Data.List.NonEmpty as NonEmpty
13 import Data.Maybe (Maybe(..))
14 import Data.Monoid (Monoid(..))
15 import Data.Ord (Ord(..))
16 import Prelude (($), (.), Integer, Num(..), const, id)
17 import Text.Show (Show(..))
18
19 import qualified Hcompta.Lib.NonEmpty as NonEmpty
20
21 -- * Class 'Account'
22
23 class
24 ( Ord a
25 , Data a
26 , Data (Account_Section a)
27 , NFData (Account_Section a)
28 , Ord (Account_Section a)
29 , Show (Account_Section a)
30 , Show a
31 ) => Account a where
32 type Account_Section a
33 account_path :: a -> Account_Path (Account_Section a)
34 type Account_Path = NonEmpty
35 instance (Data s, NFData s, Ord s, Show s) => Account (NonEmpty s) where
36 type Account_Section (NonEmpty s) = s
37 account_path = id
38
39 -- | Return the 'Account' formed by the given 'Account_Section' and 'Account_Section's.
40 path :: section -> [section] -> Account_Path section
41 path = (:|)
42
43 -- | Return the number of 'Account_Section's in the given 'Account_Path'.
44 depth :: Account a => a -> Integer
45 depth = Data.Foldable.foldl' (\d -> const $ d + 1) 0 . account_path
46
47 -- | Return the given 'Account' without its last 'Account_Section' if any.
48 ascending :: Account_Path a -> Maybe (Account_Path a)
49 ascending = NonEmpty.ascending
50
51 -- | Apply the given function to all the prefixes
52 -- of the given 'Account_Path' (including itself).
53 foldr :: Account_Path s -> (Account_Path s -> a -> a) -> a -> a
54 foldr (n0:|n0s) = go [] n0s
55 where
56 go s [] f acc = f (n0:|s) acc
57 go s (n:ns) f acc =
58 go (s `mappend` [n]) ns f (f (n0:|s) acc)
59
60 -- | Return an 'Account_Path' from the given list.
61 from_List :: [s] -> Account_Path s
62 from_List = NonEmpty.fromList