no longer need webapp state storage! excellent
This commit is contained in:
parent
8ca2aa1cba
commit
9cf4701a8f
3 changed files with 0 additions and 21 deletions
|
@ -57,7 +57,6 @@ webAppThread assistantdata urlrenderer noannex postfirstrun onstartup = thread $
|
||||||
<*> (pack <$> genRandomToken)
|
<*> (pack <$> genRandomToken)
|
||||||
<*> getreldir
|
<*> getreldir
|
||||||
<*> pure $(embed "static")
|
<*> pure $(embed "static")
|
||||||
<*> newWebAppState
|
|
||||||
<*> pure postfirstrun
|
<*> pure postfirstrun
|
||||||
<*> pure noannex
|
<*> pure noannex
|
||||||
setUrlRenderer urlrenderer $ yesodRender webapp (pack "")
|
setUrlRenderer urlrenderer $ yesodRender webapp (pack "")
|
||||||
|
|
|
@ -17,25 +17,11 @@ import Utility.Yesod
|
||||||
|
|
||||||
import Yesod
|
import Yesod
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Control.Concurrent.STM
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
|
||||||
inFirstRun :: Handler Bool
|
inFirstRun :: Handler Bool
|
||||||
inFirstRun = isNothing . relDir <$> getYesod
|
inFirstRun = isNothing . relDir <$> getYesod
|
||||||
|
|
||||||
newWebAppState :: IO (TMVar WebAppState)
|
|
||||||
newWebAppState = atomically $ newTMVar $ WebAppState { showIntro = True }
|
|
||||||
|
|
||||||
getWebAppState :: forall sub. GHandler sub WebApp WebAppState
|
|
||||||
getWebAppState = liftIO . atomically . readTMVar =<< webAppState <$> getYesod
|
|
||||||
|
|
||||||
modifyWebAppState :: forall sub. (WebAppState -> WebAppState) -> GHandler sub WebApp ()
|
|
||||||
modifyWebAppState a = go =<< webAppState <$> getYesod
|
|
||||||
where
|
|
||||||
go s = liftIO $ atomically $ do
|
|
||||||
v <- takeTMVar s
|
|
||||||
putTMVar s $ a v
|
|
||||||
|
|
||||||
{- Runs an Annex action from the webapp.
|
{- Runs an Annex action from the webapp.
|
||||||
-
|
-
|
||||||
- When the webapp is run outside a git-annex repository, the fallback
|
- When the webapp is run outside a git-annex repository, the fallback
|
||||||
|
|
|
@ -26,7 +26,6 @@ import Yesod
|
||||||
import Yesod.Static
|
import Yesod.Static
|
||||||
import Text.Hamlet
|
import Text.Hamlet
|
||||||
import Data.Text (Text, pack, unpack)
|
import Data.Text (Text, pack, unpack)
|
||||||
import Control.Concurrent.STM
|
|
||||||
|
|
||||||
publicFiles "static"
|
publicFiles "static"
|
||||||
|
|
||||||
|
@ -37,7 +36,6 @@ data WebApp = WebApp
|
||||||
, secretToken :: Text
|
, secretToken :: Text
|
||||||
, relDir :: Maybe FilePath
|
, relDir :: Maybe FilePath
|
||||||
, getStatic :: Static
|
, getStatic :: Static
|
||||||
, webAppState :: TMVar WebAppState
|
|
||||||
, postFirstRun :: Maybe (IO String)
|
, postFirstRun :: Maybe (IO String)
|
||||||
, noAnnex :: Bool
|
, noAnnex :: Bool
|
||||||
}
|
}
|
||||||
|
@ -75,10 +73,6 @@ instance RenderMessage WebApp FormMessage where
|
||||||
|
|
||||||
type Form x = Html -> MForm WebApp WebApp (FormResult x, Widget)
|
type Form x = Html -> MForm WebApp WebApp (FormResult x, Widget)
|
||||||
|
|
||||||
data WebAppState = WebAppState
|
|
||||||
{ showIntro :: Bool -- should the into message be displayed?
|
|
||||||
}
|
|
||||||
|
|
||||||
data RepoSelector = RepoSelector
|
data RepoSelector = RepoSelector
|
||||||
{ onlyCloud :: Bool
|
{ onlyCloud :: Bool
|
||||||
, onlyConfigured :: Bool
|
, onlyConfigured :: Bool
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue