{-# LANGUAGE DeriveDataTypeable #-}
module Data.Git.Types
(
ObjectType(..)
, Tree(..)
, Commit(..)
, CommitExtra(..)
, Blob(..)
, Tag(..)
, Person(..)
, EntName
, entName
, getEntNameBytes
, EntPath
, entPathAppend
, ModePerm(..)
, FilePermissions(..)
, ObjectFileType(..)
, getPermission
, getFiletype
, GitTime(..)
, gitTime
, gitTimeToLocal
, DeltaOfs(..)
, DeltaRef(..)
, TreeEnt
) where
import Data.Word
import Data.Bits
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 :: {-# UNPACK #-} !Perm
, getGroupPerm :: {-# UNPACK #-} !Perm
, getOtherPerm :: {-# UNPACK #-} !Perm
} deriving (Show,Eq)
type Perm = Word8
newtype EntName = EntName { getEntNameBytes :: ByteString }
deriving (Eq,Ord)
instance Show EntName where
show (EntName e) = UTF8.toString e
instance IsString EntName where
fromString s = entName $ UTF8.fromString s
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)
newtype Tree hash = Tree { treeGetEnts :: [TreeEnt hash] } deriving (Show,Eq)
newtype 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)