1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
{- 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
|
