mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 18:44:51 +09:00
Add a basic data model and determine change times from it
This commit is contained in:
parent
f51aa09159
commit
a953923a3e
2 changed files with 86 additions and 4 deletions
|
@ -14,22 +14,67 @@
|
|||
-}
|
||||
|
||||
module Vervis
|
||||
( subdirs
|
||||
( User (..)
|
||||
, Group (..)
|
||||
, IrcChannel (..)
|
||||
, Repository (..)
|
||||
, Server (..)
|
||||
, subdirs
|
||||
, lastChange
|
||||
, timeAgo
|
||||
, timesAgo
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad (join)
|
||||
import Data.CaseInsensitive (CI)
|
||||
import Data.Foldable (toList)
|
||||
import Data.Git
|
||||
import Data.Git.Revision
|
||||
import Data.Git.Repository
|
||||
import Data.HashMap.Lazy (HashMap)
|
||||
import Data.Hourglass
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Text (Text)
|
||||
import System.Directory.Tree
|
||||
import System.FilePath ((</>))
|
||||
import System.Hourglass (dateCurrent)
|
||||
|
||||
import qualified Data.CaseInsensitive as CI (original)
|
||||
import qualified Data.HashMap.Lazy as M
|
||||
import qualified Data.Text as T
|
||||
|
||||
data User = User
|
||||
{ userNick :: CI Text
|
||||
, userPassHash :: Text
|
||||
, userName :: Text
|
||||
, userEmail :: Text
|
||||
}
|
||||
|
||||
data Group = Group
|
||||
{ groupName :: CI Text
|
||||
, groupUsers :: [Int]
|
||||
}
|
||||
|
||||
data IrcChannel = IrcChannel
|
||||
{ chanNetwork :: Text
|
||||
, chanName :: Text
|
||||
}
|
||||
|
||||
data Repository = Repository
|
||||
{ repoName :: CI Text
|
||||
, repoIRC :: Maybe IrcChannel
|
||||
, repoML :: Maybe Text
|
||||
}
|
||||
|
||||
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
|
||||
|
@ -90,3 +135,36 @@ timeAgo dt = do
|
|||
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 $ userNick user
|
||||
prefix = dir </> ns
|
||||
repoNames = map (T.unpack . CI.original . 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 $ groupName group
|
||||
prefix = dir </> ns
|
||||
repoNames = map (T.unpack . CI.original . 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)
|
||||
|
|
|
@ -30,9 +30,13 @@ library
|
|||
-- other-modules:
|
||||
-- other-extensions:
|
||||
build-depends: base >=4.8 && <5
|
||||
, case-insensitive >=1
|
||||
, directory-tree >=0.12
|
||||
, filepath
|
||||
, hit >=0.6.3
|
||||
, hourglass
|
||||
, text >=1
|
||||
, unordered-containers >=0.2.5
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
|
Loading…
Reference in a new issue