{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RecordWildCards #-}

-- | This module provides FIFO machinery for inventory accounting.
module Haspara.Accounting.Inventory where

import qualified Data.Aeson as Aeson
import Data.Default (Default (..))
import Data.Maybe (fromMaybe)
import qualified Data.Sequence as Seq
import Data.Time (Day)
import GHC.Generics (Generic)
import GHC.TypeLits (KnownNat, Nat)
import Haspara.Internal.Aeson (commonAesonOptions)
import Haspara.Quantity (Quantity, divideD, times)


-- * Data Definitions


-- | Data definition that keeps track of inventory for an economic resource.
--
-- This data definition is polymorphic over the precision for, respectively:
--
-- 1. @pprec@ precision of the price values,
-- 2. @sprec@ precision of the inventory event quantities, and
-- 3. @vprec@ precision of the monetary values such as PnL.
--
-- Values of this type should not be directly manipulated. Instead, `def` is to
-- be used for initializing an empty inventory and `updateInventory` method (and
-- convenience wrappers) should be used to update the inventory with new
-- inventory events.
data Inventory (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) = MkInventory
  { forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Quantity sprec
inventoryTotal :: !(Quantity sprec)
  , forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Seq (InventoryEvent pprec sprec)
inventoryCurrent :: !(Seq.Seq (InventoryEvent pprec sprec))
  , forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec
-> Seq (InventoryHistoryItem pprec sprec vprec)
inventoryHistory :: !(Seq.Seq (InventoryHistoryItem pprec sprec vprec))
  }
  deriving (Inventory pprec sprec vprec -> Inventory pprec sprec vprec -> Bool
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Inventory pprec sprec vprec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inventory pprec sprec vprec -> Inventory pprec sprec vprec -> Bool
$c/= :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Inventory pprec sprec vprec -> Bool
== :: Inventory pprec sprec vprec -> Inventory pprec sprec vprec -> Bool
$c== :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Inventory pprec sprec vprec -> Bool
Eq, forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
Rep (Inventory pprec sprec vprec) x -> Inventory pprec sprec vprec
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
Inventory pprec sprec vprec -> Rep (Inventory pprec sprec vprec) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
Rep (Inventory pprec sprec vprec) x -> Inventory pprec sprec vprec
$cfrom :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
Inventory pprec sprec vprec -> Rep (Inventory pprec sprec vprec) x
Generic, Int -> Inventory pprec sprec vprec -> ShowS
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat sprec, KnownNat pprec, KnownNat vprec) =>
Int -> Inventory pprec sprec vprec -> ShowS
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat sprec, KnownNat pprec, KnownNat vprec) =>
[Inventory pprec sprec vprec] -> ShowS
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat sprec, KnownNat pprec, KnownNat vprec) =>
Inventory pprec sprec vprec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inventory pprec sprec vprec] -> ShowS
$cshowList :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat sprec, KnownNat pprec, KnownNat vprec) =>
[Inventory pprec sprec vprec] -> ShowS
show :: Inventory pprec sprec vprec -> String
$cshow :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat sprec, KnownNat pprec, KnownNat vprec) =>
Inventory pprec sprec vprec -> String
showsPrec :: Int -> Inventory pprec sprec vprec -> ShowS
$cshowsPrec :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat sprec, KnownNat pprec, KnownNat vprec) =>
Int -> Inventory pprec sprec vprec -> ShowS
Show)


instance (KnownNat pprec, KnownNat sprec, KnownNat vprec) => Default (Inventory pprec sprec vprec) where
  def :: Inventory pprec sprec vprec
def =
    MkInventory
      { inventoryTotal :: Quantity sprec
inventoryTotal = Quantity sprec
0
      , inventoryCurrent :: Seq (InventoryEvent pprec sprec)
inventoryCurrent = forall a. Monoid a => a
mempty
      , inventoryHistory :: Seq (InventoryHistoryItem pprec sprec vprec)
inventoryHistory = forall a. Monoid a => a
mempty
      }


