haspara-0.0.0.8: A library providing definitions to work with monetary values.
Safe HaskellSafe-Inferred
LanguageHaskell2010

Haspara.Accounting.Inventory

Description

This module provides FIFO machinery for inventory accounting.

Synopsis

Data Definitions

data Inventory (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) Source #

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.

Constructors

MkInventory 

Fields

Instances

Instances details
(KnownNat pprec, KnownNat sprec, KnownNat vprec) => FromJSON (Inventory pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

parseJSON :: Value -> Parser (Inventory pprec sprec vprec) #

parseJSONList :: Value -> Parser [Inventory pprec sprec vprec] #

(KnownNat pprec, KnownNat sprec, KnownNat vprec) => ToJSON (Inventory pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

toJSON :: Inventory pprec sprec vprec -> Value #

toEncoding :: Inventory pprec sprec vprec -> Encoding #

toJSONList :: [Inventory pprec sprec vprec] -> Value #

toEncodingList :: [Inventory pprec sprec vprec] -> Encoding #

Generic (Inventory pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Associated Types

type Rep (Inventory pprec sprec vprec) :: Type -> Type #

Methods

from :: Inventory pprec sprec vprec -> Rep (Inventory pprec sprec vprec) x #

to :: Rep (Inventory pprec sprec vprec) x -> Inventory pprec sprec vprec #

(KnownNat sprec, KnownNat pprec, KnownNat vprec) => Show (Inventory pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

showsPrec :: Int -> Inventory pprec sprec vprec -> ShowS #

show :: Inventory pprec sprec vprec -> String #

showList :: [Inventory pprec sprec vprec] -> ShowS #

(KnownNat pprec, KnownNat sprec, KnownNat vprec) => Default (Inventory pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

def :: Inventory pprec sprec vprec #

Eq (Inventory pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

(==) :: Inventory pprec sprec vprec -> Inventory pprec sprec vprec -> Bool #

(/=) :: Inventory pprec sprec vprec -> Inventory pprec sprec vprec -> Bool #

type Rep (Inventory pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

type Rep (Inventory pprec sprec vprec) = D1 ('MetaData "Inventory" "Haspara.Accounting.Inventory" "haspara-0.0.0.8-83lIPqySeX32MZXT98KoZ2" 'False) (C1 ('MetaCons "MkInventory" 'PrefixI 'True) (S1 ('MetaSel ('Just "inventoryTotal") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Quantity sprec)) :*: (S1 ('MetaSel ('Just "inventoryCurrent") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Seq (InventoryEvent pprec sprec))) :*: S1 ('MetaSel ('Just "inventoryHistory") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Seq (InventoryHistoryItem pprec sprec vprec))))))

data InventoryEvent (pprec :: Nat) (sprec :: Nat) Source #

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.

Instances

Instances details
(KnownNat pprec, KnownNat sprec) => FromJSON (InventoryEvent pprec sprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

parseJSON :: Value -> Parser (InventoryEvent pprec sprec) #

parseJSONList :: Value -> Parser [InventoryEvent pprec sprec] #

(KnownNat pprec, KnownNat sprec) => ToJSON (InventoryEvent pprec sprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

toJSON :: InventoryEvent pprec sprec -> Value #

toEncoding :: InventoryEvent pprec sprec -> Encoding #

toJSONList :: [InventoryEvent pprec sprec] -> Value #

toEncodingList :: [InventoryEvent pprec sprec] -> Encoding #

Generic (InventoryEvent pprec sprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Associated Types

type Rep (InventoryEvent pprec sprec) :: Type -> Type #

Methods

from :: InventoryEvent pprec sprec -> Rep (InventoryEvent pprec sprec) x #

to :: Rep (InventoryEvent pprec sprec) x -> InventoryEvent pprec sprec #

(KnownNat pprec, KnownNat sprec) => Show (InventoryEvent pprec sprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

showsPrec :: Int -> InventoryEvent pprec sprec -> ShowS #

show :: InventoryEvent pprec sprec -> String #

showList :: [InventoryEvent pprec sprec] -> ShowS #

Eq (InventoryEvent pprec sprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

(==) :: InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Bool #

(/=) :: InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Bool #

type Rep (InventoryEvent pprec sprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

type Rep (InventoryEvent pprec sprec) = D1 ('MetaData "InventoryEvent" "Haspara.Accounting.Inventory" "haspara-0.0.0.8-83lIPqySeX32MZXT98KoZ2" 'False) (C1 ('MetaCons "InventoryEvent" 'PrefixI 'True) (S1 ('MetaSel ('Just "inventoryEventDate") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Day) :*: (S1 ('MetaSel ('Just "inventoryEventPrice") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Quantity pprec)) :*: S1 ('MetaSel ('Just "inventoryEventQuantity") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Quantity sprec)))))

data InventoryHistoryItem (pprec :: Nat) (sprec :: Nat) (vprec :: Nat) Source #

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.

Instances

Instances details
(KnownNat pprec, KnownNat sprec, KnownNat vprec) => FromJSON (InventoryHistoryItem pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

parseJSON :: Value -> Parser (InventoryHistoryItem pprec sprec vprec) #

parseJSONList :: Value -> Parser [InventoryHistoryItem pprec sprec vprec] #

(KnownNat pprec, KnownNat sprec, KnownNat vprec) => ToJSON (InventoryHistoryItem pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

toJSON :: InventoryHistoryItem pprec sprec vprec -> Value #

toEncoding :: InventoryHistoryItem pprec sprec vprec -> Encoding #

toJSONList :: [InventoryHistoryItem pprec sprec vprec] -> Value #

toEncodingList :: [InventoryHistoryItem pprec sprec vprec] -> Encoding #

Generic (InventoryHistoryItem pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Associated Types

type Rep (InventoryHistoryItem pprec sprec vprec) :: Type -> Type #

Methods

from :: InventoryHistoryItem pprec sprec vprec -> Rep (InventoryHistoryItem pprec sprec vprec) x #

to :: Rep (InventoryHistoryItem pprec sprec vprec) x -> InventoryHistoryItem pprec sprec vprec #

(KnownNat vprec, KnownNat pprec, KnownNat sprec) => Show (InventoryHistoryItem pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

showsPrec :: Int -> InventoryHistoryItem pprec sprec vprec -> ShowS #

show :: InventoryHistoryItem pprec sprec vprec -> String #

showList :: [InventoryHistoryItem pprec sprec vprec] -> ShowS #

Eq (InventoryHistoryItem pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

(==) :: InventoryHistoryItem pprec sprec vprec -> InventoryHistoryItem pprec sprec vprec -> Bool #

(/=) :: InventoryHistoryItem pprec sprec vprec -> InventoryHistoryItem pprec sprec vprec -> Bool #

type Rep (InventoryHistoryItem pprec sprec vprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

type Rep (InventoryHistoryItem pprec sprec vprec) = D1 ('MetaData "InventoryHistoryItem" "Haspara.Accounting.Inventory" "haspara-0.0.0.8-83lIPqySeX32MZXT98KoZ2" 'False) (C1 ('MetaCons "MkInventoryHistoryItem" 'PrefixI 'True) ((S1 ('MetaSel ('Just "inventoryHistoryItemDate") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Day) :*: S1 ('MetaSel ('Just "inventoryHistoryItemPnl") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Quantity vprec))) :*: (S1 ('MetaSel ('Just "inventoryHistoryItemFst") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (InventoryEvent pprec sprec)) :*: S1 ('MetaSel ('Just "inventoryHistoryItemSnd") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (InventoryEvent pprec sprec)))))

Operations

updateInventory :: KnownNat pprec => KnownNat sprec => KnownNat vprec => InventoryEvent pprec sprec -> Inventory pprec sprec vprec -> (Seq (InventoryHistoryItem pprec sprec vprec), Inventory pprec sprec vprec) Source #

Processes a new inventory event onto the inventory.

Any event with 0 quantity is disregarded.

updateInventoryVP :: KnownNat pprec => KnownNat sprec => KnownNat vprec => Day -> Quantity pprec -> Quantity sprec -> Inventory pprec sprec vprec -> (Seq (InventoryHistoryItem pprec sprec vprec), Inventory pprec sprec vprec) Source #

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 (InventoryHistoryItem pprec sprec vprec), Inventory pprec sprec vprec) Source #

Convenience wrapper for updateInventory which works with date, price and quantity.

Internal Definitions

updateInventoryAux :: 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) Source #

Work-horse function for updating inventory.

This is where the whole trick happens in this module.

splitEvent :: KnownNat pprec => KnownNat sprec => Quantity sprec -> InventoryEvent pprec sprec -> (InventoryEvent pprec sprec, InventoryEvent pprec sprec) Source #

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.

addInventoryEvent :: KnownNat pprec => KnownNat sprec => KnownNat vprec => InventoryEvent pprec sprec -> Inventory pprec sprec vprec -> Inventory pprec sprec vprec Source #

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.

munchAll :: 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) Source #

Captures two events of same absolute quantities with different directions into a profit-taking inventory history item and updates the inventory.

data Munch (sprec :: Nat) Source #

Data definition representing how two inventory events should be processed.

Constructors

MunchNo 
MunchAll 
MunchLeft (Quantity sprec) 
MunchRight (Quantity sprec) 

Instances

Instances details
KnownNat sprec => Show (Munch sprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

showsPrec :: Int -> Munch sprec -> ShowS #

show :: Munch sprec -> String #

showList :: [Munch sprec] -> ShowS #

Eq (Munch sprec) Source # 
Instance details

Defined in Haspara.Accounting.Inventory

Methods

(==) :: Munch sprec -> Munch sprec -> Bool #

(/=) :: Munch sprec -> Munch sprec -> Bool #

whatMunch :: KnownNat pprec => KnownNat sprec => InventoryEvent pprec sprec -> InventoryEvent pprec sprec -> Munch sprec Source #

Figures out how two inventory events should be processed.