add Database.ContentIdentifier

Does not yet have a way to update with new information from the
git-annex branch, which will be needed when multiple repos are importing
from the same remote.
This commit is contained in:
Joey Hess 2019-02-20 16:59:10 -04:00
parent ccc0684d21
commit a818bc5e73
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 132 additions and 3 deletions

View file

@ -1,22 +1,29 @@
{- types for SQL databases
-
- Copyright 2015-2017 Joey Hess <id@joeyh.name>
- Copyright 2015-2019 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Database.Types where
import Database.Persist.TH
import Database.Persist.Class hiding (Key)
import Database.Persist.Sql hiding (Key)
import Data.Maybe
import Data.Char
import qualified Data.ByteString as S
import qualified Data.Text as T
import Utility.PartialPrelude
import Key
import Utility.InodeCache
import Git.Types (Ref(..))
import Types.UUID
import Types.Remote (ContentIdentifier(..))
-- A serialized Key
newtype SKey = SKey String
@ -112,3 +119,26 @@ toSRef = SRef
fromSRef :: SRef -> Ref
fromSRef (SRef r) = r
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