ReadonlyStoreEffects: Add a referrers query.

This commit is contained in:
Shea Levy 2018-04-27 05:12:41 -07:00
parent f086a5c5a9
commit f21f036d7e
No known key found for this signature in database
GPG Key ID: 5C0BD6957D86FE27
2 changed files with 22 additions and 2 deletions

View File

@ -21,6 +21,7 @@ library
build-depends: base >=4.10 && <4.11, build-depends: base >=4.10 && <4.11,
-- Drop foundation when we can drop cryptonite <0.25 -- Drop foundation when we can drop cryptonite <0.25
cryptonite, memory, foundation, basement, cryptonite, memory, foundation, basement,
text, regex-base, regex-tdfa-text text, regex-base, regex-tdfa-text,
hashable, unordered-containers
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

View File

@ -3,6 +3,7 @@ Description : Types and effects for interacting with the Nix store.
Maintainer : Shea Levy <shea@shealevy.com> Maintainer : Shea Levy <shea@shealevy.com>
-} -}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module System.Nix.Store module System.Nix.Store
( PathName, pathNameContents, pathName ( PathName, pathNameContents, pathName
, PathHashAlgo, Path(..) , PathHashAlgo, Path(..)
@ -12,9 +13,13 @@ module System.Nix.Store
import Crypto.Hash (Digest) import Crypto.Hash (Digest)
import Crypto.Hash.Truncated (Truncated) import Crypto.Hash.Truncated (Truncated)
import Crypto.Hash.Algorithms (SHA256) import Crypto.Hash.Algorithms (SHA256)
import qualified Data.ByteArray as B
import Data.Text (Text) import Data.Text (Text)
import Text.Regex.Base.RegexLike (makeRegex, matchTest) import Text.Regex.Base.RegexLike (makeRegex, matchTest)
import Text.Regex.TDFA.Text (Regex) import Text.Regex.TDFA.Text (Regex)
import Data.Hashable (Hashable(..), hashPtrWithSalt)
import Data.HashSet (HashSet)
import System.IO.Unsafe (unsafeDupablePerformIO)
-- | The name portion of a Nix path. -- | The name portion of a Nix path.
-- --
@ -22,7 +27,7 @@ import Text.Regex.TDFA.Text (Regex)
-- start with a ., and must have at least one character. -- start with a ., and must have at least one character.
newtype PathName = PathName newtype PathName = PathName
{ pathNameContents :: Text -- ^ The contents of the path name { pathNameContents :: Text -- ^ The contents of the path name
} } deriving (Hashable)
-- | A regular expression for matching a valid 'PathName' -- | A regular expression for matching a valid 'PathName'
nameRegex :: Regex nameRegex :: Regex
@ -41,6 +46,18 @@ type PathHashAlgo = Truncated SHA256 20
-- | A path in a store. -- | A path in a store.
data Path = Path !(Digest PathHashAlgo) !PathName data Path = Path !(Digest PathHashAlgo) !PathName
-- | Wrapper to defined a 'Hashable' instance for 'Digest'.
newtype HashableDigest a = HashableDigest (Digest a)
instance Hashable (HashableDigest a) where
hashWithSalt s (HashableDigest d) = unsafeDupablePerformIO $
B.withByteArray d $ \ptr -> hashPtrWithSalt ptr (B.length d) s
instance Hashable Path where
hashWithSalt s (Path digest name) =
s `hashWithSalt`
(HashableDigest digest) `hashWithSalt` name
-- | Read-only interactions with a store. -- | Read-only interactions with a store.
-- --
-- 'rootedPath': A path plus a witness to the fact that the path is -- 'rootedPath': A path plus a witness to the fact that the path is
@ -62,4 +79,6 @@ data ReadonlyStoreEffects rootedPath validPath m =
fromValidPath :: !(validPath -> rootedPath) fromValidPath :: !(validPath -> rootedPath)
, -- | Is the given path valid? , -- | Is the given path valid?
validPath :: !(rootedPath -> m (Maybe validPath)) validPath :: !(rootedPath -> m (Maybe validPath))
, -- | Get the paths that refer to a given path.
referrers :: !(validPath -> m (HashSet Path))
} }