{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Array.Accelerate.LLVM.Native.Plugin.BuildInfo
where
import Module
import Data.Map ( Map )
import Data.Serialize
import System.Directory
import System.FilePath
import qualified Data.ByteString as B
import qualified Data.Map as Map
import Data.Array.Accelerate.Error
mkBuildInfoFileName :: FilePath -> FilePath
mkBuildInfoFileName :: FilePath -> FilePath
mkBuildInfoFileName FilePath
path = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
"accelerate-llvm-native.buildinfo"
readBuildInfo :: HasCallStack => FilePath -> IO (Map Module [FilePath])
readBuildInfo :: FilePath -> IO (Map Module [FilePath])
readBuildInfo FilePath
path = do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
path
if Bool -> Bool
not Bool
exists
then Map Module [FilePath] -> IO (Map Module [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return Map Module [FilePath]
forall k a. Map k a
Map.empty
else do
ByteString
f <- FilePath -> IO ByteString
B.readFile FilePath
path
case ByteString -> Either FilePath (Map Module [FilePath])
forall a. Serialize a => ByteString -> Either FilePath a
decode ByteString
f of
Left FilePath
err -> FilePath -> IO (Map Module [FilePath])
forall a. HasCallStack => FilePath -> a
internalError FilePath
err
Right Map Module [FilePath]
m -> Map Module [FilePath] -> IO (Map Module [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return Map Module [FilePath]
m
writeBuildInfo :: FilePath -> Map Module [FilePath] -> IO ()
writeBuildInfo :: FilePath -> Map Module [FilePath] -> IO ()
writeBuildInfo FilePath
path Map Module [FilePath]
objs = FilePath -> ByteString -> IO ()
B.writeFile FilePath
path (Map Module [FilePath] -> ByteString
forall a. Serialize a => a -> ByteString
encode Map Module [FilePath]
objs)
instance Serialize Module where
put :: Putter Module
put (Module UnitId
p ModuleName
n) = Putter UnitId
forall t. Serialize t => Putter t
put UnitId
p PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter ModuleName
forall t. Serialize t => Putter t
put ModuleName
n
get :: Get Module
get = do
UnitId
p <- Get UnitId
forall t. Serialize t => Get t
get
ModuleName
n <- Get ModuleName
forall t. Serialize t => Get t
get
Module -> Get Module
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId -> ModuleName -> Module
Module UnitId
p ModuleName
n)
instance Serialize UnitId where
put :: Putter UnitId
put UnitId
u = Putter FilePath
forall t. Serialize t => Putter t
put (UnitId -> FilePath
unitIdString UnitId
u)
get :: Get UnitId
get = FilePath -> UnitId
stringToUnitId (FilePath -> UnitId) -> Get FilePath -> Get UnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get FilePath
forall t. Serialize t => Get t
get
instance Serialize ModuleName where
put :: Putter ModuleName
put ModuleName
m = Putter FilePath
forall t. Serialize t => Putter t
put (ModuleName -> FilePath
moduleNameString ModuleName
m)
get :: Get ModuleName
get = FilePath -> ModuleName
mkModuleName (FilePath -> ModuleName) -> Get FilePath -> Get ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get FilePath
forall t. Serialize t => Get t
get