From d84b462a711ce95593ff05a7581e722562c3835a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 14 Mar 2017 01:06:28 +0100
Subject: Implement old bar.hs

---
 app/DevelMain.hs | 99 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 app/devel.hs     |  6 ++++
 app/main.hs      |  5 +++
 3 files changed, 110 insertions(+)
 create mode 100644 app/DevelMain.hs
 create mode 100644 app/devel.hs
 create mode 100644 app/main.hs

(limited to 'app')

diff --git a/app/DevelMain.hs b/app/DevelMain.hs
new file mode 100644
index 0000000..b327943
--- /dev/null
+++ b/app/DevelMain.hs
@@ -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
diff --git a/app/devel.hs b/app/devel.hs
new file mode 100644
index 0000000..979103f
--- /dev/null
+++ b/app/devel.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE PackageImports #-}
+import "bar" Application (develMain)
+import Prelude (IO)
+
+main :: IO ()
+main = develMain
diff --git a/app/main.hs b/app/main.hs
new file mode 100644
index 0000000..4ffa93d
--- /dev/null
+++ b/app/main.hs
@@ -0,0 +1,5 @@
+import Prelude     (IO)
+import Application (appMain)
+
+main :: IO ()
+main = appMain
-- 
cgit v1.2.3