xlsx 0.1.2 → 0.2.0
raw patch · 17 files changed
+3810/−160 lines, 17 filesdep +mtldep −old-timedep ~bytestringdep ~lensdep ~vector
Dependencies added: mtl
Dependencies removed: old-time
Dependency ranges changed: bytestring, lens, vector
Files
- CHANGELOG.markdown +48/−0
- changelog +0/−23
- src/Codec/Xlsx/Formatted.hs +266/−0
- src/Codec/Xlsx/Parser.hs +46/−38
- src/Codec/Xlsx/Parser/Internal.hs +100/−11
- src/Codec/Xlsx/Types.hs +102/−7
- src/Codec/Xlsx/Types/Common.hs +9/−0
- src/Codec/Xlsx/Types/PageSetup.hs +550/−0
- src/Codec/Xlsx/Types/RichText.hs +321/−0
- src/Codec/Xlsx/Types/SharedStringTable.hs +177/−0
- src/Codec/Xlsx/Types/SheetViews.hs +532/−0
- src/Codec/Xlsx/Types/StyleSheet.hs +1370/−0
- src/Codec/Xlsx/Writer.hs +60/−49
- src/Codec/Xlsx/Writer/Internal.hs +136/−0
- src/Test.hs +6/−5
- test/DataTest.hs +57/−18
- xlsx.cabal +30/−9
+ CHANGELOG.markdown view
@@ -0,0 +1,48 @@+0.2.0+-----+* added style sheet support (thanks to Edsko de Vries <edsko@well-typed.com>)+* added high level interface for styling (thanks to Edsko de Vries <edsko@well-typed.com>)+* added sheet views support (thanks to Edsko de Vries <edsko@well-typed.com>)+* added page setup support (thanks to Edsko de Vries <edsko@well-typed.com>)+* switched from `System.Time` to `Data.Time`+* added rich text support (thanks to Edsko de Vries <edsko@well-typed.com>) including shared strings+* added a bit better internals for rendering (thanks to Edsko de Vries <edsko@well-typed.com>) and parsing++0.1.2+-----+* added lenses to access cells both using RC and XY style coordinates, RC is used by default++0.1.1.1+-------+* fixed use of internal function for parsing shared strings, previous change was unused in practice++0.1.1+-----+* added support for rich text shared strings (thanks to Steve Bigham <steve.bigham@gmail.com>)++0.1.0.5+-------+* loosened dependency on zlib package++0.1.0.4+-------+* fixed generated xml so it gets read by MS Excel with no warnings (thanks Dmitriy Nikitinskiy <nikitinskiy@gmail.com>)+* improved shared strings collection by using Vector (thanks Dmitriy Nikitinskiy <nikitinskiy@gmail.com>)+* empty xml elements don't get emmitted anymore (thanks Philipp Hausmann <nikitinskiy@gmail.com>)+* imporoved and cleaned up core.xml generation++0.1.0.3+-------+* added "str" cells content extraction as text+* added a notice that formulas in <f> are not yet supported++0.1.0+-----+* better tests and documentation+* lenses for worksheets/cells+* removed streaming support as it needs better API and improved implementaion+* removed CellLocalTime as ambiguous, added CellBool++0.0.1+-----+* initial release
− changelog
@@ -1,23 +0,0 @@-0.1.2- * added lenses to access cells both using RC and XY style coordinates, RC is used by default-0.1.1.1- * fixed use of internal function for parsing shared strings, previous change was unused in practice-0.1.1- * added support for rich text shared strings (thanks to Steve Bigham <steve.bigham@gmail.com>)-0.1.0.5- * loosened dependency on zlib package-0.1.0.4- * fixed generated xml so it gets read by MS Excel with no warnings (thanks Dmitriy Nikitinskiy <nick@linux-i294.site>)- * improved shared strings collection by using Vector (thanks Dmitriy Nikitinskiy <nick@linux-i294.site>)- * empty xml elements don't get emmitted anymore (thanks Philipp Hausmann <ph_git@314.ch>)- * imporoved and cleaned up core.xml generation-0.1.0.3- * added "str" cells content extraction as text- * added a notice that formulas in <f> are not yet supported-0.1.0- * better tests and documentation- * lenses for worksheets/cells- * removed streaming support as it needs better API and improved implementaion- * removed CellLocalTime as ambiguous, added CellBool-0.0.1- * initial release
+ src/Codec/Xlsx/Formatted.hs view
@@ -0,0 +1,266 @@+-- | Higher level interface for creating styled worksheets+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wall #-}+module Codec.Xlsx.Formatted (+ FormattedCell(..)+ , Formatted(..)+ , formatted+ -- * Lenses+ -- ** FormattedCell+ , formattedAlignment+ , formattedBorder+ , formattedFill+ , formattedFont+ , formattedProtection+ , formattedPivotButton+ , formattedQuotePrefix+ , formattedValue+ , formattedColSpan+ , formattedRowSpan+ ) where++import Prelude hiding (mapM)+import Control.Lens+import Control.Monad.State hiding (mapM, forM_)+import Data.Default+import Data.Foldable (forM_)+import Data.List (sortBy)+import Data.Map (Map)+import Data.Ord (comparing)+import Data.Traversable (mapM)+import Data.Tuple (swap)+import qualified Data.Map as Map++import Codec.Xlsx.Types++{-------------------------------------------------------------------------------+ Internal: formatting state+-------------------------------------------------------------------------------}++data FormattingState = FormattingState {+ _formattingBorders :: Map Border Int+ , _formattingCellXfs :: Map CellXf Int+ , _formattingFills :: Map Fill Int+ , _formattingFonts :: Map Font Int+ , _formattingMerges :: [Range] -- ^ In reverse order+ }++makeLenses ''FormattingState++stateFromStyleSheet :: StyleSheet -> FormattingState+stateFromStyleSheet StyleSheet{..} = FormattingState{+ _formattingBorders = fromList _styleSheetBorders+ , _formattingCellXfs = fromList _styleSheetCellXfs+ , _formattingFills = fromList _styleSheetFills+ , _formattingFonts = fromList _styleSheetFonts+ , _formattingMerges = []+ }+ where+ fromList :: Ord a => [a] -> Map a Int+ fromList = Map.fromList . (`zip` [0..])++stateToStyleSheet :: FormattingState -> StyleSheet+stateToStyleSheet FormattingState{..} = StyleSheet{+ _styleSheetBorders = toList _formattingBorders+ , _styleSheetCellXfs = toList _formattingCellXfs+ , _styleSheetFills = toList _formattingFills+ , _styleSheetFonts = toList _formattingFonts+ }+ where+ toList :: Map a Int -> [a]+ toList = map snd . sortBy (comparing fst) . map swap . Map.toList++getId :: Ord a => Lens' FormattingState (Map a Int) -> a -> State FormattingState Int+getId f a = do+ aMap <- use f+ case Map.lookup a aMap of+ Just aId -> return aId+ Nothing -> do let aId = Map.size aMap+ f %= Map.insert a aId+ return aId++{-------------------------------------------------------------------------------+ Cell with formatting+-------------------------------------------------------------------------------}++-- | Cell with formatting+--+-- See 'formatted' for more details.+--+-- TODOs:+--+-- * Add a number format ('_cellXfApplyNumberFormat', '_cellXfNumFmtId')+-- * Add references to the named style sheets ('_cellXfId')+data FormattedCell = FormattedCell {+ _formattedAlignment :: Maybe Alignment+ , _formattedBorder :: Maybe Border+ , _formattedFill :: Maybe Fill+ , _formattedFont :: Maybe Font+ , _formattedProtection :: Maybe Protection+ , _formattedPivotButton :: Maybe Bool+ , _formattedQuotePrefix :: Maybe Bool+ , _formattedValue :: Maybe CellValue+ , _formattedColSpan :: Int+ , _formattedRowSpan :: Int+ }+ deriving (Show, Eq)++makeLenses ''FormattedCell++instance Default FormattedCell where+ def = FormattedCell {+ _formattedAlignment = Nothing+ , _formattedBorder = Nothing+ , _formattedFill = Nothing+ , _formattedFont = Nothing+ , _formattedProtection = Nothing+ , _formattedPivotButton = Nothing+ , _formattedQuotePrefix = Nothing+ , _formattedValue = Nothing+ , _formattedColSpan = 1+ , _formattedRowSpan = 1+ }++{-------------------------------------------------------------------------------+ Client-facing API+-------------------------------------------------------------------------------}++-- | Result of formatting+--+-- See 'formatted'+data Formatted = Formatted {+ -- | The final 'CellMap'; see '_wsCells'+ formattedCellMap :: CellMap++ -- | The final stylesheet; see '_xlStyles' (and 'renderStyleSheet')+ , formattedStyleSheet :: StyleSheet++ -- | The final list of cell merges; see '_wsMerges'+ , formattedMerges :: [Range]+ }++-- | Higher level API for creating formatted documents+--+-- Creating formatted Excel spreadsheets using the 'Cell' datatype directly,+-- even with the support for the 'StyleSheet' datatype, is fairly painful.+-- This has a number of causes:+--+-- * The 'Cell' datatype wants an 'Int' for the style, which is supposed to+-- point into the '_styleSheetCellXfs' part of a stylesheet. However, this can+-- be difficult to work with, as it requires manual tracking of cell style+-- IDs, which in turns requires manual tracking of font IDs, border IDs, etc.+-- * Row-span and column-span properties are set on the worksheet as a whole+-- ('wsMerges') rather than on individual cells.+-- * Excel does not correctly deal with borders on cells that span multiple+-- columns or rows. Instead, these rows must be set on all the edge cells+-- in the block. Again, this means that this becomes a global property of+-- the spreadsheet rather than properties of individual cells.+--+-- This function deals with all these problems. Given a map of 'FormattedCell's,+-- which refer directly to 'Font's, 'Border's, etc. (rather than font IDs,+-- border IDs, etc.), and an initial stylesheet, it recovers all possible+-- sharing, constructs IDs, and then constructs the final 'CellMap', as well as+-- the final stylesheet and list of merges.+--+-- If you don't already have a 'StyleSheet' you want to use as starting point+-- then 'minimalStyleSheet' is a good choice.+formatted :: Map (Int, Int) FormattedCell -> StyleSheet -> Formatted+formatted cs styleSheet =+ let initSt = stateFromStyleSheet styleSheet+ (cs', finalSt) = runState (mapM (uncurry formatCell) (Map.toList cs)) initSt+ styleSheet' = stateToStyleSheet finalSt+ in Formatted {+ formattedCellMap = Map.fromList (concat cs')+ , formattedStyleSheet = styleSheet'+ , formattedMerges = reverse (finalSt ^. formattingMerges)+ }++-- | Format a cell with (potentially) rowspan or colspan+formatCell :: (Int, Int) -> FormattedCell -> State FormattingState [((Int, Int), Cell)]+formatCell (row, col) cell = do+ let (block, mMerge) = cellBlock (row, col) cell+ forM_ mMerge $ \merge -> formattingMerges %= (:) merge+ mapM go block+ where+ go :: ((Int, Int), FormattedCell) -> State FormattingState ((Int, Int), Cell)+ go (pos, c) = do+ styleId <- cellStyleId c+ return (pos, Cell styleId (_formattedValue c))++-- | Cell block corresponding to a single 'FormattedCell'+--+-- A single 'FormattedCell' might have a colspan or rowspan greater than 1.+-- Although Excel obviously supports cell merges, it does not correctly apply+-- borders to the cells covered by the rowspan or colspan. Therefore we create+-- a block of cells in this function; the top-left is the cell proper, and the+-- remaining cells are the cells covered by the rowspan/colspan.+--+-- Also returns the cell merge instruction, if any.+cellBlock :: (Int, Int) -> FormattedCell+ -> ([((Int, Int), FormattedCell)], Maybe Range)+cellBlock (row, col) cell@FormattedCell{..} = (block, merge)+ where+ block :: [((Int, Int), FormattedCell)]+ block = [ ((row', col'), cellAt (row', col'))+ | row' <- [topRow .. bottomRow]+ , col' <- [leftCol .. rightCol]+ ]++ merge :: Maybe Range+ merge = do guard (topRow /= bottomRow || leftCol /= rightCol)+ return $ mkRange (topRow, leftCol) (bottomRow, rightCol)++ cellAt :: (Int, Int) -> FormattedCell+ cellAt (row', col') =+ if row' == row && col == col'+ then cell+ else def & formattedBorder .~ Just (borderAt (row', col'))++ borderAt :: (Int, Int) -> Border+ borderAt (row', col') = def+ & borderTop .~ do guard (row' == topRow) ; _borderTop =<< _formattedBorder+ & borderBottom .~ do guard (row' == bottomRow) ; _borderBottom =<< _formattedBorder+ & borderLeft .~ do guard (col' == leftCol) ; _borderLeft =<< _formattedBorder+ & borderRight .~ do guard (col' == rightCol) ; _borderRight =<< _formattedBorder++ topRow, bottomRow, leftCol, rightCol :: Int+ topRow = row+ bottomRow = row + _formattedRowSpan - 1+ leftCol = col+ rightCol = col + _formattedColSpan - 1++cellStyleId :: FormattedCell -> State FormattingState (Maybe Int)+cellStyleId c = mapM (getId formattingCellXfs) =<< cellXf c++cellXf :: FormattedCell -> State FormattingState (Maybe CellXf)+cellXf FormattedCell{..} = do+ mBorderId <- getId formattingBorders `mapM` _formattedBorder+ mFillId <- getId formattingFills `mapM` _formattedFill+ mFontId <- getId formattingFonts `mapM` _formattedFont+ let xf = CellXf {+ _cellXfApplyAlignment = apply _formattedAlignment+ , _cellXfApplyBorder = apply mBorderId+ , _cellXfApplyFill = apply mFillId+ , _cellXfApplyFont = apply mFontId+ , _cellXfApplyNumberFormat = Nothing -- TODO+ , _cellXfApplyProtection = apply _formattedProtection+ , _cellXfBorderId = mBorderId+ , _cellXfFillId = mFillId+ , _cellXfFontId = mFontId+ , _cellXfNumFmtId = Nothing -- TODO+ , _cellXfPivotButton = _formattedPivotButton+ , _cellXfQuotePrefix = _formattedQuotePrefix+ , _cellXfId = Nothing -- TODO+ , _cellXfAlignment = _formattedAlignment+ , _cellXfProtection = _formattedProtection+ }+ return $ if xf == def then Nothing else Just xf+ where+ -- If we have formatting instructions, we want to set the corresponding+ -- applyXXX properties+ apply :: Maybe a -> Maybe Bool+ apply Nothing = Nothing+ apply (Just _) = Just True
src/Codec/Xlsx/Parser.hs view
@@ -9,12 +9,9 @@ import qualified Codec.Archive.Zip as Zip import Control.Applicative import Control.Arrow ((&&&))-import Control.Monad (liftM4) import Control.Monad.IO.Class() import qualified Data.ByteString.Lazy as L import Data.ByteString.Lazy.Char8()-import Data.IntMap (IntMap)-import qualified Data.IntMap as IM import Data.List import qualified Data.Map as M import Data.Maybe@@ -29,51 +26,47 @@ import Codec.Xlsx.Parser.Internal import Codec.Xlsx.Types+import Codec.Xlsx.Types.SharedStringTable -- | Reads `Xlsx' from raw data (lazy bytestring) toXlsx :: L.ByteString -> Xlsx-toXlsx bs = Xlsx sheets styles+toXlsx bs = Xlsx sheets styles names where ar = Zip.toArchive bs- ss = getSharedStrings ar+ sst = getSharedStrings ar styles = getStyles ar- wfs = getWorksheetFiles ar- sheets = M.fromList $ map (wfName &&& extractSheet ar ss) wfs+ (wfs, names) = readWorkbook ar+ sheets = M.fromList $ map (wfName &&& extractSheet ar sst) wfs data WorksheetFile = WorksheetFile { wfName :: Text , wfPath :: FilePath } deriving Show -decimal :: Monad m => Text -> m Int-decimal t = case T.decimal t of- Right (d, _) -> return d- _ -> fail "invalid decimal"--rational :: Monad m => Text -> m Double-rational t = case T.rational t of- Right (r, _) -> return r- _ -> fail "invalid rational"- extractSheet :: Zip.Archive- -> IM.IntMap Text+ -> SharedStringTable -> WorksheetFile -> Worksheet-extractSheet ar ss wf = Worksheet cws rowProps cells merges+extractSheet ar sst wf = Worksheet cws rowProps cells merges sheetViews pageSetup where file = fromJust $ Zip.fromEntry <$> Zip.findEntryByPath (wfPath wf) ar cur = case parseLBS def file of Left _ -> error "could not read file" Right d -> fromDocument d - cws = cur $/ element (n"cols") &/ element (n"col") >=>- liftM4 ColumnsWidth <$>- (attribute "min" >=> decimal) <*>- (attribute "max" >=> decimal) <*>- (attribute "width" >=> rational) <*>- (attribute "style" >=> decimal)+ -- The specification says the file should contain either 0 or 1 @sheetViews@+ -- (4th edition, section 18.3.1.88, p. 1704 and definition CT_Worksheet, p. 3910)+ sheetViewList = cur $/ element (n"sheetViews") &/ element (n"sheetView") >=> fromCursor+ sheetViews = case sheetViewList of+ [] -> Nothing+ views -> Just views + -- Likewise, @pageSetup@ also occurs either 0 or 1 times+ pageSetup = listToMaybe $ cur $/ element (n"pageSetup") >=> fromCursor++ cws = cur $/ element (n"cols") &/ element (n"col") >=> fromCursor+ (rowProps, cells) = collect $ cur $/ element (n"sheetData") &/ element (n"row") >=> parseRow parseRow c = do r <- c $| attribute "r" >=> decimal@@ -92,7 +85,7 @@ let s = listToMaybe $ cell $| attribute "s" >=> decimal t = fromMaybe "n" $ listToMaybe $ cell $| attribute "t"- d = listToMaybe $ cell $/ element (n"v") &/ content >=> extractCellValue ss t+ d = listToMaybe $ cell $/ element (n"v") &/ content >=> extractCellValue sst t (c, r) <- T.span (>'9') <$> (cell $| attribute "r") return (int r, col2int c, Cell s d) collect = foldr collectRow (M.empty, M.empty)@@ -107,11 +100,15 @@ parseMerges = element (n"mergeCells") &/ element (n"mergeCell") >=> parseMerge parseMerge c = c $| attribute "ref" -extractCellValue :: IntMap Text -> Text -> Text -> [CellValue]-extractCellValue ss "s" v =+extractCellValue :: SharedStringTable -> Text -> Text -> [CellValue]+extractCellValue sst "s" v = case T.decimal v of- Right (d, _) -> maybeToList $ fmap CellText $ IM.lookup d ss- _ -> []+ Right (d, _) ->+ case sstItem sst d of+ StringItemText txt -> [CellText txt]+ StringItemRich rich -> [CellRich rich]+ _ ->+ [] extractCellValue _ "str" str = [CellText str] extractCellValue _ "n" v = case T.rational v of@@ -145,20 +142,22 @@ Left _ -> error "could not read file" Right d -> fromDocument d --- | Get shared strings (if there are some) into IntMap.-getSharedStrings :: Zip.Archive -> IM.IntMap Text+-- | Get shared string table+getSharedStrings :: Zip.Archive -> SharedStringTable getSharedStrings x = case xmlCursor x "xl/sharedStrings.xml" of- Nothing -> IM.empty- Just c -> parseSharedStrings c+ Nothing ->+ error "invalid shared strings"+ Just c ->+ let [sst] = fromCursor c in sst getStyles :: Zip.Archive -> Styles getStyles ar = case Zip.fromEntry <$> Zip.findEntryByPath "xl/styles.xml" ar of Nothing -> Styles L.empty Just xml -> Styles xml --- | getWorksheetFiles pulls the names of the sheets-getWorksheetFiles :: Zip.Archive -> [WorksheetFile]-getWorksheetFiles ar = case xmlCursor ar "xl/workbook.xml" of+-- | readWorkbook pulls the names of the sheets and the defined names+readWorkbook :: Zip.Archive -> ([WorksheetFile], DefinedNames)+readWorkbook ar = case xmlCursor ar "xl/workbook.xml" of Nothing -> error "invalid workbook" Just c ->@@ -166,7 +165,16 @@ sheetData = c $/ element (n"sheets") &/ element (n"sheet") >=> liftA2 (,) <$> attribute "name" <*> attribute (odr"id") wbRels = getWbRels ar- in [WorksheetFile name ("xl/" ++ T.unpack (fromJust $ lookup rId wbRels)) | (name, rId) <- sheetData]+ names = c $/ element (n"definedNames") &/ element (n"definedName") >=> mkDefinedName+ in ([WorksheetFile name ("xl/" ++ T.unpack (fromJust $ lookup rId wbRels)) | (name, rId) <- sheetData]+ ,DefinedNames names)+ where+ -- Specification says the 'name' is required.+ mkDefinedName :: Cursor -> [(Text, Maybe Text, Text)]+ mkDefinedName c = return ( head $ attribute "name" c+ , listToMaybe $ attribute "localSheetId" c+ , T.concat $ c $/ content+ ) getWbRels :: Zip.Archive -> [(Text, Text)] getWbRels ar = case xmlCursor ar "xl/_rels/workbook.xml.rels" of
src/Codec/Xlsx/Parser/Internal.hs view
@@ -1,16 +1,101 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Codec.Xlsx.Parser.Internal- ( n- , parseSharedStrings+ ( ParseException(..)+ , n+ , FromCursor(..)+ , FromAttrVal(..)+ , fromAttribute+ , maybeAttribute+ , maybeElementValue+ , maybeFromElement+ , readSuccess+ , readFailure+ , invalidText+ , defaultReadFailure+ , decimal+ , rational ) where -import qualified Data.IntMap as IM-import Data.Text (Text)+import Control.Exception (Exception)+import Data.Text (Text) import qualified Data.Text as T-import Data.XML.Types-import Text.XML.Cursor+import qualified Data.Text.Read as T+import Data.Typeable (Typeable)+import Data.XML.Types+import Text.XML.Cursor +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif +data ParseException = ParseException String+ deriving (Show, Typeable)++instance Exception ParseException++class FromCursor a where+ fromCursor :: Cursor -> [a]++class FromAttrVal a where+ fromAttrVal :: T.Reader a++instance FromAttrVal Text where+ fromAttrVal = readSuccess++instance FromAttrVal Int where+ fromAttrVal = T.decimal++instance FromAttrVal Double where+ fromAttrVal = T.rational++instance FromAttrVal Bool where+ fromAttrVal x | x == "1" || x == "true" = readSuccess True+ | x == "0" || x == "false" = readSuccess False+ | otherwise = defaultReadFailure++-- | required attribute parsing+fromAttribute :: FromAttrVal a => Name -> Cursor -> [a]+fromAttribute name cursor =+ attribute name cursor >>= runReader fromAttrVal++-- | parsing optional attributes+maybeAttribute :: FromAttrVal a => Name -> Cursor -> [Maybe a]+maybeAttribute name cursor =+ case attribute name cursor of+ [attr] -> Just <$> runReader fromAttrVal attr+ _ -> [Nothing]++maybeElementValue :: FromAttrVal a => Name -> Cursor -> [Maybe a]+maybeElementValue name cursor =+ case cursor $/ element name of+ [cursor'] -> maybeAttribute "val" cursor'+ _ -> [Nothing]++maybeFromElement :: FromCursor a => Name -> Cursor -> [Maybe a]+maybeFromElement name cursor = case cursor $/ element name of+ [cursor'] -> Just <$> fromCursor cursor'+ _ -> [Nothing]+++readSuccess :: a -> Either String (a, Text)+readSuccess x = Right (x, T.empty)++readFailure :: Text -> Either String (a, Text)+readFailure = Left . T.unpack++invalidText :: Text -> Text -> Either String (a, Text)+invalidText what txt = readFailure $ T.concat ["Invalid ", what, ": '", txt , "'"]++defaultReadFailure :: Either String (a, Text)+defaultReadFailure = Left "invalid text"++runReader :: T.Reader a -> Text -> [a]+runReader reader t = case reader t of+ Right (r, _) -> [r]+ _ -> []+ -- | Add sml namespace to name n :: Text -> Name n x = Name@@ -19,8 +104,12 @@ , namePrefix = Nothing } -parseSharedStrings :: Cursor -> IM.IntMap Text-parseSharedStrings c = IM.fromAscList $ zip [0..] (c $/ element (n"si") >=> parseT)- where- -- it's either <t> or <r>s with <t> inside- parseT c' = [T.concat $ c' $| orSelf (child >=> (element (n"r"))) &/ element (n"t") &/ content]+decimal :: Monad m => Text -> m Int+decimal t = case T.decimal t of+ Right (d, _) -> return d+ _ -> fail "invalid decimal"++rational :: Monad m => Text -> m Double+rational t = case T.rational t of+ Right (r, _) -> return r+ _ -> fail "invalid rational"
src/Codec/Xlsx/Types.hs view
@@ -1,23 +1,33 @@+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types- ( Xlsx(..), xlSheets, xlStyles+ ( Xlsx(..), xlSheets, xlStyles, xlDefinedNames , def , Styles(..) , emptyStyles+ , renderStyleSheet+ , parseStyleSheet+ , DefinedNames(..) , ColumnsWidth(..)- , Worksheet(..), wsColumns, wsRowPropertiesMap, wsCells, wsMerges+ , PageSetup(..)+ , Worksheet(..), wsColumns, wsRowPropertiesMap, wsCells, wsMerges, wsSheetViews, wsPageSetup , CellMap , CellValue(..) , Cell(..), cellValue, cellStyle , RowProperties (..)+ , Range , int2col , col2int+ , mkCellRef+ , mkRange , toRows , fromRows+ , module X ) where +import Control.Exception (SomeException, toException) import Control.Lens.TH import qualified Data.ByteString.Lazy as L import Data.Char@@ -28,7 +38,16 @@ import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T+import Text.XML (renderLBS, parseLBS)+import Text.XML.Cursor +import Codec.Xlsx.Parser.Internal+import Codec.Xlsx.Types.Common as X+import Codec.Xlsx.Types.PageSetup as X+import Codec.Xlsx.Types.RichText as X+import Codec.Xlsx.Types.SheetViews as X+import Codec.Xlsx.Types.StyleSheet as X+import Codec.Xlsx.Writer.Internal -- | Cell values include text, numbers and booleans, -- standard includes date format also but actually dates@@ -37,6 +56,7 @@ data CellValue = CellText Text | CellDouble Double | CellBool Bool+ | CellRich [RichTextRun] deriving (Eq, Show) -- | Currently cell details include only cell values and style ids@@ -68,37 +88,100 @@ , cwStyle :: Int } deriving (Eq, Show) +instance FromCursor ColumnsWidth where+ fromCursor c = do+ cwMin <- decimal =<< attribute "min" c+ cwMax <- decimal =<< attribute "max" c+ cwWidth <- rational =<< attribute "width" c+ cwStyle <- decimal =<< attribute "style" c+ return ColumnsWidth{..}++-- | Excel range (e.g. @D13:H14@)+type Range = Text+ -- | Xlsx worksheet data Worksheet = Worksheet { _wsColumns :: [ColumnsWidth] -- ^ column widths , _wsRowPropertiesMap :: Map Int RowProperties -- ^ custom row properties (height, style) map , _wsCells :: CellMap -- ^ data mapped by (row, column) pairs- , _wsMerges :: [Text] -- ^ list of cell merges (entries of the form @D13:H14@)+ , _wsMerges :: [Range] -- ^ list of cell merges+ , _wsSheetViews :: Maybe [SheetView]+ , _wsPageSetup :: Maybe PageSetup } deriving (Eq, Show) makeLenses ''Worksheet instance Default Worksheet where- def = Worksheet [] M.empty M.empty []+ def = Worksheet [] M.empty M.empty [] Nothing Nothing newtype Styles = Styles {unStyles :: L.ByteString} deriving (Eq, Show) -- | Structured representation of Xlsx file (currently a subset of its contents) data Xlsx = Xlsx- { _xlSheets :: Map Text Worksheet- , _xlStyles :: Styles+ { _xlSheets :: Map Text Worksheet+ , _xlStyles :: Styles+ , _xlDefinedNames :: DefinedNames } deriving (Eq, Show) +-- | Defined names+--+-- Each defined name consists of a name, an optional local sheet ID, and a value.+--+-- This element defines the collection of defined names for this workbook.+-- Defined names are descriptive names to represent cells, ranges of cells,+-- formulas, or constant values. Defined names can be used to represent a range+-- on any worksheet.+--+-- Excel also defines a number of reserved names with a special interpretation:+--+-- * @_xlnm.Print_Area@ specifies the workbook's print area.+-- Example value: @SheetName!$A:$A,SheetName!$1:$4@+-- * @_xlnm.Print_Titles@ specifies the row(s) or column(s) to repeat+-- at the top of each printed page.+-- * @_xlnm.Sheet_Title@:refers to a sheet title.+--+-- and others. See Section 18.2.6, "definedNames (Defined Names)" (p. 1728) of+-- the spec (second edition).+--+-- NOTE: Right now this is only a minimal implementation of defined names.+newtype DefinedNames = DefinedNames [(Text, Maybe Text, Text)]+ deriving (Eq, Show)+ makeLenses ''Xlsx instance Default Xlsx where- def = Xlsx M.empty emptyStyles+ def = Xlsx M.empty emptyStyles def +instance Default DefinedNames where+ def = DefinedNames []+ emptyStyles :: Styles emptyStyles = Styles "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\ \<styleSheet xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\"></styleSheet>" +-- | Render 'StyleSheet'+--+-- This is used to render a structured 'StyleSheet' into a raw XML 'Styles'+-- document. Actually /replacing/ 'Styles' with 'StyleSheet' would mean we+-- would need to write a /parser/ for 'StyleSheet' as well (and would moreover+-- require that we support the full style sheet specification, which is still+-- quite a bit of work).+renderStyleSheet :: StyleSheet -> Styles+renderStyleSheet = Styles . renderLBS def . toDocument++-- | Parse 'StyleSheet'+--+-- This is used to parse raw 'Styles' into structured 'StyleSheet'+-- currently not all of the style sheet specification is supported+-- so parser (and the data model) is to be completed+parseStyleSheet :: Styles -> Either SomeException StyleSheet+parseStyleSheet (Styles bs) = parseLBS def bs >>= parseDoc+ where+ parseDoc doc = case fromCursor (fromDocument doc) of+ [stylesheet] -> Right stylesheet+ _ -> Left . toException $ ParseException "Could not parse style sheets"+ -- | convert column number (starting from 1) to its textual form (e.g. 3 -> \"C\") int2col :: Int -> Text int2col = T.pack . reverse . map int2let . base26@@ -131,3 +214,15 @@ fromRows rows = M.fromList $ concatMap mapRow rows where mapRow (r, cells) = map (\(c, v) -> ((r, c), v)) cells++-- | Render position in @(row, col)@ format to an Excel reference.+--+-- > mkCellRef (2, 4) == "D2"+mkCellRef :: (Int, Int) -> CellRef+mkCellRef (row, col) = T.concat [int2col col, T.pack (show row)]++-- | Render range+--+-- > mkRange (2, 4) (6, 8) == "D2:H6"+mkRange :: (Int, Int) -> (Int, Int) -> Range+mkRange fr to = T.concat [mkCellRef fr, T.pack ":", mkCellRef to]
+ src/Codec/Xlsx/Types/Common.hs view
@@ -0,0 +1,9 @@+module Codec.Xlsx.Types.Common+ ( CellRef+ ) where++import Data.Text (Text)++-- | Excel cell reference (e.g. @E3@)+-- see 18.18.62 @ST_Ref@ (p. 2482)+type CellRef = Text
+ src/Codec/Xlsx/Types/PageSetup.hs view
@@ -0,0 +1,550 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wall #-}+module Codec.Xlsx.Types.PageSetup (+ -- * Main types+ PageSetup(..)+-- , renderPageSetup+ -- * Enumerations+ , CellComments(..)+ , PrintErrors(..)+ , Orientation(..)+ , PageOrder(..)+ , PaperSize(..)+ -- * Lenses+ -- ** PageSetup+ , pageSetupBlackAndWhite+ , pageSetupCellComments+ , pageSetupCopies+ , pageSetupDraft+ , pageSetupErrors+ , pageSetupFirstPageNumber+ , pageSetupFitToHeight+ , pageSetupFitToWidth+ , pageSetupHorizontalDpi+ , pageSetupId+ , pageSetupOrientation+ , pageSetupPageOrder+ , pageSetupPaperHeight+ , pageSetupPaperSize+ , pageSetupPaperWidth+ , pageSetupScale+ , pageSetupUseFirstPageNumber+ , pageSetupUsePrinterDefaults+ , pageSetupVerticalDpi+ ) where++import Control.Lens (makeLenses)+import Data.Default+import Data.Maybe (catMaybes)+import Data.Text (Text)+import Text.XML+import qualified Data.Map as Map++import Codec.Xlsx.Writer.Internal+import Codec.Xlsx.Parser.Internal++{-------------------------------------------------------------------------------+ Main types+-------------------------------------------------------------------------------}++data PageSetup = PageSetup {+ -- | Print black and white.+ _pageSetupBlackAndWhite :: Maybe Bool++ -- | This attribute specifies how to print cell comments.+ , _pageSetupCellComments :: Maybe CellComments++ -- | Number of copies to print.+ , _pageSetupCopies :: Maybe Int++ -- | Print without graphics.+ , _pageSetupDraft :: Maybe Bool++ -- | Specifies how to print cell values for cells with errors.+ , _pageSetupErrors :: Maybe PrintErrors++ -- | Page number for first printed page. If no value is specified, then+ -- 'automatic' is assumed.+ , _pageSetupFirstPageNumber :: Maybe Int++ -- | Number of vertical pages to fit on.+ , _pageSetupFitToHeight :: Maybe Int++ -- | Number of horizontal pages to fit on.+ , _pageSetupFitToWidth :: Maybe Int++ -- | Horizontal print resolution of the device.+ , _pageSetupHorizontalDpi :: Maybe Int++ -- | Relationship Id of the devMode printer settings part.+ --+ -- (Explicit reference to a parent XML element.)+ --+ -- See 22.8.2.1 "ST_RelationshipId (Explicit Relationship ID)" (p. 3784)+ , _pageSetupId :: Maybe Text++ -- | Orientation of the page.+ , _pageSetupOrientation :: Maybe Orientation++ -- | Order of printed pages+ , _pageSetupPageOrder :: Maybe PageOrder++ -- | Height of custom paper as a number followed by a unit identifier.+ --+ -- When paperHeight and paperWidth are specified, paperSize shall be ignored.+ -- Examples: @"297mm"@, @"11in"@.+ --+ -- See 22.9.2.12 "ST_PositiveUniversalMeasure (Positive Universal Measurement)" (p. 3792)+ , _pageSetupPaperHeight :: Maybe Text++ -- | Pager size+ --+ -- When paperHeight, paperWidth, and paperUnits are specified, paperSize+ -- should be ignored.+ , _pageSetupPaperSize :: Maybe PaperSize++ -- | Width of custom paper as a number followed by a unit identifier+ --+ -- Examples: @21cm@, @8.5in@+ --+ -- When paperHeight and paperWidth are specified, paperSize shall be+ -- ignored.+ , _pageSetupPaperWidth :: Maybe Text++ -- | Print scaling.+ --+ -- This attribute is restricted to values ranging from 10 to 400.+ -- This setting is overridden when fitToWidth and/or fitToHeight are in+ -- use.+ , _pageSetupScale :: Maybe Int++ -- | Use '_pageSetupFirstPageNumber' value for first page number, and do+ -- not auto number the pages.+ , _pageSetupUseFirstPageNumber :: Maybe Bool++ -- | Use the printer’s defaults settings for page setup values and don't+ -- use the default values specified in the schema.+ --+ -- Example: If dpi is not present or specified in the XML, the application+ -- must not assume 600dpi as specified in the schema as a default and+ -- instead must let the printer specify the default dpi.+ , _pageSetupUsePrinterDefaults :: Maybe Bool++ -- | Vertical print resolution of the device.+ , _pageSetupVerticalDpi :: Maybe Int+ }+ deriving (Show, Eq, Ord)++{-------------------------------------------------------------------------------+ Enumerations+-------------------------------------------------------------------------------}++-- | Cell comments+--+-- These enumerations specify how cell comments shall be displayed for paper+-- printing purposes.+--+-- See 18.18.5 "ST_CellComments (Cell Comments)" (p. 2441).+data CellComments =+ -- | Print cell comments as displayed+ CellCommentsAsDisplayed++ -- | Print cell comments at end of document+ | CellCommentsAtEnd++ -- | Do not print cell comments+ | CellCommentsNone+ deriving (Show, Eq, Ord)++-- | Print errors+--+-- This enumeration specifies how to display cells with errors when printing the+-- worksheet.+data PrintErrors =+ -- | Display cell errors as blank+ PrintErrorsBlank++ -- | Display cell errors as dashes+ | PrintErrorsDash++ -- | Display cell errors as displayed on screen+ | PrintErrorsDisplayed++ -- | Display cell errors as @#N/A@+ | PrintErrorsNA+ deriving (Show, Eq, Ord)++-- | Print orientation for this sheet+data Orientation =+ OrientationDefault+ | OrientationLandscape+ | OrientationPortrait+ deriving (Show, Eq, Ord)++-- | Specifies printed page order+data PageOrder =+ -- | Order pages vertically first, then move horizontally+ PageOrderDownThenOver++ -- | Order pages horizontally first, then move vertically+ | PageOrderOverThenDown+ deriving (Show, Eq, Ord)++-- | Paper size+data PaperSize =+ PaperA2 -- ^ A2 paper (420 mm by 594 mm)+ | PaperA3 -- ^ A3 paper (297 mm by 420 mm)+ | PaperA3Extra -- ^ A3 extra paper (322 mm by 445 mm)+ | PaperA3ExtraTransverse -- ^ A3 extra transverse paper (322 mm by 445 mm)+ | PaperA3Transverse -- ^ A3 transverse paper (297 mm by 420 mm)+ | PaperA4 -- ^ A4 paper (210 mm by 297 mm)+ | PaperA4Extra -- ^ A4 extra paper (236 mm by 322 mm)+ | PaperA4Plus -- ^ A4 plus paper (210 mm by 330 mm)+ | PaperA4Small -- ^ A4 small paper (210 mm by 297 mm)+ | PaperA4Transverse -- ^ A4 transverse paper (210 mm by 297 mm)+ | PaperA5 -- ^ A5 paper (148 mm by 210 mm)+ | PaperA5Extra -- ^ A5 extra paper (174 mm by 235 mm)+ | PaperA5Transverse -- ^ A5 transverse paper (148 mm by 210 mm)+ | PaperB4 -- ^ B4 paper (250 mm by 353 mm)+ | PaperB5 -- ^ B5 paper (176 mm by 250 mm)+ | PaperC -- ^ C paper (17 in. by 22 in.)+ | PaperD -- ^ D paper (22 in. by 34 in.)+ | PaperE -- ^ E paper (34 in. by 44 in.)+ | PaperExecutive -- ^ Executive paper (7.25 in. by 10.5 in.)+ | PaperFanfoldGermanLegal -- ^ German legal fanfold (8.5 in. by 13 in.)+ | PaperFanfoldGermanStandard -- ^ German standard fanfold (8.5 in. by 12 in.)+ | PaperFanfoldUsStandard -- ^ US standard fanfold (14.875 in. by 11 in.)+ | PaperFolio -- ^ Folio paper (8.5 in. by 13 in.)+ | PaperIsoB4 -- ^ ISO B4 (250 mm by 353 mm)+ | PaperIsoB5Extra -- ^ ISO B5 extra paper (201 mm by 276 mm)+ | PaperJapaneseDoublePostcard -- ^ Japanese double postcard (200 mm by 148 mm)+ | PaperJisB5Transverse -- ^ JIS B5 transverse paper (182 mm by 257 mm)+ | PaperLedger -- ^ Ledger paper (17 in. by 11 in.)+ | PaperLegal -- ^ Legal paper (8.5 in. by 14 in.)+ | PaperLegalExtra -- ^ Legal extra paper (9.275 in. by 15 in.)+ | PaperLetter -- ^ Letter paper (8.5 in. by 11 in.)+ | PaperLetterExtra -- ^ Letter extra paper (9.275 in. by 12 in.)+ | PaperLetterExtraTransverse -- ^ Letter extra transverse paper (9.275 in. by 12 in.)+ | PaperLetterPlus -- ^ Letter plus paper (8.5 in. by 12.69 in.)+ | PaperLetterSmall -- ^ Letter small paper (8.5 in. by 11 in.)+ | PaperLetterTransverse -- ^ Letter transverse paper (8.275 in. by 11 in.)+ | PaperNote -- ^ Note paper (8.5 in. by 11 in.)+ | PaperQuarto -- ^ Quarto paper (215 mm by 275 mm)+ | PaperStandard9_11 -- ^ Standard paper (9 in. by 11 in.)+ | PaperStandard10_11 -- ^ Standard paper (10 in. by 11 in.)+ | PaperStandard10_14 -- ^ Standard paper (10 in. by 14 in.)+ | PaperStandard11_17 -- ^ Standard paper (11 in. by 17 in.)+ | PaperStandard15_11 -- ^ Standard paper (15 in. by 11 in.)+ | PaperStatement -- ^ Statement paper (5.5 in. by 8.5 in.)+ | PaperSuperA -- ^ SuperA/SuperA/A4 paper (227 mm by 356 mm)+ | PaperSuperB -- ^ SuperB/SuperB/A3 paper (305 mm by 487 mm)+ | PaperTabloid -- ^ Tabloid paper (11 in. by 17 in.)+ | PaperTabloidExtra -- ^ Tabloid extra paper (11.69 in. by 18 in.)+ | Envelope6_3_4 -- ^ 6 3/4 envelope (3.625 in. by 6.5 in.)+ | Envelope9 -- ^ #9 envelope (3.875 in. by 8.875 in.)+ | Envelope10 -- ^ #10 envelope (4.125 in. by 9.5 in.)+ | Envelope11 -- ^ #11 envelope (4.5 in. by 10.375 in.)+ | Envelope12 -- ^ #12 envelope (4.75 in. by 11 in.)+ | Envelope14 -- ^ #14 envelope (5 in. by 11.5 in.)+ | EnvelopeB4 -- ^ B4 envelope (250 mm by 353 mm)+ | EnvelopeB5 -- ^ B5 envelope (176 mm by 250 mm)+ | EnvelopeB6 -- ^ B6 envelope (176 mm by 125 mm)+ | EnvelopeC3 -- ^ C3 envelope (324 mm by 458 mm)+ | EnvelopeC4 -- ^ C4 envelope (229 mm by 324 mm)+ | EnvelopeC5 -- ^ C5 envelope (162 mm by 229 mm)+ | EnvelopeC6 -- ^ C6 envelope (114 mm by 162 mm)+ | EnvelopeC65 -- ^ C65 envelope (114 mm by 229 mm)+ | EnvelopeDL -- ^ DL envelope (110 mm by 220 mm)+ | EnvelopeInvite -- ^ Invite envelope (220 mm by 220 mm)+ | EnvelopeItaly -- ^ Italy envelope (110 mm by 230 mm)+ | EnvelopeMonarch -- ^ Monarch envelope (3.875 in. by 7.5 in.).+ deriving (Show, Eq, Ord)++{-------------------------------------------------------------------------------+ Default instances+-------------------------------------------------------------------------------}++instance Default PageSetup where+ def = PageSetup {+ _pageSetupBlackAndWhite = Nothing+ , _pageSetupCellComments = Nothing+ , _pageSetupCopies = Nothing+ , _pageSetupDraft = Nothing+ , _pageSetupErrors = Nothing+ , _pageSetupFirstPageNumber = Nothing+ , _pageSetupFitToHeight = Nothing+ , _pageSetupFitToWidth = Nothing+ , _pageSetupHorizontalDpi = Nothing+ , _pageSetupId = Nothing+ , _pageSetupOrientation = Nothing+ , _pageSetupPageOrder = Nothing+ , _pageSetupPaperHeight = Nothing+ , _pageSetupPaperSize = Nothing+ , _pageSetupPaperWidth = Nothing+ , _pageSetupScale = Nothing+ , _pageSetupUseFirstPageNumber = Nothing+ , _pageSetupUsePrinterDefaults = Nothing+ , _pageSetupVerticalDpi = Nothing+ }++{-------------------------------------------------------------------------------+ Lenses+-------------------------------------------------------------------------------}++makeLenses ''PageSetup++{-------------------------------------------------------------------------------+ Rendering+-------------------------------------------------------------------------------}++---- | Render page setup+--renderPageSetup :: PageSetup -> RawPageSetup+--renderPageSetup = RawPageSetup . NodeElement . toElement "pageSetup"++-- | See @CT_PageSetup@, p. 3922+instance ToElement PageSetup where+ toElement nm PageSetup{..} = Element {+ elementName = nm+ , elementNodes = []+ , elementAttributes = Map.fromList . catMaybes $ [+ "paperSize" .=? _pageSetupPaperSize+ , "paperHeight" .=? _pageSetupPaperHeight+ , "paperWidth" .=? _pageSetupPaperWidth+ , "scale" .=? _pageSetupScale+ , "firstPageNumber" .=? _pageSetupFirstPageNumber+ , "fitToWidth" .=? _pageSetupFitToWidth+ , "fitToHeight" .=? _pageSetupFitToHeight+ , "pageOrder" .=? _pageSetupPageOrder+ , "orientation" .=? _pageSetupOrientation+ , "usePrinterDefaults" .=? _pageSetupUsePrinterDefaults+ , "blackAndWhite" .=? _pageSetupBlackAndWhite+ , "draft" .=? _pageSetupDraft+ , "cellComments" .=? _pageSetupCellComments+ , "useFirstPageNumber" .=? _pageSetupUseFirstPageNumber+ , "errors" .=? _pageSetupErrors+ , "horizontalDpi" .=? _pageSetupHorizontalDpi+ , "verticalDpi" .=? _pageSetupVerticalDpi+ , "copies" .=? _pageSetupCopies+ , "id" .=? _pageSetupId+ ]+ }++-- | See @ST_CellComments@, p. 3923+instance ToAttrVal CellComments where+ toAttrVal CellCommentsNone = "none"+ toAttrVal CellCommentsAsDisplayed = "asDisplayed"+ toAttrVal CellCommentsAtEnd = "atEnd"++-- | See @ST_PrintError@, p. 3923+instance ToAttrVal PrintErrors where+ toAttrVal PrintErrorsDisplayed = "displayed"+ toAttrVal PrintErrorsBlank = "blank"+ toAttrVal PrintErrorsDash = "dash"+ toAttrVal PrintErrorsNA = "NA"++-- | See @ST_Orientation@, p. 3923+instance ToAttrVal Orientation where+ toAttrVal OrientationDefault = "default"+ toAttrVal OrientationPortrait = "portrait"+ toAttrVal OrientationLandscape = "landscape"++-- | See @ST_PageOrder@, p. 3923+instance ToAttrVal PageOrder where+ toAttrVal PageOrderDownThenOver = "downThenOver"+ toAttrVal PageOrderOverThenDown = "overThenDown"++-- | See @paperSize@ (attribute of @pageSetup@), p. 1659+instance ToAttrVal PaperSize where+ toAttrVal PaperLetter = "1"+ toAttrVal PaperLetterSmall = "2"+ toAttrVal PaperTabloid = "3"+ toAttrVal PaperLedger = "4"+ toAttrVal PaperLegal = "5"+ toAttrVal PaperStatement = "6"+ toAttrVal PaperExecutive = "7"+ toAttrVal PaperA3 = "8"+ toAttrVal PaperA4 = "9"+ toAttrVal PaperA4Small = "10"+ toAttrVal PaperA5 = "11"+ toAttrVal PaperB4 = "12"+ toAttrVal PaperB5 = "13"+ toAttrVal PaperFolio = "14"+ toAttrVal PaperQuarto = "15"+ toAttrVal PaperStandard10_14 = "16"+ toAttrVal PaperStandard11_17 = "17"+ toAttrVal PaperNote = "18"+ toAttrVal Envelope9 = "19"+ toAttrVal Envelope10 = "20"+ toAttrVal Envelope11 = "21"+ toAttrVal Envelope12 = "22"+ toAttrVal Envelope14 = "23"+ toAttrVal PaperC = "24"+ toAttrVal PaperD = "25"+ toAttrVal PaperE = "26"+ toAttrVal EnvelopeDL = "27"+ toAttrVal EnvelopeC5 = "28"+ toAttrVal EnvelopeC3 = "29"+ toAttrVal EnvelopeC4 = "30"+ toAttrVal EnvelopeC6 = "31"+ toAttrVal EnvelopeC65 = "32"+ toAttrVal EnvelopeB4 = "33"+ toAttrVal EnvelopeB5 = "34"+ toAttrVal EnvelopeB6 = "35"+ toAttrVal EnvelopeItaly = "36"+ toAttrVal EnvelopeMonarch = "37"+ toAttrVal Envelope6_3_4 = "38"+ toAttrVal PaperFanfoldUsStandard = "39"+ toAttrVal PaperFanfoldGermanStandard = "40"+ toAttrVal PaperFanfoldGermanLegal = "41"+ toAttrVal PaperIsoB4 = "42"+ toAttrVal PaperJapaneseDoublePostcard = "43"+ toAttrVal PaperStandard9_11 = "44"+ toAttrVal PaperStandard10_11 = "45"+ toAttrVal PaperStandard15_11 = "46"+ toAttrVal EnvelopeInvite = "47"+ toAttrVal PaperLetterExtra = "50"+ toAttrVal PaperLegalExtra = "51"+ toAttrVal PaperTabloidExtra = "52"+ toAttrVal PaperA4Extra = "53"+ toAttrVal PaperLetterTransverse = "54"+ toAttrVal PaperA4Transverse = "55"+ toAttrVal PaperLetterExtraTransverse = "56"+ toAttrVal PaperSuperA = "57"+ toAttrVal PaperSuperB = "58"+ toAttrVal PaperLetterPlus = "59"+ toAttrVal PaperA4Plus = "60"+ toAttrVal PaperA5Transverse = "61"+ toAttrVal PaperJisB5Transverse = "62"+ toAttrVal PaperA3Extra = "63"+ toAttrVal PaperA5Extra = "64"+ toAttrVal PaperIsoB5Extra = "65"+ toAttrVal PaperA2 = "66"+ toAttrVal PaperA3Transverse = "67"+ toAttrVal PaperA3ExtraTransverse = "68"++{-------------------------------------------------------------------------------+ Parsing+-------------------------------------------------------------------------------}+-- | See @CT_PageSetup@, p. 3922+instance FromCursor PageSetup where+ fromCursor cur = do+ _pageSetupPaperSize <- maybeAttribute "paperSize" cur+ _pageSetupPaperHeight <- maybeAttribute "paperHeight" cur+ _pageSetupPaperWidth <- maybeAttribute "paperWidth" cur+ _pageSetupScale <- maybeAttribute "scale" cur+ _pageSetupFirstPageNumber <- maybeAttribute "firstPageNumber" cur+ _pageSetupFitToWidth <- maybeAttribute "fitToWidth" cur+ _pageSetupFitToHeight <- maybeAttribute "fitToHeight" cur+ _pageSetupPageOrder <- maybeAttribute "pageOrder" cur+ _pageSetupOrientation <- maybeAttribute "orientation" cur+ _pageSetupUsePrinterDefaults <- maybeAttribute "usePrinterDefaults" cur+ _pageSetupBlackAndWhite <- maybeAttribute "blackAndWhite" cur+ _pageSetupDraft <- maybeAttribute "draft" cur+ _pageSetupCellComments <- maybeAttribute "cellComments" cur+ _pageSetupUseFirstPageNumber <- maybeAttribute "useFirstPageNumber" cur+ _pageSetupErrors <- maybeAttribute "errors" cur+ _pageSetupHorizontalDpi <- maybeAttribute "horizontalDpi" cur+ _pageSetupVerticalDpi <- maybeAttribute "verticalDpi" cur+ _pageSetupCopies <- maybeAttribute "copies" cur+ _pageSetupId <- maybeAttribute "id" cur+ return PageSetup{..}++-- | See @paperSize@ (attribute of @pageSetup@), p. 1659+instance FromAttrVal PaperSize where+ fromAttrVal "1" = readSuccess PaperLetter+ fromAttrVal "2" = readSuccess PaperLetterSmall+ fromAttrVal "3" = readSuccess PaperTabloid+ fromAttrVal "4" = readSuccess PaperLedger+ fromAttrVal "5" = readSuccess PaperLegal+ fromAttrVal "6" = readSuccess PaperStatement+ fromAttrVal "7" = readSuccess PaperExecutive+ fromAttrVal "8" = readSuccess PaperA3+ fromAttrVal "9" = readSuccess PaperA4+ fromAttrVal "10" = readSuccess PaperA4Small+ fromAttrVal "11" = readSuccess PaperA5+ fromAttrVal "12" = readSuccess PaperB4+ fromAttrVal "13" = readSuccess PaperB5+ fromAttrVal "14" = readSuccess PaperFolio+ fromAttrVal "15" = readSuccess PaperQuarto+ fromAttrVal "16" = readSuccess PaperStandard10_14+ fromAttrVal "17" = readSuccess PaperStandard11_17+ fromAttrVal "18" = readSuccess PaperNote+ fromAttrVal "19" = readSuccess Envelope9+ fromAttrVal "20" = readSuccess Envelope10+ fromAttrVal "21" = readSuccess Envelope11+ fromAttrVal "22" = readSuccess Envelope12+ fromAttrVal "23" = readSuccess Envelope14+ fromAttrVal "24" = readSuccess PaperC+ fromAttrVal "25" = readSuccess PaperD+ fromAttrVal "26" = readSuccess PaperE+ fromAttrVal "27" = readSuccess EnvelopeDL+ fromAttrVal "28" = readSuccess EnvelopeC5+ fromAttrVal "29" = readSuccess EnvelopeC3+ fromAttrVal "30" = readSuccess EnvelopeC4+ fromAttrVal "31" = readSuccess EnvelopeC6+ fromAttrVal "32" = readSuccess EnvelopeC65+ fromAttrVal "33" = readSuccess EnvelopeB4+ fromAttrVal "34" = readSuccess EnvelopeB5+ fromAttrVal "35" = readSuccess EnvelopeB6+ fromAttrVal "36" = readSuccess EnvelopeItaly+ fromAttrVal "37" = readSuccess EnvelopeMonarch+ fromAttrVal "38" = readSuccess Envelope6_3_4+ fromAttrVal "39" = readSuccess PaperFanfoldUsStandard+ fromAttrVal "40" = readSuccess PaperFanfoldGermanStandard+ fromAttrVal "41" = readSuccess PaperFanfoldGermanLegal+ fromAttrVal "42" = readSuccess PaperIsoB4+ fromAttrVal "43" = readSuccess PaperJapaneseDoublePostcard+ fromAttrVal "44" = readSuccess PaperStandard9_11+ fromAttrVal "45" = readSuccess PaperStandard10_11+ fromAttrVal "46" = readSuccess PaperStandard15_11+ fromAttrVal "47" = readSuccess EnvelopeInvite+ fromAttrVal "50" = readSuccess PaperLetterExtra+ fromAttrVal "51" = readSuccess PaperLegalExtra+ fromAttrVal "52" = readSuccess PaperTabloidExtra+ fromAttrVal "53" = readSuccess PaperA4Extra+ fromAttrVal "54" = readSuccess PaperLetterTransverse+ fromAttrVal "55" = readSuccess PaperA4Transverse+ fromAttrVal "56" = readSuccess PaperLetterExtraTransverse+ fromAttrVal "57" = readSuccess PaperSuperA+ fromAttrVal "58" = readSuccess PaperSuperB+ fromAttrVal "59" = readSuccess PaperLetterPlus+ fromAttrVal "60" = readSuccess PaperA4Plus+ fromAttrVal "61" = readSuccess PaperA5Transverse+ fromAttrVal "62" = readSuccess PaperJisB5Transverse+ fromAttrVal "63" = readSuccess PaperA3Extra+ fromAttrVal "64" = readSuccess PaperA5Extra+ fromAttrVal "65" = readSuccess PaperIsoB5Extra+ fromAttrVal "66" = readSuccess PaperA2+ fromAttrVal "67" = readSuccess PaperA3Transverse+ fromAttrVal "68" = readSuccess PaperA3ExtraTransverse+ fromAttrVal t = invalidText "PaperSize" t++-- | See @ST_PageOrder@, p. 3923+instance FromAttrVal PageOrder where+ fromAttrVal "downThenOver" = readSuccess PageOrderDownThenOver+ fromAttrVal "overThenDown" = readSuccess PageOrderOverThenDown+ fromAttrVal t = invalidText "PageOrder" t++-- | See @ST_CellComments@, p. 3923+instance FromAttrVal CellComments where+ fromAttrVal "none" = readSuccess CellCommentsNone+ fromAttrVal "asDisplayed" = readSuccess CellCommentsAsDisplayed+ fromAttrVal "atEnd" = readSuccess CellCommentsAtEnd+ fromAttrVal t = invalidText "CellComments" t++-- | See @ST_PrintError@, p. 3923+instance FromAttrVal PrintErrors where+ fromAttrVal "displayed" = readSuccess PrintErrorsDisplayed+ fromAttrVal "blank" = readSuccess PrintErrorsBlank+ fromAttrVal "dash" = readSuccess PrintErrorsDash+ fromAttrVal "NA" = readSuccess PrintErrorsNA+ fromAttrVal t = invalidText "PrintErrors" t++-- | See @ST_Orientation@, p. 3923+instance FromAttrVal Orientation where+ fromAttrVal "default" = readSuccess OrientationDefault+ fromAttrVal "portrait" = readSuccess OrientationPortrait+ fromAttrVal "landscape" = readSuccess OrientationLandscape+ fromAttrVal t = invalidText "Orientation" t
+ src/Codec/Xlsx/Types/RichText.hs view
@@ -0,0 +1,321 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wall #-}+module Codec.Xlsx.Types.RichText (+ -- * Main types+ RichTextRun(..)+ , RunProperties(..)+ , applyRunProperties+ -- * Lenses+ -- ** RichTextRun+ , richTextRunProperties+ , richTextRunText+ -- ** RunProperties+ , runPropertiesBold+ , runPropertiesCharset+ , runPropertiesColor+ , runPropertiesCondense+ , runPropertiesExtend+ , runPropertiesFontFamily+ , runPropertiesItalic+ , runPropertiesOutline+ , runPropertiesFont+ , runPropertiesScheme+ , runPropertiesShadow+ , runPropertiesStrikeThrough+ , runPropertiesSize+ , runPropertiesUnderline+ , runPropertiesVertAlign+ ) where++import Control.Lens hiding (element)+import Control.Monad+import Data.Default+import Data.Maybe (catMaybes)+import Data.Text (Text)+import Text.XML+import Text.XML.Cursor+import qualified Data.Map as Map++import Codec.Xlsx.Parser.Internal+import Codec.Xlsx.Types.StyleSheet+import Codec.Xlsx.Writer.Internal++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+import Data.Monoid+#endif++-- | Rich Text Run+--+-- This element represents a run of rich text. A rich text run is a region of+-- text that share a common set of properties, such as formatting properties.+--+-- Section 18.4.4, "r (Rich Text Run)" (p. 1724)+data RichTextRun = RichTextRun {+ -- | This element represents a set of properties to apply to the contents of+ -- this rich text run.+ _richTextRunProperties :: Maybe RunProperties++ -- | This element represents the text content shown as part of a string.+ --+ -- NOTE: 'RichTextRun' elements with an empty text field will result in+ -- an error when opening the file in Excel.+ --+ -- Section 18.4.12, "t (Text)" (p. 1727)+ , _richTextRunText :: Text+ }+ deriving (Show, Eq, Ord)++-- | Run properties+--+-- Section 18.4.7, "rPr (Run Properties)" (p. 1725)+data RunProperties = RunProperties {+ -- | Displays characters in bold face font style.+ --+ -- Section 18.8.2, "b (Bold)" (p. 1757)+ _runPropertiesBold :: Maybe Bool++ -- | This element defines the font character set of this font.+ --+ -- Section 18.4.1, "charset (Character Set)" (p. 1721)+ , _runPropertiesCharset :: Maybe Int++ -- | One of the colors associated with the data bar or color scale.+ --+ -- Section 18.3.1.15, "color (Data Bar Color)" (p. 1608)+ , _runPropertiesColor :: Maybe Color++ -- | Macintosh compatibility setting. Represents special word/character+ -- rendering on Macintosh, when this flag is set. The effect is to condense+ -- the text (squeeze it together).+ --+ -- Section 18.8.12, "condense (Condense)" (p. 1764)+ , _runPropertiesCondense :: Maybe Bool++ -- | This element specifies a compatibility setting used for previous+ -- spreadsheet applications, resulting in special word/character rendering+ -- on those legacy applications, when this flag is set. The effect extends+ -- or stretches out the text.+ --+ -- Section 18.8.17, "extend (Extend)" (p. 1766)+ , _runPropertiesExtend :: Maybe Bool++ -- | The font family this font belongs to. A font family is a set of fonts+ -- having common stroke width and serif characteristics. This is system+ -- level font information. The font name overrides when there are+ -- conflicting values.+ --+ -- Section 18.8.18, "family (Font Family)" (p. 1766)+ , _runPropertiesFontFamily :: Maybe FontFamily++ -- | Displays characters in italic font style. The italic style is defined+ -- by the font at a system level and is not specified by ECMA-376.+ --+ -- Section 18.8.26, "i (Italic)" (p. 1773)+ , _runPropertiesItalic :: Maybe Bool++ -- | This element displays only the inner and outer borders of each+ -- character. This is very similar to Bold in behavior.+ --+ -- Section 18.4.2, "outline (Outline)" (p. 1722)+ , _runPropertiesOutline :: Maybe Bool++ -- | This element is a string representing the name of the font assigned to+ -- display this run.+ --+ -- Section 18.4.5, "rFont (Font)" (p. 1724)+ , _runPropertiesFont :: Maybe Text++ -- | Defines the font scheme, if any, to which this font belongs. When a+ -- font definition is part of a theme definition, then the font is+ -- categorized as either a major or minor font scheme component. When a new+ -- theme is chosen, every font that is part of a theme definition is updated+ -- to use the new major or minor font definition for that theme. Usually+ -- major fonts are used for styles like headings, and minor fonts are used+ -- for body and paragraph text.+ --+ -- Section 18.8.35, "scheme (Scheme)" (p. 1794)+ , _runPropertiesScheme :: Maybe FontScheme++ -- | Macintosh compatibility setting. Represents special word/character+ -- rendering on Macintosh, when this flag is set. The effect is to render a+ -- shadow behind, beneath and to the right of the text.+ --+ -- Section 18.8.36, "shadow (Shadow)" (p. 1795)+ , _runPropertiesShadow :: Maybe Bool++ -- | This element draws a strikethrough line through the horizontal middle+ -- of the text.+ --+ -- Section 18.4.10, "strike (Strike Through)" (p. 1726)+ , _runPropertiesStrikeThrough :: Maybe Bool++ -- | This element represents the point size (1/72 of an inch) of the Latin+ -- and East Asian text.+ --+ -- Section 18.4.11, "sz (Font Size)" (p. 1727)+ , _runPropertiesSize :: Maybe Double++ -- | This element represents the underline formatting style.+ --+ -- Section 18.4.13, "u (Underline)" (p. 1728)+ , _runPropertiesUnderline :: Maybe FontUnderline++ -- | This element adjusts the vertical position of the text relative to the+ -- text's default appearance for this run. It is used to get 'superscript'+ -- or 'subscript' texts, and shall reduce the font size (if a smaller size+ -- is available) accordingly.+ --+ -- Section 18.4.14, "vertAlign (Vertical Alignment)" (p. 1728)+ , _runPropertiesVertAlign :: Maybe FontVerticalAlignment+ }+ deriving (Show, Eq, Ord)++{-------------------------------------------------------------------------------+ Lenses+-------------------------------------------------------------------------------}++makeLenses ''RichTextRun+makeLenses ''RunProperties++{-------------------------------------------------------------------------------+ Default instances+-------------------------------------------------------------------------------}++instance Default RichTextRun where+ def = RichTextRun {+ _richTextRunProperties = Nothing+ , _richTextRunText = ""+ }++instance Default RunProperties where+ def = RunProperties {+ _runPropertiesBold = Nothing+ , _runPropertiesCharset = Nothing+ , _runPropertiesColor = Nothing+ , _runPropertiesCondense = Nothing+ , _runPropertiesExtend = Nothing+ , _runPropertiesFontFamily = Nothing+ , _runPropertiesItalic = Nothing+ , _runPropertiesOutline = Nothing+ , _runPropertiesFont = Nothing+ , _runPropertiesScheme = Nothing+ , _runPropertiesShadow = Nothing+ , _runPropertiesStrikeThrough = Nothing+ , _runPropertiesSize = Nothing+ , _runPropertiesUnderline = Nothing+ , _runPropertiesVertAlign = Nothing+ }++{-------------------------------------------------------------------------------+ Rendering+-------------------------------------------------------------------------------}++-- | See @CT_RElt@, p. 3903+instance ToElement RichTextRun where+ toElement nm RichTextRun{..} = Element {+ elementName = nm+ , elementAttributes = Map.empty+ , elementNodes = map NodeElement . catMaybes $ [+ toElement "rPr" <$> _richTextRunProperties+ , Just $ elementContent "t" _richTextRunText+ ]+ }++-- | See @CT_RPrElt@, p. 3903+instance ToElement RunProperties where+ toElement nm RunProperties{..} = Element {+ elementName = nm+ , elementAttributes = Map.empty+ , elementNodes = map NodeElement . catMaybes $ [+ elementValue "rFont" <$> _runPropertiesFont+ , elementValue "charset" <$> _runPropertiesCharset+ , elementValue "family" <$> _runPropertiesFontFamily+ , elementValue "b" <$> _runPropertiesBold+ , elementValue "i" <$> _runPropertiesItalic+ , elementValue "strike" <$> _runPropertiesStrikeThrough+ , elementValue "outline" <$> _runPropertiesOutline+ , elementValue "shadow" <$> _runPropertiesShadow+ , elementValue "condense" <$> _runPropertiesCondense+ , elementValue "extend" <$> _runPropertiesExtend+ , toElement "color" <$> _runPropertiesColor+ , elementValue "sz" <$> _runPropertiesSize+ , elementValue "u" <$> _runPropertiesUnderline+ , elementValue "vertAlign" <$> _runPropertiesVertAlign+ , elementValue "scheme" <$> _runPropertiesScheme+ ]+ }++{-------------------------------------------------------------------------------+ Parsing+-------------------------------------------------------------------------------}++-- | See @CT_RElt@, p. 3903+instance FromCursor RichTextRun where+ fromCursor cur = do+ _richTextRunText <- cur $/ element (n"t") &/ content+ _richTextRunProperties <- maybeFromElement (n"rPr") cur+ return RichTextRun{..}++-- | See @CT_RPrElt@, p. 3903+instance FromCursor RunProperties where+ fromCursor cur = do+ _runPropertiesFont <- maybeElementValue (n"rFont") cur+ _runPropertiesCharset <- maybeElementValue (n"charset") cur+ _runPropertiesFontFamily <- maybeElementValue (n"family") cur+ _runPropertiesBold <- maybeElementValue (n"b") cur+ _runPropertiesItalic <- maybeElementValue (n"i") cur+ _runPropertiesStrikeThrough <- maybeElementValue (n"strike") cur+ _runPropertiesOutline <- maybeElementValue (n"outline") cur+ _runPropertiesShadow <- maybeElementValue (n"shadow") cur+ _runPropertiesCondense <- maybeElementValue (n"condense") cur+ _runPropertiesExtend <- maybeElementValue (n"extend") cur+ _runPropertiesColor <- maybeFromElement (n"color") cur+ _runPropertiesSize <- maybeElementValue (n"sz") cur+ _runPropertiesUnderline <- maybeElementValue (n"u") cur+ _runPropertiesVertAlign <- maybeElementValue (n"vertAlign") cur+ _runPropertiesScheme <- maybeElementValue (n"scheme") cur+ return RunProperties{..}++{-------------------------------------------------------------------------------+ Applying formatting+-------------------------------------------------------------------------------}++-- | The 'Monoid' instance for 'RunProperties' is biased: later properties+-- override earlier ones.+instance Monoid RunProperties where+ mempty = def+ a `mappend` b = RunProperties {+ _runPropertiesBold = override _runPropertiesBold+ , _runPropertiesCharset = override _runPropertiesCharset+ , _runPropertiesColor = override _runPropertiesColor+ , _runPropertiesCondense = override _runPropertiesCondense+ , _runPropertiesExtend = override _runPropertiesExtend+ , _runPropertiesFontFamily = override _runPropertiesFontFamily+ , _runPropertiesItalic = override _runPropertiesItalic+ , _runPropertiesOutline = override _runPropertiesOutline+ , _runPropertiesFont = override _runPropertiesFont+ , _runPropertiesScheme = override _runPropertiesScheme+ , _runPropertiesShadow = override _runPropertiesShadow+ , _runPropertiesStrikeThrough = override _runPropertiesStrikeThrough+ , _runPropertiesSize = override _runPropertiesSize+ , _runPropertiesUnderline = override _runPropertiesUnderline+ , _runPropertiesVertAlign = override _runPropertiesVertAlign+ }+ where+ override :: (RunProperties -> Maybe x) -> Maybe x+ override f = f b `mplus` f a++-- | Apply properties to a 'RichTextRun'+--+-- If the 'RichTextRun' specifies its own properties, then these overrule the+-- properties specified here. For example, adding @bold@ to a 'RichTextRun'+-- which is already @italic@ will make the 'RichTextRun' both @bold and @italic@+-- but adding it to one that that is explicitly _not_ bold will leave the+-- 'RichTextRun' unchanged.+applyRunProperties :: RunProperties -> RichTextRun -> RichTextRun+applyRunProperties p (RichTextRun Nothing t) = RichTextRun (Just p) t+applyRunProperties p (RichTextRun (Just p') t) = RichTextRun (Just (p `mappend` p')) t
@@ -0,0 +1,177 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wall #-}+module Codec.Xlsx.Types.SharedStringTable (+ -- * Main types+ SharedStringTable(..)+ , StringItem(..)+ , sstConstruct+ , sstLookupText+ , sstLookupRich+ , sstItem+ -- * Lenses+ -- ** SharedStringTable+ , sharedStringTable+ ) where++import Control.Lens hiding (element)+import Control.Monad++import Data.Maybe (mapMaybe)+import Data.Text (Text)+import Data.Vector (Vector)+import Numeric.Search.Range (searchFromTo)+import Text.XML+import Text.XML.Cursor+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.Vector as V++import Codec.Xlsx.Parser.Internal+import Codec.Xlsx.Types+import Codec.Xlsx.Writer.Internal++-- | Shared string table+--+-- A workbook can contain thousands of cells containing string (non-numeric)+-- data. Furthermore this data is very likely to be repeated across many rows or+-- columns. The goal of implementing a single string table that is shared across+-- the workbook is to improve performance in opening and saving the file by only+-- reading and writing the repetitive information once.+--+-- Relevant parts of the EMCA standard (2nd edition, part 1,+-- <http://www.ecma-international.org/publications/standards/Ecma-376.htm>),+-- page numbers refer to the page in the PDF rather than the page number as+-- printed on the page):+--+-- * Section 18.4, "Shared String Table" (p. 1712)+-- in particular subsection 18.4.9, "sst (Shared String Table)" (p. 1726)+--+-- TODO: The @extLst@ child element is currently unsupported.+data SharedStringTable = SharedStringTable {+ _sharedStringTable :: Vector StringItem+ }+ deriving (Show, Eq, Ord)++-- | String Item+--+-- This element is the representation of an individual string in the Shared+-- String table.+--+-- The spec says: "If the string is just a simple string with formatting applied+-- at the cell level, then the String Item (si) should contain a single text+-- element used to express the string. However, if the string in the cell is+-- more complex - i.e., has formatting applied at the character level - then the+-- string item shall consist of multiple rich text runs which collectively are+-- used to express the string.". So we have either a single "Text" field, or+-- else a list of "RichTextRun"s, each of which is some "Text" with layout+-- properties.+--+-- TODO: Currently we do not support @phoneticPr@ (Phonetic Properties, 18.4.3,+-- p. 1723) or @rPh@ (Phonetic Run, 18.4.6, p. 1725).+--+-- Section 18.4.8, "si (String Item)" (p. 1725)+data StringItem =+ StringItemText Text+ | StringItemRich [RichTextRun]+ deriving (Show, Eq, Ord)++{-------------------------------------------------------------------------------+ Lenses+-------------------------------------------------------------------------------}++makeLenses ''SharedStringTable++{-------------------------------------------------------------------------------+ Rendering+-------------------------------------------------------------------------------}++instance ToDocument SharedStringTable where+ toDocument = documentFromElement "Shared string table generated by xlsx"+ . toElement "sst"++-- | See @CT_Sst@, p. 3902.+--+-- TODO: The @count@ and @uniqCount@ attributes are currently unsupported.+instance ToElement SharedStringTable where+ toElement nm SharedStringTable{..} = Element {+ elementName = nm+ , elementAttributes = Map.empty+ , elementNodes = map (NodeElement . toElement "si")+ $ V.toList _sharedStringTable+ }++-- | See @CT_Rst@, p. 3903+instance ToElement StringItem where+ toElement nm si = Element {+ elementName = nm+ , elementAttributes = Map.empty+ , elementNodes = map NodeElement $+ case si of+ StringItemText text -> [elementContent "t" text]+ StringItemRich rich -> map (toElement "r") rich+ }++{-------------------------------------------------------------------------------+ Parsing+-------------------------------------------------------------------------------}++-- | See @CT_Sst@, p. 3902+--+-- The optional attributes @count@ and @uniqCount@ are being ignored at least currently+instance FromCursor SharedStringTable where+ fromCursor cur = do+ let+ items = cur $/ element (n"si") >=> fromCursor+ return (SharedStringTable (V.fromList items))++-- | See @CT_Rst@, p. 3903+instance FromCursor StringItem where+ fromCursor cur = do+ let+ ts = cur $/ element (n"t") &/ content+ rs = cur $/ element (n"r") >=> fromCursor+ case (ts,rs) of+ ([t], []) ->+ return $ StringItemText t+ ([], _:_) ->+ return $ StringItemRich rs+ _ ->+ fail "invalid item"++{-------------------------------------------------------------------------------+ Extract shared strings+-------------------------------------------------------------------------------}++-- | Construct the 'SharedStringsTable' from an existing document+sstConstruct :: [Worksheet] -> SharedStringTable+sstConstruct =+ SharedStringTable . V.fromList . uniq . concatMap goSheet+ where+ goSheet :: Worksheet -> [StringItem]+ goSheet = mapMaybe (_cellValue >=> sstEntry) . Map.elems . _wsCells++ sstEntry :: CellValue -> Maybe StringItem+ sstEntry (CellText text) = Just $ StringItemText text+ sstEntry (CellRich rich) = Just $ StringItemRich rich+ sstEntry _ = Nothing++ uniq :: Ord a => [a] -> [a]+ uniq = Set.elems . Set.fromList++sstLookupText :: SharedStringTable -> Text -> Int+sstLookupText sst = sstLookup sst . StringItemText++sstLookupRich :: SharedStringTable -> [RichTextRun] -> Int+sstLookupRich sst = sstLookup sst . StringItemRich++-- | Internal generalization used by 'sstLookupText' and 'sstLookupRich'+sstLookup :: SharedStringTable -> StringItem -> Int+sstLookup SharedStringTable{_sharedStringTable = shared} si =+ case searchFromTo (\p -> shared V.! p >= si) 0 (V.length shared - 1) of+ Just i -> i+ Nothing -> error $ "SST entry for " ++ show si ++ " not found"++sstItem :: SharedStringTable -> Int -> StringItem+sstItem SharedStringTable{_sharedStringTable = shared} = (V.!) shared
+ src/Codec/Xlsx/Types/SheetViews.hs view
@@ -0,0 +1,532 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wall #-}+module Codec.Xlsx.Types.SheetViews (+ -- * Structured type to construct 'SheetViews'+ SheetView(..)+ , Selection(..)+ , Pane(..)+ , SheetViewType(..)+ , PaneType(..)+ , PaneState(..)+ , renderSheetViews+ -- * Lenses+ -- ** SheetView+ , sheetViewColorId+ , sheetViewDefaultGridColor+ , sheetViewRightToLeft+ , sheetViewShowFormulas+ , sheetViewShowGridLines+ , sheetViewShowOutlineSymbols+ , sheetViewShowRowColHeaders+ , sheetViewShowRuler+ , sheetViewShowWhiteSpace+ , sheetViewShowZeros+ , sheetViewTabSelected+ , sheetViewTopLeftCell+ , sheetViewType+ , sheetViewWindowProtection+ , sheetViewWorkbookViewId+ , sheetViewZoomScale+ , sheetViewZoomScaleNormal+ , sheetViewZoomScalePageLayoutView+ , sheetViewZoomScaleSheetLayoutView+ , sheetViewPane+ , sheetViewSelection+ -- ** Selection+ , selectionActiveCell+ , selectionActiveCellId+ , selectionPane+ , selectionSqref+ -- ** Pane+ , paneActivePane+ , paneState+ , paneTopLeftCell+ , paneXSplit+ , paneYSplit+ ) where++import Control.Lens (makeLenses)+import Data.Default+import Data.Maybe (catMaybes, maybeToList, listToMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import Text.XML+import Text.XML.Cursor+import qualified Data.Map as Map+import qualified Data.Text as Text++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif++import Codec.Xlsx.Types.Common+import Codec.Xlsx.Parser.Internal+import Codec.Xlsx.Writer.Internal++{-------------------------------------------------------------------------------+ Main types+-------------------------------------------------------------------------------}++-- | Worksheet view+--+-- A single sheet view definition. When more than one sheet view is defined in+-- the file, it means that when opening the workbook, each sheet view+-- corresponds to a separate window within the spreadsheet application, where+-- each window is showing the particular sheet containing the same+-- workbookViewId value, the last sheetView definition is loaded, and the others+-- are discarded. When multiple windows are viewing the same sheet, multiple+-- sheetView elements (with corresponding workbookView entries) are saved.+--+-- TODO: The @pivotSelection@ and @extLst@ child elements are unsupported.+--+-- See Section 18.3.1.87 "sheetView (Worksheet View)" (p. 1880)+data SheetView = SheetView {+ -- | Index to the color value for row/column text headings and gridlines.+ -- This is an 'index color value' (ICV) rather than rgb value.+ _sheetViewColorId :: Maybe Int++ -- | Flag indicating that the consuming application should use the default+ -- grid lines color (system dependent). Overrides any color specified in+ -- colorId.+ , _sheetViewDefaultGridColor :: Maybe Bool++ -- | Flag indicating whether the sheet is in 'right to left' display mode.+ -- When in this mode, Column A is on the far right, Column B ;is one column+ -- left of Column A, and so on. Also, information in cells is displayed in+ -- the Right to Left format.+ , _sheetViewRightToLeft :: Maybe Bool++ -- | Flag indicating whether this sheet should display formulas.+ , _sheetViewShowFormulas :: Maybe Bool++ -- | Flag indicating whether this sheet should display gridlines.+ , _sheetViewShowGridLines :: Maybe Bool++ -- | Flag indicating whether the sheet has outline symbols visible. This+ -- flag shall always override SheetPr element's outlinePr child element+ -- whose attribute is named showOutlineSymbols when there is a conflict.+ , _sheetViewShowOutlineSymbols :: Maybe Bool++ -- | Flag indicating whether the sheet should display row and column headings.+ , _sheetViewShowRowColHeaders :: Maybe Bool++ -- | Show the ruler in Page Layout View.+ , _sheetViewShowRuler :: Maybe Bool++ -- | Flag indicating whether page layout view shall display margins. False+ -- means do not display left, right, top (header), and bottom (footer)+ -- margins (even when there is data in the header or footer).+ , _sheetViewShowWhiteSpace :: Maybe Bool++ -- | Flag indicating whether the window should show 0 (zero) in cells+ -- containing zero value. When false, cells with zero value appear blank+ -- instead of showing the number zero.+ , _sheetViewShowZeros :: Maybe Bool++ -- | Flag indicating whether this sheet is selected. When only 1 sheet is+ -- selected and active, this value should be in synch with the activeTab+ -- value. In case of a conflict, the Start Part setting wins and sets the+ -- active sheet tab.+ --+ -- Multiple sheets can be selected, but only one sheet shall be active at+ -- one time.+ , _sheetViewTabSelected :: Maybe Bool++ -- | Location of the top left visible cell Location of the top left visible+ -- cell in the bottom right pane (when in Left-to-Right mode).+ , _sheetViewTopLeftCell :: Maybe CellRef++ -- | Indicates the view type.+ , _sheetViewType :: Maybe SheetViewType++ -- | Flag indicating whether the panes in the window are locked due to+ -- workbook protection. This is an option when the workbook structure is+ -- protected.+ , _sheetViewWindowProtection :: Maybe Bool++ -- | Zero-based index of this workbook view, pointing to a workbookView+ -- element in the bookViews collection.+ --+ -- NOTE: This attribute is required.+ , _sheetViewWorkbookViewId :: Int++ -- | Window zoom magnification for current view representing percent values.+ -- This attribute is restricted to values ranging from 10 to 400. Horizontal &+ -- Vertical scale together.+ , _sheetViewZoomScale :: Maybe Int++ -- | Zoom magnification to use when in normal view, representing percent+ -- values. This attribute is restricted to values ranging from 10 to 400.+ -- Horizontal & Vertical scale together.+ , _sheetViewZoomScaleNormal :: Maybe Int++ -- | Zoom magnification to use when in page layout view, representing+ -- percent values. This attribute is restricted to values ranging from 10 to+ -- 400. Horizontal & Vertical scale together.+ , _sheetViewZoomScalePageLayoutView :: Maybe Int++ -- | Zoom magnification to use when in page break preview, representing+ -- percent values. This attribute is restricted to values ranging from 10 to+ -- 400. Horizontal & Vertical scale together.+ , _sheetViewZoomScaleSheetLayoutView :: Maybe Int++ -- | Worksheet view pane+ , _sheetViewPane :: Maybe Pane++ -- | Worksheet view selection+ --+ -- Minimum of 0, maximum of 4 elements+ , _sheetViewSelection :: [Selection]+ }+ deriving (Show, Eq, Ord)++-- | Worksheet view selection.+--+-- Section 18.3.1.78 "selection (Selection)" (p. 1864)+data Selection = Selection {+ -- | Location of the active cell+ _selectionActiveCell :: Maybe CellRef++ -- | 0-based index of the range reference (in the array of references listed+ -- in sqref) containing the active cell. Only used when the selection in+ -- sqref is not contiguous. Therefore, this value needs to be aware of the+ -- order in which the range references are written in sqref.+ --+ -- When this value is out of range then activeCell can be used.+ , _selectionActiveCellId :: Maybe Int++ -- | The pane to which this selection belongs.+ , _selectionPane :: Maybe PaneType++ -- | Range of the selection. Can be non-contiguous set of ranges.+ , _selectionSqref :: Maybe [CellRef]+ }+ deriving (Show, Eq, Ord)++-- | Worksheet view pane+--+-- Section 18.3.1.66 "pane (View Pane)" (p. 1843)+data Pane = Pane {+ -- | The pane that is active.+ _paneActivePane :: Maybe PaneType++ -- | Indicates whether the pane has horizontal / vertical splits, and+ -- whether those splits are frozen.+ , _paneState :: Maybe PaneState++ -- | Location of the top left visible cell in the bottom right pane (when in+ -- Left-To-Right mode).+ , _paneTopLeftCell :: Maybe CellRef++ -- | Horizontal position of the split, in 1/20th of a point; 0 (zero) if+ -- none. If the pane is frozen, this value indicates the number of columns+ -- visible in the top pane.+ , _paneXSplit :: Maybe Double++ -- | Vertical position of the split, in 1/20th of a point; 0 (zero) if none.+ -- If the pane is frozen, this value indicates the number of rows visible in+ -- the left pane.+ , _paneYSplit :: Maybe Double+ }+ deriving (Show, Eq, Ord)++{-------------------------------------------------------------------------------+ Enumerations+-------------------------------------------------------------------------------}++-- | View setting of the sheet+--+-- Section 18.18.69 "ST_SheetViewType (Sheet View Type)" (p. 2726)+data SheetViewType =+ -- | Normal view+ SheetViewTypeNormal++ -- | Page break preview+ | SheetViewTypePageBreakPreview++ -- | Page layout view+ | SheetViewTypePageLayout+ deriving (Show, Eq, Ord)++-- | Pane type+--+-- Section 18.18.52 "ST_Pane (Pane Types)" (p. 2710)+data PaneType =+ -- | Bottom left pane, when both vertical and horizontal splits are applied.+ --+ -- This value is also used when only a horizontal split has been applied,+ -- dividing the pane into upper and lower regions. In that case, this value+ -- specifies the bottom pane.+ PaneTypeBottomLeft++ -- Bottom right pane, when both vertical and horizontal splits are applied.+ | PaneTypeBottomRight++ -- | Top left pane, when both vertical and horizontal splits are applied.+ --+ -- This value is also used when only a horizontal split has been applied,+ -- dividing the pane into upper and lower regions. In that case, this value+ -- specifies the top pane.+ --+ -- This value is also used when only a vertical split has been applied,+ -- dividing the pane into right and left regions. In that case, this value+ -- specifies the left pane+ | PaneTypeTopLeft++ -- | Top right pane, when both vertical and horizontal splits are applied.+ --+ -- This value is also used when only a vertical split has been applied,+ -- dividing the pane into right and left regions. In that case, this value+ -- specifies the right pane.+ | PaneTypeTopRight+ deriving (Eq, Show, Ord)++-- | State of the sheet's pane.+--+-- Section 18.18.53 "ST_PaneState (Pane State)" (p. 2711)+data PaneState =+ -- | Panes are frozen, but were not split being frozen. In this state, when+ -- the panes are unfrozen again, a single pane results, with no split. In+ -- this state, the split bars are not adjustable.+ PaneStateFrozen++ -- | Panes are frozen and were split before being frozen. In this state,+ -- when the panes are unfrozen again, the split remains, but is adjustable.+ | PaneStateFrozenSplit++ -- | Panes are split, but not frozen. In this state, the split bars are+ -- adjustable by the user.+ | PaneStateSplit+ deriving (Eq, Show, Ord)++{-------------------------------------------------------------------------------+ Lenses+-------------------------------------------------------------------------------}++makeLenses ''SheetView+makeLenses ''Selection+makeLenses ''Pane++{-------------------------------------------------------------------------------+ Default instances+-------------------------------------------------------------------------------}++-- | NOTE: The 'Default' instance for 'SheetView' sets the required attribute+-- '_sheetViewWorkbookViewId' to @0@.+instance Default SheetView where+ def = SheetView {+ _sheetViewColorId = Nothing+ , _sheetViewDefaultGridColor = Nothing+ , _sheetViewRightToLeft = Nothing+ , _sheetViewShowFormulas = Nothing+ , _sheetViewShowGridLines = Nothing+ , _sheetViewShowOutlineSymbols = Nothing+ , _sheetViewShowRowColHeaders = Nothing+ , _sheetViewShowRuler = Nothing+ , _sheetViewShowWhiteSpace = Nothing+ , _sheetViewShowZeros = Nothing+ , _sheetViewTabSelected = Nothing+ , _sheetViewTopLeftCell = Nothing+ , _sheetViewType = Nothing+ , _sheetViewWindowProtection = Nothing+ , _sheetViewWorkbookViewId = 0+ , _sheetViewZoomScale = Nothing+ , _sheetViewZoomScaleNormal = Nothing+ , _sheetViewZoomScalePageLayoutView = Nothing+ , _sheetViewZoomScaleSheetLayoutView = Nothing+ , _sheetViewPane = Nothing+ , _sheetViewSelection = []+ }++instance Default Selection where+ def = Selection {+ _selectionActiveCell = Nothing+ , _selectionActiveCellId = Nothing+ , _selectionPane = Nothing+ , _selectionSqref = Nothing+ }++instance Default Pane where+ def = Pane {+ _paneActivePane = Nothing+ , _paneState = Nothing+ , _paneTopLeftCell = Nothing+ , _paneXSplit = Nothing+ , _paneYSplit = Nothing+ }++{-------------------------------------------------------------------------------+ Rendering+-------------------------------------------------------------------------------}++-- | Render sheet views+--+-- The list should be non-empty to be conform to the spec.+--+-- See Section 18.3.1.88 "sheetViews (Sheet Views)" (p. 1704)+renderSheetViews :: [SheetView] -> Node+renderSheetViews views = NodeElement sheetViews+ where+ sheetViews :: Element+ sheetViews = Element {+ elementName = "sheetViews"+ , elementAttributes = Map.empty+ , elementNodes = map (NodeElement . toElement "sheetView") views+ }++-- | See @CT_SheetView@, p. 3913+instance ToElement SheetView where+ toElement nm SheetView{..} = Element {+ elementName = nm+ , elementNodes = map NodeElement . concat $ [+ map (toElement "pane") (maybeToList _sheetViewPane)+ , map (toElement "selection") _sheetViewSelection+ -- TODO: pivotSelection+ -- TODO: extLst+ ]+ , elementAttributes = Map.fromList . catMaybes $ [+ "windowProtection" .=? _sheetViewWindowProtection+ , "showFormulas" .=? _sheetViewShowFormulas+ , "showGridLines" .=? _sheetViewShowGridLines+ , "showRowColHeaders" .=? _sheetViewShowRowColHeaders+ , "showZeros" .=? _sheetViewShowZeros+ , "rightToLeft" .=? _sheetViewRightToLeft+ , "tabSelected" .=? _sheetViewTabSelected+ , "showRuler" .=? _sheetViewShowRuler+ , "showOutlineSymbols" .=? _sheetViewShowOutlineSymbols+ , "defaultGridColor" .=? _sheetViewDefaultGridColor+ , "showWhiteSpace" .=? _sheetViewShowWhiteSpace+ , "view" .=? _sheetViewType+ , "topLeftCell" .=? _sheetViewTopLeftCell+ , "colorId" .=? _sheetViewColorId+ , "zoomScale" .=? _sheetViewZoomScale+ , "zoomScaleNormal" .=? _sheetViewZoomScaleNormal+ , "zoomScaleSheetLayoutView" .=? _sheetViewZoomScaleSheetLayoutView+ , "zoomScalePageLayoutView" .=? _sheetViewZoomScalePageLayoutView+ , Just $ "workbookViewId" .= _sheetViewWorkbookViewId+ ]+ }++-- | See @CT_Selection@, p. 3914+instance ToElement Selection where+ toElement nm Selection{..} = Element {+ elementName = nm+ , elementNodes = []+ , elementAttributes = Map.fromList . catMaybes $ [+ "pane" .=? _selectionPane+ , "activeCell" .=? _selectionActiveCell+ , "activeCellId" .=? _selectionActiveCellId+ , "sqref" .=? (spaceDelim <$> _selectionSqref)+ ]+ }+ where+ -- The @sqref@ is a space delimited list+ -- See 18.18.76, "ST_Sqref (Reference Sequence)", p. 2488.+ spaceDelim :: [Text] -> Text+ spaceDelim = Text.intercalate " "++-- | See @CT_Pane@, p. 3913+instance ToElement Pane where+ toElement nm Pane{..} = Element {+ elementName = nm+ , elementNodes = []+ , elementAttributes = Map.fromList . catMaybes $ [+ "xSplit" .=? _paneXSplit+ , "ySplit" .=? _paneYSplit+ , "topLeftCell" .=? _paneTopLeftCell+ , "activePane" .=? _paneActivePane+ , "state" .=? _paneState+ ]+ }++-- | See @ST_SheetViewType@, p. 3913+instance ToAttrVal SheetViewType where+ toAttrVal SheetViewTypeNormal = "normal"+ toAttrVal SheetViewTypePageBreakPreview = "pageBreakPreview"+ toAttrVal SheetViewTypePageLayout = "pageLayout"++-- | See @ST_Pane@, p. 3914+instance ToAttrVal PaneType where+ toAttrVal PaneTypeBottomRight = "bottomRight"+ toAttrVal PaneTypeTopRight = "topRight"+ toAttrVal PaneTypeBottomLeft = "bottomLeft"+ toAttrVal PaneTypeTopLeft = "topLeft"++-- | See @ST_PaneState@, p. 3929+instance ToAttrVal PaneState where+ toAttrVal PaneStateSplit = "split"+ toAttrVal PaneStateFrozen = "frozen"+ toAttrVal PaneStateFrozenSplit = "frozenSplit"++{-------------------------------------------------------------------------------+ Parsing+-------------------------------------------------------------------------------}+-- | See @CT_SheetView@, p. 3913+instance FromCursor SheetView where+ fromCursor cur = do+ _sheetViewWindowProtection <- maybeAttribute "windowProtection" cur+ _sheetViewShowFormulas <- maybeAttribute "showFormulas" cur+ _sheetViewShowGridLines <- maybeAttribute "showGridLines" cur+ _sheetViewShowRowColHeaders <- maybeAttribute "showRowColHeaders"cur+ _sheetViewShowZeros <- maybeAttribute "showZeros" cur+ _sheetViewRightToLeft <- maybeAttribute "rightToLeft" cur+ _sheetViewTabSelected <- maybeAttribute "tabSelected" cur+ _sheetViewShowRuler <- maybeAttribute "showRuler" cur+ _sheetViewShowOutlineSymbols <- maybeAttribute "showOutlineSymbols" cur+ _sheetViewDefaultGridColor <- maybeAttribute "defaultGridColor" cur+ _sheetViewShowWhiteSpace <- maybeAttribute "showWhiteSpace" cur+ _sheetViewType <- maybeAttribute "view" cur+ _sheetViewTopLeftCell <- maybeAttribute "topLeftCell" cur+ _sheetViewColorId <- maybeAttribute "colorId" cur+ _sheetViewZoomScale <- maybeAttribute "zoomScale" cur+ _sheetViewZoomScaleNormal <- maybeAttribute "zoomScaleNormal" cur+ _sheetViewZoomScaleSheetLayoutView <- maybeAttribute "zoomScaleSheetLayoutView" cur+ _sheetViewZoomScalePageLayoutView <- maybeAttribute "zoomScalePageLayoutView" cur+ _sheetViewWorkbookViewId <- fromAttribute "workbookViewId" cur+ let _sheetViewPane = listToMaybe $ cur $/ element (n"pane") >=> fromCursor+ _sheetViewSelection = cur $/ element (n"selection") >=> fromCursor+ return SheetView{..}++-- | See @CT_Pane@, p. 3913+instance FromCursor Pane where+ fromCursor cur = do+ _paneXSplit <- maybeAttribute "xSplit" cur+ _paneYSplit <- maybeAttribute "ySplit" cur+ _paneTopLeftCell <- maybeAttribute "topLeftCell" cur+ _paneActivePane <- maybeAttribute "activePane" cur+ _paneState <- maybeAttribute "state" cur+ return Pane{..}++-- | See @CT_Selection@, p. 3914+instance FromCursor Selection where+ fromCursor cur = do+ _selectionPane <- maybeAttribute "pane" cur+ _selectionActiveCell <- maybeAttribute "activeCell" cur+ _selectionActiveCellId <- maybeAttribute "activeCellId" cur+ _selectionSqref <- fmap (T.split (== ' ')) <$> maybeAttribute "sqref" cur+ return Selection{..}++-- | See @ST_SheetViewType@, p. 3913+instance FromAttrVal SheetViewType where+ fromAttrVal "normal" = readSuccess SheetViewTypeNormal+ fromAttrVal "pageBreakPreview" = readSuccess SheetViewTypePageBreakPreview+ fromAttrVal "pageLayout" = readSuccess SheetViewTypePageLayout+ fromAttrVal t = invalidText "SheetViewType" t++-- | See @ST_Pane@, p. 3914+instance FromAttrVal PaneType where+ fromAttrVal "bottomRight" = readSuccess PaneTypeBottomRight+ fromAttrVal "topRight" = readSuccess PaneTypeTopRight+ fromAttrVal "bottomLeft" = readSuccess PaneTypeBottomLeft+ fromAttrVal "topLeft" = readSuccess PaneTypeTopLeft+ fromAttrVal t = invalidText "PaneType" t++-- | See @ST_PaneState@, p. 3929+instance FromAttrVal PaneState where+ fromAttrVal "split" = readSuccess PaneStateSplit+ fromAttrVal "frozen" = readSuccess PaneStateFrozen+ fromAttrVal "frozenSplit" = readSuccess PaneStateFrozenSplit+ fromAttrVal t = invalidText "PaneState" t
+ src/Codec/Xlsx/Types/StyleSheet.hs view
@@ -0,0 +1,1370 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wall #-}+-- | Support for writing (but not reading) style sheets+module Codec.Xlsx.Types.StyleSheet (+ -- * The main two types+ StyleSheet(..)+ , CellXf(..)+ , minimalStyleSheet+ -- * Supporting record types+ , Alignment(..)+ , Border(..)+ , BorderStyle(..)+ , Color(..)+ , Fill(..)+ , FillPattern(..)+ , Font(..)+ , Protection(..)+ -- * Supporting enumerations+ , CellHorizontalAlignment(..)+ , CellVerticalAlignment(..)+ , FontFamily(..)+ , FontScheme(..)+ , FontUnderline(..)+ , FontVerticalAlignment(..)+ , LineStyle(..)+ , PatternType(..)+ , ReadingOrder(..)+ -- * Lenses+ -- ** StyleSheet+ , styleSheetBorders+ , styleSheetFonts+ , styleSheetFills+ , styleSheetCellXfs+ -- ** CellXf+ , cellXfApplyAlignment+ , cellXfApplyBorder+ , cellXfApplyFill+ , cellXfApplyFont+ , cellXfApplyNumberFormat+ , cellXfApplyProtection+ , cellXfBorderId+ , cellXfFillId+ , cellXfFontId+ , cellXfNumFmtId+ , cellXfPivotButton+ , cellXfQuotePrefix+ , cellXfId+ , cellXfAlignment+ , cellXfProtection+ -- ** Alignment+ , alignmentHorizontal+ , alignmentIndent+ , alignmentJustifyLastLine+ , alignmentReadingOrder+ , alignmentRelativeIndent+ , alignmentShrinkToFit+ , alignmentTextRotation+ , alignmentVertical+ , alignmentWrapText+ -- ** Border+ , borderDiagonalDown+ , borderDiagonalUp+ , borderOutline+ , borderBottom+ , borderDiagonal+ , borderEnd+ , borderHorizontal+ , borderStart+ , borderTop+ , borderVertical+ , borderLeft+ , borderRight+ -- ** BorderStyle+ , borderStyleColor+ , borderStyleLine+ -- ** Color+ , colorAutomatic+ , colorARGB+ , colorTheme+ , colorTint+ -- ** Fill+ , fillPattern+ -- ** FillPattern+ , fillPatternBgColor+ , fillPatternFgColor+ , fillPatternType+ -- ** Font+ , fontBold+ , fontCharset+ , fontColor+ , fontCondense+ , fontExtend+ , fontFamily+ , fontItalic+ , fontName+ , fontOutline+ , fontScheme+ , fontShadow+ , fontStrikeThrough+ , fontSize+ , fontUnderline+ , fontVertAlign+ -- ** Protection+ , protectionHidden+ , protectionLocked+ ) where++import Control.Lens hiding ((.=), element)+import Data.Default+import Data.Maybe (catMaybes)+import Data.Text (Text)+import Text.XML+import Text.XML.Cursor+import qualified Data.Map as Map++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif++import Codec.Xlsx.Writer.Internal+import Codec.Xlsx.Parser.Internal++{-------------------------------------------------------------------------------+ The main types+-------------------------------------------------------------------------------}++-- | StyleSheet for an XML document+--+-- Relevant parts of the EMCA standard (4th edition, part 1,+-- <http://www.ecma-international.org/publications/standards/Ecma-376.htm>),+-- page numbers refer to the page in the PDF rather than the page number as+-- printed on the page):+--+-- * Chapter 12, "SpreadsheetML" (p. 74)+-- In particular Section 12.3.20, "Styles Part" (p. 104)+-- * Chapter 18, "SpreadsheetML Reference Material" (p. 1528)+-- In particular Section 18.8, "Styles" (p. 1754) and Section 18.8.39+-- "styleSheet" (Style Sheet)" (p. 1796); it is the latter section that+-- specifies the top-level style sheet format.+--+-- TODO: the following child elements:+--+-- * cellStyles+-- * cellStyleXfs+-- * colors+-- * dxfs+-- * extLst+-- * numFmts+-- * tableStyles+--+-- NOTE: You will probably want to base your style sheet on 'minimalStyleSheet'.+-- See also:+--+-- * 'Codec.Xlsx.Types.renderStyleSheet' to translate a 'StyleSheet' to 'Styles'+-- * 'Codec.Xlsx.Formatted.formatted' for a higher level interface.+-- * 'Codec.Xlsx.Types.parseStyleSheet' to translate a raw 'StyleSheet' into 'Styles'+data StyleSheet = StyleSheet {+ -- | This element contains borders formatting information, specifying all+ -- border definitions for all cells in the workbook.+ --+ -- Section 18.8.5, "borders (Borders)" (p. 1760)+ _styleSheetBorders :: [Border]++ -- | Cell formats+ --+ -- This element contains the master formatting records (xf) which define the+ -- formatting applied to cells in this workbook. These records are the+ -- starting point for determining the formatting for a cell. Cells in the+ -- Sheet Part reference the xf records by zero-based index.+ --+ -- Section 18.8.10, "cellXfs (Cell Formats)" (p. 1764)+ , _styleSheetCellXfs :: [CellXf]++ -- | This element defines the cell fills portion of the Styles part,+ -- consisting of a sequence of fill records. A cell fill consists of a+ -- background color, foreground color, and pattern to be applied across the+ -- cell.+ --+ -- Section 18.8.21, "fills (Fills)" (p. 1768)+ , _styleSheetFills :: [Fill]++ -- | This element contains all font definitions for this workbook.+ --+ -- Section 18.8.23 "fonts (Fonts)" (p. 1769)+ , _styleSheetFonts :: [Font]+ }+ deriving (Show, Eq, Ord)++-- | Cell formatting+--+-- TODO: The @extLst@ field is currently unsupported.+--+-- Section 18.8.45 "xf (Format)" (p. 1800)+data CellXf = CellXf {+ -- | A boolean value indicating whether the alignment formatting specified+ -- for this xf should be applied.+ _cellXfApplyAlignment :: Maybe Bool++ -- | A boolean value indicating whether the border formatting specified for+ -- this xf should be applied.+ , _cellXfApplyBorder :: Maybe Bool++ -- | A boolean value indicating whether the fill formatting specified for+ -- this xf should be applied.+ , _cellXfApplyFill :: Maybe Bool++ -- | A boolean value indicating whether the font formatting specified for+ -- this xf should be applied.+ , _cellXfApplyFont :: Maybe Bool++ -- | A boolean value indicating whether the number formatting specified for+ -- this xf should be applied.+ , _cellXfApplyNumberFormat :: Maybe Bool++ -- | A boolean value indicating whether the protection formatting specified+ -- for this xf should be applied.+ , _cellXfApplyProtection :: Maybe Bool++ -- | Zero-based index of the border record used by this cell format.+ --+ -- (18.18.2, p. 2437).+ , _cellXfBorderId :: Maybe Int++ -- | Zero-based index of the fill record used by this cell format.+ --+ -- (18.18.30, p. 2455)+ , _cellXfFillId :: Maybe Int++ -- | Zero-based index of the font record used by this cell format.+ --+ -- An integer that represents a zero based index into the `styleSheetFonts`+ -- collection in the style sheet (18.18.32, p. 2456).+ , _cellXfFontId :: Maybe Int++ -- | Id of the number format (numFmt) record used by this cell format.+ --+ -- This simple type defines the identifier to a style sheet number format+ -- entry in CT_NumFmts. Number formats are written to the styles part+ -- (18.18.47, p. 2468). See also 18.8.31 (p. 1784) for more information on+ -- number formats.+ --+ -- TODO: The numFmts part of the style sheet is currently not implemented.+ , _cellXfNumFmtId :: Maybe Int++ -- | A boolean value indicating whether the cell rendering includes a pivot+ -- table dropdown button.+ , _cellXfPivotButton :: Maybe Bool++ -- | A boolean value indicating whether the text string in a cell should be+ -- prefixed by a single quote mark (e.g., 'text). In these cases, the quote+ -- is not stored in the Shared Strings Part.+ , _cellXfQuotePrefix :: Maybe Bool++ -- | For xf records contained in cellXfs this is the zero-based index of an+ -- xf record contained in cellStyleXfs corresponding to the cell style+ -- applied to the cell.+ --+ -- Not present for xf records contained in cellStyleXfs.+ --+ -- Used by xf records and cellStyle records to reference xf records defined+ -- in the cellStyleXfs collection. (18.18.10, p. 2442)+ -- TODO: the cellStyleXfs field of a style sheet not currently implemented.+ , _cellXfId :: Maybe Int++ -- | Formatting information pertaining to text alignment in cells. There are+ -- a variety of choices for how text is aligned both horizontally and+ -- vertically, as well as indentation settings, and so on.+ , _cellXfAlignment :: Maybe Alignment++ -- | Contains protection properties associated with the cell. Each cell has+ -- protection properties that can be set. The cell protection properties do+ -- not take effect unless the sheet has been protected.+ , _cellXfProtection :: Maybe Protection+ }+ deriving (Show, Eq, Ord)++{-------------------------------------------------------------------------------+ Supporting record types+-------------------------------------------------------------------------------}++-- | Alignment+--+-- See 18.8.1 "alignment (Alignment)" (p. 1754)+data Alignment = Alignment {+ -- | Specifies the type of horizontal alignment in cells.+ _alignmentHorizontal :: Maybe CellHorizontalAlignment++ -- | An integer value, where an increment of 1 represents 3 spaces.+ -- Indicates the number of spaces (of the normal style font) of indentation+ -- for text in a cell.+ , _alignmentIndent :: Maybe Int++ -- | A boolean value indicating if the cells justified or distributed+ -- alignment should be used on the last line of text. (This is typical for+ -- East Asian alignments but not typical in other contexts.)+ , _alignmentJustifyLastLine :: Maybe Bool++ -- | An integer value indicating whether the reading order+ -- (bidirectionality) of the cell is leftto- right, right-to-left, or+ -- context dependent.+ , _alignmentReadingOrder :: Maybe ReadingOrder++ -- | An integer value (used only in a dxf element) to indicate the+ -- additional number of spaces of indentation to adjust for text in a cell.+ , _alignmentRelativeIndent :: Maybe Int++ -- | A boolean value indicating if the displayed text in the cell should be+ -- shrunk to fit the cell width. Not applicable when a cell contains+ -- multiple lines of text.+ , _alignmentShrinkToFit :: Maybe Bool++ -- | Text rotation in cells. Expressed in degrees. Values range from 0 to+ -- 180. The first letter of the text is considered the center-point of the+ -- arc.+ , _alignmentTextRotation :: Maybe Int++ -- | Vertical alignment in cells.+ , _alignmentVertical :: Maybe CellVerticalAlignment++ -- | A boolean value indicating if the text in a cell should be line-wrapped+ -- within the cell.+ , _alignmentWrapText :: Maybe Bool+ }+ deriving (Show, Eq, Ord)++-- | Expresses a single set of cell border formats (left, right, top, bottom,+-- diagonal). Color is optional. When missing, 'automatic' is implied.+--+-- See 18.8.4 "border (Border)" (p. 1759)+data Border = Border {+ -- | A boolean value indicating if the cell's diagonal border includes a+ -- diagonal line, starting at the top left corner of the cell and moving+ -- down to the bottom right corner of the cell.+ _borderDiagonalDown :: Maybe Bool++ -- | A boolean value indicating if the cell's diagonal border includes a+ -- diagonal line, starting at the bottom left corner of the cell and moving+ -- up to the top right corner of the cell.+ , _borderDiagonalUp :: Maybe Bool++ -- | A boolean value indicating if left, right, top, and bottom borders+ -- should be applied only to outside borders of a cell range.+ , _borderOutline :: Maybe Bool++ -- | Bottom border+ , _borderBottom :: Maybe BorderStyle++ -- | Diagonal+ , _borderDiagonal :: Maybe BorderStyle++ -- | Trailing edge border+ --+ -- See also 'borderRight'+ , _borderEnd :: Maybe BorderStyle++ -- | Horizontal inner borders+ , _borderHorizontal :: Maybe BorderStyle++ -- | Left border+ --+ -- NOTE: The spec does not formally list a 'left' border element, but the+ -- examples do mention 'left' and the scheme contains it too. See also 'borderStart'.+ , _borderLeft :: Maybe BorderStyle++ -- | Right border+ --+ -- NOTE: The spec does not formally list a 'right' border element, but the+ -- examples do mention 'right' and the scheme contains it too. See also 'borderEnd'.+ , _borderRight :: Maybe BorderStyle++ -- | Leading edge border+ --+ -- See also 'borderLeft'+ , _borderStart :: Maybe BorderStyle++ -- | Top border+ , _borderTop :: Maybe BorderStyle++ -- | Vertical inner border+ , _borderVertical :: Maybe BorderStyle+ }+ deriving (Show, Eq, Ord)++-- | Border style+-- See @CT_BorderPr@ (p. 3934)+data BorderStyle = BorderStyle {+ _borderStyleColor :: Maybe Color+ , _borderStyleLine :: Maybe LineStyle+ }+ deriving (Show, Eq, Ord)++-- | One of the colors associated with the data bar or color scale.+--+-- The 'indexed' attribute (used for backwards compatibility only) is not+-- modelled here.+--+-- See 18.3.1.15 "color (Data Bar Color)" (p. 1608)+data Color = Color {+ -- | A boolean value indicating the color is automatic and system color+ -- dependent.+ _colorAutomatic :: Maybe Bool++ -- | Standard Alpha Red Green Blue color value (ARGB).+ --+ -- This simple type's contents have a length of exactly 8 hexadecimal+ -- digit(s); see "18.18.86 ST_UnsignedIntHex (Hex Unsigned Integer)" (p.+ -- 2511).+ , _colorARGB :: Maybe Text++ -- | A zero-based index into the <clrScheme> collection (20.1.6.2),+ -- referencing a particular <sysClr> or <srgbClr> value expressed in the+ -- Theme part.+ , _colorTheme :: Maybe Int++ -- | Specifies the tint value applied to the color.+ --+ -- If tint is supplied, then it is applied to the RGB value of the color to+ -- determine the final color applied.+ --+ -- The tint value is stored as a double from -1.0 .. 1.0, where -1.0 means+ -- 100% darken and 1.0 means 100% lighten. Also, 0.0 means no change.+ , _colorTint :: Maybe Double+ }+ deriving (Show, Eq, Ord)++-- | This element specifies fill formatting.+--+-- TODO: Gradient fills (18.8.4) are currently unsupported. If we add them,+-- then the spec says (@CT_Fill@, p. 3935), _either_ a gradient _or_ a solid+-- fill pattern should be specified.+--+-- Section 18.8.20, "fill (Fill)" (p. 1768)+data Fill = Fill {+ _fillPattern :: Maybe FillPattern+ }+ deriving (Show, Eq, Ord)++-- | This element is used to specify cell fill information for pattern and solid+-- color cell fills. For solid cell fills (no pattern), fgColor is used. For+-- cell fills with patterns specified, then the cell fill color is specified by+-- the bgColor element.+--+-- Section 18.8.32 "patternFill (Pattern)" (p. 1793)+data FillPattern = FillPattern {+ _fillPatternBgColor :: Maybe Color+ , _fillPatternFgColor :: Maybe Color+ , _fillPatternType :: Maybe PatternType+ }+ deriving (Show, Eq, Ord)++-- | This element defines the properties for one of the fonts used in this+-- workbook.+--+-- Section 18.2.22 "font (Font)" (p. 1769)+data Font = Font {+ -- | Displays characters in bold face font style.+ _fontBold :: Maybe Bool++ -- | This element defines the font character set of this font.+ --+ -- This field is used in font creation and selection if a font of the given+ -- facename is not available on the system. Although it is not required to+ -- have around when resolving font facename, the information can be stored+ -- for when needed to help resolve which font face to use of all available+ -- fonts on a system.+ --+ -- Charset represents the basic set of characters associated with a font+ -- (that it can display), and roughly corresponds to the ANSI codepage+ -- (8-bit or DBCS) of that character set used by a given language. Given+ -- more common use of Unicode where many fonts support more than one of the+ -- traditional charset categories, and the use of font linking, using+ -- charset to resolve font name is less and less common, but still can be+ -- useful.+ --+ -- These are operating-system-dependent values.+ --+ -- Section 18.4.1 "charset (Character Set)" provides some example values.+ , _fontCharset :: Maybe Int++ -- | Color+ , _fontColor :: Maybe Color++ -- | Macintosh compatibility setting. Represents special word/character+ -- rendering on Macintosh, when this flag is set. The effect is to condense+ -- the text (squeeze it together). SpreadsheetML applications are not+ -- required to render according to this flag.+ , _fontCondense :: Maybe Bool++ -- | This element specifies a compatibility setting used for previous+ -- spreadsheet applications, resulting in special word/character rendering+ -- on those legacy applications, when this flag is set. The effect extends+ -- or stretches out the text. SpreadsheetML applications are not required to+ -- render according to this flag.+ , _fontExtend :: Maybe Bool++ -- | The font family this font belongs to. A font family is a set of fonts+ -- having common stroke width and serif characteristics. This is system+ -- level font information. The font name overrides when there are+ -- conflicting values.+ , _fontFamily :: Maybe FontFamily++ -- | Displays characters in italic font style. The italic style is defined+ -- by the font at a system level and is not specified by ECMA-376.+ , _fontItalic :: Maybe Bool++ -- | This element specifies the face name of this font.+ --+ -- A string representing the name of the font. If the font doesn't exist+ -- (because it isn't installed on the system), or the charset not supported+ -- by that font, then another font should be substituted.+ --+ -- The string length for this attribute shall be 0 to 31 characters.+ , _fontName :: Maybe Text++ -- | This element displays only the inner and outer borders of each+ -- character. This is very similar to Bold in behavior.+ , _fontOutline :: Maybe Bool++ -- | Defines the font scheme, if any, to which this font belongs. When a+ -- font definition is part of a theme definition, then the font is+ -- categorized as either a major or minor font scheme component. When a new+ -- theme is chosen, every font that is part of a theme definition is updated+ -- to use the new major or minor font definition for that theme. Usually+ -- major fonts are used for styles like headings, and minor fonts are used+ -- for body and paragraph text.+ , _fontScheme :: Maybe FontScheme++ -- | Macintosh compatibility setting. Represents special word/character+ -- rendering on Macintosh, when this flag is set. The effect is to render a+ -- shadow behind, beneath and to the right of the text. SpreadsheetML+ -- applications are not required to render according to this flag.+ , _fontShadow :: Maybe Bool++ -- | This element draws a strikethrough line through the horizontal middle+ -- of the text.+ , _fontStrikeThrough :: Maybe Bool++ -- | This element represents the point size (1/72 of an inch) of the Latin+ -- and East Asian text.+ , _fontSize :: Maybe Double++ -- | This element represents the underline formatting style.+ , _fontUnderline :: Maybe FontUnderline++ -- | This element adjusts the vertical position of the text relative to the+ -- text's default appearance for this run. It is used to get 'superscript'+ -- or 'subscript' texts, and shall reduce the font size (if a smaller size+ -- is available) accordingly.+ , _fontVertAlign :: Maybe FontVerticalAlignment+ }+ deriving (Show, Eq, Ord)++-- | Protection properties+--+-- Contains protection properties associated with the cell. Each cell has+-- protection properties that can be set. The cell protection properties do not+-- take effect unless the sheet has been protected.+--+-- Section 18.8.33, "protection (Protection Properties)", p. 1793+data Protection = Protection {+ _protectionHidden :: Maybe Bool+ , _protectionLocked :: Maybe Bool+ }+ deriving (Show, Eq, Ord)++{-------------------------------------------------------------------------------+ Enumerations+-------------------------------------------------------------------------------}++-- | Horizontal alignment in cells+--+-- See 18.18.40 "ST_HorizontalAlignment (Horizontal Alignment Type)" (p. 2459)+data CellHorizontalAlignment =+ CellHorizontalAlignmentCenter+ | CellHorizontalAlignmentCenterContinuous+ | CellHorizontalAlignmentDistributed+ | CellHorizontalAlignmentFill+ | CellHorizontalAlignmentGeneral+ | CellHorizontalAlignmentJustify+ | CellHorizontalAlignmentLeft+ | CellHorizontalAlignmentRight+ deriving (Show, Eq, Ord)++-- | Vertical alignment in cells+--+-- See 18.18.88 "ST_VerticalAlignment (Vertical Alignment Types)" (p. 2512)+data CellVerticalAlignment =+ CellVerticalAlignmentBottom+ | CellVerticalAlignmentCenter+ | CellVerticalAlignmentDistributed+ | CellVerticalAlignmentJustify+ | CellVerticalAlignmentTop+ deriving (Show, Eq, Ord)++-- | Font family+--+-- See 18.8.18 "family (Font Family)" (p. 1766)+-- and 17.18.30 "ST_FontFamily (Font Family Value)" (p. 1388)+data FontFamily =+ -- | Family is not applicable+ FontFamilyNotApplicable++ -- | Proportional font with serifs+ | FontFamilyRoman++ -- | Proportional font without serifs+ | FontFamilySwiss++ -- | Monospace font with or without serifs+ | FontFamilyModern++ -- | Script font designed to mimic the appearance of handwriting+ | FontFamilyScript++ -- | Novelty font+ | FontFamilyDecorative+ deriving (Show, Eq, Ord)++-- | Font scheme+--+-- See 18.18.33 "ST_FontScheme (Font scheme Styles)" (p. 2456)+data FontScheme =+ -- | This font is the major font for this theme.+ FontSchemeMajor++ -- | This font is the minor font for this theme.+ | FontSchemeMinor++ -- | This font is not a theme font.+ | FontSchemeNone+ deriving (Show, Eq, Ord)++-- | Font underline property+--+-- See 18.4.13 "u (Underline)", p 1728+data FontUnderline =+ FontUnderlineSingle+ | FontUnderlineDouble+ | FontUnderlineSingleAccounting+ | FontUnderlineDoubleAccounting+ | FontUnderlineNone+ deriving (Show, Eq, Ord)++-- | Vertical alignment+--+-- See 22.9.2.17 "ST_VerticalAlignRun (Vertical Positioning Location)" (p. 3794)+data FontVerticalAlignment =+ FontVerticalAlignmentBaseline+ | FontVerticalAlignmentSubscript+ | FontVerticalAlignmentSuperscript+ deriving (Show, Eq, Ord)++data LineStyle =+ LineStyleDashDot+ | LineStyleDashDotDot+ | LineStyleDashed+ | LineStyleDotted+ | LineStyleDouble+ | LineStyleHair+ | LineStyleMedium+ | LineStyleMediumDashDot+ | LineStyleMediumDashDotDot+ | LineStyleMediumDashed+ | LineStyleNone+ | LineStyleSlantDashDot+ | LineStyleThick+ | LineStyleThin+ deriving (Show, Eq, Ord)++-- | Indicates the style of fill pattern being used for a cell format.+--+-- Section 18.18.55 "ST_PatternType (Pattern Type)" (p. 2472)+data PatternType =+ PatternTypeDarkDown+ | PatternTypeDarkGray+ | PatternTypeDarkGrid+ | PatternTypeDarkHorizontal+ | PatternTypeDarkTrellis+ | PatternTypeDarkUp+ | PatternTypeDarkVertical+ | PatternTypeGray0625+ | PatternTypeGray125+ | PatternTypeLightDown+ | PatternTypeLightGray+ | PatternTypeLightGrid+ | PatternTypeLightHorizontal+ | PatternTypeLightTrellis+ | PatternTypeLightUp+ | PatternTypeLightVertical+ | PatternTypeMediumGray+ | PatternTypeNone+ | PatternTypeSolid+ deriving (Show, Eq, Ord)++-- | Reading order+--+-- See 18.8.1 "alignment (Alignment)" (p. 1754, esp. p. 1755)+data ReadingOrder =+ ReadingOrderContextDependent+ | ReadingOrderLeftToRight+ | ReadingOrderRightToLeft+ deriving (Show, Eq, Ord)++{-------------------------------------------------------------------------------+ Lenses+-------------------------------------------------------------------------------}++makeLenses ''StyleSheet+makeLenses ''CellXf++makeLenses ''Alignment+makeLenses ''Border+makeLenses ''BorderStyle+makeLenses ''Color+makeLenses ''Fill+makeLenses ''FillPattern+makeLenses ''Font+makeLenses ''Protection++{-------------------------------------------------------------------------------+ Minimal stylesheet+-------------------------------------------------------------------------------}++-- | Minimal style sheet+--+-- Excel expects some minimal definitions in the stylesheet; you probably want+-- to define your own stylesheets based on this one.+--+-- This more-or-less follows the recommendations at+-- <http://stackoverflow.com/questions/26050708/minimal-style-sheet-for-excel-open-xml-with-dates>,+-- but with some additions based on experimental evidence.+minimalStyleSheet :: StyleSheet+minimalStyleSheet = def+ & styleSheetBorders .~ [defaultBorder]+ & styleSheetFonts .~ [defaultFont]+ & styleSheetFills .~ [fillNone, fillGray125]+ & styleSheetCellXfs .~ [defaultCellXf]+ where+ -- The 'Default' instance for 'Border' uses 'left' and 'right' rather than+ -- 'start' and 'end', because this is what Excel does (even though the spec+ -- says different)+ defaultBorder :: Border+ defaultBorder = def+ & borderBottom .~ Just def+ & borderTop .~ Just def+ & borderLeft .~ Just def+ & borderRight .~ Just def++ defaultFont :: Font+ defaultFont = def+ & fontFamily .~ Just FontFamilySwiss+ & fontSize .~ Just 11++ fillNone, fillGray125 :: Fill+ fillNone = def+ & fillPattern .~ Just (def & fillPatternType .~ Just PatternTypeNone)+ fillGray125 = def+ & fillPattern .~ Just (def & fillPatternType .~ Just PatternTypeGray125)++ defaultCellXf :: CellXf+ defaultCellXf = def+ & cellXfBorderId .~ Just 0+ & cellXfFillId .~ Just 0+ & cellXfFontId .~ Just 0++{-------------------------------------------------------------------------------+ Default instances+-------------------------------------------------------------------------------}++instance Default StyleSheet where+ def = StyleSheet {+ _styleSheetBorders = []+ , _styleSheetFonts = []+ , _styleSheetFills = []+ , _styleSheetCellXfs = []+ }++instance Default CellXf where+ def = CellXf {+ _cellXfApplyAlignment = Nothing+ , _cellXfApplyBorder = Nothing+ , _cellXfApplyFill = Nothing+ , _cellXfApplyFont = Nothing+ , _cellXfApplyNumberFormat = Nothing+ , _cellXfApplyProtection = Nothing+ , _cellXfBorderId = Nothing+ , _cellXfFillId = Nothing+ , _cellXfFontId = Nothing+ , _cellXfNumFmtId = Nothing+ , _cellXfPivotButton = Nothing+ , _cellXfQuotePrefix = Nothing+ , _cellXfId = Nothing+ , _cellXfAlignment = Nothing+ , _cellXfProtection = Nothing+ }++instance Default Alignment where+ def = Alignment {+ _alignmentHorizontal = Nothing+ , _alignmentIndent = Nothing+ , _alignmentJustifyLastLine = Nothing+ , _alignmentReadingOrder = Nothing+ , _alignmentRelativeIndent = Nothing+ , _alignmentShrinkToFit = Nothing+ , _alignmentTextRotation = Nothing+ , _alignmentVertical = Nothing+ , _alignmentWrapText = Nothing+ }++instance Default Border where+ def = Border {+ _borderDiagonalDown = Nothing+ , _borderDiagonalUp = Nothing+ , _borderOutline = Nothing+ , _borderBottom = Nothing+ , _borderDiagonal = Nothing+ , _borderEnd = Nothing+ , _borderHorizontal = Nothing+ , _borderStart = Nothing+ , _borderTop = Nothing+ , _borderVertical = Nothing+ , _borderLeft = Nothing+ , _borderRight = Nothing+ }++instance Default BorderStyle where+ def = BorderStyle {+ _borderStyleColor = Nothing+ , _borderStyleLine = Nothing+ }++instance Default Color where+ def = Color {+ _colorAutomatic = Nothing+ , _colorARGB = Nothing+ , _colorTheme = Nothing+ , _colorTint = Nothing+ }++instance Default Fill where+ def = Fill {+ _fillPattern = Nothing+ }++instance Default FillPattern where+ def = FillPattern {+ _fillPatternBgColor = Nothing+ , _fillPatternFgColor = Nothing+ , _fillPatternType = Nothing+ }++instance Default Font where+ def = Font {+ _fontBold = Nothing+ , _fontCharset = Nothing+ , _fontColor = Nothing+ , _fontCondense = Nothing+ , _fontExtend = Nothing+ , _fontFamily = Nothing+ , _fontItalic = Nothing+ , _fontName = Nothing+ , _fontOutline = Nothing+ , _fontScheme = Nothing+ , _fontShadow = Nothing+ , _fontStrikeThrough = Nothing+ , _fontSize = Nothing+ , _fontUnderline = Nothing+ , _fontVertAlign = Nothing+ }++instance Default Protection where+ def = Protection {+ _protectionHidden = Nothing+ , _protectionLocked = Nothing+ }++{-------------------------------------------------------------------------------+ Rendering record types++ NOTE: Excel is sensitive to the order of the child nodes, so we are careful+ to follow the XML schema here. We are also careful to follow the ordering+ for attributes, although this is actually pointless, as xml-conduit stores+ these as a Map, so we lose the ordering. But if we change representation,+ at least they are in the right order (hopefully) in the source code.+-------------------------------------------------------------------------------}++instance ToDocument StyleSheet where+ toDocument = documentFromElement "Stylesheet generated by xlsx"+ . toElement "styleSheet"++-- | See @CT_Stylesheet@, p. 4482+instance ToElement StyleSheet where+ toElement nm StyleSheet{..} = Element {+ elementName = nm+ , elementAttributes = Map.empty+ , elementNodes = map NodeElement $ [+ -- TODO: numFmts+ elementList "fonts" $ map (toElement "font") _styleSheetFonts+ , elementList "fills" $ map (toElement "fill") _styleSheetFills+ , elementList "borders" $ map (toElement "border") _styleSheetBorders+ -- TODO: cellStyleXfs+ , elementList "cellXfs" $ map (toElement "xf") _styleSheetCellXfs+ -- TODO: cellStyles+ -- TODO: dxfs+ -- TODO: tableStyles+ -- TODO: colors+ -- TODO: extLst+ ]+ }++-- | See @CT_Xf@, p. 4486+instance ToElement CellXf where+ toElement nm CellXf{..} = Element {+ elementName = nm+ , elementNodes = map NodeElement . catMaybes $ [+ toElement "alignment" <$> _cellXfAlignment+ , toElement "protection" <$> _cellXfProtection+ -- TODO: extLst+ ]+ , elementAttributes = Map.fromList . catMaybes $ [+ "numFmtId" .=? _cellXfNumFmtId+ , "fontId" .=? _cellXfFontId+ , "fillId" .=? _cellXfFillId+ , "borderId" .=? _cellXfBorderId+ , "xfId" .=? _cellXfId+ , "quotePrefix" .=? _cellXfQuotePrefix+ , "pivotButton" .=? _cellXfPivotButton+ , "applyNumberFormat" .=? _cellXfApplyNumberFormat+ , "applyFont" .=? _cellXfApplyFont+ , "applyFill" .=? _cellXfApplyFill+ , "applyBorder" .=? _cellXfApplyBorder+ , "applyAlignment" .=? _cellXfApplyAlignment+ , "applyProtection" .=? _cellXfApplyProtection+ ]+ }++-- | See @CT_CellAlignment@, p. 4482+instance ToElement Alignment where+ toElement nm Alignment{..} = Element {+ elementName = nm+ , elementNodes = []+ , elementAttributes = Map.fromList . catMaybes $ [+ "horizontal" .=? _alignmentHorizontal+ , "vertical" .=? _alignmentVertical+ , "textRotation" .=? _alignmentTextRotation+ , "wrapText" .=? _alignmentWrapText+ , "relativeIndent" .=? _alignmentRelativeIndent+ , "indent" .=? _alignmentIndent+ , "justifyLastLine" .=? _alignmentJustifyLastLine+ , "shrinkToFit" .=? _alignmentShrinkToFit+ , "readingOrder" .=? _alignmentReadingOrder+ ]+ }++-- | See @CT_Border@, p. 4483+instance ToElement Border where+ toElement nm Border{..} = Element {+ elementName = nm+ , elementAttributes = Map.fromList . catMaybes $ [+ "diagonalUp" .=? _borderDiagonalUp+ , "diagonalDown" .=? _borderDiagonalDown+ , "outline" .=? _borderOutline+ ]+ , elementNodes = map NodeElement . catMaybes $ [+ toElement "start" <$> _borderStart+ , toElement "end" <$> _borderEnd+ , toElement "left" <$> _borderLeft+ , toElement "right" <$> _borderRight+ , toElement "top" <$> _borderTop+ , toElement "bottom" <$> _borderBottom+ , toElement "diagonal" <$> _borderDiagonal+ , toElement "vertical" <$> _borderVertical+ , toElement "horizontal" <$> _borderHorizontal+ ]+ }++-- | See @CT_BorderPr@, p. 4483+instance ToElement BorderStyle where+ toElement nm BorderStyle{..} = Element {+ elementName = nm+ , elementAttributes = Map.fromList . catMaybes $ [+ "style" .=? _borderStyleLine+ ]+ , elementNodes = map NodeElement . catMaybes $ [+ toElement "color" <$> _borderStyleColor+ ]+ }++-- | See @CT_Color@, p. 4484+instance ToElement Color where+ toElement nm Color{..} = Element {+ elementName = nm+ , elementNodes = []+ , elementAttributes = Map.fromList . catMaybes $ [+ "auto" .=? _colorAutomatic+ , "rgb" .=? _colorARGB+ , "theme" .=? _colorTheme+ , "tint" .=? _colorTint+ ]+ }++-- | See @CT_Fill@, p. 4484+instance ToElement Fill where+ toElement nm Fill{..} = Element {+ elementName = nm+ , elementAttributes = Map.empty+ , elementNodes = map NodeElement . catMaybes $ [+ toElement "patternFill" <$> _fillPattern+ ]+ }++-- | See @CT_PatternFill@, p. 4484+instance ToElement FillPattern where+ toElement nm FillPattern{..} = Element {+ elementName = nm+ , elementAttributes = Map.fromList . catMaybes $ [+ "patternType" .=? _fillPatternType+ ]+ , elementNodes = map NodeElement . catMaybes $ [+ toElement "fgColor" <$> _fillPatternFgColor+ , toElement "bgColor" <$> _fillPatternBgColor+ ]+ }++-- | See @CT_Font@, p. 4489+instance ToElement Font where+ toElement nm Font{..} = Element {+ elementName = nm+ , elementAttributes = Map.empty -- all properties specified as child nodes+ , elementNodes = map NodeElement . catMaybes $ [+ elementValue "name" <$> _fontName+ , elementValue "charset" <$> _fontCharset+ , elementValue "family" <$> _fontFamily+ , elementValue "b" <$> _fontBold+ , elementValue "i" <$> _fontItalic+ , elementValue "strike" <$> _fontStrikeThrough+ , elementValue "outline" <$> _fontOutline+ , elementValue "shadow" <$> _fontShadow+ , elementValue "condense" <$> _fontCondense+ , elementValue "extend" <$> _fontExtend+ , toElement "color" <$> _fontColor+ , elementValue "sz" <$> _fontSize+ , elementValue "u" <$> _fontUnderline+ , elementValue "vertAlign" <$> _fontVertAlign+ , elementValue "scheme" <$> _fontScheme+ ]+ }++-- | See @CT_CellProtection@, p. 4484+instance ToElement Protection where+ toElement nm Protection{..} = Element {+ elementName = nm+ , elementNodes = []+ , elementAttributes = Map.fromList . catMaybes $ [+ "locked" .=? _protectionLocked+ , "hidden" .=? _protectionHidden+ ]+ }++{-------------------------------------------------------------------------------+ Rendering attribute values+-------------------------------------------------------------------------------}++instance ToAttrVal CellHorizontalAlignment where+ toAttrVal CellHorizontalAlignmentCenter = "center"+ toAttrVal CellHorizontalAlignmentCenterContinuous = "centerContinuous"+ toAttrVal CellHorizontalAlignmentDistributed = "distributed"+ toAttrVal CellHorizontalAlignmentFill = "fill"+ toAttrVal CellHorizontalAlignmentGeneral = "general"+ toAttrVal CellHorizontalAlignmentJustify = "justify"+ toAttrVal CellHorizontalAlignmentLeft = "left"+ toAttrVal CellHorizontalAlignmentRight = "right"++instance ToAttrVal CellVerticalAlignment where+ toAttrVal CellVerticalAlignmentBottom = "bottom"+ toAttrVal CellVerticalAlignmentCenter = "center"+ toAttrVal CellVerticalAlignmentDistributed = "distributed"+ toAttrVal CellVerticalAlignmentJustify = "justify"+ toAttrVal CellVerticalAlignmentTop = "top"++instance ToAttrVal FontFamily where+ toAttrVal FontFamilyNotApplicable = "0"+ toAttrVal FontFamilyRoman = "1"+ toAttrVal FontFamilySwiss = "2"+ toAttrVal FontFamilyModern = "3"+ toAttrVal FontFamilyScript = "4"+ toAttrVal FontFamilyDecorative = "5"++instance ToAttrVal FontScheme where+ toAttrVal FontSchemeMajor = "major"+ toAttrVal FontSchemeMinor = "minor"+ toAttrVal FontSchemeNone = "none"++-- See @ST_UnderlineValues@, p. 3940+instance ToAttrVal FontUnderline where+ toAttrVal FontUnderlineSingle = "single"+ toAttrVal FontUnderlineDouble = "double"+ toAttrVal FontUnderlineSingleAccounting = "singleAccounting"+ toAttrVal FontUnderlineDoubleAccounting = "doubleAccounting"+ toAttrVal FontUnderlineNone = "none"++instance ToAttrVal FontVerticalAlignment where+ toAttrVal FontVerticalAlignmentBaseline = "baseline"+ toAttrVal FontVerticalAlignmentSubscript = "subscript"+ toAttrVal FontVerticalAlignmentSuperscript = "superscript"++instance ToAttrVal LineStyle where+ toAttrVal LineStyleDashDot = "dashDot"+ toAttrVal LineStyleDashDotDot = "dashDotDot"+ toAttrVal LineStyleDashed = "dashed"+ toAttrVal LineStyleDotted = "dotted"+ toAttrVal LineStyleDouble = "double"+ toAttrVal LineStyleHair = "hair"+ toAttrVal LineStyleMedium = "medium"+ toAttrVal LineStyleMediumDashDot = "mediumDashDot"+ toAttrVal LineStyleMediumDashDotDot = "mediumDashDotDot"+ toAttrVal LineStyleMediumDashed = "mediumDashed"+ toAttrVal LineStyleNone = "none"+ toAttrVal LineStyleSlantDashDot = "slantDashDot"+ toAttrVal LineStyleThick = "thick"+ toAttrVal LineStyleThin = "thin"++instance ToAttrVal PatternType where+ toAttrVal PatternTypeDarkDown = "darkDown"+ toAttrVal PatternTypeDarkGray = "darkGray"+ toAttrVal PatternTypeDarkGrid = "darkGrid"+ toAttrVal PatternTypeDarkHorizontal = "darkHorizontal"+ toAttrVal PatternTypeDarkTrellis = "darkTrellis"+ toAttrVal PatternTypeDarkUp = "darkUp"+ toAttrVal PatternTypeDarkVertical = "darkVertical"+ toAttrVal PatternTypeGray0625 = "gray0625"+ toAttrVal PatternTypeGray125 = "gray125"+ toAttrVal PatternTypeLightDown = "lightDown"+ toAttrVal PatternTypeLightGray = "lightGray"+ toAttrVal PatternTypeLightGrid = "lightGrid"+ toAttrVal PatternTypeLightHorizontal = "lightHorizontal"+ toAttrVal PatternTypeLightTrellis = "lightTrellis"+ toAttrVal PatternTypeLightUp = "lightUp"+ toAttrVal PatternTypeLightVertical = "lightVertical"+ toAttrVal PatternTypeMediumGray = "mediumGray"+ toAttrVal PatternTypeNone = "none"+ toAttrVal PatternTypeSolid = "solid"++instance ToAttrVal ReadingOrder where+ toAttrVal ReadingOrderContextDependent = "0"+ toAttrVal ReadingOrderLeftToRight = "1"+ toAttrVal ReadingOrderRightToLeft = "2"++{-------------------------------------------------------------------------------+ Parsing+-------------------------------------------------------------------------------}+-- | See @CT_Stylesheet@, p. 4482+instance FromCursor StyleSheet where+ fromCursor cur = do+ let+ -- TODO: numFmts+ _styleSheetFonts = cur $/ element (n"fonts") &/ element (n"font") >=> fromCursor+ _styleSheetFills = cur $/ element (n"fills") &/ element (n"fill") >=> fromCursor+ _styleSheetBorders = cur $/ element (n"borders") &/ element (n"border") >=> fromCursor+ -- TODO: cellStyleXfs+ _styleSheetCellXfs = cur $/ element (n"cellXfs") &/ element (n"xf") >=> fromCursor+ -- TODO: cellStyles+ -- TODO: dxfs+ -- TODO: tableStyles+ -- TODO: colors+ -- TODO: extLst+ return StyleSheet{..}++-- | See @CT_Font@, p. 4489+instance FromCursor Font where+ fromCursor cur = do+ _fontName <- maybeElementValue (n"name") cur+ _fontCharset <- maybeElementValue (n"charset") cur+ _fontFamily <- maybeElementValue (n"family") cur+ _fontBold <- maybeElementValue (n"b") cur+ _fontItalic <- maybeElementValue (n"i") cur+ _fontStrikeThrough<- maybeElementValue (n"strike") cur+ _fontOutline <- maybeElementValue (n"outline") cur+ _fontShadow <- maybeElementValue (n"shadow") cur+ _fontCondense <- maybeElementValue (n"condense") cur+ _fontExtend <- maybeElementValue (n"extend") cur+ _fontColor <- maybeFromElement (n"color") cur+ _fontSize <- maybeElementValue (n"sz") cur+ _fontUnderline <- maybeElementValue (n"u") cur+ _fontVertAlign <- maybeElementValue (n"vertAlign") cur+ _fontScheme <- maybeElementValue (n"scheme") cur+ return Font{..}++instance FromAttrVal FontFamily where+ fromAttrVal "1" = readSuccess FontFamilyRoman+ fromAttrVal "2" = readSuccess FontFamilySwiss+ fromAttrVal "3" = readSuccess FontFamilyModern+ fromAttrVal "4" = readSuccess FontFamilyScript+ fromAttrVal "5" = readSuccess FontFamilyDecorative+ fromAttrVal t = invalidText "FontFamily" t++-- | See @CT_Color@, p. 4484+instance FromCursor Color where+ fromCursor cur = do+ _colorAutomatic <- maybeAttribute "auto" cur+ _colorARGB <- maybeAttribute "rgb" cur+ _colorTheme <- maybeAttribute "theme" cur+ _colorTint <- maybeAttribute "tint" cur+ return Color{..}++-- See @ST_UnderlineValues@, p. 3940+instance FromAttrVal FontUnderline where+ fromAttrVal "single" = readSuccess FontUnderlineSingle+ fromAttrVal "double" = readSuccess FontUnderlineDouble+ fromAttrVal "singleAccounting" = readSuccess FontUnderlineSingleAccounting+ fromAttrVal "doubleAccounting" = readSuccess FontUnderlineDoubleAccounting+ fromAttrVal "none" = readSuccess FontUnderlineNone+ fromAttrVal t = invalidText "FontUnderline" t++instance FromAttrVal FontVerticalAlignment where+ fromAttrVal "baseline" = readSuccess FontVerticalAlignmentBaseline+ fromAttrVal "subscript" = readSuccess FontVerticalAlignmentSubscript+ fromAttrVal "superscript" = readSuccess FontVerticalAlignmentSuperscript+ fromAttrVal t = invalidText "FontVerticalAlignment" t++instance FromAttrVal FontScheme where+ fromAttrVal "major" = readSuccess FontSchemeMajor+ fromAttrVal "minor" = readSuccess FontSchemeMinor+ fromAttrVal "none" = readSuccess FontSchemeNone+ fromAttrVal t = invalidText "FontScheme" t++-- | See @CT_Fill@, p. 4484+instance FromCursor Fill where+ fromCursor cur = do+ _fillPattern <- maybeFromElement (n"patternFill") cur+ return Fill{..}++-- | See @CT_PatternFill@, p. 4484+instance FromCursor FillPattern where+ fromCursor cur = do+ _fillPatternType <- maybeAttribute "patternType" cur+ _fillPatternFgColor <- maybeFromElement (n"fgColor") cur+ _fillPatternBgColor <- maybeFromElement (n"bgColor") cur+ return FillPattern{..}++instance FromAttrVal PatternType where+ fromAttrVal "darkDown" = readSuccess PatternTypeDarkDown+ fromAttrVal "darkGray" = readSuccess PatternTypeDarkGray+ fromAttrVal "darkGrid" = readSuccess PatternTypeDarkGrid+ fromAttrVal "darkHorizontal" = readSuccess PatternTypeDarkHorizontal+ fromAttrVal "darkTrellis" = readSuccess PatternTypeDarkTrellis+ fromAttrVal "darkUp" = readSuccess PatternTypeDarkUp+ fromAttrVal "darkVertical" = readSuccess PatternTypeDarkVertical+ fromAttrVal "gray0625" = readSuccess PatternTypeGray0625+ fromAttrVal "gray125" = readSuccess PatternTypeGray125+ fromAttrVal "lightDown" = readSuccess PatternTypeLightDown+ fromAttrVal "lightGray" = readSuccess PatternTypeLightGray+ fromAttrVal "lightGrid" = readSuccess PatternTypeLightGrid+ fromAttrVal "lightHorizontal" = readSuccess PatternTypeLightHorizontal+ fromAttrVal "lightTrellis" = readSuccess PatternTypeLightTrellis+ fromAttrVal "lightUp" = readSuccess PatternTypeLightUp+ fromAttrVal "lightVertical" = readSuccess PatternTypeLightVertical+ fromAttrVal "mediumGray" = readSuccess PatternTypeMediumGray+ fromAttrVal "none" = readSuccess PatternTypeNone+ fromAttrVal "solid" = readSuccess PatternTypeSolid+ fromAttrVal t = invalidText "PatternType" t++-- | See @CT_Border@, p. 4483+instance FromCursor Border where+ fromCursor cur = do+ _borderDiagonalUp <- maybeAttribute "diagonalUp" cur+ _borderDiagonalDown <- maybeAttribute "diagonalDown" cur+ _borderOutline <- maybeAttribute "outline" cur+ _borderStart <- maybeFromElement (n"start") cur+ _borderEnd <- maybeFromElement (n"end") cur+ _borderLeft <- maybeFromElement (n"left") cur+ _borderRight <- maybeFromElement (n"right") cur+ _borderTop <- maybeFromElement (n"top") cur+ _borderBottom <- maybeFromElement (n"bottom") cur+ _borderDiagonal <- maybeFromElement (n"diagonal") cur+ _borderVertical <- maybeFromElement (n"vertical") cur+ _borderHorizontal <- maybeFromElement (n"horizontal") cur+ return Border{..}++instance FromCursor BorderStyle where+ fromCursor cur = do+ _borderStyleLine <- maybeAttribute "style" cur+ _borderStyleColor <- maybeFromElement (n"color") cur+ return BorderStyle{..}++instance FromAttrVal LineStyle where+ fromAttrVal "dashDot" = readSuccess LineStyleDashDot+ fromAttrVal "dashDotDot" = readSuccess LineStyleDashDotDot+ fromAttrVal "dashed" = readSuccess LineStyleDashed+ fromAttrVal "dotted" = readSuccess LineStyleDotted+ fromAttrVal "double" = readSuccess LineStyleDouble+ fromAttrVal "hair" = readSuccess LineStyleHair+ fromAttrVal "medium" = readSuccess LineStyleMedium+ fromAttrVal "mediumDashDot" = readSuccess LineStyleMediumDashDot+ fromAttrVal "mediumDashDotDot" = readSuccess LineStyleMediumDashDotDot+ fromAttrVal "mediumDashed" = readSuccess LineStyleMediumDashed+ fromAttrVal "none" = readSuccess LineStyleNone+ fromAttrVal "slantDashDot" = readSuccess LineStyleSlantDashDot+ fromAttrVal "thick" = readSuccess LineStyleThick+ fromAttrVal "thin" = readSuccess LineStyleThin+ fromAttrVal t = invalidText "LineStyle" t++-- | See @CT_Xf@, p. 4486+instance FromCursor CellXf where+ fromCursor cur = do+ _cellXfAlignment <- maybeFromElement (n"alignment") cur+ _cellXfProtection <- maybeFromElement (n"protection") cur+ _cellXfNumFmtId <- maybeAttribute "numFmtId" cur+ _cellXfFontId <- maybeAttribute "fontId" cur+ _cellXfFillId <- maybeAttribute "fillId" cur+ _cellXfBorderId <- maybeAttribute "borderId" cur+ _cellXfId <- maybeAttribute "xfId" cur+ _cellXfQuotePrefix <- maybeAttribute "quotePrefix" cur+ _cellXfPivotButton <- maybeAttribute "pivotButton" cur+ _cellXfApplyNumberFormat <- maybeAttribute "applyNumberFormat" cur+ _cellXfApplyFont <- maybeAttribute "applyFont" cur+ _cellXfApplyFill <- maybeAttribute "applyFill" cur+ _cellXfApplyBorder <- maybeAttribute "applyBorder" cur+ _cellXfApplyAlignment <- maybeAttribute "applyAlignment" cur+ _cellXfApplyProtection <- maybeAttribute "applyProtection" cur+ return CellXf{..}++-- | See @CT_CellAlignment@, p. 4482+instance FromCursor Alignment where+ fromCursor cur = do+ _alignmentHorizontal <- maybeAttribute "horizontal" cur+ _alignmentVertical <- maybeAttribute "vertical" cur+ _alignmentTextRotation <- maybeAttribute "textRotation" cur+ _alignmentWrapText <- maybeAttribute "wrapText" cur+ _alignmentRelativeIndent <- maybeAttribute "relativeIndent" cur+ _alignmentIndent <- maybeAttribute "indent" cur+ _alignmentJustifyLastLine <- maybeAttribute "justifyLastLine" cur+ _alignmentShrinkToFit <- maybeAttribute "shrinkToFit" cur+ _alignmentReadingOrder <- maybeAttribute "readingOrder" cur+ return Alignment{..}++instance FromAttrVal CellHorizontalAlignment where+ fromAttrVal "center" = readSuccess CellHorizontalAlignmentCenter+ fromAttrVal "centerContinuous" = readSuccess CellHorizontalAlignmentCenterContinuous+ fromAttrVal "distributed" = readSuccess CellHorizontalAlignmentDistributed+ fromAttrVal "fill" = readSuccess CellHorizontalAlignmentFill+ fromAttrVal "general" = readSuccess CellHorizontalAlignmentGeneral+ fromAttrVal "justify" = readSuccess CellHorizontalAlignmentJustify+ fromAttrVal "left" = readSuccess CellHorizontalAlignmentLeft+ fromAttrVal "right" = readSuccess CellHorizontalAlignmentRight+ fromAttrVal t = invalidText "CellHorizontalAlignment" t++instance FromAttrVal CellVerticalAlignment where+ fromAttrVal "bottom" = readSuccess CellVerticalAlignmentBottom+ fromAttrVal "center" = readSuccess CellVerticalAlignmentCenter+ fromAttrVal "distributed" = readSuccess CellVerticalAlignmentDistributed+ fromAttrVal "justify" = readSuccess CellVerticalAlignmentJustify+ fromAttrVal "top" = readSuccess CellVerticalAlignmentTop+ fromAttrVal t = invalidText "CellVerticalAlignment" t++instance FromAttrVal ReadingOrder where+ fromAttrVal "0" = readSuccess ReadingOrderContextDependent+ fromAttrVal "1" = readSuccess ReadingOrderLeftToRight+ fromAttrVal "2" = readSuccess ReadingOrderRightToLeft+ fromAttrVal t = invalidText "ReadingOrder" t++-- | See @CT_CellProtection@, p. 4484+instance FromCursor Protection where+ fromCursor cur = do+ _protectionLocked <- maybeAttribute "locked" cur+ _protectionHidden <- maybeAttribute "hidden" cur+ return Protection{..}
src/Codec/Xlsx/Writer.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} -- | This module provides a function for serializing structured `Xlsx` into lazy bytestring module Codec.Xlsx.Writer ( fromXlsx@@ -8,7 +9,7 @@ import Control.Arrow (second) import Control.Lens hiding (transform) import qualified Data.ByteString.Lazy as L-import Data.ByteString.Lazy.Char8()+import Data.ByteString.Lazy.Char8 () import Data.Map (Map) import qualified Data.Map as M import Data.Maybe@@ -19,36 +20,44 @@ import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder.Int import Data.Text.Lazy.Builder.RealFloat-import qualified Data.Set as S-import Data.Vector (Vector)-import qualified Data.Vector as V-import Numeric.Search.Range (searchFromTo)-import System.Locale-import System.Time+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)+import Data.Time.Format (formatTime)+#if MIN_VERSION_time(1,5,0)+import Data.Time.Format (defaultTimeLocale)+#else+import System.Locale (defaultTimeLocale)+#endif import Text.XML -import Codec.Xlsx.Types+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif +import Codec.Xlsx.Types+import Codec.Xlsx.Types.SharedStringTable+import Codec.Xlsx.Writer.Internal -- | Writes `Xlsx' to raw data (lazy bytestring)-fromXlsx :: ClockTime -> Xlsx -> L.ByteString-fromXlsx ct xlsx =+fromXlsx :: POSIXTime -> Xlsx -> L.ByteString+fromXlsx pt xlsx = Zip.fromArchive $ foldr Zip.addEntryToArchive Zip.emptyArchive entries where- TOD t _ = ct+ t = round pt+ utcTime = posixSecondsToUTCTime pt entries = Zip.toEntry "[Content_Types].xml" t (contentTypesXml files) : map (\fd -> Zip.toEntry (T.unpack $ fdName fd) t (fdContents fd)) files files = sheetFiles ++ [ FileData "docProps/core.xml"- "application/vnd.openxmlformats-package.core-properties+xml" $ coreXml (toUTCTime ct) "xlsxwriter"+ "application/vnd.openxmlformats-package.core-properties+xml" $ coreXml utcTime "xlsxwriter" , FileData "docProps/app.xml" "application/vnd.openxmlformats-officedocument.extended-properties+xml" $ appXml (xlsx ^. xlSheets) , FileData "xl/workbook.xml"- "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml" $ bookXml (xlsx ^. xlSheets)+ "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml" $ bookXml (xlsx ^. xlSheets) (xlsx ^. xlDefinedNames) , FileData "xl/styles.xml" "application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml" $ unStyles (xlsx ^. xlStyles) , FileData "xl/sharedStrings.xml"- "application/vnd.openxmlformats-officedocument.spreadsheetml.sharedStrings+xml" $ ssXml $ V.toList shared+ "application/vnd.openxmlformats-officedocument.spreadsheetml.sharedStrings+xml" $ ssXml shared , FileData "xl/_rels/workbook.xml.rels" "application/vnd.openxmlformats-package.relationships+xml" $ bookRelXml sheetCount , FileData "_rels/.rels" "application/vnd.openxmlformats-package.relationships+xml" rootRelXml@@ -56,21 +65,18 @@ sheetFiles = [ FileData ("xl/worksheets/sheet" <> txti n <> ".xml") "application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml" $- sheetXml (w ^. wsColumns) (w ^. wsRowPropertiesMap) cells (w ^. wsMerges) |+ sheetXml (w ^. wsColumns) (w ^. wsRowPropertiesMap) cells (w ^. wsMerges) (w ^. wsSheetViews) (w ^. wsPageSetup) | (n, cells, w) <- zip3 [1..] sheetCells sheets] sheets = xlsx ^. xlSheets . to M.elems sheetCount = length sheets- shared = V.fromList $ S.elems $ S.fromList $ concatMap (concatMap celltext . M.elems . _wsCells) sheets+ shared = sstConstruct sheets sheetCells = map (transformSheetData shared) sheets- celltext (Cell{_cellValue=v}) = case v of- Just(CellText a) -> [a]- _ -> [] data FileData = FileData { fdName :: Text , fdContentType :: Text , fdContents :: L.ByteString} -coreXml :: CalendarTime -> Text -> L.ByteString+coreXml :: UTCTime -> Text -> L.ByteString coreXml created creator = renderLBS def{rsNamespaces=nss} $ Document (Prologue [] Nothing []) root [] where@@ -80,7 +86,7 @@ , ("xsi","http://www.w3.org/2001/XMLSchema-instance") ] namespaced = nsName nss- date = T.pack $ formatCalendarTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" created+ date = T.pack $ formatTime defaultTimeLocale "%FT%T%QZ" created root = Element (namespaced "cp" "coreProperties") M.empty [ nEl (namespaced "dcterms" "created") (M.fromList [(namespaced "xsi" "type", "dcterms:W3CDTF")]) [NodeContent date]@@ -133,27 +139,28 @@ value XlsxCell{xlsxCellValue=Just(XlsxBool False)} = "0" value _ = error "value undefined" -transformSheetData :: Vector Text -> Worksheet -> [(Int, [(Int, XlsxCell)])]+transformSheetData :: SharedStringTable -> Worksheet -> [(Int, [(Int, XlsxCell)])] transformSheetData shared ws = map transformRow $ toRows (ws ^. wsCells) where transformRow = second (map transformCell) transformCell (c, Cell{_cellValue=v, _cellStyle=s}) = (c, XlsxCell s (fmap transformValue v))- transformValue (CellText t) =- let Just i = searchFromTo (\p -> shared V.! p >= t) 0 (V.length shared - 1)- in XlsxSS i+ transformValue (CellText t) = XlsxSS (sstLookupText shared t) transformValue (CellDouble dbl) = XlsxDouble dbl transformValue (CellBool b) = XlsxBool b+ transformValue (CellRich r) = XlsxSS (sstLookupRich shared r) -sheetXml :: [ColumnsWidth] -> Map Int RowProperties -> [(Int, [(Int, XlsxCell)])] -> [Text]-> L.ByteString-sheetXml cws rh rows merges = renderLBS def $ Document (Prologue [] Nothing []) root []+sheetXml :: [ColumnsWidth] -> Map Int RowProperties -> [(Int, [(Int, XlsxCell)])] -> [Text]-> Maybe [SheetView] -> Maybe PageSetup -> L.ByteString+sheetXml cws rh rows merges sheetViews pageSetup = renderLBS def $ Document (Prologue [] Nothing []) root [] where cType = xlsxCellType root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" $ Element "worksheet" M.empty $ catMaybes- [nonEmptyNmEl "cols" M.empty $ map cwEl cws,+ [renderSheetViews <$> sheetViews,+ nonEmptyNmEl "cols" M.empty $ map cwEl cws, justNmEl "sheetData" M.empty $ map rowEl rows,- nonEmptyNmEl "mergeCells" M.empty $ map mergeE1 merges]+ nonEmptyNmEl "mergeCells" M.empty $ map mergeE1 merges,+ NodeElement . toElement "pageSetup" <$> pageSetup] cwEl cw = NodeElement $! Element "col" (M.fromList [("min", txti $ cwMin cw), ("max", txti $ cwMax cw), ("width", txtd $ cwWidth cw), ("style", txti $ cwStyle cw)]) [] rowEl (r, cells) = nEl "row"@@ -169,30 +176,41 @@ _ -> ([], False,[]) mergeE1 t = NodeElement $! Element "mergeCell" (M.fromList [("ref",t)]) [] cellEl r (icol, cell) =- nEl "c" (M.fromList (cellAttrs r (int2col icol) cell))+ nEl "c" (M.fromList (cellAttrs (mkCellRef (r, icol)) cell)) [nEl "v" M.empty [NodeContent $ value cell] | isJust $ xlsxCellValue cell]- cellAttrs r col cell = cellStyleAttr cell ++ [("r", T.concat [col, txti r]), ("t", cType cell)]+ cellAttrs ref cell = cellStyleAttr cell ++ [("r", ref), ("t", cType cell)] cellStyleAttr XlsxCell{xlsxCellStyle=Nothing} = [] cellStyleAttr XlsxCell{xlsxCellStyle=Just s} = [("s", txti s)] -bookXml :: Map Text Worksheet -> L.ByteString-bookXml wss = renderLBS def $ Document (Prologue [] Nothing []) root []+bookXml :: Map Text Worksheet -> DefinedNames -> L.ByteString+bookXml wss (DefinedNames names) = renderLBS def $ Document (Prologue [] Nothing []) root [] where numNames = [(txti i, name) | (i, name) <- zip [1..] (M.keys wss)]++ -- The @bookViews@ element is not required according to the schema, but its+ -- absence can cause Excel to crash when opening the print preview+ -- (see <https://phpexcel.codeplex.com/workitem/2935>). It suffices however+ -- to define a bookViews with a single empty @workbookView@ element+ -- (the @bookViews@ must contain at least one @wookbookView@). root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" $ Element "workbook" M.empty- [nEl "sheets" M.empty $+ [nEl "bookViews" M.empty [nEl "workbookView" M.empty []]+ ,nEl "sheets" M.empty $ map (\(n, name) -> nEl "sheet" (M.fromList [("name", name), ("sheetId", n), ("state", "visible"),- (rId, T.concat ["rId", n])]) []) numNames]+ (rId, T.concat ["rId", n])]) []) numNames+ ,nEl "definedNames" M.empty $ map (\(name, lsId, val) ->+ nEl "definedName" (definedName name lsId) [NodeContent val]) names+ ]+ rId = nm "http://schemas.openxmlformats.org/officeDocument/2006/relationships" "id" -ssXml :: [Text] -> L.ByteString-ssXml ss =- renderLBS def $ Document (Prologue [] Nothing []) root []- where- root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" $ Element "sst" M.empty $- map (\s -> nEl "si" M.empty [nEl "t" M.empty [NodeContent s]]) ss+ definedName :: Text -> Maybe Text -> Map Name Text+ definedName name Nothing = M.fromList [("name", name)]+ definedName name (Just lsId) = M.fromList [("name", name), ("localSheetId", lsId)] +ssXml :: SharedStringTable -> L.ByteString+ssXml = renderLBS def . toDocument+ bookRelXml :: Int -> L.ByteString bookRelXml n = renderLBS def $ Document (Prologue [] Nothing []) root [] where@@ -207,8 +225,7 @@ ("Type", T.concat ["http://schemas.openxmlformats.org/officeDocument/2006/relationships/", typ])]) [] rootRelXml :: L.ByteString-rootRelXml = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\-\<Relationships xmlns=\"http://schemas.openxmlformats.org/package/2006/relationships\"><Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument\" Target=\"xl/workbook.xml\"/><Relationship Id=\"rId2\" Type=\"http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties\" Target=\"docProps/core.xml\"/><Relationship Id=\"rId3\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties\" Target=\"docProps/app.xml\"/></Relationships>"+rootRelXml = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><Relationships xmlns=\"http://schemas.openxmlformats.org/package/2006/relationships\"><Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument\" Target=\"xl/workbook.xml\"/><Relationship Id=\"rId2\" Type=\"http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties\" Target=\"docProps/core.xml\"/><Relationship Id=\"rId3\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties\" Target=\"docProps/app.xml\"/></Relationships>" contentTypesXml :: [FileData] -> L.ByteString contentTypesXml fds = renderLBS def $ Document (Prologue [] Nothing []) root []@@ -238,12 +255,6 @@ { nameLocalName = n , nameNamespace = Just ns , namePrefix = Nothing}--addNS :: Text -> Element -> Element-addNS namespace (Element (Name ln _ _) as ns) = Element (Name ln (Just namespace) Nothing) as (map addNS' ns)- where- addNS' (NodeElement e) = NodeElement $ addNS namespace e- addNS' n = n -- | Creates an element with the given name, attributes and children, -- if there is at least one child. Otherwise returns `Nothing`.
+ src/Codec/Xlsx/Writer/Internal.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wall #-}+module Codec.Xlsx.Writer.Internal (+ -- * Rendering documents+ ToDocument(..)+ , documentFromElement+ -- * Rendering elements+ , ToElement(..)+ , elementList+ , elementContent+ , elementValue+ -- * Rendering attributes+ , ToAttrVal(..)+ , (.=)+ , (.=?)+ -- * Dealing with namespaces+ , addNS+ , mainNamespace+ ) where++import Data.Text (Text)+import Data.String (fromString)+import Text.XML+import qualified Data.Map as Map++{-------------------------------------------------------------------------------+ Rendering documents+-------------------------------------------------------------------------------}++class ToDocument a where+ toDocument :: a -> Document++documentFromElement :: Text -> Element -> Document+documentFromElement comment e = Document {+ documentRoot = addNS mainNamespace e+ , documentEpilogue = []+ , documentPrologue = Prologue {+ prologueBefore = [MiscComment comment]+ , prologueDoctype = Nothing+ , prologueAfter = []+ }+ }++{-------------------------------------------------------------------------------+ Rendering elements+-------------------------------------------------------------------------------}++class ToElement a where+ toElement :: Name -> a -> Element++elementList :: Name -> [Element] -> Element+elementList nm as = Element {+ elementName = nm+ , elementNodes = map NodeElement as+ , elementAttributes = Map.fromList [ "count" .= length as ]+ }++elementContent :: Name -> Text -> Element+elementContent nm txt = Element {+ elementName = nm+ , elementAttributes = Map.fromList [ preserveSpace ]+ , elementNodes = [NodeContent txt]+ }+ where+ preserveSpace = (+ Name { nameLocalName = "space"+ , nameNamespace = Just "http://www.w3.org/XML/1998/namespace"+ , namePrefix = Nothing+ }+ , "preserve"+ )++{-------------------------------------------------------------------------------+ Rendering attributes+-------------------------------------------------------------------------------}++class ToAttrVal a where+ toAttrVal :: a -> Text++instance ToAttrVal Text where toAttrVal = id+instance ToAttrVal String where toAttrVal = fromString+instance ToAttrVal Int where toAttrVal = fromString . show+instance ToAttrVal Double where toAttrVal = fromString . show++instance ToAttrVal Bool where+ toAttrVal True = "true"+ toAttrVal False = "false"++elementValue :: ToAttrVal a => Name -> a -> Element+elementValue nm a = Element {+ elementName = nm+ , elementAttributes = Map.fromList [ "val" .= a ]+ , elementNodes = []+ }++(.=) :: ToAttrVal a => Name -> a -> (Name, Text)+nm .= a = (nm, toAttrVal a)++(.=?) :: ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)+_ .=? Nothing = Nothing+nm .=? (Just a) = Just (nm .= a)++{-------------------------------------------------------------------------------+ Dealing with namespaces+-------------------------------------------------------------------------------}++-- | Set the namespace for the entire document+--+-- This follows the same policy that the rest of the xlsx package uses.+addNS :: Text -> Element -> Element+addNS ns Element{..} = Element{+ elementName = goName elementName+ , elementAttributes = elementAttributes+ , elementNodes = map goNode elementNodes+ }+ where+ goName :: Name -> Name+ goName n@Name{..} =+ case nameNamespace of+ Just _ -> n -- If a namespace was explicitly set, leave it+ Nothing -> Name{+ nameLocalName = nameLocalName+ , nameNamespace = Just ns+ , namePrefix = Nothing+ }++ goNode :: Node -> Node+ goNode (NodeElement e) = NodeElement $ addNS ns e+ goNode n = n++-- | The main namespace for Excel+mainNamespace :: Text+mainNamespace = "http://schemas.openxmlformats.org/spreadsheetml/2006/main"
src/Test.hs view
@@ -2,12 +2,13 @@ import Codec.Xlsx -import Control.Applicative ((<$>))+import Control.Applicative import Control.Lens import qualified Data.ByteString.Lazy as L import qualified Data.Map as M import Data.Text (Text,pack)-import System.Time+import Data.Time.Clock.POSIX (getPOSIXTime)+import Prelude xEmpty :: Cell@@ -86,8 +87,8 @@ main :: IO () main = do- ct <- getClockTime- L.writeFile "test.xlsx" $ fromXlsx ct $ Xlsx sheets styles+ pt <- getPOSIXTime+ L.writeFile "test.xlsx" $ fromXlsx pt $ Xlsx sheets styles def x <- toXlsx <$> L.readFile "test.xlsx" putStrLn $ "And cell (3,2) value in list 'List' is " ++ show (x ^? xlSheets . ix "List" . wsCells . ix (3,2) . cellValue . _Just)@@ -101,4 +102,4 @@ , xText $ pack $ "column4-r" ++ show r , xDouble 42.12345 , xText "False"]- sheets = M.fromList [("List", Worksheet cols rowProps cells [])] -- wtf merges?+ sheets = M.fromList [("List", Worksheet cols rowProps cells [] Nothing Nothing)] -- wtf merges?
test/DataTest.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import qualified Data.IntMap as IM+import Control.Lens+import Data.ByteString.Lazy (ByteString) import Data.Map (Map) import qualified Data.Map as M-import Data.Time.Calendar-import Data.Time.LocalTime-import System.Time+import Data.Time.Clock.POSIX (POSIXTime)+import qualified Data.Vector as V import Text.XML import Text.XML.Cursor @@ -18,6 +18,7 @@ import Test.SmallCheck.Series (Positive(..)) import Codec.Xlsx+import Codec.Xlsx.Types.SharedStringTable import Codec.Xlsx.Parser.Internal @@ -29,17 +30,36 @@ testXlsx @=? toXlsx (fromXlsx testTime testXlsx) , testCase "fromRows . toRows == id" $ testCellMap @=? fromRows (toRows testCellMap)+ , testCase "fromRight . parseStyleSheet . renderStyleSheet == id" $+ testStyleSheet @=? fromRight (parseStyleSheet (renderStyleSheet testStyleSheet)) , testCase "correct shared strings parsing" $- testSharedStrings @=? testParseSharedStrings+ [testSharedStringTable] @=? testParsedSharedStringTables ] testXlsx :: Xlsx-testXlsx = Xlsx sheets emptyStyles+testXlsx = Xlsx sheets minimalStyles definedNames where sheets = M.fromList [( "List1", sheet )]- sheet = Worksheet cols rowProps testCellMap []+ sheet = Worksheet cols rowProps testCellMap ranges sheetViews pageSetup rowProps = M.fromList [(1, RowProps (Just 50) (Just 3))] cols = [ColumnsWidth 1 10 15 1]+ ranges = [mkRange (1,1) (1,2), mkRange (2,2) (10, 5)]+ minimalStyles = renderStyleSheet minimalStyleSheet+ definedNames = DefinedNames [("SampleName", Nothing, "A10:A20")]+ sheetViews = Just [sheetView1, sheetView2]+ sheetView1 = def & sheetViewRightToLeft .~ Just True+ & sheetViewTopLeftCell .~ Just "B5"+ sheetView2 = def & sheetViewType .~ Just SheetViewTypePageBreakPreview+ & sheetViewWorkbookViewId .~ 5+ & sheetViewSelection .~ [ def & selectionActiveCell .~ Just "C2"+ & selectionPane .~ Just PaneTypeBottomRight+ , def & selectionActiveCellId .~ Just 1+ & selectionSqref .~ Just ["A3:A10","B1:G3"]+ ]+ pageSetup = Just $ def & pageSetupBlackAndWhite .~ Just True+ & pageSetupCopies .~ Just 2+ & pageSetupErrors .~ Just PrintErrorsDash+ & pageSetupPaperSize .~ Just PaperA4 testCellMap :: CellMap testCellMap = M.fromList [ ((1, 2), cd1), ((1, 5), cd2)@@ -53,16 +73,35 @@ cd4 = Cell{_cellValue=Nothing, _cellStyle=Nothing} -- shouldn't it be skipped? cd5 = cd $(CellBool True) -testTime :: ClockTime-testTime = TOD 123 567+testTime :: POSIXTime+testTime = 123 -testSharedStrings = IM.fromAscList $ zip [0..] ["plain text", "Just example"]+fromRight :: Either a b -> b+fromRight (Right b) = b -testParseSharedStrings = parseSharedStrings $ fromDocument $ parseLBS_ def strings- where- strings = "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\- \<sst xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\" count=\"2\" uniqueCount=\"2\">\- \<si><t>plain text</t></si>\- \<si><r><t>Just </t></r><r><rPr><b val=\"true\"/><u val=\"single\"/>\- \<sz val=\"10\"/><rFont val=\"Arial\"/><family val=\"2\"/></rPr><t>example</t></r></si>\- \</sst>"+testStyleSheet :: StyleSheet+testStyleSheet = minimalStyleSheet++testSharedStringTable :: SharedStringTable+testSharedStringTable = SharedStringTable $ V.fromList items+ where+ items = [text, rich]+ text = StringItemText "plain text"+ rich = StringItemRich [ RichTextRun Nothing "Just "+ , RichTextRun (Just props) "example" ]+ props = def & runPropertiesBold .~ Just True+ & runPropertiesUnderline .~ Just FontUnderlineSingle+ & runPropertiesSize .~ Just 10+ & runPropertiesFont .~ Just "Arial"+ & runPropertiesFontFamily .~ Just FontFamilySwiss++testParsedSharedStringTables ::[SharedStringTable]+testParsedSharedStringTables = fromCursor . fromDocument $ parseLBS_ def testStrings++testStrings :: ByteString+testStrings = "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\+ \<sst xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\" count=\"2\" uniqueCount=\"2\">\+ \<si><t>plain text</t></si>\+ \<si><r><t>Just </t></r><r><rPr><b val=\"true\"/><u val=\"single\"/>\+ \<sz val=\"10\"/><rFont val=\"Arial\"/><family val=\"2\"/></rPr><t>example</t></r></si>\+ \</sst>"
xlsx.cabal view
@@ -1,6 +1,6 @@ Name: xlsx -Version: 0.1.2+Version: 0.2.0 Synopsis: Simple and incomplete Excel file parser/writer Description:@@ -11,8 +11,10 @@ . Format is covered by ECMA-376 standard: <http://www.ecma-international.org/publications/standards/Ecma-376.htm>+ .+ 4th edition of the standard with the transitional schema is used for this library. Extra-source-files:- changelog+ CHANGELOG.markdown Homepage: https://github.com/qrilka/xlsx@@ -24,18 +26,26 @@ Category: Codec Build-type: Simple-+Tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2 Cabal-version: >=1.10 Library Hs-source-dirs: src Exposed-modules: Codec.Xlsx- , Codec.Xlsx.Parser , Codec.Xlsx.Types- , Codec.Xlsx.Writer+ , Codec.Xlsx.Types.Common+ , Codec.Xlsx.Types.SharedStringTable+ , Codec.Xlsx.Types.RichText+ , Codec.Xlsx.Types.SheetViews+ , Codec.Xlsx.Types.PageSetup+ , Codec.Xlsx.Types.StyleSheet , Codec.Xlsx.Lens+ , Codec.Xlsx.Parser , Codec.Xlsx.Parser.Internal+ , Codec.Xlsx.Formatted+ , Codec.Xlsx.Writer+ , Codec.Xlsx.Writer.Internal Build-depends: base == 4.* , containers >= 0.5.0.0@@ -51,14 +61,24 @@ , zlib >= 0.5.4.0 , utf8-string >= 0.3.7 , time >= 1.4.0.1- , old-time >= 1.1.0.1 , old-locale >= 1.0.0.5 , data-default == 0.5.* , vector >= 0.10+ , mtl >= 2.1 , binary-search Default-Language: Haskell2010+ Other-Extensions: CPP+ DeriveDataTypeable+ FlexibleInstances+ NoMonomorphismRestriction+ OverloadedStrings+ RankNTypes+ RecordWildCards+ TemplateHaskell+ TupleSections + Executable test Hs-source-dirs: src Other-modules: Codec.Xlsx@@ -78,7 +98,6 @@ , zlib , utf8-string , time- , old-time , old-locale , data-default == 0.5.* , vector >= 0.10@@ -92,14 +111,16 @@ Build-Depends: base, containers, time,- old-time, xlsx, xml-conduit >= 1.1.0, smallcheck, HUnit, tasty, tasty-smallcheck,- tasty-hunit+ tasty-hunit,+ lens,+ bytestring,+ vector Default-Language: Haskell2010 source-repository head