packages feed

AutoForms-0.4.0: src/Examples/HCron/Editor5thOutputWindow.hs

{-# LANGUAGE FlexibleContexts, FlexibleInstances
  , MultiParamTypeClasses, TemplateHaskell
  , TypeSynonymInstances, UndecidableInstances #-}

module Editor5thOutputWindow where

import Entry2ndRecurring as Entry

import Graphics.UI.AF.WxFormAll

import Control.Monad.Trans(MonadIO)
import Run

$(derive [''Entry,''Time,''Month,''TimeDiff])

main = startWx "Editor5th" $ editFile specLocation ([]::HCron)

instance ( AutoForm WxAct ComH WxM SatCxt EC
         , Sat (SatCxt (Entry Time)), Sat (SatCxt [String]))
    => TypePresentation (Entry Time) WxAct ComH WxM SatCxt EC where
    mkCom x = limit timeLimit ("Incorrect time") $
                 label "Entry" $ builderToCom $
                       do entryHandle  <- addCom $ defaultCom x -- don't use mkCom here, as this
                                                                -- results in eternal recursion
                          outputHandle <- addCom $ label "Command output" $ mkCom [""]
                          button "Exec..." (do cmd <- getValue entryHandle
                                               (_, out) <- liftIO $ readCommand (Entry.command cmd) ""
                                               setValue outputHandle (lines out)
                                           )
                          return entryHandle
        where
          timeLimit :: Entry Time -> IO Bool
          timeLimit Entry { when = Time y month d h m } = return $
            y > 1970   && y < 2100    &&
            d >= 1                    &&
            ((month == February && d <= 28)                   ||
             (month == February && d == 29 && y `mod` 4 == 0) ||
             (month `elem` [ January, March, May, July, August
                           , October, December] && d <= 30)   ||
             (month `elem` [April, June, September, November] && d <= 30)
            )                         &&
            h >= 0     && h <= 23     &&
            m >= 0     && m <= 59

instance GInstanceCreator Time where
    gGenUpTo _ = [Time 2000 January 1 10 00]