{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, CPP #-}
module CabalHelper.Compiletime.Data where
import Control.Monad
import Control.Monad.IO.Class
import Data.Digest.Pure.SHA
import Data.Functor
import Data.List
import qualified Data.ByteString as BS
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.UTF8 as LUTF8
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (addDependentFile)
import System.Directory
import System.FilePath
import System.IO.Temp
import System.PosixCompat.Files
import System.PosixCompat.Time
import System.PosixCompat.Types
import Prelude
import CabalHelper.Compiletime.Compat.Environment
withSystemTempDirectoryEnv :: String -> (FilePath -> IO b) -> IO b
withSystemTempDirectoryEnv :: String -> (String -> IO b) -> IO b
withSystemTempDirectoryEnv String
tpl String -> IO b
f = do
Maybe String
m <- IO (Maybe String) -> IO (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
"CABAL_HELPER_KEEP_SOURCEDIR"
case Maybe String
m of
Maybe String
Nothing -> String -> (String -> IO b) -> IO b
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
tpl String -> IO b
f
Just String
_ -> do
String
tmpdir <- IO String
getCanonicalTemporaryDirectory
String -> IO b
f (String -> IO b) -> IO String -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> IO String
createTempDirectory String
tmpdir String
tpl
createHelperSources :: FilePath -> IO ()
createHelperSources :: String -> IO ()
createHelperSources String
dir = do
let chdir :: String
chdir = String
dir String -> String -> String
</> String
"CabalHelper"
IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
chdir String -> String -> String
</> String
"Runtime"
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
chdir String -> String -> String
</> String
"Shared"
let modtime :: EpochTime
modtime :: EpochTime
modtime = Integer -> EpochTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> EpochTime) -> Integer -> EpochTime
forall a b. (a -> b) -> a -> b
$ (String -> Integer
forall a. Read a => String -> a
read :: String -> Integer)
$(runIO $ do
msde :: Maybe Integer
<- fmap read <$> lookupEnv "SOURCE_DATE_EPOCH"
(current_time :: Integer) <- round . toRational <$> epochTime
return $ LitE . StringL $ show $ maybe current_time id msde)
IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> ((String, String) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
sourceFiles (((String, String) -> IO ()) -> IO ())
-> ((String, String) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
fn, String
src) -> do
let path :: String
path = String
chdir String -> String -> String
</> String
fn
String -> ByteString -> IO ()
BS.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
UTF8.fromString String
src
String -> EpochTime -> EpochTime -> IO ()
setFileTimes String
path EpochTime
modtime EpochTime
modtime
sourceHash :: String
sourceHash :: String
sourceHash = (String, [(String, String)]) -> String
forall a b. (a, b) -> a
fst (String, [(String, String)])
runtimeSources
sourceFiles :: [(FilePath, String)]
sourceFiles :: [(String, String)]
sourceFiles = (String, [(String, String)]) -> [(String, String)]
forall a b. (a, b) -> b
snd (String, [(String, String)])
runtimeSources
runtimeSources :: (String, [(FilePath, FilePath)])
runtimeSources :: (String, [(String, String)])
runtimeSources = $(
let files = map (\f -> (f, ("src/CabalHelper" </> f))) $ sort $
[ ("Runtime/Main.hs")
, ("Runtime/HelperMain.hs")
, ("Runtime/Compat.hs")
, ("Shared/Common.hs")
, ("Shared/InterfaceTypes.hs")
]
in do
contents <- forM (map snd files) $ \lf -> do
addDependentFile lf
runIO (LBS.readFile lf)
let hashes = map (bytestringDigest . sha256) contents
let top_hash = showDigest $ sha256 $ LBS.concat hashes
let exprWrapper =
#if MIN_VERSION_template_haskell(2,16,0)
Just
#else
id
#endif
thfiles <- forM (map fst files `zip` contents) $ \(f, xs) -> do
return $ TupE [exprWrapper (LitE (StringL f)), exprWrapper (LitE (StringL (LUTF8.toString xs)))]
return $ TupE [exprWrapper (LitE (StringL top_hash)), exprWrapper (ListE thfiles)]
)