{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

-- | @Clerk@ library

module Clerk (
  -- * Coords
  -- $Coords
  Coords (..),

  -- * Cell references
  -- $CellRef
  CellRef (..),
  getCol,
  getRow,
  overCol,
  overRow,
  unsafeChangeCellRefType,

  -- * Cell formatting
  -- $Formatting
  InputIndex,
  FormatCell,
  CellTemplate,
  FormattedMap,
  FMTransform,
  WSTransform,
  Transform,
  FCTransform,
  horizontalAlignment,
  mkColorStyle,

  -- * Templates
  -- $Templates
  RowBuilder (..),
  Template (..),
  -- runBuilder,
  -- evalBuilder,
  -- execBuilder,
  -- RenderTemplate,
  -- RenderBuilderInputs,
  -- RenderBuilderInput,
  -- renderBuilderInputs,
  -- renderTemplate,

  -- * Columns
  -- $Columns
  ColumnsProperties (..),
  columnWidthCell,
  columnWidth,
  columnWidth_,
  column,
  column_,

  -- * Sheet builder
  -- $SheetBuilder
  SheetBuilder (..),
  placeInputs,
  placeInputs_,
  placeInput,
  placeInput_,

  -- * Expressions
  -- $Expressions
  Expr (..),
  ToExpr (..),
  ArithmeticOperator,
  (|+|),
  (|-|),
  (|*|),
  (|/|),
  (|:|),
  (|^|),
  (|$|),
  (+>),

  -- * Cells
  -- $Cells
  CellData,
  ToCellData (..),

  -- * Produce xlsx
  -- $Xlsx
  composeXlsx,
) 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

-- TODO Allow sheet addresses

-- TODO Make formulas aware of the current sheet
-- Or, make just formula printers aware so that they don't print the full address
-- when referring to data on the same sheet

{- FOURMOLU_DISABLE -}
-- $Coords
{- FOURMOLU_ENABLE -}

-- | Coords of a cell
data Coords = Coords {Coords -> Int
row :: Int, Coords -> Int
col :: Int}

instance Show Coords where
  show :: Coords -> String
  show :: Coords -> String
show (Coords{Int
col :: Int
row :: Int
$sel:col:Coords :: Coords -> Int
$sel:row:Coords :: Coords -> Int
..}) = Int -> String
toAlphaNumeric Int
col forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
row

instance Num Coords where
  (+) :: Coords -> Coords -> Coords
  + :: Coords -> Coords -> Coords
(+) (Coords Int
r1 Int
c1) (Coords Int
r2 Int
c2) = Int -> Int -> Coords
Coords (Int
r1 forall a. Num a => a -> a -> a
+ Int
r2) (Int
c1 forall a. Num a => a -> a -> a
+ Int
c2)
  (*) :: Coords -> Coords -> Coords
  * :: Coords -> Coords -> Coords
(*) (Coords Int
r1 Int
c1) (Coords Int
r2 Int
c2) = Int -> Int -> Coords
Coords (Int
r1 forall a. Num a => a -> a -> a
* Int
r2) (Int
c1 forall a. Num a => a -> a -> a
* Int
c2)
  (-) :: Coords -> Coords -> Coords
  (-) (Coords Int
r1 Int
c1) (Coords Int
r2 Int
c2) = Int -> Int -> Coords
Coords (Int
r1 forall a. Num a => a -> a -> a
- Int
r2) (Int
c1 forall a. Num a => a -> a -> a
- Int
c2)
  abs :: Coords -> Coords
  abs :: Coords -> Coords
abs (Coords Int
r1 Int
c1) = Int -> Int -> Coords
Coords (forall a. Num a => a -> a
abs Int
r1) (forall a. Num a => a -> a
abs Int
c1)
  signum :: Coords -> Coords
  signum :: Coords -> Coords
signum (Coords Int
r1 Int
c1) = Int -> Int -> Coords
Coords (forall a. Num a => a -> a
signum Int
r1) (forall a. Num a => a -> a
signum Int
c1)
  fromInteger :: Integer -> Coords
  fromInteger :: Integer -> Coords
fromInteger Integer
x = Int -> Int -> Coords
Coords (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Num a => a -> a
abs Integer
x)) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Num a => a -> a
abs Integer
x))

-- | Letters that can be used in column indices
alphabet :: [Char]
alphabet :: String
alphabet = [Char
'A' .. Char
'Z']

-- | Translate a number into an alphanumeric representation. Relevant for columns
toAlphaNumeric :: Int -> String
toAlphaNumeric :: Int -> String
toAlphaNumeric Int
x = String -> Int -> String
f String
"" (Int
x forall a. Num a => a -> a -> a
- Int
1)
 where
  new :: Int -> String -> String
  new :: Int -> ShowS
new Int
cur String
acc = [String
alphabet forall a. [a] -> Int -> a
!! (Int
cur forall a. Integral a => a -> a -> a
`mod` Int
26)] forall a. Semigroup a => a -> a -> a
<> String
acc
  f :: String -> Int -> String
  f :: String -> Int -> String
f String
acc Int
cur = if Int
cur forall a. Integral a => a -> a -> a
`div` Int
26 forall a. Ord a => a -> a -> Bool
> Int
0 then String -> Int -> String
f (Int -> ShowS
new Int
cur String
acc) (Int
cur forall a. Integral a => a -> a -> a
`div` Int
26 forall a. Num a => a -> a -> a
- Int
1) else Int -> ShowS
new Int
cur String
acc

{-
>>>toLetters <$> [1, 26, 27, 52, 78]
["A","Z","AA","AZ","BZ"]
-}

-- {- FOURMOLU_DISABLE -}

-- $CellRef
-- {\- FOURMOLU_ENABLE -\}

