markup-preview 0.1.0.0 → 0.2
raw patch · 2 files changed
+44/−130 lines, 2 filesdep +cmdargs
Dependencies added: cmdargs
Files
- Main.hs +31/−121
- markup-preview.cabal +13/−9
Main.hs view
@@ -1,134 +1,44 @@+{-# LANGUAGE ImplicitParams #-} module Main where - import Graphics.UI.Gtk (AttrOp((:=)))- import qualified Graphics.UI.Gtk as G- import qualified Graphics.UI.Gtk.WebKit.WebView as GW-- import Control.Monad (void, forever, when)- import Control.Concurrent (forkIO, threadDelay)- import Control.Concurrent.MVar- import Data.Maybe (isJust, fromJust)-- import Text.Pandoc- import System.Directory (getTemporaryDirectory, getModificationTime)- import System.IO.Temp (openTempFile)- import GHC.IO.Handle (hPutStr, hFlush)- import Control.Monad.Trans (lift)- import Control.Monad.Trans.Maybe-- import Paths_markup_preview-- import Debug.Trace--- generateHtml format contents = writeHtmlString def intermediaryDocument where- intermediaryDocument = - let reader = fromJust $ lookup format [("Markdown", readMarkdown), ("reStructuredText", readRST), ("Textile", readTextile)]- in reader (def { readerStandalone = True }) contents--- createFilter name filepatterns = do- fileFilter <- G.fileFilterNew- mapM_ (G.fileFilterAddPattern fileFilter) filepatterns- G.fileFilterSetName fileFilter name- return fileFilter--- createOpenDialog = do- dialog <- G.fileChooserDialogNew - (Just "Choose a markup file")- Nothing- G.FileChooserActionOpen- [("Ok", G.ResponseAccept), ("Cancel", G.ResponseCancel)]- createFilter "Markdown" ["*.md", "*.markdown"] >>= G.fileChooserAddFilter dialog- createFilter "reStructuredText" ["*.rst", "*.rest", "*.restx"] >>= G.fileChooserAddFilter dialog - createFilter "Textile" ["*.textile"] >>= G.fileChooserAddFilter dialog -- return dialog--- createToolbar loadNotifier = do- toolbar <- G.toolbarNew- G.toolbarSetStyle toolbar G.ToolbarIcons- openButton <- G.toolButtonNewFromStock "gtk-open"- void $ G.onToolButtonClicked openButton $ do- openDialog <- createOpenDialog- dialogResponse <- G.dialogRun openDialog- when (dialogResponse == G.ResponseAccept) $ do- response <- runMaybeT $ do- filepath <- MaybeT $ G.fileChooserGetFilename openDialog- fileFilter <- MaybeT $ G.fileChooserGetFilter openDialog- format <- lift $ G.fileFilterGetName fileFilter - return (format, filepath)- when (isJust response) $ putMVar loadNotifier (fromJust response)- G.widgetDestroy openDialog-- G.toolbarInsert toolbar openButton 0-- return toolbar--- createInterface loadNotifier = do- window <- G.windowNew- scrolledWindow <- G.scrolledWindowNew Nothing Nothing- webView <- GW.webViewNew- G.set scrolledWindow [ G.containerChild := webView ]- statusBar <- G.statusbarNew- toolBar <- createToolbar loadNotifier-- singleColumn <- G.vBoxNew False 1- G.boxPackStart singleColumn toolBar G.PackNatural 0- G.boxPackStart singleColumn scrolledWindow G.PackGrow 0- G.boxPackEnd singleColumn statusBar G.PackNatural 0-- G.set window [ G.containerChild := singleColumn- , G.windowDefaultWidth := 600- , G.windowDefaultHeight := 600- , G.containerBorderWidth := 1- ]- return (window, webView)+ import Application.GUI+ import Application.CommandLine+ import Application.FileHandling + -- logic related imports+ import Control.Monad+ import Control.Concurrent+ import Data.Maybe - withGUI f = do- void G.initGUI- window <- f- G.onDestroy window G.mainQuit- G.widgetShowAll window- G.mainGUI+ -- transformation related imports+ import System.Directory - loadHtmlInView webView htmlContent = do- tempDirectory <- getTemporaryDirectory- layout <- getDataFileName "Resources/layout.html" >>= \filepath -> readFile filepath- let htmlContent' = renderTemplate [("htmlContent", htmlContent)] layout- (tempFilePath, tempHandle) <- openTempFile tempDirectory "markup-preview.html"- hPutStr tempHandle htmlContent' >> hFlush tempHandle- GW.webViewLoadUri webView ("file://" ++ tempFilePath)+ loop :: Monad m => a -> (a -> m a) -> m a+ loop a f = f a >>= \a' -> loop a' f - loaderReloader webView loadNotifier Nothing Nothing = do- threadDelay 500- (format, filepath) <- takeMVar loadNotifier- modificationTime <- getModificationTime filepath- contents <- readFile filepath- loadHtmlInView webView $ generateHtml format contents- loaderReloader webView loadNotifier (Just (format, filepath)) (Just modificationTime)-- loaderReloader webView loadNotifier (Just (format, filepath)) (Just modificationTime) = do- threadDelay 500- noNewFile <- isEmptyMVar loadNotifier- if noNewFile- then do modificationTime' <- getModificationTime filepath- when (modificationTime' /= modificationTime) $ do- contents <- readFile filepath- loadHtmlInView webView $ generateHtml format contents- loaderReloader webView loadNotifier (Just (format, filepath)) (Just modificationTime')- else loaderReloader webView loadNotifier Nothing Nothing+ createLoadNotifier :: StartupOptions -> IO (MVar (String, FilePath))+ createLoadNotifier o | canLoad o = newMVar (fromJust $ filetype o, fromJust $ file o)+ | otherwise = newEmptyMVar main :: IO ()- main = withGUI $ do- loadNotifier <- newEmptyMVar :: IO (MVar (String, String))+ main = withCommandLine $ withGUI $ do+ loadNotifier <- createLoadNotifier ?startupOptions (window, webView) <- createInterface loadNotifier- forkIO $ loaderReloader webView loadNotifier Nothing Nothing+ let loadInsideView r = renderHtml r >>= webViewLoadUri webView+ void . forkIO . void $ loop (Nothing, Nothing) $ \(resource, modificationTime) -> do+ threadDelay 500+ if isNothing resource || isNothing modificationTime+ then do resource' <- takeMVar loadNotifier+ modificationTime' <- getModificationTime (snd resource')+ loadInsideView resource'+ return (Just resource', Just modificationTime')+ else do noNewFile <- isEmptyMVar loadNotifier+ if noNewFile+ then do modificationTime' <- getModificationTime (snd $ fromJust resource)+ when (modificationTime' /= fromJust modificationTime) $ loadInsideView (fromJust resource)+ return (resource, Just modificationTime')+ else return (Nothing, Nothing) return window
markup-preview.cabal view
@@ -1,12 +1,15 @@--- Initial markup-preview.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/- name: markup-preview-version: 0.1.0.0+version: 0.2 synopsis: A simple markup document preview (markdown, textile, reStructuredText)-description: A GUI application that renders the markup documents (markdown, textile, reStructuredText) into- HTML and presents them into a web view. It also reloads the content automatically when the source- file changes.+description: + A GUI application that renders the markup documents (markdown, textile, reStructuredText) into+ HTML and presents them into a web view. It also reloads the content automatically when the source+ file changes.+ .+ Changes from 0.1.0.0:+ .+ * Added command line options e.g. markup file can be specified when starting the program.+ license: OtherLicense license-file: LICENSE author: Marius Ghita@@ -23,6 +26,7 @@ executable markup-preview main-is: Main.hs- ghc-options: -threaded+ ghc-options: -threaded -Wall+ cpp-options: -DCABAL other-modules: Paths_markup_preview- build-depends: base == 4.*, gtk, webkit, pandoc, directory, temporary, transformers, mtl+ build-depends: base == 4.*, gtk, webkit, pandoc, directory, temporary, transformers, mtl, cmdargs