WtkGui.hs

---------------------------------------------------------
--
-- Module        : GUI.wtk-gui
-- Copyright     : Bartosz Wójcik (2010)
-- License       : BSD3
--
-- Maintainer    : bartek@sudety.it
-- Stability     : Unstable
-- Portability   : portable
--
-- | Data types being standard interface between any GUI and
--   underlying application.
--   Heavy usage of lenses, which has disadvantage of huge amount
--   of API documentation without proper comments.
---------------------------------------------------------
{-# LANGUAGE ExistentialQuantification
, TemplateHaskell
, FlexibleContexts
, NoMonomorphismRestriction #-}
module Graphics.UI.Gtk.WtkGui

where

import Data.Time
import Data.IORef (IORef)
import Data.Lenses
import Data.Lenses.Template

-- | Abstract input types. Denote UI fields.
data InputFieldType =
         -- | Float value
         Fl { flValue_ :: Maybe Double  -- ^ parsed value
            }                     

       -- | Integer value
       | In { inValue_ :: Maybe Int }

       -- | String value
       | Str { stValue_ :: String }

       -- | Date value
       | Da { daValue_ :: Maybe Day }

       -- | Selection list (no syntax validation)
       | Selection { selValue_  :: Maybe Int   -- ^ selected item
                   , selString_ :: [String]    -- ^ list of avaliable values
                   }

       -- | Check Box (no syntax validation)
       | CheckBox { cbValue_ :: Bool }

       -- | Very general action.
       | Action { action_ :: IO () }

       -- | In case no data needed for a widget.
       | NoDataJustAttributes

       --  Action is so particular GUI solution specific so we not abstract it.
--        forall a. Action { action :: IORef a -> IO () }       -- ^ action itself

instance Show InputFieldType where
   show (Fl x) = "Fl " ++ show x
   show (In x) = "In " ++ show x
   show (Str x) = "St " ++ x
   show (Da x) = "Da " ++ show x
   show (Selection x y) = "Sel " ++ show x ++ " " ++ show y
   show (CheckBox x) = "CB " ++ show x
   show (Action _) = "Action"

$( deriveLenses ''InputFieldType )

isSelectionJust (Selection (Just _) _) = True
isSelectionJust _                      = False
isInputJust (Fl (Just _))  = True
isInputJust (In (Just _))  = True
isInputJust (Da (Just _))  = True
isInputJust _              = False
isCheckBox (CheckBox _) = True
isCheckBox _            = False
setCheckBox v (CheckBox _) = CheckBox v
setCheckBox _ x            = x

newSelection :: Int -> InputFieldType -> InputFieldType
newSelection i s@(Selection _ xs) | length xs < i-1 || i < 0 = s
                                  | otherwise                = Selection (Just i) xs

-- ================= Abstract Widget ========================
-- | Attributes of an abstract widget
data Attributes = Attributes {
     rawValue_  :: String            -- ^ raw value
   , validated_ :: Bool              -- ^ value has been validated
   , visible_   :: Bool              -- ^ visibility
   , editable_  :: Bool              -- ^ value editable
   , isError_   :: Bool              -- ^ True when value is not correct
   , errMssg_   :: String            -- ^ error message
   }
   deriving (Show, Eq, Ord)

$( deriveLenses ''Attributes )

-- | Abstraction of widget. It consists of id, value with type and attributes.
--   This is main data type to use as widget field. It consist of all what needed:
--   its ID, its value of one of allowed types and attributes.
data InputField = InputField {idOf_  :: Int
                             ,val_   :: InputFieldType
                             ,att_   :: Attributes
                             }
                             deriving Show

$( deriveLenses ''InputField )

-- | Boilerplating not provided by Lenses.Template
val_flValue = val . flValue
val_inValue = val . inValue
val_stValue = val . stValue
val_daValue = val . daValue
val_cbValue = val . cbValue
val_selValue = val . selValue
val_selString = val . selString
val_action = val . action

att_rawValue = att . rawValue
att_validated = att . validated
att_visible = att . visible
att_editable = att . editable
att_isError = att . isError
att_errMssg = att . errMssg