{-# LANGUAGE OverloadedStrings #-}
module Codec.Xlsx.Templater(
  Orientation(..),
  TemplateSettings(..),
  TemplateDataRow,
  TemplateValue(..),
  run
  ) where

import           Codec.Xlsx
import           Codec.Xlsx.Parser
import           Codec.Xlsx.Writer
import           Data.List
import qualified Data.Map as M
import           Data.Text (Text, pack)
import           Data.Time.LocalTime
import           Text.Parsec
import           Text.Parsec.Text()


data Orientation =  Rows | Columns
                 deriving (Show, Eq)

data TemplateSettings = TemplateSettings { tsOrientation :: Orientation
                                         , tsRepeated    :: Int         -- ^ repeated row/column (depending on 'tsOrientation')
                                         }


data TemplateValue = TplText Text | TplDouble Double | TplLocalTime LocalTime
                   deriving Show

-- | data row as a map from template variable name to a 'TemplateValue'
type TemplateDataRow = M.Map Text TemplateValue

data Converter = Match Text | PassThrough
               deriving Show

data TplCell = TplCell{ tplConverter :: Converter
                      , tplSrc       :: Maybe CellData
                      , tplX         :: Int
                      }
              deriving Show

tpl2xlsx :: TemplateValue -> CellValue
tpl2xlsx (TplText t) = CellText t
tpl2xlsx (TplDouble d) = CellDouble d
tpl2xlsx (TplLocalTime t) = CellLocalTime t

replacePlaceholders :: [[Maybe CellData]] -> TemplateDataRow -> [[Maybe CellData]]
replacePlaceholders d tdr = map (map $ fmap replace) d
  where
    replace :: CellData -> CellData
    replace cd@CellData{cdValue=Just (CellText t)} =
      either (const cd) (\ph -> cd{cdValue=Just (phValue ph)}) (getVar t)
    replace cd = cd
    phValue ph = maybe (CellText ph) tpl2xlsx (M.lookup ph tdr)

getVar :: Text -> Either ParseError Text
getVar = parse varParser "unnecessary error"
  where
    varParser = do
      string "{{"
      name <- many1 $ noneOf "}"
      string "}}"
      return $ pack name

buildTemplate :: Int -> [Maybe CellData] -> [TplCell]
buildTemplate x = map build
  where
    build cd = TplCell{ tplConverter = conv cd
                      , tplSrc       = cd
                      , tplX         = x}
    conv (Just CellData{cdValue=Just (CellText t)}) = either (const PassThrough) Match (getVar t)
    conv _ = PassThrough

applyTemplate :: [TplCell] -> TemplateDataRow -> [Maybe CellData]
applyTemplate t r = map transform t
  where
    transform tc = case tplConverter tc of
      Match k     -> do
        cd <- tplSrc tc
        case M.lookup k r of
          Just v  -> return cd{cdValue = Just (tpl2xlsx v)}
          Nothing -> return cd

      PassThrough -> tplSrc tc

fixColumns :: [ColumnsWidth] -> Int -> Int -> [ColumnsWidth]
fixColumns cw c n = prolog ++ dataepilog
  where
    (prolog, rest) = span ((<c) . cwMax) cw
    dataepilog = case rest of
      [] -> []
      (dCW : rest') -> fixD dCW : fixEpilog rest'
    fixD (ColumnsWidth dMin dMax width) = ColumnsWidth dMin (dMax + n - 1) width
    fixEpilog = map (\(ColumnsWidth dMin dMax width) -> ColumnsWidth (dMin + n - 1) (dMax + n - 1) width)

fixRowHeights :: RowHeights -> Int -> Int -> RowHeights
fixRowHeights rh r n = insertCopies $ shift removeOriginal
  where
    original = M.lookup r rh
    removeOriginal = M.delete r rh
    shift = M.mapKeys (\x -> if x > r then x + n - 1 else x)
    insertCopies m = case original of
      Just h -> foldr (\x m' -> M.insert x h m') m [r..(r + n -1)]
      Nothing -> m


runSheet :: Xlsx -> Int -> (TemplateDataRow, TemplateSettings, [TemplateDataRow]) -> IO Worksheet
runSheet x n (cdr, ts, d) = do
  ws <- sheet x n
  let
    templateRows = if tsOrientation ts == Columns then transpose $ toList ws else toList ws
    repeatRow = tsRepeated ts
    (prolog, templateRow : epilog) = splitAt repeatRow templateRows
    tpl = buildTemplate repeatRow templateRow
    prolog' = replacePlaceholders prolog cdr
    n = length d
    d' = map (applyTemplate tpl) d
    epilog' = replacePlaceholders epilog cdr
    output = concat [prolog', d', epilog']
    result = if tsOrientation ts == Columns then transpose output else output
    (cw, rh) = if tsOrientation ts == Columns
                 then (fixColumns (wsColumns ws) (repeatRow + 1) n, wsRowHeights ws)
                 else (wsColumns ws, fixRowHeights (wsRowHeights ws) (repeatRow + 1) n)
    in
   return $ fromList (wsName ws) cw rh result

-- | template runner: reads template, constructs new xlsx file based on template data and template settings
run :: FilePath -> FilePath -> [(TemplateDataRow, TemplateSettings, [TemplateDataRow])] -> IO ()
run tp op options = do
  x@Xlsx{xlStyles=Styles sbs} <- xlsx tp
  out <- mapM (uncurry (runSheet x)) $ zip [0..] options
  writeXlsxStyles op sbs out