-- | A typed reference to a cell.
--
-- The user is responsible for setting the necessary cell type.
--
-- The type prevents operations between cell references with incompatible types.
--
-- >>>str = CellRef (Coords 1 1) :: CellRef String
-- >>> str |+| str
-- No instance for (Num String) arising from a use of ‘|+|’
--
-- When necessary, the user may change the cell reference type via 'unsafeChangeCellRefType'
--
-- >>>int = CellRef (Coords 1 1) :: CellRef Int
-- >>>double = CellRef (Coords 2 5) :: CellRef Double
-- >>>unsafeChangeCellRefType int |+| double
-- A1+E2
newtype CellRef a = CellRef {forall a. CellRef a -> Coords
unCell :: Coords}
  deriving newtype (Integer -> CellRef a
CellRef a -> CellRef a
CellRef a -> CellRef a -> CellRef a
forall a. Integer -> CellRef a
forall a. CellRef a -> CellRef a
forall a. CellRef a -> CellRef a -> CellRef a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> CellRef a
$cfromInteger :: forall a. Integer -> CellRef a
signum :: CellRef a -> CellRef a
$csignum :: forall a. CellRef a -> CellRef a
abs :: CellRef a -> CellRef a
$cabs :: forall a. CellRef a -> CellRef a
negate :: CellRef a -> CellRef a
$cnegate :: forall a. CellRef a -> CellRef a
* :: CellRef a -> CellRef a -> CellRef a
$c* :: forall a. CellRef a -> CellRef a -> CellRef a
- :: CellRef a -> CellRef a -> CellRef a
$c- :: forall a. CellRef a -> CellRef a -> CellRef a
+ :: CellRef a -> CellRef a -> CellRef a
$c+ :: forall a. CellRef a -> CellRef a -> CellRef a
Num)

-- | Get a column number from a 'CellRef'
getCol :: CellRef a -> Int
getCol :: forall a. CellRef a -> Int
getCol (CellRef Coords
c) = Coords
c forall a b. a -> (a -> b) -> b
& Coords -> Int
col

-- | Get a row number from a 'CellRef'
getRow :: CellRef a -> Int
getRow :: forall a. CellRef a -> Int
getRow (CellRef Coords
c) = Coords
c forall a b. a -> (a -> b) -> b
& Coords -> Int
row

-- | Apply a function over a column of a coordinate
overCol :: (Int -> Int) -> Coords -> Coords
overCol :: (Int -> Int) -> Coords -> Coords
overCol Int -> Int
f (Coords Int
row Int
col) = Int -> Int -> Coords
Coords Int
row (Int -> Int
f Int
col)

-- | Apply a function over a row of a coordinate
overRow :: (Int -> Int) -> Coords -> Coords
overRow :: (Int -> Int) -> Coords -> Coords
overRow Int -> Int
f (Coords Int
row Int
col) = Int -> Int -> Coords
Coords (Int -> Int
f Int
row) Int
col

-- | Change the type of a cell reference. Use with caution!
--
-- The type variables in the @forall@ clause are swapped for the conveniece of type applications
unsafeChangeCellRefType :: forall b a. CellRef a -> CellRef b
unsafeChangeCellRefType :: forall b a. CellRef a -> CellRef b
unsafeChangeCellRefType (CellRef Coords
c) = forall a. Coords -> CellRef a
CellRef Coords
c

{- FOURMOLU_DISABLE -}
-- $Formatting
{- FOURMOLU_ENABLE -}

-- | Index of an input
type InputIndex = Int

-- | Format a single cell depending on its coordinates, index, and data
type FormatCell = Coords -> InputIndex -> CellData -> X.FormattedCell

-- | Template of a cell with contents, style, column properties
data CellTemplate input output = CellTemplate
  { forall input output. CellTemplate input output -> input -> output
mkOutput :: input -> output
  , forall input output. CellTemplate input output -> FormatCell
fmtCell :: FormatCell
  , forall input output.
CellTemplate input output -> Maybe ColumnsProperties
columnsProperties :: Maybe X.ColumnsProperties
  }

-- | Map of coordinates to cell formatting
type FormattedMap = Map.Map (X.RowIndex, X.ColumnIndex) X.FormattedCell

-- | Transform of a map that maps coordinates to cell formatting
type FMTransform = FormattedMap -> FormattedMap

-- | Transform of a worksheet
type WSTransform = X.Worksheet -> X.Worksheet

-- | Combined: a transform of a map of formats and a transform of a worksheet
data Transform = Transform {Transform -> FMTransform
fmTransform :: FMTransform, Transform -> WSTransform
wsTransform :: WSTransform}

instance Semigroup Transform where
  (<>) :: Transform -> Transform -> Transform
  (Transform FMTransform
a1 WSTransform
b1) <> :: Transform -> Transform -> Transform
<> (Transform FMTransform
a2 WSTransform
b2) = FMTransform -> WSTransform -> Transform
Transform (FMTransform
a2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FMTransform
a1) (WSTransform
b2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSTransform
b1)

instance Monoid Transform where
  mempty :: Transform
  mempty :: Transform
mempty = FMTransform -> WSTransform -> Transform
Transform forall a. a -> a
id forall a. a -> a
id

instance Default Transform where
  def :: Transform
  def :: Transform
def = forall a. Monoid a => a
mempty

-- | Make a 'FormatCell' for a single color
--
-- @show@ on the input should translate into an @ARGB@ color. See 'XS.Color'
mkColorStyle :: Show a => a -> FormatCell
mkColorStyle :: forall a. Show a => a -> FormatCell
mkColorStyle a
color Coords
_ Int
_ CellData
cd =
  forall a. Default a => a
X.def
    forall a b. a -> (a -> b) -> b
& Lens' FormattedCell Cell
X.formattedCell forall s t a b. ASetter s t a b -> b -> s -> t
.~ CellData -> Cell
dataCell CellData
cd
    forall a b. a -> (a -> b) -> b
& Lens' FormattedCell Format
X.formattedFormat
      forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( forall a. Default a => a
X.def
            forall a b. a -> (a -> b) -> b
& Lens' Format (Maybe Fill)
X.formatFill
              forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ( forall a. Default a => a
X.def
                    forall a b. a -> (a -> b) -> b
& Iso' Fill (Maybe FillPattern)
X.fillPattern
                      forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ( forall a. Default a => a
X.def
                            forall a b. a -> (a -> b) -> b
& ( Lens' FillPattern (Maybe Color)
X.fillPatternFgColor
                                  forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (forall a. Default a => a
X.def forall a b. a -> (a -> b) -> b
& Lens' Color (Maybe Text)
X.colorARGB forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ String -> Text
T.pack (forall a. Show a => a -> String
show a
color))
                              )
                            forall a b. a -> (a -> b) -> b
& ( Lens' FillPattern (Maybe PatternType)
X.fillPatternType
                                  forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ PatternType
X.PatternTypeSolid
                              )
                         )
                 )
         )

-- | Transform of a formatted cell
type FCTransform = X.FormattedCell -> X.FormattedCell

