module Symantic.Compta.Calc.Flow where

import Control.DeepSeq (NFData)
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 Symantic.Compta.Lang

-- ** Type 'Flow'
-- | A 'Flow keeps track separatly of what goes 'In'
-- and what goes 'Out' of an account.
data Flow a
  = In !a
  | Out !a
  | Bidir !a !a
  deriving (Eq, Show, Generic, NFData, Functor)

instance FromInteger qty => FromInteger (Flow qty) where
  fromInteger i | i <= 0 = Out (fromInteger i)
                | otherwise = In (fromInteger i)

flowIn :: Flow a -> Maybe a
flowIn = \case
  In i -> Just i
  Out _ -> Nothing
  Bidir _ i -> Just i

flowOut :: Flow a -> Maybe a
flowOut = \case
  In _ -> Nothing
  Out o -> Just o
  Bidir o _ -> Just o

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

instance Zeroable a => Zeroable (Flow a) where
  zero = In zero
instance (Nullable a, Addable a) => Nullable (Flow a) where
  null = \case
    Out o -> null o
    In i -> null i
    Bidir o i -> null (o + i)
instance Addable a => Addable (Flow a) where
  In i  + Out o = Bidir o i
  In ix + In py = In (ix + py)
  In i  + Bidir ny py = Bidir ny (i + py)

  Out ox + Out ny = Out (ox + ny)
  Out o  + In i  = Bidir o i
  Out ox + Bidir ny i = Bidir (ox + ny) i

  Bidir ox ix + Out o = Bidir (ox + o) ix
  Bidir ox ix + In py = Bidir ox (ix + py)
  Bidir ox ix + Bidir ny py = Bidir (ox + ny) (ix + py)
instance Negable a => Negable (Flow a) where
  negate = \case
    In i -> Out (negate i)
    Out o -> In (negate o)
    Bidir o i -> Bidir (negate i) (negate o)
instance Flowable (Flow a) where
  outOf f = case f of
    In _ -> Nothing
    Out _ -> Just f
    Bidir n _ -> Just (Out n)
  inOf f = case f of
    In _ -> Just f
    Out _ -> Nothing
    Bidir _ p -> Just (In p)
--instance Eq

-- * 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
-}