ebook-manager/src/Devel/Main.hs

62 lines
1.7 KiB
Haskell
Raw Normal View History

2018-08-04 23:43:26 +03:00
{-# Language TypeApplications #-}
{-# Language DataKinds #-}
{-# Language FlexibleContexts #-}
2018-08-02 21:39:08 +03:00
module Devel.Main where
2018-08-03 23:36:38 +03:00
import Prelude
import Control.Monad.Trans.Reader (runReaderT)
import Main (withApp, defaultMain)
2018-08-02 21:39:08 +03:00
import Control.Concurrent
import Control.Monad (void)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Foreign.Store (Store(..), lookupStore, readStore, storeAction, withStore)
import GHC.Word (Word32)
2018-08-02 23:07:05 +03:00
import Dhall (input, auto)
2018-08-02 21:39:08 +03:00
2018-08-03 23:36:38 +03:00
import Database.Schema
import Database.Selda (tryCreateTable)
import Database
2018-08-02 21:39:08 +03:00
update :: IO ()
update = do
lookupStore tidStoreNum >>= maybe setupNew restart
where
doneStore :: Store (MVar ())
doneStore = Store 0
setupNew :: IO ()
setupNew = do
done <- storeAction doneStore newEmptyMVar
tid <- start done
void $ storeAction (Store tidStoreNum) (newIORef tid)
restart tidStore = modifyStoredIORef tidStore $ \tid -> do
killThread tid
withStore doneStore takeMVar
readStore doneStore >>= start
start :: MVar () -> IO ThreadId
2018-08-03 23:36:38 +03:00
start done = forkFinally develMain (\_ -> putMVar done ())
develMain :: IO ()
develMain = do
conf <- input auto "./config/devel.dhall"
withApp conf $ \app -> do
void $ runReaderT (runDB migrate) app
defaultMain app
where
migrate = do
tryCreateTable (gen users)
2018-08-04 21:30:08 +03:00
tryCreateTable (gen books)
tryCreateTable (gen userBooks)
tryCreateTable (gen tags)
tryCreateTable (gen channels)
tryCreateTable (gen bookTags)
tryCreateTable (gen bookChannels)
2018-08-02 21:39:08 +03:00
modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
modifyStoredIORef store f = withStore store $ \ref -> do
v <- readIORef ref
f v >>= writeIORef ref
tidStoreNum :: Word32
tidStoreNum = 1
2018-08-04 23:43:26 +03:00