-- | Apply 'FCTransform' to a 'FormatCell' to get a new 'FormatCell'
(+>) :: FormatCell -> FCTransform -> FormatCell
FormatCell
fc +> :: FormatCell -> (FormattedCell -> FormattedCell) -> FormatCell
+> FormattedCell -> FormattedCell
ft = \Coords
coords Int
idx CellData
cd -> FormattedCell -> FormattedCell
ft forall a b. (a -> b) -> a -> b
$ FormatCell
fc Coords
coords Int
idx CellData
cd

infixl 5 +>

-- | Get a 'FCTransform' with a given horizontal alignment in a cell
horizontalAlignment :: X.CellHorizontalAlignment -> FCTransform
horizontalAlignment :: CellHorizontalAlignment -> FormattedCell -> FormattedCell
horizontalAlignment CellHorizontalAlignment
alignment 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 Alignment)
X.formatAlignment
                forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ( forall a. Default a => a
X.def forall a b. a -> (a -> b) -> b
& Lens' Alignment (Maybe CellHorizontalAlignment)
X.alignmentHorizontal forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CellHorizontalAlignment
alignment
                   )
         )

{- FOURMOLU_DISABLE -}
-- $Templates
{- FOURMOLU_ENABLE -}

-- | Template for multiple cells
newtype Template input output = Template [CellTemplate input output]
  deriving (NonEmpty (Template input output) -> Template input output
Template input output
-> Template input output -> Template input output
forall b.
Integral b =>
b -> Template input output -> Template input output
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall input output.
NonEmpty (Template input output) -> Template input output
forall input output.
Template input output
-> Template input output -> Template input output
forall input output b.
Integral b =>
b -> Template input output -> Template input output
stimes :: forall b.
Integral b =>
b -> Template input output -> Template input output
$cstimes :: forall input output b.
Integral b =>
b -> Template input output -> Template input output
sconcat :: NonEmpty (Template input output) -> Template input output
$csconcat :: forall input output.
NonEmpty (Template input output) -> Template input output
<> :: Template input output
-> Template input output -> Template input output
$c<> :: forall input output.
Template input output
-> Template input output -> Template input output
Semigroup, Template input output
[Template input output] -> Template input output
Template input output
-> Template input output -> Template input output
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall input output. Semigroup (Template input output)
forall input output. Template input output
forall input output.
[Template input output] -> Template input output
forall input output.
Template input output
-> Template input output -> Template input output
mconcat :: [Template input output] -> Template input output
$cmconcat :: forall input output.
[Template input output] -> Template input output
mappend :: Template input output
-> Template input output -> Template input output
$cmappend :: forall input output.
Template input output
-> Template input output -> Template input output
mempty :: Template input output
$cmempty :: forall input output. Template input output
Monoid)

-- | Allows to describe how to build a template for a row
newtype RowBuilder input output a = RowBuilder {forall input output a.
RowBuilder input output a
-> StateT Coords (Writer (Template input output)) a
unBuilder :: StateT Coords (Writer (Template input output)) a}
  deriving (forall a b.
a -> RowBuilder input output b -> RowBuilder input output a
forall a b.
(a -> b) -> RowBuilder input output a -> RowBuilder input output b
forall input output a b.
a -> RowBuilder input output b -> RowBuilder input output a
forall input output a b.
(a -> b) -> RowBuilder input output a -> RowBuilder input output b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b.
a -> RowBuilder input output b -> RowBuilder input output a
$c<$ :: forall input output a b.
a -> RowBuilder input output b -> RowBuilder input output a
fmap :: forall a b.
(a -> b) -> RowBuilder input output a -> RowBuilder input output b
$cfmap :: forall input output a b.
(a -> b) -> RowBuilder input output a -> RowBuilder input output b
Functor, forall a. a -> RowBuilder input output a
forall input output. Functor (RowBuilder input output)
forall a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output a
forall a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output b
forall a b.
RowBuilder input output (a -> b)
-> RowBuilder input output a -> RowBuilder input output b
forall input output a. a -> RowBuilder input output a
forall a b c.
(a -> b -> c)
-> RowBuilder input output a
-> RowBuilder input output b
-> RowBuilder input output c
forall input output a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output a
forall input output a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output b
forall input output a b.
RowBuilder input output (a -> b)
-> RowBuilder input output a -> RowBuilder input output b
forall input output a b c.
(a -> b -> c)
-> RowBuilder input output a
-> RowBuilder input output b
-> RowBuilder input output c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output a
$c<* :: forall input output a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output a
*> :: forall a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output b
$c*> :: forall input output a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output b
liftA2 :: forall a b c.
(a -> b -> c)
-> RowBuilder input output a
-> RowBuilder input output b
-> RowBuilder input output c
$cliftA2 :: forall input output a b c.
(a -> b -> c)
-> RowBuilder input output a
-> RowBuilder input output b
-> RowBuilder input output c
<*> :: forall a b.
RowBuilder input output (a -> b)
-> RowBuilder input output a -> RowBuilder input output b
$c<*> :: forall input output a b.
RowBuilder input output (a -> b)
-> RowBuilder input output a -> RowBuilder input output b
pure :: forall a. a -> RowBuilder input output a
$cpure :: forall input output a. a -> RowBuilder input output a
Applicative, forall a. a -> RowBuilder input output a
forall input output. Applicative (RowBuilder input output)
forall a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output b
forall a b.
RowBuilder input output a
-> (a -> RowBuilder input output b) -> RowBuilder input output b
forall input output a. a -> RowBuilder input output a
forall input output a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output b
forall input output a b.
RowBuilder input output a
-> (a -> RowBuilder input output b) -> RowBuilder input output b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> RowBuilder input output a
$creturn :: forall input output a. a -> RowBuilder input output a
>> :: forall a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output b
$c>> :: forall input output a b.
RowBuilder input output a
-> RowBuilder input output b -> RowBuilder input output b
>>= :: forall a b.
RowBuilder input output a
-> (a -> RowBuilder input output b) -> RowBuilder input output b
$c>>= :: forall input output a b.
RowBuilder input output a
-> (a -> RowBuilder input output b) -> RowBuilder input output b
Monad, MonadState Coords, MonadWriter (Template input output))

