279991604d
This should make code that reads shas and refs from git faster. Does not compile yet, a lot needs to be done still.
131 lines
3.4 KiB
Haskell
131 lines
3.4 KiB
Haskell
{- types for SQL databases
|
|
-
|
|
- Copyright 2015-2019 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
{-# LANGUAGE TypeSynonymInstances #-}
|
|
|
|
module Database.Types (
|
|
module Database.Types,
|
|
Key,
|
|
EpochTime,
|
|
FileSize,
|
|
) where
|
|
|
|
import Database.Persist.Class hiding (Key)
|
|
import Database.Persist.Sql hiding (Key)
|
|
import qualified Data.ByteString as S
|
|
import qualified Data.Text as T
|
|
import qualified Data.Attoparsec.ByteString as A
|
|
import System.PosixCompat.Types
|
|
import Data.Int
|
|
import Data.Text.Read
|
|
import Foreign.C.Types
|
|
|
|
import Key
|
|
import Utility.InodeCache
|
|
import Utility.FileSize
|
|
import Utility.FileSystemEncoding
|
|
import Git.Types
|
|
import Types.UUID
|
|
import Types.Import
|
|
|
|
instance PersistField Key where
|
|
toPersistValue = toPersistValue . serializeKey'
|
|
fromPersistValue b = fromPersistValue b >>= parse
|
|
where
|
|
parse = either (Left . T.pack) Right . A.parseOnly keyParser
|
|
|
|
-- A key can contain arbitrarily encoded characters, so store in sqlite as a
|
|
-- blob to avoid encoding problems.
|
|
instance PersistFieldSql Key where
|
|
sqlType _ = SqlBlob
|
|
|
|
instance PersistField InodeCache where
|
|
toPersistValue = toPersistValue . showInodeCache
|
|
fromPersistValue b = fromPersistValue b >>= parse
|
|
where
|
|
parse s = maybe
|
|
(Left $ T.pack $ "bad serialized InodeCache "++ s)
|
|
Right
|
|
(readInodeCache s)
|
|
|
|
instance PersistFieldSql InodeCache where
|
|
sqlType _ = SqlString
|
|
|
|
instance PersistField UUID where
|
|
toPersistValue u = toPersistValue b
|
|
where
|
|
b :: S.ByteString
|
|
b = fromUUID u
|
|
fromPersistValue v = toUUID <$> go
|
|
where
|
|
go :: Either T.Text S.ByteString
|
|
go = fromPersistValue v
|
|
|
|
instance PersistFieldSql UUID where
|
|
sqlType _ = SqlBlob
|
|
|
|
instance PersistField ContentIdentifier where
|
|
toPersistValue (ContentIdentifier b) = toPersistValue b
|
|
fromPersistValue v = ContentIdentifier <$> go
|
|
where
|
|
go :: Either T.Text S.ByteString
|
|
go = fromPersistValue v
|
|
|
|
instance PersistFieldSql ContentIdentifier where
|
|
sqlType _ = SqlBlob
|
|
|
|
-- A serialized RawFilePath.
|
|
newtype SFilePath = SFilePath S.ByteString
|
|
deriving (Eq, Show)
|
|
|
|
instance PersistField SFilePath where
|
|
toPersistValue (SFilePath b) = toPersistValue b
|
|
fromPersistValue v = SFilePath <$> fromPersistValue v
|
|
|
|
instance PersistFieldSql SFilePath where
|
|
sqlType _ = SqlBlob
|
|
|
|
-- A serialized git Sha
|
|
newtype SSha = SSha String
|
|
deriving (Eq, Show)
|
|
|
|
toSSha :: Sha -> SSha
|
|
toSSha (Ref s) = SSha (decodeBS' s)
|
|
|
|
fromSSha :: SSha -> Ref
|
|
fromSSha (SSha s) = Ref (encodeBS' s)
|
|
|
|
instance PersistField SSha where
|
|
toPersistValue (SSha b) = toPersistValue b
|
|
fromPersistValue v = SSha <$> fromPersistValue v
|
|
|
|
instance PersistFieldSql SSha where
|
|
sqlType _ = SqlString
|
|
|
|
-- A FileSize could be stored as an Int64, but some systems could
|
|
-- conceivably have a larger filesize, and no math is ever done with them
|
|
-- in sqlite, so store a string instead.
|
|
instance PersistField FileSize where
|
|
toPersistValue = toPersistValue . show
|
|
fromPersistValue v = fromPersistValue v >>= parse
|
|
where
|
|
parse = either (Left . T.pack) (Right . fst) . decimal
|
|
|
|
instance PersistFieldSql FileSize where
|
|
sqlType _ = SqlString
|
|
|
|
-- Store EpochTime as an Int64, to allow selecting values in a range.
|
|
instance PersistField EpochTime where
|
|
toPersistValue (CTime t) = toPersistValue (fromIntegral t :: Int64)
|
|
fromPersistValue v = CTime . fromIntegral <$> go
|
|
where
|
|
go :: Either T.Text Int64
|
|
go = fromPersistValue v
|
|
|
|
instance PersistFieldSql EpochTime where
|
|
sqlType _ = SqlInt64
|