## 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
>     { ConstantsHeader -> String
hConstant :: String
>     , ConstantsHeader -> String
hSymbol :: String
>     , ConstantsHeader -> String
hValue :: String
>     , ConstantsHeader -> String
hUnits :: String
>     }
> 
> constantsHeader :: ConstantsHeader
> constantsHeader :: ConstantsHeader
constantsHeader =
>     ConstantsHeader
>         { $sel:hConstant:ConstantsHeader :: String
hConstant = String
"constant"
>         , $sel:hSymbol:ConstantsHeader :: String
hSymbol = String
"symbol"
>         , $sel:hValue:ConstantsHeader :: String
hValue = String
"value"
>         , $sel:hUnits:ConstantsHeader :: String
hUnits = String
"units"
>         }

A type for constants' data.

> data ConstantsData a = ConstantsData
>     { forall a. ConstantsData a -> String
name :: String
>     , forall a. ConstantsData a -> String
symbol :: String
>     , forall a. ConstantsData a -> a
value :: a
>     , forall a. ConstantsData a -> String
units :: String
>     }

Additionally, we declare a helper type that will store all constants together.

> data ConstantsInput = ConstantsInput
>     { ConstantsInput -> ConstantsData Double
gas :: ConstantsData Double
>     , ConstantsInput -> ConstantsData Double
nMoles :: ConstantsData Double
>     , ConstantsInput -> ConstantsData Double
temperature :: ConstantsData Double
>     }
> 
> constants :: ConstantsInput
> constants :: ConstantsInput
constants =
>     ConstantsInput
>         { $sel:gas:ConstantsInput :: ConstantsData Double
gas = forall a. String -> String -> a -> String -> ConstantsData a
ConstantsData String
"GAS CONSTANT" String
"R" Double
0.08206 String
"L.atm/mol.K"
>         , $sel:nMoles:ConstantsInput :: ConstantsData Double
nMoles = forall a. String -> String -> a -> String -> ConstantsData a
ConstantsData String
"NUMBER OF MOLES" String
"n" Double
1 String
"moles"
>         , $sel:temperature:ConstantsInput :: ConstantsData Double
temperature = forall a. String -> String -> a -> String -> ConstantsData a
ConstantsData String
"TEMPERATURE(K)" String
"T" Double
273.2 String
"K"
>         }

A type for the Volume & Pressure header.

> data ValuesHeader = ValuesHeader
>     { ValuesHeader -> String
hVolume :: String
>     , ValuesHeader -> String
hPressure :: String
>     }
> 
> valuesHeader :: ValuesHeader
> valuesHeader :: ValuesHeader
valuesHeader =
>     ValuesHeader
>         { $sel:hVolume:ValuesHeader :: String
hVolume = String
"VOLUME (L)"
>         , $sel:hPressure:ValuesHeader :: String
hPressure = String
"PRESSURE (atm)"
>         }

The last type is for volume inputs. We just generate them

> newtype Volume = Volume
>     { Volume -> Double
volume :: Double
>     }
> 
> volumeData :: [Volume]
> volumeData :: [Volume]
volumeData = forall a. Index -> [a] -> [a]
take Index
10 forall a b. (a -> b) -> a -> b
$ Double -> Volume
Volume forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
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
>     { Colors -> Text
lightBlue :: T.Text
>     , Colors -> Text
lightGreen :: T.Text
>     , Colors -> Text
blue :: T.Text
>     , Colors -> Text
green :: T.Text
>     }
> 
> colors :: Colors
> colors :: Colors
colors =
>     Colors
>         { $sel:lightGreen:Colors :: Text
lightGreen = Text
"90CCFFCC"
>         , $sel:lightBlue:Colors :: Text
lightBlue = Text
"90CCFFFF"
>         , $sel:blue:Colors :: Text
blue = Text
"FF99CCFF"
>         , $sel:green:Colors :: Text
green = Text
"FF00FF00"
>         }

Next, we convert them to `FormatCell` function

> colorBlue :: FormatCell
> colorBlue :: FormatCell
colorBlue = Text -> FormatCell
mkColorStyle Colors
colors.blue
> 
> colorLightBlue :: FormatCell
> colorLightBlue :: FormatCell
colorLightBlue = Text -> FormatCell
mkColorStyle Colors
colors.lightBlue
> 
> colorGreen :: FormatCell
> colorGreen :: FormatCell
colorGreen = Text -> FormatCell
mkColorStyle Colors
colors.green
> 
> colorMixed :: FormatCell
> colorMixed :: FormatCell
colorMixed Coords
coords Index
idx = Text -> FormatCell
mkColorStyle (if forall a. Integral a => a -> Bool
even Index
idx then Colors
colors.lightGreen else Colors
colors.lightBlue) Coords
coords Index
idx

Additionally, we compose a transform for the number format

