{-# 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 qualified Codec.Xlsx as X
import qualified Codec.Xlsx.Formatted 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 qualified Data.Map.Strict as Map (Map, insert)
import Data.Maybe (isJust, maybeToList)
import qualified Data.Text as T

-- Coords

-- TODO Allow sheet addresses

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

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

alphabet :: [String]
alphabet :: [[Char]]
alphabet = (forall a. a -> [a] -> [a]
: [Char]
"") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'A' .. Char
'Z']

toLetters :: Int -> String
toLetters :: Int -> [Char]
toLetters Int
x = [Char] -> Int -> [Char]
f [Char]
"" (Int
x forall a. Num a => a -> a -> a
- Int
1)
 where
  new :: Int -> String -> String
  new :: Int -> ShowS
new Int
cur [Char]
acc = [[Char]]
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
<> [Char]
acc
  f :: String -> Int -> String
  f :: [Char] -> Int -> [Char]
f [Char]
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 [Char] -> Int -> [Char]
f (Int -> ShowS
new Int
cur [Char]
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 [Char]
acc

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

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))

-- 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
  { forall input output. CellTemplate input output -> input -> output
mkOutput :: input -> output
  , forall input output. CellTemplate input output -> FormatCell
format :: FormatCell
  , forall input output.
CellTemplate input output -> Maybe ColumnsProperties
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 {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

-- Template

-- | 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)

-- Builder

-- | A builder
newtype Builder input output a = Builder {forall input output a.
Builder input output a
-> StateT Coords (Writer (Template input output)) a
unBuilder :: StateT Coords (Writer (Template input output)) a}
  deriving (forall a b. a -> Builder input output b -> Builder input output a
forall a b.
(a -> b) -> Builder input output a -> Builder input output b
forall input output a b.
a -> Builder input output b -> Builder input output a
forall input output a b.
(a -> b) -> Builder input output a -> Builder 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 -> Builder input output b -> Builder input output a
$c<$ :: forall input output a b.
a -> Builder input output b -> Builder input output a
fmap :: forall a b.
(a -> b) -> Builder input output a -> Builder input output b
$cfmap :: forall input output a b.
(a -> b) -> Builder input output a -> Builder input output b
Functor, forall a. a -> Builder input output a
forall input output. Functor (Builder input output)
forall a b.
Builder input output a
-> Builder input output b -> Builder input output a
forall a b.
Builder input output a
-> Builder input output b -> Builder input output b
forall a b.
Builder input output (a -> b)
-> Builder input output a -> Builder input output b
forall input output a. a -> Builder input output a
forall a b c.
(a -> b -> c)
-> Builder input output a
-> Builder input output b
-> Builder input output c
forall input output a b.
Builder input output a
-> Builder input output b -> Builder input output a
forall input output a b.
Builder input output a
-> Builder input output b -> Builder input output b
forall input output a b.
Builder input output (a -> b)
-> Builder input output a -> Builder input output b
forall input output a b c.
(a -> b -> c)
-> Builder input output a
-> Builder input output b
-> Builder 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.
Builder input output a
-> Builder input output b -> Builder input output a
$c<* :: forall input output a b.
Builder input output a
-> Builder input output b -> Builder input output a
*> :: forall a b.
Builder input output a
-> Builder input output b -> Builder input output b
$c*> :: forall input output a b.
Builder input output a
-> Builder input output b -> Builder input output b
liftA2 :: forall a b c.
(a -> b -> c)
-> Builder input output a
-> Builder input output b
-> Builder input output c
$cliftA2 :: forall input output a b c.
(a -> b -> c)
-> Builder input output a
-> Builder input output b
-> Builder input output c
<*> :: forall a b.
Builder input output (a -> b)
-> Builder input output a -> Builder input output b
$c<*> :: forall input output a b.
Builder input output (a -> b)
-> Builder input output a -> Builder input output b
pure :: forall a. a -> Builder input output a
$cpure :: forall input output a. a -> Builder input output a
Applicative, forall a. a -> Builder input output a
forall input output. Applicative (Builder input output)
forall a b.
Builder input output a
-> Builder input output b -> Builder input output b
forall a b.
Builder input output a
-> (a -> Builder input output b) -> Builder input output b
forall input output a. a -> Builder input output a
forall input output a b.
Builder input output a
-> Builder input output b -> Builder input output b
forall input output a b.
Builder input output a
-> (a -> Builder input output b) -> Builder 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 -> Builder input output a
$creturn :: forall input output a. a -> Builder input output a
>> :: forall a b.
Builder input output a
-> Builder input output b -> Builder input output b
$c>> :: forall input output a b.
Builder input output a
-> Builder input output b -> Builder input output b
>>= :: forall a b.
Builder input output a
-> (a -> Builder input output b) -> Builder input output b
$c>>= :: forall input output a b.
Builder input output a
-> (a -> Builder input output b) -> Builder input output b
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 :: forall input output a.
Builder input output a -> Coords -> (a, Template input output)
runBuilder Builder 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.
Builder input output a
-> StateT Coords (Writer (Template input output)) a
unBuilder Builder input output a
builder) Coords
coord)

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