instance (KnownNat pprec, KnownNat sprec, KnownNat vprec) => Aeson.FromJSON (Inventory pprec sprec vprec) where
  parseJSON :: Value -> Parser (Inventory pprec sprec vprec)
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventory"


instance (KnownNat pprec, KnownNat sprec, KnownNat vprec) => Aeson.ToJSON (Inventory pprec sprec vprec) where
  toJSON :: Inventory pprec sprec vprec -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventory"
  toEncoding :: Inventory pprec sprec vprec -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventory"


-- | Data definition for inventory events.
--
-- This data definition is polymorphic over the precision for, respectively:
--
-- 1. @pprec@ precision of the price values, and
-- 2. @sprec@ precision of the inventory event quantities.
data InventoryEvent (pprec :: Nat) (sprec :: Nat) = InventoryEvent
  { forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Day
inventoryEventDate :: !Day
  , forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity pprec
inventoryEventPrice :: !(Quantity pprec)
  , forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventQuantity :: !(Quantity sprec)
  }
  deriving (InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Bool
forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Bool
$c/= :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Bool
== :: InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Bool
$c== :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Bool
Eq, forall (pprec :: Nat) (sprec :: Nat) x.
Rep (InventoryEvent pprec sprec) x -> InventoryEvent pprec sprec
forall (pprec :: Nat) (sprec :: Nat) x.
InventoryEvent pprec sprec -> Rep (InventoryEvent pprec sprec) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (pprec :: Nat) (sprec :: Nat) x.
Rep (InventoryEvent pprec sprec) x -> InventoryEvent pprec sprec
$cfrom :: forall (pprec :: Nat) (sprec :: Nat) x.
InventoryEvent pprec sprec -> Rep (InventoryEvent pprec sprec) x
Generic, Int -> InventoryEvent pprec sprec -> ShowS
forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
Int -> InventoryEvent pprec sprec -> ShowS
forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
[InventoryEvent pprec sprec] -> ShowS
forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
InventoryEvent pprec sprec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InventoryEvent pprec sprec] -> ShowS
$cshowList :: forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
[InventoryEvent pprec sprec] -> ShowS
show :: InventoryEvent pprec sprec -> String
$cshow :: forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
InventoryEvent pprec sprec -> String
showsPrec :: Int -> InventoryEvent pprec sprec -> ShowS
$cshowsPrec :: forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
Int -> InventoryEvent pprec sprec -> ShowS
Show)


instance (KnownNat pprec, KnownNat sprec) => Aeson.FromJSON (InventoryEvent pprec sprec) where
  parseJSON :: Value -> Parser (InventoryEvent pprec sprec)
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventoryEvent"


instance (KnownNat pprec, KnownNat sprec) => Aeson.ToJSON (InventoryEvent pprec sprec) where
  toJSON :: InventoryEvent pprec sprec -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventoryEvent"
  toEncoding :: InventoryEvent pprec sprec -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventoryEvent"


-- | Data definition for PnL-taking inventory history items.
--
-- Essentially, values of this type represent a pnl-taking for a long/short
-- inventory event and a matching short/long inventory event of the same
-- quantity. Date refers to the date of the later event. If prices are
-- different, PnL is non-zero.
--
-- This data definition is polymorphic over the precision for, respectively:
--
-- 1. @pprec@ precision of the price values,
-- 2. @sprec@ precision of the inventory event quantities, and
-- 3. @vprec@ precision of the monetary values such as PnL.
--
-- Values of this type should not be directly manipulated. `updateInventory`
-- method (and convenience wrappers) are in charge of creating values of this
-- data type.
data InventoryHistoryItem (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) = MkInventoryHistoryItem
  { forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
InventoryHistoryItem pprec sprec vprec -> Day
inventoryHistoryItemDate :: !Day
  , forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
InventoryHistoryItem pprec sprec vprec -> Quantity vprec
inventoryHistoryItemPnl :: !(Quantity vprec)
  , forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
InventoryHistoryItem pprec sprec vprec
-> InventoryEvent pprec sprec
inventoryHistoryItemFst :: !(InventoryEvent pprec sprec)
  , forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
InventoryHistoryItem pprec sprec vprec
-> InventoryEvent pprec sprec
inventoryHistoryItemSnd :: !(InventoryEvent pprec sprec)
  }
  deriving (InventoryHistoryItem pprec sprec vprec
-> InventoryHistoryItem pprec sprec vprec -> Bool
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
InventoryHistoryItem pprec sprec vprec
-> InventoryHistoryItem pprec sprec vprec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InventoryHistoryItem pprec sprec vprec
-> InventoryHistoryItem pprec sprec vprec -> Bool
$c/= :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
InventoryHistoryItem pprec sprec vprec
-> InventoryHistoryItem pprec sprec vprec -> Bool
== :: InventoryHistoryItem pprec sprec vprec
-> InventoryHistoryItem pprec sprec vprec -> Bool
$c== :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
InventoryHistoryItem pprec sprec vprec
-> InventoryHistoryItem pprec sprec vprec -> Bool
Eq, forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
Rep (InventoryHistoryItem pprec sprec vprec) x
-> InventoryHistoryItem pprec sprec vprec
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
InventoryHistoryItem pprec sprec vprec
-> Rep (InventoryHistoryItem pprec sprec vprec) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
Rep (InventoryHistoryItem pprec sprec vprec) x
-> InventoryHistoryItem pprec sprec vprec
$cfrom :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
InventoryHistoryItem pprec sprec vprec
-> Rep (InventoryHistoryItem pprec sprec vprec) x
Generic, Int -> InventoryHistoryItem pprec sprec vprec -> ShowS
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat vprec, KnownNat pprec, KnownNat sprec) =>
Int -> InventoryHistoryItem pprec sprec vprec -> ShowS
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat vprec, KnownNat pprec, KnownNat sprec) =>
[InventoryHistoryItem pprec sprec vprec] -> ShowS
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat vprec, KnownNat pprec, KnownNat sprec) =>
InventoryHistoryItem pprec sprec vprec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InventoryHistoryItem pprec sprec vprec] -> ShowS
$cshowList :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat vprec, KnownNat pprec, KnownNat sprec) =>
[InventoryHistoryItem pprec sprec vprec] -> ShowS
show :: InventoryHistoryItem pprec sprec vprec -> String
$cshow :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat vprec, KnownNat pprec, KnownNat sprec) =>
InventoryHistoryItem pprec sprec vprec -> String
showsPrec :: Int -> InventoryHistoryItem pprec sprec vprec -> ShowS
$cshowsPrec :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat vprec, KnownNat pprec, KnownNat sprec) =>
Int -> InventoryHistoryItem pprec sprec vprec -> ShowS
Show)


instance (KnownNat pprec, KnownNat sprec, KnownNat vprec) => Aeson.FromJSON (InventoryHistoryItem pprec sprec vprec) where
  parseJSON :: Value -> Parser (InventoryHistoryItem pprec sprec vprec)
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventoryHistoryItem"


instance (KnownNat pprec, KnownNat sprec, KnownNat vprec) => Aeson.ToJSON (InventoryHistoryItem pprec sprec vprec) where
  toJSON :: InventoryHistoryItem pprec sprec vprec -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventoryHistoryItem"
  toEncoding :: InventoryHistoryItem pprec sprec vprec -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventoryHistoryItem"


-- * Operations


-- | Processes a new inventory event onto the inventory.
--
-- Any event with @0@ quantity is disregarded.
updateInventory
  :: KnownNat pprec
  => KnownNat sprec
  => KnownNat vprec
  => InventoryEvent pprec sprec
  -> Inventory pprec sprec vprec
  -> (Seq.Seq (InventoryHistoryItem pprec sprec vprec), Inventory pprec sprec vprec)