> -- | allow 2 decimal digits
> nf2decimal :: FCTransform
> nf2decimal :: FCTransform
nf2decimal FormattedCell
fc = FormattedCell
fc forall a b. a -> (a -> b) -> b
& Lens' FormattedCell Format
X.formattedFormat forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Format
ff -> Format
ff forall a b. a -> (a -> b) -> b
& Lens' Format (Maybe NumberFormat)
X.formatNumberFormat forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ImpliedNumberFormat -> NumberFormat
X.StdNumberFormat ImpliedNumberFormat
X.Nf2Decimal)

And a transform for centering the cell contents

> alignCenter :: FCTransform
> alignCenter :: FCTransform
alignCenter = CellHorizontalAlignment -> FCTransform
horizontalAlignment CellHorizontalAlignment
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 :: Builder ConstantsHeader CellData (Coords, Coords)
constantsHeaderBuilder = do
>     Cell Any
tl <- forall output input a.
ToCellData output =>
Double
-> FormatCell
-> (input -> output)
-> Builder input CellData (Cell a)
columnWidth Double
20 (FCTransform
alignCenter FCTransform -> FormatCell -> FormatCell
<| FormatCell
colorBlue) ConstantsHeader -> String
hConstant
>     forall output input.
ToCellData output =>
Double
-> FormatCell -> (input -> output) -> Builder input CellData ()
columnWidth_ Double
8 (FCTransform
alignCenter FCTransform -> FormatCell -> FormatCell
<| FormatCell
colorBlue) ConstantsHeader -> String
hSymbol
>     forall output input.
ToCellData output =>
FormatCell -> (input -> output) -> Builder input CellData ()
column_ (FCTransform
alignCenter FCTransform -> FormatCell -> FormatCell
<| FormatCell
colorBlue) ConstantsHeader -> String
hValue
>     Cell Any
tr <- forall output input a.
ToCellData output =>
Double
-> FormatCell
-> (input -> output)
-> Builder input CellData (Cell a)
columnWidth Double
13 (FCTransform
alignCenter FCTransform -> FormatCell -> FormatCell
<| FormatCell
colorBlue) ConstantsHeader -> String
hUnits
>     forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Cell a -> Coords
unCell Cell Any
tl, forall a. Cell a -> Coords
unCell Cell Any
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 :: forall a.
ToCellData a =>
Builder (ConstantsData a) CellData (Coords, Cell a)
constantBuilder = do
>     Cell Any
topLeft <- forall output input a.
ToCellData output =>
FormatCell -> (input -> output) -> Builder input CellData (Cell a)
column FormatCell
colorLightBlue forall a. ConstantsData a -> String
name
>     forall output input.
ToCellData output =>
FormatCell -> (input -> output) -> Builder input CellData ()
column_ FormatCell
colorLightBlue forall a. ConstantsData a -> String
symbol
>     Cell a
value <- forall output input a.
ToCellData output =>
FormatCell -> (input -> output) -> Builder input CellData (Cell a)
column (FCTransform
nf2decimal FCTransform -> FormatCell -> FormatCell
<| FormatCell
colorLightBlue) forall a. ConstantsData a -> a
value
>     forall output input.
ToCellData output =>
FormatCell -> (input -> output) -> Builder input CellData ()
column_ FormatCell
colorLightBlue forall a. ConstantsData a -> String
units
>     forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Cell a -> Coords
unCell Cell Any
topLeft, Cell a
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 :: Builder ValuesHeader CellData Coords
valuesHeaderBuilder = do
>     Cell Any
tl <- forall output input a.
ToCellData output =>
Double
-> FormatCell
-> (input -> output)
-> Builder input CellData (Cell a)
columnWidth Double
12 FormatCell
colorGreen ValuesHeader -> String
hVolume
>     forall output input.
ToCellData output =>
Double
-> FormatCell -> (input -> output) -> Builder input CellData ()
columnWidth_ Double
16 FormatCell
colorGreen ValuesHeader -> String
hPressure
>     forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Cell a -> Coords
unCell Cell Any
tl)

To pass values in a structured way, we make a helper type.

