tabloid-0.3: LoadSaveController.hs

module LoadSaveController 
    ( Controller
    , new
    , view
    , onSave
    , onLoad
    , clearLabel
    ) where

import qualified LoadSaveView as View
import qualified Data.ByteString.Lazy.Char8 as L
import Component
import Graphics.UI.Gtk
import WindowedApp
import FileChooser
import Control.Applicative
import Data.List

type Controller = Ref C
type LoadFun = L.ByteString -> IO ()
type SaveFun = IO (Maybe L.ByteString)

view :: C -> Widget
view = View.mainWidget . gui

new :: Maybe String -> IO Controller
new fnSuffix = do
  v <- View.new
  this <- newRef $ C v Nothing Nothing fnSuffix
  (View.saveB v) `onClicked` (this .>> save)
  (View.openB v) `onClicked` (this .>> load)
  return this

onSave :: Maybe SaveFun -> C -> C
onSave action state = state { onSaveCB = action }

onLoad :: Maybe LoadFun -> C -> C
onLoad action state = state { onLoadCB = action }

clearLabel :: C -> IO () 
clearLabel state = labelSetText (View.statusL (gui state)) ""
    
-- internal affairs
data C = C 
    { gui :: View.ViewState
    , onSaveCB :: Maybe SaveFun
    , onLoadCB :: Maybe LoadFun
    , filesuffix :: Maybe String
    }

save :: C -> IO ()
save state = saveFileDialog "Save file " (maybe Nothing (Just . (++) "*.") (filesuffix state)) $ 
             do \fileName ->
                    case onSaveCB state of
                      Nothing -> 
                          return ()
                      Just callback ->
                          do
                            c <- callback
                            case c of
                              Nothing -> 
                                   return ()
                              Just c' ->
                                  let realfn = maybe 
                                                fileName 
                                                (extendFileName fileName) 
                                                (filesuffix state)
                                  in do 
                                    L.writeFile realfn c'
                                    postGUIAsync $ labelSetText (View.statusL $ gui state) $ realfn ++ " Saved."                                           
    where
      extendFileName fileName suffix = if isSuffixOf suffix fileName 
                                         then fileName 
                                         else fileName ++ "." ++ suffix

load :: C -> IO ()
load state = openFileDialog "Open file" (maybe Nothing (Just . (++) "*.") (filesuffix state)) $ 
             do \fileName ->
                    case onLoadCB state of
                      Nothing -> 
                          return ()
                      Just callback ->
                          do
                            c <- L.readFile fileName
                            callback c
                            postGUIAsync $ labelSetText (View.statusL $ gui state) $ fileName ++ " Loaded."
                            
{-
test = windowedApp "LoadSaveController test" $ do
         clut <- new $ Nothing
         mw <- View.mainWidget <$>  (clut .> gui)
         clut .< onLoad (Just L.putStrLn)
         clut .< onSave (Just (return (Just  (L.pack "this is a test"))))
         return mw
-}