{-# 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
(Inventory pprec sprec vprec
 -> Inventory pprec sprec vprec -> Bool)
-> (Inventory pprec sprec vprec
    -> Inventory pprec sprec vprec -> Bool)
-> Eq (Inventory pprec sprec vprec)
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
$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
/= :: Inventory pprec sprec vprec -> Inventory pprec sprec vprec -> Bool
Eq, (forall x.
 Inventory pprec sprec vprec -> Rep (Inventory pprec sprec vprec) x)
-> (forall x.
    Rep (Inventory pprec sprec vprec) x -> Inventory pprec sprec vprec)
-> Generic (Inventory pprec sprec vprec)
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 x.
Rep (Inventory pprec sprec vprec) x -> Inventory pprec sprec vprec
forall 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
$cfrom :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
Inventory pprec sprec vprec -> Rep (Inventory pprec sprec vprec) x
from :: forall x.
Inventory pprec sprec vprec -> Rep (Inventory pprec sprec vprec) x
$cto :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
Rep (Inventory pprec sprec vprec) x -> Inventory pprec sprec vprec
to :: forall x.
Rep (Inventory pprec sprec vprec) x -> Inventory pprec sprec vprec
Generic, Int -> Inventory pprec sprec vprec -> ShowS
[Inventory pprec sprec vprec] -> ShowS
Inventory pprec sprec vprec -> String
(Int -> Inventory pprec sprec vprec -> ShowS)
-> (Inventory pprec sprec vprec -> String)
-> ([Inventory pprec sprec vprec] -> ShowS)
-> Show (Inventory pprec sprec vprec)
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
$cshowsPrec :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat sprec, KnownNat pprec, KnownNat vprec) =>
Int -> Inventory pprec sprec vprec -> ShowS
showsPrec :: Int -> Inventory pprec sprec vprec -> ShowS
$cshow :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat sprec, KnownNat pprec, KnownNat vprec) =>
Inventory pprec sprec vprec -> String
show :: Inventory pprec sprec vprec -> String
$cshowList :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat sprec, KnownNat pprec, KnownNat vprec) =>
[Inventory pprec sprec vprec] -> ShowS
showList :: [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 = Seq (InventoryEvent pprec sprec)
forall a. Monoid a => a
mempty
      , inventoryHistory :: Seq (InventoryHistoryItem pprec sprec vprec)
inventoryHistory = Seq (InventoryHistoryItem pprec sprec vprec)
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 = Options -> Value -> Parser (Inventory pprec sprec vprec)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON (Options -> Value -> Parser (Inventory pprec sprec vprec))
-> Options -> Value -> Parser (Inventory pprec sprec vprec)
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 = Options -> Inventory pprec sprec vprec -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON (Options -> Inventory pprec sprec vprec -> Value)
-> Options -> Inventory pprec sprec vprec -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventory"
  toEncoding :: Inventory pprec sprec vprec -> Encoding
toEncoding = Options -> Inventory pprec sprec vprec -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding (Options -> Inventory pprec sprec vprec -> Encoding)
-> Options -> Inventory pprec sprec vprec -> Encoding
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
(InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Bool)
-> (InventoryEvent pprec sprec
    -> InventoryEvent pprec sprec -> Bool)
-> Eq (InventoryEvent pprec sprec)
forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Bool
Eq, (forall x.
 InventoryEvent pprec sprec -> Rep (InventoryEvent pprec sprec) x)
-> (forall x.
    Rep (InventoryEvent pprec sprec) x -> InventoryEvent pprec sprec)
-> Generic (InventoryEvent pprec sprec)
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 x.
Rep (InventoryEvent pprec sprec) x -> InventoryEvent pprec sprec
forall 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
$cfrom :: forall (pprec :: Nat) (sprec :: Nat) x.
InventoryEvent pprec sprec -> Rep (InventoryEvent pprec sprec) x
from :: forall x.
InventoryEvent pprec sprec -> Rep (InventoryEvent pprec sprec) x
$cto :: forall (pprec :: Nat) (sprec :: Nat) x.
Rep (InventoryEvent pprec sprec) x -> InventoryEvent pprec sprec
to :: forall x.
Rep (InventoryEvent pprec sprec) x -> InventoryEvent pprec sprec
Generic, Int -> InventoryEvent pprec sprec -> ShowS
[InventoryEvent pprec sprec] -> ShowS
InventoryEvent pprec sprec -> String
(Int -> InventoryEvent pprec sprec -> ShowS)
-> (InventoryEvent pprec sprec -> String)
-> ([InventoryEvent pprec sprec] -> ShowS)
-> Show (InventoryEvent pprec sprec)
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
$cshowsPrec :: forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
Int -> InventoryEvent pprec sprec -> ShowS
showsPrec :: Int -> InventoryEvent pprec sprec -> ShowS
$cshow :: forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
InventoryEvent pprec sprec -> String
show :: InventoryEvent pprec sprec -> String
$cshowList :: forall (pprec :: Nat) (sprec :: Nat).
(KnownNat pprec, KnownNat sprec) =>
[InventoryEvent pprec sprec] -> ShowS
showList :: [InventoryEvent pprec sprec] -> ShowS
Show)


