mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 19:44:50 +09:00
Define Vervis monad as a newtype over RWST
This commit is contained in:
parent
a953923a3e
commit
56dddddde6
2 changed files with 25 additions and 0 deletions
|
@ -13,12 +13,15 @@
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
|
||||||
module Vervis
|
module Vervis
|
||||||
( User (..)
|
( User (..)
|
||||||
, Group (..)
|
, Group (..)
|
||||||
, IrcChannel (..)
|
, IrcChannel (..)
|
||||||
, Repository (..)
|
, Repository (..)
|
||||||
, Server (..)
|
, Server (..)
|
||||||
|
, Vervis ()
|
||||||
, subdirs
|
, subdirs
|
||||||
, lastChange
|
, lastChange
|
||||||
, timeAgo
|
, timeAgo
|
||||||
|
@ -27,6 +30,9 @@ module Vervis
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Monad (join)
|
import Control.Monad (join)
|
||||||
|
import Control.Monad.Fix (MonadFix)
|
||||||
|
import Control.Monad.IO.Class (MonadIO)
|
||||||
|
import Control.Monad.Trans.RWS (RWST (..))
|
||||||
import Data.CaseInsensitive (CI)
|
import Data.CaseInsensitive (CI)
|
||||||
import Data.Foldable (toList)
|
import Data.Foldable (toList)
|
||||||
import Data.Git
|
import Data.Git
|
||||||
|
@ -75,6 +81,24 @@ data Server = Server
|
||||||
, serverRepos :: HashMap (Either Int Int) [Repository]
|
, serverRepos :: HashMap (Either Int Int) [Repository]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
data VervisEnv = VervisEnv
|
||||||
|
{
|
||||||
|
}
|
||||||
|
|
||||||
|
data VervisState = VervisState
|
||||||
|
{
|
||||||
|
}
|
||||||
|
|
||||||
|
newtype Vervis a = Vervis { unVervis :: RWST VervisEnv () VervisState IO a }
|
||||||
|
deriving (Functor, Applicative, Monad, MonadFix, MonadIO)
|
||||||
|
|
||||||
|
-- internal func, wrap with API func which hides env and state details
|
||||||
|
runVervis' :: VervisEnv -> VervisState -> Vervis a -> IO (a, VervisState)
|
||||||
|
runVervis' venv vstate computation = do
|
||||||
|
let rwst = unVervis computation
|
||||||
|
(a, s, _) <- runRWST rwst venv vstate
|
||||||
|
return (a, s)
|
||||||
|
|
||||||
subdirs :: FilePath -> IO [FilePath]
|
subdirs :: FilePath -> IO [FilePath]
|
||||||
subdirs dir = do
|
subdirs dir = do
|
||||||
_base :/ tree <- buildL dir
|
_base :/ tree <- buildL dir
|
||||||
|
|
|
@ -36,6 +36,7 @@ library
|
||||||
, hit >=0.6.3
|
, hit >=0.6.3
|
||||||
, hourglass
|
, hourglass
|
||||||
, text >=1
|
, text >=1
|
||||||
|
, transformers >=0.4.2
|
||||||
, unordered-containers >=0.2.5
|
, unordered-containers >=0.2.5
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
Loading…
Reference in a new issue