eliminating xlsx th wip

Author: functora

pub/xlsx/src/Codec/Xlsx/Formatted.hs

@@ -60,11 +60,11 @@ data FormattingState = FormattingState
 stateFromStyleSheet :: StyleSheet -> FormattingState
 stateFromStyleSheet StyleSheet {..} =
   FormattingState
-    { formattingBorders = fromValueList _styleSheetBorders,
-      formattingCellXfs = fromValueList _styleSheetCellXfs,
-      formattingFills = fromValueList _styleSheetFills,
-      formattingFonts = fromValueList _styleSheetFonts,
-      formattingNumFmts = M.fromList . map swap $ M.toList _styleSheetNumFmts,
+    { formattingBorders = fromValueList styleSheetBorders,
+      formattingCellXfs = fromValueList styleSheetCellXfs,
+      formattingFills = fromValueList styleSheetFills,
+      formattingFonts = fromValueList styleSheetFonts,
+      formattingNumFmts = M.fromList . map swap $ M.toList styleSheetNumFmts,
       formattingMerges = []
     }
 
@@ -77,11 +77,11 @@ toValueList = map snd . sortBy (comparing fst) . map swap . M.toList
 updateStyleSheetFromState :: StyleSheet -> FormattingState -> StyleSheet
 updateStyleSheetFromState sSheet FormattingState {..} =
   sSheet
-    { _styleSheetBorders = toValueList formattingBorders,
-      _styleSheetCellXfs = toValueList formattingCellXfs,
-      _styleSheetFills = toValueList formattingFills,
-      _styleSheetFonts = toValueList formattingFonts,
-      _styleSheetNumFmts = M.fromList . map swap $ M.toList formattingNumFmts
+    { styleSheetBorders = toValueList formattingBorders,
+      styleSheetCellXfs = toValueList formattingCellXfs,
+      styleSheetFills = toValueList formattingFills,
+      styleSheetFonts = toValueList formattingFonts,
+      styleSheetNumFmts = M.fromList . map swap $ M.toList formattingNumFmts
     }
 
 getId ::
@@ -123,8 +123,8 @@ data FormattedCondFmt = FormattedCondFmt
 --
 -- TODOs:
 --
--- * Add a number format ('_cellXfApplyNumberFormat', '_cellXfNumFmtId')
--- * Add references to the named style sheets ('_cellXfId')
+-- * Add a number format ('cellXfApplyNumberFormat', 'cellXfNumFmtId')
+-- * Add references to the named style sheets ('cellXfId')
 data Format = Format
   { formatAlignment :: Maybe Alignment,
     formatBorder :: Maybe Border,
@@ -201,7 +201,7 @@ data Formatted = Formatted
 -- This has a number of causes:
 --
 -- * The 'Cell' datatype wants an 'Int' for the style, which is supposed to
---   point into the '_styleSheetCellXfs' part of a stylesheet. However, this can
+--   point into the 'styleSheetCellXfs' part of a stylesheet. However, this can
 --   be difficult to work with, as it requires manual tracking of cell style
 --   IDs, which in turns requires manual tracking of font IDs, border IDs, etc.
 -- * Row-span and column-span properties are set on the worksheet as a whole
@@ -272,33 +272,33 @@ toFormattedCells m merges StyleSheet {..} = applyMerges $ M.map toFormattedCell
         }
     formatFromStyle cellXf =
       Format
-        { formatAlignment = applied _cellXfApplyAlignment _cellXfAlignment cellXf,
+        { formatAlignment = applied cellXfApplyAlignment cellXfAlignment cellXf,
           formatBorder =
             flip M.lookup borders
-              =<< applied _cellXfApplyBorder _cellXfBorderId cellXf,
+              =<< applied cellXfApplyBorder cellXfBorderId cellXf,
           formatFill =
             flip M.lookup fills
-              =<< applied _cellXfApplyFill _cellXfFillId cellXf,
+              =<< applied cellXfApplyFill cellXfFillId cellXf,
           formatFont =
             flip M.lookup fonts
-              =<< applied _cellXfApplyFont _cellXfFontId cellXf,
+              =<< applied cellXfApplyFont cellXfFontId cellXf,
           formatNumberFormat =
             lookupNumFmt
-              =<< applied _cellXfApplyNumberFormat _cellXfNumFmtId cellXf,
-          formatProtection = _cellXfProtection cellXf,
-          formatPivotButton = _cellXfPivotButton cellXf,
-          formatQuotePrefix = _cellXfQuotePrefix cellXf
+              =<< applied cellXfApplyNumberFormat cellXfNumFmtId cellXf,
+          formatProtection = cellXfProtection cellXf,
+          formatPivotButton = cellXfPivotButton cellXf,
+          formatQuotePrefix = cellXfQuotePrefix cellXf
         }
     idMapped :: [a] -> Map Int a
     idMapped = M.fromList . zip [0 ..]
-    cellXfs = idMapped _styleSheetCellXfs
-    borders = idMapped _styleSheetBorders
-    fills = idMapped _styleSheetFills
-    fonts = idMapped _styleSheetFonts
+    cellXfs = idMapped styleSheetCellXfs
+    borders = idMapped styleSheetBorders
+    fills = idMapped styleSheetFills
+    fonts = idMapped styleSheetFonts
     lookupNumFmt fId =
       asum
         [ StdNumberFormat <$> idToStdNumberFormat fId,
-          UserNumberFormat <$> M.lookup fId _styleSheetNumFmts
+          UserNumberFormat <$> M.lookup fId styleSheetNumFmts
         ]
     applied :: (CellXf -> Maybe Bool) -> (CellXf -> Maybe a) -> CellXf -> Maybe a
     applied applyProp prop cXf = do
@@ -331,12 +331,12 @@ conditionallyFormatted ::
   Map CellRef [FormattedCondFmt] -> StyleSheet -> CondFormatted
 conditionallyFormatted cfs styleSheet =
   CondFormatted
-    { condformattedStyleSheet = styleSheet & styleSheetDxfs .~ finalDxfs,
+    { condformattedStyleSheet = styleSheet & #styleSheetDxfs .~ finalDxfs,
       condformattedFormattings = fmts
     }
   where
     (cellFmts, dxf2id) = runState (mapM (mapM mapDxf) cfs) dxf2id0
-    dxf2id0 = fromValueList (styleSheet ^. styleSheetDxfs)
+    dxf2id0 = fromValueList (styleSheet ^. #styleSheetDxfs)
     fmts =
       M.fromList
         . map mergeSqRef
@@ -408,14 +408,14 @@ cellBlock (row, col) cell@FormattedCell {..} = (block, merge)
     borderAt :: (RowIndex, ColumnIndex) -> Border
     borderAt (row', col') =
       def
-        & borderTop
-        .~ do guard (row' == topRow); _borderTop =<< border
-        & borderBottom
-        .~ do guard (row' == bottomRow); _borderBottom =<< border
-        & borderLeft
-        .~ do guard (col' == leftCol); _borderLeft =<< border
-        & borderRight
-        .~ do guard (col' == rightCol); _borderRight =<< border
+        & #borderTop
+        .~ do guard (row' == topRow); borderTop =<< border
+        & #borderBottom
+        .~ do guard (row' == bottomRow); borderBottom =<< border
+        & #borderLeft
+        .~ do guard (col' == leftCol); borderLeft =<< border
+        & #borderRight
+        .~ do guard (col' == rightCol); borderRight =<< border
 
     topRow, bottomRow :: RowIndex
     leftCol, rightCol :: ColumnIndex
@@ -441,21 +441,21 @@ constructCellXf FormattedCell {formattedFormat = Format {..}} = do
   mNumFmtId <- getFmtId #formattingNumFmts `mapM` formatNumberFormat
   let xf =
         CellXf
-          { _cellXfApplyAlignment = apply formatAlignment,
-            _cellXfApplyBorder = apply mBorderId,
-            _cellXfApplyFill = apply mFillId,
-            _cellXfApplyFont = apply mFontId,
-            _cellXfApplyNumberFormat = apply formatNumberFormat,
-            _cellXfApplyProtection = apply formatProtection,
-            _cellXfBorderId = mBorderId,
-            _cellXfFillId = mFillId,
-            _cellXfFontId = mFontId,
-            _cellXfNumFmtId = mNumFmtId,
-            _cellXfPivotButton = formatPivotButton,
-            _cellXfQuotePrefix = formatQuotePrefix,
-            _cellXfId = Nothing, -- TODO
-            _cellXfAlignment = formatAlignment,
-            _cellXfProtection = formatProtection
+          { cellXfApplyAlignment = apply formatAlignment,
+            cellXfApplyBorder = apply mBorderId,
+            cellXfApplyFill = apply mFillId,
+            cellXfApplyFont = apply mFontId,
+            cellXfApplyNumberFormat = apply formatNumberFormat,
+            cellXfApplyProtection = apply formatProtection,
+            cellXfBorderId = mBorderId,
+            cellXfFillId = mFillId,
+            cellXfFontId = mFontId,
+            cellXfNumFmtId = mNumFmtId,
+            cellXfPivotButton = formatPivotButton,
+            cellXfQuotePrefix = formatQuotePrefix,
+            cellXfId = Nothing, -- TODO
+            cellXfAlignment = formatAlignment,
+            cellXfProtection = formatProtection
           }
   return $ if xf == def then Nothing else Just xf
   where

pub/xlsx/src/Codec/Xlsx/Types/DataValidation.hs

@@ -3,21 +3,10 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 module Codec.Xlsx.Types.DataValidation
   ( ValidationExpression (..),
     ValidationType (..),
-    dvAllowBlank,
-    dvError,
-    dvErrorStyle,
-    dvErrorTitle,
-    dvPrompt,
-    dvPromptTitle,
-    dvShowDropDown,
-    dvShowErrorMessage,
-    dvShowInputMessage,
-    dvValidationType,
     ErrorStyle (..),
     DataValidation (..),
     ListOrRangeExpression (..),
@@ -114,23 +103,21 @@ instance NFData ErrorStyle
 
 -- See 18.3.1.32 "dataValidation (Data Validation)" (p. 1614/1624)
 data DataValidation = DataValidation
-  { _dvAllowBlank :: Bool,
-    _dvError :: Maybe Text,
-    _dvErrorStyle :: ErrorStyle,
-    _dvErrorTitle :: Maybe Text,
-    _dvPrompt :: Maybe Text,
-    _dvPromptTitle :: Maybe Text,
-    _dvShowDropDown :: Bool,
-    _dvShowErrorMessage :: Bool,
-    _dvShowInputMessage :: Bool,
-    _dvValidationType :: ValidationType
+  { dvAllowBlank :: Bool,
+    dvError :: Maybe Text,
+    dvErrorStyle :: ErrorStyle,
+    dvErrorTitle :: Maybe Text,
+    dvPrompt :: Maybe Text,
+    dvPromptTitle :: Maybe Text,
+    dvShowDropDown :: Bool,
+    dvShowErrorMessage :: Bool,
+    dvShowInputMessage :: Bool,
+    dvValidationType :: ValidationType
   }
   deriving (Eq, Show, Generic)
 
 instance NFData DataValidation
 
-makeLenses ''DataValidation
-
 instance Default DataValidation where
   def =
     DataValidation
@@ -163,35 +150,35 @@ instance FromAttrBs ErrorStyle where
 
 instance FromCursor DataValidation where
   fromCursor cur = do
-    _dvAllowBlank <- fromAttributeDef "allowBlank" False cur
-    _dvError <- maybeAttribute "error" cur
-    _dvErrorStyle <- fromAttributeDef "errorStyle" ErrorStyleStop cur
-    _dvErrorTitle <- maybeAttribute "errorTitle" cur
+    dvAllowBlank <- fromAttributeDef "allowBlank" False cur
+    dvError <- maybeAttribute "error" cur
+    dvErrorStyle <- fromAttributeDef "errorStyle" ErrorStyleStop cur
+    dvErrorTitle <- maybeAttribute "errorTitle" cur
     mop <- fromAttributeDef "operator" "between" cur
-    _dvPrompt <- maybeAttribute "prompt" cur
-    _dvPromptTitle <- maybeAttribute "promptTitle" cur
-    _dvShowDropDown <- fromAttributeDef "showDropDown" False cur
-    _dvShowErrorMessage <- fromAttributeDef "showErrorMessage" False cur
-    _dvShowInputMessage <- fromAttributeDef "showInputMessage" False cur
+    dvPrompt <- maybeAttribute "prompt" cur
+    dvPromptTitle <- maybeAttribute "promptTitle" cur
+    dvShowDropDown <- fromAttributeDef "showDropDown" False cur
+    dvShowErrorMessage <- fromAttributeDef "showErrorMessage" False cur
+    dvShowInputMessage <- fromAttributeDef "showInputMessage" False cur
     mtype <- fromAttributeDef "type" "none" cur
-    _dvValidationType <- readValidationType mop mtype cur
+    dvValidationType <- readValidationType mop mtype cur
     return DataValidation {..}
 
 instance FromXenoNode DataValidation where
   fromXenoNode root = do
     (op, atype, genDV) <- parseAttributes root $ do
-      _dvAllowBlank <- fromAttrDef "allowBlank" False
-      _dvError <- maybeAttr "error"
-      _dvErrorStyle <- fromAttrDef "errorStyle" ErrorStyleStop
-      _dvErrorTitle <- maybeAttr "errorTitle"
-      _dvPrompt <- maybeAttr "prompt"
-      _dvPromptTitle <- maybeAttr "promptTitle"
-      _dvShowDropDown <- fromAttrDef "showDropDown" False
-      _dvShowErrorMessage <- fromAttrDef "showErrorMessage" False
-      _dvShowInputMessage <- fromAttrDef "showInputMessage" False
+      dvAllowBlank <- fromAttrDef "allowBlank" False
+      dvError <- maybeAttr "error"
+      dvErrorStyle <- fromAttrDef "errorStyle" ErrorStyleStop
+      dvErrorTitle <- maybeAttr "errorTitle"
+      dvPrompt <- maybeAttr "prompt"
+      dvPromptTitle <- maybeAttr "promptTitle"
+      dvShowDropDown <- fromAttrDef "showDropDown" False
+      dvShowErrorMessage <- fromAttrDef "showErrorMessage" False
+      dvShowInputMessage <- fromAttrDef "showInputMessage" False
       op <- fromAttrDef "operator" "between"
       typ <- fromAttrDef "type" "none"
-      return (op, typ, \_dvValidationType -> DataValidation {..})
+      return (op, typ, \dvValidationType -> DataValidation {..})
     valType <- parseValidationType op atype
     return $ genDV valType
     where
@@ -333,17 +320,17 @@ instance ToElement DataValidation where
       { elementName = nm,
         elementAttributes =
           M.fromList . catMaybes $
-            [ Just $ "allowBlank" .= _dvAllowBlank,
-              "error" .=? _dvError,
-              Just $ "errorStyle" .= _dvErrorStyle,
-              "errorTitle" .=? _dvErrorTitle,
+            [ Just $ "allowBlank" .= dvAllowBlank,
+              "error" .=? dvError,
+              Just $ "errorStyle" .= dvErrorStyle,
+              "errorTitle" .=? dvErrorTitle,
               "operator" .=? op,
-              "prompt" .=? _dvPrompt,
-              "promptTitle" .=? _dvPromptTitle,
-              Just $ "showDropDown" .= _dvShowDropDown,
-              Just $ "showErrorMessage" .= _dvShowErrorMessage,
-              Just $ "showInputMessage" .= _dvShowInputMessage,
-              Just $ "type" .= _dvValidationType
+              "prompt" .=? dvPrompt,
+              "promptTitle" .=? dvPromptTitle,
+              Just $ "showDropDown" .= dvShowDropDown,
+              Just $ "showErrorMessage" .= dvShowErrorMessage,
+              Just $ "showInputMessage" .= dvShowInputMessage,
+              Just $ "type" .= dvValidationType
             ],
         elementNodes =
           catMaybes
@@ -356,7 +343,7 @@ instance ToElement DataValidation where
 
       op :: Maybe Text
       f1, f2 :: Maybe Formula
-      (op, f1, f2) = case _dvValidationType of
+      (op, f1, f2) = case dvValidationType of
         ValidationTypeNone -> (Nothing, Nothing, Nothing)
         ValidationTypeCustom f -> (Nothing, Just f, Nothing)
         ValidationTypeDate f -> opExp $ viewValidationExpression f