]> Git — Sourcephile - haskell/literate-accounting.git/blob - src/Literate/Accounting/Flow.hs
wip
[haskell/literate-accounting.git] / src / Literate / Accounting / Flow.hs
1 module Literate.Accounting.Flow where
2
3 import Control.DeepSeq (NFData)
4 import Data.Bool
5 import Data.Eq (Eq)
6 import Data.Functor (Functor)
7 import Data.Maybe (Maybe (..))
8 import Data.Ord (Ord (..))
9 import GHC.Generics (Generic)
10 import Text.Show (Show (..))
11
12 import Literate.Accounting.Math
13 import Literate.Accounting.Rebindable
14
15 -- ** Type 'Flow'
16
17 {- | A 'Flow keeps track separatly of what goes 'In'
18 and what goes 'Out' of an account.
19 -}
20 data Flow a
21 = In !a
22 | Out !a
23 | Bidir !a !a
24 deriving (Eq, Show, Generic, NFData, Functor)
25
26 instance FromInteger qty => FromInteger (Flow qty) where
27 fromInteger i
28 | i <= 0 = Out (fromInteger i)
29 | otherwise = In (fromInteger i)
30
31 flowIn :: Flow a -> Maybe a
32 flowIn = \case
33 In i -> Just i
34 Out _ -> Nothing
35 Bidir _ i -> Just i
36
37 flowOut :: Flow a -> Maybe a
38 flowOut = \case
39 In _ -> Nothing
40 Out o -> Just o
41 Bidir o _ -> Just o
42
43 flow :: Flowable a => a -> Flow a
44 flow f =
45 case (outOf f, inOf f) of
46 (Just o, Nothing) -> Out o
47 (Nothing, Just i) -> In i
48 (Just o, Just i) -> Bidir o i
49 (Nothing, Nothing) -> Bidir f f
50 unFlow :: Addable a => Flow a -> a
51 unFlow = \case
52 In i -> i
53 Out o -> o
54 Bidir o i -> o + i
55
56 instance Zeroable a => Zeroable (Flow a) where
57 zero = In zero
58 instance (Nullable a, Addable a) => Nullable (Flow a) where
59 null = \case
60 Out o -> null o
61 In i -> null i
62 Bidir o i -> null (o + i)
63 instance Addable a => Addable (Flow a) where
64 In i + Out o = Bidir o i
65 In ix + In py = In (ix + py)
66 In i + Bidir ny py = Bidir ny (i + py)
67 Out ox + Out ny = Out (ox + ny)
68 Out o + In i = Bidir o i
69 Out ox + Bidir ny i = Bidir (ox + ny) i
70 Bidir ox ix + Out o = Bidir (ox + o) ix
71 Bidir ox ix + In py = Bidir ox (ix + py)
72 Bidir ox ix + Bidir ny py = Bidir (ox + ny) (ix + py)
73 instance Negable a => Negable (Flow a) where
74 negate = \case
75 In i -> Out (negate i)
76 Out o -> In (negate o)
77 Bidir o i -> Bidir (negate i) (negate o)
78 instance Flowable (Flow a) where
79 outOf f = case f of
80 In _ -> Nothing
81 Out _ -> Just f
82 Bidir n _ -> Just (Out n)
83 inOf f = case f of
84 In _ -> Just f
85 Out _ -> Nothing
86 Bidir _ p -> Just (In p)
87
88 --instance Eq
89
90 -- * Class 'Flowable'
91 class Flowable a where
92 outOf :: a -> Maybe a
93 inOf :: a -> Maybe a
94
95 {-
96 instance Flowable Decimal where
97 outOf q =
98 case q of
99 _ | q < 0 -> Just q
100 _ -> Nothing
101 inOf q =
102 case q of
103 _ | q <= 0 -> Nothing
104 _ -> Just q
105 instance Flowable a => Flowable (Map k a) where
106 inOf q =
107 case Map.mapMaybe inOf q of
108 m | Map.null m -> Nothing
109 m -> Just m
110 outOf q =
111 case Map.mapMaybe outOf q of
112 m | Map.null m -> Nothing
113 m -> Just m
114 instance Flowable a => Flowable (k, a) where
115 inOf (u, q) = (u,) <$> inOf q
116 outOf (u, q) = (u,) <$> outOf q
117 -}