instance (KnownNat pprec, KnownNat sprec) => Aeson.FromJSON (InventoryEvent pprec sprec) where
  parseJSON :: Value -> Parser (InventoryEvent pprec sprec)
parseJSON = Options -> Value -> Parser (InventoryEvent pprec sprec)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON (Options -> Value -> Parser (InventoryEvent pprec sprec))
-> Options -> Value -> Parser (InventoryEvent pprec sprec)
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 = Options -> InventoryEvent pprec sprec -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON (Options -> InventoryEvent pprec sprec -> Value)
-> Options -> InventoryEvent pprec sprec -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventoryEvent"
  toEncoding :: InventoryEvent pprec sprec -> Encoding
toEncoding = Options -> InventoryEvent pprec sprec -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding (Options -> InventoryEvent pprec sprec -> Encoding)
-> Options -> InventoryEvent pprec sprec -> Encoding
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
(InventoryHistoryItem pprec sprec vprec
 -> InventoryHistoryItem pprec sprec vprec -> Bool)
-> (InventoryHistoryItem pprec sprec vprec
    -> InventoryHistoryItem pprec sprec vprec -> Bool)
-> Eq (InventoryHistoryItem pprec sprec vprec)
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
$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
/= :: InventoryHistoryItem pprec sprec vprec
-> InventoryHistoryItem pprec sprec vprec -> Bool
Eq, (forall x.
 InventoryHistoryItem pprec sprec vprec
 -> Rep (InventoryHistoryItem pprec sprec vprec) x)
-> (forall x.
    Rep (InventoryHistoryItem pprec sprec vprec) x
    -> InventoryHistoryItem pprec sprec vprec)
-> Generic (InventoryHistoryItem pprec sprec vprec)
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 x.
Rep (InventoryHistoryItem pprec sprec vprec) x
-> InventoryHistoryItem pprec sprec vprec
forall 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
$cfrom :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
InventoryHistoryItem pprec sprec vprec
-> Rep (InventoryHistoryItem pprec sprec vprec) x
from :: forall x.
InventoryHistoryItem pprec sprec vprec
-> Rep (InventoryHistoryItem pprec sprec vprec) x
$cto :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) x.
Rep (InventoryHistoryItem pprec sprec vprec) x
-> InventoryHistoryItem pprec sprec vprec
to :: forall x.
Rep (InventoryHistoryItem pprec sprec vprec) x
-> InventoryHistoryItem pprec sprec vprec
Generic, Int -> InventoryHistoryItem pprec sprec vprec -> ShowS
[InventoryHistoryItem pprec sprec vprec] -> ShowS
InventoryHistoryItem pprec sprec vprec -> String
(Int -> InventoryHistoryItem pprec sprec vprec -> ShowS)
-> (InventoryHistoryItem pprec sprec vprec -> String)
-> ([InventoryHistoryItem pprec sprec vprec] -> ShowS)
-> Show (InventoryHistoryItem pprec sprec vprec)
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
$cshowsPrec :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat vprec, KnownNat pprec, KnownNat sprec) =>
Int -> InventoryHistoryItem pprec sprec vprec -> ShowS
showsPrec :: Int -> InventoryHistoryItem pprec sprec vprec -> ShowS
$cshow :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat vprec, KnownNat pprec, KnownNat sprec) =>
InventoryHistoryItem pprec sprec vprec -> String
show :: InventoryHistoryItem pprec sprec vprec -> String
$cshowList :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat vprec, KnownNat pprec, KnownNat sprec) =>
[InventoryHistoryItem pprec sprec vprec] -> ShowS
showList :: [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 = Options -> Value -> Parser (InventoryHistoryItem pprec sprec vprec)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON (Options
 -> Value -> Parser (InventoryHistoryItem pprec sprec vprec))
-> Options
-> Value
-> Parser (InventoryHistoryItem pprec sprec vprec)
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 = Options -> InventoryHistoryItem pprec sprec vprec -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON (Options -> InventoryHistoryItem pprec sprec vprec -> Value)
-> Options -> InventoryHistoryItem pprec sprec vprec -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"inventoryHistoryItem"
  toEncoding :: InventoryHistoryItem pprec sprec vprec -> Encoding
toEncoding = Options -> InventoryHistoryItem pprec sprec vprec -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding (Options -> InventoryHistoryItem pprec sprec vprec -> Encoding)
-> Options -> InventoryHistoryItem pprec sprec vprec -> Encoding
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 InventoryEvent pprec sprec -> Quantity sprec
forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventQuantity InventoryEvent pprec sprec
event of
  Quantity sprec
0 -> (Seq (InventoryHistoryItem pprec sprec vprec)
forall a. Monoid a => a
mempty, Inventory pprec sprec vprec
inventory)
  Quantity sprec
_ -> Seq (InventoryHistoryItem pprec sprec vprec)
-> InventoryEvent pprec sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
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)
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 =
  InventoryEvent pprec sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
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
 -> Inventory pprec sprec vprec
 -> (Seq (InventoryHistoryItem pprec sprec vprec),
     Inventory pprec sprec vprec))
-> InventoryEvent pprec sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
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 = Quantity pprec -> Maybe (Quantity pprec) -> Quantity pprec
forall a. a -> Maybe a -> a
fromMaybe Quantity pprec
0 (Maybe (Quantity pprec) -> Quantity pprec)
-> Maybe (Quantity pprec) -> Quantity pprec
forall a b. (a -> b) -> a -> b
$ Quantity vprec
value Quantity vprec -> Quantity sprec -> Maybe (Quantity pprec)
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 Day
-> Quantity pprec
-> Quantity sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
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 -> Quantity pprec
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
inventoryTotal :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Quantity sprec
inventoryCurrent :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Seq (InventoryEvent pprec sprec)
inventoryHistory :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec
-> Seq (InventoryHistoryItem pprec sprec vprec)
inventoryTotal :: Quantity sprec
inventoryCurrent :: Seq (InventoryEvent pprec sprec)
inventoryHistory :: Seq (InventoryHistoryItem pprec sprec vprec)
..} =
  case Seq (InventoryEvent pprec sprec)
