diff --git a/src/Codec/Xlsx.hs b/src/Codec/Xlsx.hs index 08484224..b5f7ab55 100644 --- a/src/Codec/Xlsx.hs +++ b/src/Codec/Xlsx.hs @@ -38,7 +38,7 @@ module Codec.Xlsx ( module X ) where -import Codec.Xlsx.Types as X +import Codec.Xlsx.Lens as X import Codec.Xlsx.Parser as X +import Codec.Xlsx.Types as X import Codec.Xlsx.Writer as X -import Codec.Xlsx.Lens as X diff --git a/src/Codec/Xlsx/Formatted.hs b/src/Codec/Xlsx/Formatted.hs index 175b2dcc..c7985e3a 100644 --- a/src/Codec/Xlsx/Formatted.hs +++ b/src/Codec/Xlsx/Formatted.hs @@ -1,9 +1,9 @@ -- | Higher level interface for creating styled worksheets -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Formatted ( FormattedCell(..) , Formatted(..) @@ -37,9 +37,9 @@ module Codec.Xlsx.Formatted #ifdef USE_MICROLENS import Lens.Micro +import Lens.Micro.GHC () import Lens.Micro.Mtl import Lens.Micro.TH -import Lens.Micro.GHC () #else import Control.Lens #endif @@ -47,7 +47,7 @@ import Control.Monad.State hiding (forM_, mapM) import Data.Default import Data.Foldable (asum, forM_) import Data.Function (on) -import Data.List (foldl', groupBy, sortBy, sortBy) +import Data.List (foldl', groupBy, sortBy) import Data.Map (Map) import qualified Data.Map as M import Data.Ord (comparing) @@ -56,7 +56,7 @@ import Data.Traversable (mapM) import Data.Tuple (swap) import GHC.Generics (Generic) import Prelude hiding (mapM) -import Safe (headNote, fromJustNote) +import Safe (fromJustNote, headNote) import Codec.Xlsx.Types diff --git a/src/Codec/Xlsx/Lens.hs b/src/Codec/Xlsx/Lens.hs index f15f6912..9bba84b1 100644 --- a/src/Codec/Xlsx/Lens.hs +++ b/src/Codec/Xlsx/Lens.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} -- | lenses to access sheets, cells and values of 'Xlsx' module Codec.Xlsx.Lens @@ -21,8 +21,8 @@ module Codec.Xlsx.Lens import Codec.Xlsx.Types #ifdef USE_MICROLENS import Lens.Micro -import Lens.Micro.Internal import Lens.Micro.GHC () +import Lens.Micro.Internal #else import Control.Lens #endif diff --git a/src/Codec/Xlsx/Parser.hs b/src/Codec/Xlsx/Parser.hs index 166863a1..1ad3773d 100644 --- a/src/Codec/Xlsx/Parser.hs +++ b/src/Codec/Xlsx/Parser.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} @@ -26,7 +26,7 @@ import Control.Exception (Exception) #ifdef USE_MICROLENS import Lens.Micro #else -import Control.Lens hiding ((<.>), element, views) +import Control.Lens hiding (element, views, (<.>)) #endif import Control.Monad (join, void) import Control.Monad.Except (catchError, throwError) @@ -59,8 +59,7 @@ import Codec.Xlsx.Types.Internal import Codec.Xlsx.Types.Internal.CfPair import Codec.Xlsx.Types.Internal.CommentTable as CommentTable import Codec.Xlsx.Types.Internal.ContentTypes as ContentTypes -import Codec.Xlsx.Types.Internal.CustomProperties - as CustomProperties +import Codec.Xlsx.Types.Internal.CustomProperties as CustomProperties import Codec.Xlsx.Types.Internal.DvPair import Codec.Xlsx.Types.Internal.FormulaData import Codec.Xlsx.Types.Internal.Relationships as Relationships @@ -116,9 +115,9 @@ toXlsxEitherBase parseSheet bs = do CustomProperties customPropMap <- getCustomProperties ar return $ Xlsx sheets (getStyles ar) names customPropMap dateBase -data WorksheetFile = WorksheetFile { wfName :: Text +data WorksheetFile = WorksheetFile { wfName :: Text , wfState :: SheetState - , wfPath :: FilePath + , wfPath :: FilePath } deriving (Show, Generic) @@ -246,7 +245,7 @@ extractSheetFast ar sst contentTypes caches wf = do liftEither :: Either Text a -> Parser a liftEither = left (\t -> InvalidFile filePath t) justNonEmpty v@(Just (_:_)) = v - justNonEmpty _ = Nothing + justNonEmpty _ = Nothing collectRows = foldr collectRow (M.empty, M.empty, M.empty) collectRow :: ( Int @@ -325,7 +324,7 @@ extractSheetFast ar sst contentTypes caches wf = do vConverted = case contentBs <$> vNode of Nothing -> return Nothing - Just c -> Just <$> fromAttrBs c + Just c -> Just <$> fromAttrBs c mFormulaData <- mapM fromXenoNode fNode d <- case t of @@ -333,7 +332,7 @@ extractSheetFast ar sst contentTypes caches wf = do si <- vConverted case sstItem sst =<< si of Just xlTxt -> return $ Just (xlsxTextToCellValue xlTxt) - Nothing -> throwError "bad shared string index" + Nothing -> throwError "bad shared string index" "inlineStr" -> mapM (fmap xlsxTextToCellValue . fromXenoNode) isNode "str" -> fmap CellText <$> vConverted "n" -> fmap CellDouble <$> vConverted @@ -510,7 +509,7 @@ extractCellValue sst t cur si <- vConverted "shared string" case sstItem sst si of Just xlTxt -> return $ xlsxTextToCellValue xlTxt - Nothing -> fail "bad shared string index" + Nothing -> fail "bad shared string index" | t == "inlineStr" = cur $/ element (n_ "is") >=> fmap xlsxTextToCellValue . fromCursor | t == "str" = CellText <$> vConverted "string" @@ -524,7 +523,7 @@ extractCellValue sst t cur return (T.concat $ c $/ content) case fromAttrVal vContent of Right (val, _) -> return $ val - _ -> fail $ "bad " ++ typeStr ++ " cell value" + _ -> fail $ "bad " ++ typeStr ++ " cell value" -- | Get xml cursor from the specified file inside the zip archive. xmlCursorOptional :: Zip.Archive -> FilePath -> Parser (Maybe Cursor) diff --git a/src/Codec/Xlsx/Parser/Internal.hs b/src/Codec/Xlsx/Parser/Internal.hs index 3484fb04..b26cd23a 100644 --- a/src/Codec/Xlsx/Parser/Internal.hs +++ b/src/Codec/Xlsx/Parser/Internal.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module Codec.Xlsx.Parser.Internal ( ParseException(..) , n_ @@ -90,7 +90,7 @@ maybeAttribute :: FromAttrVal a => Name -> Cursor -> [Maybe a] maybeAttribute name cursor = case attribute name cursor of [attr] -> Just <$> runReader fromAttrVal attr - _ -> [Nothing] + _ -> [Nothing] fromElementValue :: FromAttrVal a => Name -> Cursor -> [a] fromElementValue name cursor = @@ -100,13 +100,13 @@ maybeElementValue :: FromAttrVal a => Name -> Cursor -> [Maybe a] maybeElementValue name cursor = case cursor $/ element name of [cursor'] -> maybeAttribute "val" cursor' - _ -> [Nothing] + _ -> [Nothing] maybeElementValueDef :: FromAttrVal a => Name -> a -> Cursor -> [Maybe a] maybeElementValueDef name defVal cursor = case cursor $/ element name of [cursor'] -> Just . fromMaybe defVal <$> maybeAttribute "val" cursor' - _ -> [Nothing] + _ -> [Nothing] maybeBoolElementValue :: Name -> Cursor -> [Maybe Bool] maybeBoolElementValue name cursor = maybeElementValueDef name True cursor @@ -114,20 +114,20 @@ maybeBoolElementValue name cursor = maybeElementValueDef name True cursor maybeFromElement :: FromCursor a => Name -> Cursor -> [Maybe a] maybeFromElement name cursor = case cursor $/ element name of [cursor'] -> Just <$> fromCursor cursor' - _ -> [Nothing] + _ -> [Nothing] attrValIs :: (Eq a, FromAttrVal a) => Name -> a -> Axis attrValIs n v c = case fromAttribute n c of [x] | x == v -> [c] - _ -> [] + _ -> [] contentOrEmpty :: Cursor -> [Text] contentOrEmpty c = case c $/ content of [t] -> [t] - [] -> [""] - _ -> error "invalid item: more than one text node encountered" + [] -> [""] + _ -> error "invalid item: more than one text node encountered" readSuccess :: a -> Either String (a, Text) readSuccess x = Right (x, T.empty) @@ -144,7 +144,7 @@ defaultReadFailure = Left "invalid text" runReader :: T.Reader a -> Text -> [a] runReader reader t = case reader t of Right (r, leftover) | T.null leftover -> [r] - _ -> [] + _ -> [] -- | Add sml namespace to name n_ :: Text -> Name diff --git a/src/Codec/Xlsx/Parser/Internal/Fast.hs b/src/Codec/Xlsx/Parser/Internal/Fast.hs index 85b3f9ce..ed959829 100644 --- a/src/Codec/Xlsx/Parser/Internal/Fast.hs +++ b/src/Codec/Xlsx/Parser/Internal/Fast.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} module Codec.Xlsx.Parser.Internal.Fast ( FromXenoNode(..) , collectChildren @@ -36,7 +36,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.Bits (shiftL, (.|.)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as SU @@ -84,7 +84,7 @@ toChildCollector :: Either Text a -> ChildCollector a toChildCollector unlifted = case unlifted of Right a -> return a - Left e -> ChildCollector $ \_ -> Left e + Left e -> ChildCollector $ \_ -> Left e collectChildren :: Node -> ChildCollector a -> Either Text a collectChildren n c = snd <$> runChildCollector c (children n) @@ -108,7 +108,7 @@ childList :: ByteString -> ChildCollector [Node] childList nm = do mNode <- maybeChild nm case mNode of - Just n -> (n:) <$> childList nm + Just n -> (n:) <$> childList nm Nothing -> return [] maybeFromChild :: (FromXenoNode a) => ByteString -> ChildCollector (Maybe a) @@ -121,13 +121,13 @@ fromChild nm = do n <- requireChild nm case fromXenoNode n of Right a -> return a - Left e -> ChildCollector $ \_ -> Left e + Left e -> ChildCollector $ \_ -> Left e fromChildList :: (FromXenoNode a) => ByteString -> ChildCollector [a] fromChildList nm = do mA <- maybeFromChild nm case mA of - Just a -> (a:) <$> fromChildList nm + Just a -> (a:) <$> fromChildList nm Nothing -> return [] maybeParse :: ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a) @@ -170,7 +170,7 @@ toAttrParser :: Either Text a -> AttrParser a toAttrParser unlifted = case unlifted of Right a -> return a - Left e -> AttrParser $ \_ -> Left e + Left e -> AttrParser $ \_ -> Left e maybeAttrBs :: ByteString -> AttrParser (Maybe ByteString) maybeAttrBs attrName = AttrParser $ go id @@ -186,7 +186,7 @@ requireAttrBs nm = do mVal <- maybeAttrBs nm case mVal of Just val -> return val - Nothing -> attrError $ "attribute " <> T.pack (show nm) <> " is required" + Nothing -> attrError $ "attribute " <> T.pack (show nm) <> " is required" unexpectedAttrBs :: Text -> ByteString -> Either Text a unexpectedAttrBs typ val = @@ -208,7 +208,7 @@ fromAttrDef nm defVal = fromMaybe defVal <$> maybeAttr nm parseAttributes :: Node -> AttrParser a -> Either Text a parseAttributes n attrParser = case runAttrParser attrParser (attributes n) of - Left e -> Left e + Left e -> Left e Right (_, a) -> return a class FromAttrBs a where @@ -353,8 +353,8 @@ contentBs :: Node -> ByteString contentBs n = BS.concat . map toBs $ contents n where toBs (Element _) = BS.empty - toBs (Text bs) = bs - toBs (CData bs) = bs + toBs (Text bs) = bs + toBs (CData bs) = bs contentX :: Node -> Either Text Text contentX = replaceEntititesBs . contentBs diff --git a/src/Codec/Xlsx/Parser/Internal/Memoize.hs b/src/Codec/Xlsx/Parser/Internal/Memoize.hs index dad1da8a..330f9cd0 100644 --- a/src/Codec/Xlsx/Parser/Internal/Memoize.hs +++ b/src/Codec/Xlsx/Parser/Internal/Memoize.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeApplications #-} -- | I rewrote: https://hackage.haskell.org/package/unliftio-0.2.20/docs/src/UnliftIO.Memoize.html#Memoized -- for monad trans basecontrol @@ -12,10 +12,10 @@ module Codec.Xlsx.Parser.Internal.Memoize ) where import Control.Applicative as A +import Control.Exception import Control.Monad (join) import Control.Monad.IO.Class import Data.IORef -import Control.Exception -- | A \"run once\" value, with results saved. Extract the value with -- 'runMemoized'. For single-threaded usage, you can use 'memoizeRef' to diff --git a/src/Codec/Xlsx/Parser/Internal/PivotTable.hs b/src/Codec/Xlsx/Parser/Internal/PivotTable.hs index dbbba83a..992fccec 100644 --- a/src/Codec/Xlsx/Parser/Internal/PivotTable.hs +++ b/src/Codec/Xlsx/Parser/Internal/PivotTable.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} module Codec.Xlsx.Parser.Internal.PivotTable ( parsePivotTable , parseCache @@ -104,6 +104,6 @@ fillCacheFieldsFromRecords fields recs = if null (cfItems field) then field {cfItems = mapMaybe recToCellValue recVals} else field - recToCellValue (CacheText t) = Just $ CellText t + recToCellValue (CacheText t) = Just $ CellText t recToCellValue (CacheNumber n) = Just $ CellDouble n - recToCellValue (CacheIndex _) = Nothing + recToCellValue (CacheIndex _) = Nothing diff --git a/src/Codec/Xlsx/Parser/Internal/Util.hs b/src/Codec/Xlsx/Parser/Internal/Util.hs index 70bb3585..558bec8f 100644 --- a/src/Codec/Xlsx/Parser/Internal/Util.hs +++ b/src/Codec/Xlsx/Parser/Internal/Util.hs @@ -7,11 +7,11 @@ module Codec.Xlsx.Parser.Internal.Util , eitherRational ) where -import Data.Text (Text) import Control.Monad.Fail (MonadFail) +import qualified Control.Monad.Fail as F +import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Read as T -import qualified Control.Monad.Fail as F decimal :: (MonadFail m, Integral a) => Text -> m a decimal = fromEither . eitherDecimal @@ -19,7 +19,7 @@ decimal = fromEither . eitherDecimal 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 + _ -> Left $ "invalid decimal: " ++ show t rational :: (MonadFail m) => Text -> m Double rational = fromEither . eitherRational @@ -27,7 +27,7 @@ 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 + _ -> Left $ "invalid rational: " ++ show t boolean :: (MonadFail m) => Text -> m Bool boolean = fromEither . eitherBoolean @@ -39,5 +39,5 @@ eitherBoolean t = case T.unpack $ T.strip t of _ -> Left $ "invalid boolean: " ++ show t fromEither :: (MonadFail m) => Either String b -> m b -fromEither (Left a) = F.fail a +fromEither (Left a) = F.fail a fromEither (Right b) = return b diff --git a/src/Codec/Xlsx/Parser/Stream.hs b/src/Codec/Xlsx/Parser/Stream.hs index 7c29d41a..5f31dde3 100644 --- a/src/Codec/Xlsx/Parser/Stream.hs +++ b/src/Codec/Xlsx/Parser/Stream.hs @@ -85,6 +85,8 @@ import Lens.Micro.TH import Control.Lens #endif import Codec.Xlsx.Parser.Internal +import Codec.Xlsx.Parser.Internal.Memoize +import Control.DeepSeq import Control.Monad.Catch import Control.Monad.Except import Control.Monad.Reader @@ -95,9 +97,9 @@ import qualified Data.ByteString as BS import Data.Conduit (ConduitT) import qualified Data.DList as DL import Data.Foldable -import Data.IORef import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IntMap +import Data.IORef import qualified Data.Map.Strict as M import Data.Text (Text) import qualified Data.Text as T @@ -107,8 +109,6 @@ import qualified Data.Text.Read as Read import Data.Traversable (for) import Data.XML.Types import GHC.Generics -import Control.DeepSeq -import Codec.Xlsx.Parser.Internal.Memoize import qualified Codec.Xlsx.Parser.Stream.HexpatInternal as HexpatInternal import Control.Monad.Base @@ -134,8 +134,8 @@ data SheetItem = MkSheetItem deriving anyclass NFData data Row = MkRow - { _ri_row_index :: Int -- ^ Row number - , _ri_cell_row :: ~CellRow -- ^ Row itself + { _ri_row_index :: Int -- ^ Row number + , _ri_cell_row :: ~CellRow -- ^ Row itself } deriving stock (Generic, Show) deriving anyclass NFData diff --git a/src/Codec/Xlsx/Parser/Stream/HexpatInternal.hs b/src/Codec/Xlsx/Parser/Stream/HexpatInternal.hs index d8f669fe..462ea2ac 100644 --- a/src/Codec/Xlsx/Parser/Stream/HexpatInternal.hs +++ b/src/Codec/Xlsx/Parser/Stream/HexpatInternal.hs @@ -9,16 +9,16 @@ copied over because the upstream library doesn't expose this function. module Codec.Xlsx.Parser.Stream.HexpatInternal (parseBuf) where import Control.Monad -import Text.XML.Expat.SAX -import qualified Data.ByteString.Internal as I import Data.Bits -import Data.Int import Data.ByteString.Internal (c_strlen) +import qualified Data.ByteString.Internal as I +import Data.Int import Data.Word import Foreign.C import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable +import Text.XML.Expat.SAX {-# SCC parseBuf #-} parseBuf :: (GenericXMLString tag, GenericXMLString text) => diff --git a/src/Codec/Xlsx/Types.hs b/src/Codec/Xlsx/Types.hs index c239fee3..49479be5 100644 --- a/src/Codec/Xlsx/Types.hs +++ b/src/Codec/Xlsx/Types.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types ( -- * The main types @@ -71,9 +71,9 @@ module Codec.Xlsx.Types ( import Control.Exception (SomeException, toException) #ifdef USE_MICROLENS -import Lens.Micro.TH -import Data.Profunctor(dimap) +import Data.Profunctor (dimap) import Data.Profunctor.Choice +import Lens.Micro.TH #else #endif import Control.DeepSeq (NFData) @@ -111,7 +111,7 @@ import Codec.Xlsx.Writer.Internal #ifdef USE_MICROLENS import Lens.Micro #else -import Control.Lens (lens, Lens', makeLenses) +import Control.Lens (Lens', lens, makeLenses) import Control.Lens.TH (makePrisms) #endif @@ -141,7 +141,7 @@ _CustomHeight (\ x_a4xge -> case x_a4xge of CustomHeight y1_a4xgf -> Right y1_a4xgf - _ -> Left x_a4xge) + _ -> Left x_a4xge) {-# INLINE _CustomHeight #-} _AutomaticHeight :: Prism' RowHeight Double @@ -150,7 +150,7 @@ _AutomaticHeight (\ x_a4xgh -> case x_a4xgh of AutomaticHeight y1_a4xgi -> Right y1_a4xgi - _ -> Left x_a4xgh) + _ -> Left x_a4xgh) {-# INLINE _AutomaticHeight #-} #else @@ -160,11 +160,11 @@ makePrisms ''RowHeight -- | Properties of a row. See §18.3.1.73 "row (Row)" for more details data RowProperties = RowProps - { rowHeight :: Maybe RowHeight + { rowHeight :: Maybe RowHeight -- ^ Row height in points - , rowStyle :: Maybe Int + , rowStyle :: Maybe Int -- ^ Style to be applied to row - , rowHidden :: Bool + , rowHidden :: Bool -- ^ Whether row is visible or not } deriving (Eq, Ord, Show, Read, Generic) instance NFData RowProperties @@ -180,28 +180,28 @@ instance Default RowProperties where -- | Column range (from cwMin to cwMax) properties data ColumnsProperties = ColumnsProperties - { cpMin :: Int + { cpMin :: Int -- ^ First column affected by this 'ColumnWidth' record. - , cpMax :: Int + , cpMax :: Int -- ^ Last column affected by this 'ColumnWidth' record. - , cpWidth :: Maybe Double + , cpWidth :: Maybe Double -- ^ Column width measured as the number of characters of the -- maximum digit width of the numbers 0, 1, 2, ..., 9 as rendered in -- the normal style's font. -- -- See longer description in Section 18.3.1.13 "col (Column Width & -- Formatting)" (p. 1605) - , cpStyle :: Maybe Int + , cpStyle :: Maybe Int -- ^ Default style for the affected column(s). Affects cells not yet -- allocated in the column(s). In other words, this style applies -- to new columns. - , cpHidden :: Bool + , cpHidden :: Bool -- ^ Flag indicating if the affected column(s) are hidden on this -- worksheet. , cpCollapsed :: Bool -- ^ Flag indicating if the outlining of the affected column(s) is -- in the collapsed state. - , cpBestFit :: Bool + , cpBestFit :: Bool -- ^ Flag indicating if the specified column(s) is set to 'best -- fit'. } deriving (Eq, Show, Generic) @@ -268,21 +268,21 @@ instance ToAttrVal SheetState where -- | Xlsx worksheet data Worksheet = Worksheet - { _wsColumnsProperties :: [ColumnsProperties] -- ^ column widths - , _wsRowPropertiesMap :: Map Int RowProperties -- ^ custom row properties (height, style) map - , _wsCells :: CellMap -- ^ data mapped by (row, column) pairs - , _wsDrawing :: Maybe Drawing -- ^ SpreadsheetML Drawing - , _wsMerges :: [Range] -- ^ list of cell merges - , _wsSheetViews :: Maybe [SheetView] - , _wsPageSetup :: Maybe PageSetup + { _wsColumnsProperties :: [ColumnsProperties] -- ^ column widths + , _wsRowPropertiesMap :: Map Int RowProperties -- ^ custom row properties (height, style) map + , _wsCells :: CellMap -- ^ data mapped by (row, column) pairs + , _wsDrawing :: Maybe Drawing -- ^ SpreadsheetML Drawing + , _wsMerges :: [Range] -- ^ list of cell merges + , _wsSheetViews :: Maybe [SheetView] + , _wsPageSetup :: Maybe PageSetup , _wsConditionalFormattings :: Map SqRef ConditionalFormatting - , _wsDataValidations :: Map SqRef DataValidation - , _wsPivotTables :: [PivotTable] - , _wsAutoFilter :: Maybe AutoFilter - , _wsTables :: [Table] - , _wsProtection :: Maybe SheetProtection - , _wsSharedFormulas :: Map SharedFormulaIndex SharedFormulaOptions - , _wsState :: SheetState + , _wsDataValidations :: Map SqRef DataValidation + , _wsPivotTables :: [PivotTable] + , _wsAutoFilter :: Maybe AutoFilter + , _wsTables :: [Table] + , _wsProtection :: Maybe SheetProtection + , _wsSharedFormulas :: Map SharedFormulaIndex SharedFormulaOptions + , _wsState :: SheetState } deriving (Eq, Show, Generic) instance NFData Worksheet @@ -316,11 +316,11 @@ instance NFData Styles -- | Structured representation of Xlsx file (currently a subset of its contents) data Xlsx = Xlsx - { _xlSheets :: [(Text, Worksheet)] - , _xlStyles :: Styles - , _xlDefinedNames :: DefinedNames + { _xlSheets :: [(Text, Worksheet)] + , _xlStyles :: Styles + , _xlDefinedNames :: DefinedNames , _xlCustomProperties :: Map Text Variant - , _xlDateBase :: DateBase + , _xlDateBase :: DateBase -- ^ date base to use when converting serial value (i.e. 'CellDouble d') -- into date-time. Default value is 'DateBase1900' -- @@ -416,4 +416,4 @@ instance ToElement ColumnsProperties where , "hidden" .=? justTrue cpHidden , "collapsed" .=? justTrue cpCollapsed , "bestFit" .=? justTrue cpBestFit - ] \ No newline at end of file + ] diff --git a/src/Codec/Xlsx/Types/AutoFilter.hs b/src/Codec/Xlsx/Types/AutoFilter.hs index 2f9f063a..80c78eec 100644 --- a/src/Codec/Xlsx/Types/AutoFilter.hs +++ b/src/Codec/Xlsx/Types/AutoFilter.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types.AutoFilter where import Control.Arrow (first) @@ -87,7 +87,7 @@ instance NFData DateGroup data CustomFilter = CustomFilter { cfltOperator :: CustomFilterOperator - , cfltValue :: Text + , cfltValue :: Text } deriving (Eq, Show, Generic) instance NFData CustomFilter @@ -111,10 +111,10 @@ data EdgeFilterOptions = EdgeFilterOptions { _efoUsePercents :: Bool -- ^ Flag indicating whether or not to filter by percent value of -- the column. A false value filters by number of items. - , _efoVal :: Double + , _efoVal :: Double -- ^ Top or bottom value to use as the filter criteria. -- Example: "Filter by Top 10 Percent" or "Filter by Top 5 Items" - , _efoFilterVal :: Maybe Double + , _efoFilterVal :: Maybe Double -- ^ The actual cell value in the range which is used to perform the -- comparison for this filter. } deriving (Eq, Show, Generic) @@ -134,7 +134,7 @@ data ColorFilterOptions = ColorFilterOptions -- -- For rich text in cells, if the color specified appears in the -- cell at all, it shall be included in the filter. - , _cfoDxfId :: Maybe Int + , _cfoDxfId :: Maybe Int -- ^ Id of differential format record (dxf) in the Styles Part (see -- '_styleSheetDxfs') which expresses the color value to filter by. } deriving (Eq, Show, Generic) @@ -180,8 +180,8 @@ instance NFData ColorFilterOptions -- -- See 18.3.2.5 "dynamicFilter (Dynamic Filter)" (p. 1715) data DynFilterOptions = DynFilterOptions - { _dfoType :: DynFilterType - , _dfoVal :: Maybe Double + { _dfoType :: DynFilterType + , _dfoVal :: Maybe Double -- ^ A minimum numeric value for dynamic filter. , _dfoMaxVal :: Maybe Double -- ^ A maximum value for dynamic filter. @@ -277,7 +277,7 @@ instance NFData DynFilterType -- -- See 18.3.1.2 "autoFilter (AutoFilter Settings)" (p. 1596) data AutoFilter = AutoFilter - { _afRef :: Maybe CellRef + { _afRef :: Maybe CellRef , _afFilterColumns :: Map Int FilterColumn } deriving (Eq, Show, Generic) instance NFData AutoFilter @@ -490,22 +490,22 @@ filterCriterionFromNode n cur = fromNode n instance FromAttrVal CustomFilterOperator where - fromAttrVal "equal" = readSuccess FltrEqual - fromAttrVal "greaterThan" = readSuccess FltrGreaterThan + fromAttrVal "equal" = readSuccess FltrEqual + fromAttrVal "greaterThan" = readSuccess FltrGreaterThan fromAttrVal "greaterThanOrEqual" = readSuccess FltrGreaterThanOrEqual - fromAttrVal "lessThan" = readSuccess FltrLessThan - fromAttrVal "lessThanOrEqual" = readSuccess FltrLessThanOrEqual - fromAttrVal "notEqual" = readSuccess FltrNotEqual - fromAttrVal t = invalidText "CustomFilterOperator" t + fromAttrVal "lessThan" = readSuccess FltrLessThan + fromAttrVal "lessThanOrEqual" = readSuccess FltrLessThanOrEqual + fromAttrVal "notEqual" = readSuccess FltrNotEqual + fromAttrVal t = invalidText "CustomFilterOperator" t instance FromAttrBs CustomFilterOperator where - fromAttrBs "equal" = return FltrEqual - fromAttrBs "greaterThan" = return FltrGreaterThan + fromAttrBs "equal" = return FltrEqual + fromAttrBs "greaterThan" = return FltrGreaterThan fromAttrBs "greaterThanOrEqual" = return FltrGreaterThanOrEqual - fromAttrBs "lessThan" = return FltrLessThan - fromAttrBs "lessThanOrEqual" = return FltrLessThanOrEqual - fromAttrBs "notEqual" = return FltrNotEqual - fromAttrBs x = unexpectedAttrBs "CustomFilterOperator" x + fromAttrBs "lessThan" = return FltrLessThan + fromAttrBs "lessThanOrEqual" = return FltrLessThanOrEqual + fromAttrBs "notEqual" = return FltrNotEqual + fromAttrBs x = unexpectedAttrBs "CustomFilterOperator" x instance FromAttrVal FilterByBlank where fromAttrVal = @@ -517,78 +517,78 @@ instance FromAttrBs FilterByBlank where instance FromAttrVal DynFilterType where fromAttrVal "aboveAverage" = readSuccess DynFilterAboveAverage fromAttrVal "belowAverage" = readSuccess DynFilterBelowAverage - fromAttrVal "lastMonth" = readSuccess DynFilterLastMonth - fromAttrVal "lastQuarter" = readSuccess DynFilterLastQuarter - fromAttrVal "lastWeek" = readSuccess DynFilterLastWeek - fromAttrVal "lastYear" = readSuccess DynFilterLastYear - fromAttrVal "M1" = readSuccess DynFilterM1 - fromAttrVal "M10" = readSuccess DynFilterM10 - fromAttrVal "M11" = readSuccess DynFilterM11 - fromAttrVal "M12" = readSuccess DynFilterM12 - fromAttrVal "M2" = readSuccess DynFilterM2 - fromAttrVal "M3" = readSuccess DynFilterM3 - fromAttrVal "M4" = readSuccess DynFilterM4 - fromAttrVal "M5" = readSuccess DynFilterM5 - fromAttrVal "M6" = readSuccess DynFilterM6 - fromAttrVal "M7" = readSuccess DynFilterM7 - fromAttrVal "M8" = readSuccess DynFilterM8 - fromAttrVal "M9" = readSuccess DynFilterM9 - fromAttrVal "nextMonth" = readSuccess DynFilterNextMonth - fromAttrVal "nextQuarter" = readSuccess DynFilterNextQuarter - fromAttrVal "nextWeek" = readSuccess DynFilterNextWeek - fromAttrVal "nextYear" = readSuccess DynFilterNextYear - fromAttrVal "null" = readSuccess DynFilterNull - fromAttrVal "Q1" = readSuccess DynFilterQ1 - fromAttrVal "Q2" = readSuccess DynFilterQ2 - fromAttrVal "Q3" = readSuccess DynFilterQ3 - fromAttrVal "Q4" = readSuccess DynFilterQ4 - fromAttrVal "thisMonth" = readSuccess DynFilterThisMonth - fromAttrVal "thisQuarter" = readSuccess DynFilterThisQuarter - fromAttrVal "thisWeek" = readSuccess DynFilterThisWeek - fromAttrVal "thisYear" = readSuccess DynFilterThisYear - fromAttrVal "today" = readSuccess DynFilterToday - fromAttrVal "tomorrow" = readSuccess DynFilterTomorrow - fromAttrVal "yearToDate" = readSuccess DynFilterYearToDate - fromAttrVal "yesterday" = readSuccess DynFilterYesterday - fromAttrVal t = invalidText "DynFilterType" t + fromAttrVal "lastMonth" = readSuccess DynFilterLastMonth + fromAttrVal "lastQuarter" = readSuccess DynFilterLastQuarter + fromAttrVal "lastWeek" = readSuccess DynFilterLastWeek + fromAttrVal "lastYear" = readSuccess DynFilterLastYear + fromAttrVal "M1" = readSuccess DynFilterM1 + fromAttrVal "M10" = readSuccess DynFilterM10 + fromAttrVal "M11" = readSuccess DynFilterM11 + fromAttrVal "M12" = readSuccess DynFilterM12 + fromAttrVal "M2" = readSuccess DynFilterM2 + fromAttrVal "M3" = readSuccess DynFilterM3 + fromAttrVal "M4" = readSuccess DynFilterM4 + fromAttrVal "M5" = readSuccess DynFilterM5 + fromAttrVal "M6" = readSuccess DynFilterM6 + fromAttrVal "M7" = readSuccess DynFilterM7 + fromAttrVal "M8" = readSuccess DynFilterM8 + fromAttrVal "M9" = readSuccess DynFilterM9 + fromAttrVal "nextMonth" = readSuccess DynFilterNextMonth + fromAttrVal "nextQuarter" = readSuccess DynFilterNextQuarter + fromAttrVal "nextWeek" = readSuccess DynFilterNextWeek + fromAttrVal "nextYear" = readSuccess DynFilterNextYear + fromAttrVal "null" = readSuccess DynFilterNull + fromAttrVal "Q1" = readSuccess DynFilterQ1 + fromAttrVal "Q2" = readSuccess DynFilterQ2 + fromAttrVal "Q3" = readSuccess DynFilterQ3 + fromAttrVal "Q4" = readSuccess DynFilterQ4 + fromAttrVal "thisMonth" = readSuccess DynFilterThisMonth + fromAttrVal "thisQuarter" = readSuccess DynFilterThisQuarter + fromAttrVal "thisWeek" = readSuccess DynFilterThisWeek + fromAttrVal "thisYear" = readSuccess DynFilterThisYear + fromAttrVal "today" = readSuccess DynFilterToday + fromAttrVal "tomorrow" = readSuccess DynFilterTomorrow + fromAttrVal "yearToDate" = readSuccess DynFilterYearToDate + fromAttrVal "yesterday" = readSuccess DynFilterYesterday + fromAttrVal t = invalidText "DynFilterType" t instance FromAttrBs DynFilterType where fromAttrBs "aboveAverage" = return DynFilterAboveAverage fromAttrBs "belowAverage" = return DynFilterBelowAverage - fromAttrBs "lastMonth" = return DynFilterLastMonth - fromAttrBs "lastQuarter" = return DynFilterLastQuarter - fromAttrBs "lastWeek" = return DynFilterLastWeek - fromAttrBs "lastYear" = return DynFilterLastYear - fromAttrBs "M1" = return DynFilterM1 - fromAttrBs "M10" = return DynFilterM10 - fromAttrBs "M11" = return DynFilterM11 - fromAttrBs "M12" = return DynFilterM12 - fromAttrBs "M2" = return DynFilterM2 - fromAttrBs "M3" = return DynFilterM3 - fromAttrBs "M4" = return DynFilterM4 - fromAttrBs "M5" = return DynFilterM5 - fromAttrBs "M6" = return DynFilterM6 - fromAttrBs "M7" = return DynFilterM7 - fromAttrBs "M8" = return DynFilterM8 - fromAttrBs "M9" = return DynFilterM9 - fromAttrBs "nextMonth" = return DynFilterNextMonth - fromAttrBs "nextQuarter" = return DynFilterNextQuarter - fromAttrBs "nextWeek" = return DynFilterNextWeek - fromAttrBs "nextYear" = return DynFilterNextYear - fromAttrBs "null" = return DynFilterNull - fromAttrBs "Q1" = return DynFilterQ1 - fromAttrBs "Q2" = return DynFilterQ2 - fromAttrBs "Q3" = return DynFilterQ3 - fromAttrBs "Q4" = return DynFilterQ4 - fromAttrBs "thisMonth" = return DynFilterThisMonth - fromAttrBs "thisQuarter" = return DynFilterThisQuarter - fromAttrBs "thisWeek" = return DynFilterThisWeek - fromAttrBs "thisYear" = return DynFilterThisYear - fromAttrBs "today" = return DynFilterToday - fromAttrBs "tomorrow" = return DynFilterTomorrow - fromAttrBs "yearToDate" = return DynFilterYearToDate - fromAttrBs "yesterday" = return DynFilterYesterday - fromAttrBs x = unexpectedAttrBs "DynFilterType" x + fromAttrBs "lastMonth" = return DynFilterLastMonth + fromAttrBs "lastQuarter" = return DynFilterLastQuarter + fromAttrBs "lastWeek" = return DynFilterLastWeek + fromAttrBs "lastYear" = return DynFilterLastYear + fromAttrBs "M1" = return DynFilterM1 + fromAttrBs "M10" = return DynFilterM10 + fromAttrBs "M11" = return DynFilterM11 + fromAttrBs "M12" = return DynFilterM12 + fromAttrBs "M2" = return DynFilterM2 + fromAttrBs "M3" = return DynFilterM3 + fromAttrBs "M4" = return DynFilterM4 + fromAttrBs "M5" = return DynFilterM5 + fromAttrBs "M6" = return DynFilterM6 + fromAttrBs "M7" = return DynFilterM7 + fromAttrBs "M8" = return DynFilterM8 + fromAttrBs "M9" = return DynFilterM9 + fromAttrBs "nextMonth" = return DynFilterNextMonth + fromAttrBs "nextQuarter" = return DynFilterNextQuarter + fromAttrBs "nextWeek" = return DynFilterNextWeek + fromAttrBs "nextYear" = return DynFilterNextYear + fromAttrBs "null" = return DynFilterNull + fromAttrBs "Q1" = return DynFilterQ1 + fromAttrBs "Q2" = return DynFilterQ2 + fromAttrBs "Q3" = return DynFilterQ3 + fromAttrBs "Q4" = return DynFilterQ4 + fromAttrBs "thisMonth" = return DynFilterThisMonth + fromAttrBs "thisQuarter" = return DynFilterThisQuarter + fromAttrBs "thisWeek" = return DynFilterThisWeek + fromAttrBs "thisYear" = return DynFilterThisYear + fromAttrBs "today" = return DynFilterToday + fromAttrBs "tomorrow" = return DynFilterTomorrow + fromAttrBs "yearToDate" = return DynFilterYearToDate + fromAttrBs "yesterday" = return DynFilterYesterday + fromAttrBs x = unexpectedAttrBs "DynFilterType" x {------------------------------------------------------------------------------- Rendering @@ -687,15 +687,15 @@ instance ToElement CustomFilter where leafElement nm ["operator" .= cfltOperator, "val" .= cfltValue] instance ToAttrVal CustomFilterOperator where - toAttrVal FltrEqual = "equal" - toAttrVal FltrGreaterThan = "greaterThan" + toAttrVal FltrEqual = "equal" + toAttrVal FltrGreaterThan = "greaterThan" toAttrVal FltrGreaterThanOrEqual = "greaterThanOrEqual" - toAttrVal FltrLessThan = "lessThan" - toAttrVal FltrLessThanOrEqual = "lessThanOrEqual" - toAttrVal FltrNotEqual = "notEqual" + toAttrVal FltrLessThan = "lessThan" + toAttrVal FltrLessThanOrEqual = "lessThanOrEqual" + toAttrVal FltrNotEqual = "notEqual" instance ToAttrVal FilterByBlank where - toAttrVal FilterByBlank = toAttrVal True + toAttrVal FilterByBlank = toAttrVal True toAttrVal DontFilterByBlank = toAttrVal False instance ToElement ColorFilterOptions where @@ -712,36 +712,36 @@ instance ToElement DynFilterOptions where instance ToAttrVal DynFilterType where toAttrVal DynFilterAboveAverage = "aboveAverage" toAttrVal DynFilterBelowAverage = "belowAverage" - toAttrVal DynFilterLastMonth = "lastMonth" - toAttrVal DynFilterLastQuarter = "lastQuarter" - toAttrVal DynFilterLastWeek = "lastWeek" - toAttrVal DynFilterLastYear = "lastYear" - toAttrVal DynFilterM1 = "M1" - toAttrVal DynFilterM10 = "M10" - toAttrVal DynFilterM11 = "M11" - toAttrVal DynFilterM12 = "M12" - toAttrVal DynFilterM2 = "M2" - toAttrVal DynFilterM3 = "M3" - toAttrVal DynFilterM4 = "M4" - toAttrVal DynFilterM5 = "M5" - toAttrVal DynFilterM6 = "M6" - toAttrVal DynFilterM7 = "M7" - toAttrVal DynFilterM8 = "M8" - toAttrVal DynFilterM9 = "M9" - toAttrVal DynFilterNextMonth = "nextMonth" - toAttrVal DynFilterNextQuarter = "nextQuarter" - toAttrVal DynFilterNextWeek = "nextWeek" - toAttrVal DynFilterNextYear = "nextYear" - toAttrVal DynFilterNull = "null" - toAttrVal DynFilterQ1 = "Q1" - toAttrVal DynFilterQ2 = "Q2" - toAttrVal DynFilterQ3 = "Q3" - toAttrVal DynFilterQ4 = "Q4" - toAttrVal DynFilterThisMonth = "thisMonth" - toAttrVal DynFilterThisQuarter = "thisQuarter" - toAttrVal DynFilterThisWeek = "thisWeek" - toAttrVal DynFilterThisYear = "thisYear" - toAttrVal DynFilterToday = "today" - toAttrVal DynFilterTomorrow = "tomorrow" - toAttrVal DynFilterYearToDate = "yearToDate" - toAttrVal DynFilterYesterday = "yesterday" + toAttrVal DynFilterLastMonth = "lastMonth" + toAttrVal DynFilterLastQuarter = "lastQuarter" + toAttrVal DynFilterLastWeek = "lastWeek" + toAttrVal DynFilterLastYear = "lastYear" + toAttrVal DynFilterM1 = "M1" + toAttrVal DynFilterM10 = "M10" + toAttrVal DynFilterM11 = "M11" + toAttrVal DynFilterM12 = "M12" + toAttrVal DynFilterM2 = "M2" + toAttrVal DynFilterM3 = "M3" + toAttrVal DynFilterM4 = "M4" + toAttrVal DynFilterM5 = "M5" + toAttrVal DynFilterM6 = "M6" + toAttrVal DynFilterM7 = "M7" + toAttrVal DynFilterM8 = "M8" + toAttrVal DynFilterM9 = "M9" + toAttrVal DynFilterNextMonth = "nextMonth" + toAttrVal DynFilterNextQuarter = "nextQuarter" + toAttrVal DynFilterNextWeek = "nextWeek" + toAttrVal DynFilterNextYear = "nextYear" + toAttrVal DynFilterNull = "null" + toAttrVal DynFilterQ1 = "Q1" + toAttrVal DynFilterQ2 = "Q2" + toAttrVal DynFilterQ3 = "Q3" + toAttrVal DynFilterQ4 = "Q4" + toAttrVal DynFilterThisMonth = "thisMonth" + toAttrVal DynFilterThisQuarter = "thisQuarter" + toAttrVal DynFilterThisWeek = "thisWeek" + toAttrVal DynFilterThisYear = "thisYear" + toAttrVal DynFilterToday = "today" + toAttrVal DynFilterTomorrow = "tomorrow" + toAttrVal DynFilterYearToDate = "yearToDate" + toAttrVal DynFilterYesterday = "yesterday" diff --git a/src/Codec/Xlsx/Types/Cell.hs b/src/Codec/Xlsx/Types/Cell.hs index 8279f773..6f2b935c 100644 --- a/src/Codec/Xlsx/Types/Cell.hs +++ b/src/Codec/Xlsx/Types/Cell.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types.Cell ( CellFormula(..) , FormulaExpression(..) @@ -48,10 +48,10 @@ import Codec.Xlsx.Writer.Internal -- -- See 18.3.1.40 "f (Formula)" (p. 1636) data CellFormula = CellFormula - { _cellfExpression :: FormulaExpression + { _cellfExpression :: FormulaExpression , _cellfAssignsToName :: Bool -- ^ Specifies that this formula assigns a value to a name. - , _cellfCalculate :: Bool + , _cellfCalculate :: Bool -- ^ Indicates that this formula needs to be recalculated -- the next time calculation is performed. -- [/Example/: This is always set on volatile functions, @@ -76,7 +76,7 @@ newtype SharedFormulaIndex = SharedFormulaIndex Int instance NFData SharedFormulaIndex data SharedFormulaOptions = SharedFormulaOptions - { _sfoRef :: CellRef + { _sfoRef :: CellRef , _sfoExpression :: Formula } deriving (Eq, Show, Generic) @@ -165,7 +165,7 @@ instance ToElement CellFormula where ] (formulaEl, fType) = case _cellfExpression of - NormalFormula f -> (toElement nm f, defaultFormulaType) + NormalFormula f -> (toElement nm f, defaultFormulaType) SharedFormula si -> (leafElement nm ["si" .= si], "shared") instance ToAttrVal SharedFormulaIndex where diff --git a/src/Codec/Xlsx/Types/Common.hs b/src/Codec/Xlsx/Types/Common.hs index 424b0aaa..7d05533a 100644 --- a/src/Codec/Xlsx/Types/Common.hs +++ b/src/Codec/Xlsx/Types/Common.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} module Codec.Xlsx.Types.Common ( CellRef(..) , Coord(..) @@ -63,15 +63,15 @@ import Control.Monad (forM, guard) import Data.Bifunctor (bimap) import qualified Data.ByteString as BS import Data.Char -import Data.Maybe (isJust, fromMaybe) import Data.Function ((&)) import Data.Ix (inRange) import qualified Data.Map as Map +import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Time.Calendar (Day, addDays, diffDays, fromGregorian) -import Data.Time.Clock (UTCTime(UTCTime), picosecondsToDiffTime) +import Data.Time.Clock (UTCTime (UTCTime), picosecondsToDiffTime) import Safe import Text.XML import Text.XML.Cursor @@ -80,13 +80,13 @@ import Codec.Xlsx.Parser.Internal import Codec.Xlsx.Types.RichText import Codec.Xlsx.Writer.Internal #ifdef USE_MICROLENS +import Data.Profunctor (dimap) +import Data.Profunctor.Choice import Lens.Micro -import Lens.Micro.Internal import Lens.Micro.GHC () -import Data.Profunctor.Choice -import Data.Profunctor(dimap) +import Lens.Micro.Internal #else -import Control.Lens(makePrisms) +import Control.Lens (makePrisms) #endif -- | convert column number (starting from 1) to its textual form (e.g. 3 -> \"C\") @@ -240,8 +240,8 @@ ignoreRefSheetName :: Text -> Maybe Text ignoreRefSheetName t = case T.split (== '!') t of [_, r] -> Just r - [r] -> Just r - _ -> Nothing + [r] -> Just r + _ -> Nothing -- | Render a single cell existing in another worksheet. -- This function always renders the sheet name single-quoted regardless the presence of spaces. @@ -345,7 +345,7 @@ data XlsxText = XlsxText Text instance NFData XlsxText xlsxTextToCellValue :: XlsxText -> CellValue -xlsxTextToCellValue (XlsxText txt) = CellText txt +xlsxTextToCellValue (XlsxText txt) = CellText txt xlsxTextToCellValue (XlsxRichText rich) = CellRich rich -- | A formula @@ -522,7 +522,7 @@ instance FromXenoNode XlsxText where Nothing -> case rs of [] -> Left $ "missing rich text subelements" - _ -> return $ XlsxRichText rs + _ -> return $ XlsxRichText rs instance FromAttrVal CellRef where fromAttrVal = fmap (first CellRef) . fromAttrVal @@ -558,23 +558,23 @@ instance FromAttrBs Formula where instance FromAttrVal ErrorType where fromAttrVal "#DIV/0!" = readSuccess ErrorDiv0 - fromAttrVal "#N/A" = readSuccess ErrorNA - fromAttrVal "#NAME?" = readSuccess ErrorName - fromAttrVal "#NULL!" = readSuccess ErrorNull - fromAttrVal "#NUM!" = readSuccess ErrorNum - fromAttrVal "#REF!" = readSuccess ErrorRef + fromAttrVal "#N/A" = readSuccess ErrorNA + fromAttrVal "#NAME?" = readSuccess ErrorName + fromAttrVal "#NULL!" = readSuccess ErrorNull + fromAttrVal "#NUM!" = readSuccess ErrorNum + fromAttrVal "#REF!" = readSuccess ErrorRef fromAttrVal "#VALUE!" = readSuccess ErrorValue - fromAttrVal t = invalidText "ErrorType" t + fromAttrVal t = invalidText "ErrorType" t instance FromAttrBs ErrorType where fromAttrBs "#DIV/0!" = return ErrorDiv0 - fromAttrBs "#N/A" = return ErrorNA - fromAttrBs "#NAME?" = return ErrorName - fromAttrBs "#NULL!" = return ErrorNull - fromAttrBs "#NUM!" = return ErrorNum - fromAttrBs "#REF!" = return ErrorRef + fromAttrBs "#N/A" = return ErrorNA + fromAttrBs "#NAME?" = return ErrorName + fromAttrBs "#NULL!" = return ErrorNull + fromAttrBs "#NUM!" = return ErrorNum + fromAttrBs "#REF!" = return ErrorRef fromAttrBs "#VALUE!" = return ErrorValue - fromAttrBs x = unexpectedAttrBs "ErrorType" x + fromAttrBs x = unexpectedAttrBs "ErrorType" x {------------------------------------------------------------------------------- Rendering @@ -603,12 +603,12 @@ instance ToElement Formula where toElement nm (Formula txt) = elementContent nm txt instance ToAttrVal ErrorType where - toAttrVal ErrorDiv0 = "#DIV/0!" - toAttrVal ErrorNA = "#N/A" - toAttrVal ErrorName = "#NAME?" - toAttrVal ErrorNull = "#NULL!" - toAttrVal ErrorNum = "#NUM!" - toAttrVal ErrorRef = "#REF!" + toAttrVal ErrorDiv0 = "#DIV/0!" + toAttrVal ErrorNA = "#N/A" + toAttrVal ErrorName = "#NAME?" + toAttrVal ErrorNull = "#NULL!" + toAttrVal ErrorNum = "#NUM!" + toAttrVal ErrorRef = "#REF!" toAttrVal ErrorValue = "#VALUE!" #ifdef USE_MICROLENS @@ -629,7 +629,7 @@ _CellText (\ x_a1ZQw -> case x_a1ZQw of CellText y1_a1ZQx -> Right y1_a1ZQx - _ -> Left x_a1ZQw) + _ -> Left x_a1ZQw) {-# INLINE _CellText #-} _CellDouble :: Prism' CellValue Double _CellDouble @@ -637,7 +637,7 @@ _CellDouble (\ x_a1ZQz -> case x_a1ZQz of CellDouble y1_a1ZQA -> Right y1_a1ZQA - _ -> Left x_a1ZQz) + _ -> Left x_a1ZQz) {-# INLINE _CellDouble #-} _CellBool :: Prism' CellValue Bool _CellBool @@ -645,7 +645,7 @@ _CellBool (\ x_a1ZQC -> case x_a1ZQC of CellBool y1_a1ZQD -> Right y1_a1ZQD - _ -> Left x_a1ZQC) + _ -> Left x_a1ZQC) {-# INLINE _CellBool #-} _CellRich :: Prism' CellValue [RichTextRun] _CellRich @@ -653,7 +653,7 @@ _CellRich (\ x_a1ZQF -> case x_a1ZQF of CellRich y1_a1ZQG -> Right y1_a1ZQG - _ -> Left x_a1ZQF) + _ -> Left x_a1ZQF) {-# INLINE _CellRich #-} _CellError :: Prism' CellValue ErrorType _CellError @@ -661,7 +661,7 @@ _CellError (\ x_a1ZQI -> case x_a1ZQI of CellError y1_a1ZQJ -> Right y1_a1ZQJ - _ -> Left x_a1ZQI) + _ -> Left x_a1ZQI) {-# INLINE _CellError #-} _XlsxText :: Prism' XlsxText Text @@ -670,7 +670,7 @@ _XlsxText (\ x_a1ZzV -> case x_a1ZzV of XlsxText y1_a1ZzW -> Right y1_a1ZzW - _ -> Left x_a1ZzV) + _ -> Left x_a1ZzV) {-# INLINE _XlsxText #-} _XlsxRichText :: Prism' XlsxText [RichTextRun] _XlsxRichText @@ -678,7 +678,7 @@ _XlsxRichText (\ x_a1ZzY -> case x_a1ZzY of XlsxRichText y1_a1ZzZ -> Right y1_a1ZzZ - _ -> Left x_a1ZzY) + _ -> Left x_a1ZzY) {-# INLINE _XlsxRichText #-} #else diff --git a/src/Codec/Xlsx/Types/ConditionalFormatting.hs b/src/Codec/Xlsx/Types/ConditionalFormatting.hs index 102ccc5c..5389b887 100644 --- a/src/Codec/Xlsx/Types/ConditionalFormatting.hs +++ b/src/Codec/Xlsx/Types/ConditionalFormatting.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types.ConditionalFormatting ( ConditionalFormatting , CfRule(..) @@ -272,11 +272,11 @@ instance NFData CfvType -- -- See 18.3.1.49 "iconSet (Icon Set)" (p. 1645) data IconSetOptions = IconSetOptions - { _isoIconSet :: IconSetType + { _isoIconSet :: IconSetType -- ^ icon set used, default value is 'IconSet3Trafficlights1' - , _isoValues :: [CfValue] + , _isoValues :: [CfValue] -- ^ values describing per icon ranges - , _isoReverse :: Bool + , _isoReverse :: Bool -- ^ reverses the default order of the icons in the specified icon set , _isoShowValue :: Bool -- ^ indicates whether to show the values of the cells on which this @@ -326,9 +326,9 @@ data DataBarOptions = DataBarOptions , _dboShowValue :: Bool -- ^ Indicates whether to show the values of the cells on which this -- data bar is applied. - , _dboMinimum :: MinCfValue - , _dboMaximum :: MaxCfValue - , _dboColor :: Color + , _dboMinimum :: MinCfValue + , _dboMaximum :: MaxCfValue + , _dboColor :: Color } deriving (Eq, Ord, Show, Generic) instance NFData DataBarOptions @@ -468,9 +468,9 @@ readCondition "top10" cur = do percent <- fromAttributeDef "percent" False cur rank <- fromAttribute "rank" cur case (bottom, percent) of - (True, True) -> return $ BottomNPercent rank - (True, False) -> return $ BottomNValues rank - (False, True) -> return $ TopNPercent rank + (True, True) -> return $ BottomNPercent rank + (True, False) -> return $ BottomNValues rank + (False, True) -> return $ TopNPercent rank (False, False) -> return $ TopNValues rank readCondition "uniqueValues" _ = return UniqueValues readCondition t _ = error $ "Unexpected conditional formatting type " ++ show t @@ -568,9 +568,9 @@ instance FromXenoNode CfRule where percent <- fromAttrDef "percent" False rank <- fromAttr "rank" case (bottom, percent) of - (True, True) -> return $ BottomNPercent rank - (True, False) -> return $ BottomNValues rank - (False, True) -> return $ TopNPercent rank + (True, True) -> return $ BottomNPercent rank + (True, False) -> return $ BottomNValues rank + (False, True) -> return $ TopNPercent rank (False, False) -> return $ TopNValues rank readConditionX "uniqueValues" = return UniqueValues readConditionX x = @@ -717,44 +717,44 @@ instance FromXenoNode IconSetOptions where return IconSetOptions {..} instance FromAttrVal IconSetType where - fromAttrVal "3Arrows" = readSuccess IconSet3Arrows - fromAttrVal "3ArrowsGray" = readSuccess IconSet3ArrowsGray - fromAttrVal "3Flags" = readSuccess IconSet3Flags - fromAttrVal "3Signs" = readSuccess IconSet3Signs - fromAttrVal "3Symbols" = readSuccess IconSet3Symbols - fromAttrVal "3Symbols2" = readSuccess IconSet3Symbols2 + fromAttrVal "3Arrows" = readSuccess IconSet3Arrows + fromAttrVal "3ArrowsGray" = readSuccess IconSet3ArrowsGray + fromAttrVal "3Flags" = readSuccess IconSet3Flags + fromAttrVal "3Signs" = readSuccess IconSet3Signs + fromAttrVal "3Symbols" = readSuccess IconSet3Symbols + fromAttrVal "3Symbols2" = readSuccess IconSet3Symbols2 fromAttrVal "3TrafficLights1" = readSuccess IconSet3TrafficLights1 fromAttrVal "3TrafficLights2" = readSuccess IconSet3TrafficLights2 - fromAttrVal "4Arrows" = readSuccess IconSet4Arrows - fromAttrVal "4ArrowsGray" = readSuccess IconSet4ArrowsGray - fromAttrVal "4Rating" = readSuccess IconSet4Rating - fromAttrVal "4RedToBlack" = readSuccess IconSet4RedToBlack - fromAttrVal "4TrafficLights" = readSuccess IconSet4TrafficLights - fromAttrVal "5Arrows" = readSuccess IconSet5Arrows - fromAttrVal "5ArrowsGray" = readSuccess IconSet5ArrowsGray - fromAttrVal "5Quarters" = readSuccess IconSet5Quarters - fromAttrVal "5Rating" = readSuccess IconSet5Rating - fromAttrVal t = invalidText "IconSetType" t + fromAttrVal "4Arrows" = readSuccess IconSet4Arrows + fromAttrVal "4ArrowsGray" = readSuccess IconSet4ArrowsGray + fromAttrVal "4Rating" = readSuccess IconSet4Rating + fromAttrVal "4RedToBlack" = readSuccess IconSet4RedToBlack + fromAttrVal "4TrafficLights" = readSuccess IconSet4TrafficLights + fromAttrVal "5Arrows" = readSuccess IconSet5Arrows + fromAttrVal "5ArrowsGray" = readSuccess IconSet5ArrowsGray + fromAttrVal "5Quarters" = readSuccess IconSet5Quarters + fromAttrVal "5Rating" = readSuccess IconSet5Rating + fromAttrVal t = invalidText "IconSetType" t instance FromAttrBs IconSetType where - fromAttrBs "3Arrows" = return IconSet3Arrows - fromAttrBs "3ArrowsGray" = return IconSet3ArrowsGray - fromAttrBs "3Flags" = return IconSet3Flags - fromAttrBs "3Signs" = return IconSet3Signs - fromAttrBs "3Symbols" = return IconSet3Symbols - fromAttrBs "3Symbols2" = return IconSet3Symbols2 + fromAttrBs "3Arrows" = return IconSet3Arrows + fromAttrBs "3ArrowsGray" = return IconSet3ArrowsGray + fromAttrBs "3Flags" = return IconSet3Flags + fromAttrBs "3Signs" = return IconSet3Signs + fromAttrBs "3Symbols" = return IconSet3Symbols + fromAttrBs "3Symbols2" = return IconSet3Symbols2 fromAttrBs "3TrafficLights1" = return IconSet3TrafficLights1 fromAttrBs "3TrafficLights2" = return IconSet3TrafficLights2 - fromAttrBs "4Arrows" = return IconSet4Arrows - fromAttrBs "4ArrowsGray" = return IconSet4ArrowsGray - fromAttrBs "4Rating" = return IconSet4Rating - fromAttrBs "4RedToBlack" = return IconSet4RedToBlack - fromAttrBs "4TrafficLights" = return IconSet4TrafficLights - fromAttrBs "5Arrows" = return IconSet5Arrows - fromAttrBs "5ArrowsGray" = return IconSet5ArrowsGray - fromAttrBs "5Quarters" = return IconSet5Quarters - fromAttrBs "5Rating" = return IconSet5Rating - fromAttrBs x = unexpectedAttrBs "IconSetType" x + fromAttrBs "4Arrows" = return IconSet4Arrows + fromAttrBs "4ArrowsGray" = return IconSet4ArrowsGray + fromAttrBs "4Rating" = return IconSet4Rating + fromAttrBs "4RedToBlack" = return IconSet4RedToBlack + fromAttrBs "4TrafficLights" = return IconSet4TrafficLights + fromAttrBs "5Arrows" = return IconSet5Arrows + fromAttrBs "5ArrowsGray" = return IconSet5ArrowsGray + fromAttrBs "5Quarters" = return IconSet5Quarters + fromAttrBs "5Rating" = return IconSet5Rating + fromAttrBs x = unexpectedAttrBs "IconSetType" x instance FromCursor DataBarOptions where fromCursor cur = do @@ -886,11 +886,11 @@ operatorExpressionData (OpNotContains f) = ("notContains", [formulaNode operatorExpressionData (OpNotEqual f) = ("notEqual", [formulaNode f]) instance ToElement MinCfValue where - toElement nm CfvMin = leafElement nm ["type" .= CfvtMin] + toElement nm CfvMin = leafElement nm ["type" .= CfvtMin] toElement nm (MinCfValue cfv) = toElement nm cfv instance ToElement MaxCfValue where - toElement nm CfvMax = leafElement nm ["type" .= CfvtMax] + toElement nm CfvMax = leafElement nm ["type" .= CfvtMax] toElement nm (MaxCfValue cfv) = toElement nm cfv instance ToElement CfValue where @@ -903,11 +903,11 @@ instance ToElement CfValue where leafElement nm ["type" .= CfvtFormula, "val" .= unFormula f] instance ToAttrVal CfvType where - toAttrVal CfvtNum = "num" - toAttrVal CfvtPercent = "percent" - toAttrVal CfvtMax = "max" - toAttrVal CfvtMin = "min" - toAttrVal CfvtFormula = "formula" + toAttrVal CfvtNum = "num" + toAttrVal CfvtPercent = "percent" + toAttrVal CfvtMax = "max" + toAttrVal CfvtMin = "min" + toAttrVal CfvtFormula = "formula" toAttrVal CfvtPercentile = "percentile" instance ToElement IconSetOptions where @@ -921,23 +921,23 @@ instance ToElement IconSetOptions where ] instance ToAttrVal IconSetType where - toAttrVal IconSet3Arrows = "3Arrows" - toAttrVal IconSet3ArrowsGray = "3ArrowsGray" - toAttrVal IconSet3Flags = "3Flags" - toAttrVal IconSet3Signs = "3Signs" - toAttrVal IconSet3Symbols = "3Symbols" - toAttrVal IconSet3Symbols2 = "3Symbols2" + toAttrVal IconSet3Arrows = "3Arrows" + toAttrVal IconSet3ArrowsGray = "3ArrowsGray" + toAttrVal IconSet3Flags = "3Flags" + toAttrVal IconSet3Signs = "3Signs" + toAttrVal IconSet3Symbols = "3Symbols" + toAttrVal IconSet3Symbols2 = "3Symbols2" toAttrVal IconSet3TrafficLights1 = "3TrafficLights1" toAttrVal IconSet3TrafficLights2 = "3TrafficLights2" - toAttrVal IconSet4Arrows = "4Arrows" - toAttrVal IconSet4ArrowsGray = "4ArrowsGray" - toAttrVal IconSet4Rating = "4Rating" - toAttrVal IconSet4RedToBlack = "4RedToBlack" - toAttrVal IconSet4TrafficLights = "4TrafficLights" - toAttrVal IconSet5Arrows = "5Arrows" - toAttrVal IconSet5ArrowsGray = "5ArrowsGray" - toAttrVal IconSet5Quarters = "5Quarters" - toAttrVal IconSet5Rating = "5Rating" + toAttrVal IconSet4Arrows = "4Arrows" + toAttrVal IconSet4ArrowsGray = "4ArrowsGray" + toAttrVal IconSet4Rating = "4Rating" + toAttrVal IconSet4RedToBlack = "4RedToBlack" + toAttrVal IconSet4TrafficLights = "4TrafficLights" + toAttrVal IconSet5Arrows = "5Arrows" + toAttrVal IconSet5ArrowsGray = "5ArrowsGray" + toAttrVal IconSet5Quarters = "5Quarters" + toAttrVal IconSet5Rating = "5Rating" instance ToElement DataBarOptions where toElement nm DataBarOptions {..} = elementList nm attrs elements diff --git a/src/Codec/Xlsx/Types/DataValidation.hs b/src/Codec/Xlsx/Types/DataValidation.hs index 8ebe6a88..90f14ddc 100644 --- a/src/Codec/Xlsx/Types/DataValidation.hs +++ b/src/Codec/Xlsx/Types/DataValidation.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types.DataValidation ( ValidationExpression(..) , ValidationType(..) @@ -38,7 +38,7 @@ import Lens.Micro.TH (makeLenses) #else import Control.Lens.TH (makeLenses) #endif -import Control.Monad ((>=>), guard) +import Control.Monad (guard, (>=>)) import Data.ByteString (ByteString) import Data.Char (isSpace) import Data.Default @@ -48,8 +48,8 @@ import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic) -import Text.XML (Element(..), Node(..)) -import Text.XML.Cursor (Cursor, ($/), element) +import Text.XML (Element (..), Node (..)) +import Text.XML.Cursor (Cursor, element, ($/)) import Codec.Xlsx.Parser.Internal import Codec.Xlsx.Types.Common @@ -220,12 +220,12 @@ readValidationType op ty cur = do -- | Attempt to obtain a plain list expression maybePlainValidationList :: ValidationType -> Maybe ValidationList maybePlainValidationList (ValidationTypeList (ListExpression le)) = Just le -maybePlainValidationList _ = Nothing +maybePlainValidationList _ = Nothing -- | Attempt to obtain a range expression maybeValidationRange :: ValidationType -> Maybe Range maybeValidationRange (ValidationTypeList (RangeExpression re)) = Just re -maybeValidationRange _ = Nothing +maybeValidationRange _ = Nothing readListFormulas :: Formula -> Maybe ListOrRangeExpression readListFormulas (Formula f) = readQuotedList f <|> readUnquotedCellRange f @@ -341,7 +341,7 @@ instance ToElement DataValidation where f = Formula $ case as of RangeExpression re -> unCellRef re - ListExpression le -> renderPlainList le + ListExpression le -> renderPlainList le in (Nothing, Just f, Nothing) viewValidationExpression :: ValidationExpression -> (Text, Formula, Maybe Formula) diff --git a/src/Codec/Xlsx/Types/Drawing.hs b/src/Codec/Xlsx/Types/Drawing.hs index 1452edf0..06752a6c 100644 --- a/src/Codec/Xlsx/Types/Drawing.hs +++ b/src/Codec/Xlsx/Types/Drawing.hs @@ -1,14 +1,14 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Types.Drawing where import Control.Arrow (first) @@ -84,16 +84,16 @@ data Anchoring instance NFData Anchoring data DrawingObject p g - = Picture { _picMacro :: Maybe Text - , _picPublished :: Bool - , _picNonVisual :: PicNonVisual - , _picBlipFill :: BlipFillProperties p + = Picture { _picMacro :: Maybe Text + , _picPublished :: Bool + , _picNonVisual :: PicNonVisual + , _picBlipFill :: BlipFillProperties p , _picShapeProperties :: ShapeProperties -- TODO: style } - | Graphic { _grNonVisual :: GraphNonVisual + | Graphic { _grNonVisual :: GraphNonVisual , _grChartSpace :: g - , _grTransform :: Transform2D} + , _grTransform :: Transform2D} -- TODO: sp, grpSp, graphicFrame, cxnSp, contentPart deriving (Eq, Show, Generic) instance (NFData p, NFData g) => NFData (DrawingObject p g) @@ -142,7 +142,7 @@ extractPictures dr = mapMaybe maybePictureInfo $ _xdrAnchors dr maybePictureInfo Anchor {..} = case _anchObject of Picture {..} -> (_anchAnchoring,) <$> _bfpImageInfo _picBlipFill - _ -> Nothing + _ -> Nothing -- | This element is used to set certain properties related to a drawing -- element on the client spreadsheet application. diff --git a/src/Codec/Xlsx/Types/Drawing/Chart.hs b/src/Codec/Xlsx/Types/Drawing/Chart.hs index 81d70dda..66155207 100644 --- a/src/Codec/Xlsx/Types/Drawing/Chart.hs +++ b/src/Codec/Xlsx/Types/Drawing/Chart.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types.Drawing.Chart where import GHC.Generics (Generic) @@ -28,10 +28,10 @@ import Codec.Xlsx.Writer.Internal -- TODO: title, autoTitleDeleted, pivotFmts -- view3D, floor, sideWall, backWall, showDLblsOverMax, extLst data ChartSpace = ChartSpace - { _chspTitle :: Maybe ChartTitle - , _chspCharts :: [Chart] - , _chspLegend :: Maybe Legend - , _chspPlotVisOnly :: Maybe Bool + { _chspTitle :: Maybe ChartTitle + , _chspCharts :: [Chart] + , _chspLegend :: Maybe Legend + , _chspPlotVisOnly :: Maybe Bool , _chspDispBlanksAs :: Maybe DispBlanksAs } deriving (Eq, Show, Generic) instance NFData ChartSpace @@ -91,23 +91,23 @@ instance NFData LegendPos -- surfaceChart, surface3DChart, bubbleChart data Chart = LineChart { _lnchGrouping :: ChartGrouping - , _lnchSeries :: [LineSeries] - , _lnchMarker :: Maybe Bool + , _lnchSeries :: [LineSeries] + , _lnchMarker :: Maybe Bool -- ^ specifies that the marker shall be shown - , _lnchSmooth :: Maybe Bool + , _lnchSmooth :: Maybe Bool -- ^ specifies the line connecting the points on the chart shall be -- smoothed using Catmull-Rom splines } | AreaChart { _archGrouping :: Maybe ChartGrouping - , _archSeries :: [AreaSeries] + , _archSeries :: [AreaSeries] } | BarChart { _brchDirection :: BarDirection - , _brchGrouping :: Maybe BarChartGrouping - , _brchSeries :: [BarSeries] + , _brchGrouping :: Maybe BarChartGrouping + , _brchSeries :: [BarSeries] } | PieChart { _pichSeries :: [PieSeries] } - | ScatterChart { _scchStyle :: ScatterStyle + | ScatterChart { _scchStyle :: ScatterStyle , _scchSeries :: [ScatterSeries] } deriving (Eq, Show, Generic) @@ -180,7 +180,7 @@ instance NFData ScatterStyle -- -- See 21.2.2.52 "dPt (Data Point)" (p. 3384) data DataPoint = DataPoint - { _dpMarker :: Maybe DataMarker + { _dpMarker :: Maybe DataMarker , _dpShapeProperties :: Maybe ShapeProperties } deriving (Eq, Show, Generic) instance NFData DataPoint @@ -190,7 +190,7 @@ instance NFData DataPoint -- -- See @EG_SerShared@ (p. 4063) data Series = Series - { _serTx :: Maybe Formula + { _serTx :: Maybe Formula -- ^ specifies text for a series name, without rich text formatting -- currently only reference formula is supported , _serShapeProperties :: Maybe ShapeProperties @@ -203,12 +203,12 @@ instance NFData Series -- -- See @CT_LineSer@ (p. 4064) data LineSeries = LineSeries - { _lnserShared :: Series - , _lnserMarker :: Maybe DataMarker + { _lnserShared :: Series + , _lnserMarker :: Maybe DataMarker , _lnserDataLblProps :: Maybe DataLblProps - , _lnserVal :: Maybe Formula + , _lnserVal :: Maybe Formula -- ^ currently only reference formula is supported - , _lnserSmooth :: Maybe Bool + , _lnserSmooth :: Maybe Bool } deriving (Eq, Show, Generic) instance NFData LineSeries @@ -218,9 +218,9 @@ instance NFData LineSeries -- -- See @CT_AreaSer@ (p. 4065) data AreaSeries = AreaSeries - { _arserShared :: Series + { _arserShared :: Series , _arserDataLblProps :: Maybe DataLblProps - , _arserVal :: Maybe Formula + , _arserVal :: Maybe Formula } deriving (Eq, Show, Generic) instance NFData AreaSeries @@ -231,9 +231,9 @@ instance NFData AreaSeries -- -- See @CT_BarSer@ (p. 4064) data BarSeries = BarSeries - { _brserShared :: Series + { _brserShared :: Series , _brserDataLblProps :: Maybe DataLblProps - , _brserVal :: Maybe Formula + , _brserVal :: Maybe Formula } deriving (Eq, Show, Generic) instance NFData BarSeries @@ -243,12 +243,12 @@ instance NFData BarSeries -- -- See @CT_PieSer@ (p. 4065) data PieSeries = PieSeries - { _piserShared :: Series - , _piserDataPoints :: [DataPoint] + { _piserShared :: Series + , _piserDataPoints :: [DataPoint] -- ^ normally you should set fill for chart datapoints to make them -- properly colored , _piserDataLblProps :: Maybe DataLblProps - , _piserVal :: Maybe Formula + , _piserVal :: Maybe Formula } deriving (Eq, Show, Generic) instance NFData PieSeries @@ -258,19 +258,19 @@ instance NFData PieSeries -- -- See @CT_ScatterSer@ (p. 4064) data ScatterSeries = ScatterSeries - { _scserShared :: Series - , _scserMarker :: Maybe DataMarker + { _scserShared :: Series + , _scserMarker :: Maybe DataMarker , _scserDataLblProps :: Maybe DataLblProps - , _scserXVal :: Maybe Formula - , _scserYVal :: Maybe Formula - , _scserSmooth :: Maybe Bool + , _scserXVal :: Maybe Formula + , _scserYVal :: Maybe Formula + , _scserSmooth :: Maybe Bool } deriving (Eq, Show, Generic) instance NFData ScatterSeries -- See @CT_Marker@ (p. 4061) data DataMarker = DataMarker { _dmrkSymbol :: Maybe DataMarkerSymbol - , _dmrkSize :: Maybe Int + , _dmrkSize :: Maybe Int -- ^ integer between 2 and 72, specifying a size in points } deriving (Eq, Show, Generic) instance NFData DataMarker @@ -299,10 +299,10 @@ instance NFData DataMarkerSymbol -- See 21.2.2.49 "dLbls (Data Labels)" (p. 3384) data DataLblProps = DataLblProps { _dlblShowLegendKey :: Maybe Bool - , _dlblShowVal :: Maybe Bool - , _dlblShowCatName :: Maybe Bool - , _dlblShowSerName :: Maybe Bool - , _dlblShowPercent :: Maybe Bool + , _dlblShowVal :: Maybe Bool + , _dlblShowCatName :: Maybe Bool + , _dlblShowSerName :: Maybe Bool + , _dlblShowPercent :: Maybe Bool } deriving (Eq, Show, Generic) instance NFData DataLblProps @@ -449,33 +449,33 @@ instance FromCursor DataPoint where return DataPoint {..} instance FromAttrVal DataMarkerSymbol where - fromAttrVal "circle" = readSuccess DataMarkerCircle - fromAttrVal "dash" = readSuccess DataMarkerDash - fromAttrVal "diamond" = readSuccess DataMarkerDiamond - fromAttrVal "dot" = readSuccess DataMarkerDot - fromAttrVal "none" = readSuccess DataMarkerNone - fromAttrVal "picture" = readSuccess DataMarkerPicture - fromAttrVal "plus" = readSuccess DataMarkerPlus - fromAttrVal "square" = readSuccess DataMarkerSquare - fromAttrVal "star" = readSuccess DataMarkerStar + fromAttrVal "circle" = readSuccess DataMarkerCircle + fromAttrVal "dash" = readSuccess DataMarkerDash + fromAttrVal "diamond" = readSuccess DataMarkerDiamond + fromAttrVal "dot" = readSuccess DataMarkerDot + fromAttrVal "none" = readSuccess DataMarkerNone + fromAttrVal "picture" = readSuccess DataMarkerPicture + fromAttrVal "plus" = readSuccess DataMarkerPlus + fromAttrVal "square" = readSuccess DataMarkerSquare + fromAttrVal "star" = readSuccess DataMarkerStar fromAttrVal "triangle" = readSuccess DataMarkerTriangle - fromAttrVal "x" = readSuccess DataMarkerX - fromAttrVal "auto" = readSuccess DataMarkerAuto - fromAttrVal t = invalidText "DataMarkerSymbol" t + fromAttrVal "x" = readSuccess DataMarkerX + fromAttrVal "auto" = readSuccess DataMarkerAuto + fromAttrVal t = invalidText "DataMarkerSymbol" t instance FromAttrVal BarDirection where fromAttrVal "bar" = readSuccess DirectionBar fromAttrVal "col" = readSuccess DirectionColumn - fromAttrVal t = invalidText "BarDirection" t + fromAttrVal t = invalidText "BarDirection" t instance FromAttrVal ScatterStyle where - fromAttrVal "none" = readSuccess ScatterNone - fromAttrVal "line" = readSuccess ScatterLine - fromAttrVal "lineMarker" = readSuccess ScatterLineMarker - fromAttrVal "marker" = readSuccess ScatterMarker - fromAttrVal "smooth" = readSuccess ScatterSmooth + fromAttrVal "none" = readSuccess ScatterNone + fromAttrVal "line" = readSuccess ScatterLine + fromAttrVal "lineMarker" = readSuccess ScatterLineMarker + fromAttrVal "marker" = readSuccess ScatterMarker + fromAttrVal "smooth" = readSuccess ScatterSmooth fromAttrVal "smoothMarker" = readSuccess ScatterSmoothMarker - fromAttrVal t = invalidText "ScatterStyle" t + fromAttrVal t = invalidText "ScatterStyle" t instance FromCursor DataLblProps where fromCursor cur = do @@ -488,16 +488,16 @@ instance FromCursor DataLblProps where instance FromAttrVal ChartGrouping where fromAttrVal "percentStacked" = readSuccess PercentStackedGrouping - fromAttrVal "standard" = readSuccess StandardGrouping - fromAttrVal "stacked" = readSuccess StackedGrouping - fromAttrVal t = invalidText "ChartGrouping" t + fromAttrVal "standard" = readSuccess StandardGrouping + fromAttrVal "stacked" = readSuccess StackedGrouping + fromAttrVal t = invalidText "ChartGrouping" t instance FromAttrVal BarChartGrouping where - fromAttrVal "clustered" = readSuccess BarClusteredGrouping + fromAttrVal "clustered" = readSuccess BarClusteredGrouping fromAttrVal "percentStacked" = readSuccess BarPercentStackedGrouping - fromAttrVal "standard" = readSuccess BarStandardGrouping - fromAttrVal "stacked" = readSuccess BarStackedGrouping - fromAttrVal t = invalidText "BarChartGrouping" t + fromAttrVal "standard" = readSuccess BarStandardGrouping + fromAttrVal "stacked" = readSuccess BarStackedGrouping + fromAttrVal t = invalidText "BarChartGrouping" t instance FromCursor ChartTitle where fromCursor cur = do @@ -512,18 +512,18 @@ instance FromCursor Legend where return Legend {..} instance FromAttrVal LegendPos where - fromAttrVal "b" = readSuccess LegendBottom - fromAttrVal "l" = readSuccess LegendLeft - fromAttrVal "r" = readSuccess LegendRight - fromAttrVal "t" = readSuccess LegendTop + fromAttrVal "b" = readSuccess LegendBottom + fromAttrVal "l" = readSuccess LegendLeft + fromAttrVal "r" = readSuccess LegendRight + fromAttrVal "t" = readSuccess LegendTop fromAttrVal "tr" = readSuccess LegendTopRight - fromAttrVal t = invalidText "LegendPos" t + fromAttrVal t = invalidText "LegendPos" t instance FromAttrVal DispBlanksAs where - fromAttrVal "gap" = readSuccess DispBlanksAsGap + fromAttrVal "gap" = readSuccess DispBlanksAsGap fromAttrVal "span" = readSuccess DispBlanksAsSpan fromAttrVal "zero" = readSuccess DispBlanksAsZero - fromAttrVal t = invalidText "DispBlanksAs" t + fromAttrVal t = invalidText "DispBlanksAs" t {------------------------------------------------------------------------------- Default instances @@ -661,25 +661,25 @@ chartToElements chart axId = instance ToAttrVal ChartGrouping where toAttrVal PercentStackedGrouping = "percentStacked" - toAttrVal StandardGrouping = "standard" - toAttrVal StackedGrouping = "stacked" + toAttrVal StandardGrouping = "standard" + toAttrVal StackedGrouping = "stacked" instance ToAttrVal BarChartGrouping where - toAttrVal BarClusteredGrouping = "clustered" + toAttrVal BarClusteredGrouping = "clustered" toAttrVal BarPercentStackedGrouping = "percentStacked" - toAttrVal BarStandardGrouping = "standard" - toAttrVal BarStackedGrouping = "stacked" + toAttrVal BarStandardGrouping = "standard" + toAttrVal BarStackedGrouping = "stacked" instance ToAttrVal BarDirection where - toAttrVal DirectionBar = "bar" + toAttrVal DirectionBar = "bar" toAttrVal DirectionColumn = "col" instance ToAttrVal ScatterStyle where - toAttrVal ScatterNone = "none" - toAttrVal ScatterLine = "line" - toAttrVal ScatterLineMarker = "lineMarker" - toAttrVal ScatterMarker = "marker" - toAttrVal ScatterSmooth = "smooth" + toAttrVal ScatterNone = "none" + toAttrVal ScatterLine = "line" + toAttrVal ScatterLineMarker = "lineMarker" + toAttrVal ScatterMarker = "marker" + toAttrVal ScatterSmooth = "smooth" toAttrVal ScatterSmoothMarker = "smoothMarker" instance ToElement LineSeries where @@ -718,18 +718,18 @@ instance ToElement DataMarker where ] instance ToAttrVal DataMarkerSymbol where - toAttrVal DataMarkerCircle = "circle" - toAttrVal DataMarkerDash = "dash" - toAttrVal DataMarkerDiamond = "diamond" - toAttrVal DataMarkerDot = "dot" - toAttrVal DataMarkerNone = "none" - toAttrVal DataMarkerPicture = "picture" - toAttrVal DataMarkerPlus = "plus" - toAttrVal DataMarkerSquare = "square" - toAttrVal DataMarkerStar = "star" + toAttrVal DataMarkerCircle = "circle" + toAttrVal DataMarkerDash = "dash" + toAttrVal DataMarkerDiamond = "diamond" + toAttrVal DataMarkerDot = "dot" + toAttrVal DataMarkerNone = "none" + toAttrVal DataMarkerPicture = "picture" + toAttrVal DataMarkerPlus = "plus" + toAttrVal DataMarkerSquare = "square" + toAttrVal DataMarkerStar = "star" toAttrVal DataMarkerTriangle = "triangle" - toAttrVal DataMarkerX = "x" - toAttrVal DataMarkerAuto = "auto" + toAttrVal DataMarkerX = "x" + toAttrVal DataMarkerAuto = "auto" instance ToElement DataLblProps where toElement nm DataLblProps {..} = elementListSimple nm elements @@ -820,9 +820,9 @@ instance ToAttrVal DispBlanksAs where instance ToAttrVal TickMark where toAttrVal TickMarkCross = "cross" - toAttrVal TickMarkIn = "in" - toAttrVal TickMarkNone = "none" - toAttrVal TickMarkOut = "out" + toAttrVal TickMarkIn = "in" + toAttrVal TickMarkNone = "none" + toAttrVal TickMarkOut = "out" -- | Add chart namespace to name c_ :: Text -> Name diff --git a/src/Codec/Xlsx/Types/Drawing/Common.hs b/src/Codec/Xlsx/Types/Drawing/Common.hs index caea17ca..3fc71bd8 100644 --- a/src/Codec/Xlsx/Types/Drawing/Common.hs +++ b/src/Codec/Xlsx/Types/Drawing/Common.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types.Drawing.Common where import GHC.Generics (Generic) @@ -13,9 +13,9 @@ import Lens.Micro.TH (makeLenses) #else import Control.Lens.TH #endif +import Control.DeepSeq (NFData) import Control.Monad (join) import Control.Monad.Fail (MonadFail) -import Control.DeepSeq (NFData) import Data.Default import Data.Maybe (catMaybes, listToMaybe) import Data.Monoid ((<>)) @@ -44,25 +44,25 @@ instance NFData Angle -- -- See @CT_TextBody@ (p. 4034) data TextBody = TextBody - { _txbdRotation :: Angle + { _txbdRotation :: Angle -- ^ Specifies the rotation that is being applied to the text within the bounding box. , _txbdSpcFirstLastPara :: Bool -- ^ Specifies whether the before and after paragraph spacing defined by the user is -- to be respected. - , _txbdVertOverflow :: TextVertOverflow + , _txbdVertOverflow :: TextVertOverflow -- ^ Determines whether the text can flow out of the bounding box vertically. - , _txbdVertical :: TextVertical + , _txbdVertical :: TextVertical -- ^ Determines if the text within the given text body should be displayed vertically. - , _txbdWrap :: TextWrap + , _txbdWrap :: TextWrap -- ^ Specifies the wrapping options to be used for this text body. - , _txbdAnchor :: TextAnchoring + , _txbdAnchor :: TextAnchoring -- ^ Specifies the anchoring position of the txBody within the shape. - , _txbdAnchorCenter :: Bool + , _txbdAnchorCenter :: Bool -- ^ Specifies the centering of the text box. The way it works fundamentally is -- to determine the smallest possible "bounds box" for the text and then to center -- that "bounds box" accordingly. This is different than paragraph alignment, which -- aligns the text within the "bounds box" for the text. - , _txbdParagraphs :: [TextParagraph] + , _txbdParagraphs :: [TextParagraph] -- ^ Paragraphs of text within the containing text body } deriving (Eq, Show, Generic) instance NFData TextBody @@ -154,7 +154,7 @@ instance NFData TextAnchoring -- See 21.1.2.2.6 "p (Text Paragraphs)" (p. 3211) data TextParagraph = TextParagraph { _txpaDefCharProps :: Maybe TextCharacterProperties - , _txpaRuns :: [TextRun] + , _txpaRuns :: [TextRun] } deriving (Eq, Show, Generic) instance NFData TextParagraph @@ -168,8 +168,8 @@ instance NFData TextParagraph -- -- See @CT_TextCharacterProperties@ (p. 4039) data TextCharacterProperties = TextCharacterProperties - { _txchBold :: Bool - , _txchItalic :: Bool + { _txchBold :: Bool + , _txchItalic :: Bool , _txchUnderline :: Bool } deriving (Eq, Show, Generic) instance NFData TextCharacterProperties @@ -179,7 +179,7 @@ instance NFData TextCharacterProperties -- TODO: br, fld data TextRun = RegularRun { _txrCharProps :: Maybe TextCharacterProperties - , _txrText :: Text + , _txrText :: Text } deriving (Eq, Show, Generic) instance NFData TextRun @@ -242,15 +242,15 @@ cm2emu cm = 360000 * cm -- See 20.1.7.6 "xfrm (2D Transform for Individual Objects)" (p. 2849) data Transform2D = Transform2D - { _trRot :: Angle + { _trRot :: Angle -- ^ Specifies the rotation of the Graphic Frame. - , _trFlipH :: Bool + , _trFlipH :: Bool -- ^ Specifies a horizontal flip. When true, this attribute defines -- that the shape is flipped horizontally about the center of its bounding box. - , _trFlipV :: Bool + , _trFlipV :: Bool -- ^ Specifies a vertical flip. When true, this attribute defines -- that the shape is flipped vetically about the center of its bounding box. - , _trOffset :: Maybe Point2D + , _trOffset :: Maybe Point2D -- ^ See 20.1.7.4 "off (Offset)" (p. 2847) , _trExtents :: Maybe PositiveSize2D -- ^ See 20.1.7.3 "ext (Extents)" (p. 2846) or @@ -268,10 +268,10 @@ instance NFData Geometry -- See 20.1.2.2.35 "spPr (Shape Properties)" (p. 2751) data ShapeProperties = ShapeProperties - { _spXfrm :: Maybe Transform2D + { _spXfrm :: Maybe Transform2D , _spGeometry :: Maybe Geometry - , _spFill :: Maybe FillProperties - , _spOutline :: Maybe LineProperties + , _spFill :: Maybe FillProperties + , _spOutline :: Maybe LineProperties -- TODO: bwMode, a_EG_EffectProperties, scene3d, sp3d, extLst } deriving (Eq, Show, Generic) instance NFData ShapeProperties @@ -284,7 +284,7 @@ instance NFData ShapeProperties -- -- See 20.1.2.2.24 "ln (Outline)" (p. 2744) data LineProperties = LineProperties - { _lnFill :: Maybe FillProperties + { _lnFill :: Maybe FillProperties , _lnWidth :: Int -- ^ Specifies the width to be used for the underline stroke. The -- value is in EMU, is greater of equal to 0 and maximum value is @@ -379,32 +379,32 @@ instance FromAttrVal Angle where instance FromAttrVal TextVertOverflow where fromAttrVal "overflow" = readSuccess TextVertOverflow fromAttrVal "ellipsis" = readSuccess TextVertOverflowEllipsis - fromAttrVal "clip" = readSuccess TextVertOverflowClip - fromAttrVal t = invalidText "TextVertOverflow" t + fromAttrVal "clip" = readSuccess TextVertOverflowClip + fromAttrVal t = invalidText "TextVertOverflow" t instance FromAttrVal TextVertical where - fromAttrVal "horz" = readSuccess TextVerticalHorz - fromAttrVal "vert" = readSuccess TextVertical - fromAttrVal "vert270" = readSuccess TextVertical270 - fromAttrVal "wordArtVert" = readSuccess TextVerticalWordArt - fromAttrVal "eaVert" = readSuccess TextVerticalEA - fromAttrVal "mongolianVert" = readSuccess TextVerticalMongolian + fromAttrVal "horz" = readSuccess TextVerticalHorz + fromAttrVal "vert" = readSuccess TextVertical + fromAttrVal "vert270" = readSuccess TextVertical270 + fromAttrVal "wordArtVert" = readSuccess TextVerticalWordArt + fromAttrVal "eaVert" = readSuccess TextVerticalEA + fromAttrVal "mongolianVert" = readSuccess TextVerticalMongolian fromAttrVal "wordArtVertRtl" = readSuccess TextVerticalWordArtRtl - fromAttrVal t = invalidText "TextVertical" t + fromAttrVal t = invalidText "TextVertical" t instance FromAttrVal TextWrap where - fromAttrVal "none" = readSuccess TextWrapNone + fromAttrVal "none" = readSuccess TextWrapNone fromAttrVal "square" = readSuccess TextWrapSquare - fromAttrVal t = invalidText "TextWrap" t + fromAttrVal t = invalidText "TextWrap" t -- See 20.1.10.59 "ST_TextAnchoringType (Text Anchoring Types)" (p. 3058) instance FromAttrVal TextAnchoring where - fromAttrVal "t" = readSuccess TextAnchoringTop - fromAttrVal "ctr" = readSuccess TextAnchoringCenter - fromAttrVal "b" = readSuccess TextAnchoringBottom + fromAttrVal "t" = readSuccess TextAnchoringTop + fromAttrVal "ctr" = readSuccess TextAnchoringCenter + fromAttrVal "b" = readSuccess TextAnchoringBottom fromAttrVal "just" = readSuccess TextAnchoringJustified fromAttrVal "dist" = readSuccess TextAnchoringDistributed - fromAttrVal t = invalidText "TextAnchoring" t + fromAttrVal t = invalidText "TextAnchoring" t instance FromCursor ShapeProperties where fromCursor cur = do @@ -508,7 +508,7 @@ instance ToElement TextParagraph where elements = case _txpaDefCharProps of Just props -> (defRPr props) : runs - Nothing -> runs + Nothing -> runs defRPr props = elementListSimple (a_ "pPr") [toElement (a_ "defRPr") props] runs = map (toElement (a_ "r")) _txpaRuns @@ -528,29 +528,29 @@ instance ToElement TextRun where ] instance ToAttrVal TextVertOverflow where - toAttrVal TextVertOverflow = "overflow" + toAttrVal TextVertOverflow = "overflow" toAttrVal TextVertOverflowEllipsis = "ellipsis" - toAttrVal TextVertOverflowClip = "clip" + toAttrVal TextVertOverflowClip = "clip" instance ToAttrVal TextVertical where - toAttrVal TextVerticalHorz = "horz" - toAttrVal TextVertical = "vert" - toAttrVal TextVertical270 = "vert270" - toAttrVal TextVerticalWordArt = "wordArtVert" - toAttrVal TextVerticalEA = "eaVert" - toAttrVal TextVerticalMongolian = "mongolianVert" + toAttrVal TextVerticalHorz = "horz" + toAttrVal TextVertical = "vert" + toAttrVal TextVertical270 = "vert270" + toAttrVal TextVerticalWordArt = "wordArtVert" + toAttrVal TextVerticalEA = "eaVert" + toAttrVal TextVerticalMongolian = "mongolianVert" toAttrVal TextVerticalWordArtRtl = "wordArtVertRtl" instance ToAttrVal TextWrap where - toAttrVal TextWrapNone = "none" + toAttrVal TextWrapNone = "none" toAttrVal TextWrapSquare = "square" -- See 20.1.10.59 "ST_TextAnchoringType (Text Anchoring Types)" (p. 3058) instance ToAttrVal TextAnchoring where - toAttrVal TextAnchoringTop = "t" - toAttrVal TextAnchoringCenter = "ctr" - toAttrVal TextAnchoringBottom = "b" - toAttrVal TextAnchoringJustified = "just" + toAttrVal TextAnchoringTop = "t" + toAttrVal TextAnchoringCenter = "ctr" + toAttrVal TextAnchoringBottom = "b" + toAttrVal TextAnchoringJustified = "just" toAttrVal TextAnchoringDistributed = "dist" instance ToAttrVal Angle where diff --git a/src/Codec/Xlsx/Types/Internal.hs b/src/Codec/Xlsx/Types/Internal.hs index e76bac9d..deb16aef 100644 --- a/src/Codec/Xlsx/Types/Internal.hs +++ b/src/Codec/Xlsx/Types/Internal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module Codec.Xlsx.Types.Internal where diff --git a/src/Codec/Xlsx/Types/Internal/CfPair.hs b/src/Codec/Xlsx/Types/Internal/CfPair.hs index 2e0a00bb..d1743d8d 100644 --- a/src/Codec/Xlsx/Types/Internal/CfPair.hs +++ b/src/Codec/Xlsx/Types/Internal/CfPair.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Types.Internal.CfPair where import GHC.Generics (Generic) diff --git a/src/Codec/Xlsx/Types/Internal/CommentTable.hs b/src/Codec/Xlsx/Types/Internal/CommentTable.hs index d537d302..ec3f1e2a 100644 --- a/src/Codec/Xlsx/Types/Internal/CommentTable.hs +++ b/src/Codec/Xlsx/Types/Internal/CommentTable.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Types.Internal.CommentTable where import Data.ByteString.Lazy (ByteString) diff --git a/src/Codec/Xlsx/Types/Internal/ContentTypes.hs b/src/Codec/Xlsx/Types/Internal/ContentTypes.hs index c805c949..b661c352 100644 --- a/src/Codec/Xlsx/Types/Internal/ContentTypes.hs +++ b/src/Codec/Xlsx/Types/Internal/ContentTypes.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Types.Internal.ContentTypes where import Control.Arrow diff --git a/src/Codec/Xlsx/Types/Internal/CustomProperties.hs b/src/Codec/Xlsx/Types/Internal/CustomProperties.hs index 6f8988d7..2178a035 100644 --- a/src/Codec/Xlsx/Types/Internal/CustomProperties.hs +++ b/src/Codec/Xlsx/Types/Internal/CustomProperties.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Types.Internal.CustomProperties where import Data.Map (Map) diff --git a/src/Codec/Xlsx/Types/Internal/DvPair.hs b/src/Codec/Xlsx/Types/Internal/DvPair.hs index 15e99975..99a20178 100644 --- a/src/Codec/Xlsx/Types/Internal/DvPair.hs +++ b/src/Codec/Xlsx/Types/Internal/DvPair.hs @@ -1,10 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Types.Internal.DvPair where import qualified Data.Map as M import GHC.Generics (Generic) -import Text.XML (Element(..)) +import Text.XML (Element (..)) import Codec.Xlsx.Parser.Internal import Codec.Xlsx.Types.Common diff --git a/src/Codec/Xlsx/Types/Internal/FormulaData.hs b/src/Codec/Xlsx/Types/Internal/FormulaData.hs index f55c5841..98413c72 100644 --- a/src/Codec/Xlsx/Types/Internal/FormulaData.hs +++ b/src/Codec/Xlsx/Types/Internal/FormulaData.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards #-} module Codec.Xlsx.Types.Internal.FormulaData where import Data.Monoid ((<>)) @@ -14,7 +14,7 @@ import Codec.Xlsx.Types.Common data FormulaData = FormulaData { frmdFormula :: CellFormula - , frmdShared :: Maybe (SharedFormulaIndex, SharedFormulaOptions) + , frmdShared :: Maybe (SharedFormulaIndex, SharedFormulaOptions) } deriving Generic defaultFormulaType :: Text diff --git a/src/Codec/Xlsx/Types/Internal/Relationships.hs b/src/Codec/Xlsx/Types/Internal/Relationships.hs index c3fd4e16..c0bf7f64 100644 --- a/src/Codec/Xlsx/Types/Internal/Relationships.hs +++ b/src/Codec/Xlsx/Types/Internal/Relationships.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Types.Internal.Relationships where import Data.List (find) diff --git a/src/Codec/Xlsx/Types/Internal/SharedStringTable.hs b/src/Codec/Xlsx/Types/Internal/SharedStringTable.hs index 26ea2041..c10ae476 100644 --- a/src/Codec/Xlsx/Types/Internal/SharedStringTable.hs +++ b/src/Codec/Xlsx/Types/Internal/SharedStringTable.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Types.Internal.SharedStringTable ( -- * Main types SharedStringTable(..) diff --git a/src/Codec/Xlsx/Types/PageSetup.hs b/src/Codec/Xlsx/Types/PageSetup.hs index 696824f3..da9680ea 100644 --- a/src/Codec/Xlsx/Types/PageSetup.hs +++ b/src/Codec/Xlsx/Types/PageSetup.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types.PageSetup ( -- * Main types PageSetup(..) @@ -48,8 +48,8 @@ import Data.Text (Text) import GHC.Generics (Generic) import Text.XML -import Codec.Xlsx.Writer.Internal import Codec.Xlsx.Parser.Internal +import Codec.Xlsx.Writer.Internal {------------------------------------------------------------------------------- Main types @@ -57,45 +57,45 @@ import Codec.Xlsx.Parser.Internal data PageSetup = PageSetup { -- | Print black and white. - _pageSetupBlackAndWhite :: Maybe Bool + _pageSetupBlackAndWhite :: Maybe Bool -- | This attribute specifies how to print cell comments. - , _pageSetupCellComments :: Maybe CellComments + , _pageSetupCellComments :: Maybe CellComments -- | Number of copies to print. - , _pageSetupCopies :: Maybe Int + , _pageSetupCopies :: Maybe Int -- | Print without graphics. - , _pageSetupDraft :: Maybe Bool + , _pageSetupDraft :: Maybe Bool -- | Specifies how to print cell values for cells with errors. - , _pageSetupErrors :: Maybe PrintErrors + , _pageSetupErrors :: Maybe PrintErrors -- | Page number for first printed page. If no value is specified, then -- 'automatic' is assumed. - , _pageSetupFirstPageNumber :: Maybe Int + , _pageSetupFirstPageNumber :: Maybe Int -- | Number of vertical pages to fit on. - , _pageSetupFitToHeight :: Maybe Int + , _pageSetupFitToHeight :: Maybe Int -- | Number of horizontal pages to fit on. - , _pageSetupFitToWidth :: Maybe Int + , _pageSetupFitToWidth :: Maybe Int -- | Horizontal print resolution of the device. - , _pageSetupHorizontalDpi :: Maybe Int + , _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 + , _pageSetupId :: Maybe Text -- | Orientation of the page. - , _pageSetupOrientation :: Maybe Orientation + , _pageSetupOrientation :: Maybe Orientation -- | Order of printed pages - , _pageSetupPageOrder :: Maybe PageOrder + , _pageSetupPageOrder :: Maybe PageOrder -- | Height of custom paper as a number followed by a unit identifier. -- @@ -103,13 +103,13 @@ data PageSetup = PageSetup { -- Examples: @"297mm"@, @"11in"@. -- -- See 22.9.2.12 "ST_PositiveUniversalMeasure (Positive Universal Measurement)" (p. 3792) - , _pageSetupPaperHeight :: Maybe Text + , _pageSetupPaperHeight :: Maybe Text -- | Pager size -- -- When paperHeight, paperWidth, and paperUnits are specified, paperSize -- should be ignored. - , _pageSetupPaperSize :: Maybe PaperSize + , _pageSetupPaperSize :: Maybe PaperSize -- | Width of custom paper as a number followed by a unit identifier -- @@ -117,14 +117,14 @@ data PageSetup = PageSetup { -- -- When paperHeight and paperWidth are specified, paperSize shall be -- ignored. - , _pageSetupPaperWidth :: Maybe Text + , _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 + , _pageSetupScale :: Maybe Int -- | Use '_pageSetupFirstPageNumber' value for first page number, and do -- not auto number the pages. @@ -139,7 +139,7 @@ data PageSetup = PageSetup { , _pageSetupUsePrinterDefaults :: Maybe Bool -- | Vertical print resolution of the device. - , _pageSetupVerticalDpi :: Maybe Int + , _pageSetupVerticalDpi :: Maybe Int } deriving (Eq, Ord, Show, Generic) instance NFData PageSetup diff --git a/src/Codec/Xlsx/Types/PivotTable.hs b/src/Codec/Xlsx/Types/PivotTable.hs index 310ec16d..a2bd15dd 100644 --- a/src/Codec/Xlsx/Types/PivotTable.hs +++ b/src/Codec/Xlsx/Types/PivotTable.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} module Codec.Xlsx.Types.PivotTable ( PivotTable(..) , PivotFieldName(..) @@ -16,31 +16,31 @@ import Control.DeepSeq (NFData) import Data.Text (Text) import GHC.Generics (Generic) -import Codec.Xlsx.Types.Common import Codec.Xlsx.Parser.Internal +import Codec.Xlsx.Types.Common import Codec.Xlsx.Writer.Internal data PivotTable = PivotTable - { _pvtName :: Text - , _pvtDataCaption :: Text - , _pvtRowFields :: [PositionedField] - , _pvtColumnFields :: [PositionedField] - , _pvtDataFields :: [DataField] - , _pvtFields :: [PivotFieldInfo] - , _pvtRowGrandTotals :: Bool + { _pvtName :: Text + , _pvtDataCaption :: Text + , _pvtRowFields :: [PositionedField] + , _pvtColumnFields :: [PositionedField] + , _pvtDataFields :: [DataField] + , _pvtFields :: [PivotFieldInfo] + , _pvtRowGrandTotals :: Bool , _pvtColumnGrandTotals :: Bool - , _pvtOutline :: Bool - , _pvtOutlineData :: Bool - , _pvtLocation :: CellRef - , _pvtSrcSheet :: Text - , _pvtSrcRef :: Range + , _pvtOutline :: Bool + , _pvtOutlineData :: Bool + , _pvtLocation :: CellRef + , _pvtSrcSheet :: Text + , _pvtSrcRef :: Range } deriving (Eq, Show, Generic) instance NFData PivotTable data PivotFieldInfo = PivotFieldInfo - { _pfiName :: Maybe PivotFieldName - , _pfiOutline :: Bool - , _pfiSortType :: FieldSortType + { _pfiName :: Maybe PivotFieldName + , _pfiOutline :: Bool + , _pfiSortType :: FieldSortType , _pfiHiddenItems :: [CellValue] } deriving (Eq, Show, Generic) instance NFData PivotFieldInfo @@ -67,8 +67,8 @@ data PositionedField instance NFData PositionedField data DataField = DataField - { _dfField :: PivotFieldName - , _dfName :: Text + { _dfField :: PivotFieldName + , _dfName :: Text , _dfFunction :: ConsolidateFunction } deriving (Eq, Show, Generic) instance NFData DataField @@ -116,24 +116,24 @@ instance NFData ConsolidateFunction -------------------------------------------------------------------------------} instance ToAttrVal ConsolidateFunction where - toAttrVal ConsolidateAverage = "average" - toAttrVal ConsolidateCount = "count" + toAttrVal ConsolidateAverage = "average" + toAttrVal ConsolidateCount = "count" toAttrVal ConsolidateCountNums = "countNums" - toAttrVal ConsolidateMaximum = "max" - toAttrVal ConsolidateMinimum = "min" - toAttrVal ConsolidateProduct = "product" - toAttrVal ConsolidateStdDev = "stdDev" - toAttrVal ConsolidateStdDevP = "stdDevp" - toAttrVal ConsolidateSum = "sum" - toAttrVal ConsolidateVariance = "var" - toAttrVal ConsolidateVarP = "varp" + toAttrVal ConsolidateMaximum = "max" + toAttrVal ConsolidateMinimum = "min" + toAttrVal ConsolidateProduct = "product" + toAttrVal ConsolidateStdDev = "stdDev" + toAttrVal ConsolidateStdDevP = "stdDevp" + toAttrVal ConsolidateSum = "sum" + toAttrVal ConsolidateVariance = "var" + toAttrVal ConsolidateVarP = "varp" instance ToAttrVal PivotFieldName where toAttrVal (PivotFieldName n) = toAttrVal n instance ToAttrVal FieldSortType where - toAttrVal FieldSortManual = "manual" - toAttrVal FieldSortAscending = "ascending" + toAttrVal FieldSortManual = "manual" + toAttrVal FieldSortAscending = "ascending" toAttrVal FieldSortDescending = "descending" {------------------------------------------------------------------------------- @@ -141,24 +141,24 @@ instance ToAttrVal FieldSortType where -------------------------------------------------------------------------------} instance FromAttrVal ConsolidateFunction where - fromAttrVal "average" = readSuccess ConsolidateAverage - fromAttrVal "count" = readSuccess ConsolidateCount + fromAttrVal "average" = readSuccess ConsolidateAverage + fromAttrVal "count" = readSuccess ConsolidateCount fromAttrVal "countNums" = readSuccess ConsolidateCountNums - fromAttrVal "max" = readSuccess ConsolidateMaximum - fromAttrVal "min" = readSuccess ConsolidateMinimum - fromAttrVal "product" = readSuccess ConsolidateProduct - fromAttrVal "stdDev" = readSuccess ConsolidateStdDev - fromAttrVal "stdDevp" = readSuccess ConsolidateStdDevP - fromAttrVal "sum" = readSuccess ConsolidateSum - fromAttrVal "var" = readSuccess ConsolidateVariance - fromAttrVal "varp" = readSuccess ConsolidateVarP - fromAttrVal t = invalidText "ConsolidateFunction" t + fromAttrVal "max" = readSuccess ConsolidateMaximum + fromAttrVal "min" = readSuccess ConsolidateMinimum + fromAttrVal "product" = readSuccess ConsolidateProduct + fromAttrVal "stdDev" = readSuccess ConsolidateStdDev + fromAttrVal "stdDevp" = readSuccess ConsolidateStdDevP + fromAttrVal "sum" = readSuccess ConsolidateSum + fromAttrVal "var" = readSuccess ConsolidateVariance + fromAttrVal "varp" = readSuccess ConsolidateVarP + fromAttrVal t = invalidText "ConsolidateFunction" t instance FromAttrVal PivotFieldName where fromAttrVal = fmap (first PivotFieldName) . fromAttrVal instance FromAttrVal FieldSortType where - fromAttrVal "manual" = readSuccess FieldSortManual - fromAttrVal "ascending" = readSuccess FieldSortAscending + fromAttrVal "manual" = readSuccess FieldSortManual + fromAttrVal "ascending" = readSuccess FieldSortAscending fromAttrVal "descending" = readSuccess FieldSortDescending - fromAttrVal t = invalidText "FieldSortType" t + fromAttrVal t = invalidText "FieldSortType" t diff --git a/src/Codec/Xlsx/Types/PivotTable/Internal.hs b/src/Codec/Xlsx/Types/PivotTable/Internal.hs index 7f6d8dae..f3b0c1e3 100644 --- a/src/Codec/Xlsx/Types/PivotTable/Internal.hs +++ b/src/Codec/Xlsx/Types/PivotTable/Internal.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} module Codec.Xlsx.Types.PivotTable.Internal ( CacheId(..) , CacheField(..) @@ -25,7 +25,7 @@ import Codec.Xlsx.Writer.Internal newtype CacheId = CacheId Int deriving (Eq, Generic) data CacheField = CacheField - { cfName :: PivotFieldName + { cfName :: PivotFieldName , cfItems :: [CellValue] } deriving (Eq, Show, Generic) @@ -96,7 +96,7 @@ instance ToElement CacheField where ] containsNumber = any isNumber cfItems isNumber (CellDouble _) = True - isNumber _ = False + isNumber _ = False containsString = any isString cfItems isString (CellText _) = True - isString _ = False + isString _ = False diff --git a/src/Codec/Xlsx/Types/Protection.hs b/src/Codec/Xlsx/Types/Protection.hs index 2ecce835..b6162eab 100644 --- a/src/Codec/Xlsx/Types/Protection.hs +++ b/src/Codec/Xlsx/Types/Protection.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types.Protection ( SheetProtection(..) , fullSheetProtection @@ -11,21 +11,21 @@ module Codec.Xlsx.Types.Protection , legacyPassword -- * Lenses , sprLegacyPassword - , sprSheet - , sprObjects - , sprScenarios - , sprFormatCells - , sprFormatColumns - , sprFormatRows - , sprInsertColumns - , sprInsertRows - , sprInsertHyperlinks - , sprDeleteColumns - , sprDeleteRows - , sprSelectLockedCells - , sprSort - , sprAutoFilter - , sprPivotTables + , sprSheet + , sprObjects + , sprScenarios + , sprFormatCells + , sprFormatColumns + , sprFormatRows + , sprInsertColumns + , sprInsertRows + , sprInsertHyperlinks + , sprDeleteColumns + , sprDeleteRows + , sprSelectLockedCells + , sprSort + , sprAutoFilter + , sprPivotTables , sprSelectUnlockedCells ) where @@ -83,57 +83,57 @@ legacyPassword = LegacyPassword . hex . legacyHash . map ord . T.unpack -- -- See 18.3.1.85 "sheetProtection (Sheet Protection Options)" (p. 1694) data SheetProtection = SheetProtection - { _sprLegacyPassword :: Maybe LegacyPassword + { _sprLegacyPassword :: Maybe LegacyPassword -- ^ Specifies the legacy hash of the password required for editing -- this worksheet. -- -- See Part 4, 15.3.1.6 "Additional attribute for sheetProtection -- element (Part 1, §18.3.1.85)" (p. 229) - , _sprSheet :: Bool + , _sprSheet :: Bool -- ^ the value of this attribute dictates whether the other -- attributes of 'SheetProtection' should be applied - , _sprAutoFilter :: Bool + , _sprAutoFilter :: Bool -- ^ AutoFilters should not be allowed to operate when the sheet -- is protected - , _sprDeleteColumns :: Bool + , _sprDeleteColumns :: Bool -- ^ deleting columns should not be allowed when the sheet is -- protected - , _sprDeleteRows :: Bool + , _sprDeleteRows :: Bool -- ^ deleting rows should not be allowed when the sheet is -- protected - , _sprFormatCells :: Bool + , _sprFormatCells :: Bool -- ^ formatting cells should not be allowed when the sheet is -- protected - , _sprFormatColumns :: Bool + , _sprFormatColumns :: Bool -- ^ formatting columns should not be allowed when the sheet is -- protected - , _sprFormatRows :: Bool + , _sprFormatRows :: Bool -- ^ formatting rows should not be allowed when the sheet is -- protected - , _sprInsertColumns :: Bool + , _sprInsertColumns :: Bool -- ^ inserting columns should not be allowed when the sheet is -- protected - , _sprInsertHyperlinks :: Bool + , _sprInsertHyperlinks :: Bool -- ^ inserting hyperlinks should not be allowed when the sheet is -- protected - , _sprInsertRows :: Bool + , _sprInsertRows :: Bool -- ^ inserting rows should not be allowed when the sheet is -- protected - , _sprObjects :: Bool + , _sprObjects :: Bool -- ^ editing of objects should not be allowed when the sheet is -- protected - , _sprPivotTables :: Bool + , _sprPivotTables :: Bool -- ^ PivotTables should not be allowed to operate when the sheet -- is protected - , _sprScenarios :: Bool + , _sprScenarios :: Bool -- ^ Scenarios should not be edited when the sheet is protected - , _sprSelectLockedCells :: Bool + , _sprSelectLockedCells :: Bool -- ^ selection of locked cells should not be allowed when the -- sheet is protected , _sprSelectUnlockedCells :: Bool -- ^ selection of unlocked cells should not be allowed when the -- sheet is protected - , _sprSort :: Bool + , _sprSort :: Bool -- ^ sorting should not be allowed when the sheet is protected } deriving (Eq, Show, Generic) instance NFData SheetProtection @@ -212,7 +212,7 @@ instance FromCursor SheetProtection where _sprScenarios <- fromAttributeDef "scenarios" False cur _sprSelectLockedCells <- fromAttributeDef "selectLockedCells" False cur _sprSelectUnlockedCells <- fromAttributeDef "selectUnlockedCells" False cur - _sprSort <- fromAttributeDef "sort" True cur + _sprSort <- fromAttributeDef "sort" True cur return SheetProtection {..} instance FromXenoNode SheetProtection where diff --git a/src/Codec/Xlsx/Types/RichText.hs b/src/Codec/Xlsx/Types/RichText.hs index 1a2ded13..da2daa4c 100644 --- a/src/Codec/Xlsx/Types/RichText.hs +++ b/src/Codec/Xlsx/Types/RichText.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types.RichText ( -- * Main types RichTextRun(..) @@ -37,14 +37,14 @@ import Lens.Micro.TH (makeLenses) #else import Control.Lens hiding (element) #endif -import Control.Monad import Control.DeepSeq (NFData) +import Control.Monad import Data.Default +import qualified Data.Map as Map 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 @@ -67,7 +67,7 @@ data RichTextRun = RichTextRun { -- an error when opening the file in Excel. -- -- Section 18.4.12, "t (Text)" (p. 1727) - , _richTextRunText :: Text + , _richTextRunText :: Text } deriving (Eq, Ord, Show, Generic) @@ -80,24 +80,24 @@ data RunProperties = RunProperties { -- | Displays characters in bold face font style. -- -- Section 18.8.2, "b (Bold)" (p. 1757) - _runPropertiesBold :: Maybe Bool + _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 + , _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 + , _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 + , _runPropertiesCondense :: Maybe Bool -- | This element specifies a compatibility setting used for previous -- spreadsheet applications, resulting in special word/character rendering @@ -105,7 +105,7 @@ data RunProperties = RunProperties { -- or stretches out the text. -- -- Section 18.8.17, "extend (Extend)" (p. 1766) - , _runPropertiesExtend :: Maybe Bool + , _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 @@ -113,25 +113,25 @@ data RunProperties = RunProperties { -- conflicting values. -- -- Section 18.8.18, "family (Font Family)" (p. 1766) - , _runPropertiesFontFamily :: Maybe FontFamily + , _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 + , _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 + , _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 + , _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 @@ -142,14 +142,14 @@ data RunProperties = RunProperties { -- for body and paragraph text. -- -- Section 18.8.35, "scheme (Scheme)" (p. 1794) - , _runPropertiesScheme :: Maybe FontScheme + , _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 + , _runPropertiesShadow :: Maybe Bool -- | This element draws a strikethrough line through the horizontal middle -- of the text. @@ -161,12 +161,12 @@ data RunProperties = RunProperties { -- and East Asian text. -- -- Section 18.4.11, "sz (Font Size)" (p. 1727) - , _runPropertiesSize :: Maybe Double + , _runPropertiesSize :: Maybe Double -- | This element represents the underline formatting style. -- -- Section 18.4.13, "u (Underline)" (p. 1728) - , _runPropertiesUnderline :: Maybe FontUnderline + , _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' @@ -174,7 +174,7 @@ data RunProperties = RunProperties { -- is available) accordingly. -- -- Section 18.4.14, "vertAlign (Vertical Alignment)" (p. 1728) - , _runPropertiesVertAlign :: Maybe FontVerticalAlignment + , _runPropertiesVertAlign :: Maybe FontVerticalAlignment } deriving (Eq, Ord, Show, Generic) diff --git a/src/Codec/Xlsx/Types/SheetViews.hs b/src/Codec/Xlsx/Types/SheetViews.hs index 063c5475..6e56e9eb 100644 --- a/src/Codec/Xlsx/Types/SheetViews.hs +++ b/src/Codec/Xlsx/Types/SheetViews.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Types.SheetViews ( -- * Structured type to construct 'SheetViews' SheetView(..) @@ -56,13 +56,13 @@ import Control.Lens (makeLenses) #endif import Control.DeepSeq (NFData) import Data.Default -import Data.Maybe (catMaybes, maybeToList, listToMaybe) +import qualified Data.Map as Map +import Data.Maybe (catMaybes, listToMaybe, maybeToList) import Text.XML import Text.XML.Cursor -import qualified Data.Map as Map -import Codec.Xlsx.Types.Common import Codec.Xlsx.Parser.Internal +import Codec.Xlsx.Types.Common import Codec.Xlsx.Writer.Internal {------------------------------------------------------------------------------- @@ -85,45 +85,45 @@ import Codec.Xlsx.Writer.Internal 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 + _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 + , _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 + , _sheetViewRightToLeft :: Maybe Bool -- | Flag indicating whether this sheet should display formulas. - , _sheetViewShowFormulas :: Maybe Bool + , _sheetViewShowFormulas :: Maybe Bool -- | Flag indicating whether this sheet should display gridlines. - , _sheetViewShowGridLines :: Maybe Bool + , _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 + , _sheetViewShowOutlineSymbols :: Maybe Bool -- | Flag indicating whether the sheet should display row and column headings. - , _sheetViewShowRowColHeaders :: Maybe Bool + , _sheetViewShowRowColHeaders :: Maybe Bool -- | Show the ruler in Page Layout View. - , _sheetViewShowRuler :: Maybe Bool + , _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 + , _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 + , _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 @@ -132,40 +132,40 @@ data SheetView = SheetView { -- -- Multiple sheets can be selected, but only one sheet shall be active at -- one time. - , _sheetViewTabSelected :: Maybe Bool + , _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 + , _sheetViewTopLeftCell :: Maybe CellRef -- | Indicates the view type. - , _sheetViewType :: Maybe SheetViewType + , _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 + , _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 + , _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 + , _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 + , _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 + , _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 @@ -173,12 +173,12 @@ data SheetView = SheetView { , _sheetViewZoomScaleSheetLayoutView :: Maybe Int -- | Worksheet view pane - , _sheetViewPane :: Maybe Pane + , _sheetViewPane :: Maybe Pane -- | Worksheet view selection -- -- Minimum of 0, maximum of 4 elements - , _sheetViewSelection :: [Selection] + , _sheetViewSelection :: [Selection] } deriving (Eq, Ord, Show, Generic) instance NFData SheetView @@ -188,7 +188,7 @@ instance NFData SheetView -- Section 18.3.1.78 "selection (Selection)" (p. 1864) data Selection = Selection { -- | Location of the active cell - _selectionActiveCell :: Maybe CellRef + _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 @@ -199,10 +199,10 @@ data Selection = Selection { , _selectionActiveCellId :: Maybe Int -- | The pane to which this selection belongs. - , _selectionPane :: Maybe PaneType + , _selectionPane :: Maybe PaneType -- | Range of the selection. Can be non-contiguous set of ranges. - , _selectionSqref :: Maybe SqRef + , _selectionSqref :: Maybe SqRef } deriving (Eq, Ord, Show, Generic) instance NFData Selection @@ -212,11 +212,11 @@ instance NFData Selection -- Section 18.3.1.66 "pane (View Pane)" (p. 1843) data Pane = Pane { -- | The pane that is active. - _paneActivePane :: Maybe PaneType + _paneActivePane :: Maybe PaneType -- | Indicates whether the pane has horizontal / vertical splits, and -- whether those splits are frozen. - , _paneState :: Maybe PaneState + , _paneState :: Maybe PaneState -- | Location of the top left visible cell in the bottom right pane (when in -- Left-To-Right mode). @@ -225,12 +225,12 @@ data Pane = Pane { -- | 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 + , _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 + , _paneYSplit :: Maybe Double } deriving (Eq, Ord, Show, Generic) instance NFData Pane diff --git a/src/Codec/Xlsx/Types/StyleSheet.hs b/src/Codec/Xlsx/Types/StyleSheet.hs index 812ac2b7..1be639f9 100644 --- a/src/Codec/Xlsx/Types/StyleSheet.hs +++ b/src/Codec/Xlsx/Types/StyleSheet.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} -- | Support for writing (but not reading) style sheets module Codec.Xlsx.Types.StyleSheet ( -- * The main two types @@ -649,7 +649,7 @@ type FormatCode = Text -- -- Section 18.8.30 "numFmt (Number Format)" (p. 1777) data NumFmt = NumFmt - { _numFmtId :: Int + { _numFmtId :: Int , _numFmtCode :: FormatCode } deriving (Eq, Ord, Show, Generic) diff --git a/src/Codec/Xlsx/Types/Table.hs b/src/Codec/Xlsx/Types/Table.hs index 6f524fe3..04a6a2bd 100644 --- a/src/Codec/Xlsx/Types/Table.hs +++ b/src/Codec/Xlsx/Types/Table.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types.Table where #ifdef USE_MICROLENS @@ -46,7 +46,7 @@ data Table = Table -- it, and it shall be unique amongst all other displayNames and -- definedNames in the workbook. The character lengths and -- restrictions are the same as for definedNames . - , tblName :: Maybe Text + , tblName :: Maybe Text -- ^ A string representing the name of the table that is used to -- reference the table programmatically through the spreadsheet -- applications object model. This string shall be unique per table @@ -55,13 +55,13 @@ data Table = Table -- table's 'tblDisplayName' . This name should also be kept in synch with -- the displayName when the displayName is updated in the UI by the -- spreadsheet user. - , tblRef :: CellRef + , tblRef :: CellRef -- ^ The range on the relevant sheet that the table occupies -- expressed using A1 style referencing. - , tblColumns :: [TableColumn] + , tblColumns :: [TableColumn] -- ^ columns of this table, specification requires any table to -- include at least 1 column - , tblAutoFilter :: Maybe AutoFilter + , tblAutoFilter :: Maybe AutoFilter } deriving (Eq, Show, Generic) instance NFData Table diff --git a/src/Codec/Xlsx/Types/Variant.hs b/src/Codec/Xlsx/Types/Variant.hs index 48d0cce0..9e3117b8 100644 --- a/src/Codec/Xlsx/Types/Variant.hs +++ b/src/Codec/Xlsx/Types/Variant.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Types.Variant where import Control.DeepSeq (NFData) diff --git a/src/Codec/Xlsx/Writer.hs b/src/Codec/Xlsx/Writer.hs index 1375184a..2ad6fb80 100644 --- a/src/Codec/Xlsx/Writer.hs +++ b/src/Codec/Xlsx/Writer.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} -- | This module provides a function for serializing structured `Xlsx` into lazy bytestring module Codec.Xlsx.Writer ( fromXlsx @@ -32,8 +32,7 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Time (UTCTime) import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime) -import Data.Time.Format (formatTime) -import Data.Time.Format (defaultTimeLocale) +import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Tuple.Extra (fst3, snd3, thd3) import GHC.Generics (Generic) import Safe @@ -43,12 +42,10 @@ import Codec.Xlsx.Types import Codec.Xlsx.Types.Cell (applySharedFormulaOpts) import Codec.Xlsx.Types.Internal import Codec.Xlsx.Types.Internal.CfPair -import qualified Codec.Xlsx.Types.Internal.CommentTable - as CommentTable +import qualified Codec.Xlsx.Types.Internal.CommentTable as CommentTable import Codec.Xlsx.Types.Internal.CustomProperties import Codec.Xlsx.Types.Internal.DvPair -import Codec.Xlsx.Types.Internal.Relationships as Relationships - hiding (lookup) +import Codec.Xlsx.Types.Internal.Relationships as Relationships hiding (lookup) import Codec.Xlsx.Types.Internal.SharedStringTable import Codec.Xlsx.Types.PivotTable.Internal import Codec.Xlsx.Writer.Internal @@ -197,7 +194,7 @@ sheetDataXml rows rh sharedFormulas = let cellAttrs ref c = cellStyleAttr c ++ [("r" .= ref), ("t" .= xlsxCellType c)] cellStyleAttr XlsxCell{xlsxCellStyle=Nothing} = [] - cellStyleAttr XlsxCell{xlsxCellStyle=Just s} = [("s", txti s)] + cellStyleAttr XlsxCell{xlsxCellStyle=Just s} = [("s", txti s)] formula = xlsxCellFormula cell fEl0 = toElement "f" <$> formula fEl <- case formula of @@ -307,7 +304,7 @@ genDrawing n ref dr = do referenced = case innerFiles of [] -> [] - _ -> drawingRels : (map snd innerFiles) + _ -> drawingRels : (map snd innerFiles) genChart :: Int -> Int -> ChartSpace -> FileData genChart n i ch = FileData path contentType relType contents @@ -323,9 +320,9 @@ genChart n i ch = FileData path contentType relType contents ] data PvGenerated = PvGenerated - { pvgCacheFiles :: [(CacheId, FileData)] + { pvgCacheFiles :: [(CacheId, FileData)] , pvgSheetTableFiles :: [[FileData]] - , pvgOthers :: [FileData] + , pvgOthers :: [FileData] } generatePivotFiles :: [(CellMap, [PivotTable])] -> PvGenerated @@ -461,16 +458,16 @@ data XlsxCell = XlsxCell } deriving (Eq, Show, Generic) xlsxCellType :: XlsxCell -> Text -xlsxCellType XlsxCell{xlsxCellValue=Just(XlsxSS _)} = "s" -xlsxCellType XlsxCell{xlsxCellValue=Just(XlsxBool _)} = "b" +xlsxCellType XlsxCell{xlsxCellValue=Just(XlsxSS _)} = "s" +xlsxCellType XlsxCell{xlsxCellValue=Just(XlsxBool _)} = "b" xlsxCellType XlsxCell{xlsxCellValue=Just(XlsxError _)} = "e" -xlsxCellType _ = "n" -- default in SpreadsheetML schema, TODO: add other types +xlsxCellType _ = "n" -- default in SpreadsheetML schema, TODO: add other types value :: XlsxCellData -> Text -value (XlsxSS i) = txti i -value (XlsxDouble d) = txtd d -value (XlsxBool True) = "1" -value (XlsxBool False) = "0" +value (XlsxSS i) = txti i +value (XlsxDouble d) = txtd d +value (XlsxBool True) = "1" +value (XlsxBool False) = "0" value (XlsxError eType) = toAttrVal eType transformSheetData :: SharedStringTable -> Worksheet -> Cells @@ -479,11 +476,11 @@ transformSheetData shared ws = map transformRow $ toRows (ws ^. wsCells) transformRow = second (map transformCell) transformCell (c, Cell{..}) = (c, XlsxCell _cellStyle (fmap transformValue _cellValue) _cellComment _cellFormula) - transformValue (CellText t) = XlsxSS (sstLookupText shared t) + transformValue (CellText t) = XlsxSS (sstLookupText shared t) transformValue (CellDouble dbl) = XlsxDouble dbl - transformValue (CellBool b) = XlsxBool b - transformValue (CellRich r) = XlsxSS (sstLookupRich shared r) - transformValue (CellError e) = XlsxError e + transformValue (CellBool b) = XlsxBool b + transformValue (CellRich r) = XlsxSS (sstLookupRich shared r) + transformValue (CellError e) = XlsxError e bookFiles :: Xlsx -> [FileData] bookFiles xlsx = runST $ do @@ -577,7 +574,7 @@ bookXml rIdAttrs (DefinedNames names) cacheIdRefs dateBase = leafElement "pivotCache" ["cacheId" .= cId, (odr "id") .= refId] definedName :: Text -> Maybe Text -> [(Name, Text)] - definedName name Nothing = ["name" .= name] + definedName name Nothing = ["name" .= name] definedName name (Just lsId) = ["name" .= name, "localSheetId" .= lsId] ssXml :: SharedStringTable -> L.ByteString diff --git a/src/Codec/Xlsx/Writer/Internal.hs b/src/Codec/Xlsx/Writer/Internal.hs index 4afb97ab..6bd4f681 100644 --- a/src/Codec/Xlsx/Writer/Internal.hs +++ b/src/Codec/Xlsx/Writer/Internal.hs @@ -1,8 +1,8 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Xlsx.Writer.Internal ( -- * Rendering documents @@ -91,7 +91,7 @@ countedElementList nm as = elementList nm [ "count" .= length as ] as nonEmptyCountedElementList :: Name -> [Element] -> Maybe Element nonEmptyCountedElementList nm as = case as of [] -> Nothing - _ -> Just $ countedElementList nm as + _ -> Just $ countedElementList nm as elementList :: Name -> [(Name, Text)] -> [Element] -> Element elementList nm attrs els = Element { diff --git a/src/Codec/Xlsx/Writer/Internal/PivotTable.hs b/src/Codec/Xlsx/Writer/Internal/PivotTable.hs index 627d8b92..b6692942 100644 --- a/src/Codec/Xlsx/Writer/Internal/PivotTable.hs +++ b/src/Codec/Xlsx/Writer/Internal/PivotTable.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} module Codec.Xlsx.Writer.Internal.PivotTable ( PivotTableFiles(..) , renderPivotTableFiles @@ -25,15 +25,15 @@ import Codec.Xlsx.Types.PivotTable.Internal import Codec.Xlsx.Writer.Internal data PivotTableFiles = PivotTableFiles - { pvtfTable :: ByteString + { pvtfTable :: ByteString , pvtfCacheDefinition :: ByteString - , pvtfCacheRecords :: ByteString + , pvtfCacheRecords :: ByteString } deriving (Eq, Show, Generic) data CacheDefinition = CacheDefinition - { cdSourceRef :: CellRef + { cdSourceRef :: CellRef , cdSourceSheet :: Text - , cdFields :: [CacheField] + , cdFields :: [CacheField] } deriving (Eq, Show, Generic) renderPivotTableFiles :: CellMap -> Int -> PivotTable -> PivotTableFiles @@ -79,7 +79,7 @@ ptDefinitionElement nm cacheId cache PivotTable {..} = name2x = M.fromList $ zip (mapMaybe _pfiName _pvtFields) [0 ..] mapFieldToX f = fromJustNote "no field" $ M.lookup f name2x pivotFields = elementListSimple "pivotFields" $ map pFieldEl _pvtFields - maybeFieldIn Nothing _ = False + maybeFieldIn Nothing _ = False maybeFieldIn (Just name) positions = FieldPosition name `elem` positions pFieldEl PivotFieldInfo { _pfiName = fName , _pfiOutline = outline @@ -126,7 +126,7 @@ ptDefinitionElement nm cacheId cache PivotTable {..} = else filter (/= DataPosition) _pvtRowFields colFields = elementListSimple "colFields" $ map fieldEl _pvtColumnFields fieldEl p = leafElement "field" ["x" .= fieldPos p] - fieldPos DataPosition = (-2) :: Int + fieldPos DataPosition = (-2) :: Int fieldPos (FieldPosition f) = mapFieldToX f dataFields = elementListSimple "dataFields" $ map dFieldEl _pvtDataFields dFieldEl DataField {..} = @@ -185,16 +185,16 @@ writeCache CacheDefinition {..} = (cacheDefDoc, cacheRecordsDoc) documentFromElement "Pivot cache records generated by xlsx" . elementListSimple "pivotCacheRecords" $ map (elementListSimple "r" . map recordValueToEl) cacheRecords - recordValueToEl (CacheText t) = leafElement "s" ["v" .= t] + recordValueToEl (CacheText t) = leafElement "s" ["v" .= t] recordValueToEl (CacheNumber n) = leafElement "n" ["v" .= n] - recordValueToEl (CacheIndex i) = leafElement "x" ["v" .= i] + recordValueToEl (CacheIndex i) = leafElement "x" ["v" .= i] cacheRecords = transpose $ map (itemsToRecordValues . cfItems) cdFields itemsToRecordValues vals = if all isText vals then indexes vals else map itemToRecordValue vals isText (CellText _) = True - isText _ = False + isText _ = False indexes vals = [ CacheIndex . fromJustNote "inconsistend definition" $ elemIndex v vals | v <- vals diff --git a/src/Codec/Xlsx/Writer/Stream.hs b/src/Codec/Xlsx/Writer/Stream.hs index ce57600c..3742de3d 100644 --- a/src/Codec/Xlsx/Writer/Stream.hs +++ b/src/Codec/Xlsx/Writer/Stream.hs @@ -67,8 +67,8 @@ import Data.Time import Data.Word import Data.XML.Types import Text.Printf -import Text.XML (toXMLElement) import qualified Text.XML as TXML +import Text.XML (toXMLElement) import Text.XML.Stream.Render import Text.XML.Unresolved (elementToEvents) diff --git a/test/AutoFilterTests.hs b/test/AutoFilterTests.hs index 01b044f2..dccf0d60 100644 --- a/test/AutoFilterTests.hs +++ b/test/AutoFilterTests.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module AutoFilterTests @@ -6,7 +6,7 @@ module AutoFilterTests ) where import Test.SmallCheck.Series -import Test.Tasty (testGroup, TestTree) +import Test.Tasty (TestTree, testGroup) import Test.Tasty.SmallCheck (testProperty) import Codec.Xlsx diff --git a/test/CommonTests.hs b/test/CommonTests.hs index c363154e..608067f9 100644 --- a/test/CommonTests.hs +++ b/test/CommonTests.hs @@ -1,26 +1,21 @@ -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module CommonTests ( tests ) where -import Data.Fixed (Pico, Fixed(..), E12) +import Data.Fixed (E12, Fixed (..), Pico) import Data.Time.Calendar (fromGregorian) -import Data.Time.Clock (UTCTime(..)) -import Test.Tasty.SmallCheck (testProperty) -import Test.SmallCheck.Series as Series - ( Positive(..) - , Serial(..) - , newtypeCons - , cons0 - , (\/) - ) -import Test.Tasty (testGroup, TestTree) +import Data.Time.Clock (UTCTime (..)) +import Test.SmallCheck.Series as Series (Positive (..), Serial (..), cons0, + newtypeCons, (\/)) +import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) +import Test.Tasty.SmallCheck (testProperty) import Codec.Xlsx.Types.Common @@ -63,4 +58,4 @@ instance Monad m => Serial m (Fixed E12) where series = newtypeCons MkFixed instance Monad m => Serial m DateBase where - series = cons0 DateBase1900 \/ cons0 DateBase1904 \ No newline at end of file + series = cons0 DateBase1900 \/ cons0 DateBase1904 diff --git a/test/CondFmtTests.hs b/test/CondFmtTests.hs index f7052428..cc5bd92a 100644 --- a/test/CondFmtTests.hs +++ b/test/CondFmtTests.hs @@ -1,11 +1,11 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module CondFmtTests ( tests ) where -import Test.Tasty (testGroup, TestTree) +import Test.Tasty (TestTree, testGroup) import Test.Tasty.SmallCheck (testProperty) import Codec.Xlsx diff --git a/test/Diff.hs b/test/Diff.hs index 34c35618..63151a53 100644 --- a/test/Diff.hs +++ b/test/Diff.hs @@ -1,10 +1,10 @@ module Diff where -import Data.Algorithm.Diff (Diff (..), getGroupedDiff) -import Data.Algorithm.DiffOutput (ppDiff) -import Data.Monoid ((<>)) -import Test.Tasty.HUnit (Assertion, assertBool) -import Text.Groom (groom) +import Data.Algorithm.Diff (Diff (..), getGroupedDiff) +import Data.Algorithm.DiffOutput (ppDiff) +import Data.Monoid ((<>)) +import Test.Tasty.HUnit (Assertion, assertBool) +import Text.Groom (groom) -- | Like '@=?' but producing a diff on failure. (@==?) :: (Eq a, Show a) => a -> a -> Assertion diff --git a/test/DrawingTests.hs b/test/DrawingTests.hs index afc6374a..a846d7fe 100644 --- a/test/DrawingTests.hs +++ b/test/DrawingTests.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE QuasiQuotes #-} module DrawingTests ( tests , testDrawing @@ -13,7 +13,7 @@ import Lens.Micro import Control.Lens #endif import Data.ByteString.Lazy (ByteString) -import Test.Tasty (testGroup, TestTree) +import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) import Text.RawString.QQ import Text.XML diff --git a/test/PivotTableTests.hs b/test/PivotTableTests.hs index 974f965c..1a6853ea 100644 --- a/test/PivotTableTests.hs +++ b/test/PivotTableTests.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE QuasiQuotes #-} module PivotTableTests ( tests , testPivotTable @@ -16,7 +16,7 @@ import Data.ByteString.Lazy (ByteString) import qualified Data.Map as M import Data.Maybe (mapMaybe) import qualified Data.Text as T -import Test.Tasty (testGroup, TestTree) +import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) import Text.RawString.QQ import Text.XML @@ -43,7 +43,7 @@ tests = let sheetName = "Sheet1" ref = CellRef "A1:D5" forCacheId (CacheId 3) = Just (sheetName, ref, testPivotCacheFields) - forCacheId _ = Nothing + forCacheId _ = Nothing -- fields with numeric values go into cache records testPivotCacheFields' = [ if cfName cf == PivotFieldName "Color" diff --git a/test/StreamTests.hs b/test/StreamTests.hs index cac23d8f..a16b5971 100644 --- a/test/StreamTests.hs +++ b/test/StreamTests.hs @@ -1,52 +1,59 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} module StreamTests ( tests ) where +import Data.List (unwords) #ifdef USE_MICROLENS - import Test.Tasty (TestName, TestTree, testGroup) -tests :: TestTree -tests = testGroup - "I stubbed out the tests module for microlens \ - because it doesn't understand setOf. \ - Volunteers are welcome to fix this!" - [] #else - -import Control.Exception import Codec.Xlsx import Codec.Xlsx.Parser.Stream +import qualified Codec.Xlsx.Writer.Internal.Stream as SW +import qualified Codec.Xlsx.Writer.Stream as SW import Conduit ((.|)) import qualified Conduit as C +import Control.Exception import Control.Lens hiding (indexed) -import Data.Set.Lens -import qualified Data.ByteString.Lazy as LB +import Control.Monad.State.Lazy import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LB +import Data.Conduit +import qualified Data.IntMap.Strict as IM import Data.Map (Map) import qualified Data.Map as M -import qualified Data.IntMap.Strict as IM +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Set.Lens import Data.Text (Text) import qualified Data.Text as Text import Diff +import Test.SmallCheck.Series.Instances () import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) -import TestXlsx -import qualified Codec.Xlsx.Writer.Stream as SW -import qualified Codec.Xlsx.Writer.Internal.Stream as SW -import Control.Monad.State.Lazy import Test.Tasty.SmallCheck -import Test.SmallCheck.Series.Instances () -import qualified Data.Set as Set -import Data.Set (Set) +import TestXlsx import Text.Printf -import Data.Conduit +#endif + +#ifdef USE_MICROLENS + +tests :: TestTree +tests = testGroup + (unwords [ "I stubbed out the tests module for microlens" + , "because it doesn't understand setOf." + , "Volunteers are welcome to fix this!" + ] + ) + -- various versions of GHC and stylish-haskell do not handle multiline strings the same + [] +#else toBs :: Xlsx -> BS.ByteString toBs = LB.toStrict . fromXlsx testTime @@ -65,12 +72,13 @@ tests = [ testCase "Write as stream, see if memory based implementation can read it" $ readWrite simpleWorkbook , testCase "Write as stream, see if memory based implementation can read it" $ readWrite simpleWorkbookRow , testCase "Test a small workbook which has a fullblown sqaure" $ readWrite smallWorkbook - , testCase "Test a big workbook as a full square which caused issues with zipstream \ - The buffer of zipstream maybe 1kb, this workbook is big enough \ - to be more than that. \ - So if this encodes/decodes we know we can handle those sizes. \ - In some older version the bytestring got cut off resulting in a corrupt xlsx file" - $ readWrite bigWorkbook + , testCase (unwords [ "Test a big workbook as a full square which caused issues with zipstream" + , "The buffer of zipstream maybe 1kb, this workbook is big enough" + , "to be more than that." + , "So if this encodes/decodes we know we can handle those sizes." + , "In some older version the bytestring got cut off resulting in a corrupt xlsx file" + ] + ) $ readWrite bigWorkbook -- , testCase "Write as stream, see if memory based implementation can read it" $ readWrite testXlsx -- TODO forall SheetItem write that can be read ], diff --git a/test/Test/SmallCheck/Series/Instances.hs b/test/Test/SmallCheck/Series/Instances.hs index 9c6d37a8..ccf6b80e 100644 --- a/test/Test/SmallCheck/Series/Instances.hs +++ b/test/Test/SmallCheck/Series/Instances.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-} diff --git a/test/TestXlsx.hs b/test/TestXlsx.hs index 86aaa049..e6589939 100644 --- a/test/TestXlsx.hs +++ b/test/TestXlsx.hs @@ -1,8 +1,8 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} module TestXlsx where @@ -24,12 +24,11 @@ import Codec.Xlsx import Codec.Xlsx.Formatted import Codec.Xlsx.Types.Internal import Codec.Xlsx.Types.Internal.CommentTable -import Codec.Xlsx.Types.Internal.CustomProperties - as CustomProperties +import Codec.Xlsx.Types.Internal.CustomProperties as CustomProperties import Codec.Xlsx.Types.Internal.SharedStringTable -import PivotTableTests import DrawingTests +import PivotTableTests testXlsx :: Xlsx testXlsx = Xlsx sheets minimalStyles definedNames customProperties DateBase1904 @@ -235,8 +234,8 @@ 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]] + let newprops = props & runPropertiesUnderline .~ Just u + in SharedStringTable [text, XlsxRichText [rich1, RichTextRun (Just newprops) val]] testSharedStringTable :: SharedStringTable testSharedStringTable = SharedStringTable $ V.fromList items @@ -469,13 +468,13 @@ testFormatWorkbookResult = def & xlSheets .~ sheets 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] @@ -595,4 +594,4 @@ foreignValidations = M.fromList , _dvValidationType = ValidationTypeList $ RangeExpression $ CellRef "'cellrange DV source'!$A$1:$B$2" } ) - ] \ No newline at end of file + ]