1{-# LANGUAGE TemplateHaskell #-} 2{-# LANGUAGE CPP #-} 3{-# LANGUAGE OverloadedStrings #-} 4-- | This module uses template Haskell. Following is a simplified explanation of usage for those unfamiliar with calling Template Haskell functions. 5-- 6-- The function @embedFile@ in this modules embeds a file into the executable 7-- that you can use it at runtime. A file is represented as a @ByteString@. 8-- However, as you can see below, the type signature indicates a value of type 9-- @Q Exp@ will be returned. In order to convert this into a @ByteString@, you 10-- must use Template Haskell syntax, e.g.: 11-- 12-- > $(embedFile "myfile.txt") 13-- 14-- This expression will have type @ByteString@. Be certain to enable the 15-- TemplateHaskell language extension, usually by adding the following to the 16-- top of your module: 17-- 18-- > {-# LANGUAGE TemplateHaskell #-} 19module Data.FileEmbed 20 ( -- * Embed at compile time 21 embedFile 22 , embedFileIfExists 23 , embedOneFileOf 24 , embedDir 25 , embedDirListing 26 , getDir 27 -- * Embed as a IsString 28 , embedStringFile 29 , embedOneStringFileOf 30 -- * Inject into an executable 31 -- $inject 32#if MIN_VERSION_template_haskell(2,5,0) 33 , dummySpace 34 , dummySpaceWith 35#endif 36 , inject 37 , injectFile 38 , injectWith 39 , injectFileWith 40 -- * Relative path manipulation 41 , makeRelativeToProject 42 -- * Internal 43 , stringToBs 44 , bsToExp 45 , strToExp 46 ) where 47 48import Language.Haskell.TH.Syntax 49 ( Exp (AppE, ListE, LitE, TupE, SigE, VarE) 50 , Lit (..) 51 , Q 52 , runIO 53 , qLocation, loc_filename 54#if MIN_VERSION_template_haskell(2,7,0) 55 , Quasi(qAddDependentFile) 56#endif 57 ) 58#if MIN_VERSION_template_haskell(2,16,0) 59import Language.Haskell.TH ( mkBytes, bytesPrimL ) 60import qualified Data.ByteString.Internal as B 61#endif 62import System.Directory (doesDirectoryExist, doesFileExist, 63 getDirectoryContents, canonicalizePath) 64import Control.Exception (throw, tryJust, ErrorCall(..)) 65import Control.Monad (filterM, guard) 66import qualified Data.ByteString as B 67import qualified Data.ByteString.Char8 as B8 68import Control.Arrow ((&&&), second) 69import Control.Applicative ((<$>)) 70import Data.ByteString.Unsafe (unsafePackAddressLen) 71import System.IO.Error (isDoesNotExistError) 72import System.IO.Unsafe (unsafePerformIO) 73import System.FilePath ((</>), takeDirectory, takeExtension) 74import Data.String (fromString) 75import Prelude as P 76import Data.List (sortBy) 77import Data.Ord (comparing) 78 79-- | Embed a single file in your source code. 80-- 81-- > import qualified Data.ByteString 82-- > 83-- > myFile :: Data.ByteString.ByteString 84-- > myFile = $(embedFile "dirName/fileName") 85embedFile :: FilePath -> Q Exp 86embedFile fp = 87#if MIN_VERSION_template_haskell(2,7,0) 88 qAddDependentFile fp >> 89#endif 90 (runIO $ B.readFile fp) >>= bsToExp 91 92-- | Maybe embed a single file in your source code depending on whether or not file exists. 93-- 94-- Warning: When a build is compiled with the file missing, a recompile when the file exists might not trigger an embed of the file. 95-- You might try to fix this by doing a clean build. 96-- 97-- > import qualified Data.ByteString 98-- > 99-- > maybeMyFile :: Maybe Data.ByteString.ByteString 100-- > maybeMyFile = $(embedFileIfExists "dirName/fileName") 101-- 102-- @since 0.0.14.0 103embedFileIfExists :: FilePath -> Q Exp 104embedFileIfExists fp = do 105 mbs <- runIO maybeFile 106 case mbs of 107 Nothing -> [| Nothing |] 108 Just bs -> do 109#if MIN_VERSION_template_haskell(2,7,0) 110 qAddDependentFile fp 111#endif 112 [| Just $(bsToExp bs) |] 113 where 114 maybeFile :: IO (Maybe B.ByteString) 115 maybeFile = 116 either (const Nothing) Just <$> 117 tryJust (guard . isDoesNotExistError) (B.readFile fp) 118 119-- | Embed a single existing file in your source code 120-- out of list a list of paths supplied. 121-- 122-- > import qualified Data.ByteString 123-- > 124-- > myFile :: Data.ByteString.ByteString 125-- > myFile = $(embedOneFileOf [ "dirName/fileName", "src/dirName/fileName" ]) 126embedOneFileOf :: [FilePath] -> Q Exp 127embedOneFileOf ps = 128 (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do 129#if MIN_VERSION_template_haskell(2,7,0) 130 qAddDependentFile path 131#endif 132 bsToExp content 133 where 134 readExistingFile :: [FilePath] -> IO ( FilePath, B.ByteString ) 135 readExistingFile xs = do 136 ys <- filterM doesFileExist xs 137 case ys of 138 (p:_) -> B.readFile p >>= \ c -> return ( p, c ) 139 _ -> throw $ ErrorCall "Cannot find file to embed as resource" 140 141-- | Embed a directory recursively in your source code. 142-- 143-- > import qualified Data.ByteString 144-- > 145-- > myDir :: [(FilePath, Data.ByteString.ByteString)] 146-- > myDir = $(embedDir "dirName") 147embedDir :: FilePath -> Q Exp 148embedDir fp = do 149 typ <- [t| [(FilePath, B.ByteString)] |] 150 e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp)) 151 return $ SigE e typ 152 153-- | Embed a directory listing recursively in your source code. 154-- 155-- > myFiles :: [FilePath] 156-- > myFiles = $(embedDirListing "dirName") 157-- 158-- @since 0.0.11 159embedDirListing :: FilePath -> Q Exp 160embedDirListing fp = do 161 typ <- [t| [FilePath] |] 162 e <- ListE <$> ((runIO $ fmap fst <$> fileList fp) >>= mapM strToExp) 163 return $ SigE e typ 164 165-- | Get a directory tree in the IO monad. 166-- 167-- This is the workhorse of 'embedDir' 168getDir :: FilePath -> IO [(FilePath, B.ByteString)] 169getDir = fileList 170 171pairToExp :: FilePath -> (FilePath, B.ByteString) -> Q Exp 172pairToExp _root (path, bs) = do 173#if MIN_VERSION_template_haskell(2,7,0) 174 qAddDependentFile $ _root ++ '/' : path 175#endif 176 exp' <- bsToExp bs 177 return $! TupE 178#if MIN_VERSION_template_haskell(2,16,0) 179 $ map Just 180#endif 181 [LitE $ StringL path, exp'] 182 183bsToExp :: B.ByteString -> Q Exp 184#if MIN_VERSION_template_haskell(2, 5, 0) 185bsToExp bs = 186 return $ VarE 'unsafePerformIO 187 `AppE` (VarE 'unsafePackAddressLen 188 `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs) 189#if MIN_VERSION_template_haskell(2, 16, 0) 190 `AppE` LitE (bytesPrimL ( 191 let B.PS ptr off sz = bs 192 in mkBytes ptr (fromIntegral off) (fromIntegral sz)))) 193#elif MIN_VERSION_template_haskell(2, 8, 0) 194 `AppE` LitE (StringPrimL $ B.unpack bs)) 195#else 196 `AppE` LitE (StringPrimL $ B8.unpack bs)) 197#endif 198#else 199bsToExp bs = do 200 helper <- [| stringToBs |] 201 let chars = B8.unpack bs 202 return $! AppE helper $! LitE $! StringL chars 203#endif 204 205stringToBs :: String -> B.ByteString 206stringToBs = B8.pack 207 208-- | Embed a single file in your source code. 209-- 210-- > import Data.String 211-- > 212-- > myFile :: IsString a => a 213-- > myFile = $(embedStringFile "dirName/fileName") 214-- 215-- Since 0.0.9 216embedStringFile :: FilePath -> Q Exp 217embedStringFile fp = 218#if MIN_VERSION_template_haskell(2,7,0) 219 qAddDependentFile fp >> 220#endif 221 (runIO $ P.readFile fp) >>= strToExp 222 223-- | Embed a single existing string file in your source code 224-- out of list a list of paths supplied. 225-- 226-- Since 0.0.9 227embedOneStringFileOf :: [FilePath] -> Q Exp 228embedOneStringFileOf ps = 229 (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do 230#if MIN_VERSION_template_haskell(2,7,0) 231 qAddDependentFile path 232#endif 233 strToExp content 234 where 235 readExistingFile :: [FilePath] -> IO ( FilePath, String ) 236 readExistingFile xs = do 237 ys <- filterM doesFileExist xs 238 case ys of 239 (p:_) -> P.readFile p >>= \ c -> return ( p, c ) 240 _ -> throw $ ErrorCall "Cannot find file to embed as resource" 241 242strToExp :: String -> Q Exp 243#if MIN_VERSION_template_haskell(2, 5, 0) 244strToExp s = 245 return $ VarE 'fromString 246 `AppE` LitE (StringL s) 247#else 248strToExp s = do 249 helper <- [| fromString |] 250 return $! AppE helper $! LitE $! StringL s 251#endif 252 253notHidden :: FilePath -> Bool 254notHidden ('.':_) = False 255notHidden _ = True 256 257fileList :: FilePath -> IO [(FilePath, B.ByteString)] 258fileList top = fileList' top "" 259 260fileList' :: FilePath -> FilePath -> IO [(FilePath, B.ByteString)] 261fileList' realTop top = do 262 allContents <- filter notHidden <$> getDirectoryContents (realTop </> top) 263 let all' = map ((top </>) &&& (\x -> realTop </> top </> x)) allContents 264 files <- filterM (doesFileExist . snd) all' >>= 265 mapM (liftPair2 . second B.readFile) 266 dirs <- filterM (doesDirectoryExist . snd) all' >>= 267 mapM (fileList' realTop . fst) 268 return $ sortBy (comparing fst) $ concat $ files : dirs 269 270liftPair2 :: Monad m => (a, m b) -> m (a, b) 271liftPair2 (a, b) = b >>= \b' -> return (a, b') 272 273magic :: B.ByteString -> B.ByteString 274magic x = B8.concat ["fe", x] 275 276sizeLen :: Int 277sizeLen = 20 278 279getInner :: B.ByteString -> B.ByteString 280getInner b = 281 let (sizeBS, rest) = B.splitAt sizeLen b 282 in case reads $ B8.unpack sizeBS of 283 (i, _):_ -> B.take i rest 284 [] -> error "Data.FileEmbed (getInner): Your dummy space has been corrupted." 285 286padSize :: Int -> String 287padSize i = 288 let s = show i 289 in replicate (sizeLen - length s) '0' ++ s 290 291#if MIN_VERSION_template_haskell(2,5,0) 292-- | Allocate the given number of bytes in the generate executable. That space 293-- can be filled up with the 'inject' and 'injectFile' functions. 294dummySpace :: Int -> Q Exp 295dummySpace = dummySpaceWith "MS" 296 297-- | Like 'dummySpace', but takes a postfix for the magic string. In 298-- order for this to work, the same postfix must be used by 'inject' / 299-- 'injectFile'. This allows an executable to have multiple 300-- 'ByteString's injected into it, without encountering collisions. 301-- 302-- Since 0.0.8 303dummySpaceWith :: B.ByteString -> Int -> Q Exp 304dummySpaceWith postfix space = do 305 let size = padSize space 306 magic' = magic postfix 307 start = B8.unpack magic' ++ size 308 magicLen = B8.length magic' 309 len = magicLen + sizeLen + space 310 chars = LitE $ StringPrimL $ 311#if MIN_VERSION_template_haskell(2,6,0) 312 map (toEnum . fromEnum) $ 313#endif 314 start ++ replicate space '0' 315 [| getInner (B.drop magicLen (unsafePerformIO (unsafePackAddressLen len $(return chars)))) |] 316#endif 317 318-- | Inject some raw data inside a @ByteString@ containing empty, dummy space 319-- (allocated with @dummySpace@). Typically, the original @ByteString@ is an 320-- executable read from the filesystem. 321inject :: B.ByteString -- ^ bs to inject 322 -> B.ByteString -- ^ original BS containing dummy 323 -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space 324inject = injectWith "MS" 325 326-- | Like 'inject', but takes a postfix for the magic string. 327-- 328-- Since 0.0.8 329injectWith :: B.ByteString -- ^ postfix of magic string 330 -> B.ByteString -- ^ bs to inject 331 -> B.ByteString -- ^ original BS containing dummy 332 -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space 333injectWith postfix toInj orig = 334 if toInjL > size 335 then Nothing 336 else Just $ B.concat [before, magic', B8.pack $ padSize toInjL, toInj, B8.pack $ replicate (size - toInjL) '0', after] 337 where 338 magic' = magic postfix 339 toInjL = B.length toInj 340 (before, rest) = B.breakSubstring magic' orig 341 (sizeBS, rest') = B.splitAt sizeLen $ B.drop (B8.length magic') rest 342 size = case reads $ B8.unpack sizeBS of 343 (i, _):_ -> i 344 [] -> error $ "Data.FileEmbed (inject): Your dummy space has been corrupted. Size is: " ++ show sizeBS 345 after = B.drop size rest' 346 347-- | Same as 'inject', but instead of performing the injecting in memory, read 348-- the contents from the filesystem and write back to a different file on the 349-- filesystem. 350injectFile :: B.ByteString -- ^ bs to inject 351 -> FilePath -- ^ template file 352 -> FilePath -- ^ output file 353 -> IO () 354injectFile = injectFileWith "MS" 355 356-- | Like 'injectFile', but takes a postfix for the magic string. 357-- 358-- Since 0.0.8 359injectFileWith :: B.ByteString -- ^ postfix of magic string 360 -> B.ByteString -- ^ bs to inject 361 -> FilePath -- ^ template file 362 -> FilePath -- ^ output file 363 -> IO () 364injectFileWith postfix inj srcFP dstFP = do 365 src <- B.readFile srcFP 366 case injectWith postfix inj src of 367 Nothing -> error "Insufficient dummy space" 368 Just dst -> B.writeFile dstFP dst 369 370{- $inject 371 372The inject system allows arbitrary content to be embedded inside a Haskell 373executable, post compilation. Typically, file-embed allows you to read some 374contents from the file system at compile time and embed them inside your 375executable. Consider a case, instead, where you would want to embed these 376contents after compilation. Two real-world examples are: 377 378* You would like to embed a hash of the executable itself, for sanity checking in a network protocol. (Obviously the hash will change after you embed the hash.) 379 380* You want to create a self-contained web server that has a set of content, but will need to update the content on machines that do not have access to GHC. 381 382The typical workflow use: 383 384* Use 'dummySpace' or 'dummySpaceWith' to create some empty space in your executable 385 386* Use 'injectFile' or 'injectFileWith' from a separate utility to modify that executable to have the updated content. 387 388The reason for the @With@-variant of the functions is for cases where you wish 389to inject multiple different kinds of content, and therefore need control over 390the magic key. If you know for certain that there will only be one dummy space 391available, you can use the non-@With@ variants. 392 393-} 394 395-- | Take a relative file path and attach it to the root of the current 396-- project. 397-- 398-- The idea here is that, when building with Stack, the build will always be 399-- executed with a current working directory of the root of the project (where 400-- your .cabal file is located). However, if you load up multiple projects with 401-- @stack ghci@, the working directory may be something else entirely. 402-- 403-- This function looks at the source location of the Haskell file calling it, 404-- finds the first parent directory with a .cabal file, and uses that as the 405-- root directory for fixing the relative path. 406-- 407-- @$(makeRelativeToProject "data/foo.txt" >>= embedFile)@ 408-- 409-- @since 0.0.10 410makeRelativeToProject :: FilePath -> Q FilePath 411makeRelativeToProject rel = do 412 loc <- qLocation 413 runIO $ do 414 srcFP <- canonicalizePath $ loc_filename loc 415 mdir <- findProjectDir srcFP 416 case mdir of 417 Nothing -> error $ "Could not find .cabal file for path: " ++ srcFP 418 Just dir -> return $ dir </> rel 419 where 420 findProjectDir x = do 421 let dir = takeDirectory x 422 if dir == x 423 then return Nothing 424 else do 425 contents <- getDirectoryContents dir 426 if any isCabalFile contents 427 then return (Just dir) 428 else findProjectDir dir 429 430 isCabalFile fp = takeExtension fp == ".cabal" 431