1
0
Fork 0
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:
fr33domlover 2016-01-31 05:58:50 +00:00
parent a953923a3e
commit 56dddddde6
2 changed files with 25 additions and 0 deletions

View file

@ -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

View file

@ -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