Safe Haskell | None |
---|---|
Language | Haskell2010 |
Pantry.Internal.Stackage
Description
All types and functions exported from this module are for advanced usage only. They are needed for stackage-server integration with pantry.
Synopsis
- data family EntityField record a :: Type
- data family Key record :: Type
- data family Unique record :: Type
- data SafeFilePath
- newtype ModuleNameP = ModuleNameP {
- unModuleNameP :: ModuleName
- newtype VersionP = VersionP {}
- newtype PackageNameP = PackageNameP {}
- data PantryConfig = PantryConfig {
- pcHackageSecurity :: !HackageSecurityConfig
- pcHpackExecutable :: !HpackExecutable
- pcRootDir :: !(Path Abs Dir)
- pcStorage :: !Storage
- pcUpdateRef :: !(MVar Bool)
- pcParsedCabalFilesRawImmutable :: !(IORef (Map RawPackageLocationImmutable GenericPackageDescription))
- pcParsedCabalFilesMutable :: !(IORef (Map (Path Abs Dir) (PrintWarnings -> IO GenericPackageDescription, PackageName, Path Abs File)))
- pcConnectionCount :: !Int
- data Storage = Storage {
- withStorage_ :: forall env a. HasLogFunc env => ReaderT SqlBackend (RIO env) a -> RIO env a
- withWriteLock_ :: forall env a. HasLogFunc env => RIO env a -> RIO env a
- packageTreeKey :: Package -> TreeKey
- unSafeFilePath :: SafeFilePath -> Text
- mkSafeFilePath :: Text -> Maybe SafeFilePath
- parsePackageName :: String -> Maybe PackageName
- parseVersion :: String -> Maybe Version
- parseVersionThrowing :: MonadThrow m => String -> m Version
- packageNameString :: PackageName -> String
- versionString :: Version -> String
- type ModuleNameId = Key ModuleName
- type TreeEntryId = Key TreeEntry
- data TreeEntry = TreeEntry {
- treeEntryTree :: !(Key Tree)
- treeEntryPath :: !(Key FilePath)
- treeEntryBlob :: !(Key Blob)
- treeEntryType :: !FileType
- type TreeId = Key Tree
- data Tree = Tree {
- treeKey :: !(Key Blob)
- treeCabal :: !(Maybe (Key Blob))
- treeCabalType :: !FileType
- treeName :: !(Key PackageName)
- treeVersion :: !(Key Version)
- type HackageCabalId = Key HackageCabal
- type VersionId = Key Version
- data Version
- type PackageNameId = Key PackageName
- data PackageName
- type BlobId = Key Blob
- migrateAll :: Migration
- getPackageNameById :: PackageNameId -> ReaderT SqlBackend (RIO env) (Maybe PackageName)
- getPackageNameId :: PackageName -> ReaderT SqlBackend (RIO env) PackageNameId
- getVersionId :: Version -> ReaderT SqlBackend (RIO env) VersionId
- loadBlobById :: BlobId -> ReaderT SqlBackend (RIO env) ByteString
- allBlobsSource :: HasResourceMap env => Maybe BlobId -> ConduitT () (BlobId, ByteString) (ReaderT SqlBackend (RIO env)) ()
- allBlobsCount :: Maybe BlobId -> ReaderT SqlBackend (RIO env) Int
- getBlobKey :: BlobId -> ReaderT SqlBackend (RIO env) BlobKey
- getTreeForKey :: TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
- data HackageTarballResult = HackageTarballResult {
- htrPackage :: !Package
- htrFreshPackageInfo :: !(Maybe (GenericPackageDescription, TreeId))
- forceUpdateHackageIndex :: (HasPantryConfig env, HasLogFunc env) => Maybe Utf8Builder -> RIO env DidUpdateOccur
- getHackageTarball :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) => PackageIdentifierRevision -> Maybe TreeKey -> RIO env HackageTarballResult
Documentation
data family EntityField record a :: Type #
Instances
data family Key record :: Type #
Instances
data family Unique record :: Type #
Instances
Show (Unique Tree) | |
Show (Unique Version) | |
Show (Unique PackageName) | |
Defined in Pantry.Storage Methods showsPrec :: Int -> Unique PackageName -> ShowS show :: Unique PackageName -> String showList :: [Unique PackageName] -> ShowS | |
data Unique TreeEntry Source # | |
Defined in Pantry.Storage | |
data Unique Tree Source # | |
Defined in Pantry.Storage | |
data Unique Version Source # | |
Defined in Pantry.Storage | |
data Unique PackageName Source # | |
Defined in Pantry.Storage |
data SafeFilePath Source #
Instances
Eq SafeFilePath Source # | |
Defined in Pantry.Types | |
Ord SafeFilePath Source # | |
Defined in Pantry.Types Methods compare :: SafeFilePath -> SafeFilePath -> Ordering (<) :: SafeFilePath -> SafeFilePath -> Bool (<=) :: SafeFilePath -> SafeFilePath -> Bool (>) :: SafeFilePath -> SafeFilePath -> Bool (>=) :: SafeFilePath -> SafeFilePath -> Bool max :: SafeFilePath -> SafeFilePath -> SafeFilePath min :: SafeFilePath -> SafeFilePath -> SafeFilePath | |
Show SafeFilePath Source # | |
Defined in Pantry.Types Methods showsPrec :: Int -> SafeFilePath -> ShowS show :: SafeFilePath -> String showList :: [SafeFilePath] -> ShowS | |
Display SafeFilePath Source # | |
Defined in Pantry.Types | |
PersistField SafeFilePath Source # | |
Defined in Pantry.Types Methods toPersistValue :: SafeFilePath -> PersistValue fromPersistValue :: PersistValue -> Either Text SafeFilePath | |
PersistFieldSql SafeFilePath Source # | |
Defined in Pantry.Types Methods sqlType :: Proxy SafeFilePath -> SqlType |
newtype ModuleNameP Source #
Constructors
ModuleNameP | |
Fields
|
Instances
Eq ModuleNameP Source # | |
Defined in Pantry.Types | |
Ord ModuleNameP Source # | |
Defined in Pantry.Types Methods compare :: ModuleNameP -> ModuleNameP -> Ordering (<) :: ModuleNameP -> ModuleNameP -> Bool (<=) :: ModuleNameP -> ModuleNameP -> Bool (>) :: ModuleNameP -> ModuleNameP -> Bool (>=) :: ModuleNameP -> ModuleNameP -> Bool max :: ModuleNameP -> ModuleNameP -> ModuleNameP min :: ModuleNameP -> ModuleNameP -> ModuleNameP | |
Show ModuleNameP Source # | |
Defined in Pantry.Types Methods showsPrec :: Int -> ModuleNameP -> ShowS show :: ModuleNameP -> String showList :: [ModuleNameP] -> ShowS | |
NFData ModuleNameP Source # | |
Defined in Pantry.Types Methods rnf :: ModuleNameP -> () | |
Display ModuleNameP Source # | |
Defined in Pantry.Types | |
PersistField ModuleNameP Source # | |
Defined in Pantry.Types Methods toPersistValue :: ModuleNameP -> PersistValue fromPersistValue :: PersistValue -> Either Text ModuleNameP | |
PersistFieldSql ModuleNameP Source # | |
Defined in Pantry.Types Methods sqlType :: Proxy ModuleNameP -> SqlType |
Constructors
VersionP | |
Fields |
Instances
Eq VersionP Source # | |
Ord VersionP Source # | |
Read VersionP Source # | |
Defined in Pantry.Types | |
Show VersionP Source # | |
FromJSON VersionP Source # | |
Defined in Pantry.Types | |
ToJSON VersionP Source # | |
Defined in Pantry.Types | |
NFData VersionP Source # | |
Defined in Pantry.Types | |
Display VersionP Source # | |
Defined in Pantry.Types | |
PersistField VersionP Source # | |
Defined in Pantry.Types Methods toPersistValue :: VersionP -> PersistValue fromPersistValue :: PersistValue -> Either Text VersionP | |
PersistFieldSql VersionP Source # | |
Defined in Pantry.Types |
newtype PackageNameP Source #
Constructors
PackageNameP | |
Fields |
Instances
data PantryConfig Source #
Configuration value used by the entire pantry package. Create one
using withPantryConfig
. See also PantryApp
for a convenience
approach to using pantry.
Since: 0.1.0.0
Constructors
PantryConfig | |
Fields
|
Represents a SQL database connection. This used to be a newtype wrapper around a connection pool. However, when investigating https://github.com/commercialhaskell/stack/issues/4471, it appeared that holding a pool resulted in overly long write locks being held on the database. As a result, we now abstract away whether a pool is used, and the default implementation in Pantry.Storage does not use a pool.
Constructors
Storage | |
Fields
|
packageTreeKey :: Package -> TreeKey Source #
The TreeKey
containing this package.
This is a hash of the binary representation of packageTree
.
Since: 0.1.0.0
unSafeFilePath :: SafeFilePath -> Text Source #
mkSafeFilePath :: Text -> Maybe SafeFilePath Source #
parsePackageName :: String -> Maybe PackageName Source #
Parse a package name from a String
.
Since: 0.1.0.0
parseVersion :: String -> Maybe Version Source #
Parse a version from a String
.
Since: 0.1.0.0
parseVersionThrowing :: MonadThrow m => String -> m Version Source #
Parse a package version from a String
throwing on failure
Since: 0.1.0.0
packageNameString :: PackageName -> String Source #
Render a package name as a String
.
Since: 0.1.0.0
versionString :: Version -> String Source #
Render a version as a String
.
Since: 0.1.0.0
type ModuleNameId = Key ModuleName Source #
type TreeEntryId = Key TreeEntry Source #
Constructors
TreeEntry | |
Fields
|
Instances
Constructors
Tree | |
Fields
|
Instances
PersistEntity Tree Source # | |
Defined in Pantry.Storage Methods keyToValues :: Key Tree -> [PersistValue] keyFromValues :: [PersistValue] -> Either Text (Key Tree) persistIdField :: EntityField Tree (Key Tree) entityDef :: Monad m => m Tree -> EntityDef persistFieldDef :: EntityField Tree typ -> FieldDef toPersistFields :: Tree -> [SomePersistField] fromPersistValues :: [PersistValue] -> Either Text Tree persistUniqueKeys :: Tree -> [Unique Tree] persistUniqueToFieldNames :: Unique Tree -> [(HaskellName, DBName)] persistUniqueToValues :: Unique Tree -> [PersistValue] fieldLens :: EntityField Tree field -> forall (f :: Type -> Type). Functor f => (field -> f field) -> Entity Tree -> f (Entity Tree) | |
PersistField Tree Source # | |
Defined in Pantry.Storage | |
PersistFieldSql Tree Source # | |
Defined in Pantry.Storage | |
ToBackendKey SqlBackend Tree Source # | |
Defined in Pantry.Storage Methods toBackendKey :: Key Tree -> BackendKey SqlBackend fromBackendKey :: BackendKey SqlBackend -> Key Tree | |
Eq (Key Tree) Source # | |
Ord (Key Tree) Source # | |
Read (Key Tree) Source # | |
Show (Key Tree) Source # | |
Show (Unique Tree) Source # | |
FromJSON (Key Tree) Source # | |
ToJSON (Key Tree) Source # | |
PersistField (Key Tree) Source # | |
Defined in Pantry.Storage Methods toPersistValue :: Key Tree -> PersistValue fromPersistValue :: PersistValue -> Either Text (Key Tree) | |
PersistFieldSql (Key Tree) Source # | |
Defined in Pantry.Storage | |
FromHttpApiData (Key Tree) Source # | |
Defined in Pantry.Storage Methods parseUrlPiece :: Text -> Either Text (Key Tree) parseHeader :: ByteString -> Either Text (Key Tree) parseQueryParam :: Text -> Either Text (Key Tree) | |
PathPiece (Key Tree) Source # | |
Defined in Pantry.Storage | |
ToHttpApiData (Key Tree) Source # | |
Defined in Pantry.Storage Methods toUrlPiece :: Key Tree -> Text toEncodedUrlPiece :: Key Tree -> Builder toHeader :: Key Tree -> ByteString toQueryParam :: Key Tree -> Text | |
data EntityField Tree typ Source # | |
Defined in Pantry.Storage data EntityField Tree typ where
| |
newtype Key Tree Source # | |
Defined in Pantry.Storage | |
type PersistEntityBackend Tree Source # | |
Defined in Pantry.Storage type PersistEntityBackend Tree = SqlBackend | |
data Unique Tree Source # | |
Defined in Pantry.Storage |
type HackageCabalId = Key HackageCabal Source #
Instances
PersistEntity Version Source # | |
Defined in Pantry.Storage Methods keyToValues :: Key Version -> [PersistValue] keyFromValues :: [PersistValue] -> Either Text (Key Version) persistIdField :: EntityField Version (Key Version) entityDef :: Monad m => m Version -> EntityDef persistFieldDef :: EntityField Version typ -> FieldDef toPersistFields :: Version -> [SomePersistField] fromPersistValues :: [PersistValue] -> Either Text Version persistUniqueKeys :: Version -> [Unique Version] persistUniqueToFieldNames :: Unique Version -> [(HaskellName, DBName)] persistUniqueToValues :: Unique Version -> [PersistValue] fieldLens :: EntityField Version field -> forall (f :: Type -> Type). Functor f => (field -> f field) -> Entity Version -> f (Entity Version) | |
PersistField Version Source # | |
Defined in Pantry.Storage Methods toPersistValue :: Version -> PersistValue fromPersistValue :: PersistValue -> Either Text Version | |
PersistFieldSql Version Source # | |
Defined in Pantry.Storage | |
ToBackendKey SqlBackend Version Source # | |
Defined in Pantry.Storage Methods toBackendKey :: Key Version -> BackendKey SqlBackend fromBackendKey :: BackendKey SqlBackend -> Key Version | |
Eq (Key Version) Source # | |
Ord (Key Version) Source # | |
Read (Key Version) Source # | |
Show (Key Version) Source # | |
Show (Unique Version) Source # | |
FromJSON (Key Version) Source # | |
ToJSON (Key Version) Source # | |
PersistField (Key Version) Source # | |
Defined in Pantry.Storage Methods toPersistValue :: Key Version -> PersistValue fromPersistValue :: PersistValue -> Either Text (Key Version) | |
PersistFieldSql (Key Version) Source # | |
Defined in Pantry.Storage | |
FromHttpApiData (Key Version) Source # | |
Defined in Pantry.Storage Methods parseUrlPiece :: Text -> Either Text (Key Version) parseHeader :: ByteString -> Either Text (Key Version) parseQueryParam :: Text -> Either Text (Key Version) | |
PathPiece (Key Version) Source # | |
Defined in Pantry.Storage | |
ToHttpApiData (Key Version) Source # | |
Defined in Pantry.Storage Methods toUrlPiece :: Key Version -> Text toEncodedUrlPiece :: Key Version -> Builder toHeader :: Key Version -> ByteString toQueryParam :: Key Version -> Text | |
data EntityField Version typ Source # | |
Defined in Pantry.Storage data EntityField Version typ where
| |
newtype Key Version Source # | |
Defined in Pantry.Storage | |
type PersistEntityBackend Version Source # | |
Defined in Pantry.Storage type PersistEntityBackend Version = SqlBackend | |
data Unique Version Source # | |
Defined in Pantry.Storage |
type PackageNameId = Key PackageName Source #
data PackageName Source #
Instances
migrateAll :: Migration Source #
getPackageNameById :: PackageNameId -> ReaderT SqlBackend (RIO env) (Maybe PackageName) Source #
getPackageNameId :: PackageName -> ReaderT SqlBackend (RIO env) PackageNameId Source #
getVersionId :: Version -> ReaderT SqlBackend (RIO env) VersionId Source #
loadBlobById :: BlobId -> ReaderT SqlBackend (RIO env) ByteString Source #
Arguments
:: HasResourceMap env | |
=> Maybe BlobId | For some x, yield blob whose id>x. |
-> ConduitT () (BlobId, ByteString) (ReaderT SqlBackend (RIO env)) () |
allBlobsCount :: Maybe BlobId -> ReaderT SqlBackend (RIO env) Int Source #
getBlobKey :: BlobId -> ReaderT SqlBackend (RIO env) BlobKey Source #
getTreeForKey :: TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree)) Source #
data HackageTarballResult Source #
Information returned by getHackageTarball
Since: 0.1.0.0
Constructors
HackageTarballResult | |
Fields
|
forceUpdateHackageIndex :: (HasPantryConfig env, HasLogFunc env) => Maybe Utf8Builder -> RIO env DidUpdateOccur Source #
Same as updateHackageIndex
, but force the database update even if hackage
security tells that there is no change. This can be useful in order to make
sure the database is in sync with the locally downloaded tarball
Since: 0.1.0.0
getHackageTarball :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) => PackageIdentifierRevision -> Maybe TreeKey -> RIO env HackageTarballResult Source #