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