packages feed

halive 0.1.0.0 → 0.1.0.1

raw patch · 4 files changed

+207/−74 lines, 4 filesdep ~base

Dependency ranges changed: base

Files

+ exec/Banner.hs view
@@ -0,0 +1,11 @@+module Banner where++banner :: String+banner = +    "██╗  ██╗ █████╗ ██╗     ██╗██╗   ██╗███████╗\n\+    \██║  ██║██╔══██╗██║     ██║██║   ██║██╔════╝\n\+    \███████║███████║██║     ██║██║   ██║█████╗  \n\+    \██╔══██║██╔══██║██║     ██║╚██╗ ██╔╝██╔══╝  \n\+    \██║  ██║██║  ██║███████╗██║ ╚████╔╝ ███████╗\n\+    \╚═╝  ╚═╝╚═╝  ╚═╝╚══════╝╚═╝  ╚═══╝  ╚══════╝\n\+    \                  engaged"
+ exec/Halive.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE OverloadedStrings, LambdaCase #-}+module Halive where++import GHC+import Linker+import Packages+import DynFlags+import GHC.Paths+import Outputable+import Data.IORef+import Control.Monad+import Control.Concurrent+import Control.Monad.IO.Class++import System.FSNotify+import System.FilePath+import qualified Filesystem.Path as FSP++import SandboxPath++directoryWatcher :: IO (Chan Event)+directoryWatcher = do+    let predicate event = case event of+            Modified path _ -> FSP.extension path `elem` map Just ["hs", "vert", "frag", "pd"]+            _               -> False+    eventChan <- newChan+    _ <- forkIO $ withManager $ \manager -> do+        -- start a watching job (in the background)+        let watchDirectory = "."+        _stopListening <- watchTreeChan+            manager+            watchDirectory+            predicate+            eventChan+        -- Keep the watcher alive forever+        forever $ threadDelay 10000000++    return eventChan++++recompiler :: FilePath -> [FilePath] -> IO ()+recompiler mainFileName importPaths' = withGHCSession mainFileName importPaths' $ do+    mainThreadId <- liftIO myThreadId++    {-+    Watcher:+        Tell the main thread to recompile.+        If the main thread isn't done yet, kill it.+    Compiler:+        Wait for the signal to recompile.+        Before recompiling & running, mark that we've started,+        and after we're done running, mark that we're done.+    -}++    mainDone  <- liftIO $ newIORef False+    -- Start with a full MVar so we recompile right away.+    recompile <- liftIO $ newMVar ()++    -- Watch for changes and recompile whenever they occur+    watcher <- liftIO directoryWatcher+    _ <- liftIO . forkIO . forever $ do+        _ <- readChan watcher+        putMVar recompile ()+        mainIsDone <- readIORef mainDone+        unless mainIsDone $ killThread mainThreadId+    +    -- Start up the app+    forever $ do+        _ <- liftIO $ takeMVar recompile+        liftIO $ writeIORef mainDone False+        recompileTargets+        liftIO $ writeIORef mainDone True+        +++withGHCSession :: FilePath -> [FilePath] -> Ghc () -> IO ()+withGHCSession mainFileName importPaths' action = do+    defaultErrorHandler defaultFatalMessager defaultFlushOut $ runGhc (Just libdir) $ do+        -- Add the main file's path to the import path list+        let mainFilePath = dropFileName mainFileName+            importPaths'' = mainFilePath:importPaths'++        -- Get the default dynFlags+        dflags0 <- getSessionDynFlags+        +        -- If there's a sandbox, add its package DB+        dflags1 <- liftIO getSandboxDb >>= \case+            Nothing -> return dflags0+            Just sandboxDB -> do+                let pkgs = map PkgConfFile [sandboxDB]+                return dflags0 { extraPkgConfs = (pkgs ++) . extraPkgConfs dflags0 }++        -- Make sure we're configured for live-reload, and turn off the GHCi sandbox+        -- since it breaks OpenGL/GUI usage+        let dflags2 = dflags1 { hscTarget = HscInterpreted+                              , ghcLink   = LinkInMemory+                              , ghcMode   = CompManager+                              , importPaths = importPaths''+                              } `gopt_unset` Opt_GhciSandbox+        +        -- We must set dynflags before calling initPackages or any other GHC API+        _ <- setSessionDynFlags dflags2++        -- Initialize the package database+        (dflags3, _) <- liftIO $ initPackages dflags2++        -- Initialize the dynamic linker+        liftIO $ initDynLinker dflags3 ++        -- Set the given filename as a compilation target+        setTargets =<< sequence [guessTarget mainFileName Nothing]++        action++-- Recompiles the current targets+recompileTargets :: Ghc ()+recompileTargets = handleSourceError printException $ do+    -- Get the dependencies of the main target+    graph <- depanal [] False++    -- Reload the main target+    loadSuccess <- load LoadAllTargets+    unless (failed loadSuccess) $ do+        -- We must parse and typecheck modules before they'll be available for usage+        forM_ graph (typecheckModule <=< parseModule)+        +        -- Load the dependencies of the main target+        setContext $ map (IIModule . ms_mod_name) graph++        -- Run the target file's "main" function+        rr <- runStmt "main" RunToCompletion+        case rr of+            RunOk _ -> liftIO $ putStrLn "OK"+            RunException exception -> liftIO $ print exception+            RunBreak _ _ _ -> liftIO $ putStrLn "Breakpoint"+++-- A helper from interactive-diagrams to print out GHC API values, +-- useful while debugging the API.+-- | Outputs any value that can be pretty-printed using the default style+output :: (GhcMonad m, MonadIO m) => Outputable a => a -> m ()+output a = do+    dfs <- getSessionDynFlags+    let style = defaultUserStyle+    let cntx  = initSDocContext dfs style+    liftIO $ print $ runSDoc (ppr a) cntx
+ exec/SandboxPath.hs view
@@ -0,0 +1,34 @@+module SandboxPath where+import Data.Maybe+import Data.Traversable (traverse)+import Control.Applicative ((<$>))+import System.Directory+import System.FilePath+import Data.List+import Data.Char++-- From ghc-mod+mightExist :: FilePath -> IO (Maybe FilePath)+mightExist f = do+    exists <- doesFileExist f+    return $ if exists then (Just f) else (Nothing)++-- | Get path to sandbox config file+getSandboxDb :: IO (Maybe FilePath)+getSandboxDb = do+    currentDir <- getCurrentDirectory+    config <- traverse readFile =<< mightExist (currentDir </> "cabal.sandbox.config")+    return $ (extractSandboxDbDir =<< config)++-- | Extract the sandbox package db directory from the cabal.sandbox.config file.+--   Exception is thrown if the sandbox config file is broken.+extractSandboxDbDir :: String -> Maybe FilePath+extractSandboxDbDir conf = extractValue <$> parse conf+  where+    key = "package-db:"+    keyLen = length key++    parse = listToMaybe . filter (key `isPrefixOf`) . lines+    extractValue = dropWhileEnd isSpace . dropWhile isSpace . drop keyLen++-- main = print =<< getSandboxDb
halive.cabal view
@@ -2,81 +2,20 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                halive-version:             0.1.0.0+version:             0.1.0.1 synopsis:            A live recompiler description:         -  > ██╗  ██╗ █████╗ ██╗     ██╗██╗   ██╗███████╗-  > ██║  ██║██╔══██╗██║     ██║██║   ██║██╔════╝-  > ███████║███████║██║     ██║██║   ██║█████╗  -  > ██╔══██║██╔══██║██║     ██║╚██╗ ██╔╝██╔══╝  -  > ██║  ██║██║  ██║███████╗██║ ╚████╔╝ ███████╗-  > ╚═╝  ╚═╝╚═╝  ╚═╝╚══════╝╚═╝  ╚═══╝  ╚══════╝-     Live recompiler for Haskell-  -  <<http://lukexi.github.io/HaliveDemo.gif Halive Demo>>-  -  Halive uses the GHC API to instantly recompile-  and reload your code any time you change it.-  -  Usage:-  @cabal install@-  -  and then-  -  @halive \<path\/to\/mymain.hs> \<extra-include-dirs>@-  -  Any time you change a file in the current directory or its-  subdirectories,-  halive will recompile and rerun the @main@ function in the file you gave-  it.-  -  If the program is long-running (e.g. a daemon, GUI or game loop) it will-  be-  killed and restarted. Learn how to maintain state in the next section.-  -  Try a live-coding GL demo by running @halive demo\/Main.hs@ (in the-  source package)-  and changing values in @Main.hs@ and @Green.hs@-  (requires @gl@, @GLFW-b@, @foreign-store@, @linear@, and @random@).-  -  == Keeping values alive-  #keeping-values-alive#-  -  To keep state alive, import @Halive.Utils@ and wrap-  your value in @reacquire@ along with a unique identifier, like:-  -  @win \<- reacquire 0 (setupGLFW \"HotGLFW\" 640 480)@-  -  to only create the resource the first time you run the program, and then-  reuse it on subsequent recompilations.-  -  You can see this in action in @test\/glfw.hs@.-  -  Thanks to Chris Done\'s-  <https://hackage.haskell.org/package/foreign-store @foreign-store@>-  library for enabling this.-  -  == Notes-  #notes#-  -  Creating, updating, and deleting modules in the include path should-  work fine during a Halive session.-  -  Halive also supports Cabal sandboxes;-  if run within a directory containing a cabal.sandbox.config file it will-  use the package database defined therein.-  -  Halive also works nicely with either batch-processing or run-loop type-  programs — if the program finishes, it will be restarted on next save,-  and if it\'s still running, it will be killed and restarted on save.-  -  To kill Halive during run-loop type programs, you may need to hold down-  Ctrl-C-  to get GHC to recognize the double-Control-C-kill sequence.-  -  <http://twitter.com/lukexi \@lukexi>-homepage:            tree.is+  .+  <<http://lukexi.github.io/HaliveDemo.gif>>+  .+  /Usage:/+  .+  > halive path/to/myfile.hs  [optionally any/extra include/dirs ..]+  .+  See <https://github.com/lukexi/halive/blob/master/README.md README>+homepage:            https://github.com/lukexi/halive+bug-reports:         https://github.com/lukexi/halive/issues license:             BSD2 license-file:        LICENSE author:              Luke Iannini@@ -84,7 +23,6 @@ -- copyright:            category:            Development build-type:          Simple--- extra-source-files:   cabal-version:       >=1.10  source-repository head@@ -107,7 +45,10 @@   hs-source-dirs:      exec   default-language:    Haskell2010   ghc-options:         -Wall -threaded -dynamic-  -- other-modules:       +  other-modules:       +    Banner+    Halive+    SandboxPath   -- other-extensions:       build-depends:     base >=4.7 && <4.9,