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 FromInteger qty => FromInteger (Flow qty) where
  27   fromInteger i
  28     | i <= 0 = FlowDest (fromInteger i)
  29     | otherwise = FlowSource (fromInteger i)
  30 instance (Zeroable a, Addable a) => Zeroable (Flow a) where
  31   zero = FlowSource zero
  32   isZero = \case
  33     FlowDest o -> isZero o
  34     FlowSource i -> isZero i
  35     FlowBidir o i -> isZero (o + i)
  36 instance Addable a => Addable (Flow a) where
  37   FlowSource i + FlowDest o = FlowBidir o i
  38   FlowSource ix + FlowSource py = FlowSource (ix + py)
  39   FlowSource i + FlowBidir ny py = FlowBidir ny (i + py)
  40   FlowDest ox + FlowDest ny = FlowDest (ox + ny)
  41   FlowDest o + FlowSource i = FlowBidir o i
  42   FlowDest ox + FlowBidir ny i = FlowBidir (ox + ny) i
  43   FlowBidir ox ix + FlowDest o = FlowBidir (ox + o) ix
  44   FlowBidir ox ix + FlowSource py = FlowBidir ox (ix + py)
  45   FlowBidir ox ix + FlowBidir ny py = FlowBidir (ox + ny) (ix + py)
  46 instance Flowable (Flow a) where
  47   outOf f = case f of
  48     FlowSource _ -> Nothing
  49     FlowDest _ -> Just f
  50     FlowBidir n _ -> Just (FlowDest n)
  51   inOf f = case f of
  52     FlowSource _ -> Just f
  53     FlowDest _ -> Nothing
  54     FlowBidir _ p -> Just (FlowSource p)
  55
  56 flowIn :: Flow a -> Maybe a
  57 flowIn = \case
  58   FlowSource i -> Just i
  59   FlowDest _ -> Nothing
  60   FlowBidir _ i -> Just i
  61
  62 flowOut :: Flow a -> Maybe a
  63 flowOut = \case
  64   FlowSource _ -> Nothing
  65   FlowDest o -> Just o
  66   FlowBidir o _ -> Just o
  67
  68 flow :: Flowable a => a -> Flow a
  69 flow f =
  70   case (outOf f, inOf f) of
  71     (Just o, Nothing) -> FlowDest o
  72     (Nothing, Just i) -> FlowSource i
  73     (Just o, Just i) -> FlowBidir o i
  74     (Nothing, Nothing) -> FlowBidir f f
  75 unFlow :: Addable a => Flow a -> a
  76 unFlow = \case
  77   FlowSource i -> i
  78   FlowDest o -> o
  79   FlowBidir o i -> o + i
  80
  81 -- * Class 'Flowable'
  82 class Flowable a where
  83   outOf :: a -> Maybe a
  84   inOf :: a -> Maybe a
  85
  86 {-
  87 instance Flowable Decimal where
  88   outOf q =
  89     case q of
  90      _ | q < 0 -> Just q
  91      _         -> Nothing
  92   inOf q =
  93     case q of
  94      _ | q <= 0 -> Nothing
  95      _          -> Just q
  96 instance Flowable a => Flowable (Map k a) where
  97   inOf q =
  98     case Map.mapMaybe inOf q of
  99      m | Map.null m -> Nothing
 100      m -> Just m
 101   outOf q =
 102     case Map.mapMaybe outOf q of
 103      m | Map.null m -> Nothing
 104      m -> Just m
 105 instance Flowable a => Flowable (k, a) where
 106   inOf (u, q) = (u,) <$> inOf q
 107   outOf (u, q) = (u,) <$> outOf q
 108 -}