{-# 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