xlsx wip

Author: functora

ghcjs/delivery-calculator/src/App/Widgets/Menu.hs

@@ -93,10 +93,11 @@ menu st =
                 [ ("min-width", "0")
                 ],
               onClick . PushUpdate . Instant . EffectUpdate $ do
-                imgs <- Jsm.fetchBlobUris $ st ^. #modelState
+                let doc = st ^. #modelState
+                imgs <- Jsm.fetchBlobUris doc
                 Jsm.saveFile Xlsx.xlsxFile Xlsx.xlsxMime
                   . from @BL.ByteString @ByteString
-                  $ Xlsx.newXlsx imgs
+                  $ Xlsx.newXlsx doc imgs
             ]
             [ icon Icon.IconDownload
             ],

ghcjs/delivery-calculator/src/App/Xlsx.hs

@@ -1,50 +1,118 @@
-{-# OPTIONS_GHC -Wno-deprecations #-}
-{-# OPTIONS_GHC -Wno-x-partial #-}
-
 module App.Xlsx
   ( newXlsx,
     xlsxFile,
     xlsxMime,
   )
 where
 
+import App.Types
 import Codec.Xlsx
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Map as Map
-import Functora.Miso.Prelude
+import Functora.Miso.Prelude hiding ((^.), _Just)
 import Lens.Micro hiding (each, to)
-import qualified Prelude
 
-newXlsx :: Map Unicode Rfc2397 -> BL.ByteString
-newXlsx imgs = xlsx
+newXlsx :: St Unique -> Map Unicode Rfc2397 -> BL.ByteString
+newXlsx st imgs = xlsx
   where
     xlsx =
       fromXlsx 0
         $ def
-        & atSheet "List1" ?~ sheet
+        & atSheet "Delivery Calculator" ?~ sheet
     sheet =
       def
-        & cellValueAt (1, 2) ?~ CellDouble 42.0
-        & cellValueAt (3, 2) ?~ CellText "foo"
-        & #wsDrawing ?~ drawing (Prelude.head $ Map.elems imgs)
+        & #wsDrawing ?~ Drawing mempty
+        & addHeader st
+        & flip
+          (foldl $ addRow imgs)
+          ( zip [2 ..]
+              $ fmap
+                (^.. #assetFieldPairs . each . #fieldPairValue)
+                (st ^. #stAssets)
+          )
+
+addHeader :: St Unique -> Worksheet -> Worksheet
+addHeader st sheet =
+  case sortOn length headers of
+    [] -> sheet
+    (rowVal : _) ->
+      foldl
+        ( \acc (colIdx, colVal) ->
+            acc
+              & cellValueAt (1, colIdx) ?~ CellText colVal
+        )
+        sheet
+        $ zip [1 ..] rowVal
+  where
+    headers :: [[Unicode]]
+    headers =
+      fmap
+        ( ^..
+            #assetFieldPairs
+              . each
+              . #fieldPairKey
+              . #fieldOutput
+        )
+        $ stAssets st
+
+addRow ::
+  Map Unicode Rfc2397 ->
+  Worksheet ->
+  (RowIndex, [Field DynamicField Unique]) ->
+  Worksheet
+addRow imgs sheet (rowIdx, rowVal) =
+  foldl
+    ( \acc (colIdx, colVal) ->
+        addCol imgs acc rowIdx colIdx colVal
+    )
+    sheet
+    $ zip [1 ..] rowVal
+
+addCol ::
+  Map Unicode Rfc2397 ->
+  Worksheet ->
+  RowIndex ->
+  ColumnIndex ->
+  Field DynamicField Unique ->
+  Worksheet
+addCol imgs sheet rowIdx colIdx field =
+  if fieldType field /= FieldTypeImage
+    then
+      sheet
+        & cellValueAt (rowIdx, colIdx)
+          ?~ CellText txt
+    else case Map.lookup txt imgs of
+      --
+      -- TODO : handle img link
+      --
+      Nothing ->
+        sheet
+          & cellValueAt (rowIdx, colIdx)
+            ?~ CellText txt
+      Just img ->
+        sheet
+          & #wsDrawing . _Just %~ \case
+            Drawing xs ->
+              Drawing $ newImg rowIdx colIdx (length xs) img : xs
+  where
+    txt = field ^. #fieldInput . #uniqueValue
 
-drawing :: Rfc2397 -> Drawing
-drawing rfc2397 = Drawing [anchor1]
+newImg :: RowIndex -> ColumnIndex -> Int -> Rfc2397 -> Anchor FileInfo a
+newImg (RowIndex rowIdx) (ColumnIndex colIdx) imgIdx rfc2397 =
+  Anchor
+    { anchAnchoring =
+        TwoCellAnchor
+          { tcaFrom = unqMarker (colIdx - 1, 0) (rowIdx - 1, 0),
+            tcaTo = unqMarker (colIdx, 0) (rowIdx, 0),
+            tcaEditAs = EditAsTwoCell
+          },
+      anchObject = obj,
+      anchClientData = def
+    }
   where
-    anchor1 =
-      Anchor
-        { anchAnchoring =
-            TwoCellAnchor
-              { tcaFrom = unqMarker (1, 0) (1, 0),
-                tcaTo = unqMarker (5, 0) (13, 0),
-                tcaEditAs = EditAsTwoCell
-              },
-          anchObject = obj,
-          anchClientData = def
-        }
     obj =
       picture
-        (DrawingElementId 0)
+        (DrawingElementId imgIdx)
         FileInfo
           { fiFilename = "img",
             fiContentType = decodeUtf8 $ rfc2397Mime rfc2397,