fa62c98910
This eliminates the distinction between decodeBS and decodeBS', encodeBS and encodeBS', etc. The old implementation truncated at NUL, and the primed versions had to do extra work to avoid that problem. The new implementation does not truncate at NUL, and is also a lot faster. (Benchmarked at 2x faster for decodeBS and 3x for encodeBS; more for the primed versions.) Note that filepath-bytestring 1.4.2.1.8 contains the same optimisation, and upgrading to it will speed up to/fromRawFilePath. AFAIK, nothing relied on the old behavior of truncating at NUL. Some code used the faster versions in places where I was sure there would not be a NUL. So this change is unlikely to break anything. Also, moved s2w8 and w82s out of the module, as they do not involve filesystem encoding really. Sponsored-by: Shae Erisson on Patreon
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
|