-- | Run builder on given coordinates. Get a result and a template
runBuilder :: RowBuilder input output a -> Coords -> (a, Template input output)
runBuilder :: forall input output a.
RowBuilder input output a -> Coords -> (a, Template input output)
runBuilder RowBuilder input output a
builder Coords
coord = forall w a. Writer w a -> (a, w)
runWriter (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall input output a.
RowBuilder input output a
-> StateT Coords (Writer (Template input output)) a
unBuilder RowBuilder input output a
builder) Coords
coord)

-- | Run builder on given coordinates. Get a template
evalBuilder :: RowBuilder input output a -> Coords -> Template input output
evalBuilder :: forall input output a.
RowBuilder input output a -> Coords -> Template input output
evalBuilder RowBuilder input output a
builder Coords
coord = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall input output a.
RowBuilder input output a -> Coords -> (a, Template input output)
runBuilder RowBuilder input output a
builder Coords
coord

-- | Run builder on given coordinates. Get a result
execBuilder :: RowBuilder input output a -> Coords -> a
execBuilder :: forall input output a. RowBuilder input output a -> Coords -> a
execBuilder RowBuilder input output a
builder Coords
coord = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall input output a.
RowBuilder input output a -> Coords -> (a, Template input output)
runBuilder RowBuilder input output a
builder Coords
coord

type RenderTemplate m input output = (Monad m, ToCellData output) => Coords -> InputIndex -> input -> Template input output -> m Transform
type RenderBuilderInputs m input output a = (Monad m, ToCellData output) => RowBuilder input output a -> [input] -> m (Transform, a)
type RenderBuilderInput m input output a = (Monad m, ToCellData output) => RowBuilder input output a -> input -> m (Transform, a)

-- | 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 :: forall (m :: * -> *) output input a.
(Monad m, ToCellData output) =>
Coords
-> RenderTemplate m input output
-> RenderBuilderInputs m input output a
renderBuilderInputs Coords
offset RenderTemplate m input output
render RowBuilder input output a
builder [input]
inputs = m (Transform, a)
ret
 where
  ts :: [(Coords, Template input output)]
ts =
    [ (Coords
coord, Template input output
template)
    | Int
row <- [Int
0 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [input]
inputs]
    , let coord :: Coords
coord = Coords
offset forall a. Num a => a -> a -> a
+ Coords{Int
row :: Int
$sel:row:Coords :: Int
row, $sel:col:Coords :: Int
col = Int
0}
          template :: Template input output
template = forall input output a.
RowBuilder input output a -> Coords -> Template input output
evalBuilder RowBuilder input output a
builder Coords
coord
    ]
  -- result obtained from the top row
  a :: a
a = forall input output a. RowBuilder input output a -> Coords -> a
execBuilder RowBuilder input output a
builder (Coords
offset forall a. Num a => a -> a -> a
+ Coords{$sel:row:Coords :: Int
row = Int
0, $sel:col:Coords :: Int
col = Int
0})
  transform :: m Transform
transform =
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
        ( forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3
            ( \input
input Int
inputIdx (Coords
coord, Template input output
template) ->
                RenderTemplate m input output
render Coords
coord Int
inputIdx input
input Template input output
template
            )
            [input]
inputs
            [Int
0 ..]
            [(Coords, Template input output)]
ts
        )
  ret :: m (Transform, a)
ret = (,a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Transform
transform

-- | Render a template with a given offset, input index and input
renderTemplate :: RenderTemplate m input output
renderTemplate :: forall (m :: * -> *) input output. RenderTemplate m input output
renderTemplate Coords{Int
col :: Int
row :: Int
$sel:col:Coords :: Coords -> Int
$sel:row:Coords :: Coords -> Int
..} Int
inputIdx input
input (Template [CellTemplate input output]
columns) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Transform]
ps
 where
  ps :: [Transform]
ps =
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
      ( \Int
columnIdx CellTemplate input output
mk ->
          let
            CellTemplate{Maybe ColumnsProperties
input -> output
FormatCell
columnsProperties :: Maybe ColumnsProperties
fmtCell :: FormatCell
mkOutput :: input -> output
$sel:columnsProperties:CellTemplate :: forall input output.
CellTemplate input output -> Maybe ColumnsProperties
$sel:fmtCell:CellTemplate :: forall input output. CellTemplate input output -> FormatCell
$sel:mkOutput:CellTemplate :: forall input output. CellTemplate input output -> input -> output
..} = CellTemplate input output
mk
            cd' :: CellData
cd' = forall a. ToCellData a => a -> CellData
toCellData (input -> output
mkOutput input
input)
            col' :: Int
col' = (Int
col forall a. Num a => a -> a -> a
+ Int
columnIdx)
            coords' :: Coords
coords' = Int -> Int -> Coords
Coords Int
row Int
col'
            c :: FormattedCell
c = FormatCell
fmtCell Coords
coords' Int
inputIdx CellData
cd'
            fmTransform :: FMTransform
fmTransform = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
row, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
col') FormattedCell
c
            wsTransform :: WSTransform
wsTransform
              -- add column width only once
              | Int
inputIdx forall a. Eq a => a -> a -> Bool
== Int
0 = Lens' Worksheet [ColumnsProperties]
X.wsColumnsProperties forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\[ColumnsProperties]
x -> [ColumnsProperties]
x forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe ColumnsProperties
columnsProperties)
              | Bool
otherwise = forall a. a -> a
id
           in
            forall a. Default a => a
def{FMTransform
fmTransform :: FMTransform
$sel:fmTransform:Transform :: FMTransform
fmTransform, WSTransform
wsTransform :: WSTransform
$sel:wsTransform:Transform :: WSTransform
wsTransform}
      )
      [Int
0 ..]
      [CellTemplate input output]
columns

{- FOURMOLU_DISABLE -}
-- $Columns
{- FOURMOLU_ENABLE -}

-- | Properties of a column
newtype ColumnsProperties = ColumnsProperties {ColumnsProperties -> ColumnsProperties
unColumnsProperties :: X.ColumnsProperties}

instance Default ColumnsProperties where
  def :: ColumnsProperties
  def :: ColumnsProperties
def =
    ColumnsProperties -> ColumnsProperties
ColumnsProperties
      X.ColumnsProperties
        { cpMin :: Int
cpMin = Int
1
        , cpMax :: Int
cpMax = Int
1
        , cpWidth :: Maybe Double
cpWidth = forall a. Maybe a
Nothing
        , cpStyle :: Maybe Int
cpStyle = forall a. Maybe a
Nothing
        , cpHidden :: Bool
cpHidden = Bool
False
        , cpCollapsed :: Bool
cpCollapsed = Bool
False
        , cpBestFit :: Bool
cpBestFit = Bool
False
        }