-- | Run builder on given coordinates. Get a result
execBuilder :: Builder input output a -> Coords -> a
execBuilder :: forall input output a. Builder input output a -> Coords -> a
execBuilder Builder input output a
builder Coords
coord = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall input output a.
Builder input output a -> Coords -> (a, Template input output)
runBuilder Builder input output a
builder Coords
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 :: 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 Builder 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.
Builder input output a -> Coords -> Template input output
evalBuilder Builder input output a
builder Coords
coord
    ]
  -- result obtained from the top row
  a :: a
a = forall input output a. Builder input output a -> Coords -> a
execBuilder Builder 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
format :: FormatCell
mkOutput :: input -> output
$sel:columnsProperties:CellTemplate :: forall input output.
CellTemplate input output -> Maybe ColumnsProperties
$sel:format: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
format 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

-- Columns

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
        }

-- 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 :: forall a input output.
Maybe Double
-> FormatCell -> (input -> output) -> Builder input output (Cell a)
columnWidthCell Maybe Double
width FormatCell
format 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
format :: FormatCell
$sel:format:CellTemplate :: FormatCell
format, input -> output
mkOutput :: input -> output
$sel:mkOutput:CellTemplate :: input -> output
mkOutput, Maybe ColumnsProperties
columnsProperties :: Maybe ColumnsProperties
$sel:columnsProperties:CellTemplate :: Maybe ColumnsProperties
columnsProperties}])
  Cell a
cell <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. Coords -> Cell a
Cell
  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 Cell a
cell

columnWidth :: ToCellData output => Double -> FormatCell -> (input -> output) -> Builder input CellData (Cell a)
columnWidth :: forall output input a.
ToCellData output =>
Double
-> FormatCell
-> (input -> output)
-> Builder input CellData (Cell a)
columnWidth Double
width FormatCell
fmtCell input -> output
mkOutput = forall a input output.
Maybe Double
-> FormatCell -> (input -> output) -> Builder input output (Cell 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)

columnWidth_ :: ToCellData output => Double -> FormatCell -> (input -> output) -> Builder input CellData ()
columnWidth_ :: forall output input.
ToCellData output =>
Double
-> FormatCell -> (input -> output) -> Builder 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)
-> Builder input CellData (Cell a)
columnWidth Double
width FormatCell
fmtCell input -> output
mkOutput)

-- | Produce a column with a given style and get a cell
column :: ToCellData output => FormatCell -> (input -> output) -> Builder input CellData (Cell a)
column :: forall output input a.
ToCellData output =>
FormatCell -> (input -> output) -> Builder input CellData (Cell a)
column FormatCell
fmtCell input -> output
mkOutput = forall a input output.
Maybe Double
-> FormatCell -> (input -> output) -> Builder input output (Cell 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)

-- | Produce a column with a given style
column_ :: ToCellData output => FormatCell -> (input -> output) -> Builder input CellData ()
column_ :: forall output input.
ToCellData output =>
FormatCell -> (input -> output) -> Builder 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) -> Builder input CellData (Cell a)
column FormatCell
fmtCell input -> output
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 :: forall a input output.
ToCellData output =>
RenderTemplate Identity input output
-> Coords -> [input] -> Builder input output a -> (Transform, a)
composeTransformResult RenderTemplate Identity input output
renderTemplate' Coords
offset [input]
input Builder 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' Builder input output a
builder [input]
input

-- | Produce a result
defaultTransformResult :: ToCellData output => Coords -> [input] -> Builder input output a -> (Transform, a)
defaultTransformResult :: forall output input a.
ToCellData output =>
Coords -> [input] -> Builder input output a -> (Transform, a)
defaultTransformResult = forall a input output.
ToCellData output =>
RenderTemplate Identity input output
-> Coords -> [input] -> Builder input output a -> (Transform, a)
composeTransformResult forall (m :: * -> *) input output. RenderTemplate m input output
renderTemplate

-- TODO
-- Store current sheet info for formulas

-- | Top monad to compose the results of Builders
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)

class Functor a => Discardable a where
  discard :: a b -> a ()

placeInputs :: ToCellData output => Coords -> [input] -> Builder input output a -> SheetBuilder a
placeInputs :: forall output input a.
ToCellData output =>
Coords -> [input] -> Builder input output a -> SheetBuilder a
placeInputs Coords
offset [input]
inputs Builder input output a
b = do
  let transformResult :: (Transform, a)
