clerk (empty) → 0.1.0.0
raw patch · 8 files changed
+1252/−0 lines, 8 filesdep +basedep +bytestringdep +clerksetup-changed
Dependencies added: base, bytestring, clerk, containers, data-default, lens, mtl, text, time, transformers, xlsx
Files
- CHANGELOG.md +11/−0
- LICENSE +30/−0
- README.md +316/−0
- Setup.hs +2/−0
- app/Main.hs +6/−0
- clerk.cabal +103/−0
- src/Clerk.hs +544/−0
- src/Example.lhs +240/−0
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog for `haskell`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright value (c) 2022++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of value nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,316 @@+# clerk++`clerk` is a library for declarative spreadsheet generation using a Haskell eDSL.++It extends upon the [work](https://youtu.be/1xGoa-zEOrQ) of Kudasov by making the tables' layout more flexible.++## Features++`clerk` produces a styled spreadsheet with some data and formulas on it. These formulas will be calculated by the target spreadsheet system.++The library supports++- typed cell references - `Cell Double`+- type-safe arithmetic operations - `(a :: Cell Double) + (b :: Cell Double)`+- range references - `a |:| b` -> `A1:B1`+- formulas - `(e :: Expr Double) = "SUM" |$| [(a |:| b)]` -> `SUM(A1:B1)`+- conditional styles, formatting, column widths++The example below demonstrates some of these features.++## Example++This is a demo program that uses `clerk` to produce an `xlsx` file that looks as follows:++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/demoValues.png" width = "80%">++Alternatively, with formulas enabled:++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/demoFormulas.png" width = "80%">++This file has a sheet with several tables. These are tables for+constants' header, a table per a constant's value (three of them), volume & pressure header, volume & pressure values.+Let's see how we can construct such a sheet.++### Imports++First, we import the necessary stuff.++```haskell+module Example (main) where+import Clerk+import Codec.Xlsx qualified as X+import Codec.Xlsx.Formatted qualified as X+import Control.Lens ((%~), (&), (?~))+import Data.ByteString.Lazy qualified as L+import Data.Text qualified as T+import Data.Time.Clock.POSIX (getPOSIXTime)+import Control.Monad (void)+```++### Inputs++Following that, we declare a number of data types that we'll use to store the input values.++A type for constants' headers.++```haskell+data ConstantsHeader = ConstantsHeader+ { hConstant :: String+ , hSymbol :: String+ , hValue :: String+ , hUnits :: String+ }++constantsHeader :: ConstantsHeader+constantsHeader =+ ConstantsHeader+ { hConstant = "constant"+ , hSymbol = "symbol"+ , hValue = "value"+ , hUnits = "units"+ }+```++A type for constants' data.++```haskell+data ConstantsData a = ConstantsData+ { name :: String+ , symbol :: String+ , value :: a+ , units :: String+ }+```++Additionally, we declare a helper type that will store all constants together.++```haskell+data ConstantsInput = ConstantsInput+ { gas :: ConstantsData Double+ , nMoles :: ConstantsData Double+ , temperature :: ConstantsData Double+ }++constants :: ConstantsInput+constants =+ ConstantsInput+ { gas = ConstantsData "GAS CONSTANT" "R" 0.08206 "L.atm/mol.K"+ , nMoles = ConstantsData "NUMBER OF MOLES" "n" 1 "moles"+ , temperature = ConstantsData "TEMPERATURE(K)" "T" 273.2 "K"+ }+```++A type for the Volume & Pressure header.++```haskell+data ValuesHeader = ValuesHeader+ { hVolume :: String+ , hPressure :: String+ }++valuesHeader :: ValuesHeader+valuesHeader =+ ValuesHeader+ { hVolume = "VOLUME (L)"+ , hPressure = "PRESSURE (atm)"+ }+```++The last type is for volume inputs. We just generate them++```haskell+newtype Volume = Volume+ { volume :: Double+ }++volumeData :: [Volume]+volumeData = take 10 $ Volume <$> [1 ..]+```++### Styles++Following the headers and data types, we define the styles. Let's start with colors.+We select several color codes and store them into `colors`++```haskell+data Colors = Colors+ { lightBlue :: T.Text+ , lightGreen :: T.Text+ , blue :: T.Text+ , green :: T.Text+ }++colors :: Colors+colors =+ Colors+ { lightGreen = "90CCFFCC"+ , lightBlue = "90CCFFFF"+ , blue = "FF99CCFF"+ , green = "FF00FF00"+ }+```++Next, we convert them to `FormatCell` function++```haskell+colorBlue :: FormatCell+colorBlue = mkColorStyle colors.blue++colorLightBlue :: FormatCell+colorLightBlue = mkColorStyle colors.lightBlue++colorGreen :: FormatCell+colorGreen = mkColorStyle colors.green++colorMixed :: FormatCell+colorMixed coords idx = mkColorStyle (if even idx then colors.lightGreen else colors.lightBlue) coords idx+```++Additionally, we compose a transform for the number format++```haskell+-- | allow 2 decimal digits+nf2decimal :: FCTransform+nf2decimal fc = fc & X.formattedFormat %~ (\ff -> ff & X.formatNumberFormat ?~ X.StdNumberFormat X.Nf2Decimal)+```++And a transform for centering the cell contents++```haskell+alignCenter :: FCTransform+alignCenter = horizontalAlignment X.CellHorizontalAlignmentCenter+```++### `Builder`s++Now, we are able to compose the `Builder`s for tables.++A builder for the constants header.++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/constantsHeader.png" width = "50%">++```haskell+constantsHeaderBuilder :: Builder ConstantsHeader CellData (Coords, Coords)+constantsHeaderBuilder = do+ tl <- columnWidth 20 (alignCenter <| colorBlue) hConstant+ columnWidth_ 8 (alignCenter <| colorBlue) hSymbol+ column_ (alignCenter <| colorBlue) hValue+ tr <- columnWidth 13 (alignCenter <| colorBlue) hUnits+ return (unCell tl, unCell tr)+```++A builder for a constant. We'll use this builder for each constant separately+as each constant produces cells of a specific type.++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/constants.png" width = "50%">++```haskell+constantBuilder :: forall a. ToCellData a => Builder (ConstantsData a) CellData (Coords, Cell a)+constantBuilder = do+ topLeft <- column colorLightBlue name+ column_ colorLightBlue symbol+ value <- column (nf2decimal <| colorLightBlue) value+ column_ colorLightBlue units+ return (unCell topLeft, value)+```++A builder for values' header.++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/valuesHeader.png" width = "50%">++```haskell+valuesHeaderBuilder :: Builder ValuesHeader CellData Coords+valuesHeaderBuilder = do+ tl <- columnWidth 12 colorGreen hVolume+ columnWidth_ 16 colorGreen hPressure+ return (unCell tl)+```++To pass values in a structured way, we make a helper type.++```haskell+data ConstantsValues = ConstantsValues+ { gas :: Cell Double+ , nMoles :: Cell Double+ , temperature :: Cell Double+ }+```++A builder for volume & pressure (formulas enabled)++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/valuesFormulas.png" width = "50%">++```haskell+valuesBuilder :: ConstantsValues -> Builder Volume CellData ()+valuesBuilder cv = do+ volume' <- column colorMixed volume+ let pressure' = ex cv.gas |*| ex cv.nMoles |*| ex cv.temperature |/| ex volume'+ column_ (nf2decimal <| colorMixed) (const pressure')+```++### `SheetBuilder`++The `SheetBuilder` is used to place builders onto a sheet and glue them together++```haskell+full :: SheetBuilder ()+full = do+ (constantsHeaderTL, constantsHeaderTR) <- placeInput (Coords 2 2) constantsHeader constantsHeaderBuilder+ (gasTL, gas) <- placeInput (overRow (+ 2) constantsHeaderTL) constants.gas constantBuilder+ (nMolesTL, nMoles) <- placeInput (overRow (+ 1) gasTL) constants.nMoles constantBuilder+ temperature <- snd <$> placeInput (overRow (+ 1) nMolesTL) constants.temperature constantBuilder+ valuesHeaderTL <- placeInput (overCol (+ 2) constantsHeaderTR) valuesHeader valuesHeaderBuilder+ placeInputs_ (overRow (+ 2) valuesHeaderTL) volumeData (valuesBuilder $ ConstantsValues{..})+```++### Result++Now, we can write the result and get the spreadsheet images that you've seen at the top of this tutorial.++```haskell+writeWorksheet :: SheetBuilder a -> String -> IO ()+writeWorksheet tb name = do+ ct <- getPOSIXTime+ let+ xlsx = composeXlsx [("List 1", void tb)]+ L.writeFile ("example-" <> name <> ".xlsx") $ X.fromXlsx ct xlsx++writeEx :: IO ()+writeEx = writeWorksheet full "1"++main :: IO ()+main = writeEx+```++Run++```console+stack run+```++to get `example-1.xlsx`.++With formulas enabled, `example-1.xlsx` looks like this:++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/demoFormulas.png" width = "80%">++## Contribute++### Prerequisites++As this project uses `Nix` for dev environment, study the following prerequisites to set up the project++- [Prerequisites](https://github.com/deemp/flakes#prerequisites)+- `Haskell` project [template](https://github.com/deemp/flakes/tree/main/templates/codium/haskell#readme)+- [Haskell](https://github.com/deemp/flakes/blob/main/README/Haskell.md)++Next, run++```sh+nix develop nix-dev/+write-settings-json+codium .+```++and open a `Haskell` file. `HLS` should soon start giving you hints.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Example qualified as E (main)++main :: IO ()+main = E.main
+ clerk.cabal view
@@ -0,0 +1,103 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.0.+--+-- see: https://github.com/sol/hpack++name: clerk+version: 0.1.0.0+synopsis: Declaratively describe spreadsheets and generate xlsx+description: Please see the README on GitHub at <https://github.com/deemp/clerk#readme>+category: spreadsheet+homepage: https://github.com/deemp/clerk#readme+bug-reports: https://github.com/deemp/clerk/issues+author: Danila Danko, Nickolay Kudasov+maintainer: Danila Danko+copyright: Danila Danko, Nickolay Kudasov+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/deemp/clerk++library+ exposed-modules:+ Clerk+ Example+ other-modules:+ Paths_clerk+ hs-source-dirs:+ src+ default-extensions:+ DataKinds+ DeriveFunctor+ FlexibleContexts+ FlexibleInstances+ OverloadedStrings+ OverloadedRecordDot+ GeneralizedNewtypeDeriving+ RankNTypes+ ImportQualifiedPost+ InstanceSigs+ NamedFieldPuns+ RecordWildCards+ TupleSections+ MonoLocalBinds+ TypeSynonymInstances+ DuplicateRecordFields+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ build-depends:+ base >=4.9.0.0 && <5.0+ , bytestring >=0.10.8.0+ , containers >=0.5.0.0+ , data-default >=0.7.1.1+ , lens >=3.8 && <5.3+ , mtl >=2.1+ , text >=0.11.3.1+ , time >=1.4.0.1+ , transformers >=0.3.0.0+ , xlsx >=1.1.0.1+ default-language: Haskell2010++executable clerk+ main-is: Main.hs+ other-modules:+ Paths_clerk+ hs-source-dirs:+ app+ default-extensions:+ DataKinds+ DeriveFunctor+ FlexibleContexts+ FlexibleInstances+ OverloadedStrings+ OverloadedRecordDot+ GeneralizedNewtypeDeriving+ RankNTypes+ ImportQualifiedPost+ InstanceSigs+ NamedFieldPuns+ RecordWildCards+ TupleSections+ MonoLocalBinds+ TypeSynonymInstances+ DuplicateRecordFields+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ build-depends:+ base >=4.9.0.0 && <5.0+ , bytestring >=0.10.8.0+ , clerk+ , containers >=0.5.0.0+ , data-default >=0.7.1.1+ , lens >=3.8 && <5.3+ , mtl >=2.1+ , text >=0.11.3.1+ , time >=1.4.0.1+ , transformers >=0.3.0.0+ , xlsx >=1.1.0.1+ default-language: Haskell2010
+ src/Clerk.hs view
@@ -0,0 +1,544 @@+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}++module Clerk (+ Builder,+ Cell (unCell),+ CellData,+ Coords (Coords),+ FCTransform,+ FormatCell,+ ToCellData,+ SheetBuilder (..),+ column,+ columnWidth,+ columnWidth_,+ column_,+ composeXlsx,+ ex,+ ex',+ horizontalAlignment,+ mkColorStyle,+ overCol,+ overRow,+ placeInput,+ placeInputs_,+ (|+|),+ (|-|),+ (|*|),+ (|/|),+ (|:|),+ (|^|),+ (|$|),+ (<|),+ Expr(..)+) where++import Codec.Xlsx qualified as X+import Codec.Xlsx.Formatted qualified as X+import Control.Lens (Identity (runIdentity), (%~), (&), (?~))+import Control.Lens.Operators ((.~))+import Control.Monad.State (+ MonadState,+ StateT (StateT),+ evalStateT,+ get,+ gets,+ modify,+ void,+ )+import Control.Monad.Trans.Writer (execWriter, runWriter)+import Control.Monad.Writer (MonadWriter (..), Writer)+import Data.Char (toUpper)+import Data.Default (Default (..))+import Data.Foldable (Foldable (..))+import Data.List (intercalate)+import Data.Map.Strict qualified as Map (Map, insert)+import Data.Maybe (isJust, maybeToList)+import Data.Text qualified as T++-- Coords++-- TODO Allow sheet addresses++-- | Coords of a cell+data Coords = Coords {row :: Int, col :: Int}++instance Show Coords where+ show :: Coords -> String+ show (Coords{..}) = toLetters col <> show row++alphabet :: [String]+alphabet = (: "") <$> ['A' .. 'Z']++toLetters :: Int -> String+toLetters x = f "" (x - 1)+ where+ new :: Int -> String -> String+ new cur acc = alphabet !! (cur `mod` 26) <> acc+ f :: String -> Int -> String+ f acc cur = if cur `div` 26 > 0 then f (new cur acc) (cur `div` 26 - 1) else new cur acc++{-+>>>toLetters <$> [1, 26, 27, 52, 78]+["A","Z","AA","AZ","BZ"]+-}++instance Num Coords where+ (+) :: Coords -> Coords -> Coords+ (+) (Coords r1 c1) (Coords r2 c2) = Coords (r1 + r2) (c1 + c2)+ (*) :: Coords -> Coords -> Coords+ (*) (Coords r1 c1) (Coords r2 c2) = Coords (r1 * r2) (c1 * c2)+ (-) :: Coords -> Coords -> Coords+ (-) (Coords r1 c1) (Coords r2 c2) = Coords (r1 - r2) (c1 - c2)+ abs :: Coords -> Coords+ abs (Coords r1 c1) = Coords (abs r1) (abs c1)+ signum :: Coords -> Coords+ signum (Coords r1 c1) = Coords (signum r1) (signum c1)+ fromInteger :: Integer -> Coords+ fromInteger x = Coords (fromIntegral (abs x)) (fromIntegral (abs x))++-- Cell++-- | Index of an input+type Index = Int++-- | Format a single cell depending on its coordinates, index, and data+type FormatCell = Coords -> Index -> CellData -> X.FormattedCell++-- | Cell with contents, style, column props+data CellTemplate input output = CellTemplate+ { mkOutput :: input -> output+ , format :: FormatCell+ , columnsProperties :: Maybe X.ColumnsProperties+ }++-- Transforms++type FormattedMap = Map.Map (X.RowIndex, X.ColumnIndex) X.FormattedCell+type FMTransform = FormattedMap -> FormattedMap+type WSTransform = X.Worksheet -> X.Worksheet++-- | A transform of the map of formats and a transform of a worksheet+data Transform = Transform {fmTransform :: FMTransform, wsTransform :: WSTransform}++instance Semigroup Transform where+ (<>) :: Transform -> Transform -> Transform+ (Transform a1 b1) <> (Transform a2 b2) = Transform (a2 . a1) (b2 . b1)++instance Monoid Transform where+ mempty :: Transform+ mempty = Transform id id++instance Default Transform where+ def :: Transform+ def = mempty++-- Template++-- | Template for multiple cells+newtype Template input output = Template [CellTemplate input output]+ deriving (Semigroup, Monoid)++-- Builder++-- | A builder+newtype Builder input output a = Builder {unBuilder :: StateT Coords (Writer (Template input output)) a}+ deriving (Functor, Applicative, Monad, MonadState Coords, MonadWriter (Template input output))++-- | Run builder on given coordinates. Get a result and a template+runBuilder :: Builder input output a -> Coords -> (a, Template input output)+runBuilder builder coord = runWriter (evalStateT (unBuilder builder) coord)++-- | Run builder on given coordinates. Get a template+evalBuilder :: Builder input output a -> Coords -> Template input output+evalBuilder builder coord = snd $ runBuilder builder coord++-- | Run builder on given coordinates. Get a result+execBuilder :: Builder input output a -> Coords -> a+execBuilder builder coord = fst $ runBuilder builder coord++type RenderTemplate m input output = (Monad m, ToCellData output) => Coords -> Index -> input -> Template input output -> m Transform+type RenderBuilderInputs m input output a = (Monad m, ToCellData output) => Builder input output a -> [input] -> m (Transform, a)+type RenderBuilderInput m input output a = (Monad m, ToCellData output) => Builder input output a -> input -> m (Transform, a)++-- Render+-- meaning produce a transform++-- | Render a builder with given coords and inputs. Return the result calculated using the topmost row+renderBuilderInputs :: (Monad m, ToCellData output) => Coords -> RenderTemplate m input output -> RenderBuilderInputs m input output a+renderBuilderInputs offset render builder inputs = ret+ where+ ts =+ [ (coord, template)+ | row <- [0 .. length inputs]+ , let coord = offset + Coords{row, col = 0}+ template = evalBuilder builder coord+ ]+ -- result obtained from the top row+ a = execBuilder builder (offset + Coords{row = 0, col = 0})+ transform =+ fold+ <$> sequenceA+ ( zipWith3+ ( \input inputIdx (coord, template) ->+ render coord inputIdx input template+ )+ inputs+ [0 ..]+ ts+ )+ ret = (,a) <$> transform++-- | Render a template with a given offset, input index and input+renderTemplate :: RenderTemplate m input output+renderTemplate Coords{..} inputIdx input (Template columns) = return $ fold ps+ where+ ps =+ zipWith+ ( \columnIdx mk ->+ let+ CellTemplate{..} = mk+ cd' = toCellData (mkOutput input)+ col' = (col + columnIdx)+ coords' = Coords row col'+ c = format coords' inputIdx cd'+ fmTransform = Map.insert (fromIntegral row, fromIntegral col') c+ wsTransform+ -- add column width only once+ | inputIdx == 0 = X.wsColumnsProperties %~ (\x -> x ++ maybeToList columnsProperties)+ | otherwise = id+ in+ def{fmTransform, wsTransform}+ )+ [0 ..]+ columns++-- Columns++newtype ColumnsProperties = ColumnsProperties {unColumnsProperties :: X.ColumnsProperties}++instance Default ColumnsProperties where+ def :: ColumnsProperties+ def =+ ColumnsProperties+ X.ColumnsProperties+ { cpMin = 1+ , cpMax = 1+ , cpWidth = Nothing+ , cpStyle = Nothing+ , cpHidden = False+ , cpCollapsed = False+ , cpBestFit = False+ }++-- TODO fix doesn't work for non-first row+-- need to filter the final list++-- | Produce a column with a given style and width and get a cell+columnWidthCell :: forall a input output. Maybe Double -> FormatCell -> (input -> output) -> Builder input output (Cell a)+columnWidthCell width format mkOutput = do+ coords <- get+ let columnsProperties =+ Just $+ (unColumnsProperties def)+ { X.cpMin = coords.col+ , X.cpMax = coords.col+ , X.cpWidth = width+ }+ tell (Template [CellTemplate{format, mkOutput, columnsProperties}])+ cell <- gets Cell+ modify (\x -> x{col = (x.col) + 1})+ return cell++columnWidth :: ToCellData output => Double -> FormatCell -> (input -> output) -> Builder input CellData (Cell a)+columnWidth width fmtCell mkOutput = columnWidthCell (Just width) fmtCell (toCellData . mkOutput)++columnWidth_ :: ToCellData output => Double -> FormatCell -> (input -> output) -> Builder input CellData ()+columnWidth_ width fmtCell mkOutput = void (columnWidth width fmtCell mkOutput)++-- | Produce a column with a given style and get a cell+column :: ToCellData output => FormatCell -> (input -> output) -> Builder input CellData (Cell a)+column fmtCell mkOutput = columnWidthCell Nothing fmtCell (toCellData . mkOutput)++-- | Produce a column with a given style+column_ :: ToCellData output => FormatCell -> (input -> output) -> Builder input CellData ()+column_ fmtCell mkOutput = void (column fmtCell mkOutput)++-- | Produce a transform and a result from inputs and a builder+composeTransformResult :: forall a input output. ToCellData output => RenderTemplate Identity input output -> Coords -> [input] -> Builder input output a -> (Transform, a)+composeTransformResult renderTemplate' offset input builder = runIdentity $ renderBuilderInputs offset renderTemplate' builder input++-- | Produce a result+defaultTransformResult :: ToCellData output => Coords -> [input] -> Builder input output a -> (Transform, a)+defaultTransformResult = composeTransformResult renderTemplate++-- TODO+-- Store current sheet info for formulas++-- | Top monad to compose the results of Builders+newtype SheetBuilder a = SheetBuilder {unSheetBuilder :: Writer Transform a}+ deriving (Functor, Applicative, Monad, MonadWriter Transform)++class Functor a => Discardable a where+ discard :: a b -> a ()++placeInputs :: ToCellData output => Coords -> [input] -> Builder input output a -> SheetBuilder a+placeInputs offset inputs b = do+ let transformResult = defaultTransformResult offset inputs b+ tell (fst transformResult)+ return (snd transformResult)++placeInput :: ToCellData output => Coords -> input -> Builder input output a -> SheetBuilder a+placeInput coords input = placeInputs coords [input]++placeInputs_ :: ToCellData output => Coords -> [input] -> Builder input output a -> SheetBuilder ()+placeInputs_ coords inputs b = void (placeInputs coords inputs b)++placeInput_ :: ToCellData output => Coords -> input -> Builder input output a -> SheetBuilder ()+placeInput_ coords input = placeInputs_ coords [input]++composeXlsx :: [(T.Text, SheetBuilder ())] -> X.Xlsx+composeXlsx sheetBuilders = workBook'+ where+ getTransform x = execWriter $ unSheetBuilder x+ workBook = X.formatWorkbook ((\(name, tf') -> (name, (getTransform tf').fmTransform X.def)) <$> sheetBuilders) X.def+ filterWidths ws = ws & X.wsColumnsProperties %~ filter (isJust . X.cpWidth)+ workBook' =+ workBook+ & X.xlSheets+ %~ \sheets -> zipWith (\x (name, ws) -> (name, (getTransform x).wsTransform ws & filterWidths)) (snd <$> sheetBuilders) sheets++{- Lib. Formulas -}++-- | Formula expressions+data Expr t+ = Add (Expr t) (Expr t)+ | Sub (Expr t) (Expr t)+ | Mul (Expr t) (Expr t)+ | Div (Expr t) (Expr t)+ | Function String [Expr t]+ | Range (Expr t) (Expr t)+ | ExprCell (Cell t)+ deriving (Functor)++-- | Change phantom type of an Expr+ex' :: forall b a. Expr a -> Expr b+ex' = toExpr++-- | Something that can be turned into an expression+class ToExpr v where+ toExpr :: v -> Expr t++instance ToExpr (Cell a) where+ toExpr :: Cell a -> Expr t+ toExpr (Cell c) = ExprCell (Cell c)++instance ToExpr Coords where+ toExpr :: Coords -> Expr t+ toExpr c = ExprCell (Cell c)++toExprCell :: Cell a -> Coords+toExprCell (Cell c1) = c1++instance ToExpr (Expr a) where+ toExpr :: Expr a -> Expr b+ toExpr (Add l r) = Add (toExpr l) (toExpr r)+ toExpr (Sub l r) = Sub (toExpr l) (toExpr r)+ toExpr (Mul l r) = Mul (toExpr l) (toExpr r)+ toExpr (Div l r) = Div (toExpr l) (toExpr r)+ toExpr (Function name args) = Function name (toExpr <$> args)+ toExpr (Range l r) = Range (toExpr l) (toExpr r)+ toExpr (ExprCell (Cell c)) = ExprCell (Cell c)++showOp2 :: (Show a, Show b) => String -> a -> b -> String+showOp2 operator c1 c2 = show c1 <> operator <> show c2++mkOp2 :: (ToExpr a, ToExpr b) => (Expr t -> Expr t -> Expr t) -> a -> b -> Expr t+mkOp2 f c1 c2 = f (toExpr c1) (toExpr c2)++mkNumOp2 :: (Num t, ToExpr a, ToExpr b) => (Expr t -> Expr t -> Expr t) -> a -> b -> Expr t+mkNumOp2 = mkOp2++-- | Assemble a range expression+(|:|) :: Cell a -> Cell b -> Expr c+(|:|) = mkOp2 Range++infixr 5 |:|++-- | Assemble an addition expression+(|+|) :: Num a => Expr a -> Expr a -> Expr a+(|+|) = mkNumOp2 Add++infixl 6 |+|++-- | Assemble a subtraction expression+(|-|) :: Num a => Expr a -> Expr a -> Expr a+(|-|) = mkNumOp2 Sub++infixl 6 |-|++-- | Assemble a division expression+(|/|) :: Num a => Expr a -> Expr a -> Expr a+(|/|) = mkNumOp2 Div++infixl 7 |/|++-- | Assemble a multiplication expression+(|*|) :: Num a => Expr a -> Expr a -> Expr a+(|*|) = mkNumOp2 Mul++infixl 6 |*|++-- | Assemble a multiplication expression+(|^|) :: Num a => Expr a -> Expr a -> Expr a+(|^|) = mkNumOp2 Mul++infixr 8 |^|++-- | Assemble a function expression+(|$|) :: ToExpr a => String -> [a] -> Expr t+(|$|) n as = Function (toUpper <$> n) (toExpr <$> as)++infixr 0 |$|++instance Show (Expr t) where+ show :: Expr t -> String+ show (Add c1 c2) = showOp2 "+" c1 c2+ show (Sub c1 c2) = showOp2 "-" c1 c2+ show (Mul c1 c2) = showOp2 "*" c1 c2+ show (Div c1 c2) = showOp2 "/" c1 c2+ show (Range c1 c2) = showOp2 ":" c1 c2+ show (ExprCell (Cell e)) = show e+ show (Function n as) = n <> "(" <> intercalate "," (show <$> as) <> ")"++-- | Coordinates of a cell with a given phantom type+newtype Cell a = Cell {unCell :: Coords} deriving (Functor)++cellCol :: Cell a -> Int+cellCol (Cell c) = c.col++cellRow :: Cell a -> Int+cellRow (Cell c) = c.row++overCol :: (Int -> Int) -> Coords -> Coords+overCol f (Coords row col) = Coords row (f col)++overRow :: (Int -> Int) -> Coords -> Coords+overRow f (Coords row col) = Coords (f row) col++instance Num (Cell a) where+ (+) :: Cell a -> Cell a -> Cell a+ (+) (Cell c1) (Cell c2) = Cell (c1 + c2)+ (*) :: Cell a -> Cell a -> Cell a+ (*) (Cell c1) (Cell c2) = Cell (c1 * c2)+ (-) :: Cell a -> Cell a -> Cell a+ (-) (Cell c1) (Cell c2) = Cell (c1 - c2)+ abs :: Cell a -> Cell a+ abs (Cell c1) = Cell (abs c1)+ signum :: Cell a -> Cell a+ signum (Cell c1) = Cell (signum c1)+ fromInteger :: Integer -> Cell a+ fromInteger x = Cell (fromInteger x)++-- | Convert a typed cell to an expression+ex :: Cell a -> Expr a+ex = toExpr++{- Lib.Example.Typechecks+>>>str = ex (Cell (Coords 1 1)) :: Expr String+>>> str |+| str+No instance for (Num String) arising from a use of `|+|'+In the expression: str |+| str+NOW In an equation for `it_a1TViD': it_a1TViD = str |+| str++>>>int = ex (Cell (Coords 1 1)) :: Expr Int+>>>double = ex (Cell (Coords 2 5)) :: Expr Double+>>>ex' int |+| double+A1+E2+-}++mkColorStyle :: T.Text -> FormatCell+mkColorStyle color _ _ cd =+ X.def+ & X.formattedCell .~ dataCell cd+ & X.formattedFormat+ .~ ( X.def+ & X.formatFill+ ?~ ( X.def+ & X.fillPattern+ ?~ ( X.def+ & ( X.fillPatternFgColor+ ?~ (X.def & X.colorARGB ?~ color)+ )+ & ( X.fillPatternType+ ?~ X.PatternTypeSolid+ )+ )+ )+ )++type FCTransform = X.FormattedCell -> X.FormattedCell++infixl 5 <|+(<|) :: FCTransform -> FormatCell -> FormatCell+f <| fc = \coords idx cd -> f $ fc coords idx cd++horizontalAlignment :: X.CellHorizontalAlignment -> FCTransform+horizontalAlignment alignment fc =+ fc+ & X.formattedFormat+ %~ ( \ff ->+ ff+ & X.formatAlignment+ ?~ ( X.def & X.alignmentHorizontal ?~ alignment+ )+ )++-- | A union of some Cell components+data CellData+ = CellFormula X.CellFormula+ | CellValue X.CellValue+ | CellComment X.Comment++-- | Convert some Cell component into a cell+dataCell :: CellData -> X.Cell+dataCell cd =+ X.def+ & case cd of+ CellValue d -> X.cellValue ?~ d+ CellFormula d -> X.cellFormula ?~ d+ CellComment d -> X.cellComment ?~ d++class ToCellData a where+ toCellData :: a -> CellData++instance ToCellData String where+ toCellData :: String -> CellData+ toCellData = CellValue . X.CellText . T.pack++instance ToCellData Int where+ toCellData :: Int -> CellData+ toCellData = CellValue . X.CellDouble . fromIntegral++instance ToCellData Double where+ toCellData :: Double -> CellData+ toCellData = CellValue . X.CellDouble++instance ToCellData Bool where+ toCellData :: Bool -> CellData+ toCellData = CellValue . X.CellBool++instance ToCellData CellData where+ toCellData :: CellData -> CellData+ toCellData = id++instance ToCellData (Expr a) where+ toCellData :: Expr a -> CellData+ toCellData e =+ CellFormula+ X.CellFormula+ { X._cellfAssignsToName = False+ , X._cellfCalculate = True+ , X._cellfExpression = X.NormalFormula $ X.Formula $ T.pack $ show e+ }
+ src/Example.lhs view
@@ -0,0 +1,240 @@+ ## Example++This is a demo program that uses `clerk` to produce an `xlsx` file that looks as follows:++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/demoValues.png" width = "80%">++Alternatively, with formulas enabled:++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/demoFormulas.png" width = "80%">++This file has a sheet with several tables. These are tables for+constants' header, a table per a constant's value (three of them), volume & pressure header, volume & pressure values.+Let's see how we can construct such a sheet.++ ### Imports++First, we import the necessary stuff.++> module Example (main) where+> import Clerk+> import Codec.Xlsx qualified as X+> import Codec.Xlsx.Formatted qualified as X+> import Control.Lens ((%~), (&), (?~))+> import Data.ByteString.Lazy qualified as L+> import Data.Text qualified as T+> import Data.Time.Clock.POSIX (getPOSIXTime)+> import Control.Monad (void)++ ### Inputs++Following that, we declare a number of data types that we'll use to store the input values.++A type for constants' headers.++> data ConstantsHeader = ConstantsHeader+> { hConstant :: String+> , hSymbol :: String+> , hValue :: String+> , hUnits :: String+> }+> +> constantsHeader :: ConstantsHeader+> constantsHeader =+> ConstantsHeader+> { hConstant = "constant"+> , hSymbol = "symbol"+> , hValue = "value"+> , hUnits = "units"+> }++A type for constants' data.++> data ConstantsData a = ConstantsData+> { name :: String+> , symbol :: String+> , value :: a+> , units :: String+> }++Additionally, we declare a helper type that will store all constants together.++> data ConstantsInput = ConstantsInput+> { gas :: ConstantsData Double+> , nMoles :: ConstantsData Double+> , temperature :: ConstantsData Double+> }+> +> constants :: ConstantsInput+> constants =+> ConstantsInput+> { gas = ConstantsData "GAS CONSTANT" "R" 0.08206 "L.atm/mol.K"+> , nMoles = ConstantsData "NUMBER OF MOLES" "n" 1 "moles"+> , temperature = ConstantsData "TEMPERATURE(K)" "T" 273.2 "K"+> }++A type for the Volume & Pressure header.++> data ValuesHeader = ValuesHeader+> { hVolume :: String+> , hPressure :: String+> }+> +> valuesHeader :: ValuesHeader+> valuesHeader =+> ValuesHeader+> { hVolume = "VOLUME (L)"+> , hPressure = "PRESSURE (atm)"+> }++The last type is for volume inputs. We just generate them++> newtype Volume = Volume+> { volume :: Double+> }+> +> volumeData :: [Volume]+> volumeData = take 10 $ Volume <$> [1 ..]++ ### Styles++Following the headers and data types, we define the styles. Let's start with colors.+We select several color codes and store them into `colors`++> data Colors = Colors+> { lightBlue :: T.Text+> , lightGreen :: T.Text+> , blue :: T.Text+> , green :: T.Text+> }+> +> colors :: Colors+> colors =+> Colors+> { lightGreen = "90CCFFCC"+> , lightBlue = "90CCFFFF"+> , blue = "FF99CCFF"+> , green = "FF00FF00"+> }++Next, we convert them to `FormatCell` function++> colorBlue :: FormatCell+> colorBlue = mkColorStyle colors.blue+> +> colorLightBlue :: FormatCell+> colorLightBlue = mkColorStyle colors.lightBlue+> +> colorGreen :: FormatCell+> colorGreen = mkColorStyle colors.green+> +> colorMixed :: FormatCell+> colorMixed coords idx = mkColorStyle (if even idx then colors.lightGreen else colors.lightBlue) coords idx++Additionally, we compose a transform for the number format++> -- | allow 2 decimal digits+> nf2decimal :: FCTransform+> nf2decimal fc = fc & X.formattedFormat %~ (\ff -> ff & X.formatNumberFormat ?~ X.StdNumberFormat X.Nf2Decimal)++And a transform for centering the cell contents++> alignCenter :: FCTransform+> alignCenter = horizontalAlignment X.CellHorizontalAlignmentCenter++ ### `Builder`s++Now, we are able to compose the `Builder`s for tables.++A builder for the constants header.++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/constantsHeader.png" width = "50%">++> constantsHeaderBuilder :: Builder ConstantsHeader CellData (Coords, Coords)+> constantsHeaderBuilder = do+> tl <- columnWidth 20 (alignCenter <| colorBlue) hConstant+> columnWidth_ 8 (alignCenter <| colorBlue) hSymbol+> column_ (alignCenter <| colorBlue) hValue+> tr <- columnWidth 13 (alignCenter <| colorBlue) hUnits+> return (unCell tl, unCell tr)++A builder for a constant. We'll use this builder for each constant separately+as each constant produces cells of a specific type.++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/constants.png" width = "50%">++> constantBuilder :: forall a. ToCellData a => Builder (ConstantsData a) CellData (Coords, Cell a)+> constantBuilder = do+> topLeft <- column colorLightBlue name+> column_ colorLightBlue symbol+> value <- column (nf2decimal <| colorLightBlue) value+> column_ colorLightBlue units+> return (unCell topLeft, value)++A builder for values' header.++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/valuesHeader.png" width = "50%">++> valuesHeaderBuilder :: Builder ValuesHeader CellData Coords+> valuesHeaderBuilder = do+> tl <- columnWidth 12 colorGreen hVolume+> columnWidth_ 16 colorGreen hPressure+> return (unCell tl)++To pass values in a structured way, we make a helper type.++> data ConstantsValues = ConstantsValues+> { gas :: Cell Double+> , nMoles :: Cell Double+> , temperature :: Cell Double+> }++A builder for volume & pressure (formulas enabled)++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/valuesFormulas.png" width = "50%">++> valuesBuilder :: ConstantsValues -> Builder Volume CellData ()+> valuesBuilder cv = do+> volume' <- column colorMixed volume+> let pressure' = ex cv.gas |*| ex cv.nMoles |*| ex cv.temperature |/| ex volume'+> column_ (nf2decimal <| colorMixed) (const pressure')++ ### `SheetBuilder`++The `SheetBuilder` is used to place builders onto a sheet and glue them together++> full :: SheetBuilder ()+> full = do+> (constantsHeaderTL, constantsHeaderTR) <- placeInput (Coords 2 2) constantsHeader constantsHeaderBuilder+> (gasTL, gas) <- placeInput (overRow (+ 2) constantsHeaderTL) constants.gas constantBuilder+> (nMolesTL, nMoles) <- placeInput (overRow (+ 1) gasTL) constants.nMoles constantBuilder+> temperature <- snd <$> placeInput (overRow (+ 1) nMolesTL) constants.temperature constantBuilder+> valuesHeaderTL <- placeInput (overCol (+ 2) constantsHeaderTR) valuesHeader valuesHeaderBuilder+> placeInputs_ (overRow (+ 2) valuesHeaderTL) volumeData (valuesBuilder $ ConstantsValues{..})++ ### Result++Now, we can write the result and get the spreadsheet images that you've seen at the top of this tutorial.++> writeWorksheet :: SheetBuilder a -> String -> IO ()+> writeWorksheet tb name = do+> ct <- getPOSIXTime+> let+> xlsx = composeXlsx [("List 1", void tb)]+> L.writeFile ("example-" <> name <> ".xlsx") $ X.fromXlsx ct xlsx+> +> writeEx :: IO ()+> writeEx = writeWorksheet full "1"+> +> main :: IO ()+> main = writeEx++Run++< stack run++to get `example-1.xlsx`.++With formulas enabled, `example-1.xlsx` looks like this:++<img src = "https://raw.githubusercontent.com/deemp/clerk/master/README/demoFormulas.png" width = "80%">