Split code into submodules
This commit is contained in:
fr33domlover
parent
547db845be
commit
e6fbca1c2a
6 changed files with 572 additions and 400 deletions
401
src/Vervis.hs
401
src/Vervis.hs
|
|
@ -13,406 +13,7 @@
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
|
||||||
|
|
||||||
module Vervis
|
module Vervis
|
||||||
( UserID (..)
|
(
|
||||||
, GroupID (..)
|
|
||||||
, RepoID (..)
|
|
||||||
, ProjID (..)
|
|
||||||
, Username (..)
|
|
||||||
, PasswordHash (..)
|
|
||||||
, RealName (..)
|
|
||||||
, EmailAddress (..)
|
|
||||||
, GroupName (..)
|
|
||||||
, RepoName (..)
|
|
||||||
, ProjectName (..)
|
|
||||||
, User (..)
|
|
||||||
, Group (..)
|
|
||||||
, IrcChannel (..)
|
|
||||||
, Repository (..)
|
|
||||||
, Project (..)
|
|
||||||
, Vervis ()
|
|
||||||
, runVervis
|
|
||||||
, saveState
|
|
||||||
, createUser
|
|
||||||
, Server (..)--TODO remove this type later...
|
|
||||||
, subdirs
|
|
||||||
, lastChange
|
|
||||||
, timeAgo
|
|
||||||
, timesAgo
|
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Monad (join)
|
|
||||||
import Control.Monad.Fix (MonadFix)
|
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Control.Monad.Trans.RWS (RWST (..))
|
|
||||||
import Data.Aeson
|
|
||||||
import Data.CaseInsensitive (CI)
|
|
||||||
import Data.Foldable (toList)
|
|
||||||
import Data.Git
|
|
||||||
import Data.Git.Revision
|
|
||||||
import Data.Git.Repository
|
|
||||||
import Data.Hashable (Hashable)
|
|
||||||
import Data.HashMap.Lazy (HashMap)
|
|
||||||
import Data.HashSet (HashSet)
|
|
||||||
import Data.Hourglass
|
|
||||||
import Data.JsonState
|
|
||||||
import Data.Maybe (fromMaybe, mapMaybe)
|
|
||||||
import Data.Text (Text)
|
|
||||||
import Data.Time.Units
|
|
||||||
import GHC.Generics
|
|
||||||
import System.Directory.Tree hiding (name, file, err)
|
|
||||||
import System.FilePath ((</>))
|
|
||||||
import System.Hourglass (dateCurrent)
|
|
||||||
|
|
||||||
import qualified Control.Monad.Trans.RWS as RWS
|
|
||||||
import qualified Data.CaseInsensitive as CI
|
|
||||||
import qualified Data.HashMap.Lazy as M
|
|
||||||
import qualified Data.Text as T
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- Types
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
newtype UserID = UserID { unUserID :: Int }
|
|
||||||
deriving (Eq, Hashable, FromJSON, ToJSON, WrappedText)
|
|
||||||
|
|
||||||
newtype GroupID = GroupID { unGroupID :: Int }
|
|
||||||
deriving (Eq, Hashable, FromJSON, ToJSON, WrappedText)
|
|
||||||
|
|
||||||
newtype RepoID = RepoID { unRepoID :: Int } deriving (Eq, Hashable, WrappedText)
|
|
||||||
|
|
||||||
newtype ProjID = ProjID { unProjID :: Int }
|
|
||||||
deriving (Eq, Hashable, FromJSON, ToJSON, WrappedText)
|
|
||||||
|
|
||||||
newtype Username = Username { unUsername :: CI Text }
|
|
||||||
deriving (FromJSON, ToJSON)
|
|
||||||
|
|
||||||
newtype PasswordHash = PasswordHash { unPasswordHash :: Text }
|
|
||||||
deriving (FromJSON, ToJSON)
|
|
||||||
|
|
||||||
newtype RealName = RealName { unRealName :: Text } deriving (FromJSON, ToJSON)
|
|
||||||
|
|
||||||
data EmailAddress = EmailAddress
|
|
||||||
{ emailUser :: Text
|
|
||||||
, emailHost :: Text
|
|
||||||
}
|
|
||||||
deriving Generic
|
|
||||||
|
|
||||||
instance FromJSON EmailAddress
|
|
||||||
instance ToJSON EmailAddress
|
|
||||||
|
|
||||||
newtype GroupName = GroupName { unGroupName :: CI Text }
|
|
||||||
deriving (FromJSON, ToJSON)
|
|
||||||
|
|
||||||
newtype RepoName = RepoName { unRepoName :: CI Text }
|
|
||||||
deriving (FromJSON, ToJSON, WrappedText)
|
|
||||||
|
|
||||||
newtype ProjectName = ProjectName { unProjectName :: CI Text }
|
|
||||||
deriving (FromJSON, ToJSON, WrappedText)
|
|
||||||
|
|
||||||
data User = User
|
|
||||||
{ userName :: Username
|
|
||||||
, userPassHash :: Maybe PasswordHash -- to disable pass and use SSH only?
|
|
||||||
, userRealName :: RealName
|
|
||||||
, userEmail :: EmailAddress
|
|
||||||
}
|
|
||||||
deriving Generic
|
|
||||||
|
|
||||||
instance FromJSON User
|
|
||||||
instance ToJSON User
|
|
||||||
|
|
||||||
data Group = Group
|
|
||||||
{ groupName :: GroupName
|
|
||||||
, groupUsers :: HashSet UserID
|
|
||||||
}
|
|
||||||
deriving Generic
|
|
||||||
|
|
||||||
instance FromJSON Group
|
|
||||||
instance ToJSON Group
|
|
||||||
|
|
||||||
data IrcChannel = IrcChannel
|
|
||||||
{ chanNetwork :: Text
|
|
||||||
, chanName :: Text
|
|
||||||
}
|
|
||||||
deriving Generic
|
|
||||||
|
|
||||||
instance FromJSON IrcChannel
|
|
||||||
instance ToJSON IrcChannel
|
|
||||||
|
|
||||||
data Repository = Repository
|
|
||||||
{ repoName :: RepoName
|
|
||||||
, repoIRC :: Maybe IrcChannel
|
|
||||||
, repoML :: Maybe Text
|
|
||||||
}
|
|
||||||
deriving Generic
|
|
||||||
|
|
||||||
instance ToJSON Repository
|
|
||||||
instance FromJSON Repository
|
|
||||||
|
|
||||||
data Project = Project
|
|
||||||
{ projName :: ProjectName
|
|
||||||
, projRepos :: HashMap RepoID Repository
|
|
||||||
}
|
|
||||||
deriving Generic
|
|
||||||
|
|
||||||
instance ToJSON Project
|
|
||||||
instance FromJSON Project
|
|
||||||
|
|
||||||
data VervisEnv = VervisEnv
|
|
||||||
{ veName :: Text
|
|
||||||
, veDir :: FilePath
|
|
||||||
, veSave :: VervisState -> Vervis ()
|
|
||||||
}
|
|
||||||
|
|
||||||
data VervisState = VervisState
|
|
||||||
{ vsUsers :: HashMap UserID User
|
|
||||||
, vsGroups :: HashMap GroupID Group
|
|
||||||
, vsProjects :: HashMap (Either UserID GroupID) (HashMap ProjID Project)
|
|
||||||
, vsNextUser :: UserID
|
|
||||||
, vsNextGroup :: GroupID
|
|
||||||
, vsNextProject :: ProjID
|
|
||||||
}
|
|
||||||
deriving Generic
|
|
||||||
|
|
||||||
instance ToJSON VervisState
|
|
||||||
instance FromJSON VervisState
|
|
||||||
|
|
||||||
newtype Vervis a = Vervis { unVervis :: RWST VervisEnv () VervisState IO a }
|
|
||||||
deriving (Functor, Applicative, Monad, MonadFix, MonadIO)
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- Instances
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
instance (CI.FoldCase a, FromJSON a) => FromJSON (CI a) where
|
|
||||||
parseJSON v = CI.mk <$> parseJSON v
|
|
||||||
|
|
||||||
instance ToJSON a => ToJSON (CI a) where
|
|
||||||
toJSON = toJSON . CI.original
|
|
||||||
|
|
||||||
class WrappedText a where
|
|
||||||
toText :: a -> Text
|
|
||||||
fromText :: Text -> a
|
|
||||||
|
|
||||||
instance WrappedText Text where
|
|
||||||
toText = id
|
|
||||||
fromText = id
|
|
||||||
|
|
||||||
instance (WrappedText a, CI.FoldCase a) => WrappedText (CI a) where
|
|
||||||
toText = toText . CI.original
|
|
||||||
fromText = CI.mk . fromText
|
|
||||||
|
|
||||||
instance WrappedText Int where
|
|
||||||
toText = T.pack . show
|
|
||||||
fromText = read . T.unpack
|
|
||||||
|
|
||||||
mapFst :: (a -> c) -> [(a, b)] -> [(c, b)]
|
|
||||||
mapFst f = map $ \ (x, y) -> (f x, y)
|
|
||||||
|
|
||||||
instance (Eq k, Hashable k, WrappedText k, FromJSON v) => FromJSON (HashMap k v) where
|
|
||||||
parseJSON v = M.fromList . mapFst fromText . M.toList <$> parseJSON v
|
|
||||||
|
|
||||||
instance (WrappedText k, ToJSON v) => ToJSON (HashMap k v) where
|
|
||||||
toJSON = toJSON . M.fromList . mapFst toText . M.toList
|
|
||||||
|
|
||||||
instance (WrappedText a, WrappedText b) => WrappedText (Either a b) where
|
|
||||||
toText (Left x) = 'l' `T.cons` toText x
|
|
||||||
toText (Right y) = 'r' `T.cons` toText y
|
|
||||||
fromText t =
|
|
||||||
case T.uncons t of
|
|
||||||
Nothing -> error "blank JSON field name???"
|
|
||||||
Just ('l', r) -> Left $ fromText r
|
|
||||||
Just ('r', r) -> Right $ fromText r
|
|
||||||
_ -> error "what is dis ting"
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- Monad
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
-- | Fetch the value of the environment.
|
|
||||||
ask :: Vervis (VervisEnv)
|
|
||||||
ask = Vervis RWS.ask
|
|
||||||
|
|
||||||
-- | Retrieve a function of the current environment.
|
|
||||||
asks :: (VervisEnv -> a) -> Vervis a
|
|
||||||
asks = Vervis . RWS.asks
|
|
||||||
|
|
||||||
-- | Fetch the current value of the state within the monad.
|
|
||||||
get :: Vervis (VervisState)
|
|
||||||
get = Vervis RWS.get
|
|
||||||
|
|
||||||
-- | Get a specific component of the state, using a projection function
|
|
||||||
-- supplied.
|
|
||||||
gets :: (VervisState -> a) -> Vervis a
|
|
||||||
gets = Vervis . RWS.gets
|
|
||||||
|
|
||||||
-- | @'put' s@ sets the state within the monad to @s@.
|
|
||||||
put :: VervisState -> Vervis ()
|
|
||||||
put = Vervis . RWS.put
|
|
||||||
|
|
||||||
-- | @'modify' f@ is an action that updates the state to the result of
|
|
||||||
-- applying @f@ to the current state.
|
|
||||||
modify :: (VervisState -> VervisState) -> Vervis ()
|
|
||||||
modify = Vervis . RWS.modify
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- Operations
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
-- 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)
|
|
||||||
|
|
||||||
-- | Run a Vervis server computation.
|
|
||||||
runVervis
|
|
||||||
:: Text -- ^ Server name, e.g. @hub.vervis.org@
|
|
||||||
-> FilePath -- ^ Path of database file, which is really JSON currently
|
|
||||||
-> FilePath -- ^ Path to the directory containing the namespace/repo tree
|
|
||||||
-> Vervis a -- ^ Computation to run
|
|
||||||
-> IO a
|
|
||||||
runVervis name file dir comp = do
|
|
||||||
result <- loadState file
|
|
||||||
case result of
|
|
||||||
Left (False, err) -> error $ "Loading JSON state failed: " ++ err
|
|
||||||
Left (True, err) -> error $ "Parsing JSON state failed: " ++ err
|
|
||||||
Right vstate -> do
|
|
||||||
save <- mkSaveState (3 :: Second) file
|
|
||||||
let venv = VervisEnv
|
|
||||||
{ veName = name
|
|
||||||
, veDir = dir
|
|
||||||
, veSave = liftIO . save
|
|
||||||
}
|
|
||||||
(a, _s) <- runVervis' venv vstate comp
|
|
||||||
return a
|
|
||||||
|
|
||||||
saveState :: Vervis ()
|
|
||||||
saveState = do
|
|
||||||
save <- asks veSave
|
|
||||||
vstate <- get
|
|
||||||
save vstate
|
|
||||||
|
|
||||||
createUser :: User -> Vervis ()
|
|
||||||
createUser user = do
|
|
||||||
vstate <- get
|
|
||||||
let users = vsUsers vstate
|
|
||||||
next = vsNextUser vstate
|
|
||||||
users' = M.insert next user users
|
|
||||||
next' = UserID $ unUserID next + 1
|
|
||||||
put vstate { vsUsers = users', vsNextUser = next' }
|
|
||||||
saveState
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- Git Utils
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
data Server = Server
|
|
||||||
{ serverName :: Text
|
|
||||||
, serverDir :: FilePath
|
|
||||||
, serverUsers :: HashMap Int User
|
|
||||||
, serverGroups :: HashMap Int Group
|
|
||||||
, serverRepos :: HashMap (Either Int Int) [Repository]
|
|
||||||
}
|
|
||||||
|
|
||||||
subdirs :: FilePath -> IO [FilePath]
|
|
||||||
subdirs dir = do
|
|
||||||
_base :/ tree <- buildL dir
|
|
||||||
return $ case tree of
|
|
||||||
Dir _ cs ->
|
|
||||||
let dirName (Dir n _) = Just n
|
|
||||||
dirName _ = Nothing
|
|
||||||
in mapMaybe dirName cs
|
|
||||||
_ -> []
|
|
||||||
|
|
||||||
lastBranchChange :: Git -> String -> IO GitTime
|
|
||||||
lastBranchChange git branch = do
|
|
||||||
mref <- resolveRevision git $ Revision branch []
|
|
||||||
mco <- traverse (getCommitMaybe git) mref
|
|
||||||
let mtime = fmap (personTime . commitCommitter) (join mco)
|
|
||||||
return $ fromMaybe (error "mtime is Nothing") mtime
|
|
||||||
|
|
||||||
lastChange :: FilePath -> IO DateTime
|
|
||||||
lastChange path = withRepo (fromString path) $ \ git -> do
|
|
||||||
--TODO add a better intro to json-state, the docs are bad there
|
|
||||||
|
|
||||||
names <- branchList git
|
|
||||||
times <- traverse (lastBranchChange git) $ map refNameRaw $ toList names
|
|
||||||
let datetimes = map timeConvert times
|
|
||||||
return $ maximum datetimes
|
|
||||||
|
|
||||||
showPeriod :: Period -> String
|
|
||||||
showPeriod (Period 0 0 d) = show d ++ " days"
|
|
||||||
showPeriod (Period 0 m _) = show m ++ " months"
|
|
||||||
showPeriod (Period y _ _) = show y ++ " years"
|
|
||||||
|
|
||||||
showDuration :: Duration -> String
|
|
||||||
showDuration (Duration (Hours h) (Minutes m) (Seconds s) _) =
|
|
||||||
case (h, m, s) of
|
|
||||||
(0, 0, 0) -> "now"
|
|
||||||
(0, 0, _) -> show s ++ " seconds"
|
|
||||||
(0, _, _) -> show m ++ " minutes"
|
|
||||||
_ -> show h ++ " hours"
|
|
||||||
|
|
||||||
showAgo :: Period -> Duration -> String
|
|
||||||
showAgo (Period 0 0 0) d = showDuration d
|
|
||||||
showAgo p _ = showPeriod p
|
|
||||||
|
|
||||||
fromSec :: Seconds -> (Period, Duration)
|
|
||||||
fromSec sec =
|
|
||||||
let d = 3600 * 24
|
|
||||||
m = 30 * d
|
|
||||||
y = 365 * d
|
|
||||||
fs (Seconds n) = fromIntegral n
|
|
||||||
(years, yrest) = sec `divMod` Seconds y
|
|
||||||
(months, mrest) = yrest `divMod` Seconds m
|
|
||||||
(days, drest) = mrest `divMod` Seconds d
|
|
||||||
in (Period (fs years) (fs months) (fs days), fst $ fromSeconds drest)
|
|
||||||
|
|
||||||
timeAgo :: DateTime -> IO String
|
|
||||||
timeAgo dt = do
|
|
||||||
now <- dateCurrent
|
|
||||||
let sec = timeDiff now dt
|
|
||||||
(period, duration) = fromSec sec
|
|
||||||
return $ showAgo period duration
|
|
||||||
|
|
||||||
repoPaths :: Server -> Either Int Int -> [Repository] -> [FilePath]
|
|
||||||
repoPaths server (Left uid) repos =
|
|
||||||
case M.lookup uid $ serverUsers server of
|
|
||||||
Nothing -> error "';..;'"
|
|
||||||
Just user ->
|
|
||||||
let dir = serverDir server
|
|
||||||
ns = T.unpack $ CI.original $ unUsername $ userName user
|
|
||||||
prefix = dir </> ns
|
|
||||||
repoNames =
|
|
||||||
map (T.unpack . CI.original . unRepoName . repoName) repos
|
|
||||||
in map (prefix </>) repoNames
|
|
||||||
repoPaths server (Right gid) repos =
|
|
||||||
case M.lookup gid $ serverGroups server of
|
|
||||||
Nothing -> error "';..;'"
|
|
||||||
Just group ->
|
|
||||||
let dir = serverDir server
|
|
||||||
ns = T.unpack $ CI.original $ unGroupName $ groupName group
|
|
||||||
prefix = dir </> ns
|
|
||||||
repoNames =
|
|
||||||
map (T.unpack . CI.original . unRepoName . repoName) repos
|
|
||||||
in map (prefix </>) repoNames
|
|
||||||
|
|
||||||
timesAgo :: Server -> IO [(Text, Text)]
|
|
||||||
timesAgo server = do
|
|
||||||
-- make list of file paths
|
|
||||||
let paths = uncurry $ repoPaths server
|
|
||||||
nsRepos = map paths $ M.toList $ serverRepos server
|
|
||||||
repos = concat nsRepos
|
|
||||||
-- run lastChange on each
|
|
||||||
times <- traverse lastChange repos
|
|
||||||
-- run timeAgo on each result
|
|
||||||
agos <- traverse timeAgo times
|
|
||||||
-- return
|
|
||||||
return $ zip (map T.pack repos) (map T.pack agos)
|
|
||||||
|
|
|
||||||
160
src/Vervis/Git.hs
Normal file
160
src/Vervis/Git.hs
Normal file
|
|
@ -0,0 +1,160 @@
|
||||||
|
{- This file is part of Vervis.
|
||||||
|
-
|
||||||
|
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
|
-
|
||||||
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
|
-
|
||||||
|
- The author(s) have dedicated all copyright and related and neighboring
|
||||||
|
- rights to this software to the public domain worldwide. This software is
|
||||||
|
- distributed without any warranty.
|
||||||
|
-
|
||||||
|
- You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
|
- with this software. If not, see
|
||||||
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
|
||||||
|
module Vervis.Git
|
||||||
|
( Server (..)--TODO remove this type later...
|
||||||
|
, subdirs
|
||||||
|
, lastChange
|
||||||
|
, timeAgo
|
||||||
|
, timesAgo
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Monad (join)
|
||||||
|
import Control.Monad.Fix (MonadFix)
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import Control.Monad.Trans.RWS (RWST (..))
|
||||||
|
import Data.Aeson
|
||||||
|
import Data.CaseInsensitive (CI)
|
||||||
|
import Data.Foldable (toList)
|
||||||
|
import Data.Git
|
||||||
|
import Data.Git.Revision
|
||||||
|
import Data.Git.Repository
|
||||||
|
import Data.Hashable (Hashable)
|
||||||
|
import Data.HashMap.Lazy (HashMap)
|
||||||
|
import Data.HashSet (HashSet)
|
||||||
|
import Data.Hourglass
|
||||||
|
import Data.JsonState
|
||||||
|
import Data.Maybe (fromMaybe, mapMaybe)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Time.Units
|
||||||
|
import GHC.Generics
|
||||||
|
import System.Directory.Tree hiding (name, file, err)
|
||||||
|
import System.FilePath ((</>))
|
||||||
|
import System.Hourglass (dateCurrent)
|
||||||
|
import Vervis.Types
|
||||||
|
|
||||||
|
import qualified Control.Monad.Trans.RWS as RWS
|
||||||
|
import qualified Data.CaseInsensitive as CI
|
||||||
|
import qualified Data.HashMap.Lazy as M
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
data Server = Server
|
||||||
|
{ serverName :: Text
|
||||||
|
, serverDir :: FilePath
|
||||||
|
, serverUsers :: HashMap Int User
|
||||||
|
, serverGroups :: HashMap Int Group
|
||||||
|
, serverRepos :: HashMap (Either Int Int) [Repository]
|
||||||
|
}
|
||||||
|
|
||||||
|
subdirs :: FilePath -> IO [FilePath]
|
||||||
|
subdirs dir = do
|
||||||
|
_base :/ tree <- buildL dir
|
||||||
|
return $ case tree of
|
||||||
|
Dir _ cs ->
|
||||||
|
let dirName (Dir n _) = Just n
|
||||||
|
dirName _ = Nothing
|
||||||
|
in mapMaybe dirName cs
|
||||||
|
_ -> []
|
||||||
|
|
||||||
|
lastBranchChange :: Git -> String -> IO GitTime
|
||||||
|
lastBranchChange git branch = do
|
||||||
|
mref <- resolveRevision git $ Revision branch []
|
||||||
|
mco <- traverse (getCommitMaybe git) mref
|
||||||
|
let mtime = fmap (personTime . commitCommitter) (join mco)
|
||||||
|
return $ fromMaybe (error "mtime is Nothing") mtime
|
||||||
|
|
||||||
|
lastChange :: FilePath -> IO DateTime
|
||||||
|
lastChange path = withRepo (fromString path) $ \ git -> do
|
||||||
|
--TODO add a better intro to json-state, the docs are bad there
|
||||||
|
|
||||||
|
names <- branchList git
|
||||||
|
times <- traverse (lastBranchChange git) $ map refNameRaw $ toList names
|
||||||
|
let datetimes = map timeConvert times
|
||||||
|
return $ maximum datetimes
|
||||||
|
|
||||||
|
showPeriod :: Period -> String
|
||||||
|
showPeriod (Period 0 0 d) = show d ++ " days"
|
||||||
|
showPeriod (Period 0 m _) = show m ++ " months"
|
||||||
|
showPeriod (Period y _ _) = show y ++ " years"
|
||||||
|
|
||||||
|
showDuration :: Duration -> String
|
||||||
|
showDuration (Duration (Hours h) (Minutes m) (Seconds s) _) =
|
||||||
|
case (h, m, s) of
|
||||||
|
(0, 0, 0) -> "now"
|
||||||
|
(0, 0, _) -> show s ++ " seconds"
|
||||||
|
(0, _, _) -> show m ++ " minutes"
|
||||||
|
_ -> show h ++ " hours"
|
||||||
|
|
||||||
|
showAgo :: Period -> Duration -> String
|
||||||
|
showAgo (Period 0 0 0) d = showDuration d
|
||||||
|
showAgo p _ = showPeriod p
|
||||||
|
|
||||||
|
fromSec :: Seconds -> (Period, Duration)
|
||||||
|
fromSec sec =
|
||||||
|
let d = 3600 * 24
|
||||||
|
m = 30 * d
|
||||||
|
y = 365 * d
|
||||||
|
fs (Seconds n) = fromIntegral n
|
||||||
|
(years, yrest) = sec `divMod` Seconds y
|
||||||
|
(months, mrest) = yrest `divMod` Seconds m
|
||||||
|
(days, drest) = mrest `divMod` Seconds d
|
||||||
|
in (Period (fs years) (fs months) (fs days), fst $ fromSeconds drest)
|
||||||
|
|
||||||
|
timeAgo :: DateTime -> IO String
|
||||||
|
timeAgo dt = do
|
||||||
|
now <- dateCurrent
|
||||||
|
let sec = timeDiff now dt
|
||||||
|
(period, duration) = fromSec sec
|
||||||
|
return $ showAgo period duration
|
||||||
|
|
||||||
|
repoPaths :: Server -> Either Int Int -> [Repository] -> [FilePath]
|
||||||
|
repoPaths server (Left uid) repos =
|
||||||
|
case M.lookup uid $ serverUsers server of
|
||||||
|
Nothing -> error "';..;'"
|
||||||
|
Just user ->
|
||||||
|
let dir = serverDir server
|
||||||
|
ns = T.unpack $ CI.original $ unUsername $ userName user
|
||||||
|
prefix = dir </> ns
|
||||||
|
repoNames =
|
||||||
|
map (T.unpack . CI.original . unRepoName . repoName) repos
|
||||||
|
in map (prefix </>) repoNames
|
||||||
|
repoPaths server (Right gid) repos =
|
||||||
|
case M.lookup gid $ serverGroups server of
|
||||||
|
Nothing -> error "';..;'"
|
||||||
|
Just group ->
|
||||||
|
let dir = serverDir server
|
||||||
|
ns = T.unpack $ CI.original $ unGroupName $ groupName group
|
||||||
|
prefix = dir </> ns
|
||||||
|
repoNames =
|
||||||
|
map (T.unpack . CI.original . unRepoName . repoName) repos
|
||||||
|
in map (prefix </>) repoNames
|
||||||
|
|
||||||
|
timesAgo :: Server -> IO [(Text, Text)]
|
||||||
|
timesAgo server = do
|
||||||
|
-- make list of file paths
|
||||||
|
let paths = uncurry $ repoPaths server
|
||||||
|
nsRepos = map paths $ M.toList $ serverRepos server
|
||||||
|
repos = concat nsRepos
|
||||||
|
-- run lastChange on each
|
||||||
|
times <- traverse lastChange repos
|
||||||
|
-- run timeAgo on each result
|
||||||
|
agos <- traverse timeAgo times
|
||||||
|
-- return
|
||||||
|
return $ zip (map T.pack repos) (map T.pack agos)
|
||||||
138
src/Vervis/Monad.hs
Normal file
138
src/Vervis/Monad.hs
Normal file
|
|
@ -0,0 +1,138 @@
|
||||||
|
{- This file is part of Vervis.
|
||||||
|
-
|
||||||
|
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
|
-
|
||||||
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
|
-
|
||||||
|
- The author(s) have dedicated all copyright and related and neighboring
|
||||||
|
- rights to this software to the public domain worldwide. This software is
|
||||||
|
- distributed without any warranty.
|
||||||
|
-
|
||||||
|
- You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
|
- with this software. If not, see
|
||||||
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
|
||||||
|
module Vervis.Monad
|
||||||
|
( VervisEnv (..)
|
||||||
|
, VervisState (..)
|
||||||
|
, Vervis ()
|
||||||
|
, runVervis
|
||||||
|
, ask
|
||||||
|
, asks
|
||||||
|
, get
|
||||||
|
, gets
|
||||||
|
, put
|
||||||
|
, modify
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Monad (join)
|
||||||
|
import Control.Monad.Fix (MonadFix)
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import Control.Monad.Trans.RWS (RWST (..))
|
||||||
|
import Data.Aeson
|
||||||
|
import Data.CaseInsensitive (CI)
|
||||||
|
import Data.Foldable (toList)
|
||||||
|
import Data.Git
|
||||||
|
import Data.Git.Revision
|
||||||
|
import Data.Git.Repository
|
||||||
|
import Data.Hashable (Hashable)
|
||||||
|
import Data.HashMap.Lazy (HashMap)
|
||||||
|
import Data.HashSet (HashSet)
|
||||||
|
import Data.Hourglass
|
||||||
|
import Data.JsonState
|
||||||
|
import Data.Maybe (fromMaybe, mapMaybe)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Time.Units
|
||||||
|
import GHC.Generics
|
||||||
|
import System.Directory.Tree hiding (name, file, err)
|
||||||
|
import System.FilePath ((</>))
|
||||||
|
import System.Hourglass (dateCurrent)
|
||||||
|
import Vervis.Types
|
||||||
|
|
||||||
|
import qualified Control.Monad.Trans.RWS as RWS
|
||||||
|
import qualified Data.CaseInsensitive as CI
|
||||||
|
import qualified Data.HashMap.Lazy as M
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
data VervisEnv = VervisEnv
|
||||||
|
{ veName :: Text
|
||||||
|
, veDir :: FilePath
|
||||||
|
, veSave :: VervisState -> Vervis ()
|
||||||
|
}
|
||||||
|
|
||||||
|
data VervisState = VervisState
|
||||||
|
{ vsUsers :: HashMap UserID User
|
||||||
|
, vsGroups :: HashMap GroupID Group
|
||||||
|
, vsProjects :: HashMap (Either UserID GroupID) (HashMap ProjID Project)
|
||||||
|
, vsNextUser :: UserID
|
||||||
|
, vsNextGroup :: GroupID
|
||||||
|
, vsNextProject :: ProjID
|
||||||
|
}
|
||||||
|
deriving Generic
|
||||||
|
|
||||||
|
instance ToJSON VervisState
|
||||||
|
instance FromJSON 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)
|
||||||
|
|
||||||
|
-- | Run a Vervis server computation.
|
||||||
|
runVervis
|
||||||
|
:: Text -- ^ Server name, e.g. @hub.vervis.org@
|
||||||
|
-> FilePath -- ^ Path of database file, which is really JSON currently
|
||||||
|
-> FilePath -- ^ Path to the directory containing the namespace/repo tree
|
||||||
|
-> Vervis a -- ^ Computation to run
|
||||||
|
-> IO a
|
||||||
|
runVervis name file dir comp = do
|
||||||
|
result <- loadState file
|
||||||
|
case result of
|
||||||
|
Left (False, err) -> error $ "Loading JSON state failed: " ++ err
|
||||||
|
Left (True, err) -> error $ "Parsing JSON state failed: " ++ err
|
||||||
|
Right vstate -> do
|
||||||
|
save <- mkSaveState (3 :: Second) file
|
||||||
|
let venv = VervisEnv
|
||||||
|
{ veName = name
|
||||||
|
, veDir = dir
|
||||||
|
, veSave = liftIO . save
|
||||||
|
}
|
||||||
|
(a, _s) <- runVervis' venv vstate comp
|
||||||
|
return a
|
||||||
|
|
||||||
|
-- | Fetch the value of the environment.
|
||||||
|
ask :: Vervis VervisEnv
|
||||||
|
ask = Vervis RWS.ask
|
||||||
|
|
||||||
|
-- | Retrieve a function of the current environment.
|
||||||
|
asks :: (VervisEnv -> a) -> Vervis a
|
||||||
|
asks = Vervis . RWS.asks
|
||||||
|
|
||||||
|
-- | Fetch the current value of the state within the monad.
|
||||||
|
get :: Vervis VervisState
|
||||||
|
get = Vervis RWS.get
|
||||||
|
|
||||||
|
-- | Get a specific component of the state, using a projection function
|
||||||
|
-- supplied.
|
||||||
|
gets :: (VervisState -> a) -> Vervis a
|
||||||
|
gets = Vervis . RWS.gets
|
||||||
|
|
||||||
|
-- | @'put' s@ sets the state within the monad to @s@.
|
||||||
|
put :: VervisState -> Vervis ()
|
||||||
|
put = Vervis . RWS.put
|
||||||
|
|
||||||
|
-- | @'modify' f@ is an action that updates the state to the result of
|
||||||
|
-- applying @f@ to the current state.
|
||||||
|
modify :: (VervisState -> VervisState) -> Vervis ()
|
||||||
|
modify = Vervis . RWS.modify
|
||||||
69
src/Vervis/Ops.hs
Normal file
69
src/Vervis/Ops.hs
Normal file
|
|
@ -0,0 +1,69 @@
|
||||||
|
{- This file is part of Vervis.
|
||||||
|
-
|
||||||
|
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
|
-
|
||||||
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
|
-
|
||||||
|
- The author(s) have dedicated all copyright and related and neighboring
|
||||||
|
- rights to this software to the public domain worldwide. This software is
|
||||||
|
- distributed without any warranty.
|
||||||
|
-
|
||||||
|
- You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
|
- with this software. If not, see
|
||||||
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
|
||||||
|
module Vervis.Ops
|
||||||
|
( saveState
|
||||||
|
, createUser
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Monad (join)
|
||||||
|
import Control.Monad.Fix (MonadFix)
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import Data.Aeson
|
||||||
|
import Data.CaseInsensitive (CI)
|
||||||
|
import Data.Foldable (toList)
|
||||||
|
import Data.Git
|
||||||
|
import Data.Git.Revision
|
||||||
|
import Data.Git.Repository
|
||||||
|
import Data.Hashable (Hashable)
|
||||||
|
import Data.HashMap.Lazy (HashMap)
|
||||||
|
import Data.HashSet (HashSet)
|
||||||
|
import Data.Hourglass
|
||||||
|
import Data.JsonState
|
||||||
|
import Data.Maybe (fromMaybe, mapMaybe)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Time.Units
|
||||||
|
import GHC.Generics
|
||||||
|
import System.Directory.Tree hiding (name, file, err)
|
||||||
|
import System.FilePath ((</>))
|
||||||
|
import System.Hourglass (dateCurrent)
|
||||||
|
import Vervis.Monad
|
||||||
|
import Vervis.Types
|
||||||
|
|
||||||
|
import qualified Control.Monad.Trans.RWS as RWS
|
||||||
|
import qualified Data.CaseInsensitive as CI
|
||||||
|
import qualified Data.HashMap.Lazy as M
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
saveState :: Vervis ()
|
||||||
|
saveState = do
|
||||||
|
save <- asks veSave
|
||||||
|
vstate <- get
|
||||||
|
save vstate
|
||||||
|
|
||||||
|
createUser :: User -> Vervis ()
|
||||||
|
createUser user = do
|
||||||
|
vstate <- get
|
||||||
|
let users = vsUsers vstate
|
||||||
|
next = vsNextUser vstate
|
||||||
|
users' = M.insert next user users
|
||||||
|
next' = UserID $ unUserID next + 1
|
||||||
|
put vstate { vsUsers = users', vsNextUser = next' }
|
||||||
|
saveState
|
||||||
200
src/Vervis/Types.hs
Normal file
200
src/Vervis/Types.hs
Normal file
|
|
@ -0,0 +1,200 @@
|
||||||
|
{- This file is part of Vervis.
|
||||||
|
-
|
||||||
|
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
|
-
|
||||||
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
|
-
|
||||||
|
- The author(s) have dedicated all copyright and related and neighboring
|
||||||
|
- rights to this software to the public domain worldwide. This software is
|
||||||
|
- distributed without any warranty.
|
||||||
|
-
|
||||||
|
- You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
|
- with this software. If not, see
|
||||||
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
|
||||||
|
module Vervis.Types
|
||||||
|
( UserID (..)
|
||||||
|
, GroupID (..)
|
||||||
|
, RepoID (..)
|
||||||
|
, ProjID (..)
|
||||||
|
, Username (..)
|
||||||
|
, PasswordHash (..)
|
||||||
|
, RealName (..)
|
||||||
|
, EmailAddress (..)
|
||||||
|
, GroupName (..)
|
||||||
|
, RepoName (..)
|
||||||
|
, ProjectName (..)
|
||||||
|
, User (..)
|
||||||
|
, Group (..)
|
||||||
|
, IrcChannel (..)
|
||||||
|
, Repository (..)
|
||||||
|
, Project (..)
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Monad (join)
|
||||||
|
import Control.Monad.Fix (MonadFix)
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import Control.Monad.Trans.RWS (RWST (..))
|
||||||
|
import Data.Aeson
|
||||||
|
import Data.CaseInsensitive (CI)
|
||||||
|
import Data.Foldable (toList)
|
||||||
|
import Data.Git
|
||||||
|
import Data.Git.Revision
|
||||||
|
import Data.Git.Repository
|
||||||
|
import Data.Hashable (Hashable)
|
||||||
|
import Data.HashMap.Lazy (HashMap)
|
||||||
|
import Data.HashSet (HashSet)
|
||||||
|
import Data.Hourglass
|
||||||
|
import Data.JsonState
|
||||||
|
import Data.Maybe (fromMaybe, mapMaybe)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Time.Units
|
||||||
|
import GHC.Generics
|
||||||
|
import System.Directory.Tree hiding (name, file, err)
|
||||||
|
import System.FilePath ((</>))
|
||||||
|
import System.Hourglass (dateCurrent)
|
||||||
|
|
||||||
|
import qualified Control.Monad.Trans.RWS as RWS
|
||||||
|
import qualified Data.CaseInsensitive as CI
|
||||||
|
import qualified Data.HashMap.Lazy as M
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Types
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
newtype UserID = UserID { unUserID :: Int }
|
||||||
|
deriving (Eq, Hashable, FromJSON, ToJSON, WrappedText)
|
||||||
|
|
||||||
|
newtype GroupID = GroupID { unGroupID :: Int }
|
||||||
|
deriving (Eq, Hashable, FromJSON, ToJSON, WrappedText)
|
||||||
|
|
||||||
|
newtype RepoID = RepoID { unRepoID :: Int } deriving (Eq, Hashable, WrappedText)
|
||||||
|
|
||||||
|
newtype ProjID = ProjID { unProjID :: Int }
|
||||||
|
deriving (Eq, Hashable, FromJSON, ToJSON, WrappedText)
|
||||||
|
|
||||||
|
newtype Username = Username { unUsername :: CI Text }
|
||||||
|
deriving (FromJSON, ToJSON)
|
||||||
|
|
||||||
|
newtype PasswordHash = PasswordHash { unPasswordHash :: Text }
|
||||||
|
deriving (FromJSON, ToJSON)
|
||||||
|
|
||||||
|
newtype RealName = RealName { unRealName :: Text } deriving (FromJSON, ToJSON)
|
||||||
|
|
||||||
|
data EmailAddress = EmailAddress
|
||||||
|
{ emailUser :: Text
|
||||||
|
, emailHost :: Text
|
||||||
|
}
|
||||||
|
deriving Generic
|
||||||
|
|
||||||
|
instance FromJSON EmailAddress
|
||||||
|
instance ToJSON EmailAddress
|
||||||
|
|
||||||
|
newtype GroupName = GroupName { unGroupName :: CI Text }
|
||||||
|
deriving (FromJSON, ToJSON)
|
||||||
|
|
||||||
|
newtype RepoName = RepoName { unRepoName :: CI Text }
|
||||||
|
deriving (FromJSON, ToJSON, WrappedText)
|
||||||
|
|
||||||
|
newtype ProjectName = ProjectName { unProjectName :: CI Text }
|
||||||
|
deriving (FromJSON, ToJSON, WrappedText)
|
||||||
|
|
||||||
|
data User = User
|
||||||
|
{ userName :: Username
|
||||||
|
, userPassHash :: Maybe PasswordHash -- to disable pass and use SSH only?
|
||||||
|
, userRealName :: RealName
|
||||||
|
, userEmail :: EmailAddress
|
||||||
|
}
|
||||||
|
deriving Generic
|
||||||
|
|
||||||
|
instance FromJSON User
|
||||||
|
instance ToJSON User
|
||||||
|
|
||||||
|
data Group = Group
|
||||||
|
{ groupName :: GroupName
|
||||||
|
, groupUsers :: HashSet UserID
|
||||||
|
}
|
||||||
|
deriving Generic
|
||||||
|
|
||||||
|
instance FromJSON Group
|
||||||
|
instance ToJSON Group
|
||||||
|
|
||||||
|
data IrcChannel = IrcChannel
|
||||||
|
{ chanNetwork :: Text
|
||||||
|
, chanName :: Text
|
||||||
|
}
|
||||||
|
deriving Generic
|
||||||
|
|
||||||
|
instance FromJSON IrcChannel
|
||||||
|
instance ToJSON IrcChannel
|
||||||
|
|
||||||
|
data Repository = Repository
|
||||||
|
{ repoName :: RepoName
|
||||||
|
, repoIRC :: Maybe IrcChannel
|
||||||
|
, repoML :: Maybe Text
|
||||||
|
}
|
||||||
|
deriving Generic
|
||||||
|
|
||||||
|
instance ToJSON Repository
|
||||||
|
instance FromJSON Repository
|
||||||
|
|
||||||
|
data Project = Project
|
||||||
|
{ projName :: ProjectName
|
||||||
|
, projRepos :: HashMap RepoID Repository
|
||||||
|
}
|
||||||
|
deriving Generic
|
||||||
|
|
||||||
|
instance ToJSON Project
|
||||||
|
instance FromJSON Project
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Instances
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
instance (CI.FoldCase a, FromJSON a) => FromJSON (CI a) where
|
||||||
|
parseJSON v = CI.mk <$> parseJSON v
|
||||||
|
|
||||||
|
instance ToJSON a => ToJSON (CI a) where
|
||||||
|
toJSON = toJSON . CI.original
|
||||||
|
|
||||||
|
class WrappedText a where
|
||||||
|
toText :: a -> Text
|
||||||
|
fromText :: Text -> a
|
||||||
|
|
||||||
|
instance WrappedText Text where
|
||||||
|
toText = id
|
||||||
|
fromText = id
|
||||||
|
|
||||||
|
instance (WrappedText a, CI.FoldCase a) => WrappedText (CI a) where
|
||||||
|
toText = toText . CI.original
|
||||||
|
fromText = CI.mk . fromText
|
||||||
|
|
||||||
|
instance WrappedText Int where
|
||||||
|
toText = T.pack . show
|
||||||
|
fromText = read . T.unpack
|
||||||
|
|
||||||
|
mapFst :: (a -> c) -> [(a, b)] -> [(c, b)]
|
||||||
|
mapFst f = map $ \ (x, y) -> (f x, y)
|
||||||
|
|
||||||
|
instance (Eq k, Hashable k, WrappedText k, FromJSON v) => FromJSON (HashMap k v) where
|
||||||
|
parseJSON v = M.fromList . mapFst fromText . M.toList <$> parseJSON v
|
||||||
|
|
||||||
|
instance (WrappedText k, ToJSON v) => ToJSON (HashMap k v) where
|
||||||
|
toJSON = toJSON . M.fromList . mapFst toText . M.toList
|
||||||
|
|
||||||
|
instance (WrappedText a, WrappedText b) => WrappedText (Either a b) where
|
||||||
|
toText (Left x) = 'l' `T.cons` toText x
|
||||||
|
toText (Right y) = 'r' `T.cons` toText y
|
||||||
|
fromText t =
|
||||||
|
case T.uncons t of
|
||||||
|
Nothing -> error "blank JSON field name???"
|
||||||
|
Just ('l', r) -> Left $ fromText r
|
||||||
|
Just ('r', r) -> Right $ fromText r
|
||||||
|
_ -> error "what is dis ting"
|
||||||
|
|
@ -27,6 +27,10 @@ source-repository head
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules: Vervis
|
exposed-modules: Vervis
|
||||||
|
, Vervis.Git
|
||||||
|
, Vervis.Monad
|
||||||
|
, Vervis.Ops
|
||||||
|
, Vervis.Types
|
||||||
-- other-modules:
|
-- other-modules:
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
build-depends: aeson
|
build-depends: aeson
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue