| Safe Haskell | None |
|---|
Data.FileEmbed
Description
This module uses template Haskell. Following is a simplified explanation of usage for those unfamiliar with calling Template Haskell functions.
The function embedFile in this modules embeds a file into the exceutable
that you can use it at runtime. A file is represented as a ByteString.
However, as you can see below, the type signature indicates a value of type
Q Exp will be returned. In order to convert this into a ByteString, you
must use Template Haskell syntax, e.g.:
$(embedFile "myfile.txt")
This expression will have type ByteString. Be certain to enable the
TemplateHaskell language extension, usually by adding the following to the
top of your module:
{-# LANGUAGE TemplateHaskell #-}
- embedFile :: FilePath -> Q Exp
- embedOneFileOf :: [FilePath] -> Q Exp
- embedDir :: FilePath -> Q Exp
- getDir :: FilePath -> IO [(FilePath, ByteString)]
- dummySpace :: Int -> Q Exp
- inject :: ByteString -> ByteString -> Maybe ByteString
- injectFile :: ByteString -> FilePath -> FilePath -> IO ()
- stringToBs :: String -> ByteString
Embed at compile time
embedFile :: FilePath -> Q ExpSource
Embed a single file in your source code.
import qualified Data.ByteString myFile :: Data.ByteString.ByteString myFile = $(embedFile "dirName/fileName")
embedOneFileOf :: [FilePath] -> Q ExpSource
Embed a single existing file in your source code out of list a list of paths supplied.
import qualified Data.ByteString myFile :: Data.ByteString.ByteString myFile = $(embedFile' [ "dirName/fileName", "src/dirName/fileName" ])
embedDir :: FilePath -> Q ExpSource
Embed a directory recursively in your source code.
import qualified Data.ByteString myDir :: [(FilePath, Data.ByteString.ByteString)] myDir = $(embedDir "dirName")
getDir :: FilePath -> IO [(FilePath, ByteString)]Source
Get a directory tree in the IO monad.
This is the workhorse of embedDir
Inject into an executable
dummySpace :: Int -> Q ExpSource
Arguments
| :: ByteString | bs to inject |
| -> ByteString | original BS containing dummy |
| -> Maybe ByteString | new BS, or Nothing if there is insufficient dummy space |
Arguments
| :: ByteString | |
| -> FilePath | template file |
| -> FilePath | output file |
| -> IO () |
Internal
stringToBs :: String -> ByteStringSource