module HTML where

import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List
import qualified Text.XML.Light as X
import qualified Text.XML.Light.Output as X
import Numeric(showFFloat)
import LedgerT
import Balances
import Valuation
import ErrVal

-- | Show balances of each account, in each commodity
balanceTable :: Balances -> X.Element
balanceTable bals = node "table" (tstyle, cgroups++[header,body])
  where
    cgroups = [ colgroup aNameWidth, colgroup (length commods) ]
                    
    header = node "thead" $ tr $ atitle ++ ctitle
      where
        atitle = fill aNameWidth (th ()) [thL "Account"]
        ctitle = [thR (symbol c) | c <- commods]

    body = node "tbody" [mkrow an | an <- anames]

    mkrow an = tr $ aname ++ [mkval c | c <- commods]
      where
        aname = fill aNameWidth (td (astyle an))  aname0
        aname0 = [td (astyle a,if a == an then last a else "") | a <- tail (inits an)] 
        mkval c = case Map.lookup (an,symbol c) vals of
            Nothing -> td (astyle an)
            Just v -> td (alignRight:astyle an,showA c v)
        astyle an = case Map.lookup an colors of
            Nothing -> []
            Just c -> [X.Attr (X.unqual "style") ("background: " ++ c ++ ";")]

    abals = bals
    vals = getVals abals
    commods = getCommods abals
    colors = prefixColors anames
    anames = nub $ sort $ map fst $ Map.keys vals
    aNameWidth = maximum $ [0] ++ (map length anames)

data ConvBalanceTableSettings = ConvBalanceTableSettings {
    cbt_showCommodityAmounts :: Bool,
    cbt_showCommodityValues :: Bool
} 

-- | Show balances of each account, in each commodity, and converted to a base
-- valuation commodity (which would typically be the local currency)
convBalanceTable :: ConvBalanceTableSettings -> ValuationEnv -> Balances  -> X.Element
convBalanceTable flags venv bals =  node "table" (tstyle, cgroups++[header,body])
  where
    cgroups = [ colgroup aNameWidth, colgroup 1 ] ++ [ colgroup (length ct) | ct <- ctitles ]
                    
    header = node "thead" $ tr $ atitle ++ total ++ concat ctitles
      
    atitle = fill aNameWidth (th ()) [thL "Account"]
    total = if hasConversions then [thL ("Value (" ++ symbol vcur ++")")] else []
    ctitles = [ctitle c| c <- commods]
    ctitle c
        | showCAmounts && showCValues && not (isVcur c) = [thR (symbol c),thR "@",thR p]
        | showCAmounts || (showCValues && isVcur c)     = [thR (symbol c)]
        | showCValues                                   = [thR (symbol c++"(" ++ symbol vcur ++")")]
        | otherwise                                     = []
      where
        p = errval (\v -> showAmount (Amount vcur v Nothing)) id (price c)

    body = node "tbody" [mkrow an | an <- anames]

    mkrow an = tr $ aname ++ total ++ concat [mkval c | c <- commods]
      where
        aname = fill aNameWidth (td astyle1) aname0
        aname0 = [td (astyle a,if a == an then last a else "") | a <- tail (inits an)] 
        total = if hasConversions then [td (astyle2,showEA vcur totalV)] else []

        totalV = sum [getval c | c <- commods]
          where
            getval c = case  Map.lookup (an,symbol c) vals of 
                Nothing -> 0
                (Just v) -> eVal v * price c
        
        mkval c = case Map.lookup (an,symbol c) vals of
            Nothing  -> cfields c (td astyle1) (td astyle1) (td astyle1)
            (Just v) -> cfields c (td (astyle2,showA c v)) (td astyle2) (td (astyle2,showEA c (eVal v * price c)))
        astyle1 = astyle an
        astyle2 = alignRight:astyle1

    price c = presentValue venv (symbol c)

    astyle an = maybe [] attrbg (Map.lookup an colors)
      where attrbg c = [X.Attr (X.unqual "style") ("background: " ++ c ++ ";")]

    abals = bals
    vals = getVals abals
    hasConversions = not $ null $ filter (\c -> symbol c /= symbol vcur) commods
    commods = getCommods abals
    colors = prefixColors anames
    anames = nub $ sort $ map fst $ Map.keys vals
    aNameWidth = maximum $ [0] ++ (map length anames)
    vcur = venv_commodity venv

    cfields c amount sep value
        | showCAmounts && showCValues  && not (isVcur c) = [amount,sep,value]
        | showCAmounts                                   = [amount]
        | showCValues                                    = [value]
        | otherwise                                      = []

    isVcur c = symbol c == symbol vcur
    showCAmounts = cbt_showCommodityAmounts flags
    showCValues = cbt_showCommodityValues flags


