module Penny.Copper.Price (price, render) where
import Text.Parsec ( char, getPosition, sourceLine, (<?>),
SourcePos )
import Text.Parsec.Text ( Parser )
import Control.Applicative ((<*>), (<*), (<|>), (<$))
import Data.Text (singleton, snoc, intercalate)
import qualified Data.Text as X
import qualified Penny.Lincoln as L
import qualified Penny.Lincoln.Bits.PricePoint as PP
import qualified Penny.Copper.Amount as A
import qualified Penny.Copper.Commodity as C
import qualified Penny.Copper.DateTime as DT
import qualified Penny.Copper.Qty as Q
import Penny.Copper.Util (lexeme, eol)
mkPrice :: SourcePos
-> L.DateTime
-> L.Commodity
-> (L.Amount, L.Format)
-> Maybe L.PricePoint
mkPrice pos dt from (am, fmt) = let
to = L.commodity am
q = L.qty am
pm = L.PriceMeta (Just pl) (Just fmt)
pl = L.PriceLine . sourceLine $ pos
in do
p <- L.newPrice (L.From from) (L.To to) (L.CountPerUnit q)
return $ L.PricePoint dt p pm
maybePrice ::
DT.DefaultTimeZone
-> Q.RadGroup
-> Parser (Maybe L.PricePoint)
maybePrice dtz rg =
mkPrice
<$ lexeme (char '@')
<*> getPosition
<*> lexeme (DT.dateTime dtz)
<*> lexeme (C.quotedLvl1Cmdty <|> C.lvl2Cmdty)
<*> A.amount rg
<* eol
<?> "price"
price ::
DT.DefaultTimeZone
-> Q.RadGroup
-> Parser L.PricePoint
price dtz rg = do
b <- maybePrice dtz rg
case b of
Nothing -> fail "invalid price given"
Just p -> return p
render ::
DT.DefaultTimeZone
-> (Q.GroupingSpec, Q.GroupingSpec)
-> Q.RadGroup
-> L.PricePoint
-> Maybe X.Text
render dtz gs rg pp = let
dateTxt = DT.render dtz (PP.dateTime pp)
(L.From from) = L.from . L.price $ pp
(L.To to) = L.to . L.price $ pp
(L.CountPerUnit q) = L.countPerUnit . L.price $ pp
mayFromTxt = C.renderLvl3 from <|> C.renderQuotedLvl1 from
amt = L.Amount q to
in do
fmt <- L.priceFormat . L.ppMeta $ pp
let mayAmtTxt = A.render gs rg fmt amt
amtTxt <- mayAmtTxt
fromTxt <- mayFromTxt
return $
(intercalate (singleton ' ')
[singleton '@', dateTxt, fromTxt, amtTxt])
`snoc` '\n'