transformResult = forall output input a.
ToCellData output =>
Coords -> [input] -> Builder input output a -> (Transform, a)
defaultTransformResult Coords
offset [input]
inputs Builder 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)

placeInput :: ToCellData output => Coords -> input -> Builder input output a -> SheetBuilder a
placeInput :: forall output input a.
ToCellData output =>
Coords -> input -> Builder input output a -> SheetBuilder a
placeInput Coords
coords input
input = forall output input a.
ToCellData output =>
Coords -> [input] -> Builder input output a -> SheetBuilder a
placeInputs Coords
coords [input
input]

placeInputs_ :: ToCellData output => Coords -> [input] -> Builder input output a -> SheetBuilder ()
placeInputs_ :: forall output input a.
ToCellData output =>
Coords -> [input] -> Builder input output a -> SheetBuilder ()
placeInputs_ Coords
coords [input]
inputs Builder input output a
b = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall output input a.
ToCellData output =>
Coords -> [input] -> Builder input output a -> SheetBuilder a
placeInputs Coords
coords [input]
inputs Builder input output a
b)

placeInput_ :: ToCellData output => Coords -> input -> Builder input output a -> SheetBuilder ()
placeInput_ :: forall output input a.
ToCellData output =>
Coords -> input -> Builder input output a -> SheetBuilder ()
placeInput_ Coords
coords input
input = forall output input a.
ToCellData output =>
Coords -> [input] -> Builder input output a -> SheetBuilder ()
placeInputs_ Coords
coords [input
input]

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

{- 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 (forall a b. a -> Expr b -> Expr a
forall a b. (a -> b) -> Expr a -> Expr 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 -> Expr b -> Expr a
$c<$ :: forall a b. a -> Expr b -> Expr a
fmap :: forall a b. (a -> b) -> Expr a -> Expr b
$cfmap :: forall a b. (a -> b) -> Expr a -> Expr b
Functor)

-- | Change phantom type of an Expr
ex' :: forall b a. Expr a -> Expr b
ex' :: forall b a. Expr a -> Expr b
ex' = forall v t. ToExpr v => v -> Expr t
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 :: forall t. Cell a -> Expr t
toExpr (Cell Coords
c) = forall t. Cell t -> Expr t
ExprCell (forall a. Coords -> Cell a
Cell Coords
c)

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

toExprCell :: Cell a -> Coords
toExprCell :: forall a. Cell a -> Coords
toExprCell (Cell 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 (Function [Char]
name [Expr a]
args) = forall t. [Char] -> [Expr t] -> Expr t
Function [Char]
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 (Cell Coords
c)) = forall t. Cell t -> Expr t
ExprCell (forall a. Coords -> Cell a
Cell Coords
c)

showOp2 :: (Show a, Show b) => String -> a -> b -> String
showOp2 :: forall a b. (Show a, Show b) => [Char] -> a -> b -> [Char]
showOp2 [Char]
operator a
c1 b
c2 = forall a. Show a => a -> [Char]
show a
c1 forall a. Semigroup a => a -> a -> a
<> [Char]
operator forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
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
(|:|) :: Cell a -> Cell b -> Expr c
|:| :: forall a b c. Cell a -> Cell 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 |:|

-- | Assemble an addition expression
(|+|) :: Num a => Expr a -> Expr a -> Expr a
|+| :: forall a. Num a => Expr a -> Expr a -> Expr a
(|+|) = 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
(|-|) :: Num a => Expr a -> Expr a -> Expr a
|-| :: forall a. Num a => Expr a -> Expr a -> Expr a
(|-|) = 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
(|/|) :: Num a => Expr a -> Expr a -> Expr a
|/| :: forall a. Num a => Expr a -> Expr a -> Expr a
(|/|) = 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
(|*|) :: Num a => Expr a -> Expr a -> Expr a
|*| :: forall a. Num a => Expr a -> Expr a -> Expr a
(|*|) = 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
(|^|) :: Num a => Expr a -> Expr a -> Expr a
|^| :: forall a. Num a => Expr a -> Expr a -> Expr a
(|^|) = 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

infixr 8 |^|

-- | Assemble a function expression
(|$|) :: ToExpr a => String -> [a] -> Expr t
|$| :: forall a t. ToExpr a => [Char] -> [a] -> Expr t
(|$|) [Char]
n [a]
as = forall t. [Char] -> [Expr t] -> Expr t
Function (Char -> Char
toUpper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
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 -> [Char]
show (Add Expr t
c1 Expr t
c2) = forall a b. (Show a, Show b) => [Char] -> a -> b -> [Char]
showOp2 [Char]
"+" Expr t
c1 Expr t
c2
  show (Sub Expr t
c1 Expr t
c2) = forall a b. (Show a, Show b) => [Char] -> a -> b -> [Char]
showOp2 [Char]
"-" Expr t
c1 Expr t
c2
  show (Mul Expr t
c1 Expr t
c2) = forall a b. (Show a, Show b) => [Char] -> a -> b -> [Char]
showOp2 [Char]
"*" Expr t
c1 Expr t
c2
  show (Div Expr t
c1 Expr t
c2) = forall a b. (Show a, Show b) => [Char] -> a -> b -> [Char]
showOp2 [Char]
"/" Expr t
c1 Expr t
c2
  show (Range Expr t
c1 Expr t
c2) = forall a b. (Show a, Show b) => [Char] -> a -> b -> [Char]
showOp2 [Char]
":" Expr t
c1 Expr t
c2
  show (ExprCell (Cell Coords
e)) = forall a. Show a => a -> [Char]
show Coords
e
  show (Function [Char]
n [Expr t]
as) = [Char]
n forall a. Semigroup a => a -> a -> a
<> [Char]
"(" forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a. Show a => a -> [Char]
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr t]
as) forall a. Semigroup a => a -> a -> a
<> [Char]
")"

