Skip to content

Instantly share code, notes, and snippets.

@YoEight
Created April 27, 2014 21:47
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save YoEight/11356454 to your computer and use it in GitHub Desktop.
Save YoEight/11356454 to your computer and use it in GitHub Desktop.
GHC: 7.8.2
Cabal: 1.18.0.3
import Control.Applicative (liftA2)
import Control.Monad (forever)
import Control.Monad.State
import Control.Monad.Trans
import Data.Foldable (traverse_, for_)
import Data.Functor (void)
import Data.Monoid ((<>))
import qualified Graphics.UI.Gtk as Gtk
import MVC
import MVC.Prelude
import Pipes
import Pipes.Concurrent
import System.FilePath
data Inputs = ISrc FilePath
| IDest FilePath
| IDoIt
data Outputs = OSrc FilePath
| ODest FilePath
| ODoIt FilePath FilePath
data AppState =
AppState
{ appSrc :: Maybe FilePath
, appDest :: Maybe FilePath
}
initState :: AppState
initState = AppState Nothing Nothing
main :: IO ()
main = do
Gtk.initGUI
win <- Gtk.windowNew
-- Open File Dialog
odialog <- Gtk.fileChooserDialogNew (Just "Choose Source")
(Just win)
Gtk.FileChooserActionOpen
[("Open", Gtk.ResponseOk), ("Cancel", Gtk.ResponseCancel)]
-- Save File Dialog
sdialog <- Gtk.fileChooserDialogNew (Just "Choose Destination")
(Just win)
Gtk.FileChooserActionSave
[("Save", Gtk.ResponseOk), ("Cancel", Gtk.ResponseCancel)]
-- Vbox
vbox <- Gtk.vBoxNew True 10
srcb <- Gtk.buttonNewWithLabel "Choose source..."
destb <- Gtk.buttonNewWithLabel "Choose destination..."
dob <- Gtk.buttonNewWithLabel "Do it !"
Gtk.widgetSetSensitive destb False
Gtk.widgetSetSensitive dob False
Gtk.containerAdd vbox srcb
Gtk.containerAdd vbox destb
Gtk.containerAdd vbox dob
(output, input) <- spawn Unbounded
-- Src Button
Gtk.on srcb Gtk.buttonActivated $ do
opt <- getSelection odialog
traverse_ (forkIO . void . atomically . send output . ISrc) opt
-- Dest Button
Gtk.on destb Gtk.buttonActivated $ do
opt <- getSelection sdialog
traverse_ (forkIO . void . atomically . send output . IDest) opt
-- Do it Button
Gtk.on dob Gtk.buttonActivated $
void $ forkIO $ void $ atomically $ send output IDoIt
let controller = asInput input
view = asSink $ \i -> Gtk.postGUISync $
case i of
OSrc path -> do
Gtk.buttonSetLabel srcb (takeFileName path)
Gtk.widgetSetSensitive destb True
ODest path -> do
Gtk.buttonSetLabel destb (takeFileName path)
Gtk.widgetSetSensitive dob True
ODoIt from to -> readFile from >>= writeFile to
-- Model
model = asPipe $ forever $ do
i <- await
s <- get
case i of
ISrc path -> do
put s{ appSrc = Just path }
yield $ OSrc path
IDest path -> do
put s{ appDest = Just path }
yield $ ODest path
IDoIt ->
let zipped = liftA2 (,) (appSrc s) (appDest s) in
traverse_ (yield . uncurry ODoIt) zipped
-- Configure main window
Gtk.set win [ Gtk.windowTitle Gtk.:= "MVC Test"
, Gtk.windowDefaultWidth Gtk.:= 200
, Gtk.containerBorderWidth Gtk.:= 10
, Gtk.containerChild Gtk.:= vbox
]
Gtk.on win Gtk.objectDestroy Gtk.mainQuit
Gtk.widgetShowAll win
-- Run our MVC
forkIO $ void $ runMVC initState model $ return (view, controller)
Gtk.mainGUI
getSelection :: Gtk.FileChooserDialog -> IO (Maybe FilePath)
getSelection diag = do
resp <- Gtk.dialogRun diag
Gtk.widgetHide diag
case resp of
Gtk.ResponseOk -> Gtk.fileChooserGetFilename diag
_ -> return Nothing
name: test-mvc
version: 0.1.0.0
build-type: Simple
cabal-version: >=1.10
executable test-mvc
main-is: Main.hs
build-depends: base >=4.7 && <4.8,
mvc,
gtk3,
mtl,
pipes,
pipes-concurrency,
filepath
default-language: Haskell2010
@YoEight
Copy link
Author

YoEight commented Apr 27, 2014

Description

This is a simple file copier. It got 3 buttons:

  1. Choose source: Select a file to copy from
  2. Choose destination: Select a file to write to
  3. Do it: Performs copy

Implementation

  1. Controller emits ISrc when an source file is selected. The model yields OSrc when it gets ISrc
  2. Controller emits IDest when an destination file is selected. The model yields ODest when it gets IDest
  3. Controller emits IDoIt when Do It button is clicked. The model yields ODoIt when it gets IDoIt

Issues

I have to click several time on a button to get it's view action executed. I don't know if that behaviour is related to how I configured the mailbox or another misuse of the library.

Some figures.

To get OSrc view action executed, I have to select a file ~4 times
To get ODest view action executed, I have to select a file 4-8 times
To get ODoIt view action executed, I have to click on Do it ~10 times

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment