-
Notifications
You must be signed in to change notification settings - Fork 6
Minimal reproduction.
Njagi Mwaniki edited this page Feb 11, 2016
·
1 revision
This is if you want to experiment with some new wai-devel feature or whatever else you may want.
It doesn't handle rebuilds yet.
{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
module Compile
( runCompile
) where
import IdeSession
import Control.Concurrent (forkIO, threadDelay)
import qualified Data.ByteString.Char8 as BS
-- Reverse proxying.
import Network.HTTP.ReverseProxy (WaiProxyResponse(WPRProxyDest), ProxyDest(ProxyDest), waiProxyTo)
import Network.HTTP.Client (newManager)
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types (status200)
import Control.Exception
import Network.Wai (Application, responseLBS)
import Network.HTTP.Client.Conduit (defaultManagerSettings)
-- Build log
import Data.IORef
-- Hamlet
import Text.Hamlet
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
runCompile :: IO ()
runCompile = do
iStrLst <- newIORef [] :: IO (IORef [String])
sesh <- initialiseSession
_ <- forkIO $ runReverseProxy iStrLst
let upd = updateCodeGeneration True
printer upLst = do
lstt <- readIORef iStrLst
let str = show upLst
newLst = lstt ++ [str]
_ <- putStrLn str
writeIORef iStrLst newLst
_ <- updateSession sesh upd printer
threadDelay 1000000000
errs <- getSourceErrors sesh
mapM_ print errs
ra <- runStmt sesh "Main" "main"
loop ra
where
loop :: RunActions RunResult -> IO ()
loop ra = do
eBS <- runWait ra
case eBS of
Left bs -> BS.putStr bs >> loop ra
Right err -> putStrLn $ "Run result: " ++ show err
runReverseProxy :: IORef [String] -> IO ()
runReverseProxy iStrLst = do
mgr <- newManager defaultManagerSettings
let onException' :: SomeException -> Application
onException' _ _ respond =do
lstt <- readIORef iStrLst
respond $ responseLBS status200
[ ("content-type", "text/html")
, ("Refresh", "1")
]
(renderHtml $(shamletFile "build.hamlet"))
-- proxyApp :: (Request -> ResourceT IO (Either Response ProxyDest)) -> (SomeException -> Application) -> Manager -> Application
proxyApp = waiProxyTo
(\_ -> return $ WPRProxyDest $ ProxyDest "127.0.0.1" 2000)
onException'
mgr
run 3000 proxyApp
-- Where to find packages
-- Replace this with your own paths, expand the tildes with full paths.
initialiseSession :: IO IdeSession
initialiseSession = do
conf <- sessionConfigFromEnv
initSession
defaultSessionInitParams {sessionInitTargets= TargetsInclude ["Main.hs"]}
conf { configExtraPathDirs= ["~/.stack/programs/x86_64-linux/ghc-7.10.3/bin"] -- Where to find ghc?
, configPackageDBStack= [GlobalPackageDB
, UserPackageDB
, SpecificPackageDB "~/src/haskell/site/.stack-work/install/x86_64-linux/lts-5.1/7.10.3/pkgdb"
, SpecificPackageDB "~/.stack/snapshots/x86_64-linux/lts-5.1/7.10.3/pkgdb"
, SpecificPackageDB "~/.stack/programs/x86_64-linux/ghc-7.10.3/lib/ghc-7.10.3/package.conf.d"
, SpecificPackageDB "~/.stack/snapshots/x86_64-linux/lts-5.1/7.10.3/pkgdb"
, SpecificPackageDB "~/src/haskell/site/.stack-work/install/x86_64-linux/lts-5.1/7.10.3/pkgdb"]
}