updateInventory :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
InventoryEvent pprec sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
updateInventory InventoryEvent pprec sprec
event Inventory pprec sprec vprec
inventory = case forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventQuantity InventoryEvent pprec sprec
event of
  Quantity sprec
0 -> (forall a. Monoid a => a
mempty, Inventory pprec sprec vprec
inventory)
  Quantity sprec
_ -> forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
Seq (InventoryHistoryItem pprec sprec vprec)
-> InventoryEvent pprec sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
updateInventoryAux forall a. Monoid a => a
mempty InventoryEvent pprec sprec
event Inventory pprec sprec vprec
inventory


-- | Convenience wrapper for 'updateInventory' which works with date, price and
-- quantity.
updateInventoryVP
  :: KnownNat pprec
  => KnownNat sprec
  => KnownNat vprec
  => Day
  -> Quantity pprec
  -> Quantity sprec
  -> Inventory pprec sprec vprec
  -> (Seq.Seq (InventoryHistoryItem pprec sprec vprec), Inventory pprec sprec vprec)
updateInventoryVP :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
Day
-> Quantity pprec
-> Quantity sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
updateInventoryVP Day
date Quantity pprec
price Quantity sprec
quantity =
  forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
InventoryEvent pprec sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
updateInventory forall a b. (a -> b) -> a -> b
$
    InventoryEvent
      { inventoryEventDate :: Day
inventoryEventDate = Day
date
      , inventoryEventPrice :: Quantity pprec
inventoryEventPrice = Quantity pprec
price
      , inventoryEventQuantity :: Quantity sprec
inventoryEventQuantity = Quantity sprec
quantity
      }


-- | Convenience wrapper for 'updateInventory' which works with date, price and
-- quantity.
updateInventoryVV
  :: KnownNat pprec
  => KnownNat sprec
  => KnownNat vprec
  => Day
  -> Quantity vprec
  -> Quantity sprec
  -> Inventory pprec sprec vprec
  -> (Seq.Seq (InventoryHistoryItem pprec sprec vprec), Inventory pprec sprec vprec)
updateInventoryVV :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
Day
-> Quantity vprec
-> Quantity sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
updateInventoryVV Day
date Quantity vprec
value Quantity sprec
quantity =
  let price :: Quantity pprec