> data ConstantsValues = ConstantsValues
>     { ConstantsValues -> Cell Double
gas :: Cell Double
>     , ConstantsValues -> Cell Double
nMoles :: Cell Double
>     , ConstantsValues -> 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 :: ConstantsValues -> Builder Volume CellData ()
valuesBuilder ConstantsValues
cv = do
>     Cell Double
volume' <- forall output input a.
ToCellData output =>
FormatCell -> (input -> output) -> Builder input CellData (Cell a)
column FormatCell
colorMixed Volume -> Double
volume
>     let pressure' :: Expr Double
pressure' = forall a. Cell a -> Expr a
ex ConstantsValues
cv.gas forall a. Num a => Expr a -> Expr a -> Expr a
|*| forall a. Cell a -> Expr a
ex ConstantsValues
cv.nMoles forall a. Num a => Expr a -> Expr a -> Expr a
|*| forall a. Cell a -> Expr a
ex ConstantsValues
cv.temperature forall a. Num a => Expr a -> Expr a -> Expr a
|/| forall a. Cell a -> Expr a
ex Cell Double
volume'
>     forall output input.
ToCellData output =>
FormatCell -> (input -> output) -> Builder input CellData ()
column_ (FCTransform
nf2decimal FCTransform -> FormatCell -> FormatCell
<| FormatCell
colorMixed) (forall a b. a -> b -> a
const Expr Double
pressure')

 ### `SheetBuilder`

The `SheetBuilder` is used to place builders onto a sheet and glue them together

> full :: SheetBuilder ()
> full :: SheetBuilder ()
full = do
>     (Coords
constantsHeaderTL, Coords
constantsHeaderTR) <- forall output input a.
ToCellData output =>
Coords -> input -> Builder input output a -> SheetBuilder a
placeInput (Index -> Index -> Coords
Coords Index
2 Index
2) ConstantsHeader
constantsHeader Builder ConstantsHeader CellData (Coords, Coords)
constantsHeaderBuilder
>     (Coords
gasTL, Cell Double
gas) <- forall output input a.
ToCellData output =>
Coords -> input -> Builder input output a -> SheetBuilder a
placeInput ((Index -> Index) -> Coords -> Coords
overRow (forall a. Num a => a -> a -> a
+ Index
2) Coords
constantsHeaderTL) ConstantsInput
constants.gas forall a.
ToCellData a =>
Builder (ConstantsData a) CellData (Coords, Cell a)
constantBuilder
>     (Coords
nMolesTL, Cell Double
nMoles) <- forall output input a.
ToCellData output =>
Coords -> input -> Builder input output a -> SheetBuilder a
placeInput ((Index -> Index) -> Coords -> Coords
overRow (forall a. Num a => a -> a -> a
+ Index
1) Coords
gasTL) ConstantsInput
constants.nMoles forall a.
ToCellData a =>
Builder (ConstantsData a) CellData (Coords, Cell a)
constantBuilder
>     Cell Double
temperature <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall output input a.
ToCellData output =>
Coords -> input -> Builder input output a -> SheetBuilder a
placeInput ((Index -> Index) -> Coords -> Coords
overRow (forall a. Num a => a -> a -> a
+ Index
1) Coords
nMolesTL) ConstantsInput
constants.temperature forall a.
ToCellData a =>
Builder (ConstantsData a) CellData (Coords, Cell a)
constantBuilder
>     Coords
valuesHeaderTL <- forall output input a.
ToCellData output =>
Coords -> input -> Builder input output a -> SheetBuilder a
placeInput ((Index -> Index) -> Coords -> Coords
overCol (forall a. Num a => a -> a -> a
+ Index
2) Coords
constantsHeaderTR) ValuesHeader
valuesHeader Builder ValuesHeader CellData Coords
valuesHeaderBuilder
>     forall output input a.
ToCellData output =>
Coords -> [input] -> Builder input output a -> SheetBuilder ()
placeInputs_ ((Index -> Index) -> Coords -> Coords
overRow (forall a. Num a => a -> a -> a
+ Index
2) Coords
valuesHeaderTL) [Volume]
volumeData (ConstantsValues -> Builder Volume CellData ()
valuesBuilder forall a b. (a -> b) -> a -> b
$ ConstantsValues{Cell Double
temperature :: Cell Double
nMoles :: Cell Double
gas :: Cell Double
$sel:temperature:ConstantsValues :: Cell Double
$sel:nMoles:ConstantsValues :: Cell Double
$sel:gas:ConstantsValues :: Cell Double
..})

 ### 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 :: forall a. SheetBuilder a -> String -> IO ()
writeWorksheet SheetBuilder a
tb String
name = do
>     POSIXTime
ct <- IO POSIXTime
getPOSIXTime
>     let
>         xlsx :: Xlsx
xlsx = [(Text, SheetBuilder ())] -> Xlsx
composeXlsx [(Text
"List 1", forall (f :: * -> *) a. Functor f => f a -> f ()
void SheetBuilder a
tb)]
>     String -> ByteString -> IO ()
L.writeFile (String
"example-" forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> String
".xlsx") forall a b. (a -> b) -> a -> b
$ POSIXTime -> Xlsx -> ByteString
X.fromXlsx POSIXTime
ct Xlsx
xlsx
> 
> writeEx :: IO ()
> writeEx :: IO ()
writeEx = forall a. SheetBuilder a -> String -> IO ()
writeWorksheet SheetBuilder ()
full String
"1"
> 
> main :: IO ()
> main :: IO ()
main = IO ()
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%">