module Data.Git.Types
(
ObjectType(..)
, Tree(..)
, Commit(..)
, CommitExtra(..)
, Blob(..)
, Tag(..)
, Person(..)
, EntName
, entName
, EntPath
, entPathAppend
, ModePerm(..)
, FilePermissions(..)
, ObjectFileType(..)
, getPermission
, getFiletype
, GitTime(..)
, gitTime
, gitTimeToLocal
, DeltaOfs(..)
, DeltaRef(..)
, TreeEnt
) where
import Data.Word
import Data.Bits
import Data.Byteable
import Data.String
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Git.Ref
import Data.Git.Delta
import Data.Git.Imports
import Data.Hourglass (Elapsed, TimezoneOffset(..)
, timePrint, timeConvert
, Time(..), Timeable(..)
, LocalTime, localTimeSetTimezone, localTimeFromGlobal)
import Data.Data
import qualified Data.ByteString.UTF8 as UTF8
data ObjectType =
TypeTree
| TypeBlob
| TypeCommit
| TypeTag
| TypeDeltaOff
| TypeDeltaRef
deriving (Show,Eq,Data,Typeable)
data GitTime = GitTime
{ gitTimeUTC :: Elapsed
, gitTimeTimezone :: TimezoneOffset
} deriving (Eq)
instance Timeable GitTime where
timeGetNanoSeconds _ = 0
timeGetElapsedP (GitTime t _) = timeConvert t
timeGetElapsed (GitTime t _) = t
instance Time GitTime where
timeFromElapsedP e = GitTime (timeGetElapsed e) (TimezoneOffset 0)
timeFromElapsed e = GitTime e (TimezoneOffset 0)
instance Show GitTime where
show (GitTime t tz) =
timePrint "EPOCH" t ++ " " ++ show tz
gitTime :: Integer -> Int -> GitTime
gitTime seconds tzMins =
GitTime (fromIntegral seconds) (TimezoneOffset tzMins)
gitTimeToLocal :: GitTime -> LocalTime Elapsed
gitTimeToLocal (GitTime t tz) =
localTimeSetTimezone tz (localTimeFromGlobal t)
instance Enum ObjectType where
fromEnum TypeCommit = 0x1
fromEnum TypeTree = 0x2
fromEnum TypeBlob = 0x3
fromEnum TypeTag = 0x4
fromEnum TypeDeltaOff = 0x6
fromEnum TypeDeltaRef = 0x7
toEnum 0x1 = TypeCommit
toEnum 0x2 = TypeTree
toEnum 0x3 = TypeBlob
toEnum 0x4 = TypeTag
toEnum 0x6 = TypeDeltaOff
toEnum 0x7 = TypeDeltaRef
toEnum n = error ("not a valid object: " ++ show n)
newtype ModePerm = ModePerm Word32
deriving (Show,Eq)
getPermission :: ModePerm -> FilePermissions
getPermission (ModePerm modeperm) =
let owner = (modeperm .&. 0x700) `shiftR` 6
group = (modeperm .&. 0x70) `shiftR` 3
other = modeperm .&. 0x7
in FilePermissions (fromIntegral owner) (fromIntegral group) (fromIntegral other)
getFiletype :: ModePerm -> ObjectFileType
getFiletype (ModePerm modeperm) =
case modeperm `shiftR` 12 of
_ -> error "filetype unknown"
data ObjectFileType =
FileTypeDirectory
| FileTypeRegularFile
| FileTypeSymbolicLink
| FileTypeGitLink
deriving (Show,Eq)
data FilePermissions = FilePermissions
{ getOwnerPerm :: !Perm
, getGroupPerm :: !Perm
, getOtherPerm :: !Perm
} deriving (Show,Eq)
type Perm = Word8
newtype EntName = EntName ByteString
deriving (Eq,Ord)
instance Show EntName where
show (EntName e) = UTF8.toString e
instance IsString EntName where
fromString s = entName $ UTF8.fromString s
instance Byteable EntName where
toBytes (EntName n) = n
entName :: ByteString -> EntName
entName bs
| B.elem slash bs = error ("entity name " ++ show bs ++ " contains an invalid '/' character")
| otherwise = EntName bs
where slash = 47
entPathAppend :: EntPath -> EntName -> EntPath
entPathAppend l e = l ++ [e]
type EntPath = [EntName]
type TreeEnt hash = (ModePerm,EntName,Ref hash)
data Person = Person
{ personName :: ByteString
, personEmail :: ByteString
, personTime :: GitTime
} deriving (Show,Eq)
data Tree hash = Tree { treeGetEnts :: [TreeEnt hash] } deriving (Show,Eq)
instance Monoid (Tree hash) where
mempty = Tree []
mappend (Tree e1) (Tree e2) = Tree (e1 ++ e2)
mconcat trees = Tree $ concatMap treeGetEnts trees
data Blob hash = Blob { blobGetContent :: L.ByteString } deriving (Show,Eq)
data Commit hash = Commit
{ commitTreeish :: Ref hash
, commitParents :: [Ref hash]
, commitAuthor :: Person
, commitCommitter :: Person
, commitEncoding :: Maybe ByteString
, commitExtras :: [CommitExtra]
, commitMessage :: ByteString
} deriving (Show,Eq)
data CommitExtra = CommitExtra
{ commitExtraKey :: ByteString
, commitExtraValue :: ByteString
} deriving (Show,Eq)
data Tag hash = Tag
{ tagRef :: Ref hash
, tagObjectType :: ObjectType
, tagBlob :: ByteString
, tagName :: Person
, tagS :: ByteString
} deriving (Show,Eq)
data DeltaOfs hash = DeltaOfs Word64 Delta
deriving (Show,Eq)
data DeltaRef hash = DeltaRef (Ref hash) Delta
deriving (Show,Eq)