{-# LANGUAGE DeriveDataTypeable, BangPatterns, GeneralizedNewtypeDeriving, DeriveDataTypeable,
             ViewPatterns, DeriveFunctor, StandaloneDeriving #-}
{-# OPTIONS -Wall #-}
module DataTreeView.Row(CellData,cellData,unCellData,
    ColorName,CellAttr,txt,bgcolor,bgcolor',fgcolor,fgcolor',scale,Row(..),
    addToAll,convertAttrs,seqListSpine, standardScale,addFieldName) where
import Control.DeepSeq
import Graphics.UI.Gtk
import Data.Typeable
import Data.Monoid
import DataTreeView.StrictTypes
import Data.Data
import Data.Word

seqListSpine ::  [t1] -> t -> t
seqListSpine [] x = x
seqListSpine (_:xs) x = xs `seqListSpine` x 




type CellData = StrictList CellAttr


cellData ::  [CellAttr] -> CellData
cellData = strictList

unCellData :: CellData -> [CellAttr]
unCellData = fromStrictList

type ColorName = String




-- | Cell attributes
data CellAttr =
     Txt !String 
     -- yes, the !String isn't strict enough; thus the smart constructors
   | Bgcolor !ColorName
   | Bgcolor' !Word16 !Word16 !Word16 -- ^ Expanded because 'Color' doesn't have a 'Data' instances and I don't want the code to break once it does
   | Fgcolor !String
   | Fgcolor' !Word16 !Word16 !Word16
   | Scale !Double
   deriving(Show,Typeable,Data,Eq,Ord)

-- | The cell's text. If this attribute occurs multiple times for a single cell, the occurences are concatenated.
txt ::  String -> CellAttr
txt x = rnf x `seq` Txt x
-- | Background color, by name
bgcolor ::  ColorName -> CellAttr
bgcolor x = rnf x `seq` Bgcolor x
-- | Background color, red\/green\/blue
bgcolor' :: Word16 -> Word16 -> Word16 -> CellAttr
bgcolor' = Bgcolor'
-- | Foreground color, by name
fgcolor ::  ColorName -> CellAttr
fgcolor x = rnf x `seq` Fgcolor x
-- | Foreground color, red\/green\/blue
fgcolor' :: Word16 -> Word16 -> Word16 -> CellAttr
fgcolor' = Fgcolor'
-- | Font scaling factor
scale ::  Double -> CellAttr
scale = Scale -- . (*standardScale)

standardScale :: Double
standardScale = 0.75

-- | Data for a row of the tree widget.
data Row = Row { 
      rowCV         :: !CellData -- ^ Constructor name, literal value, or a placeholder like @\"{List}\"@ for custom things 
    , rowFieldName  :: !CellData -- ^ Record field name. You can mostly ignore this, see the remark in 'newRow'.
    , rowCustomInfo :: !CellData -- ^ Arbitrary information (left empty by the generic handler)
    , rowTypeName   :: !CellData 
} deriving(Show,Typeable,Data)

-- | Adds the given attribute to each cell of the given row.
addToAll :: Row -> [CellAttr] -> Row
addToAll r (cellData -> x)    
                 = r { rowCV = rowCV r `mappend` x
                     , rowFieldName = rowFieldName r `mappend` x
                     , rowCustomInfo = rowCustomInfo r `mappend` x
                     , rowTypeName = rowTypeName r `mappend` x
                     }

convertAttrs :: CellRendererTextClass c => CellData -> [AttrOp c]
convertAttrs = fmap convertAttr . fromStrictList 
    where
        convertAttr (Txt x)          = cellText                :~ (++x)
        convertAttr (Fgcolor x)      = cellTextForeground      := x
        convertAttr (Fgcolor' r g b) = cellTextForegroundColor := Color r g b
        convertAttr (Bgcolor x)      = cellTextBackground      := x
        convertAttr (Bgcolor' r g b) = cellTextBackgroundColor := Color r g b
        convertAttr (Scale x)        = cellTextScale           :~ (*x)

addFieldName :: String -> Row -> Row
addFieldName fn r = r { rowFieldName = rowFieldName r `mappend` strictList [txt fn] }