yesod-fast-devel (empty) → 0.1.2.0
raw patch · 6 files changed
+501/−0 lines, 6 filesdep +Globdep +ansi-terminaldep +basesetup-changed
Dependencies added: Glob, ansi-terminal, base, bytestring, directory, filepath, fsnotify, optparse-applicative, process, pureMD5, stm, system-filepath, temporary, text
Files
- LICENSE +31/−0
- Main.hs +220/−0
- OriginalDevelMain.hs +99/−0
- PatchedDevelMain.hs +103/−0
- Setup.hs +2/−0
- yesod-fast-devel.cabal +46/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2014, Arne Link+Copyright (c) 2016, Pedro Tacla Yamada++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Arne Link nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,220 @@+module Main where++import Control.Concurrent (forkIO, threadDelay)+import Control.Concurrent.STM.TChan (TChan, dupTChan, newTChan,+ readTChan, writeTChan)+import Control.Exception (bracket)+import Control.Monad (forever, unless, when)+import Control.Monad.STM (atomically)+import qualified Data.ByteString.Lazy as ByteString+import Data.Digest.Pure.MD5 (md5)+import Data.Maybe+import Data.Monoid+import Data.Text (isInfixOf, pack)+import Options.Applicative+import Paths_yesod_fast_devel+import System.Console.ANSI+import System.Directory (copyFile, doesDirectoryExist,+ findExecutable)+import System.Exit+import System.FilePath (takeDirectory)+import System.FilePath.Glob+import System.FilePath.Posix (takeBaseName)+import System.FSNotify (Event (..), watchTree,+ withManager)+import System.IO (BufferMode (..), Handle,+ hPutStrLn, hSetBuffering, stderr,+ stdout)+import System.Process++data Options+ = PatchDevelMain { pdmFilePath :: FilePath}+ | PrintPatchedMain+ | StartServer { ssFilePath :: FilePath}++options :: ParserInfo Options+options =+ info+ (allCommands <**> helper)+ (header "Faster yesod-devel with GHCi and Browser Sync")+ where+ allCommands =+ subparser+ (patchDevelMain <> printPatchedMain <> startServer <>+ metavar "patch | server| print-patched-main")+ printPatchedMain =+ command+ "print-patched-main"+ (info (pure PrintPatchedMain) (progDesc "Print the patched DevelMain"))+ startServer =+ command+ "server"+ (info+ (StartServer . fromMaybe "app/DevelMain.hs" <$>+ optional (argument str (metavar "devel-main-path")) <**>+ helper)+ (progDesc "Start the development servers"))+ patchDevelMain =+ command+ "patch"+ (info+ (PatchDevelMain . fromMaybe "app/DevelMain.hs" <$>+ optional (argument str (metavar "devel-main-path")) <**>+ helper)+ (progDesc "Patch your devel main with browser-sync"))++main :: IO ()+main = do+ cmd <- execParser options+ case cmd of+ PatchDevelMain fp -> initYesodFastDevel fp+ StartServer fp -> go fp+ PrintPatchedMain ->+ putStrLn =<< readFile =<< getDataFileName "PatchedDevelMain.hs"+ where+ go develMainPth = do+ hSetBuffering stdout LineBuffering+ hSetBuffering stderr LineBuffering+ chan <- atomically newTChan+ _ <- forkIO $ do+ hPutStrLn stderr "Watching files for changes..."+ watchThread chan+ _ <- forkIO $ do+ hPutStrLn stderr "Spawning browser-sync..."+ browserSyncThread+ hPutStrLn stderr "Spawning GHCi..."+ _ <- replThread develMainPth chan+ return ()++initYesodFastDevel :: FilePath -> IO ()+initYesodFastDevel develMainPth = do+ verifyDirectory+ verifyDevelMain+ patchedDevelMain <- getDataFileName "PatchedDevelMain.hs"+ copyFile patchedDevelMain develMainPth+ putStrLn "Patched `DevelMain.hs`"+ browserSyncPth <- findExecutable "browser-sync"+ putStrLn "Make sure you have `foreign-store` on your cabal file"+ when (isNothing browserSyncPth) $+ putStrLn "Install `browser-sync` to have livereload at port 4000"+ exitSuccess+ where+ verifyDirectory = do+ let dir = takeDirectory develMainPth+ putStrLn ("Verifying `" ++ dir ++ "` exists")+ dexists <- doesDirectoryExist dir+ unless dexists $ do+ hPutStrLn stderr ("Directory `" ++ dir ++ "` not found")+ exitFailure+ verifyDevelMain = do+ putStrLn "Verifying `DevelMain.hs` isn't modified"+ userDevelMd5 <- md5 <$> ByteString.readFile develMainPth+ originalDevelMd5 <-+ md5 <$> (ByteString.readFile =<< getDataFileName "OriginalDevelMain.hs")+ patchedDevelMd5 <-+ md5 <$> (ByteString.readFile =<< getDataFileName "PatchedDevelMain.hs")+ when (userDevelMd5 == patchedDevelMd5) $ do+ putStrLn "DevelMain.hs is already patched"+ exitSuccess+ when (userDevelMd5 /= originalDevelMd5) $ do+ hPutStrLn stderr "Found a weird DevelMain.hs on your project"+ hPutStrLn stderr "Use `yesod-fast-devel print-patched-main`"+ exitFailure++browserSyncThread :: IO ()+browserSyncThread = do+ browserSyncPth <- findExecutable "browser-sync"+ when (isJust browserSyncPth) $ callCommand cmd+ where+ cmd =+ "browser-sync start --no-open --files=\"devel-main-since\" --proxy \"localhost:3000\" --port 4000"++watchThread :: TChan Event -> IO ()+watchThread writeChan =+ withManager $ \mgr+ -- start a watching job (in the background)+ -> do+ _ <- watchTree mgr "." shouldReload (reloadApplication writeChan)+ -- sleep forever (until interrupted)+ forever $ threadDelay 1000000000++replThread :: FilePath -> TChan Event -> IO ()+replThread develMainPth chan = do+ readChan <- atomically (dupTChan chan)+ bracket newRepl onError (onSuccess readChan)+ where+ onError (_, _, _, process) = do+ interruptProcessGroupOf process+ threadDelay 100000+ terminateProcess process+ threadDelay 100000+ waitForProcess process+ onSuccess readChan (Just replIn, _, _, _) = do+ hSetBuffering replIn LineBuffering+ threadDelay 1000000+ hPutStrLn replIn loadString+ hPutStrLn replIn startString+ forever $ do+ event <- atomically (readTChan readChan)+ putStrLn "-----------------------------"+ setSGR [SetColor Foreground Vivid Yellow]+ print event+ setSGR [Reset]+ putStrLn "-----------------------------"+ hPutStrLn replIn loadString+ hPutStrLn replIn startString+ onSuccess _ (_, _, _, _) = do+ hPutStrLn stderr "Can't open GHCi's stdin"+ exitFailure+ startString = "update"+ loadString = ":load " ++ develMainPth++shouldReload :: Event -> Bool+shouldReload event = not (or conditions)+ where+ fp =+ case event of+ Added filePath _ -> filePath+ Modified filePath _ -> filePath+ Removed filePath _ -> filePath+ conditions =+ [ notInPath ".git"+ , notInPath "yesod-devel"+ , notInPath "dist"+ , notInFile "#"+ , notInPath ".cabal-sandbox"+ , notInFile "flycheck_"+ , notInPath ".stack-work"+ , notInGlob (compile "**/*.sqlite3-*")+ , notInGlob (compile "*.sqlite3-*")+ , notInFile "stack.yaml"+ , notInGlob (compile "*.hi")+ , notInGlob (compile "**/*.hi")+ , notInGlob (compile "*.o")+ , notInGlob (compile "**/*.o")+ , notInFile "devel-main-since"+ ]+ notInPath t = t `isInfixOf` pack fp+ notInFile t = t `isInfixOf` pack (takeBaseName fp)+ notInGlob pt = match pt fp++reloadApplication :: TChan Event -> Event -> IO ()+reloadApplication chan event = atomically (writeTChan chan event)++newRepl :: IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)+newRepl =+ createProcess $ newProc "stack" ["ghci", "--ghc-options", "-O0 -fobject-code"]++newProc :: FilePath -> [String] -> CreateProcess+newProc cmd args =+ CreateProcess+ { cmdspec = RawCommand cmd args+ , cwd = Nothing+ , env = Nothing+ , std_in = CreatePipe+ , std_out = Inherit+ , std_err = Inherit+ , close_fds = False+ , create_group = True+ , delegate_ctlc = False+ }
+ OriginalDevelMain.hs view
@@ -0,0 +1,99 @@+-- | Running your app inside GHCi.+--+-- To start up GHCi for usage with Yesod, first make sure you are in dev mode:+--+-- > cabal configure -fdev+--+-- Note that @yesod devel@ automatically sets the dev flag.+-- Now launch the repl:+--+-- > cabal repl --ghc-options="-O0 -fobject-code"+--+-- To start your app, run:+--+-- > :l DevelMain+-- > DevelMain.update+--+-- You can also call @DevelMain.shutdown@ to stop the app+--+-- You will need to add the foreign-store package to your .cabal file.+-- It is very light-weight.+--+-- If you don't use cabal repl, you will need+-- to run the following in GHCi or to add it to+-- your .ghci file.+--+-- :set -DDEVELOPMENT+--+-- There is more information about this approach,+-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci++module DevelMain where++import Prelude+import Application (getApplicationRepl, shutdownApp)++import Control.Exception (finally)+import Control.Monad ((>=>))+import Control.Concurrent+import Data.IORef+import Foreign.Store+import Network.Wai.Handler.Warp+import GHC.Word++-- | Start or restart the server.+-- newStore is from foreign-store.+-- A Store holds onto some data across ghci reloads+update :: IO ()+update = do+ mtidStore <- lookupStore tidStoreNum+ case mtidStore of+ -- no server running+ Nothing -> do+ done <- storeAction doneStore newEmptyMVar+ tid <- start done+ _ <- storeAction (Store tidStoreNum) (newIORef tid)+ return ()+ -- server is already running+ Just tidStore -> restartAppInNewThread tidStore+ where+ doneStore :: Store (MVar ())+ doneStore = Store 0++ -- shut the server down with killThread and wait for the done signal+ restartAppInNewThread :: Store (IORef ThreadId) -> IO ()+ restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do+ killThread tid+ withStore doneStore takeMVar+ readStore doneStore >>= start+++ -- | Start the server in a separate thread.+ start :: MVar () -- ^ Written to when the thread is killed.+ -> IO ThreadId+ start done = do+ (port, site, app) <- getApplicationRepl+ forkIO (finally (runSettings (setPort port defaultSettings) app)+ -- Note that this implies concurrency+ -- between shutdownApp and the next app that is starting.+ -- Normally this should be fine+ (putMVar done () >> shutdownApp site))++-- | kill the server+shutdown :: IO ()+shutdown = do+ mtidStore <- lookupStore tidStoreNum+ case mtidStore of+ -- no server running+ Nothing -> putStrLn "no Yesod app running"+ Just tidStore -> do+ withStore tidStore $ readIORef >=> killThread+ putStrLn "Yesod app is shutdown"++tidStoreNum :: Word32+tidStoreNum = 1++modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()+modifyStoredIORef store f = withStore store $ \ref -> do+ v <- readIORef ref+ f v >>= writeIORef ref
+ PatchedDevelMain.hs view
@@ -0,0 +1,103 @@+-- | Running your app inside GHCi.+--+-- To start up GHCi for usage with Yesod, first make sure you are in dev mode:+--+-- > cabal configure -fdev+--+-- Note that @yesod devel@ automatically sets the dev flag.+-- Now launch the repl:+--+-- > cabal repl --ghc-options="-O0 -fobject-code"+--+-- To start your app, run:+--+-- > :l DevelMain+-- > DevelMain.update+--+-- You can also call @DevelMain.shutdown@ to stop the app+--+-- You will need to add the foreign-store package to your .cabal file.+-- It is very light-weight.+--+-- If you don't use cabal repl, you will need+-- to run the following in GHCi or to add it to+-- your .ghci file.+--+-- :set -DDEVELOPMENT+--+-- There is more information about this approach,+-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci++module DevelMain where++import Prelude+import Application (getApplicationRepl, shutdownApp)++import Control.Exception (finally)+import Control.Monad ((>=>))+import Control.Concurrent+import Data.IORef+import Data.Time.Clock+import Foreign.Store+import Network.Wai.Handler.Warp+import GHC.Word++-- | Start or restart the server.+-- newStore is from foreign-store.+-- A Store holds onto some data across ghci reloads+update :: IO ()+update = do+ mtidStore <- lookupStore tidStoreNum+ case mtidStore of+ -- no server running+ Nothing -> do+ done <- storeAction doneStore newEmptyMVar+ tid <- start done+ _ <- storeAction (Store tidStoreNum) (newIORef tid)+ return ()+ -- server is already running+ Just tidStore -> restartAppInNewThread tidStore+ where+ doneStore :: Store (MVar ())+ doneStore = Store 0++ -- shut the server down with killThread and wait for the done signal+ restartAppInNewThread :: Store (IORef ThreadId) -> IO ()+ restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do+ killThread tid+ withStore doneStore takeMVar+ readStore doneStore >>= start+++ -- | Start the server in a separate thread.+ start :: MVar () -- ^ Written to when the thread is killed.+ -> IO ThreadId+ start done = do+ (port, site, app) <- getApplicationRepl+ tid <- forkIO (finally (runSettings (setPort port defaultSettings) app)+ -- Note that this implies concurrency+ -- between shutdownApp and the next app that is starting.+ -- Normally this should be fine+ (putMVar done () >> shutdownApp site))+ writeFile "devel-main-since" =<< show <$> getCurrentTime+ return tid+++-- | kill the server+shutdown :: IO ()+shutdown = do+ mtidStore <- lookupStore tidStoreNum+ case mtidStore of+ -- no server running+ Nothing -> putStrLn "no Yesod app running"+ Just tidStore -> do+ withStore tidStore $ readIORef >=> killThread+ putStrLn "Yesod app is shutdown"++tidStoreNum :: Word32+tidStoreNum = 1++modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()+modifyStoredIORef store f = withStore store $ \ref -> do+ v <- readIORef ref+ f v >>= writeIORef ref
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ yesod-fast-devel.cabal view
@@ -0,0 +1,46 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name: yesod-fast-devel+version: 0.1.2.0+synopsis: Fast live-reloading for yesod applications.+description: https://github.com/haskellbr/yesod-fast-devel+license: BSD3+license-file: LICENSE+author: Arne Link, Pedro Tacla Yamada+maintainer: tacla.yamada@gmail.com+category: Development+homepage: https://github.com/haskellbr/yesod-fast-devel#readme+bug-reports: https://github.com/haskellbr/yesod-fast-devel/issues+build-type: Simple+cabal-version: >= 1.10++data-files:+ OriginalDevelMain.hs+ PatchedDevelMain.hs++source-repository head+ type: git+ location: https://github.com/haskellbr/yesod-fast-devel++executable yesod-fast-devel+ default-extensions: OverloadedStrings LambdaCase+ main-is: Main.hs+ build-depends:+ Glob >=0.7+ , ansi-terminal+ , base >=4.7 && <5+ , bytestring >=0.10.6.0+ , directory >=1.2.2.0+ , filepath >=1.4.0.0+ , fsnotify >=0.1.0.0+ , optparse-applicative+ , process >=1.2.0.0+ , pureMD5 >=2.1+ , stm >=2.1.1.0+ , system-filepath+ , temporary >=1.2.0.0+ , text >=1.2.0.0+ default-language: Haskell2010+ ghc-options: -threaded