-- | A column with a possibly given width and cell format. Returns a cell reference
columnWidthCell :: forall a input output. Maybe Double -> FormatCell -> (input -> output) -> RowBuilder input output (CellRef a)
columnWidthCell :: forall a input output.
Maybe Double
-> FormatCell
-> (input -> output)
-> RowBuilder input output (CellRef a)
columnWidthCell Maybe Double
width FormatCell
fmtCell input -> output
mkOutput = do
  Coords
coords <- forall s (m :: * -> *). MonadState s m => m s
get
  let columnsProperties :: Maybe ColumnsProperties
columnsProperties =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
          (ColumnsProperties -> ColumnsProperties
unColumnsProperties forall a. Default a => a
def)
            { cpMin :: Int
X.cpMin = Coords
coords forall a b. a -> (a -> b) -> b
& Coords -> Int
col
            , cpMax :: Int
X.cpMax = Coords
coords forall a b. a -> (a -> b) -> b
& Coords -> Int
col
            , cpWidth :: Maybe Double
X.cpWidth = Maybe Double
width
            }
  forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (forall input output.
[CellTemplate input output] -> Template input output
Template [CellTemplate{FormatCell
fmtCell :: FormatCell
$sel:fmtCell:CellTemplate :: FormatCell
fmtCell, input -> output
mkOutput :: input -> output
$sel:mkOutput:CellTemplate :: input -> output
mkOutput, Maybe ColumnsProperties
columnsProperties :: Maybe ColumnsProperties
$sel:columnsProperties:CellTemplate :: Maybe ColumnsProperties
columnsProperties}])
  CellRef a
cell <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. Coords -> CellRef a
CellRef
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Coords
x -> Coords
x{$sel:col:Coords :: Int
col = (Coords
x forall a b. a -> (a -> b) -> b
& Coords -> Int
col) forall a. Num a => a -> a -> a
+ Int
1})
  forall (m :: * -> *) a. Monad m => a -> m a
return CellRef a
cell

-- | A column with a given width and cell format. Returns a cell reference
columnWidth :: ToCellData output => Double -> FormatCell -> (input -> output) -> RowBuilder input CellData (CellRef a)
columnWidth :: forall output input a.
ToCellData output =>
Double
-> FormatCell
-> (input -> output)
-> RowBuilder input CellData (CellRef a)
columnWidth Double
width FormatCell
fmtCell input -> output
mkOutput = forall a input output.
Maybe Double
-> FormatCell
-> (input -> output)
-> RowBuilder input output (CellRef a)
columnWidthCell (forall a. a -> Maybe a
Just Double
width) FormatCell
fmtCell (forall a. ToCellData a => a -> CellData
toCellData forall b c a. (b -> c) -> (a -> b) -> a -> c
. input -> output
mkOutput)

-- | A column with a given width and cell format
columnWidth_ :: ToCellData output => Double -> FormatCell -> (input -> output) -> RowBuilder input CellData ()
columnWidth_ :: forall output input.
ToCellData output =>
Double
-> FormatCell -> (input -> output) -> RowBuilder input CellData ()
columnWidth_ Double
width FormatCell
fmtCell input -> output
mkOutput = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall output input a.
ToCellData output =>
Double
-> FormatCell
-> (input -> output)
-> RowBuilder input CellData (CellRef a)
columnWidth Double
width FormatCell
fmtCell input -> output
mkOutput)

-- | A column with a given cell format. Returns a cell reference
column :: ToCellData output => FormatCell -> (input -> output) -> RowBuilder input CellData (CellRef a)
column :: forall output input a.
ToCellData output =>
FormatCell
-> (input -> output) -> RowBuilder input CellData (CellRef a)
column FormatCell
fmtCell input -> output
mkOutput = forall a input output.
Maybe Double
-> FormatCell
-> (input -> output)
-> RowBuilder input output (CellRef a)
columnWidthCell forall a. Maybe a
Nothing FormatCell
fmtCell (forall a. ToCellData a => a -> CellData
toCellData forall b c a. (b -> c) -> (a -> b) -> a -> c
. input -> output
mkOutput)

-- | A column with a given cell format
column_ :: ToCellData output => FormatCell -> (input -> output) -> RowBuilder input CellData ()
column_ :: forall output input.
ToCellData output =>
FormatCell -> (input -> output) -> RowBuilder input CellData ()
column_ FormatCell
fmtCell input -> output
mkOutput = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall output input a.
ToCellData output =>
FormatCell
-> (input -> output) -> RowBuilder input CellData (CellRef a)
column FormatCell
fmtCell input -> output
mkOutput)

-- | Produce a transform and a result from a template renderer, inputs, and a builder
composeTransformAndResult :: forall a input output. ToCellData output => RenderTemplate Identity input output -> Coords -> [input] -> RowBuilder input output a -> (Transform, a)
composeTransformAndResult :: forall a input output.
ToCellData output =>
RenderTemplate Identity input output
-> Coords -> [input] -> RowBuilder input output a -> (Transform, a)
composeTransformAndResult RenderTemplate Identity input output
renderTemplate' Coords
offset [input]
input RowBuilder input output a
builder = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) output input a.
(Monad m, ToCellData output) =>
Coords
-> RenderTemplate m input output
-> RenderBuilderInputs m input output a
renderBuilderInputs Coords
offset RenderTemplate Identity input output
renderTemplate' RowBuilder input output a
builder [input]
input

-- | Produce a result from a default template renderer, inputs, and a builder
defaultComposeTransformAndResult :: ToCellData output => Coords -> [input] -> RowBuilder input output a -> (Transform, a)
defaultComposeTransformAndResult :: forall output input a.
ToCellData output =>
Coords -> [input] -> RowBuilder input output a -> (Transform, a)
defaultComposeTransformAndResult = forall a input output.
ToCellData output =>
RenderTemplate Identity input output
-> Coords -> [input] -> RowBuilder input output a -> (Transform, a)
composeTransformAndResult forall (m :: * -> *) input output. RenderTemplate m input output
renderTemplate

{- FOURMOLU_DISABLE -}
-- $SheetBuilder
{- FOURMOLU_ENABLE -}

