module Penny.Cabin.Scheme where
import qualified Penny.Cabin.Chunk as C
import qualified Penny.Cabin.Meta as M
import qualified Penny.Lincoln as L
import qualified Data.Text as X
data Label
= Debit
| Credit
| Zero
| Other
deriving (Eq, Ord, Show)
data EvenOdd = Even | Odd deriving (Eq, Ord, Show)
data Labels a = Labels
{ debit :: a
, credit :: a
, zero :: a
, other :: a
} deriving Show
getLabelValue :: Label -> Labels a -> a
getLabelValue l ls = case l of
Debit -> debit ls
Credit -> credit ls
Zero -> zero ls
Other -> other ls
data EvenAndOdd a = EvenAndOdd
{ eoEven :: a
, eoOdd :: a
} deriving Show
type TextSpecs = Labels (EvenAndOdd C.TextSpec)
data Scheme = Scheme
{ name :: String
, description :: String
, textSpecs :: TextSpecs
} deriving Show
getEvenOdd :: EvenOdd -> EvenAndOdd a -> a
getEvenOdd eo eao = case eo of
Even -> eoEven eao
Odd -> eoOdd eao
getEvenOddLabelValue
:: Label
-> EvenOdd
-> Labels (EvenAndOdd a)
-> a
getEvenOddLabelValue l eo ls =
getEvenOdd eo (getLabelValue l ls)
data PreChunk = PreChunk
{ label :: Label
, evenOdd :: EvenOdd
, text :: X.Text
} deriving (Eq, Show)
width :: PreChunk -> C.Width
width = C.Width . X.length . text
makeChunk :: TextSpecs -> PreChunk -> C.Chunk
makeChunk s p =
C.chunk (getEvenOddLabelValue (label p) (evenOdd p) s)
(text p)
fromVisibleNum :: M.VisibleNum -> EvenOdd
fromVisibleNum vn =
let s = M.unVisibleNum vn in
if even . L.forward $ s then Even else Odd
dcToLbl :: L.DrCr -> Label
dcToLbl L.Debit = Debit
dcToLbl L.Credit = Credit
bottomLineToDrCr :: L.BottomLine -> EvenOdd -> PreChunk
bottomLineToDrCr bl eo = PreChunk lbl eo t
where
(lbl, t) = case bl of
L.Zero -> (Zero, X.pack "--")
L.NonZero (L.Column clmDrCr _) -> case clmDrCr of
L.Debit -> (Debit, X.singleton '<')
L.Credit -> (Credit, X.singleton '>')
balancesToCmdtys
:: EvenOdd
-> [(L.Commodity, L.BottomLine)]
-> [PreChunk]
balancesToCmdtys eo ls =
if null ls
then [PreChunk Zero eo (X.pack "--")]
else map (bottomLineToCmdty eo) ls
bottomLineToCmdty
:: EvenOdd
-> (L.Commodity, L.BottomLine)
-> PreChunk
bottomLineToCmdty eo (cy, bl) = PreChunk lbl eo t
where
t = L.unCommodity cy
lbl = case bl of
L.Zero -> Zero
L.NonZero (L.Column clmDrCr _) -> dcToLbl clmDrCr
balanceToQtys
:: (L.Commodity -> L.Qty -> X.Text)
-> EvenOdd
-> [(L.Commodity, L.BottomLine)]
-> [PreChunk]
balanceToQtys getTxt eo ls =
if null ls
then [PreChunk Zero eo (X.pack "--")]
else map (bottomLineToQty getTxt eo) ls
bottomLineToQty
:: (L.Commodity -> L.Qty -> X.Text)
-> EvenOdd
-> (L.Commodity, L.BottomLine)
-> PreChunk
bottomLineToQty getTxt eo (cy, bl) = PreChunk lbl eo t
where
(lbl, t) = case bl of
L.Zero -> (Zero, X.pack "--")
L.NonZero (L.Column clmDrCr qt) -> (dcToLbl clmDrCr, getTxt cy qt)