price = forall a. a -> Maybe a -> a
fromMaybe Quantity pprec
0 forall a b. (a -> b) -> a -> b
$ Quantity vprec
value forall (r :: Nat) (s :: Nat) (k :: Nat).
(KnownNat r, KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Maybe (Quantity r)
`divideD` Quantity sprec
quantity
   in forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
Day
-> Quantity pprec
-> Quantity sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
updateInventoryVP Day
date (forall a. Num a => a -> a
abs Quantity pprec
price) Quantity sprec
quantity


-- * Internal Definitions


-- | Work-horse function for updating inventory.
--
-- This is where the whole trick happens in this module.
updateInventoryAux
  :: KnownNat pprec
  => KnownNat sprec
  => KnownNat vprec
  => Seq.Seq (InventoryHistoryItem pprec sprec vprec)
  -> InventoryEvent pprec sprec
  -> Inventory pprec sprec vprec
  -> (Seq.Seq (InventoryHistoryItem pprec sprec vprec), Inventory pprec sprec vprec)
updateInventoryAux :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
Seq (InventoryHistoryItem pprec sprec vprec)
-> InventoryEvent pprec sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
updateInventoryAux Seq (InventoryHistoryItem pprec sprec vprec)
history InventoryEvent pprec sprec
event inventory :: Inventory pprec sprec vprec
inventory@MkInventory {Seq (InventoryHistoryItem pprec sprec vprec)
Seq (InventoryEvent pprec sprec)
Quantity sprec
inventoryHistory :: Seq (InventoryHistoryItem pprec sprec vprec)
inventoryCurrent :: Seq (InventoryEvent pprec sprec)
inventoryTotal :: Quantity sprec
inventoryHistory :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec
-> Seq (InventoryHistoryItem pprec sprec vprec)
inventoryCurrent :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Seq (InventoryEvent pprec sprec)
inventoryTotal :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Quantity sprec
..} =
  case forall a. Seq a -> ViewL a
Seq.viewl Seq (InventoryEvent pprec sprec)
inventoryCurrent of
    ViewL (InventoryEvent pprec sprec)
Seq.EmptyL -> (Seq (InventoryHistoryItem pprec sprec vprec)
history, forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
InventoryEvent pprec sprec
-> Inventory pprec sprec vprec -> Inventory pprec sprec vprec
addInventoryEvent InventoryEvent pprec sprec
event Inventory pprec sprec vprec
inventory)
    InventoryEvent pprec sprec
i Seq.:< Seq (InventoryEvent pprec sprec)
is -> case forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
InventoryEvent pprec sprec
-> InventoryEvent pprec sprec -> Munch sprec
whatMunch InventoryEvent pprec sprec
event InventoryEvent pprec sprec
i of
      Munch sprec
MunchNo -> (Seq (InventoryHistoryItem pprec sprec vprec)
history, forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
InventoryEvent pprec sprec
-> Inventory pprec sprec vprec -> Inventory pprec sprec vprec
addInventoryEvent InventoryEvent pprec sprec
event Inventory pprec sprec vprec
inventory)
      Munch sprec
MunchAll ->
        let (InventoryHistoryItem pprec sprec vprec
historyItem, Inventory pprec sprec vprec
newInventory) = forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
InventoryEvent pprec sprec
-> InventoryEvent pprec sprec
-> Seq (InventoryEvent pprec sprec)
-> Inventory pprec sprec vprec
-> (InventoryHistoryItem pprec sprec vprec,
    Inventory pprec sprec vprec)
munchAll InventoryEvent pprec sprec
event InventoryEvent pprec sprec
i Seq (InventoryEvent pprec sprec)
is Inventory pprec sprec vprec
inventory
         in (Seq (InventoryHistoryItem pprec sprec vprec)
history forall a. Seq a -> a -> Seq a
Seq.|> InventoryHistoryItem pprec sprec vprec
historyItem, Inventory pprec sprec vprec
newInventory)
      MunchLeft Quantity sprec
quan ->
        let (InventoryEvent pprec sprec
newEvent, InventoryEvent pprec sprec
remEvent) = forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
Quantity sprec
-> InventoryEvent pprec sprec
-> (InventoryEvent pprec sprec, InventoryEvent pprec sprec)
splitEvent Quantity sprec
quan InventoryEvent pprec sprec
event
            (InventoryHistoryItem pprec sprec vprec
historyItem, Inventory pprec sprec vprec
newInventory) = forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
InventoryEvent pprec sprec
-> InventoryEvent pprec sprec
-> Seq (InventoryEvent pprec sprec)
-> Inventory pprec sprec vprec
-> (InventoryHistoryItem pprec sprec vprec,
    Inventory pprec sprec vprec)
munchAll InventoryEvent pprec sprec
newEvent InventoryEvent pprec sprec
i Seq (InventoryEvent pprec sprec)
is Inventory pprec sprec vprec
inventory
         in forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
Seq (InventoryHistoryItem pprec sprec vprec)
-> InventoryEvent pprec sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
updateInventoryAux (Seq (InventoryHistoryItem pprec sprec vprec)
history forall a. Seq a -> a -> Seq a
Seq.|> InventoryHistoryItem pprec sprec vprec
historyItem) InventoryEvent pprec sprec
remEvent Inventory pprec sprec vprec
newInventory
      MunchRight Quantity sprec
quan ->
        let (InventoryEvent pprec sprec
newEvent, InventoryEvent pprec sprec
remEvent) = forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
Quantity sprec
-> InventoryEvent pprec sprec
-> (InventoryEvent pprec sprec, InventoryEvent pprec sprec)
splitEvent Quantity sprec
quan InventoryEvent pprec sprec
i
            (InventoryHistoryItem pprec sprec vprec
historyItem, Inventory pprec sprec vprec
newInventory) = forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
InventoryEvent pprec sprec
-> InventoryEvent pprec sprec
-> Seq (InventoryEvent pprec sprec)
-> Inventory pprec sprec vprec
-> (InventoryHistoryItem pprec sprec vprec,
    Inventory pprec sprec vprec)
munchAll InventoryEvent pprec sprec
event InventoryEvent pprec sprec
newEvent (InventoryEvent pprec sprec
remEvent forall a. a -> Seq a -> Seq a
Seq.<| Seq (InventoryEvent pprec sprec)
is) Inventory pprec sprec vprec
inventory
         in (Seq (InventoryHistoryItem pprec sprec vprec)
history forall a. Seq a -> a -> Seq a
Seq.|> InventoryHistoryItem pprec sprec vprec
historyItem, Inventory pprec sprec vprec
newInventory)


-- | Splits the event into two events as per the given quantity.
--
-- If the event has a quantity of @100@ and the desired quantity is @10@, this
-- function spits out two event with same information except that the first has
-- a quantity of @10@ and the second has a quantity of @90@.
splitEvent
  :: KnownNat pprec
  => KnownNat sprec
  => Quantity sprec
  -> InventoryEvent pprec sprec
  -> (InventoryEvent pprec sprec, InventoryEvent pprec sprec)
splitEvent :: forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
Quantity sprec
-> InventoryEvent pprec sprec
-> (InventoryEvent pprec sprec, InventoryEvent pprec sprec)
splitEvent Quantity sprec
qty event :: InventoryEvent pprec sprec
event@InventoryEvent {Day
Quantity pprec
Quantity sprec
inventoryEventQuantity :: Quantity sprec
inventoryEventPrice :: Quantity pprec
inventoryEventDate :: Day
inventoryEventQuantity :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventPrice :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity pprec
inventoryEventDate :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Day
..} =
  let newItemQty :: Quantity sprec
newItemQty = (-Quantity sprec
qty)
      remItemQty :: Quantity sprec
remItemQty = Quantity sprec
inventoryEventQuantity forall a. Num a => a -> a -> a
+ Quantity sprec
qty

      newItem :: InventoryEvent pprec sprec
newItem = InventoryEvent pprec sprec
event {inventoryEventQuantity :: Quantity sprec
inventoryEventQuantity = Quantity sprec
newItemQty}
      remItem :: InventoryEvent pprec sprec
remItem = InventoryEvent pprec sprec
event {inventoryEventQuantity :: Quantity sprec
inventoryEventQuantity = Quantity sprec
remItemQty}
   in (InventoryEvent pprec sprec
newItem, InventoryEvent pprec sprec
remItem)


-- | Pushes a new inventory event to the inventory.
--
-- This function is to be called by the internal machinery that handles most of
-- the critical tasks. Direct calls to this function will bypass the entire
-- machinery.
addInventoryEvent
  :: KnownNat pprec
  => KnownNat sprec
  => KnownNat vprec
  => InventoryEvent pprec sprec
  -> Inventory pprec sprec vprec
  -> Inventory pprec sprec vprec
addInventoryEvent :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
InventoryEvent pprec sprec
-> Inventory pprec sprec vprec -> Inventory pprec sprec vprec
addInventoryEvent event :: InventoryEvent pprec sprec
event@InventoryEvent {Day
Quantity pprec
Quantity sprec
inventoryEventQuantity :: Quantity sprec
inventoryEventPrice :: Quantity pprec
inventoryEventDate :: Day
inventoryEventQuantity :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventPrice :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity pprec
inventoryEventDate :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Day
..} inventory :: Inventory pprec sprec vprec
inventory@MkInventory {Seq (InventoryHistoryItem pprec sprec vprec)
Seq (InventoryEvent pprec sprec)
Quantity sprec
inventoryHistory :: Seq (InventoryHistoryItem pprec sprec vprec)
inventoryCurrent :: Seq (InventoryEvent pprec sprec)
inventoryTotal :: Quantity sprec
inventoryHistory :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec
-> Seq (InventoryHistoryItem pprec sprec vprec)
inventoryCurrent :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Seq (InventoryEvent pprec sprec)
inventoryTotal :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Quantity sprec
..} =
  Inventory pprec sprec vprec
inventory
    { inventoryTotal :: Quantity sprec
inventoryTotal = Quantity sprec
inventoryTotal forall a. Num a => a -> a -> a
+ Quantity sprec
inventoryEventQuantity
    , inventoryCurrent :: Seq (InventoryEvent pprec sprec)
inventoryCurrent = Seq (InventoryEvent pprec sprec)
inventoryCurrent forall a. Seq a -> a -> Seq a
Seq.|> InventoryEvent pprec sprec
event
    }


-- | Captures two events of same absolute quantities with different directions
-- into a profit-taking inventory history item and updates the inventory.
munchAll
  :: KnownNat pprec
  => KnownNat sprec
  => KnownNat vprec
  => InventoryEvent pprec sprec
  -> InventoryEvent pprec sprec
  -> Seq.Seq (InventoryEvent pprec sprec)
  -> Inventory pprec sprec vprec
  -> (InventoryHistoryItem pprec sprec vprec, Inventory pprec sprec vprec)
munchAll :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
InventoryEvent pprec sprec
-> InventoryEvent pprec sprec
-> Seq (InventoryEvent pprec sprec)
-> Inventory pprec sprec vprec
-> (InventoryHistoryItem pprec sprec vprec,
    Inventory pprec sprec vprec)
munchAll InventoryEvent pprec sprec
lEvent InventoryEvent pprec sprec
rEvent Seq (InventoryEvent pprec sprec)
remainingEvents inventory :: Inventory pprec sprec vprec
inventory@MkInventory {Seq (InventoryHistoryItem pprec sprec vprec)
Seq (InventoryEvent pprec sprec)
Quantity sprec
inventoryHistory :: Seq (InventoryHistoryItem pprec sprec vprec)
inventoryCurrent :: Seq (InventoryEvent pprec sprec)
inventoryTotal :: Quantity sprec
inventoryHistory :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec
-> Seq (InventoryHistoryItem pprec sprec vprec)
inventoryCurrent :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Seq (InventoryEvent pprec sprec)
inventoryTotal :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Quantity sprec
..} =
  let lValue :: Quantity sprec
lValue = forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventQuantity InventoryEvent pprec sprec
lEvent forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
`times` forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity pprec
inventoryEventPrice InventoryEvent pprec sprec
lEvent
      rValue :: Quantity sprec
rValue = forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventQuantity InventoryEvent pprec sprec
rEvent forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
`times` forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity pprec
inventoryEventPrice InventoryEvent pprec sprec
rEvent

      historyItem :: InventoryHistoryItem pprec sprec vprec
historyItem =
        MkInventoryHistoryItem
          { inventoryHistoryItemDate :: Day
inventoryHistoryItemDate = forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Day
inventoryEventDate InventoryEvent pprec sprec
lEvent
          , inventoryHistoryItemPnl :: Quantity vprec
inventoryHistoryItemPnl = (-Quantity vprec
1) forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
`times` (Quantity sprec
rValue forall a. Num a => a -> a -> a
+ Quantity sprec
lValue)
          , inventoryHistoryItemFst :: InventoryEvent pprec sprec
inventoryHistoryItemFst = InventoryEvent pprec sprec
rEvent
          , inventoryHistoryItemSnd :: InventoryEvent pprec sprec
inventoryHistoryItemSnd = InventoryEvent pprec sprec
lEvent
          }

      newInventory :: Inventory pprec sprec vprec
newInventory =
        Inventory pprec sprec vprec
inventory
          { inventoryTotal :: Quantity sprec
inventoryTotal = Quantity sprec
inventoryTotal forall a. Num a => a -> a -> a
+ forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventQuantity InventoryEvent pprec sprec
lEvent
          , inventoryCurrent :: Seq (InventoryEvent pprec sprec)
inventoryCurrent = Seq (InventoryEvent pprec sprec)
remainingEvents
          , inventoryHistory :: Seq (InventoryHistoryItem pprec sprec vprec)
inventoryHistory = Seq (InventoryHistoryItem pprec sprec vprec)
inventoryHistory forall a. Seq a -> a -> Seq a
Seq.|> InventoryHistoryItem pprec sprec vprec
historyItem
          }
   in (InventoryHistoryItem pprec sprec vprec
historyItem, Inventory pprec sprec vprec
newInventory)


-- | Data definition representing how two inventory events should be processed.
data Munch (sprec :: Nat)
  = MunchNo
  | MunchAll
  | MunchLeft (Quantity sprec)
  | MunchRight (Quantity sprec)
  deriving (Munch sprec -> Munch sprec -> Bool
forall (sprec :: Nat). Munch sprec -> Munch sprec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Munch sprec -> Munch sprec -> Bool
$c/= :: forall (sprec :: Nat). Munch sprec -> Munch sprec -> Bool
== :: Munch sprec -> Munch sprec -> Bool
$c== :: forall (sprec :: Nat). Munch sprec -> Munch sprec -> Bool
Eq, Int -> Munch sprec -> ShowS
forall (sprec :: Nat).
KnownNat sprec =>
Int -> Munch sprec -> ShowS
forall (sprec :: Nat). KnownNat sprec => [Munch sprec] -> ShowS
forall (sprec :: Nat). KnownNat sprec => Munch sprec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Munch sprec] -> ShowS
$cshowList :: forall (sprec :: Nat). KnownNat sprec => [Munch sprec] -> ShowS
show :: Munch sprec -> String
$cshow :: forall (sprec :: Nat). KnownNat sprec => Munch sprec -> String
showsPrec :: Int -> Munch sprec -> ShowS
$cshowsPrec :: forall (sprec :: Nat).
KnownNat sprec =>
Int -> Munch sprec -> ShowS
Show)