-- | A builder to compose the results of 'RowBuilder's
newtype SheetBuilder a = SheetBuilder {forall a. SheetBuilder a -> Writer Transform a
unSheetBuilder :: Writer Transform a}
  deriving (forall a b. a -> SheetBuilder b -> SheetBuilder a
forall a b. (a -> b) -> SheetBuilder a -> SheetBuilder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SheetBuilder b -> SheetBuilder a
$c<$ :: forall a b. a -> SheetBuilder b -> SheetBuilder a
fmap :: forall a b. (a -> b) -> SheetBuilder a -> SheetBuilder b
$cfmap :: forall a b. (a -> b) -> SheetBuilder a -> SheetBuilder b
Functor, Functor SheetBuilder
forall a. a -> SheetBuilder a
forall a b. SheetBuilder a -> SheetBuilder b -> SheetBuilder a
forall a b. SheetBuilder a -> SheetBuilder b -> SheetBuilder b
forall a b.
SheetBuilder (a -> b) -> SheetBuilder a -> SheetBuilder b
forall a b c.
(a -> b -> c) -> SheetBuilder a -> SheetBuilder b -> SheetBuilder c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. SheetBuilder a -> SheetBuilder b -> SheetBuilder a
$c<* :: forall a b. SheetBuilder a -> SheetBuilder b -> SheetBuilder a
*> :: forall a b. SheetBuilder a -> SheetBuilder b -> SheetBuilder b
$c*> :: forall a b. SheetBuilder a -> SheetBuilder b -> SheetBuilder b
liftA2 :: forall a b c.
(a -> b -> c) -> SheetBuilder a -> SheetBuilder b -> SheetBuilder c
$cliftA2 :: forall a b c.
(a -> b -> c) -> SheetBuilder a -> SheetBuilder b -> SheetBuilder c
<*> :: forall a b.
SheetBuilder (a -> b) -> SheetBuilder a -> SheetBuilder b
$c<*> :: forall a b.
SheetBuilder (a -> b) -> SheetBuilder a -> SheetBuilder b
pure :: forall a. a -> SheetBuilder a
$cpure :: forall a. a -> SheetBuilder a
Applicative, Applicative SheetBuilder
forall a. a -> SheetBuilder a
forall a b. SheetBuilder a -> SheetBuilder b -> SheetBuilder b
forall a b.
SheetBuilder a -> (a -> SheetBuilder b) -> SheetBuilder b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> SheetBuilder a
$creturn :: forall a. a -> SheetBuilder a
>> :: forall a b. SheetBuilder a -> SheetBuilder b -> SheetBuilder b
$c>> :: forall a b. SheetBuilder a -> SheetBuilder b -> SheetBuilder b
>>= :: forall a b.
SheetBuilder a -> (a -> SheetBuilder b) -> SheetBuilder b
$c>>= :: forall a b.
SheetBuilder a -> (a -> SheetBuilder b) -> SheetBuilder b
Monad, MonadWriter Transform)

-- | Starting at given coordinates, place rows of data made from a list of inputs according to a row builder. Return the result of the row builder.
placeInputs :: ToCellData output => Coords -> [input] -> RowBuilder input output a -> SheetBuilder a
placeInputs :: forall output input a.
ToCellData output =>
Coords -> [input] -> RowBuilder input output a -> SheetBuilder a
placeInputs Coords
offset [input]
inputs RowBuilder input output a
b = do
  let transformResult :: (Transform, a)
transformResult = forall output input a.
ToCellData output =>
Coords -> [input] -> RowBuilder input output a -> (Transform, a)
defaultComposeTransformAndResult Coords
offset [input]
inputs RowBuilder input output a
b
  forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (forall a b. (a, b) -> a
fst (Transform, a)
transformResult)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a, b) -> b
snd (Transform, a)
transformResult)

-- | Starting at given coordinates, place a row of data made from a single input according to a row builder. Return the result of the row builder.
placeInput :: ToCellData output => Coords -> input -> RowBuilder input output a -> SheetBuilder a
placeInput :: forall output input a.
ToCellData output =>
Coords -> input -> RowBuilder input output a -> SheetBuilder a
placeInput Coords
coords input
input = forall output input a.
ToCellData output =>
Coords -> [input] -> RowBuilder input output a -> SheetBuilder a
placeInputs Coords
coords [input
input]

-- | Starting at given coordinates, place rows of data made from a list of inputs according to a row builder.
placeInputs_ :: ToCellData output => Coords -> [input] -> RowBuilder input output a -> SheetBuilder ()
placeInputs_ :: forall output input a.
ToCellData output =>
Coords -> [input] -> RowBuilder input output a -> SheetBuilder ()
placeInputs_ Coords
coords [input]
inputs RowBuilder input output a
b = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall output input a.
ToCellData output =>
Coords -> [input] -> RowBuilder input output a -> SheetBuilder a
placeInputs Coords
coords [input]
inputs RowBuilder input output a
b)

-- | Starting at given coordinates, place a row of data made from a single input according to a row builder.
placeInput_ :: ToCellData output => Coords -> input -> RowBuilder input output a -> SheetBuilder ()
placeInput_ :: forall output input a.
ToCellData output =>
Coords -> input -> RowBuilder input output a -> SheetBuilder ()
placeInput_ Coords
coords input
input = forall output input a.
ToCellData output =>
Coords -> [input] -> RowBuilder input output a -> SheetBuilder ()
placeInputs_ Coords
coords [input
input]

{- FOURMOLU_DISABLE -}
-- $Expressions
{- FOURMOLU_ENABLE -}

-- | Expression syntax
data Expr t
  = Add (Expr t) (Expr t)
  | Sub (Expr t) (Expr t)
  | Mul (Expr t) (Expr t)
  | Div (Expr t) (Expr t)
  | Power (Expr t) (Expr t)
  | Function String [Expr t]
  | Range (Expr t) (Expr t)
  | ExprCell (CellRef t)

-- | Something that can be turned into an expression
class ToExpr v where
  toExpr :: v -> Expr t

instance ToExpr (CellRef a) where
  toExpr :: CellRef a -> Expr t
  toExpr :: forall t. CellRef a -> Expr t
toExpr (CellRef Coords
c) = forall t. CellRef t -> Expr t
ExprCell (forall a. Coords -> CellRef a
CellRef Coords
c)

