Row.hs

module Spreadsheet.Row (
   M,
   exec,
   run,

   Value,
   Fraction,
   Precision(..),

   putEmpty,
   putValueFormula,
   putValue,
   putFractionFormula,
   putFraction,
   putPlainFraction,
   putString,
   putAnchor,
   putInt,
   putNumber,

   FieldTracked,
   FieldType(..),
   TableField(..),
   emptyField,
   fractionField,
   fracFieldFromTracked,
   ) where

import qualified Spreadsheet.Formula as CalcForm
import Spreadsheet.Formula
         (FormulaTracked, CellTracked, Tracked(Tracked), untracked)

import qualified Control.Monad.Trans.RWS as MRWS
import Control.Monad (liftM2)
import Data.Bifunctor (bimap, )

import Text.Printf (PrintfArg, printf)

import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()


data FieldType = TypeString | TypeNumber
   deriving (Eq, Ord, Enum, Show)

type FieldTracked = TableField (Tracked (Maybe CalcForm.Formula) String)
data TableField a =
   TableField {
      fieldType :: FieldType,
      fieldQuoted :: Bool,
      fieldAnchor :: String,
      fieldHead :: Bool,
      fieldSpan :: Int,
      fieldPrecision :: Maybe Precision,
      fieldContent :: a
   }

instance Functor TableField where
   fmap f x = x{fieldContent = f $ fieldContent x}


type M = MRWS.RWS Int [FieldTracked] Int

exec :: Int -> M () -> [FieldTracked]
exec row act = snd $ run row act

run :: Int -> M row -> (row, [FieldTracked])
run row act = MRWS.evalRWS act row 0


makeField :: Bool -> a -> TableField a
makeField quote content =
   TableField {
      fieldType = TypeString,
      fieldQuoted = quote,
      fieldAnchor = "",
      fieldHead = False,
      fieldSpan = 1,
      fieldPrecision = Nothing,
      fieldContent = content
   }

putString :: String -> M ()
putString str =
   put $ makeField True $ untracked str

putAnchor :: String -> String -> M ()
putAnchor ref str =
   put $ (makeField True $ untracked str) {fieldAnchor = ref}


put :: FieldTracked -> M ()
put x = do
   column <- MRWS.get
   MRWS.tell [x]
   MRWS.put $! column + fieldSpan x


putEmpty :: M ()
putEmpty = put emptyField

putInt :: (Ring.C a) => Int -> M (CellTracked a)
putInt = fmap CalcForm.fromInt . putNumber

getCellName :: M CalcForm.CellId
getCellName = liftM2 CalcForm.CellId MRWS.ask MRWS.get

putNumber :: (Value a) => a -> M (CellTracked a)
putNumber x = do
   cell <- getCellName
   put $ (makeField False $ untracked $ formatValue x) {fieldType = TypeNumber}
   return $ Tracked cell x

putValue :: (Value a) => FormulaTracked a -> M (CellTracked a)
putValue x = do
   cell <- getCellName
   put $ fieldFromTracked x
   return $ x{CalcForm.trackedFormula = cell}

putValueFormula :: (Value a) => FormulaTracked a -> M (FormulaTracked a)
putValueFormula = fmap CalcForm.trackedVar . putValue

putFraction ::
   (Fraction a) => Precision -> FormulaTracked a -> M (CellTracked a)
putFraction prec x = do
   cell <- getCellName
   put $ fracFieldFromTracked prec x
   return $ x{CalcForm.trackedFormula = cell}

putPlainFraction :: (Fraction a) => Precision -> a -> M (CellTracked a)
putPlainFraction prec x = do
   cell <- getCellName
   put $ fractionField prec x
   return $ Tracked cell x

putFractionFormula ::
   (Fraction a) => Precision -> FormulaTracked a -> M (FormulaTracked a)
putFractionFormula prec = fmap CalcForm.trackedVar . putFraction prec


class Value a where
   {- |
   Convert a value to a text representation
   that is compatible to spreadsheet processors.
   -}
   formatValue :: a -> String

instance Value Int where
   formatValue = show

instance Value Integer where
   formatValue = show

instance Value Float where
   formatValue = show

instance Value Double where
   formatValue = show


data Precision = Prec0 | Prec3 | Prec6
   deriving (Eq, Ord, Enum)

class (Value a, Field.C a) => Fraction a where
   formatFraction :: Precision -> a -> String

instance Fraction Float where
   formatFraction = formatFractionDefault

instance Fraction Double where
   formatFraction = formatFractionDefault

formatFractionDefault :: (PrintfArg a) => Precision -> a -> String
formatFractionDefault prec = printf (precisionFormat prec)

precisionFormat :: Precision -> String
precisionFormat prec =
   case prec of
      Prec0 -> "%.0f"
      Prec3 -> "%.3f"
      Prec6 -> "%.6f"


fieldFromTracked :: Value a => Tracked CalcForm.Formula a -> FieldTracked
fieldFromTracked x =
   (makeField False $ bimap Just formatValue x) {fieldType = TypeNumber}

fracFieldFromTracked ::
   Fraction a => Precision -> Tracked CalcForm.Formula a -> FieldTracked
fracFieldFromTracked prec x =
   (makeField False $ bimap Just (formatFraction prec) x)
      {fieldType = TypeNumber, fieldPrecision = Just prec}

emptyField :: FieldTracked
emptyField = makeField False $ untracked ""

fractionField :: (Fraction a) => Precision -> a -> FieldTracked
fractionField prec a =
   (makeField False $ untracked $ formatFraction prec a)
      {fieldType = TypeNumber, fieldPrecision = Just prec}