{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module GHC.Unit.Database
( GenericUnitInfo(..)
, type DbUnitInfo
, DbModule (..)
, DbInstUnitId (..)
, mapGenericUnitInfo
, DbMode(..)
, DbOpenMode(..)
, isDbOpenReadMode
, readPackageDbForGhc
, readPackageDbForGhcPkg
, writePackageDb
, PackageDbLock
, lockPackageDb
, unlockPackageDb
, mkMungePathUrl
, mungeUnitInfoPaths
)
where
import Prelude
import Data.Version (Version(..))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.Char8
import qualified Data.ByteString.Lazy as BS.Lazy
import qualified Data.ByteString.Lazy.Internal as BS.Lazy (defaultChunkSize)
import qualified Data.Foldable as F
import qualified Data.Traversable as F
import Data.Bifunctor
import Data.Binary as Bin
import Data.Binary.Put as Bin
import Data.Binary.Get as Bin
import Data.List (intersperse)
import Control.Exception as Exception
import Control.Monad (when)
import System.FilePath as FilePath
#if !defined(mingw32_HOST_OS)
import Data.Bits ((.|.))
import System.Posix.Files
import System.Posix.Types (FileMode)
#endif
import System.IO
import System.IO.Error
import GHC.IO.Exception (IOErrorType(InappropriateType))
import qualified GHC.Data.ShortText as ST
import GHC.IO.Handle.Lock
import System.Directory
type DbUnitInfo = GenericUnitInfo BS.ByteString BS.ByteString BS.ByteString BS.ByteString DbModule
data GenericUnitInfo srcpkgid srcpkgname uid modulename mod = GenericUnitInfo
{ forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitId :: uid
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitInstanceOf :: uid
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [(modulename, mod)]
unitInstantiations :: [(modulename, mod)]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> srcpkgid
unitPackageId :: srcpkgid
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName :: srcpkgname
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Version
unitPackageVersion :: Version
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> Maybe srcpkgname
unitComponentName :: Maybe srcpkgname
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShortText
unitAbiHash :: ST.ShortText
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> [uid]
unitDepends :: [uid]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [(uid, ShortText)]
unitAbiDepends :: [(uid, ST.ShortText)]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitImportDirs :: [FilePathST]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraries :: [ST.ShortText]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsSys :: [ST.ShortText]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsGhc :: [ST.ShortText]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDirs :: [FilePathST]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDynDirs :: [FilePathST]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworks :: [ST.ShortText]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworkDirs :: [FilePathST]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLinkerOptions :: [ST.ShortText]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitCcOptions :: [ST.ShortText]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludes :: [ST.ShortText]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludeDirs :: [FilePathST]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockInterfaces :: [FilePathST]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockHTMLs :: [FilePathST]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitExposedModules :: [(modulename, Maybe mod)]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [modulename]
unitHiddenModules :: [modulename]
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
unitIsIndefinite :: Bool
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
unitIsExposed :: Bool
, forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
unitIsTrusted :: Bool
}
deriving (GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
(GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool)
-> (GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool)
-> Eq (GenericUnitInfo srcpkgid srcpkgname uid modulename mod)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall srcpkgid srcpkgname uid modulename mod.
(Eq uid, Eq modulename, Eq mod, Eq srcpkgid, Eq srcpkgname) =>
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
$c== :: forall srcpkgid srcpkgname uid modulename mod.
(Eq uid, Eq modulename, Eq mod, Eq srcpkgid, Eq srcpkgname) =>
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
== :: GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
$c/= :: forall srcpkgid srcpkgname uid modulename mod.
(Eq uid, Eq modulename, Eq mod, Eq srcpkgid, Eq srcpkgname) =>
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
/= :: GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
Eq, Int
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShowS
[GenericUnitInfo srcpkgid srcpkgname uid modulename mod] -> ShowS
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> String
(Int
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShowS)
-> (GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> String)
-> ([GenericUnitInfo srcpkgid srcpkgname uid modulename mod]
-> ShowS)
-> Show (GenericUnitInfo srcpkgid srcpkgname uid modulename mod)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall srcpkgid srcpkgname uid modulename mod.
(Show uid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
Int
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShowS
forall srcpkgid srcpkgname uid modulename mod.
(Show uid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
[GenericUnitInfo srcpkgid srcpkgname uid modulename mod] -> ShowS
forall srcpkgid srcpkgname uid modulename mod.
(Show uid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> String
$cshowsPrec :: forall srcpkgid srcpkgname uid modulename mod.
(Show uid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
Int
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShowS
showsPrec :: Int
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShowS
$cshow :: forall srcpkgid srcpkgname uid modulename mod.
(Show uid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> String
show :: GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> String
$cshowList :: forall srcpkgid srcpkgname uid modulename mod.
(Show uid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
[GenericUnitInfo srcpkgid srcpkgname uid modulename mod] -> ShowS
showList :: [GenericUnitInfo srcpkgid srcpkgname uid modulename mod] -> ShowS
Show)
type FilePathST = ST.ShortText
mapGenericUnitInfo
:: (uid1 -> uid2)
-> (srcpkg1 -> srcpkg2)
-> (srcpkgname1 -> srcpkgname2)
-> (modname1 -> modname2)
-> (mod1 -> mod2)
-> (GenericUnitInfo srcpkg1 srcpkgname1 uid1 modname1 mod1
-> GenericUnitInfo srcpkg2 srcpkgname2 uid2 modname2 mod2)
mapGenericUnitInfo :: forall uid1 uid2 srcpkg1 srcpkg2 srcpkgname1 srcpkgname2 modname1
modname2 mod1 mod2.
(uid1 -> uid2)
-> (srcpkg1 -> srcpkg2)
-> (srcpkgname1 -> srcpkgname2)
-> (modname1 -> modname2)
-> (mod1 -> mod2)
-> GenericUnitInfo srcpkg1 srcpkgname1 uid1 modname1 mod1
-> GenericUnitInfo srcpkg2 srcpkgname2 uid2 modname2 mod2
mapGenericUnitInfo uid1 -> uid2
fuid srcpkg1 -> srcpkg2
fsrcpkg srcpkgname1 -> srcpkgname2
fsrcpkgname modname1 -> modname2
fmodname mod1 -> mod2
fmod g :: GenericUnitInfo srcpkg1 srcpkgname1 uid1 modname1 mod1
g@(GenericUnitInfo {uid1
srcpkg1
srcpkgname1
Bool
[uid1]
[modname1]
[(uid1, ShortText)]
[(modname1, mod1)]
[(modname1, Maybe mod1)]
[ShortText]
Maybe srcpkgname1
Version
ShortText
unitId :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitInstanceOf :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitInstantiations :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [(modulename, mod)]
unitPackageId :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> srcpkgid
unitPackageName :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageVersion :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Version
unitComponentName :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> Maybe srcpkgname
unitAbiHash :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShortText
unitDepends :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> [uid]
unitAbiDepends :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [(uid, ShortText)]
unitImportDirs :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraries :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsSys :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsGhc :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDirs :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDynDirs :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworks :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworkDirs :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLinkerOptions :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitCcOptions :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludes :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludeDirs :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockInterfaces :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockHTMLs :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExposedModules :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitHiddenModules :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [modulename]
unitIsIndefinite :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
unitIsExposed :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
unitIsTrusted :: forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
unitId :: uid1
unitInstanceOf :: uid1
unitInstantiations :: [(modname1, mod1)]
unitPackageId :: srcpkg1
unitPackageName :: srcpkgname1
unitPackageVersion :: Version
unitComponentName :: Maybe srcpkgname1
unitAbiHash :: ShortText
unitDepends :: [uid1]
unitAbiDepends :: [(uid1, ShortText)]
unitImportDirs :: [ShortText]
unitLibraries :: [ShortText]
unitExtDepLibsSys :: [ShortText]
unitExtDepLibsGhc :: [ShortText]
unitLibraryDirs :: [ShortText]
unitLibraryDynDirs :: [ShortText]
unitExtDepFrameworks :: [ShortText]
unitExtDepFrameworkDirs :: [ShortText]
unitLinkerOptions :: [ShortText]
unitCcOptions :: [ShortText]
unitIncludes :: [ShortText]
unitIncludeDirs :: [ShortText]
unitHaddockInterfaces :: [ShortText]
unitHaddockHTMLs :: [ShortText]
unitExposedModules :: [(modname1, Maybe mod1)]
unitHiddenModules :: [modname1]
unitIsIndefinite :: Bool
unitIsExposed :: Bool
unitIsTrusted :: Bool
..}) =
GenericUnitInfo srcpkg1 srcpkgname1 uid1 modname1 mod1
g { unitId :: uid2
unitId = uid1 -> uid2
fuid uid1
unitId
, unitInstanceOf :: uid2
unitInstanceOf = uid1 -> uid2
fuid uid1
unitInstanceOf
, unitInstantiations :: [(modname2, mod2)]
unitInstantiations = ((modname1, mod1) -> (modname2, mod2))
-> [(modname1, mod1)] -> [(modname2, mod2)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((modname1 -> modname2)
-> (mod1 -> mod2) -> (modname1, mod1) -> (modname2, mod2)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap modname1 -> modname2
fmodname mod1 -> mod2
fmod) [(modname1, mod1)]
unitInstantiations
, unitPackageId :: srcpkg2
unitPackageId = srcpkg1 -> srcpkg2
fsrcpkg srcpkg1
unitPackageId
, unitPackageName :: srcpkgname2
unitPackageName = srcpkgname1 -> srcpkgname2
fsrcpkgname srcpkgname1
unitPackageName
, unitComponentName :: Maybe srcpkgname2
unitComponentName = (srcpkgname1 -> srcpkgname2)
-> Maybe srcpkgname1 -> Maybe srcpkgname2
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap srcpkgname1 -> srcpkgname2
fsrcpkgname Maybe srcpkgname1
unitComponentName
, unitDepends :: [uid2]
unitDepends = (uid1 -> uid2) -> [uid1] -> [uid2]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap uid1 -> uid2
fuid [uid1]
unitDepends
, unitAbiDepends :: [(uid2, ShortText)]
unitAbiDepends = ((uid1, ShortText) -> (uid2, ShortText))
-> [(uid1, ShortText)] -> [(uid2, ShortText)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((uid1 -> uid2) -> (uid1, ShortText) -> (uid2, ShortText)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first uid1 -> uid2
fuid) [(uid1, ShortText)]
unitAbiDepends
, unitExposedModules :: [(modname2, Maybe mod2)]
unitExposedModules = ((modname1, Maybe mod1) -> (modname2, Maybe mod2))
-> [(modname1, Maybe mod1)] -> [(modname2, Maybe mod2)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((modname1 -> modname2)
-> (Maybe mod1 -> Maybe mod2)
-> (modname1, Maybe mod1)
-> (modname2, Maybe mod2)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap modname1 -> modname2
fmodname ((mod1 -> mod2) -> Maybe mod1 -> Maybe mod2
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap mod1 -> mod2
fmod)) [(modname1, Maybe mod1)]
unitExposedModules
, unitHiddenModules :: [modname2]
unitHiddenModules = (modname1 -> modname2) -> [modname1] -> [modname2]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap modname1 -> modname2
fmodname [modname1]
unitHiddenModules
}
data DbModule
= DbModule
{ DbModule -> DbInstUnitId
dbModuleUnitId :: DbInstUnitId
, DbModule -> ByteString
dbModuleName :: BS.ByteString
}
| DbModuleVar
{ DbModule -> ByteString
dbModuleVarName :: BS.ByteString
}
deriving (DbModule -> DbModule -> Bool
(DbModule -> DbModule -> Bool)
-> (DbModule -> DbModule -> Bool) -> Eq DbModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DbModule -> DbModule -> Bool
== :: DbModule -> DbModule -> Bool
$c/= :: DbModule -> DbModule -> Bool
/= :: DbModule -> DbModule -> Bool
Eq, Int -> DbModule -> ShowS
[DbModule] -> ShowS
DbModule -> String
(Int -> DbModule -> ShowS)
-> (DbModule -> String) -> ([DbModule] -> ShowS) -> Show DbModule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DbModule -> ShowS
showsPrec :: Int -> DbModule -> ShowS
$cshow :: DbModule -> String
show :: DbModule -> String
$cshowList :: [DbModule] -> ShowS
showList :: [DbModule] -> ShowS
Show)
data DbInstUnitId
= DbInstUnitId
BS.ByteString
[(BS.ByteString, DbModule)]
| DbUnitId
BS.ByteString
deriving (DbInstUnitId -> DbInstUnitId -> Bool
(DbInstUnitId -> DbInstUnitId -> Bool)
-> (DbInstUnitId -> DbInstUnitId -> Bool) -> Eq DbInstUnitId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DbInstUnitId -> DbInstUnitId -> Bool
== :: DbInstUnitId -> DbInstUnitId -> Bool
$c/= :: DbInstUnitId -> DbInstUnitId -> Bool
/= :: DbInstUnitId -> DbInstUnitId -> Bool
Eq, Int -> DbInstUnitId -> ShowS
[DbInstUnitId] -> ShowS
DbInstUnitId -> String
(Int -> DbInstUnitId -> ShowS)
-> (DbInstUnitId -> String)
-> ([DbInstUnitId] -> ShowS)
-> Show DbInstUnitId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DbInstUnitId -> ShowS
showsPrec :: Int -> DbInstUnitId -> ShowS
$cshow :: DbInstUnitId -> String
show :: DbInstUnitId -> String
$cshowList :: [DbInstUnitId] -> ShowS
showList :: [DbInstUnitId] -> ShowS
Show)
newtype PackageDbLock = PackageDbLock Handle
lockPackageDb :: FilePath -> IO PackageDbLock
unlockPackageDb :: PackageDbLock -> IO ()
lockPackageDbWith :: LockMode -> FilePath -> IO PackageDbLock
lockPackageDbWith :: LockMode -> String -> IO PackageDbLock
lockPackageDbWith LockMode
mode String
file = do
(IOError -> Maybe ())
-> IO PackageDbLock -> (() -> IO PackageDbLock) -> IO PackageDbLock
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust
(\IOError
e -> if IOError -> Bool
isPermissionError IOError
e then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing)
(IOMode -> IO PackageDbLock
lockFileOpenIn IOMode
ReadWriteMode)
(IO PackageDbLock -> () -> IO PackageDbLock
forall a b. a -> b -> a
const (IO PackageDbLock -> () -> IO PackageDbLock)
-> IO PackageDbLock -> () -> IO PackageDbLock
forall a b. (a -> b) -> a -> b
$ IOMode -> IO PackageDbLock
lockFileOpenIn IOMode
ReadMode)
where
lock :: String
lock = String
file String -> ShowS
<.> String
"lock"
lockFileOpenIn :: IOMode -> IO PackageDbLock
lockFileOpenIn IOMode
io_mode = IO Handle
-> (Handle -> IO ())
-> (Handle -> IO PackageDbLock)
-> IO PackageDbLock
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
(String -> IOMode -> IO Handle
openBinaryFile String
lock IOMode
io_mode)
Handle -> IO ()
hClose
((Handle -> IO PackageDbLock) -> IO PackageDbLock)
-> (Handle -> IO PackageDbLock) -> IO PackageDbLock
forall a b. (a -> b) -> a -> b
$ \Handle
hnd -> do Handle -> LockMode -> IO ()
hLock Handle
hnd LockMode
mode IO () -> (FileLockingNotSupported -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \FileLockingNotSupported
FileLockingNotSupported -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
PackageDbLock -> IO PackageDbLock
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDbLock -> IO PackageDbLock)
-> PackageDbLock -> IO PackageDbLock
forall a b. (a -> b) -> a -> b
$ Handle -> PackageDbLock
PackageDbLock Handle
hnd
lockPackageDb :: String -> IO PackageDbLock
lockPackageDb = LockMode -> String -> IO PackageDbLock
lockPackageDbWith LockMode
ExclusiveLock
unlockPackageDb :: PackageDbLock -> IO ()
unlockPackageDb (PackageDbLock Handle
hnd) = do
Handle -> IO ()
hUnlock Handle
hnd
Handle -> IO ()
hClose Handle
hnd
data DbMode = DbReadOnly | DbReadWrite
data DbOpenMode (mode :: DbMode) t where
DbOpenReadOnly :: DbOpenMode 'DbReadOnly t
DbOpenReadWrite :: t -> DbOpenMode 'DbReadWrite t
deriving instance Functor (DbOpenMode mode)
deriving instance F.Foldable (DbOpenMode mode)
deriving instance F.Traversable (DbOpenMode mode)
isDbOpenReadMode :: DbOpenMode mode t -> Bool
isDbOpenReadMode :: forall (mode :: DbMode) a. DbOpenMode mode a -> Bool
isDbOpenReadMode = \case
DbOpenMode mode t
DbOpenReadOnly -> Bool
True
DbOpenReadWrite{} -> Bool
False
readPackageDbForGhc :: FilePath -> IO [DbUnitInfo]
readPackageDbForGhc :: String -> IO [DbUnitInfo]
readPackageDbForGhc String
file =
String
-> DbOpenMode 'DbReadOnly Any
-> Get [DbUnitInfo]
-> IO ([DbUnitInfo], DbOpenMode 'DbReadOnly PackageDbLock)
forall (mode :: DbMode) t pkgs.
String
-> DbOpenMode mode t
-> Get pkgs
-> IO (pkgs, DbOpenMode mode PackageDbLock)
decodeFromFile String
file DbOpenMode 'DbReadOnly Any
forall t. DbOpenMode 'DbReadOnly t
DbOpenReadOnly Get [DbUnitInfo]
getDbForGhc IO ([DbUnitInfo], DbOpenMode 'DbReadOnly PackageDbLock)
-> (([DbUnitInfo], DbOpenMode 'DbReadOnly PackageDbLock)
-> IO [DbUnitInfo])
-> IO [DbUnitInfo]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
([DbUnitInfo]
pkgs, DbOpenMode 'DbReadOnly PackageDbLock
DbOpenReadOnly) -> [DbUnitInfo] -> IO [DbUnitInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DbUnitInfo]
pkgs
where
getDbForGhc :: Get [DbUnitInfo]
getDbForGhc = do
(Word32, Word32)
_version <- Get (Word32, Word32)
getHeader
Word32
_ghcPartLen <- Get Word32
forall t. Binary t => Get t
get :: Get Word32
[DbUnitInfo]
ghcPart <- Get [DbUnitInfo]
forall t. Binary t => Get t
get
[DbUnitInfo] -> Get [DbUnitInfo]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return [DbUnitInfo]
ghcPart
readPackageDbForGhcPkg :: Binary pkgs => FilePath -> DbOpenMode mode t ->
IO (pkgs, DbOpenMode mode PackageDbLock)
readPackageDbForGhcPkg :: forall pkgs (mode :: DbMode) t.
Binary pkgs =>
String
-> DbOpenMode mode t -> IO (pkgs, DbOpenMode mode PackageDbLock)
readPackageDbForGhcPkg String
file DbOpenMode mode t
mode =
String
-> DbOpenMode mode t
-> Get pkgs
-> IO (pkgs, DbOpenMode mode PackageDbLock)
forall (mode :: DbMode) t pkgs.
String
-> DbOpenMode mode t
-> Get pkgs
-> IO (pkgs, DbOpenMode mode PackageDbLock)
decodeFromFile String
file DbOpenMode mode t
mode Get pkgs
getDbForGhcPkg
where
getDbForGhcPkg :: Get pkgs
getDbForGhcPkg = do
(Word32, Word32)
_version <- Get (Word32, Word32)
getHeader
Word32
ghcPartLen <- Get Word32
forall t. Binary t => Get t
get :: Get Word32
()
_ghcPart <- Int -> Get ()
skip (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ghcPartLen)
pkgs
ghcPkgPart <- Get pkgs
forall t. Binary t => Get t
get
pkgs -> Get pkgs
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return pkgs
ghcPkgPart
writePackageDb :: Binary pkgs => FilePath -> [DbUnitInfo] -> pkgs -> IO ()
writePackageDb :: forall pkgs. Binary pkgs => String -> [DbUnitInfo] -> pkgs -> IO ()
writePackageDb String
file [DbUnitInfo]
ghcPkgs pkgs
ghcPkgPart = do
String -> ByteString -> IO ()
writeFileAtomic String
file (Put -> ByteString
runPut Put
putDbForGhcPkg)
#if !defined(mingw32_HOST_OS)
String -> FileMode -> IO ()
addFileMode String
file FileMode
0o444
#endif
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
putDbForGhcPkg :: Put
putDbForGhcPkg = do
Put
putHeader
Word32 -> Put
forall t. Binary t => t -> Put
put Word32
ghcPartLen
ByteString -> Put
putLazyByteString ByteString
ghcPart
pkgs -> Put
forall t. Binary t => t -> Put
put pkgs
ghcPkgPart
where
ghcPartLen :: Word32
ghcPartLen :: Word32
ghcPartLen = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BS.Lazy.length ByteString
ghcPart)
ghcPart :: ByteString
ghcPart = [DbUnitInfo] -> ByteString
forall a. Binary a => a -> ByteString
encode [DbUnitInfo]
ghcPkgs
#if !defined(mingw32_HOST_OS)
addFileMode :: FilePath -> FileMode -> IO ()
addFileMode :: String -> FileMode -> IO ()
addFileMode String
file FileMode
m = do
FileMode
o <- FileStatus -> FileMode
fileMode (FileStatus -> FileMode) -> IO FileStatus -> IO FileMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO FileStatus
getFileStatus String
file
String -> FileMode -> IO ()
setFileMode String
file (FileMode
m FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
o)
#endif
getHeader :: Get (Word32, Word32)
= do
ByteString
magic <- Int -> Get ByteString
getByteString (ByteString -> Int
BS.length ByteString
headerMagic)
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
magic ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
headerMagic) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a ghc-pkg db file, wrong file magic number"
Word32
majorVersion <- Get Word32
forall t. Binary t => Get t
get :: Get Word32
Word32
minorVersion <- Get Word32
forall t. Binary t => Get t
get :: Get Word32
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
majorVersion Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
1) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unsupported ghc-pkg db format version"
Word32
headerExtraLen <- Get Word32
forall t. Binary t => Get t
get :: Get Word32
Int -> Get ()
skip (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
headerExtraLen)
(Word32, Word32) -> Get (Word32, Word32)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
majorVersion, Word32
minorVersion)
putHeader :: Put
= do
ByteString -> Put
putByteString ByteString
headerMagic
Word32 -> Put
forall t. Binary t => t -> Put
put Word32
majorVersion
Word32 -> Put
forall t. Binary t => t -> Put
put Word32
minorVersion
Word32 -> Put
forall t. Binary t => t -> Put
put Word32
headerExtraLen
where
majorVersion :: Word32
majorVersion = Word32
1 :: Word32
minorVersion :: Word32
minorVersion = Word32
0 :: Word32
headerExtraLen :: Word32
headerExtraLen = Word32
0 :: Word32
headerMagic :: BS.ByteString
= String -> ByteString
BS.Char8.pack String
"\0ghcpkg\0"
decodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs ->
IO (pkgs, DbOpenMode mode PackageDbLock)
decodeFromFile :: forall (mode :: DbMode) t pkgs.
String
-> DbOpenMode mode t
-> Get pkgs
-> IO (pkgs, DbOpenMode mode PackageDbLock)
decodeFromFile String
file DbOpenMode mode t
mode Get pkgs
decoder = case DbOpenMode mode t
mode of
DbOpenMode mode t
DbOpenReadOnly -> do
#if defined(mingw32_HOST_OS)
bracket (lockPackageDbWith SharedLock file) unlockPackageDb $ \_ -> do
#endif
(, DbOpenMode 'DbReadOnly PackageDbLock
forall t. DbOpenMode 'DbReadOnly t
DbOpenReadOnly) (pkgs -> (pkgs, DbOpenMode mode PackageDbLock))
-> IO pkgs -> IO (pkgs, DbOpenMode mode PackageDbLock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO pkgs
decodeFileContents
DbOpenReadWrite{} -> do
IO PackageDbLock
-> (PackageDbLock -> IO ())
-> (PackageDbLock -> IO (pkgs, DbOpenMode mode PackageDbLock))
-> IO (pkgs, DbOpenMode mode PackageDbLock)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError (String -> IO PackageDbLock
lockPackageDb String
file) PackageDbLock -> IO ()
unlockPackageDb ((PackageDbLock -> IO (pkgs, DbOpenMode mode PackageDbLock))
-> IO (pkgs, DbOpenMode mode PackageDbLock))
-> (PackageDbLock -> IO (pkgs, DbOpenMode mode PackageDbLock))
-> IO (pkgs, DbOpenMode mode PackageDbLock)
forall a b. (a -> b) -> a -> b
$ \PackageDbLock
lock -> do
(, PackageDbLock -> DbOpenMode 'DbReadWrite PackageDbLock
forall t. t -> DbOpenMode 'DbReadWrite t
DbOpenReadWrite PackageDbLock
lock) (pkgs -> (pkgs, DbOpenMode mode PackageDbLock))
-> IO pkgs -> IO (pkgs, DbOpenMode mode PackageDbLock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO pkgs
decodeFileContents
where
decodeFileContents :: IO pkgs
decodeFileContents = String -> IOMode -> (Handle -> IO pkgs) -> IO pkgs
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
file IOMode
ReadMode ((Handle -> IO pkgs) -> IO pkgs) -> (Handle -> IO pkgs) -> IO pkgs
forall a b. (a -> b) -> a -> b
$ \Handle
hnd ->
Handle -> Decoder pkgs -> IO pkgs
feed Handle
hnd (Get pkgs -> Decoder pkgs
forall a. Get a -> Decoder a
runGetIncremental Get pkgs
decoder)
feed :: Handle -> Decoder pkgs -> IO pkgs
feed Handle
hnd (Partial Maybe ByteString -> Decoder pkgs
k) = do ByteString
chunk <- Handle -> Int -> IO ByteString
BS.hGet Handle
hnd Int
BS.Lazy.defaultChunkSize
if ByteString -> Bool
BS.null ByteString
chunk
then Handle -> Decoder pkgs -> IO pkgs
feed Handle
hnd (Maybe ByteString -> Decoder pkgs
k Maybe ByteString
forall a. Maybe a
Nothing)
else Handle -> Decoder pkgs -> IO pkgs
feed Handle
hnd (Maybe ByteString -> Decoder pkgs
k (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
chunk))
feed Handle
_ (Done ByteString
_ Int64
_ pkgs
res) = pkgs -> IO pkgs
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return pkgs
res
feed Handle
_ (Fail ByteString
_ Int64
_ String
msg) = IOError -> IO pkgs
forall a. IOError -> IO a
ioError IOError
err
where
err :: IOError
err = IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
InappropriateType String
loc Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
file)
IOError -> String -> IOError
`ioeSetErrorString` String
msg
loc :: String
loc = String
"GHC.Unit.Database.readPackageDb"
writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()
writeFileAtomic :: String -> ByteString -> IO ()
writeFileAtomic String
targetPath ByteString
content = do
let (String
targetDir, String
targetFile) = String -> (String, String)
splitFileName String
targetPath
IO (String, Handle)
-> ((String, Handle) -> IO ())
-> ((String, Handle) -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracketOnError
(String -> String -> IO (String, Handle)
openBinaryTempFileWithDefaultPermissions String
targetDir (String -> IO (String, Handle)) -> String -> IO (String, Handle)
forall a b. (a -> b) -> a -> b
$ String
targetFile String -> ShowS
<.> String
"tmp")
(\(String
tmpPath, Handle
handle) -> Handle -> IO ()
hClose Handle
handle IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
removeFile String
tmpPath)
(\(String
tmpPath, Handle
handle) -> do
Handle -> ByteString -> IO ()
BS.Lazy.hPut Handle
handle ByteString
content
Handle -> IO ()
hClose Handle
handle
String -> String -> IO ()
renameFile String
tmpPath String
targetPath)
instance Binary DbUnitInfo where
put :: DbUnitInfo -> Put
put (GenericUnitInfo
ByteString
unitId ByteString
unitInstanceOf [(ByteString, DbModule)]
unitInstantiations
ByteString
unitPackageId
ByteString
unitPackageName Version
unitPackageVersion
Maybe ByteString
unitComponentName
ShortText
unitAbiHash [ByteString]
unitDepends [(ByteString, ShortText)]
unitAbiDepends [ShortText]
unitImportDirs
[ShortText]
unitLibraries [ShortText]
unitExtDepLibsSys [ShortText]
unitExtDepLibsGhc
[ShortText]
unitLibraryDirs [ShortText]
unitLibraryDynDirs
[ShortText]
unitExtDepFrameworks [ShortText]
unitExtDepFrameworkDirs
[ShortText]
unitLinkerOptions [ShortText]
unitCcOptions
[ShortText]
unitIncludes [ShortText]
unitIncludeDirs
[ShortText]
unitHaddockInterfaces [ShortText]
unitHaddockHTMLs
[(ByteString, Maybe DbModule)]
unitExposedModules [ByteString]
unitHiddenModules
Bool
unitIsIndefinite Bool
unitIsExposed Bool
unitIsTrusted) = do
ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
unitPackageId
ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
unitPackageName
Version -> Put
forall t. Binary t => t -> Put
put Version
unitPackageVersion
Maybe ByteString -> Put
forall t. Binary t => t -> Put
put Maybe ByteString
unitComponentName
ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
unitId
ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
unitInstanceOf
[(ByteString, DbModule)] -> Put
forall t. Binary t => t -> Put
put [(ByteString, DbModule)]
unitInstantiations
ShortText -> Put
forall t. Binary t => t -> Put
put ShortText
unitAbiHash
[ByteString] -> Put
forall t. Binary t => t -> Put
put [ByteString]
unitDepends
[(ByteString, ShortText)] -> Put
forall t. Binary t => t -> Put
put [(ByteString, ShortText)]
unitAbiDepends
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitImportDirs
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitLibraries
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitExtDepLibsSys
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitExtDepLibsGhc
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitLibraryDirs
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitLibraryDynDirs
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitExtDepFrameworks
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitExtDepFrameworkDirs
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitLinkerOptions
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitCcOptions
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitIncludes
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitIncludeDirs
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitHaddockInterfaces
[ShortText] -> Put
forall t. Binary t => t -> Put
put [ShortText]
unitHaddockHTMLs
[(ByteString, Maybe DbModule)] -> Put
forall t. Binary t => t -> Put
put [(ByteString, Maybe DbModule)]
unitExposedModules
[ByteString] -> Put
forall t. Binary t => t -> Put
put [ByteString]
unitHiddenModules
Bool -> Put
forall t. Binary t => t -> Put
put Bool
unitIsIndefinite
Bool -> Put
forall t. Binary t => t -> Put
put Bool
unitIsExposed
Bool -> Put
forall t. Binary t => t -> Put
put Bool
unitIsTrusted
get :: Get DbUnitInfo
get = do
ByteString
unitPackageId <- Get ByteString
forall t. Binary t => Get t
get
ByteString
unitPackageName <- Get ByteString
forall t. Binary t => Get t
get
Version
unitPackageVersion <- Get Version
forall t. Binary t => Get t
get
Maybe ByteString
unitComponentName <- Get (Maybe ByteString)
forall t. Binary t => Get t
get
ByteString
unitId <- Get ByteString
forall t. Binary t => Get t
get
ByteString
unitInstanceOf <- Get ByteString
forall t. Binary t => Get t
get
[(ByteString, DbModule)]
unitInstantiations <- Get [(ByteString, DbModule)]
forall t. Binary t => Get t
get
ShortText
unitAbiHash <- Get ShortText
forall t. Binary t => Get t
get
[ByteString]
unitDepends <- Get [ByteString]
forall t. Binary t => Get t
get
[(ByteString, ShortText)]
unitAbiDepends <- Get [(ByteString, ShortText)]
forall t. Binary t => Get t
get
[ShortText]
unitImportDirs <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
unitLibraries <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
unitExtDepLibsSys <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
unitExtDepLibsGhc <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
libraryDirs <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
libraryDynDirs <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
frameworks <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
frameworkDirs <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
unitLinkerOptions <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
unitCcOptions <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
unitIncludes <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
unitIncludeDirs <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
unitHaddockInterfaces <- Get [ShortText]
forall t. Binary t => Get t
get
[ShortText]
unitHaddockHTMLs <- Get [ShortText]
forall t. Binary t => Get t
get
[(ByteString, Maybe DbModule)]
unitExposedModules <- Get [(ByteString, Maybe DbModule)]
forall t. Binary t => Get t
get
[ByteString]
unitHiddenModules <- Get [ByteString]
forall t. Binary t => Get t
get
Bool
unitIsIndefinite <- Get Bool
forall t. Binary t => Get t
get
Bool
unitIsExposed <- Get Bool
forall t. Binary t => Get t
get
Bool
unitIsTrusted <- Get Bool
forall t. Binary t => Get t
get
DbUnitInfo -> Get DbUnitInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
-> ByteString
-> [(ByteString, DbModule)]
-> ByteString
-> ByteString
-> Version
-> Maybe ByteString
-> ShortText
-> [ByteString]
-> [(ByteString, ShortText)]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [(ByteString, Maybe DbModule)]
-> [ByteString]
-> Bool
-> Bool
-> Bool
-> DbUnitInfo
forall srcpkgid srcpkgname uid modulename mod.
uid
-> uid
-> [(modulename, mod)]
-> srcpkgid
-> srcpkgname
-> Version
-> Maybe srcpkgname
-> ShortText
-> [uid]
-> [(uid, ShortText)]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [ShortText]
-> [(modulename, Maybe mod)]
-> [modulename]
-> Bool
-> Bool
-> Bool
-> GenericUnitInfo srcpkgid srcpkgname uid modulename mod
GenericUnitInfo
ByteString
unitId
ByteString
unitInstanceOf
[(ByteString, DbModule)]
unitInstantiations
ByteString
unitPackageId
ByteString
unitPackageName
Version
unitPackageVersion
Maybe ByteString
unitComponentName
ShortText
unitAbiHash
[ByteString]
unitDepends
[(ByteString, ShortText)]
unitAbiDepends
[ShortText]
unitImportDirs
[ShortText]
unitLibraries [ShortText]
unitExtDepLibsSys [ShortText]
unitExtDepLibsGhc
[ShortText]
libraryDirs [ShortText]
libraryDynDirs
[ShortText]
frameworks [ShortText]
frameworkDirs
[ShortText]
unitLinkerOptions [ShortText]
unitCcOptions
[ShortText]
unitIncludes [ShortText]
unitIncludeDirs
[ShortText]
unitHaddockInterfaces [ShortText]
unitHaddockHTMLs
[(ByteString, Maybe DbModule)]
unitExposedModules
[ByteString]
unitHiddenModules
Bool
unitIsIndefinite Bool
unitIsExposed Bool
unitIsTrusted)
instance Binary DbModule where
put :: DbModule -> Put
put (DbModule DbInstUnitId
dbModuleUnitId ByteString
dbModuleName) = do
Word8 -> Put
putWord8 Word8
0
DbInstUnitId -> Put
forall t. Binary t => t -> Put
put DbInstUnitId
dbModuleUnitId
ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
dbModuleName
put (DbModuleVar ByteString
dbModuleVarName) = do
Word8 -> Put
putWord8 Word8
1
ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
dbModuleVarName
get :: Get DbModule
get = do
Word8
b <- Get Word8
getWord8
case Word8
b of
Word8
0 -> DbInstUnitId -> ByteString -> DbModule
DbModule (DbInstUnitId -> ByteString -> DbModule)
-> Get DbInstUnitId -> Get (ByteString -> DbModule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get DbInstUnitId
forall t. Binary t => Get t
get Get (ByteString -> DbModule) -> Get ByteString -> Get DbModule
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
forall t. Binary t => Get t
get
Word8
_ -> ByteString -> DbModule
DbModuleVar (ByteString -> DbModule) -> Get ByteString -> Get DbModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
forall t. Binary t => Get t
get
instance Binary DbInstUnitId where
put :: DbInstUnitId -> Put
put (DbUnitId ByteString
uid) = do
Word8 -> Put
putWord8 Word8
0
ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
uid
put (DbInstUnitId ByteString
dbUnitIdComponentId [(ByteString, DbModule)]
dbUnitIdInsts) = do
Word8 -> Put
putWord8 Word8
1
ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
dbUnitIdComponentId
[(ByteString, DbModule)] -> Put
forall t. Binary t => t -> Put
put [(ByteString, DbModule)]
dbUnitIdInsts
get :: Get DbInstUnitId
get = do
Word8
b <- Get Word8
getWord8
case Word8
b of
Word8
0 -> ByteString -> DbInstUnitId
DbUnitId (ByteString -> DbInstUnitId) -> Get ByteString -> Get DbInstUnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
forall t. Binary t => Get t
get
Word8
_ -> ByteString -> [(ByteString, DbModule)] -> DbInstUnitId
DbInstUnitId (ByteString -> [(ByteString, DbModule)] -> DbInstUnitId)
-> Get ByteString -> Get ([(ByteString, DbModule)] -> DbInstUnitId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
forall t. Binary t => Get t
get Get ([(ByteString, DbModule)] -> DbInstUnitId)
-> Get [(ByteString, DbModule)] -> Get DbInstUnitId
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [(ByteString, DbModule)]
forall t. Binary t => Get t
get
mkMungePathUrl :: FilePathST -> FilePathST -> (FilePathST -> FilePathST, FilePathST -> FilePathST)
mkMungePathUrl :: ShortText
-> ShortText -> (ShortText -> ShortText, ShortText -> ShortText)
mkMungePathUrl ShortText
top_dir ShortText
pkgroot = (ShortText -> ShortText
munge_path, ShortText -> ShortText
munge_url)
where
munge_path :: ShortText -> ShortText
munge_path ShortText
p
| Just ShortText
p' <- ShortText -> ShortText -> Maybe ShortText
stripVarPrefix ShortText
"${pkgroot}" ShortText
p = ShortText -> ShortText -> ShortText
forall a. Monoid a => a -> a -> a
mappend ShortText
pkgroot ShortText
p'
| Just ShortText
p' <- ShortText -> ShortText -> Maybe ShortText
stripVarPrefix ShortText
"$topdir" ShortText
p = ShortText -> ShortText -> ShortText
forall a. Monoid a => a -> a -> a
mappend ShortText
top_dir ShortText
p'
| Bool
otherwise = ShortText
p
munge_url :: ShortText -> ShortText
munge_url ShortText
p
| Just ShortText
p' <- ShortText -> ShortText -> Maybe ShortText
stripVarPrefix ShortText
"${pkgrooturl}" ShortText
p = ShortText -> ShortText -> ShortText
toUrlPath ShortText
pkgroot ShortText
p'
| Just ShortText
p' <- ShortText -> ShortText -> Maybe ShortText
stripVarPrefix ShortText
"$httptopdir" ShortText
p = ShortText -> ShortText -> ShortText
toUrlPath ShortText
top_dir ShortText
p'
| Bool
otherwise = ShortText
p
toUrlPath :: ShortText -> ShortText -> ShortText
toUrlPath ShortText
r ShortText
p = [ShortText] -> ShortText
forall a. Monoid a => [a] -> a
mconcat ([ShortText] -> ShortText) -> [ShortText] -> ShortText
forall a b. (a -> b) -> a -> b
$ ShortText
"file:///" ShortText -> [ShortText] -> [ShortText]
forall a. a -> [a] -> [a]
: (ShortText -> [ShortText] -> [ShortText]
forall a. a -> [a] -> [a]
intersperse ShortText
"/" (ShortText
r ShortText -> [ShortText] -> [ShortText]
forall a. a -> [a] -> [a]
: (ShortText -> [ShortText]
splitDirectories ShortText
p)))
splitDirectories :: FilePathST -> [FilePathST]
splitDirectories :: ShortText -> [ShortText]
splitDirectories ShortText
p = (ShortText -> Bool) -> [ShortText] -> [ShortText]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ShortText -> Bool) -> ShortText -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Bool
ST.null) ([ShortText] -> [ShortText]) -> [ShortText] -> [ShortText]
forall a b. (a -> b) -> a -> b
$ ShortText -> [ShortText]
ST.splitFilePath ShortText
p
stripVarPrefix :: ShortText -> ShortText -> Maybe ShortText
stripVarPrefix ShortText
var ShortText
path = case ShortText -> ShortText -> Maybe ShortText
ST.stripPrefix ShortText
var ShortText
path of
Just ShortText
"" -> ShortText -> Maybe ShortText
forall a. a -> Maybe a
Just ShortText
""
Just ShortText
cs | Char -> Bool
isPathSeparator (ShortText -> Char
ST.head ShortText
cs) -> ShortText -> Maybe ShortText
forall a. a -> Maybe a
Just ShortText
cs
Maybe ShortText
_ -> Maybe ShortText
forall a. Maybe a
Nothing
mungeUnitInfoPaths :: FilePathST -> FilePathST -> GenericUnitInfo a b c d e -> GenericUnitInfo a b c d e
mungeUnitInfoPaths :: forall a b c d e.
ShortText
-> ShortText
-> GenericUnitInfo a b c d e
-> GenericUnitInfo a b c d e
mungeUnitInfoPaths ShortText
top_dir ShortText
pkgroot GenericUnitInfo a b c d e
pkg =
GenericUnitInfo a b c d e
pkg
{ unitImportDirs :: [ShortText]
unitImportDirs = [ShortText] -> [ShortText]
munge_paths (GenericUnitInfo a b c d e -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitImportDirs GenericUnitInfo a b c d e
pkg)
, unitIncludeDirs :: [ShortText]
unitIncludeDirs = [ShortText] -> [ShortText]
munge_paths (GenericUnitInfo a b c d e -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludeDirs GenericUnitInfo a b c d e
pkg)
, unitLibraryDirs :: [ShortText]
unitLibraryDirs = [ShortText] -> [ShortText]
munge_paths (GenericUnitInfo a b c d e -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDirs GenericUnitInfo a b c d e
pkg)
, unitLibraryDynDirs :: [ShortText]
unitLibraryDynDirs = [ShortText] -> [ShortText]
munge_paths (GenericUnitInfo a b c d e -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDynDirs GenericUnitInfo a b c d e
pkg)
, unitExtDepFrameworkDirs :: [ShortText]
unitExtDepFrameworkDirs = [ShortText] -> [ShortText]
munge_paths (GenericUnitInfo a b c d e -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworkDirs GenericUnitInfo a b c d e
pkg)
, unitHaddockInterfaces :: [ShortText]
unitHaddockInterfaces = [ShortText] -> [ShortText]
munge_paths (GenericUnitInfo a b c d e -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockInterfaces GenericUnitInfo a b c d e
pkg)
, unitHaddockHTMLs :: [ShortText]
unitHaddockHTMLs = [ShortText] -> [ShortText]
munge_paths ([ShortText] -> [ShortText]
munge_urls (GenericUnitInfo a b c d e -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockHTMLs GenericUnitInfo a b c d e
pkg))
}
where
munge_paths :: [ShortText] -> [ShortText]
munge_paths = (ShortText -> ShortText) -> [ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> ShortText
munge_path
munge_urls :: [ShortText] -> [ShortText]
munge_urls = (ShortText -> ShortText) -> [ShortText] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> ShortText
munge_url
(ShortText -> ShortText
munge_path,ShortText -> ShortText
munge_url) = ShortText
-> ShortText -> (ShortText -> ShortText, ShortText -> ShortText)
mkMungePathUrl ShortText
top_dir ShortText
pkgroot