Add a basic data model and determine change times from it

This commit is contained in:
fr33domlover 2016-01-29 09:39:35 +00:00
parent f51aa09159
commit a953923a3e
2 changed files with 86 additions and 4 deletions

View file

@ -14,22 +14,67 @@
-} -}
module Vervis module Vervis
( subdirs ( User (..)
, Group (..)
, IrcChannel (..)
, Repository (..)
, Server (..)
, subdirs
, lastChange , lastChange
, timeAgo , timeAgo
, timesAgo
) )
where where
import Control.Monad (join) import Control.Monad (join)
import Data.CaseInsensitive (CI)
import Data.Foldable (toList) import Data.Foldable (toList)
import Data.Git import Data.Git
import Data.Git.Revision import Data.Git.Revision
import Data.Git.Repository import Data.Git.Repository
import Data.HashMap.Lazy (HashMap)
import Data.Hourglass import Data.Hourglass
import Data.Maybe (fromMaybe, mapMaybe) import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text)
import System.Directory.Tree import System.Directory.Tree
import System.FilePath ((</>))
import System.Hourglass (dateCurrent) 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 :: FilePath -> IO [FilePath]
subdirs dir = do subdirs dir = do
_base :/ tree <- buildL dir _base :/ tree <- buildL dir
@ -90,3 +135,36 @@ timeAgo dt = do
let sec = timeDiff now dt let sec = timeDiff now dt
(period, duration) = fromSec sec (period, duration) = fromSec sec
return $ showAgo period duration 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)

View file

@ -30,9 +30,13 @@ library
-- other-modules: -- other-modules:
-- other-extensions: -- other-extensions:
build-depends: base >=4.8 && <5 build-depends: base >=4.8 && <5
, case-insensitive >=1
, directory-tree >=0.12 , directory-tree >=0.12
, filepath
, hit >=0.6.3 , hit >=0.6.3
, hourglass , hourglass
, text >=1
, unordered-containers >=0.2.5
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall