{-# 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 System.Posix.Files
import GHC.IO.Exception (ioe_type, IOErrorType(NoSuchThing))
#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 BS.ByteString DbModule
data GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod = GenericUnitInfo
{ forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId :: uid
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> compid
unitInstanceOf :: compid
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, mod)]
unitInstantiations :: [(modulename, mod)]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgid
unitPackageId :: srcpkgid
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName :: srcpkgname
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Version
unitPackageVersion :: Version
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Maybe srcpkgname
unitComponentName :: Maybe srcpkgname
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> ShortText
unitAbiHash :: ST.ShortText
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [uid]
unitDepends :: [uid]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(uid, ShortText)]
unitAbiDepends :: [(uid, ST.ShortText)]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitImportDirs :: [FilePathST]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraries :: [ST.ShortText]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsSys :: [ST.ShortText]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsGhc :: [ST.ShortText]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDirs :: [FilePathST]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDynDirs :: [FilePathST]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworks :: [ST.ShortText]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworkDirs :: [FilePathST]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLinkerOptions :: [ST.ShortText]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitCcOptions :: [ST.ShortText]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludes :: [ST.ShortText]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludeDirs :: [FilePathST]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockInterfaces :: [FilePathST]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockHTMLs :: [FilePathST]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitExposedModules :: [(modulename, Maybe mod)]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [modulename]
unitHiddenModules :: [modulename]
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsIndefinite :: Bool
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsExposed :: Bool
, forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsTrusted :: Bool
}
deriving (GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall compid srcpkgid srcpkgname uid modulename mod.
(Eq uid, Eq compid, Eq modulename, Eq mod, Eq srcpkgid,
Eq srcpkgname) =>
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
/= :: GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
$c/= :: forall compid srcpkgid srcpkgname uid modulename mod.
(Eq uid, Eq compid, Eq modulename, Eq mod, Eq srcpkgid,
Eq srcpkgname) =>
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
== :: GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
$c== :: forall compid srcpkgid srcpkgname uid modulename mod.
(Eq uid, Eq compid, Eq modulename, Eq mod, Eq srcpkgid,
Eq srcpkgname) =>
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
Eq, Int
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall compid srcpkgid srcpkgname uid modulename mod.
(Show uid, Show compid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
Int
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> ShowS
forall compid srcpkgid srcpkgname uid modulename mod.
(Show uid, Show compid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
[GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod]
-> ShowS
forall compid srcpkgid srcpkgname uid modulename mod.
(Show uid, Show compid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> String
showList :: [GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod]
-> ShowS
$cshowList :: forall compid srcpkgid srcpkgname uid modulename mod.
(Show uid, Show compid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
[GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod]
-> ShowS
show :: GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> String
$cshow :: forall compid srcpkgid srcpkgname uid modulename mod.
(Show uid, Show compid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> String
showsPrec :: Int
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> ShowS
$cshowsPrec :: forall compid srcpkgid srcpkgname uid modulename mod.
(Show uid, Show compid, Show modulename, Show mod, Show srcpkgid,
Show srcpkgname) =>
Int
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> ShowS
Show)
type FilePathST = ST.ShortText
mapGenericUnitInfo
:: (uid1 -> uid2)
-> (cid1 -> cid2)
-> (srcpkg1 -> srcpkg2)
-> (srcpkgname1 -> srcpkgname2)
-> (modname1 -> modname2)
-> (mod1 -> mod2)
-> (GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1
-> GenericUnitInfo cid2 srcpkg2 srcpkgname2 uid2 modname2 mod2)
mapGenericUnitInfo :: forall uid1 uid2 cid1 cid2 srcpkg1 srcpkg2 srcpkgname1 srcpkgname2
modname1 modname2 mod1 mod2.
(uid1 -> uid2)
-> (cid1 -> cid2)
-> (srcpkg1 -> srcpkg2)
-> (srcpkgname1 -> srcpkgname2)
-> (modname1 -> modname2)
-> (mod1 -> mod2)
-> GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1
-> GenericUnitInfo cid2 srcpkg2 srcpkgname2 uid2 modname2 mod2
mapGenericUnitInfo uid1 -> uid2
fuid cid1 -> cid2
fcid srcpkg1 -> srcpkg2
fsrcpkg srcpkgname1 -> srcpkgname2
fsrcpkgname modname1 -> modname2
fmodname mod1 -> mod2
fmod g :: GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1
g@(GenericUnitInfo {uid1
cid1
srcpkg1
srcpkgname1
Bool
[uid1]
[modname1]
[(uid1, ShortText)]
[(modname1, mod1)]
[(modname1, Maybe mod1)]
[ShortText]
Maybe srcpkgname1
Version
ShortText
unitIsTrusted :: Bool
unitIsExposed :: Bool
unitIsIndefinite :: Bool
unitHiddenModules :: [modname1]
unitExposedModules :: [(modname1, Maybe mod1)]
unitHaddockHTMLs :: [ShortText]
unitHaddockInterfaces :: [ShortText]
unitIncludeDirs :: [ShortText]
unitIncludes :: [ShortText]
unitCcOptions :: [ShortText]
unitLinkerOptions :: [ShortText]
unitExtDepFrameworkDirs :: [ShortText]
unitExtDepFrameworks :: [ShortText]
unitLibraryDynDirs :: [ShortText]
unitLibraryDirs :: [ShortText]
unitExtDepLibsGhc :: [ShortText]
unitExtDepLibsSys :: [ShortText]
unitLibraries :: [ShortText]
unitImportDirs :: [ShortText]
unitAbiDepends :: [(uid1, ShortText)]
unitDepends :: [uid1]
unitAbiHash :: ShortText
unitComponentName :: Maybe srcpkgname1
unitPackageVersion :: Version
unitPackageName :: srcpkgname1
unitPackageId :: srcpkg1
unitInstantiations :: [(modname1, mod1)]
unitInstanceOf :: cid1
unitId :: uid1
unitIsTrusted :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsExposed :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsIndefinite :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitHiddenModules :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [modulename]
unitExposedModules :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitHaddockHTMLs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockInterfaces :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludeDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludes :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitCcOptions :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLinkerOptions :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworkDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworks :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDynDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsGhc :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsSys :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraries :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitImportDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitAbiDepends :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(uid, ShortText)]
unitDepends :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [uid]
unitAbiHash :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> ShortText
unitComponentName :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Maybe srcpkgname
unitPackageVersion :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Version
unitPackageName :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageId :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgid
unitInstantiations :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, mod)]
unitInstanceOf :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> compid
unitId :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
..}) =
GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1
g { unitId :: uid2
unitId = uid1 -> uid2
fuid uid1
unitId
, unitInstanceOf :: cid2
unitInstanceOf = cid1 -> cid2
fcid cid1
unitInstanceOf
, unitInstantiations :: [(modname2, mod2)]
unitInstantiations = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap srcpkgname1 -> srcpkgname2
fsrcpkgname Maybe srcpkgname1
unitComponentName
, unitDepends :: [uid2]
unitDepends = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap uid1 -> uid2
fuid [uid1]
unitDepends
, unitAbiDepends :: [(uid2, ShortText)]
unitAbiDepends = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap modname1 -> modname2
fmodname (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap mod1 -> mod2
fmod)) [(modname1, Maybe mod1)]
unitExposedModules
, unitHiddenModules :: [modname2]
unitHiddenModules = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DbModule -> DbModule -> Bool
$c/= :: DbModule -> DbModule -> Bool
== :: DbModule -> DbModule -> Bool
$c== :: DbModule -> DbModule -> Bool
Eq, Int -> DbModule -> ShowS
[DbModule] -> ShowS
DbModule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DbModule] -> ShowS
$cshowList :: [DbModule] -> ShowS
show :: DbModule -> String
$cshow :: DbModule -> String
showsPrec :: Int -> DbModule -> ShowS
$cshowsPrec :: Int -> DbModule -> ShowS
Show)
data DbInstUnitId
= DbInstUnitId
BS.ByteString
[(BS.ByteString, DbModule)]
| DbUnitId
BS.ByteString
deriving (DbInstUnitId -> DbInstUnitId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DbInstUnitId -> DbInstUnitId -> Bool
$c/= :: DbInstUnitId -> DbInstUnitId -> Bool
== :: DbInstUnitId -> DbInstUnitId -> Bool
$c== :: DbInstUnitId -> DbInstUnitId -> Bool
Eq, Int -> DbInstUnitId -> ShowS
[DbInstUnitId] -> ShowS
DbInstUnitId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DbInstUnitId] -> ShowS
$cshowList :: [DbInstUnitId] -> ShowS
show :: DbInstUnitId -> String
$cshow :: DbInstUnitId -> String
showsPrec :: Int -> DbInstUnitId -> ShowS
$cshowsPrec :: Int -> 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
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 forall a. a -> Maybe a
Just () else forall a. Maybe a
Nothing)
(IOMode -> IO PackageDbLock
lockFileOpenIn IOMode
ReadWriteMode)
(forall a b. a -> b -> a
const 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 = 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
forall a b. (a -> b) -> a -> b
$ \Handle
hnd -> do Handle -> LockMode -> IO ()
hLock Handle
hnd LockMode
mode forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \FileLockingNotSupported
FileLockingNotSupported -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return 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 =
forall (mode :: DbMode) t pkgs.
String
-> DbOpenMode mode t
-> Get pkgs
-> IO (pkgs, DbOpenMode mode PackageDbLock)
decodeFromFile String
file forall t. DbOpenMode 'DbReadOnly t
DbOpenReadOnly Get [DbUnitInfo]
getDbForGhc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
([DbUnitInfo]
pkgs, DbOpenMode 'DbReadOnly PackageDbLock
DbOpenReadOnly) -> 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 <- forall t. Binary t => Get t
get :: Get Word32
[DbUnitInfo]
ghcPart <- forall t. Binary t => Get t
get
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 =
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 <- forall t. Binary t => Get t
get :: Get Word32
()
_ghcPart <- Int -> Get ()
skip (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ghcPartLen)
pkgs
ghcPkgPart <- forall t. Binary t => Get t
get
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 =
String -> ByteString -> IO ()
writeFileAtomic String
file (Put -> ByteString
runPut Put
putDbForGhcPkg)
where
putDbForGhcPkg :: Put
putDbForGhcPkg = do
Put
putHeader
forall t. Binary t => t -> Put
put Word32
ghcPartLen
ByteString -> Put
putLazyByteString ByteString
ghcPart
forall t. Binary t => t -> Put
put pkgs
ghcPkgPart
where
ghcPartLen :: Word32
ghcPartLen :: Word32
ghcPartLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BS.Lazy.length ByteString
ghcPart)
ghcPart :: ByteString
ghcPart = forall a. Binary a => a -> ByteString
encode [DbUnitInfo]
ghcPkgs
getHeader :: Get (Word32, Word32)
= do
ByteString
magic <- Int -> Get ByteString
getByteString (ByteString -> Int
BS.length ByteString
headerMagic)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
magic forall a. Eq a => a -> a -> Bool
/= ByteString
headerMagic) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a ghc-pkg db file, wrong file magic number"
Word32
majorVersion <- forall t. Binary t => Get t
get :: Get Word32
Word32
minorVersion <- forall t. Binary t => Get t
get :: Get Word32
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
majorVersion forall a. Eq a => a -> a -> Bool
/= Word32
1) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unsupported ghc-pkg db format version"
Word32
headerExtraLen <- forall t. Binary t => Get t
get :: Get Word32
Int -> Get ()
skip (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
headerExtraLen)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
majorVersion, Word32
minorVersion)
putHeader :: Put
= do
ByteString -> Put
putByteString ByteString
headerMagic
forall t. Binary t => t -> Put
put Word32
majorVersion
forall t. Binary t => t -> Put
put Word32
minorVersion
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
(, forall t. DbOpenMode 'DbReadOnly t
DbOpenReadOnly) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO pkgs
decodeFileContents
DbOpenReadWrite{} -> do
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError (String -> IO PackageDbLock
lockPackageDb String
file) PackageDbLock -> IO ()
unlockPackageDb forall a b. (a -> b) -> a -> b
$ \PackageDbLock
lock -> do
(, forall t. t -> DbOpenMode 'DbReadWrite t
DbOpenReadWrite PackageDbLock
lock) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO pkgs
decodeFileContents
where
decodeFileContents :: IO pkgs
decodeFileContents = forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
file IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
hnd ->
Handle -> Decoder pkgs -> IO pkgs
feed Handle
hnd (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 forall a. Maybe a
Nothing)
else Handle -> Decoder pkgs -> IO pkgs
feed Handle
hnd (Maybe ByteString -> Decoder pkgs
k (forall a. a -> Maybe a
Just ByteString
chunk))
feed Handle
_ (Done ByteString
_ Int64
_ pkgs
res) = forall (m :: * -> *) a. Monad m => a -> m a
return pkgs
res
feed Handle
_ (Fail ByteString
_ Int64
_ String
msg) = forall a. IOError -> IO a
ioError IOError
err
where
err :: IOError
err = IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
InappropriateType String
loc forall a. Maybe a
Nothing (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 no_update :: p -> m ()
no_update p
_path = forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if !defined(mingw32_HOST_OS)
let on_error :: IOError -> IO (p -> m ())
on_error IOError
ioe =
case IOError -> IOErrorType
ioe_type IOError
ioe of
IOErrorType
NoSuchThing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall {m :: * -> *} {p}. Monad m => p -> m ()
no_update
IOErrorType
_ -> forall a. IOError -> IO a
ioError IOError
ioe
let handleIO :: (IOException -> IO a) -> IO a -> IO a
handleIO :: forall a. (IOError -> IO a) -> IO a -> IO a
handleIO = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
String -> IO ()
set_metadata <- forall a. (IOError -> IO a) -> IO a -> IO a
handleIO forall {m :: * -> *} {p}. Monad m => IOError -> IO (p -> m ())
on_error forall a b. (a -> b) -> a -> b
$ do
FileStatus
status <- String -> IO FileStatus
getFileStatus String
targetPath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \String
path -> do
String -> FileMode -> IO ()
setFileMode String
path (FileStatus -> FileMode
fileMode FileStatus
status)
String -> UserID -> GroupID -> IO ()
setOwnerAndGroup String
path (FileStatus -> UserID
fileOwner FileStatus
status) (FileStatus -> GroupID
fileGroup FileStatus
status)
#else
let set_metadata = no_update
#endif
let (String
targetDir, String
targetFile) = String -> (String, String)
splitFileName String
targetPath
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracketOnError
(String -> String -> IO (String, Handle)
openBinaryTempFileWithDefaultPermissions String
targetDir forall a b. (a -> b) -> a -> b
$ String
targetFile String -> ShowS
<.> String
"tmp")
(\(String
tmpPath, Handle
handle) -> Handle -> IO ()
hClose Handle
handle 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 -> IO ()
set_metadata String
tmpPath
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
forall t. Binary t => t -> Put
put ByteString
unitPackageId
forall t. Binary t => t -> Put
put ByteString
unitPackageName
forall t. Binary t => t -> Put
put Version
unitPackageVersion
forall t. Binary t => t -> Put
put Maybe ByteString
unitComponentName
forall t. Binary t => t -> Put
put ByteString
unitId
forall t. Binary t => t -> Put
put ByteString
unitInstanceOf
forall t. Binary t => t -> Put
put [(ByteString, DbModule)]
unitInstantiations
forall t. Binary t => t -> Put
put ShortText
unitAbiHash
forall t. Binary t => t -> Put
put [ByteString]
unitDepends
forall t. Binary t => t -> Put
put [(ByteString, ShortText)]
unitAbiDepends
forall t. Binary t => t -> Put
put [ShortText]
unitImportDirs
forall t. Binary t => t -> Put
put [ShortText]
unitLibraries
forall t. Binary t => t -> Put
put [ShortText]
unitExtDepLibsSys
forall t. Binary t => t -> Put
put [ShortText]
unitExtDepLibsGhc
forall t. Binary t => t -> Put
put [ShortText]
unitLibraryDirs
forall t. Binary t => t -> Put
put [ShortText]
unitLibraryDynDirs
forall t. Binary t => t -> Put
put [ShortText]
unitExtDepFrameworks
forall t. Binary t => t -> Put
put [ShortText]
unitExtDepFrameworkDirs
forall t. Binary t => t -> Put
put [ShortText]
unitLinkerOptions
forall t. Binary t => t -> Put
put [ShortText]
unitCcOptions
forall t. Binary t => t -> Put
put [ShortText]
unitIncludes
forall t. Binary t => t -> Put
put [ShortText]
unitIncludeDirs
forall t. Binary t => t -> Put
put [ShortText]
unitHaddockInterfaces
forall t. Binary t => t -> Put
put [ShortText]
unitHaddockHTMLs
forall t. Binary t => t -> Put
put [(ByteString, Maybe DbModule)]
unitExposedModules
forall t. Binary t => t -> Put
put [ByteString]
unitHiddenModules
forall t. Binary t => t -> Put
put Bool
unitIsIndefinite
forall t. Binary t => t -> Put
put Bool
unitIsExposed
forall t. Binary t => t -> Put
put Bool
unitIsTrusted
get :: Get DbUnitInfo
get = do
ByteString
unitPackageId <- forall t. Binary t => Get t
get
ByteString
unitPackageName <- forall t. Binary t => Get t
get
Version
unitPackageVersion <- forall t. Binary t => Get t
get
Maybe ByteString
unitComponentName <- forall t. Binary t => Get t
get
ByteString
unitId <- forall t. Binary t => Get t
get
ByteString
unitInstanceOf <- forall t. Binary t => Get t
get
[(ByteString, DbModule)]
unitInstantiations <- forall t. Binary t => Get t
get
ShortText
unitAbiHash <- forall t. Binary t => Get t
get
[ByteString]
unitDepends <- forall t. Binary t => Get t
get
[(ByteString, ShortText)]
unitAbiDepends <- forall t. Binary t => Get t
get
[ShortText]
unitImportDirs <- forall t. Binary t => Get t
get
[ShortText]
unitLibraries <- forall t. Binary t => Get t
get
[ShortText]
unitExtDepLibsSys <- forall t. Binary t => Get t
get
[ShortText]
unitExtDepLibsGhc <- forall t. Binary t => Get t
get
[ShortText]
libraryDirs <- forall t. Binary t => Get t
get
[ShortText]
libraryDynDirs <- forall t. Binary t => Get t
get
[ShortText]
frameworks <- forall t. Binary t => Get t
get
[ShortText]
frameworkDirs <- forall t. Binary t => Get t
get
[ShortText]
unitLinkerOptions <- forall t. Binary t => Get t
get
[ShortText]
unitCcOptions <- forall t. Binary t => Get t
get
[ShortText]
unitIncludes <- forall t. Binary t => Get t
get
[ShortText]
unitIncludeDirs <- forall t. Binary t => Get t
get
[ShortText]
unitHaddockInterfaces <- forall t. Binary t => Get t
get
[ShortText]
unitHaddockHTMLs <- forall t. Binary t => Get t
get
[(ByteString, Maybe DbModule)]
unitExposedModules <- forall t. Binary t => Get t
get
[ByteString]
unitHiddenModules <- forall t. Binary t => Get t
get
Bool
unitIsIndefinite <- forall t. Binary t => Get t
get
Bool
unitIsExposed <- forall t. Binary t => Get t
get
Bool
unitIsTrusted <- forall t. Binary t => Get t
get
forall (m :: * -> *) a. Monad m => a -> m a
return (forall compid srcpkgid srcpkgname uid modulename mod.
uid
-> compid
-> [(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 compid 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
forall t. Binary t => t -> Put
put DbInstUnitId
dbModuleUnitId
forall t. Binary t => t -> Put
put ByteString
dbModuleName
put (DbModuleVar ByteString
dbModuleVarName) = do
Word8 -> Put
putWord8 Word8
1
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
Word8
_ -> ByteString -> DbModule
DbModuleVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
instance Binary DbInstUnitId where
put :: DbInstUnitId -> Put
put (DbUnitId ByteString
uid) = do
Word8 -> Put
putWord8 Word8
0
forall t. Binary t => t -> Put
put ByteString
uid
put (DbInstUnitId ByteString
dbUnitIdComponentId [(ByteString, DbModule)]
dbUnitIdInsts) = do
Word8 -> Put
putWord8 Word8
1
forall t. Binary t => t -> Put
put ByteString
dbUnitIdComponentId
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
Word8
_ -> ByteString -> [(ByteString, DbModule)] -> DbInstUnitId
DbInstUnitId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall a. Monoid a => a -> a -> a
mappend ShortText
pkgroot ShortText
p'
| Just ShortText
p' <- ShortText -> ShortText -> Maybe ShortText
stripVarPrefix ShortText
"$topdir" ShortText
p = 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 = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ ShortText
"file:///" forall a. a -> [a] -> [a]
: (forall a. a -> [a] -> [a]
intersperse ShortText
"/" (ShortText
r forall a. a -> [a] -> [a]
: (ShortText -> [ShortText]
splitDirectories ShortText
p)))
splitDirectories :: FilePathST -> [FilePathST]
splitDirectories :: ShortText -> [ShortText]
splitDirectories ShortText
p = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Bool
ST.null) 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
"" -> forall a. a -> Maybe a
Just ShortText
""
Just ShortText
cs | Char -> Bool
isPathSeparator (ShortText -> Char
ST.head ShortText
cs) -> forall a. a -> Maybe a
Just ShortText
cs
Maybe ShortText
_ -> forall a. Maybe a
Nothing
mungeUnitInfoPaths :: FilePathST -> FilePathST -> GenericUnitInfo a b c d e f -> GenericUnitInfo a b c d e f
mungeUnitInfoPaths :: forall a b c d e f.
ShortText
-> ShortText
-> GenericUnitInfo a b c d e f
-> GenericUnitInfo a b c d e f
mungeUnitInfoPaths ShortText
top_dir ShortText
pkgroot GenericUnitInfo a b c d e f
pkg =
GenericUnitInfo a b c d e f
pkg
{ unitImportDirs :: [ShortText]
unitImportDirs = [ShortText] -> [ShortText]
munge_paths (forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitImportDirs GenericUnitInfo a b c d e f
pkg)
, unitIncludeDirs :: [ShortText]
unitIncludeDirs = [ShortText] -> [ShortText]
munge_paths (forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludeDirs GenericUnitInfo a b c d e f
pkg)
, unitLibraryDirs :: [ShortText]
unitLibraryDirs = [ShortText] -> [ShortText]
munge_paths (forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDirs GenericUnitInfo a b c d e f
pkg)
, unitLibraryDynDirs :: [ShortText]
unitLibraryDynDirs = [ShortText] -> [ShortText]
munge_paths (forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDynDirs GenericUnitInfo a b c d e f
pkg)
, unitExtDepFrameworkDirs :: [ShortText]
unitExtDepFrameworkDirs = [ShortText] -> [ShortText]
munge_paths (forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworkDirs GenericUnitInfo a b c d e f
pkg)
, unitHaddockInterfaces :: [ShortText]
unitHaddockInterfaces = [ShortText] -> [ShortText]
munge_paths (forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockInterfaces GenericUnitInfo a b c d e f
pkg)
, unitHaddockHTMLs :: [ShortText]
unitHaddockHTMLs = [ShortText] -> [ShortText]
munge_paths ([ShortText] -> [ShortText]
munge_urls (forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockHTMLs GenericUnitInfo a b c d e f
pkg))
}
where
munge_paths :: [ShortText] -> [ShortText]
munge_paths = forall a b. (a -> b) -> [a] -> [b]
map ShortText -> ShortText
munge_path
munge_urls :: [ShortText] -> [ShortText]
munge_urls = 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