diff --git a/src/Vervis.hs b/src/Vervis.hs index ade4c84..738267f 100644 --- a/src/Vervis.hs +++ b/src/Vervis.hs @@ -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) diff --git a/vervis.cabal b/vervis.cabal index 9fce8d8..74e2e6c 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -29,10 +29,14 @@ library exposed-modules: Vervis -- other-modules: -- other-extensions: - build-depends: base >=4.8 && <5 - , directory-tree >=0.12 - , hit >=0.6.3 + 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