diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2012 Kirill Zaborsky + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Codec/Xlsx/Templater.hs b/src/Codec/Xlsx/Templater.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Xlsx/Templater.hs @@ -0,0 +1,134 @@ +{-# 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 (( [] + (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 diff --git a/src/Test.hs b/src/Test.hs new file mode 100644 --- /dev/null +++ b/src/Test.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} +import Codec.Xlsx.Templater +import Data.Map +import Data.Time.Calendar +import Data.Time.LocalTime + +test :: IO () +test = run "tmpl.xlsx" "tmpl-out.xlsx" [(empty, TemplateSettings Rows 0, d1), + (common, TemplateSettings Rows 3, d2), + (empty, TemplateSettings Columns 1, d3)] + where + d1 = [fromList [("a", TplText "first row"), ("b", TplText "b1")], + fromList [("a", TplText "second row should be here!"), ("b", TplText "b2")]] + common = fromList [("common1", TplText "common first value"), ("commonDbl", TplDouble 42)] + d2 = + [fromList [("a", TplText "a value"),("b", TplText "b value"),("c", TplText "c value")], + fromList [("a", TplText "a value'"),("b", TplDouble 1.23456),("c", TplLocalTime $ LocalTime (fromGregorian 2012 08 13) (TimeOfDay 12 13 14))]] + d3 = [fromList [("x", TplText "first column"), ("z", TplText "z1")], + fromList [("x", TplText "second column should be here!"), ("z", TplText "z2")], + fromList [("x", TplText "column #3"), ("z", TplText "z3")]] + +n = TplDouble +txt = TplText +dt d m y h mi s = TplLocalTime $ LocalTime (fromGregorian d m y) (TimeOfDay h mi s) +d d' m y = dt d' m y 0 0 0 +t = dt 2000 1 1 + + +repairData = replicate 10000 $ fromList + [("N", n 23456), ("Org", txt "XYZ Co."), ("Date", d 2012 1 13), ("Time", t 10 00 00), + ("CarNum", txt "X666YZ777"), ("SaleDate", d 2009 12 07), ("VIN", txt "WWWZZZ6KZBW666666"), + ("Run", n 77777) , ("Brand", txt "BELAZ"), ("Model", txt "Tachila"), + ("Problem", txt "Something broken"), ("ProblemSystem", txt "Electornics"), + ("ProblemDetail", txt "No power"), ("ProblemCause", txt "Bug found"), + ("Weather", txt "Windy with some clouds"), ("HelpResult", txt "Removed bug"), + ("Status", txt "Fixed"), ("AppealType", txt "Evacuation") , ("Evacuator", txt "BORYA Ltd."), + ("EvacuationCity", txt "Chicago"), ("SaleDealer", txt "Some greate Car Dealer"), + ("ProblemAddress", txt "Somewhere over the rainbow"), ("CustomerFirstName", txt "John"), + ("CustomerSurname", txt "Dow"), ("OrderNumber", txt "some"), ("RepairFinishDate", d 2012 2 1), + ("CountryEvacuatorRun", txt "-"), ("CustomerPhone", txt "+7 (495) 666 6666"), + ("Comment", txt "some notes here"), ("Cost", n 6666.66), ("CostExplained", txt "10 * 666,666")] + +main = run "data/Repairs-template.xlsx" "data/Repairs.xlsx" [(empty, TemplateSettings Rows 1, repairData)] diff --git a/xlsx-templater.cabal b/xlsx-templater.cabal new file mode 100644 --- /dev/null +++ b/xlsx-templater.cabal @@ -0,0 +1,53 @@ +Name: xlsx-templater + +Version: 0.0.1 + +Synopsis: Simple and incomplete Excel file templater +Description: + Library for creating xlsx data files from xlsx tempaltes. + +Homepage: https://github.com/qrilka/xlsx-templater +Bug-Reports: https://github.com/qrilka/xlsx-templater/issues +License: MIT +License-file: LICENSE +Author: Kirill Zaborsky +Maintainer: qrilka@gmail.com + + +Category: Codec +Build-type: Simple + +-- Extra files to be distributed with the package, such as examples or +-- a README. +-- Extra-source-files: + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.6 + + +Library + Hs-source-dirs: src + Exposed-modules: Codec.Xlsx.Templater + + +Executable test + Hs-source-dirs: src + ghc-options: -rtsopts -Wall -threaded -O2 + + main-is: Test.hs + + + Build-depends: base == 4.* + , containers + , transformers + , bytestring + , text + , xlsx == 0.0.1 + , data-default == 0.4.* + , conduit == 0.4.* + , parsec == 3.1.* + , time + +source-repository head + type: git + location: git://github.com/qrilka/xlsx-templater.git