-- | Coordinates of a cell with a given phantom type
newtype Cell a = Cell {forall a. Cell a -> Coords
unCell :: Coords} deriving (forall a b. a -> Cell b -> Cell a
forall a b. (a -> b) -> Cell a -> Cell 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 -> Cell b -> Cell a
$c<$ :: forall a b. a -> Cell b -> Cell a
fmap :: forall a b. (a -> b) -> Cell a -> Cell b
$cfmap :: forall a b. (a -> b) -> Cell a -> Cell b
Functor)

cellCol :: Cell a -> Int
cellCol :: forall a. Cell a -> Int
cellCol (Cell Coords
c) = Coords
c forall a b. a -> (a -> b) -> b
& Coords -> Int
col

cellRow :: Cell a -> Int
cellRow :: forall a. Cell a -> Int
cellRow (Cell Coords
c) = Coords
c forall a b. a -> (a -> b) -> b
& Coords -> Int
row

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)

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

instance Num (Cell a) where
  (+) :: Cell a -> Cell a -> Cell a
  + :: Cell a -> Cell a -> Cell a
(+) (Cell Coords
c1) (Cell Coords
c2) = forall a. Coords -> Cell a
Cell (Coords
c1 forall a. Num a => a -> a -> a
+ Coords
c2)
  (*) :: Cell a -> Cell a -> Cell a
  * :: Cell a -> Cell a -> Cell a
(*) (Cell Coords
c1) (Cell Coords
c2) = forall a. Coords -> Cell a
Cell (Coords
c1 forall a. Num a => a -> a -> a
* Coords
c2)
  (-) :: Cell a -> Cell a -> Cell a
  (-) (Cell Coords
c1) (Cell Coords
c2) = forall a. Coords -> Cell a
Cell (Coords
c1 forall a. Num a => a -> a -> a
- Coords
c2)
  abs :: Cell a -> Cell a
  abs :: Cell a -> Cell a
abs (Cell Coords
c1) = forall a. Coords -> Cell a
Cell (forall a. Num a => a -> a
abs Coords
c1)
  signum :: Cell a -> Cell a
  signum :: Cell a -> Cell a
signum (Cell Coords
c1) = forall a. Coords -> Cell a
Cell (forall a. Num a => a -> a
signum Coords
c1)
  fromInteger :: Integer -> Cell a
  fromInteger :: Integer -> Cell a
fromInteger Integer
x = forall a. Coords -> Cell a
Cell (forall a. Num a => Integer -> a
fromInteger Integer
x)

-- | Convert a typed cell to an expression
ex :: Cell a -> Expr a
ex :: forall t. Cell t -> Expr t
ex = forall v t. ToExpr v => v -> Expr t
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 :: Text -> FormatCell
mkColorStyle Text
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
?~ Text
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
                              )
                         )
                 )
         )

type FCTransform = X.FormattedCell -> X.FormattedCell

infixl 5 <|
(<|) :: FCTransform -> FormatCell -> FormatCell
FormattedCell -> FormattedCell
f <| :: (FormattedCell -> FormattedCell) -> FormatCell -> FormatCell
<| FormatCell
fc = \Coords
coords Int
idx CellData
cd -> FormattedCell -> FormattedCell
f forall a b. (a -> b) -> a -> b
$ FormatCell
fc Coords
coords Int
idx CellData
cd

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
                   )
         )

-- | 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 :: 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

class ToCellData a where
  toCellData :: a -> CellData

instance ToCellData String where
  toCellData :: String -> CellData
  toCellData :: [Char] -> 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
. [Char] -> 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
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Expr a
e
        }