Add developWith for app reloading with ghcid

Signed-off-by: Jan Hamal Dvořák <mordae@anilinux.org>

hikaru.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 8bbf377869281f273f43485c46ccce646be610521dbf18fa016b0762e07d767f
+-- hash: f2e507d7c6d6469807c9edd22fe9f5628b08203e542661f8e917468fd1f856e8
 
 name:           hikaru
 version:        0.1.0.0
@@ -45,6 +45,7 @@ library
       Hikaru.Route
       Hikaru.Types
   other-modules:
+      Hikaru.Develop
       Paths_hikaru
   hs-source-dirs:
       lib
@@ -59,6 +60,7 @@ library
     , containers >=0.6 && <0.7
     , cookie >=0.4 && <0.5
     , cryptonite >=0.26 && <0.27
+    , foreign-store >=0.2 && <0.3
     , http-types >=0.12 && <0.13
     , lucid >=2.9 && <2.10
     , memory >=0.15 && <0.16
@@ -98,6 +100,7 @@ test-suite spec
     , containers >=0.6 && <0.7
     , cookie >=0.4 && <0.5
     , cryptonite >=0.26 && <0.27
+    , foreign-store >=0.2 && <0.3
     , hikaru
     , hspec
     , http-types >=0.12 && <0.13

lib/Hikaru.hs

@@ -16,6 +16,7 @@ module Hikaru
     module Hikaru.Action
   , module Hikaru.Config
   , module Hikaru.CSRF
+  , module Hikaru.Develop
   , module Hikaru.Dispatch
   , module Hikaru.Form
   , module Hikaru.Link
@@ -28,6 +29,7 @@ where
   import Hikaru.Action
   import Hikaru.Config
   import Hikaru.CSRF
+  import Hikaru.Develop
   import Hikaru.Dispatch
   import Hikaru.Form
   import Hikaru.Link

lib/Hikaru/Develop.hs

+{-|
+Module      :  Hikaru.Develop
+Copyright   :  Jan Hamal Dvořák
+License     :  AGPL-3
+
+Maintainer  :  mordae@anilinux.org
+Stability   :  unstable
+Portability :  non-portable (ghc)
+
+This module provides development and testing utilities.
+-}
+
+module Hikaru.Develop
+  ( developWith
+  )
+where
+  import Relude
+
+  import Control.Concurrent (killThread, forkFinally)
+  import Foreign.Store
+
+
+  -- |
+  -- To be used with @ghcid@ to reload the app when the source changes.
+  --
+  developWith :: IO () -> IO ()
+  developWith main = do
+    store <- mapM readStore =<< lookupStore 1
+    stash <- case store of
+               Nothing -> do
+                 stash <- newEmptyMVar
+                 writeStore (Store 1) stash
+                 return stash
+
+               Just stash -> do
+                 return stash
+
+    tryTakeMVar stash >>= \case
+      Nothing          -> return ()
+      Just (lock, tid) -> killThread tid >> takeMVar lock
+
+    lock' <- newEmptyMVar
+    tid'  <- forkFinally main $ const $ putMVar lock' ()
+    putMVar stash (lock', tid')
+
+
+-- vim:set ft=haskell sw=2 ts=2 et:

package.yaml

@@ -52,6 +52,7 @@ dependencies:
   - containers         >= 0.6  && <0.7
   - cookie             >= 0.4  && <0.5
   - cryptonite         >= 0.26 && <0.27
+  - foreign-store      >= 0.2  && <0.3
   - http-types         >= 0.12 && <0.13
   - lucid              >= 2.9  && <2.10
   - memory             >= 0.15 && <0.16