instance ToExpr Coords where
  toExpr :: Coords -> Expr t
  toExpr :: forall t. Coords -> Expr t
toExpr Coords
c = forall t. CellRef t -> Expr t
ExprCell (forall a. Coords -> CellRef a
CellRef Coords
c)

toExprCell :: CellRef a -> Coords
toExprCell :: forall a. CellRef a -> Coords
toExprCell (CellRef Coords
c1) = Coords
c1

instance ToExpr (Expr a) where
  toExpr :: Expr a -> Expr b
  toExpr :: forall t. Expr a -> Expr t
toExpr (Add Expr a
l Expr a
r) = forall t. Expr t -> Expr t -> Expr t
Add (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
l) (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
r)
  toExpr (Sub Expr a
l Expr a
r) = forall t. Expr t -> Expr t -> Expr t
Sub (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
l) (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
r)
  toExpr (Mul Expr a
l Expr a
r) = forall t. Expr t -> Expr t -> Expr t
Mul (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
l) (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
r)
  toExpr (Div Expr a
l Expr a
r) = forall t. Expr t -> Expr t -> Expr t
Div (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
l) (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
r)
  toExpr (Power Expr a
b Expr a
p) = forall t. Expr t -> Expr t -> Expr t
Power (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
b) (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
p)
  toExpr (Function String
name [Expr a]
args) = forall t. String -> [Expr t] -> Expr t
Function String
name (forall v t. ToExpr v => v -> Expr t
toExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr a]
args)
  toExpr (Range Expr a
l Expr a
r) = forall t. Expr t -> Expr t -> Expr t
Range (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
l) (forall v t. ToExpr v => v -> Expr t
toExpr Expr a
r)
  toExpr (ExprCell (CellRef Coords
c)) = forall t. CellRef t -> Expr t
ExprCell (forall a. Coords -> CellRef a
CellRef Coords
c)

showOp2 :: (Show a, Show b) => String -> a -> b -> String
showOp2 :: forall a b. (Show a, Show b) => String -> a -> b -> String
showOp2 String
operator a
c1 b
c2 = forall a. Show a => a -> String
show a
c1 forall a. Semigroup a => a -> a -> a
<> String
operator forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show b
c2

mkOp2 :: (ToExpr a, ToExpr b) => (Expr t -> Expr t -> Expr t) -> a -> b -> Expr t
mkOp2 :: forall a b t.
(ToExpr a, ToExpr b) =>
(Expr t -> Expr t -> Expr t) -> a -> b -> Expr t
mkOp2 Expr t -> Expr t -> Expr t
f a
c1 b
c2 = Expr t -> Expr t -> Expr t
f (forall v t. ToExpr v => v -> Expr t
toExpr a
c1) (forall v t. ToExpr v => v -> Expr t
toExpr b
c2)

mkNumOp2 :: (Num t, ToExpr a, ToExpr b) => (Expr t -> Expr t -> Expr t) -> a -> b -> Expr t
mkNumOp2 :: forall t a b.
(Num t, ToExpr a, ToExpr b) =>
(Expr t -> Expr t -> Expr t) -> a -> b -> Expr t
mkNumOp2 = forall a b t.
(ToExpr a, ToExpr b) =>
(Expr t -> Expr t -> Expr t) -> a -> b -> Expr t
mkOp2

-- | Assemble a range expression
(|:|) :: CellRef a -> CellRef b -> Expr c
|:| :: forall a b c. CellRef a -> CellRef b -> Expr c
(|:|) = forall a b t.
(ToExpr a, ToExpr b) =>
(Expr t -> Expr t -> Expr t) -> a -> b -> Expr t
mkOp2 forall t. Expr t -> Expr t -> Expr t
Range

infixr 5 |:|

-- | A type for arithmetic operators
type ArithmeticOperator a b c = (Num a, ToExpr (b a), ToExpr (c a)) => b a -> c a -> Expr a

-- | Assemble an addition expression
(|+|) :: ArithmeticOperator a b c
|+| :: forall a (b :: * -> *) (c :: * -> *). ArithmeticOperator a b c
(|+|) = forall t a b.
(Num t, ToExpr a, ToExpr b) =>
(Expr t -> Expr t -> Expr t) -> a -> b -> Expr t
mkNumOp2 forall t. Expr t -> Expr t -> Expr t
Add

infixl 6 |+|

-- | Assemble a subtraction expression
(|-|) :: ArithmeticOperator a b c
|-| :: forall a (b :: * -> *) (c :: * -> *). ArithmeticOperator a b c
(|-|) = forall t a b.
(Num t, ToExpr a, ToExpr b) =>
(Expr t -> Expr t -> Expr t) -> a -> b -> Expr t
mkNumOp2 forall t. Expr t -> Expr t -> Expr t
Sub

infixl 6 |-|

-- | Assemble a division expression
(|/|) :: ArithmeticOperator a b c
|/| :: forall a (b :: * -> *) (c :: * -> *). ArithmeticOperator a b c
(|/|) = forall t a b.
(Num t, ToExpr a, ToExpr b) =>
(Expr t -> Expr t -> Expr t) -> a -> b -> Expr t
mkNumOp2 forall t. Expr t -> Expr t -> Expr t
Div

infixl 7 |/|

-- | Assemble a multiplication expression
(|*|) :: ArithmeticOperator a b c
|*| :: forall a (b :: * -> *) (c :: * -> *). ArithmeticOperator a b c
(|*|) = forall t a b.
(Num t, ToExpr a, ToExpr b) =>
(Expr t -> Expr t -> Expr t) -> a -> b -> Expr t
mkNumOp2 forall t. Expr t -> Expr t -> Expr t
Mul

infixl 6 |*|

-- | Assemble a multiplication expression
(|^|) :: ArithmeticOperator a b c
|^| :: forall a (b :: * -> *) (c :: * -> *). ArithmeticOperator a b c
(|^|) = forall t a b.
(Num t, ToExpr a, ToExpr b) =>
(Expr t -> Expr t -> Expr t) -> a -> b -> Expr t
mkNumOp2 forall t. Expr t -> Expr t -> Expr t
Power

infixr 8 |^|

-- | Assemble a function expression
(|$|) :: ToExpr a => String -> [a] -> Expr t
|$| :: forall a t. ToExpr a => String -> [a] -> Expr t
(|$|) String
n [a]
as = forall t. String -> [Expr t] -> Expr t
Function (Char -> Char
toUpper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
n) (forall v t. ToExpr v => v -> Expr t
toExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as)

