src/Literate/Accounting/Flow.hs

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