-- | Show changes between two sets of balances, just in terms of a single valuation
-- commodity
balanceChangeTable :: (ValuationEnv,Balances) -> (ValuationEnv,Balances) -> X.Element
balanceChangeTable (venv1,bals1) (venv2,bals2) =  node "table" (tstyle, cgroups++[header,body])
  where
    cgroups = [ colgroup aNameWidth, colgroup 1, colgroup 3, colgroup 1]
                    
    header = node "thead" $ tr $ atitle ++ vtitles

    atitle = fill aNameWidth (th ()) [thL "Account"]

    vtitles = [ thR ("Initial (" ++ symbol vcur ++")")
              , th ([alignRight,attr "colspan" "2"], 
                    raw $ "Market (&Delta;" ++ symbol vcur ++")")
              , thR (raw $ "Transactions (&Delta;" ++ symbol vcur ++")")
              , thR ("Final (" ++ symbol vcur ++")")
              ]

    body = node "tbody" [mkrow an | an <- anames]

    mkrow an = tr $ aname ++ values
      where
        aname = fill aNameWidth (td astyle1) aname0
        aname0 = [td (astyle a,if a == an then last a else "") | a <- tail (inits an)] 
        values = 
            [ td (astyle2,showEA vcur total1)
            , td (astyle2,showEA vcur (total2 - total1))
            , td (astyle2,showEP vcur (if total1 == 0 then 0 else (total2 / total1 - 1) * 100))
            , td (astyle2,showEA vcur (total3 - total2))
            , td (astyle2,showEA vcur total3)
            ]
         
        total1 = sum [getval venv1 vals1 c | c <- commods]
        total2 = sum [getval venv2 vals1 c | c <- commods]
        total3 = sum [getval venv2 vals2 c | c <- commods]
            
        getval venv vals c = case  Map.lookup (an,symbol c) vals of 
            Nothing -> 0
            (Just v) -> eVal v * presentValue venv (symbol c)
        
        astyle1 = astyle an
        astyle2 = alignRight:astyle1

        showEP c ev = errval showPercent id ev
        showPercent v | v == 0    = ""
                      | v > 0     = "(+" ++ showFFloat (Just 2) v "%)"
                      | otherwise = "(" ++ showFFloat (Just 2) v "%)"

    astyle an = maybe [] attrbg (Map.lookup an colors)
      where attrbg c = [X.Attr (X.unqual "style") ("background: " ++ c ++ ";")]

    abals1 = bals1
    abals2 = bals2
    commods = (Set.toList.Set.fromList) (getCommods abals1 ++ getCommods abals2)

    vals1 = getVals abals1
    vals2 = getVals abals2

    colors = prefixColors anames
    anames = nub $ sort $ map fst $ (Map.keys vals1 ++ Map.keys vals2)
    aNameWidth = maximum $ [0] ++ (map length anames)
    vcur = venv_commodity venv1

-- | Show a series of entries in a table
entriesTable :: [Entry] -> X.Element
entriesTable es = node "table" (tstyle,cgroups++[header]++bodies)
  where
     es' = map mergeTransactions es

     cgroups = [colgroup 2, colgroup (length commods)]

     header = node "thead" $ tr $ 
       [ thL "Date" , thL "Details" ] ++ [thR c | c <- commods]
     bodies = map (node "tbody".erows) es'
     erows e = tr [td (alignLeft, show (edate e)), td (alignLeft, node "b" (edescription e))]
               : map trow (etransactions e)
     trow rt = tr ([td (), td (alignLeft, taccount rt)]++map (getval (tamount rt)) commods)
     getval ma c = case find (\a -> symbol (commodity a) == c) (amounts ma) of
         Nothing -> td ()
         Just a -> td (alignRight,showAmount' a)

     commods = commoditySymbols (netEntries es')

     mergeTransactions :: Entry -> Entry
     mergeTransactions e@(Entry{etransactions=ts}) = e{etransactions=ts'}
       where 
         ts' = foldl' addt [] ts
         addt (t1:ts) t | taccount t == taccount t1 = t1{tamount=tamount t1 + tamount t} : ts
                        | otherwise                 = t1 : addt ts t
         addt [] t = [t]

showA c v = showAmount' (Amount c v Nothing)
showEA c ev = errval (\v -> if v == 0 then "" else showAmount' (Amount c v Nothing)) id ev

raw s = X.blank_cdata {X.cdData = s,X.cdVerbatim = X.CDataRaw}

th a = X.node (X.unqual "th") a
tr a = X.node (X.unqual "tr") a
td a = X.node (X.unqual "td") a

thL a = th (alignLeft,a)
thR a = th (alignRight,a)

alignRight = attr "align" "right"
alignLeft = attr "align" "left"
tstyle = [ attr "frame" "box", attr "rules" "groups"
         ]

colgroup :: Int -> X.Element
colgroup n = node "colgroup" (attr "span" (show n))

node s a = X.node (X.unqual s) a
attr s a = X.Attr (X.unqual s) a

fill n empty vs = vs ++ replicate (n - length vs) empty

getCommods :: Balances -> [Commodity]
getCommods abals = map showCommas $ Map.elems $ foldBalances f Map.empty abals
  where
    showCommas c = c{comma=True}
    f an a = let c = commodity a in Map.insertWith g (symbol c) c
    g c1 c2 = c1{precision=max (precision c1) (precision c2)}

getVals :: Balances -> Map.Map (AccountNameC,CommoditySymbol) Double
getVals abals = foldBalances f Map.empty abals
  where
    f an a = Map.insert (an,symbol $ commodity a) (quantity a)

-- Just color the top level categories for now
prefixColors anames = Map.fromList $ zip [an | an <- anames, length an == 1] (cycle colors)
  where
    colors = ["#e0e0f0","#e0f0e0"]


tableCSS = concat $ intersperse "\n" [
  "body {",
  "  font-family: sans-serif;",
  "  }",
  "",
  "table {",
  "  border-collapse: collapse;",
  "  border: 1px solid #03476F;",
  "  }",
  "",
  "th {",
  "  background: #4591AD;",
  "  color: #FFFFFF;",
  "  padding: 4px;",
  "}",
  "",
  "td {",
  "  padding: 4px;",
  "}"
  ]