infixr 0 |$|

instance Show (Expr t) where
  show :: Expr t -> String
  show :: Expr t -> String
show (Add Expr t
c1 Expr t
c2) = forall a b. (Show a, Show b) => String -> a -> b -> String
showOp2 String
"+" Expr t
c1 Expr t
c2
  show (Sub Expr t
c1 Expr t
c2) = forall a b. (Show a, Show b) => String -> a -> b -> String
showOp2 String
"-" Expr t
c1 Expr t
c2
  show (Mul Expr t
c1 Expr t
c2) = forall a b. (Show a, Show b) => String -> a -> b -> String
showOp2 String
"*" Expr t
c1 Expr t
c2
  show (Div Expr t
c1 Expr t
c2) = forall a b. (Show a, Show b) => String -> a -> b -> String
showOp2 String
"/" Expr t
c1 Expr t
c2
  show (Power Expr t
c1 Expr t
c2) = forall a b. (Show a, Show b) => String -> a -> b -> String
showOp2 String
"^" Expr t
c1 Expr t
c2
  show (Range Expr t
c1 Expr t
c2) = forall a b. (Show a, Show b) => String -> a -> b -> String
showOp2 String
":" Expr t
c1 Expr t
c2
  show (ExprCell (CellRef Coords
e)) = forall a. Show a => a -> String
show Coords
e
  show (Function String
n [Expr t]
as) = String
n forall a. Semigroup a => a -> a -> a
<> String
"(" forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr t]
as) forall a. Semigroup a => a -> a -> a
<> String
")"

{- FOURMOLU_DISABLE -}
-- $Cells
{- FOURMOLU_ENABLE -}

-- | A union of what can be inside a cell
data CellData
  = CellFormula X.CellFormula
  | CellValue X.CellValue
  | CellComment X.Comment

-- | Convert some CellRef component into a cell
dataCell :: CellData -> X.Cell
dataCell :: CellData -> Cell
dataCell CellData
cd =
  forall a. Default a => a
X.def
    forall a b. a -> (a -> b) -> b
& case CellData
cd of
      CellValue CellValue
d -> Lens' Cell (Maybe CellValue)
X.cellValue forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CellValue
d
      CellFormula CellFormula
d -> Lens' Cell (Maybe CellFormula)
X.cellFormula forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CellFormula
d
      CellComment Comment
d -> Lens' Cell (Maybe Comment)
X.cellComment forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Comment
d

-- | Something that can be turned into 'CellData'
class ToCellData a where
  toCellData :: a -> CellData

instance ToCellData String where
  toCellData :: String -> CellData
  toCellData :: String -> CellData
toCellData = CellValue -> CellData
CellValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CellValue
X.CellText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance ToCellData Int where
  toCellData :: Int -> CellData
  toCellData :: Int -> CellData
toCellData = CellValue -> CellData
CellValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CellValue
X.CellDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToCellData Double where
  toCellData :: Double -> CellData
  toCellData :: Double -> CellData
toCellData = CellValue -> CellData
CellValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CellValue
X.CellDouble

instance ToCellData Bool where
  toCellData :: Bool -> CellData
  toCellData :: Bool -> CellData
toCellData = CellValue -> CellData
CellValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CellValue
X.CellBool

instance ToCellData CellData where
  toCellData :: CellData -> CellData
  toCellData :: CellData -> CellData
toCellData = forall a. a -> a
id

instance ToCellData (Expr a) where
  toCellData :: Expr a -> CellData
  toCellData :: Expr a -> CellData
toCellData Expr a
e =
    CellFormula -> CellData
CellFormula
      X.CellFormula
        { _cellfAssignsToName :: Bool
X._cellfAssignsToName = Bool
False
        , _cellfCalculate :: Bool
X._cellfCalculate = Bool
True
        , _cellfExpression :: FormulaExpression
X._cellfExpression = Formula -> FormulaExpression
X.NormalFormula forall a b. (a -> b) -> a -> b
$ Text -> Formula
X.Formula forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Expr a
e
        }

{- FOURMOLU_DISABLE -}
-- $Xlsx
{- FOURMOLU_ENABLE -}

-- | Compose an @xlsx@ from a list of sheet names and builders
composeXlsx :: [(T.Text, SheetBuilder ())] -> X.Xlsx
composeXlsx :: [(Text, SheetBuilder ())] -> Xlsx
composeXlsx [(Text, SheetBuilder ())]
sheetBuilders = Xlsx
workBook'
 where
  getTransform :: SheetBuilder a -> Transform
getTransform SheetBuilder a
x = forall w a. Writer w a -> w
execWriter forall a b. (a -> b) -> a -> b
$ forall a. SheetBuilder a -> Writer Transform a
unSheetBuilder SheetBuilder a
x
  workBook :: Xlsx
workBook = [(Text, FormattedMap)] -> StyleSheet -> Xlsx
X.formatWorkbook ((\(Text
name, SheetBuilder ()
tf') -> (Text
name, (forall {a}. SheetBuilder a -> Transform
getTransform SheetBuilder ()
tf' forall a b. a -> (a -> b) -> b
& Transform -> FMTransform
fmTransform) forall a. Default a => a
X.def)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, SheetBuilder ())]
sheetBuilders) forall a. Default a => a
X.def
  filterWidths :: WSTransform
filterWidths Worksheet
ws = Worksheet
ws forall a b. a -> (a -> b) -> b
& Lens' Worksheet [ColumnsProperties]
X.wsColumnsProperties forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnsProperties -> Maybe Double
X.cpWidth)
  workBook' :: Xlsx
workBook' =
    Xlsx
workBook
      forall a b. a -> (a -> b) -> b
& Lens' Xlsx [(Text, Worksheet)]
X.xlSheets
        forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \[(Text, Worksheet)]
sheets -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SheetBuilder ()
x (Text
name, Worksheet
ws) -> (Text
name, (forall {a}. SheetBuilder a -> Transform
getTransform SheetBuilder ()
x forall a b. a -> (a -> b) -> b
& Transform -> WSTransform
wsTransform) Worksheet
ws forall a b. a -> (a -> b) -> b
& WSTransform
filterWidths)) (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, SheetBuilder ())]
sheetBuilders) [(Text, Worksheet)]
sheets