import qualified Hcompta.Account as Account
import Hcompta.Account (Account_Tags(..))
import qualified Hcompta.Balance as Balance
-import qualified Hcompta.Chart as Chart
+-- import qualified Hcompta.Chart as Chart
import Hcompta.Date (Date)
import qualified Hcompta.Date as Date
import qualified Hcompta.Filter.Amount as Filter.Amount
type Account_Section = Text
type Account_Path = Path Account_Section
-class Account a where
+class Account j a where
account_path :: a -> Account_Path
- account_tags :: a -> Account_Tags
+ account_tags :: j -> a -> Account_Tags
instance Account (Account_Tags, Account_Path) where
account_path = snd
- account_tags = fst
+ account_tags _j = fst
+{-
instance Account (Chart.Charted Account_Path Account_Path) where
account_path = Chart.charted
account_tags (Chart.Charted c a) = Chart.account_tags a c
+-}
-- ** Class 'Amount'
class
( Posting.Posting p
- , Account (Posting.Posting_Account p)
- , Amount (Posting.Posting_Amount p)
- ) => Posting p where
- posting_type :: p -> Posting_Type
-
-data Posting_Type
- = Posting_Type_Regular
- | Posting_Type_Virtual
- deriving (Data, Eq, Show, Typeable)
-
-newtype Posting_Typed posting
- = Posting_Typed (Posting_Type, posting)
- deriving (Data, Show, Functor)
-
-instance
- ( Posting.Posting p
- ) => Posting.Posting (Posting_Typed p) where
- type Posting_Account (Posting_Typed p) = Posting.Posting_Account p
- type Posting_Amount (Posting_Typed p) = Posting.Posting_Amount p
- type Posting_Amounts (Posting_Typed p) = Posting.Posting_Amounts p
- posting_account (Posting_Typed p) = Posting.posting_account (snd p)
- posting_amounts (Posting_Typed p) = Posting.posting_amounts (snd p)
-instance Posting p
- => Posting (Posting_Typed p) where
- posting_type (Posting_Typed p) = fst p
-
-instance Balance.Posting p
- => Balance.Posting (Posting_Typed p) where
- type Posting_Account (Posting_Typed p) = Balance.Posting_Account p
- type Posting_Quantity (Posting_Typed p) = Balance.Posting_Quantity p
- type Posting_Unit (Posting_Typed p) = Balance.Posting_Unit p
- posting_account (Posting_Typed p) = Balance.posting_account (snd p)
- posting_amounts (Posting_Typed p) = Balance.posting_amounts (snd p)
- posting_set_amounts m (Posting_Typed p) = Posting_Typed $ second (Balance.posting_set_amounts m) p
+ , Account j (Posting.Posting_Account p)
+ , Amount (Posting.Posting_Amount p)
+ ) => Posting j p
-- ** Class 'Transaction'
class
- ( Posting (Transaction_Posting t)
- , Foldable (Transaction_Postings t)
+ ( Posting j (Transaction_Posting t)
+ , Foldable (Transaction_Postings t)
)
- => Transaction t where
+ => Transaction j t where
type Transaction_Posting t
type Transaction_Postings t :: * -> *
transaction_date :: t -> Date
-- ** Class 'Balance'
class
- ( Account (Balance_Account b)
+ ( Account j (Balance_Account b)
, Amount (Balance_Amount b)
- ) => Balance b where
+ ) => Balance j b where
type Balance_Account b
type Balance_Amount b
balance_account :: b -> Balance_Account b
-- ** Class 'GL'
class
- ( Account (GL_Account g)
- , Amount (GL_Amount g)
- ) => GL g where
+ ( Account j (GL_Account g)
+ , Amount (GL_Amount g)
+ ) => GL j g where
type GL_Account g
type GL_Amount g
gl_account :: g -> GL_Account g
let h = Interval.high i in
case f of
Filter_Ord Lt o -> case compare (Interval.limit h) o of
- LT -> True
- EQ -> Interval.adherence h == Interval.Out
- GT -> False
+ LT -> True
+ EQ -> Interval.adherence h == Interval.Out
+ GT -> False
Filter_Ord Le o -> Interval.limit h <= o
Filter_Ord Eq o -> Interval.limit l == o && Interval.limit h == o
Filter_Ord Ge o -> Interval.limit l >= o
Filter_Ord Gt o -> case compare (Interval.limit l) o of
- LT -> False
- EQ -> Interval.adherence l == Interval.Out
- GT -> True
+ LT -> False
+ EQ -> Interval.adherence l == Interval.Out
+ GT -> True
Filter_Ord_Any -> True
simplify f =
Simplified $
instance Account a
=> Filter (Filter_Account_Component a) where
type Filter_Key (Filter_Account_Component a) = a
- test (Filter_Account_Path f) a = test f $ account_path a
- test (Filter_Account_Tag f) a =
+ test (Filter_Account_Path f) a = test f $ account_path a
+ test (Filter_Account_Tag f) a =
let Account_Tags tags = account_tags a in
test f tags
simplify f =
Filter_Amount_Section_Quantity ff -> Filter_Amount_Section_Quantity <$> simplify ff
Filter_Amount_Section_Unit ff -> Filter_Amount_Section_Unit <$> simplify ff
--- ** Type 'Filter_Posting_Type'
-
-data Filter_Posting_Type
- = Filter_Posting_Type_Any
- | Filter_Posting_Type_Exact Posting_Type
- deriving (Data, Eq, Show, Typeable)
-
-instance Filter Filter_Posting_Type where
- type Filter_Key Filter_Posting_Type = Posting_Type
- test f p =
- case f of
- Filter_Posting_Type_Any -> True
- Filter_Posting_Type_Exact ff -> ff == p
- simplify f =
- Simplified $
- case f of
- Filter_Posting_Type_Any -> Right True
- Filter_Posting_Type_Exact _ -> Left f
-
-- ** Type 'Filter_Date'
data Filter_Date
-- ** Type 'Filter_Posting'
-data Posting p
- => Filter_Posting p
+data Posting j p
+ => Filter_Posting j p
= Filter_Posting_Account (Filter_Account (Posting.Posting_Account p))
| Filter_Posting_Amount (Filter_Amount (Posting.Posting_Amount p))
| Filter_Posting_Unit (Filter_Unit (Amount_Unit (Posting.Posting_Amount p))) -- TODO: remove: Filter_Posting_Amount should be enough
- | Filter_Posting_Type Filter_Posting_Type
deriving (Typeable)
-- Virtual
-- Wording Comp_String String
test f $ Posting.posting_account p
test (Filter_Posting_Amount f) p =
any (test f) $ Posting.posting_amounts p
- test (Filter_Posting_Type f) p =
- test f $ posting_type p
test (Filter_Posting_Unit f) p =
any (test f . amount_unit) $ Posting.posting_amounts p
simplify f =
case f of
Filter_Posting_Account ff -> Filter_Posting_Account <$> simplify ff
Filter_Posting_Amount ff -> Filter_Posting_Amount <$> simplify ff
- Filter_Posting_Type ff -> Filter_Posting_Type <$> simplify ff
Filter_Posting_Unit ff -> Filter_Posting_Unit <$> simplify ff
{-
-- ** Type 'Filter_Transaction'
-data Transaction t
- => Filter_Transaction t
+data Transaction j t
+ => Filter_Transaction j t
= Filter_Transaction_Date (Filter_Bool Filter_Date)
-- | Filter_Transaction_Posting (Filter_Bool (Filter_Posting (Posting_Typed (Transaction_Posting t))))
- | Filter_Transaction_Posting (Filter_Bool (Filter_Posting (Posting_Typed (Transaction_Posting t))))
+ | Filter_Transaction_Posting (Filter_Bool (Filter_Posting (Transaction_Posting t)))
| Filter_Transaction_Tag Filter_Tags
| Filter_Transaction_Wording Filter_Wording
deriving (Typeable)
=> Filter (Filter_Transaction t) where
type Filter_Key (Filter_Transaction t) = t
test (Filter_Transaction_Posting f) t =
- any
- (test f . Posting_Typed . (Posting_Type_Regular,))
- (transaction_postings t)
+ any (test f) (transaction_postings t)
test (Filter_Transaction_Date f) t =
test f $ transaction_date t
test (Filter_Transaction_Tag f) t =