{-# LANGUAGE DeriveAnyClass #-}

module Literate.Accounting.Flow where

import Data.Bool
import Data.Eq (Eq)
import Data.Functor (Functor)
import Data.Maybe (Maybe (..))
import Data.Ord (Ord (..))
import GHC.Generics (Generic)
import Text.Show (Show (..))

import Literate.Accounting.Quantity
import Literate.Prelude

-- ** Type 'Flow'

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

instance FromInteger qty => FromInteger (Flow qty) where
  fromInteger i
    | i <= 0 = FlowDest (fromInteger i)
    | otherwise = FlowSource (fromInteger i)
instance (Zeroable a, Addable a) => Zeroable (Flow a) where
  zero = FlowSource zero
  isZero = \case
    FlowDest o -> isZero o
    FlowSource i -> isZero i
    FlowBidir o i -> isZero (o + i)
instance Addable a => Addable (Flow a) where
  FlowSource i + FlowDest o = FlowBidir o i
  FlowSource ix + FlowSource py = FlowSource (ix + py)
  FlowSource i + FlowBidir ny py = FlowBidir ny (i + py)
  FlowDest ox + FlowDest ny = FlowDest (ox + ny)
  FlowDest o + FlowSource i = FlowBidir o i
  FlowDest ox + FlowBidir ny i = FlowBidir (ox + ny) i
  FlowBidir ox ix + FlowDest o = FlowBidir (ox + o) ix
  FlowBidir ox ix + FlowSource 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
    FlowSource _ -> Nothing
    FlowDest _ -> Just f
    FlowBidir n _ -> Just (FlowDest n)
  inOf f = case f of
    FlowSource _ -> Just f
    FlowDest _ -> Nothing
    FlowBidir _ p -> Just (FlowSource p)

flowIn :: Flow a -> Maybe a
flowIn = \case
  FlowSource i -> Just i
  FlowDest _ -> Nothing
  FlowBidir _ i -> Just i

flowOut :: Flow a -> Maybe a
flowOut = \case
  FlowSource _ -> Nothing
  FlowDest o -> Just o
  FlowBidir o _ -> Just o

flow :: Flowable a => a -> Flow a
flow f =
  case (outOf f, inOf f) of
    (Just o, Nothing) -> FlowDest o
    (Nothing, Just i) -> FlowSource i
    (Just o, Just i) -> FlowBidir o i
    (Nothing, Nothing) -> FlowBidir f f
unFlow :: Addable a => Flow a -> a
unFlow = \case
  FlowSource i -> i
  FlowDest 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
-}