{-# LANGUAGE DeriveAnyClass #-}

module Literate.Accounting.Flow where

import Literate.Accounting.Quantity
import Literate.Prelude

-- ** Type 'Flow'

-- | A 'Flow keeps track separatly of what 'FlowOrigin'
--  and what 'FlowTarget' of an account.
data Flow a
  = FlowOrigin !a
  | FlowTarget !a
  | FlowBidir !a !a
  deriving (Eq, Show, Generic, NFData, Functor)

instance FromRational qty => FromRational (Flow qty) where
  fromRational i
    | i <= 0 = FlowTarget (fromRational i)
    | otherwise = FlowOrigin (fromRational i)
instance FromInteger qty => FromInteger (Flow qty) where
  fromInteger i
    | i <= 0 = FlowTarget (fromInteger i)
    | otherwise = FlowOrigin (fromInteger i)
instance (Zeroable a, Addable a) => Zeroable (Flow a) where
  zero = FlowOrigin zero
  isZero = \case
    FlowOrigin i -> isZero i
    FlowTarget o -> isZero o
    FlowBidir o i -> isZero (o + i)
instance Addable a => Addable (Flow a) where
  FlowOrigin i + FlowTarget o = FlowBidir o i
  FlowOrigin ix + FlowOrigin py = FlowOrigin (ix + py)
  FlowOrigin i + FlowBidir ny py = FlowBidir ny (i + py)
  FlowTarget ox + FlowTarget ny = FlowTarget (ox + ny)
  FlowTarget o + FlowOrigin i = FlowBidir o i
  FlowTarget ox + FlowBidir ny i = FlowBidir (ox + ny) i
  FlowBidir ox ix + FlowTarget o = FlowBidir (ox + o) ix
  FlowBidir ox ix + FlowOrigin py = FlowBidir ox (ix + py)
  FlowBidir ox ix + FlowBidir ny py = FlowBidir (ox + ny) (ix + py)
instance Flowable (Flow a) where
  outOf f = case f of
    FlowOrigin _ -> Nothing
    FlowTarget _ -> Just f
    FlowBidir n _ -> Just (FlowTarget n)
  inOf f = case f of
    FlowOrigin _ -> Just f
    FlowTarget _ -> Nothing
    FlowBidir _ p -> Just (FlowOrigin p)

flowOrigin :: Flow a -> Maybe a
flowOrigin = \case
  FlowOrigin i -> Just i
  FlowTarget _ -> Nothing
  FlowBidir _ i -> Just i

flowTarget :: Flow a -> Maybe a
flowTarget = \case
  FlowOrigin _ -> Nothing
  FlowTarget o -> Just o
  FlowBidir o _ -> Just o

flow :: Flowable a => a -> Flow a
flow f =
  case (outOf f, inOf f) of
    (Just o, Nothing) -> FlowTarget o
    (Nothing, Just i) -> FlowOrigin i
    (Just o, Just i) -> FlowBidir o i
    (Nothing, Nothing) -> FlowBidir f f
unFlow :: Addable a => Flow a -> a
unFlow = \case
  FlowOrigin i -> i
  FlowTarget o -> o
  FlowBidir o i -> o + i

-- * Class 'Flowable'
class Flowable a where
  outOf :: a -> Maybe a
  inOf :: a -> Maybe a

{-
instance Flowable Decimal where
  outOf q =
    case q of
     _ | q < 0 -> Just q
     _         -> Nothing
  inOf q =
    case q of
     _ | q <= 0 -> Nothing
     _          -> Just q
instance Flowable a => Flowable (Map k a) where
  inOf q =
    case Map.mapMaybe inOf q of
     m | Map.null m -> Nothing
     m -> Just m
  outOf q =
    case Map.mapMaybe outOf q of
     m | Map.null m -> Nothing
     m -> Just m
instance Flowable a => Flowable (k, a) where
  inOf (u, q) = (u,) <$> inOf q
  outOf (u, q) = (u,) <$> outOf q
-}