-> ViewL (InventoryEvent pprec sprec)
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, InventoryEvent pprec sprec
-> Inventory pprec sprec vprec -> Inventory pprec sprec vprec
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 InventoryEvent pprec sprec
-> InventoryEvent pprec sprec -> Munch sprec
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, InventoryEvent pprec sprec
-> Inventory pprec sprec vprec -> Inventory pprec sprec vprec
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) = InventoryEvent pprec sprec
-> InventoryEvent pprec sprec
-> Seq (InventoryEvent pprec sprec)
-> Inventory pprec sprec vprec
-> (InventoryHistoryItem pprec sprec vprec,
    Inventory pprec sprec vprec)
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 Seq (InventoryHistoryItem pprec sprec vprec)
-> InventoryHistoryItem pprec sprec vprec
-> Seq (InventoryHistoryItem pprec sprec vprec)
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) = Quantity sprec
-> InventoryEvent pprec sprec
-> (InventoryEvent pprec sprec, InventoryEvent pprec sprec)
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) = InventoryEvent pprec sprec
-> InventoryEvent pprec sprec
-> Seq (InventoryEvent pprec sprec)
-> Inventory pprec sprec vprec
-> (InventoryHistoryItem pprec sprec vprec,
    Inventory pprec sprec vprec)
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 Seq (InventoryHistoryItem pprec sprec vprec)
-> InventoryEvent pprec sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
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 Seq (InventoryHistoryItem pprec sprec vprec)
-> InventoryHistoryItem pprec sprec vprec
-> Seq (InventoryHistoryItem pprec sprec vprec)
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) = Quantity sprec
-> InventoryEvent pprec sprec
-> (InventoryEvent pprec sprec, InventoryEvent pprec sprec)
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) = InventoryEvent pprec sprec
-> InventoryEvent pprec sprec
-> Seq (InventoryEvent pprec sprec)
-> Inventory pprec sprec vprec
-> (InventoryHistoryItem pprec sprec vprec,
    Inventory pprec sprec vprec)
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 InventoryEvent pprec sprec
-> Seq (InventoryEvent pprec sprec)
-> Seq (InventoryEvent pprec sprec)
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 Seq (InventoryHistoryItem pprec sprec vprec)
-> InventoryHistoryItem pprec sprec vprec
-> Seq (InventoryHistoryItem pprec sprec vprec)
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
inventoryEventDate :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Day
inventoryEventPrice :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity pprec
inventoryEventQuantity :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventDate :: Day
inventoryEventPrice :: Quantity pprec
inventoryEventQuantity :: Quantity sprec
..} =
  let newItemQty :: Quantity sprec
newItemQty = (-Quantity sprec
qty)
      remItemQty :: Quantity sprec
remItemQty = Quantity sprec
inventoryEventQuantity Quantity sprec -> Quantity sprec -> Quantity sprec
forall a. Num a => a -> a -> a
+ Quantity sprec
qty

      newItem :: InventoryEvent pprec sprec
newItem = InventoryEvent pprec sprec
event {inventoryEventQuantity = newItemQty}
      remItem :: InventoryEvent pprec sprec
remItem = InventoryEvent pprec sprec
event {inventoryEventQuantity = 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
inventoryEventDate :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Day
inventoryEventPrice :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity pprec
inventoryEventQuantity :: forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventDate :: Day
inventoryEventPrice :: Quantity pprec
inventoryEventQuantity :: Quantity sprec
..} inventory :: Inventory pprec sprec vprec
inventory@MkInventory {Seq (InventoryHistoryItem pprec sprec vprec)
Seq (InventoryEvent pprec sprec)
Quantity sprec
inventoryTotal :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Quantity sprec
inventoryCurrent :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Seq (InventoryEvent pprec sprec)
inventoryHistory :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec
-> Seq (InventoryHistoryItem pprec sprec vprec)
inventoryTotal :: Quantity sprec
inventoryCurrent :: Seq (InventoryEvent pprec sprec)
inventoryHistory :: Seq (InventoryHistoryItem pprec sprec vprec)
..} =
  Inventory pprec sprec vprec
inventory
    { inventoryTotal = inventoryTotal + inventoryEventQuantity
    , inventoryCurrent = inventoryCurrent Seq.|> 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
inventoryTotal :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Quantity sprec
inventoryCurrent :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec -> Seq (InventoryEvent pprec sprec)
inventoryHistory :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
Inventory pprec sprec vprec
-> Seq (InventoryHistoryItem pprec sprec vprec)
inventoryTotal :: Quantity sprec
inventoryCurrent :: Seq (InventoryEvent pprec sprec)
inventoryHistory :: Seq (InventoryHistoryItem pprec sprec vprec)
..} =
  let lValue :: Quantity sprec
