From cbe7851a70141f28bcfe29a38a949b9acbd9b77a Mon Sep 17 00:00:00 2001 From: Lim Yeonjun Date: Sat, 11 Mar 2017 17:26:16 +0900 Subject: [PATCH] Add watch option --- nirum.cabal | 3 ++ src/Nirum/Cli.hs | 117 +++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 100 insertions(+), 20 deletions(-) diff --git a/nirum.cabal b/nirum.cabal index cda5c86..54e7319 100644 --- a/nirum.cabal +++ b/nirum.cabal @@ -54,6 +54,7 @@ library , directory >=1.2.5 && <1.4 , email-validate >=2.0.0 && <3.0.0 , filepath >=1.4 && <1.5 + , fsnotify >=0.2.1 && <0.3.0 , htoml >=1.0.0.0 && <1.1.0.0 , interpolatedstring-perl6 >=1.0.0 && <1.1.0 , megaparsec >=5 && <5.3 @@ -62,8 +63,10 @@ library , parsec -- only for dealing with htoml's ParserError , semver >=0.3.0 && <1.0 + , stm >=2.4.4.1 , template-haskell >=2.11 && <3 , text >=0.9.1.0 && <1.3 + , unix >=2.7.2.1 , unordered-containers -- only for dealing with htoml's data structures , uri >=0.1 && <1.0 diff --git a/src/Nirum/Cli.hs b/src/Nirum/Cli.hs index 4f27b45..394a59c 100644 --- a/src/Nirum/Cli.hs +++ b/src/Nirum/Cli.hs @@ -8,11 +8,17 @@ import qualified Data.ByteString as B import qualified Data.Map.Strict as M import qualified Data.Set as S import qualified Data.Text as T +import Control.Concurrent (threadDelay) +import Control.Concurrent.STM (atomically, newTVar, readTVar, TVar, writeTVar) +import Control.Monad (forever, when) import Data.Monoid ((<>)) import qualified Options.Applicative as OPT import System.Directory (createDirectoryIfMissing) import System.Exit (die) import System.FilePath (takeDirectory, ()) +import System.FilePath.Posix +import System.FSNotify +import System.IO import Text.InterpolatedString.Perl6 (qq) import Text.Megaparsec (Token) import Text.Megaparsec.Error ( Dec @@ -31,7 +37,6 @@ import Nirum.Package ( PackageError ( ImportError ) , scanModules ) -import Nirum.Package.Metadata (TargetName) import Nirum.Package.ModuleSet ( ImportError ( CircularImportError , MissingImportError , MissingModulePathError @@ -44,6 +49,25 @@ import Nirum.Targets ( BuildError (CompileError, PackageError, TargetNameError) ) import Nirum.Version (versionString) +type TFlag = TVar Bool + +data Opts = Opts { outDirectory :: !String + , targetOption :: !String + , watch :: !Bool + , packageDirectory :: !String + } + +data AppOptions = AppOptions { outputPath :: FilePath + , packagePath :: FilePath + , targetLanguage :: T.Text + , watching :: Bool + , building :: TFlag + , changed :: TFlag + } + +debounceDelay :: Int +debounceDelay = 1 * 1000 * 1000 + parseErrortoPrettyMessage :: ParseError (Token T.Text) Dec -> FilePath -> IO String @@ -113,12 +137,15 @@ importErrorsToPrettyMessage importErrors = targetNamesText :: T.Text targetNamesText = T.intercalate ", " $ S.toAscList targetNames -runCli :: FilePath -> FilePath -> TargetName -> IO () -runCli src outDir target = do +build :: AppOptions -> IO () +build options@AppOptions { packagePath = src + , outputPath = outDir + , targetLanguage = target + } = do result <- buildPackage target src case result of Left (TargetNameError targetName') -> - die [qq|Couldn't find "$targetName'" target. + tryDie options [qq|Couldn't find "$targetName'" target. Available targets: $targetNamesText|] Left (PackageError (ParseError modulePath error')) -> do {- FIXME: find more efficient way to determine filename from @@ -127,19 +154,19 @@ Available targets: $targetNamesText|] case M.lookup modulePath filePaths of Just filePath' -> do m <- parseErrortoPrettyMessage error' filePath' - die m - Nothing -> die [qq|$modulePath not found|] + tryDie options m + Nothing -> tryDie options [qq|$modulePath not found|] Left (PackageError (ImportError importErrors)) -> - die [qq|Import error: + tryDie options [qq|Import error: {importErrorsToPrettyMessage importErrors} |] Left (PackageError (ScanError _ error')) -> - die [qq|Scan error: $error'|] + tryDie options [qq|Scan error: $error'|] Left (PackageError (MetadataError error')) -> - die [qq|Metadata error: $error'|] + tryDie options [qq|Metadata error: $error'|] Left (CompileError errors) -> forM_ (M.toList errors) $ \ (filePath, compileError) -> - die [qq|error: $filePath: $compileError|] + tryDie options [qq|error: $filePath: $compileError|] Right buildResult -> writeFiles outDir buildResult writeFiles :: FilePath -> BuildResult -> IO () @@ -150,18 +177,65 @@ writeFiles outDir files = putStrLn outPath B.writeFile outPath code -data Opts = Opts { outDirectory :: !String - , targetOption :: !String - , packageDirectory :: !String - } -main :: IO () -main = do +onFileChanged :: AppOptions -> Event -> IO () +onFileChanged + options@AppOptions { building = building' + , changed = changed' + } + event + | takeExtension path == ".nrm" = do + atomically $ writeTVar changed' True + buildable <- atomically $ do + b <- readTVar building' + writeTVar building' True + return $ not b + when buildable $ do + threadDelay debounceDelay + reactiveBuild options + | otherwise = return () + where + path :: FilePath + path = eventPath event + +reactiveBuild :: AppOptions -> IO () +reactiveBuild options@AppOptions { building = building', changed = changed' } = do + changed'' <- atomically $ readTVar changed' + when changed'' $ do + atomically $ writeTVar changed' False + build options + atomically $ writeTVar building' False + changedDuringBuild <- atomically $ readTVar changed' + when changedDuringBuild $ reactiveBuild options + +tryDie :: AppOptions -> String -> IO () +tryDie AppOptions { watching = watching' } errorMessage + | watching' = hPutStrLn stderr errorMessage + | otherwise = die errorMessage + +main :: IO() +main = + withManager $ \mgr -> do opts <- OPT.execParser optsParser - let packageDirectoryPath = packageDirectory opts - outDirectoryPath = outDirectory opts - targetName = T.pack $ targetOption opts - runCli packageDirectoryPath outDirectoryPath targetName + building' <- atomically $ newTVar False + changed' <- atomically $ newTVar True + let watch' = watch opts + packagePath' = (packageDirectory opts) + options = AppOptions + (outDirectory opts) + packagePath' + (T.pack $ targetOption opts) + watch' + building' + changed' + + when watch' $ do + _ <- watchDir mgr packagePath' (const True) (onFileChanged options) + return () + reactiveBuild options + -- sleep forever (until interrupted) + when watch' $ do + forever $ threadDelay 1000000 where optsParser :: OPT.ParserInfo Opts optsParser = @@ -184,5 +258,8 @@ main = do OPT.strOption (OPT.long "target" <> OPT.short 't' <> OPT.metavar "TARGET" <> OPT.help "Target language name") <*> + OPT.switch + (OPT.long "watch" <> OPT.short 'w' <> + OPT.help "Watches files for changes and rebuilds") <*> OPT.strArgument (OPT.metavar "DIR" <> OPT.help "Package directory")