xlsx 0.7.2 → 0.8.0
raw patch · 10 files changed
+146/−31 lines, 10 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.markdown +6/−0
- src/Codec/Xlsx/Formatted.hs +17/−1
- src/Codec/Xlsx/Parser/Internal/Fast.hs +3/−2
- src/Codec/Xlsx/Parser/Internal/Util.hs +31/−14
- src/Codec/Xlsx/Types/Drawing/Common.hs +2/−1
- src/Codec/Xlsx/Types/RichText.hs +3/−2
- src/Codec/Xlsx/Types/Variant.hs +2/−1
- src/Codec/Xlsx/Writer/Internal.hs +7/−5
- test/Main.hs +72/−2
- xlsx.cabal +3/−3
CHANGELOG.markdown view
@@ -1,3 +1,9 @@+0.8.0+------+* GHC 8.8 compatibility added (GHC 8.6 didn't need any updates). Dropped+ compatilibity with GHC 7.10+ (thanks to David Hewson <david.hewson@tracsis.com>)+ 0.7.2 ----- * GHC 8.4 compatibility
src/Codec/Xlsx/Formatted.hs view
@@ -8,6 +8,7 @@ , Formatted(..) , Format(..) , formatted+ , formatWorkbook , toFormattedCells , CondFormatted(..) , conditionallyFormatted@@ -72,7 +73,7 @@ , _formattingCellXfs = fromValueList _styleSheetCellXfs , _formattingFills = fromValueList _styleSheetFills , _formattingFonts = fromValueList _styleSheetFonts- , _formattingNumFmts = M.empty+ , _formattingNumFmts = M.fromList . map swap $ M.toList _styleSheetNumFmts , _formattingMerges = [] } @@ -235,6 +236,21 @@ , formattedStyleSheet = styleSheet' , formattedMerges = reverse (finalSt ^. formattingMerges) }++formatWorkbook :: [(Text, Map (Int, Int) FormattedCell)] -> StyleSheet -> Xlsx+formatWorkbook nfcss initStyle = extract go+ where+ initSt = stateFromStyleSheet initStyle+ go = flip runState initSt $+ forM nfcss $ \(name, fcs) -> do+ cs' <- forM (M.toList fcs) $ \(rc, fc) -> formatCell rc fc+ merges <- reverse . _formattingMerges <$> get+ return ( name+ , def & wsCells .~ M.fromList (concat cs')+ & wsMerges .~ merges)+ extract (sheets, st) =+ def & xlSheets .~ sheets+ & xlStyles .~ renderStyleSheet (updateStyleSheetFromState initStyle st) -- | reverse to 'formatted' which allows to get a map of formatted cells -- from an existing worksheet and its workbook's style sheet
src/Codec/Xlsx/Parser/Internal/Fast.hs view
@@ -35,6 +35,7 @@ import Control.Arrow (second) import Control.Exception (Exception, throw) import Control.Monad (ap, forM, join, liftM)+import Data.Bifunctor (first) import Data.Bits ((.|.), shiftL) import Data.ByteString (ByteString) import qualified Data.ByteString as BS@@ -224,11 +225,11 @@ instance FromAttrBs Int where -- it appears that parser in text is more optimized than the one in -- attoparsec at least as of text-1.2.2.2 and attoparsec-0.13.1.0- fromAttrBs = decimal . T.decodeLatin1+ fromAttrBs = first T.pack . eitherDecimal . T.decodeLatin1 instance FromAttrBs Double where -- as for rationals- fromAttrBs = rational . T.decodeLatin1+ fromAttrBs = first T.pack . eitherRational . T.decodeLatin1 instance FromAttrBs Text where fromAttrBs = replaceEntititesBs
src/Codec/Xlsx/Parser/Internal/Util.hs view
@@ -1,26 +1,43 @@-{-# LANGUAGE OverloadedStrings #-} module Codec.Xlsx.Parser.Internal.Util ( boolean+ , eitherBoolean , decimal+ , eitherDecimal , rational+ , eitherRational ) where import Data.Text (Text)+import Control.Monad.Fail (MonadFail) import qualified Data.Text as T import qualified Data.Text.Read as T+import qualified Control.Monad.Fail as F -decimal :: (Monad m, Integral a) => Text -> m a-decimal t = case T.signed T.decimal $ t of- Right (d, leftover) | T.null leftover -> return d- _ -> fail $ "invalid decimal" ++ show t+decimal :: (MonadFail m, Integral a) => Text -> m a+decimal = fromEither . eitherDecimal -rational :: Monad m => Text -> m Double-rational t = case T.signed T.rational t of- Right (r, leftover) | T.null leftover -> return r- _ -> fail $ "invalid rational: " ++ show t+eitherDecimal :: (Integral a) => Text -> Either String a+eitherDecimal t = case T.signed T.decimal t of+ Right (d, leftover) | T.null leftover -> Right d+ _ -> Left $ "invalid decimal: " ++ show t -boolean :: Monad m => Text -> m Bool-boolean t = case T.strip t of- "true" -> return True- "false" -> return False- _ -> fail $ "invalid boolean: " ++ show t+rational :: (MonadFail m) => Text -> m Double+rational = fromEither . eitherRational++eitherRational :: Text -> Either String Double+eitherRational t = case T.signed T.rational t of+ Right (r, leftover) | T.null leftover -> Right r+ _ -> Left $ "invalid rational: " ++ show t++boolean :: (MonadFail m) => Text -> m Bool+boolean = fromEither . eitherBoolean++eitherBoolean :: Text -> Either String Bool+eitherBoolean t = case T.unpack $ T.strip t of+ "true" -> Right True+ "false" -> Right False+ _ -> Left $ "invalid boolean: " ++ show t++fromEither :: (MonadFail m) => Either String b -> m b+fromEither (Left a) = F.fail a+fromEither (Right b) = return b
src/Codec/Xlsx/Types/Drawing/Common.hs view
@@ -9,6 +9,7 @@ import Control.Arrow (first) import Control.Lens.TH import Control.Monad (join)+import Control.Monad.Fail (MonadFail) import Control.DeepSeq (NFData) import Data.Default import Data.Maybe (catMaybes, listToMaybe)@@ -462,7 +463,7 @@ return $ RgbColor val | otherwise = fail "no matching color choice node" -coordinate :: Monad m => Text -> m Coordinate+coordinate :: MonadFail m => Text -> m Coordinate coordinate t = case T.decimal t of Right (d, leftover) | leftover == T.empty -> return $ UnqCoordinate d
src/Codec/Xlsx/Types/RichText.hs view
@@ -245,7 +245,8 @@ , elementValue "extend" <$> _runPropertiesExtend , toElement "color" <$> _runPropertiesColor , elementValue "sz" <$> _runPropertiesSize- , elementValue "u" <$> _runPropertiesUnderline+ , elementValueDef "u" FontUnderlineSingle+ <$> _runPropertiesUnderline , elementValue "vertAlign" <$> _runPropertiesVertAlign , elementValue "scheme" <$> _runPropertiesScheme ]@@ -284,7 +285,7 @@ _runPropertiesExtend <- maybeBoolElementValue (n_ "extend") cur _runPropertiesColor <- maybeFromElement (n_ "color") cur _runPropertiesSize <- maybeElementValue (n_ "sz") cur- _runPropertiesUnderline <- maybeElementValue (n_ "u") cur+ _runPropertiesUnderline <- maybeElementValueDef (n_ "u") FontUnderlineSingle cur _runPropertiesVertAlign <- maybeElementValue (n_ "vertAlign") cur _runPropertiesScheme <- maybeElementValue (n_ "scheme") cur return RunProperties{..}
src/Codec/Xlsx/Types/Variant.hs view
@@ -3,6 +3,7 @@ module Codec.Xlsx.Types.Variant where import Control.DeepSeq (NFData)+import Control.Monad.Fail (MonadFail) import Data.ByteString (ByteString) import Data.ByteString.Base64 as B64 import Data.Text (Text)@@ -52,7 +53,7 @@ killWhitespace :: Text -> Text killWhitespace = T.filter (/=' ') -decodeBase64 :: Monad m => Text -> m ByteString+decodeBase64 :: MonadFail m => Text -> m ByteString decodeBase64 t = case B64.decode (T.encodeUtf8 t) of Right bs -> return bs Left err -> fail $ "invalid base64 value: " ++ err
src/Codec/Xlsx/Writer/Internal.hs view
@@ -21,6 +21,7 @@ , elementContent , elementContentPreserved , elementValue+ , elementValueDef -- * Rendering attributes , ToAttrVal(..) , (.=)@@ -39,6 +40,7 @@ ) where import qualified Data.Map as Map+import Data.Maybe (catMaybes) import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as T@@ -143,11 +145,11 @@ toAttrVal False = "0" elementValue :: ToAttrVal a => Name -> a -> Element-elementValue nm a = Element {- elementName = nm- , elementAttributes = Map.fromList [ "val" .= a ]- , elementNodes = []- }+elementValue nm a = leafElement nm [ "val" .= a ]++elementValueDef :: (Eq a, ToAttrVal a) => Name -> a -> a -> Element+elementValueDef nm defVal a =+ leafElement nm $ catMaybes [ "val" .=? justNonDef defVal a ] (.=) :: ToAttrVal a => Name -> a -> (Name, Text) nm .= a = (nm, toAttrVal a)
test/Main.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE QuasiQuotes #-} module Main@@ -54,6 +55,10 @@ testStyleSheet @==? fromRight (parseStyleSheet (renderStyleSheet testStyleSheet)) , testCase "correct shared strings parsing" $ [testSharedStringTable] @=? parseBS testStrings+ , testCase "correct shared strings parsing: single underline" $+ [withSingleUnderline testSharedStringTable] @=? parseBS testStringsWithSingleUnderline+ , testCase "correct shared strings parsing: double underline" $+ [withDoubleUnderline testSharedStringTable] @=? parseBS testStringsWithDoubleUnderline , testCase "correct shared strings parsing even when one of the shared strings entry is just <t/>" $ [testSharedStringTableWithEmpty] @=? parseBS testStringsWithEmpty , testCase "correct comments parsing" $@@ -62,6 +67,8 @@ [testCustomProperties] @==? parseBS testCustomPropertiesXml , testCase "proper results from `formatted`" $ testFormattedResult @==? testRunFormatted+ , testCase "proper results from `formatWorkbook`" $+ testFormatWorkbookResult @==? testFormatWorkbook , testCase "formatted . toFormattedCells = id" $ do let fmtd = formatted testFormattedCells minimalStyleSheet testFormattedCells @==? toFormattedCells (formattedCellMap fmtd) (formattedMerges fmtd)@@ -251,6 +258,18 @@ { _cellXfApplyNumberFormat = Just True , _cellXfNumFmtId = Just 164 } ++withSingleUnderline :: SharedStringTable -> SharedStringTable+withSingleUnderline = withUnderline FontUnderlineSingle++withDoubleUnderline :: SharedStringTable -> SharedStringTable+withDoubleUnderline = withUnderline FontUnderlineDouble++withUnderline :: FontUnderline -> SharedStringTable -> SharedStringTable+withUnderline u (SharedStringTable [text, XlsxRichText [rich1, RichTextRun (Just props) val]]) =+ let newprops = props & runPropertiesUnderline .~ Just u + in SharedStringTable [text, XlsxRichText [rich1, RichTextRun (Just newprops) val]] + testSharedStringTable :: SharedStringTable testSharedStringTable = SharedStringTable $ V.fromList items where@@ -259,7 +278,7 @@ rich = XlsxRichText [ RichTextRun Nothing "Just " , RichTextRun (Just props) "example" ] props = def & runPropertiesBold .~ Just True- & runPropertiesUnderline .~ Just FontUnderlineSingle+ & runPropertiesItalic .~ Just True & runPropertiesSize .~ Just 10 & runPropertiesFont .~ Just "Arial" & runPropertiesFontFamily .~ Just FontFamilySwiss@@ -295,10 +314,26 @@ 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\"/>\+ \<si><r><t>Just </t></r><r><rPr><b /><i />\ \<sz val=\"10\"/><rFont val=\"Arial\"/><family val=\"2\"/></rPr><t>example</t></r></si>\ \</sst>" +testStringsWithSingleUnderline :: ByteString+testStringsWithSingleUnderline = "<?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 /><i /><u />\+ \<sz val=\"10\"/><rFont val=\"Arial\"/><family val=\"2\"/></rPr><t>example</t></r></si>\+ \</sst>"++testStringsWithDoubleUnderline :: ByteString+testStringsWithDoubleUnderline = "<?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 /><i /><u val=\"double\"/>\+ \<sz val=\"10\"/><rFont val=\"Arial\"/><family val=\"2\"/></rPr><t>example</t></r></si>\+ \</sst>"+ testStringsWithEmpty :: ByteString testStringsWithEmpty = "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\ \<sst xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\" count=\"2\" uniqueCount=\"2\">\@@ -435,6 +470,41 @@ & formattedFormat . formatNumberFormat ?~ fmtDecimalsZeroes 4) at (2, 5) ?= (def & formattedCell . cellValue ?~ CellDouble 1.23456 & formattedFormat . formatNumberFormat ?~ StdNumberFormat Nf2Decimal)++testFormatWorkbookResult :: Xlsx+testFormatWorkbookResult = def & xlSheets .~ sheets+ & xlStyles .~ renderStyleSheet style+ where+ testCellMap1 = M.fromList [((1, 1), Cell { _cellStyle = Nothing+ , _cellValue = Just (CellText "text at A1 Sheet1")+ , _cellComment = Nothing+ , _cellFormula = Nothing })]+ testCellMap2 = M.fromList [((2, 3), Cell { _cellStyle = Just 1+ , _cellValue = Just (CellDouble 1.23456)+ , _cellComment = Nothing+ , _cellFormula = Nothing })]+ sheets = [ ("Sheet1", def & wsCells .~ testCellMap1)+ , ("Sheet2", def & wsCells .~ testCellMap2)+ ]+ style = minimalStyleSheet & styleSheetNumFmts .~ M.fromList [(164, "DD.MM.YYYY")]+ & styleSheetCellXfs .~ [cellXf1, cellXf2]+ cellXf1 = def+ & cellXfBorderId .~ Just 0+ & cellXfFillId .~ Just 0+ & cellXfFontId .~ Just 0+ cellXf2 = def+ { _cellXfApplyNumberFormat = Just True+ , _cellXfNumFmtId = Just 164 }+ +testFormatWorkbook :: Xlsx+testFormatWorkbook = formatWorkbook sheets minimalStyleSheet+ where+ sheetNames = ["Sheet1", "Sheet2"]+ testFormattedCellMap1 = M.fromList [((1,1), (def & formattedCell . cellValue ?~ CellText "text at A1 Sheet1"))]+ + testFormattedCellMap2 = M.fromList [((2,3), (def & formattedCell . cellValue ?~ CellDouble 1.23456+ & formattedFormat . formatNumberFormat ?~ (UserNumberFormat "DD.MM.YYYY")))]+ sheets = zip sheetNames [testFormattedCellMap1, testFormattedCellMap2] testCondFormattedResult :: CondFormatted testCondFormattedResult = CondFormatted styleSheet formattings
xlsx.cabal view
@@ -1,6 +1,6 @@ Name: xlsx -Version: 0.7.2+Version: 0.8.0 Synopsis: Simple and incomplete Excel file parser/writer Description:@@ -26,7 +26,7 @@ Category: Codec Build-type: Simple-Tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2+Tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.5, GHC == 8.8.1 Cabal-version: >=1.10 @@ -73,7 +73,7 @@ , Codec.Xlsx.Writer.Internal , Codec.Xlsx.Writer.Internal.PivotTable - Build-depends: base == 4.*+ Build-depends: base >= 4.9.0.0 && < 5.0 , attoparsec , base64-bytestring , binary-search