packages feed

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

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

module Editor6thCrontab where

import Entry3rdCrontab
import Run

import Graphics.UI.AF.WxFormAll

$(derive [''Crontab,''Entry,''Comment,''Field])

main = do (exitCode, crontabText) <- readCommand "crontab -l" ""
          startWx "Editor6th" $
             case exitCode of
               ExitFailure e -> errorDialog' ("Error - could not read crontab:\n") e
               ExitSuccess   -> do crontab <- liftIO $ (readIO crontabText >>= return . Right)
                                                       `catch` (return . Left)
                                   either (errorDialog' "Error - could not parse crontab:\n")
                                          -- (\x -> window [] $ crontabComponent x)
                                          cronGui
                                          crontab
          return ()
    where
      errorDialog' msg e = errorDialog "Error loading crontab" (msg ++ show e)
      cronGui x
          = do cronHandle <- builderCom x
               chState    <- makeChangedState cronHandle
               button "Save" (saveFile cronHandle chState) >>= enabledWhen chState (== Changed)
               button "Show" (showFile cronHandle)
               button "Quit" closeWindow
               return ()
          
      saveFile cronHandle chState = 
          do x <- getValue cronHandle
             (exitCode, crontabText) <- liftIO $ readCommand "crontab -" (show x)
             case exitCode of
               ExitFailure _ -> errorDialog "Error saving crontab" "Could not save crontab"
               _             -> setValue chState $ Unchanged x
      showFile :: ComH Crontab -> WxAct()
      showFile cronHandle =
          do x <- getValue cronHandle
             infoDialog "Crontab file" (show x)

instance TypePresentation Entry WxAct ComH WxM SatCxt EC where
    mkCom x = finalDepth $ layoutAs dualColumn $ defaultCom x