b03d77c211
New table needed to look up what filenames are used in the currently exported tree, for reasons explained in export.mdwn. Also, added smart constructors for ExportLocation and ExportDirectory to make sure they contain filepaths with the right direction slashes. And some code refactoring. This commit was sponsored by Francois Marier on Patreon.
114 lines
2.7 KiB
Haskell
114 lines
2.7 KiB
Haskell
{- types for SQL databases
|
|
-
|
|
- Copyright 2015-2017 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Database.Types where
|
|
|
|
import Database.Persist.TH
|
|
import Data.Maybe
|
|
import Data.Char
|
|
|
|
import Utility.PartialPrelude
|
|
import Key
|
|
import Utility.InodeCache
|
|
import Git.Types (Ref(..))
|
|
|
|
-- A serialized Key
|
|
newtype SKey = SKey String
|
|
deriving (Show, Read)
|
|
|
|
toSKey :: Key -> SKey
|
|
toSKey = SKey . key2file
|
|
|
|
fromSKey :: SKey -> Key
|
|
fromSKey (SKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (file2key s)
|
|
|
|
derivePersistField "SKey"
|
|
|
|
-- A Key index. More efficient than SKey, but its Read instance does not
|
|
-- work when it's used in any kind of complex data structure.
|
|
newtype IKey = IKey String
|
|
|
|
instance Read IKey where
|
|
readsPrec _ s = [(IKey s, "")]
|
|
|
|
instance Show IKey where
|
|
show (IKey s) = s
|
|
|
|
toIKey :: Key -> IKey
|
|
toIKey = IKey . key2file
|
|
|
|
fromIKey :: IKey -> Key
|
|
fromIKey (IKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (file2key s)
|
|
|
|
derivePersistField "IKey"
|
|
|
|
-- A serialized InodeCache
|
|
newtype SInodeCache = I String
|
|
deriving (Show, Read)
|
|
|
|
toSInodeCache :: InodeCache -> SInodeCache
|
|
toSInodeCache = I . showInodeCache
|
|
|
|
fromSInodeCache :: SInodeCache -> InodeCache
|
|
fromSInodeCache (I s) = fromMaybe (error $ "bad serialized InodeCache " ++ s) (readInodeCache s)
|
|
|
|
derivePersistField "SInodeCache"
|
|
|
|
-- A serialized FilePath.
|
|
--
|
|
-- Not all unicode characters round-trip through sqlite. In particular,
|
|
-- surrigate code points do not. So, escape the FilePath. But, only when
|
|
-- it contains such characters.
|
|
newtype SFilePath = SFilePath String
|
|
|
|
-- Note that Read instance does not work when used in any kind of complex
|
|
-- data structure.
|
|
instance Read SFilePath where
|
|
readsPrec _ s = [(SFilePath s, "")]
|
|
|
|
instance Show SFilePath where
|
|
show (SFilePath s) = s
|
|
|
|
toSFilePath :: FilePath -> SFilePath
|
|
toSFilePath s@('"':_) = SFilePath (show s)
|
|
toSFilePath s
|
|
| any needsescape s = SFilePath (show s)
|
|
| otherwise = SFilePath s
|
|
where
|
|
needsescape c = case generalCategory c of
|
|
Surrogate -> True
|
|
PrivateUse -> True
|
|
NotAssigned -> True
|
|
_ -> False
|
|
|
|
fromSFilePath :: SFilePath -> FilePath
|
|
fromSFilePath (SFilePath s@('"':_)) =
|
|
fromMaybe (error "bad serialized SFilePath " ++ s) (readish s)
|
|
fromSFilePath (SFilePath s) = s
|
|
|
|
derivePersistField "SFilePath"
|
|
|
|
-- A serialized Ref
|
|
newtype SRef = SRef Ref
|
|
|
|
-- Note that Read instance does not work when used in any kind of complex
|
|
-- data structure.
|
|
instance Read SRef where
|
|
readsPrec _ s = [(SRef (Ref s), "")]
|
|
|
|
instance Show SRef where
|
|
show (SRef (Ref s)) = s
|
|
|
|
derivePersistField "SRef"
|
|
|
|
toSRef :: Ref -> SRef
|
|
toSRef = SRef
|
|
|
|
fromSRef :: SRef -> Ref
|
|
fromSRef (SRef r) = r
|