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 -}