src/Git/Metadata.hs

   1 -- |
   2 -- Module      : Git.Metadata
   3 -- Copyright   : (c) 2008 Bertram Felgenhauer
   4 -- License     : GPL2
   5 --
   6 -- Maintainer  : Bertram Felgenhauer <int-e@gmx.de>
   7 -- Stability   : experimental
   8 -- Portability : ghc
   9 --
  10 -- convert from darcs to git metadata
  11
  12 module Git.Metadata (
  13     extractGitInfo,
  14     GitInfo (..),
  15 ) where
  16
  17 import Darcs.Patch.Info (
  18     PatchInfo, pi_author, pi_name, pi_tag, pi_date, pi_log, make_filename)
  19 import System.Time (calendarTimeToString)
  20
  21 data GitInfo = GitInfo {
  22     gitAuthor  :: String,       -- author name
  23     gitAEmail  :: String,       -- author email
  24     gitTag     :: Maybe String, -- tag name (Nothing for normal patches)
  25     gitDate    :: String,       -- patch date
  26     gitMessage :: String        -- patch name and message
  27 }
  28
  29 extractGitInfo :: PatchInfo -> GitInfo
  30 extractGitInfo pip = GitInfo {
  31     gitAuthor  = fst (extractAuthor pip),
  32     gitAEmail  = snd (extractAuthor pip),
  33     gitTag     = extractTag pip,
  34     gitDate    = extractDate pip,
  35     gitMessage = extractMessage pip
  36 }
  37
  38 -- split "Foo <bar@what>" into "Foo" and "bar@what".
  39 -- (dirty implementation - can be improved, but mostly works)
  40 extractAuthor :: PatchInfo -> (String, String)
  41 extractAuthor pip = let
  42     m = pi_author pip
  43     ms = words (filter (/= '\'') m)
  44     (name, email) = span (\word -> head word /= '<') ms
  45   in
  46     if null email && length name == 1 && '@' `elem` head name then ("", "<" ++ head name ++ ">") else
  47     (if null name then "nobody" else unwords name, if null email then "<>" else unwords email)
  48
  49 -- derive a tag name from a tag message. basically filter allowed characters.
  50 extractTag :: PatchInfo -> Maybe String
  51 extractTag = fmap (concatMap tagChar) . pi_tag where
  52     tagChar c | '0' <= c && c <= '9' ||
  53                 'a' <= c && c <= 'z' ||
  54                 'A' <= c && c <= 'Z' ||
  55                 c `elem` validChars = c : []
  56     tagChar ' ' = "_"
  57     tagChar _   = ""
  58     validChars = ".<>-"
  59
  60 extractDate :: PatchInfo -> String
  61 extractDate = calendarTimeToString . pi_date
  62
  63 extractMessage :: PatchInfo -> String
  64 extractMessage pip = unlines
  65     (pi_name pip : "" : pi_log pip ++ ["", make_filename pip])