Skip to content

Commit 59cdba4

Browse files
functorafunctora
committed
wip
1 parent 09ab918 commit 59cdba4

File tree

5 files changed

+71
-75
lines changed

5 files changed

+71
-75
lines changed

‎pub/xlsx/src/Codec/Xlsx/Parser.hs‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -677,29 +677,29 @@ getDrawing ar contentTypes fp = do
677677
cur <- xmlCursorRequired ar fp
678678
drawingRels <- getRels ar fp
679679
unresolved <- headErr (InvalidFile fp "Couldn't parse drawing") (fromCursor cur)
680-
anchors <- forM (unresolved ^. xdrAnchors) $ resolveFileInfo drawingRels
680+
anchors <- forM (xdrAnchors unresolved) $ resolveFileInfo drawingRels
681681
return $ Drawing anchors
682682
where
683683
resolveFileInfo ::
684684
Relationships -> Anchor RefId RefId -> Parser (Anchor FileInfo ChartSpace)
685685
resolveFileInfo rels uAnch =
686-
case uAnch ^. anchObject of
686+
case uAnch ^. #anchObject of
687687
Picture {..} -> do
688-
let mRefId = _picBlipFill ^. bfpImageInfo
688+
let mRefId = _picBlipFill ^. #bfpImageInfo
689689
mFI <- lookupFI rels mRefId
690690
let pic' =
691691
Picture
692692
{ _picMacro = _picMacro,
693693
_picPublished = _picPublished,
694694
_picNonVisual = _picNonVisual,
695-
_picBlipFill = (_picBlipFill & bfpImageInfo .~ mFI),
695+
_picBlipFill = (_picBlipFill & #bfpImageInfo .~ mFI),
696696
_picShapeProperties = _picShapeProperties
697697
}
698-
return uAnch {_anchObject = pic'}
698+
return uAnch {anchObject = pic'}
699699
Graphic nv rId tr -> do
700700
chartPath <- lookupRelPath fp rels rId
701701
chart <- readChart ar chartPath
702-
return uAnch {_anchObject = Graphic nv chart tr}
702+
return uAnch {anchObject = Graphic nv chart tr}
703703
lookupFI _ Nothing = return Nothing
704704
lookupFI rels (Just rId) = do
705705
path <- lookupRelPath fp rels rId

‎pub/xlsx/src/Codec/Xlsx/Types/Drawing.hs‎

Lines changed: 40 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@
55
{-# LANGUAGE OverloadedStrings #-}
66
{-# LANGUAGE RecordWildCards #-}
77
{-# LANGUAGE StandaloneDeriving #-}
8-
{-# LANGUAGE TemplateHaskell #-}
98
{-# LANGUAGE TupleSections #-}
109
{-# LANGUAGE TypeFamilies #-}
1110
{-# LANGUAGE TypeSynonymInstances #-}
@@ -38,22 +37,22 @@ import Text.XML.Cursor
3837
-- | information about image file as a par of a drawing
3938
data FileInfo = FileInfo
4039
{ -- | image filename, images are assumed to be stored under path "xl\/media\/"
41-
_fiFilename :: FilePath,
40+
fiFilename :: FilePath,
4241
-- | image content type, ECMA-376 advises to use "image\/png" or "image\/jpeg"
4342
-- if interoperability is wanted
44-
_fiContentType :: Text,
43+
fiContentType :: Text,
4544
-- | image file contents
46-
_fiContents :: ByteString
45+
fiContents :: ByteString
4746
}
4847
deriving (Eq, Show, Generic)
4948

5049
instance NFData FileInfo
5150

5251
data Marker = Marker
53-
{ _mrkCol :: Int,
54-
_mrkColOff :: Coordinate,
55-
_mrkRow :: Int,
56-
_mrkRowOff :: Coordinate
52+
{ mrkCol :: Int,
53+
mrkColOff :: Coordinate,
54+
mrkRow :: Int,
55+
mrkRowOff :: Coordinate
5756
}
5857
deriving (Eq, Show, Generic)
5958

@@ -127,15 +126,15 @@ picture dId fi =
127126
PicNonVisual $
128127
NonVisualDrawingProperties
129128
{ _nvdpId = dId,
130-
_nvdpName = T.pack $ _fiFilename fi,
129+
_nvdpName = T.pack $ fiFilename fi,
131130
_nvdpDescription = Nothing,
132131
_nvdpHidden = False,
133132
_nvdpTitle = Nothing
134133
}
135134
bfProps =
136135
BlipFillProperties
137-
{ _bfpImageInfo = Just fi,
138-
_bfpFillMode = Just FillStretch
136+
{ bfpImageInfo = Just fi,
137+
bfpFillMode = Just FillStretch
139138
}
140139
shProps =
141140
ShapeProperties
@@ -149,11 +148,11 @@ picture dId fi =
149148
-- particular drawing alongside with their anchorings (i.e. sizes and
150149
-- positions)
151150
extractPictures :: Drawing -> [(Anchoring, FileInfo)]
152-
extractPictures dr = mapMaybe maybePictureInfo $ _xdrAnchors dr
151+
extractPictures dr = mapMaybe maybePictureInfo $ xdrAnchors dr
153152
where
154153
maybePictureInfo Anchor {..} =
155-
case _anchObject of
156-
Picture {..} -> (_anchAnchoring,) <$> _bfpImageInfo _picBlipFill
154+
case anchObject of
155+
Picture {..} -> (anchAnchoring,) <$> bfpImageInfo _picBlipFill
157156
_ -> Nothing
158157

159158
-- | This element is used to set certain properties related to a drawing
@@ -216,8 +215,8 @@ data NonVisualDrawingProperties = NonVisualDrawingProperties
216215
instance NFData NonVisualDrawingProperties
217216

218217
data BlipFillProperties a = BlipFillProperties
219-
{ _bfpImageInfo :: Maybe a,
220-
_bfpFillMode :: Maybe FillMode
218+
{ bfpImageInfo :: Maybe a,
219+
bfpFillMode :: Maybe FillMode
221220
-- TODO: dpi, rotWithShape, srcRect
222221
}
223222
deriving (Eq, Show, Generic)
@@ -236,16 +235,16 @@ instance NFData FillMode
236235

237236
-- See @EG_Anchor@ (p. 4052)
238237
data Anchor p g = Anchor
239-
{ _anchAnchoring :: Anchoring,
240-
_anchObject :: DrawingObject p g,
241-
_anchClientData :: ClientData
238+
{ anchAnchoring :: Anchoring,
239+
anchObject :: DrawingObject p g,
240+
anchClientData :: ClientData
242241
}
243242
deriving (Eq, Show, Generic)
244243

245244
instance (NFData p, NFData g) => NFData (Anchor p g)
246245

247246
data GenericDrawing p g = Drawing
248-
{ _xdrAnchors :: [Anchor p g]
247+
{ xdrAnchors :: [Anchor p g]
249248
}
250249
deriving (Eq, Show, Generic)
251250

@@ -256,11 +255,6 @@ type Drawing = GenericDrawing FileInfo ChartSpace
256255

257256
type UnresolvedDrawing = GenericDrawing RefId RefId
258257

259-
makeLenses ''Anchor
260-
makeLenses ''DrawingObject
261-
makeLenses ''BlipFillProperties
262-
makeLenses ''GenericDrawing
263-
264258
-- | simple drawing object anchoring using one cell as a top lelft
265259
-- corner and dimensions of that object
266260
simpleAnchorXY ::
@@ -274,10 +268,10 @@ simpleAnchorXY ::
274268
Anchor p g
275269
simpleAnchorXY (x, y) sz obj =
276270
Anchor
277-
{ _anchAnchoring =
271+
{ anchAnchoring =
278272
OneCellAnchor {onecaFrom = unqMarker (x, 0) (y, 0), onecaExt = sz},
279-
_anchObject = obj,
280-
_anchClientData = def
273+
anchObject = obj,
274+
anchClientData = def
281275
}
282276

283277
{-------------------------------------------------------------------------------
@@ -296,9 +290,9 @@ instance FromCursor UnresolvedDrawing where
296290

297291
instance FromCursor (Anchor RefId RefId) where
298292
fromCursor cur = do
299-
_anchAnchoring <- fromCursor cur
300-
_anchObject <- cur $/ anyElement >=> fromCursor
301-
_anchClientData <- cur $/ element (xdr "clientData") >=> fromCursor
293+
anchAnchoring <- fromCursor cur
294+
anchObject <- cur $/ anyElement >=> fromCursor
295+
anchClientData <- cur $/ element (xdr "clientData") >=> fromCursor
302296
return Anchor {..}
303297

304298
instance FromCursor Anchoring where
@@ -325,10 +319,10 @@ anchoringFromNode n
325319

326320
instance FromCursor Marker where
327321
fromCursor cur = do
328-
_mrkCol <- cur $/ element (xdr "col") &/ content >=> decimal
329-
_mrkColOff <- cur $/ element (xdr "colOff") &/ content >=> coordinate
330-
_mrkRow <- cur $/ element (xdr "row") &/ content >=> decimal
331-
_mrkRowOff <- cur $/ element (xdr "rowOff") &/ content >=> coordinate
322+
mrkCol <- cur $/ element (xdr "col") &/ content >=> decimal
323+
mrkColOff <- cur $/ element (xdr "colOff") &/ content >=> coordinate
324+
mrkRow <- cur $/ element (xdr "row") &/ content >=> decimal
325+
mrkRowOff <- cur $/ element (xdr "rowOff") &/ content >=> coordinate
332326
return Marker {..}
333327

334328
instance FromCursor (DrawingObject RefId RefId) where
@@ -382,12 +376,12 @@ instance FromAttrVal DrawingElementId where
382376

383377
instance FromCursor (BlipFillProperties RefId) where
384378
fromCursor cur = do
385-
let _bfpImageInfo =
379+
let bfpImageInfo =
386380
listToMaybe $
387381
cur
388382
$/ element (a_ "blip")
389383
>=> fmap RefId . attribute (odr "embed")
390-
_bfpFillMode = listToMaybe $ cur $/ anyElement >=> fromCursor
384+
bfpFillMode = listToMaybe $ cur $/ anyElement >=> fromCursor
391385
return BlipFillProperties {..}
392386

393387
instance FromCursor FillMode where
@@ -439,9 +433,9 @@ anchorToElement Anchor {..} =
439433
++ map NodeElement [drawingObjEl, cdEl]
440434
}
441435
where
442-
el = anchoringToElement _anchAnchoring
443-
drawingObjEl = drawingObjToElement _anchObject
444-
cdEl = toElement "clientData" _anchClientData
436+
el = anchoringToElement anchAnchoring
437+
drawingObjEl = drawingObjToElement anchObject
438+
cdEl = toElement "clientData" anchClientData
445439

446440
anchoringToElement :: Anchoring -> Element
447441
anchoringToElement anchoring = elementList nm attrs elements
@@ -467,10 +461,10 @@ instance ToElement Marker where
467461
toElement nm Marker {..} = elementListSimple nm elements
468462
where
469463
elements =
470-
[ elementContent "col" (toAttrVal _mrkCol),
471-
elementContent "colOff" (toAttrVal _mrkColOff),
472-
elementContent "row" (toAttrVal _mrkRow),
473-
elementContent "rowOff" (toAttrVal _mrkRowOff)
464+
[ elementContent "col" (toAttrVal mrkCol),
465+
elementContent "colOff" (toAttrVal mrkColOff),
466+
elementContent "row" (toAttrVal mrkRow),
467+
elementContent "rowOff" (toAttrVal mrkRowOff)
474468
]
475469

476470
drawingObjToElement :: DrawingObject RefId RefId -> Element
@@ -534,8 +528,8 @@ instance ToElement (BlipFillProperties RefId) where
534528
where
535529
elements =
536530
catMaybes
537-
[ (\rId -> leafElement (a_ "blip") [odr "embed" .= rId]) <$> _bfpImageInfo,
538-
fillModeToElement <$> _bfpFillMode
531+
[ (\rId -> leafElement (a_ "blip") [odr "embed" .= rId]) <$> bfpImageInfo,
532+
fillModeToElement <$> bfpFillMode
539533
]
540534

541535
fillModeToElement :: FillMode -> Element

‎pub/xlsx/src/Codec/Xlsx/Writer.hs‎

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ import Control.Monad.ST
3838
import Control.Monad.State (evalState, get, put)
3939
import qualified Data.ByteString.Lazy as L
4040
import Data.ByteString.Lazy.Char8 ()
41+
import Data.Generics.Labels
4142
import Data.List (foldl', mapAccumL)
4243
import Data.Map (Map)
4344
import qualified Data.Map as M
@@ -138,7 +139,8 @@ singleSheetFiles n cells pivFileDatas ws tblIdRef = do
138139
$ sheetXml
139140
nss =
140141
[("r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships")]
141-
sheetXml = renderLBS def {rsNamespaces = nss} $ Document (Prologue [] Nothing []) root []
142+
sheetXml =
143+
renderLBS def {rsNamespaces = nss} $ Document (Prologue [] Nothing []) root []
142144
root =
143145
addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" Nothing $
144146
elementListSimple "worksheet" rootEls
@@ -307,34 +309,34 @@ genDrawing n ref dr = do
307309
("a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
308310
("r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships")
309311
]
310-
dr' = Drawing {_xdrAnchors = reverse anchors'}
311-
(anchors', images, charts, _) = foldl' collectFile ([], [], [], 1) (dr ^. xdrAnchors)
312+
dr' = Drawing {xdrAnchors = reverse anchors'}
313+
(anchors', images, charts, _) = foldl' collectFile ([], [], [], 1) (dr ^. #xdrAnchors)
312314
collectFile ::
313315
([Anchor RefId RefId], [Maybe (Int, FileInfo)], [(Int, ChartSpace)], Int) ->
314316
Anchor FileInfo ChartSpace ->
315317
([Anchor RefId RefId], [Maybe (Int, FileInfo)], [(Int, ChartSpace)], Int)
316318
collectFile (as, fis, chs, i) anch0 =
317-
case anch0 ^. anchObject of
319+
case anch0 ^. #anchObject of
318320
Picture {..} ->
319-
let fi = (i,) <$> _picBlipFill ^. bfpImageInfo
321+
let fi = (i,) <$> _picBlipFill ^. #bfpImageInfo
320322
pic' =
321323
Picture
322324
{ _picMacro = _picMacro,
323325
_picPublished = _picPublished,
324326
_picNonVisual = _picNonVisual,
325327
_picBlipFill =
326-
(_picBlipFill & bfpImageInfo ?~ RefId ("rId" <> txti i)),
328+
(_picBlipFill & #bfpImageInfo ?~ RefId ("rId" <> txti i)),
327329
_picShapeProperties = _picShapeProperties
328330
}
329-
anch = anch0 {_anchObject = pic'}
331+
anch = anch0 {anchObject = pic'}
330332
in (anch : as, fi : fis, chs, i + 1)
331333
Graphic nv ch tr ->
332334
let gr' = Graphic nv (RefId ("rId" <> txti i)) tr
333-
anch = anch0 {_anchObject = gr'}
335+
anch = anch0 {anchObject = gr'}
334336
in (anch : as, fis, (i, ch) : chs, i + 1)
335337
imageFiles =
336338
[ ( unsafeRefId i,
337-
FileData ("xl/media/" <> _fiFilename) _fiContentType "image" _fiContents
339+
FileData ("xl/media/" <> fiFilename) fiContentType "image" fiContents
338340
)
339341
| (i, FileInfo {..}) <- reverse (catMaybes images)
340342
]

‎pub/xlsx/test/DrawingTests.hs‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -53,9 +53,9 @@ testDrawing = Drawing [anchor1, anchor2]
5353
where
5454
anchor1 =
5555
Anchor
56-
{ _anchAnchoring = anchoring1,
57-
_anchObject = pic,
58-
_anchClientData = def
56+
{ anchAnchoring = anchoring1,
57+
anchObject = pic,
58+
anchClientData = def
5959
}
6060
anchoring1 =
6161
TwoCellAnchor
@@ -82,8 +82,8 @@ testDrawing = Drawing [anchor1, anchor2]
8282
}
8383
bfProps =
8484
BlipFillProperties
85-
{ _bfpImageInfo = Just (RefId "rId1"),
86-
_bfpFillMode = Just FillStretch
85+
{ bfpImageInfo = Just (RefId "rId1"),
86+
bfpFillMode = Just FillStretch
8787
}
8888
shProps =
8989
ShapeProperties
@@ -107,9 +107,9 @@ testDrawing = Drawing [anchor1, anchor2]
107107
}
108108
anchor2 =
109109
Anchor
110-
{ _anchAnchoring = anchoring2,
111-
_anchObject = graphic,
112-
_anchClientData = def
110+
{ anchAnchoring = anchoring2,
111+
anchObject = graphic,
112+
anchClientData = def
113113
}
114114
anchoring2 =
115115
TwoCellAnchor

‎pub/xlsx/test/TestXlsx.hs‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -123,13 +123,13 @@ testXlsx = Xlsx sheets minimalStyles definedNames customProperties DateBase1904
123123
)
124124
]
125125
cols = [ColumnsProperties 1 10 (Just 15) (Just 1) False False False]
126-
drawing = Just $ testDrawing {_xdrAnchors = map resolve $ _xdrAnchors testDrawing}
126+
drawing = Just $ testDrawing {xdrAnchors = map resolve $ xdrAnchors testDrawing}
127127
resolve :: Anchor RefId RefId -> Anchor FileInfo ChartSpace
128128
resolve Anchor {..} =
129129
let obj =
130-
case _anchObject of
130+
case anchObject of
131131
Picture {..} ->
132-
let blipFill = (_picBlipFill & bfpImageInfo ?~ fileInfo)
132+
let blipFill = (_picBlipFill & #bfpImageInfo ?~ fileInfo)
133133
in Picture
134134
{ _picMacro = _picMacro,
135135
_picPublished = _picPublished,
@@ -140,9 +140,9 @@ testXlsx = Xlsx sheets minimalStyles definedNames customProperties DateBase1904
140140
Graphic nv _ tr ->
141141
Graphic nv testLineChartSpace tr
142142
in Anchor
143-
{ _anchAnchoring = _anchAnchoring,
144-
_anchObject = obj,
145-
_anchClientData = _anchClientData
143+
{ anchAnchoring = anchAnchoring,
144+
anchObject = obj,
145+
anchClientData = anchClientData
146146
}
147147
fileInfo = FileInfo "dummy.png" "image/png" "fake contents"
148148
ranges = [mkRange (1, 1) (1, 2), mkRange (2, 2) (10, 5)]

0 commit comments

Comments
 (0)