module Ledger.Commodity
( Commodity
, CommodityInfo(..), HasCommodityInfo(..)
, defaultCommodityInfo, defaultPrimaryCommodityInfo
, CommodityMap(..), HasCommodityMap(..)
, extendByDigits
) where
import Control.Lens
import Data.IntMap (IntMap, Key)
import qualified Data.IntMap as IntMap
import Data.Map (Map)
import Data.Ratio
import Data.Semigroup
import Data.Text (Text)
import Data.Thyme.Time
import Prelude hiding (lookup)
type Commodity = Key
extendByDigits :: Int
extendByDigits = 6
data CommodityInfo = CommodityInfo
{ _commSymbol :: !Text
, _commPrecision :: !Int
, _commSuffixed :: !Bool
, _commSeparated :: !Bool
, _commThousands :: !Bool
, _commDecimalComma :: !Bool
, _commNoMarket :: !Bool
, _commBuiltin :: !Bool
, _commKnown :: !Bool
, _commPrimary :: !Bool
, _commHistory :: !(IntMap (Map UTCTime Rational))
} deriving (Eq, Read, Show)
makeClassy ''CommodityInfo
instance Semigroup CommodityInfo where
x <> y = x
& commSymbol .~ y^.commSymbol
& commPrecision .~ max (x^.commPrecision) (y^.commPrecision)
& commSuffixed .~ (x^.commSuffixed || y^.commSuffixed)
& commSeparated .~ (x^.commSeparated || y^.commSeparated)
& commThousands .~ (x^.commThousands || y^.commThousands)
& commDecimalComma .~ (x^.commDecimalComma || y^.commDecimalComma)
& commNoMarket .~ (x^.commNoMarket || y^.commNoMarket)
& commBuiltin .~ (x^.commBuiltin || y^.commBuiltin)
& commKnown .~ (x^.commKnown || y^.commKnown)
& commPrimary .~ (x^.commPrimary || y^.commPrimary)
& commHistory .~ (x^.commHistory <> y^.commHistory)
instance Monoid CommodityInfo where
mempty = defaultCommodityInfo
x `mappend` y = x <> y
defaultCommodityInfo :: CommodityInfo
defaultCommodityInfo = CommodityInfo
{ _commSymbol = ""
, _commPrecision = 0
, _commSuffixed = False
, _commSeparated = True
, _commThousands = True
, _commDecimalComma = False
, _commNoMarket = False
, _commBuiltin = False
, _commKnown = False
, _commPrimary = False
, _commHistory = IntMap.empty
}
defaultPrimaryCommodityInfo :: Text -> CommodityInfo
defaultPrimaryCommodityInfo sym = defaultCommodityInfo
& commSymbol .~ sym
& commPrecision .~ 2
& commNoMarket .~ True
& commKnown .~ True
& commPrimary .~ True
data CommodityMap = CommodityMap
{ _commodities :: !(IntMap CommodityInfo)
}
deriving (Eq, Read, Show)
makeClassy ''CommodityMap
instance Semigroup CommodityMap where
CommodityMap x <> CommodityMap y =
CommodityMap (IntMap.unionWith (<>) x y)
instance Monoid CommodityMap where
mempty = CommodityMap mempty
x `mappend` y = x <> y