Skip to content

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"] 
         }
Clone this wiki locally