lValue = InventoryEvent pprec sprec -> Quantity sprec
forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventQuantity InventoryEvent pprec sprec
lEvent Quantity sprec -> Quantity pprec -> Quantity sprec
forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
`times` InventoryEvent pprec sprec -> Quantity pprec
forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity pprec
inventoryEventPrice InventoryEvent pprec sprec
lEvent
      rValue :: Quantity sprec
rValue = InventoryEvent pprec sprec -> Quantity sprec
forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventQuantity InventoryEvent pprec sprec
rEvent Quantity sprec -> Quantity pprec -> Quantity sprec
forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
`times` InventoryEvent pprec sprec -> Quantity pprec
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 = InventoryEvent pprec sprec -> Day
forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Day
inventoryEventDate InventoryEvent pprec sprec
lEvent
          , inventoryHistoryItemPnl :: Quantity vprec
inventoryHistoryItemPnl = (-Quantity vprec
1) Quantity vprec -> Quantity sprec -> Quantity vprec
forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
`times` (Quantity sprec
rValue Quantity sprec -> Quantity sprec -> Quantity sprec
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 = inventoryTotal + inventoryEventQuantity lEvent
          , inventoryCurrent = remainingEvents
          , inventoryHistory = inventoryHistory Seq.|> 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
(Munch sprec -> Munch sprec -> Bool)
-> (Munch sprec -> Munch sprec -> Bool) -> Eq (Munch sprec)
forall (sprec :: Nat). Munch sprec -> Munch sprec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (sprec :: Nat). Munch sprec -> Munch sprec -> Bool
== :: Munch sprec -> Munch sprec -> Bool
$c/= :: forall (sprec :: Nat). Munch sprec -> Munch sprec -> Bool
/= :: Munch sprec -> Munch sprec -> Bool
Eq, Int -> Munch sprec -> ShowS
[Munch sprec] -> ShowS
Munch sprec -> String
(Int -> Munch sprec -> ShowS)
-> (Munch sprec -> String)
-> ([Munch sprec] -> ShowS)
-> Show (Munch sprec)
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
$cshowsPrec :: forall (sprec :: Nat).
KnownNat sprec =>
Int -> Munch sprec -> ShowS
showsPrec :: Int -> Munch sprec -> ShowS
$cshow :: forall (sprec :: Nat). KnownNat sprec => Munch sprec -> String
show :: Munch sprec -> String
$cshowList :: forall (sprec :: Nat). KnownNat sprec => [Munch sprec] -> ShowS
showList :: [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 Quantity sprec -> Quantity sprec -> Bool
forall a. Eq a => a -> a -> Bool
== Quantity sprec
rsgn = Munch sprec
forall (sprec :: Nat). Munch sprec
MunchNo
  | Quantity sprec
labs Quantity sprec -> Quantity sprec -> Bool
forall a. Eq a => a -> a -> Bool
== Quantity sprec
rabs = Munch sprec
forall (sprec :: Nat). Munch sprec
MunchAll
  | Quantity sprec
labs Quantity sprec -> Quantity sprec -> Bool
forall a. Ord a => a -> a -> Bool
> Quantity sprec
rabs = Quantity sprec -> Munch sprec
forall (sprec :: Nat). Quantity sprec -> Munch sprec
MunchLeft Quantity sprec
rqty
  | Bool
otherwise = Quantity sprec -> Munch sprec
forall (sprec :: Nat). Quantity sprec -> Munch sprec
MunchRight Quantity sprec
lqty
  where
    lqty :: Quantity sprec
lqty = InventoryEvent pprec sprec -> Quantity sprec
forall (pprec :: Nat) (sprec :: Nat).
InventoryEvent pprec sprec -> Quantity sprec
inventoryEventQuantity InventoryEvent pprec sprec
l
    labs :: Quantity sprec
labs = Quantity sprec -> Quantity sprec
forall a. Num a => a -> a
abs Quantity sprec
lqty
    lsgn :: Quantity sprec
lsgn = Quantity sprec -> Quantity sprec
forall a. Num a => a -> a
signum Quantity sprec
lqty

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