-- | Figures out how two inventory events should be processed.
whatMunch
  :: KnownNat pprec
  => KnownNat sprec
  => InventoryEvent pprec sprec
  -> InventoryEvent pprec sprec
  -> Munch sprec
whatMunch :: forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
InventoryEvent pprec sprec
-> InventoryEvent pprec sprec -> Munch sprec
whatMunch InventoryEvent pprec sprec
l InventoryEvent pprec sprec
r
  | Quantity sprec
lsgn forall a. Eq a => a -> a -> Bool
== Quantity sprec
rsgn = forall (sprec :: Nat). Munch sprec
MunchNo
  | Quantity sprec
labs forall a. Eq a => a -> a -> Bool
== Quantity sprec
rabs = forall (sprec :: Nat). Munch sprec
MunchAll
  | Quantity sprec
labs forall a. Ord a => a -> a -> Bool
> Quantity sprec
rabs = forall (sprec :: Nat). Quantity sprec -> Munch sprec
MunchLeft Quantity sprec
rqty
  | Bool
otherwise = forall (sprec :: Nat). Quantity sprec -> Munch sprec
MunchRight Quantity sprec
lqty
  where
    lqty :: Quantity sprec
lqty = forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventQuantity InventoryEvent pprec sprec
l
    labs :: Quantity sprec
labs = forall a. Num a => a -> a
abs Quantity sprec
lqty
    lsgn :: Quantity sprec
lsgn = forall a. Num a => a -> a
signum Quantity sprec
lqty

    rqty :: Quantity sprec
rqty = forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventQuantity InventoryEvent pprec sprec
r
    rabs :: Quantity sprec
rabs = forall a. Num a => a -> a
abs Quantity sprec
rqty
    rsgn :: Quantity sprec
rsgn = forall a. Num a => a -> a
signum Quantity sprec
rqty