module TextUI.ItemField.Types where

import qualified Data.Text as T


type GroupName = T.Text
type NumItems = Int
data Items = ItemGroup GroupName Items | Items NumItems deriving Show
data ItemState = Free | Marked | Good | Bad | Pending deriving (Show,Eq)
type ItemIdent = Maybe (Int -> ItemState -> T.Text)

numItems :: Items -> NumItems
numItems (ItemGroup _ x) = numItems x
numItems (Items n) = n

-- | Returns the count of the number of items
cntItems :: [Items] -> NumItems
cntItems = sum . map numItems



-- | The ItemField is the central management of the set of items and
-- their current states.  There is simply a number of collections of
-- items, expressing only the number of items in the collection.,
-- although there may be a group name associated with each collection.
--
-- Each item has a corresponding state, which is maintained in
-- parallel and an item's state can be modified.
data ItemField = ItemFld { curSel      :: Int
                           -- ^ Currently "selected" item (usually
                           -- where the cursor is)
                         , items       :: [Items]
                         -- ^ Actual item counts, possibly with a group name
                         , itemst8     :: [ItemState]
                         -- ^ Current state of each item (length == cntItems)
                         , elemIdent   :: ItemIdent
                         -- ^ Function returning an item description
                         -- given the item number
                         }


instance Show ItemField where
    showsPrec p s = showParen (p > 10) $
                            showString "ItemFld @ " . shows (curSel s)
                            . showString " with " . shows (length $ itemst8 s)
                            . showString " items"


-- | Standard factory to create an ItemField from a specification of
-- Items and their potential identification function.
newItemField :: [Items] -> ItemIdent -> ItemField
newItemField itms = ItemFld 0 itms (replicate (cntItems itms) Free)