@@ -19,10 +19,8 @@
19module Data.FileEmbed
19module Data.FileEmbed
20 ( -- * Embed at compile time
20 ( -- * Embed at compile time
23 , embedOneFileOf
22 , embedOneFileOf
24 , embedDir
23 , embedDir
27 -- * Embed as a IsString
25 -- * Embed as a IsString
28 , embedStringFile
26 , embedStringFile
@@ -37,9 +35,6 @@ module Data.FileEmbed
37 , injectFile
35 , injectFile
38 , injectWith
36 , injectWith
39 , injectFileWith
37 , injectFileWith
40− -- * Relative path manipulation
41− , makeRelativeToProject
42− , makeRelativeToLocationPredicate
43 -- * Internal
38 -- * Internal
44 , stringToBs
39 , stringToBs
@@ -48,34 +43,30 @@ module Data.FileEmbed
49import Language.Haskell.TH.Syntax
44import Language.Haskell.TH.Syntax
50 ( Exp (AppE, ListE, LitE, TupE, SigE, VarE)
45 ( Exp (AppE, ListE, LitE, TupE, SigE, VarE)
51− , Lit (..)
46+#if MIN_VERSION_template_haskell(2,5,0)
47+ , Lit (StringL, StringPrimL, IntegerL)
49+ , Lit (StringL, IntegerL)
54− , qLocation, loc_filename
55#if MIN_VERSION_template_haskell(2,7,0)
53#if MIN_VERSION_template_haskell(2,7,0)
56 , Quasi(qAddDependentFile)
54 , Quasi(qAddDependentFile)
59−#if MIN_VERSION_template_haskell(2,16,0)
60−import Language.Haskell.TH ( mkBytes, bytesPrimL )
61−import qualified Data.ByteString.Internal as B
63import System.Directory (doesDirectoryExist, doesFileExist,
57import System.Directory (doesDirectoryExist, doesFileExist,
64− getDirectoryContents, canonicalizePath)
58+ getDirectoryContents)
65−import Control.Exception (throw, tryJust, ErrorCall(..))
59+import Control.Exception (throw, ErrorCall(..))
66−import Control.Monad (filterM, guard)
60+import Control.Monad (filterM)
67import qualified Data.ByteString as B
61import qualified Data.ByteString as B
68import qualified Data.ByteString.Char8 as B8
62import qualified Data.ByteString.Char8 as B8
69import Control.Arrow ((&&&), second)
63import Control.Arrow ((&&&), second)
70import Control.Applicative ((<$>))
64import Control.Applicative ((<$>))
71import Data.ByteString.Unsafe (unsafePackAddressLen)
65import Data.ByteString.Unsafe (unsafePackAddressLen)
72−import System.IO.Error (isDoesNotExistError)
73import System.IO.Unsafe (unsafePerformIO)
66import System.IO.Unsafe (unsafePerformIO)
74−import System.FilePath ((</>), takeDirectory, takeExtension)
67+import System.FilePath ((</>))
75import Data.String (fromString)
68import Data.String (fromString)
76import Prelude as P
69import Prelude as P
77−import Data.List (sortBy)
78−import Data.Ord (comparing)
80-- | Embed a single file in your source code.
71-- | Embed a single file in your source code.
@@ -90,40 +81,13 @@ embedFile fp =
91 (runIO $ B.readFile fp) >>= bsToExp
82 (runIO $ B.readFile fp) >>= bsToExp
93−-- | Maybe embed a single file in your source code depending on whether or not file exists.
95−-- Warning: When a build is compiled with the file missing, a recompile when the file exists might not trigger an embed of the file.
96−-- You might try to fix this by doing a clean build.
98−-- > import qualified Data.ByteString
100−-- > maybeMyFile :: Maybe Data.ByteString.ByteString
101−-- > maybeMyFile = $(embedFileIfExists "dirName/fileName")
104−embedFileIfExists :: FilePath -> Q Exp
105−embedFileIfExists fp = do
106− mbs <- runIO maybeFile
108− Nothing -> [| Nothing |]
110−#if MIN_VERSION_template_haskell(2,7,0)
111− qAddDependentFile fp
113− [| Just $(bsToExp bs) |]
115− maybeFile :: IO (Maybe B.ByteString)
117− either (const Nothing) Just <$>
118− tryJust (guard . isDoesNotExistError) (B.readFile fp)
120-- | Embed a single existing file in your source code
84-- | Embed a single existing file in your source code
121-- out of list a list of paths supplied.
85-- out of list a list of paths supplied.
123-- > import qualified Data.ByteString
87-- > import qualified Data.ByteString
125-- > myFile :: Data.ByteString.ByteString
89-- > myFile :: Data.ByteString.ByteString
126−-- > myFile = $(embedOneFileOf [ "dirName/fileName", "src/dirName/fileName" ])
90+-- > myFile = $(embedFile' [ "dirName/fileName", "src/dirName/fileName" ])
127embedOneFileOf :: [FilePath] -> Q Exp
91embedOneFileOf :: [FilePath] -> Q Exp
128embedOneFileOf ps =
92embedOneFileOf ps =
129 (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do
93 (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do
@@ -151,18 +115,6 @@ embedDir fp = do
151 e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
115 e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
152 return $ SigE e typ
116 return $ SigE e typ
154−-- | Embed a directory listing recursively in your source code.
156−-- > myFiles :: [FilePath]
157−-- > myFiles = $(embedDirListing "dirName")
160−embedDirListing :: FilePath -> Q Exp
161−embedDirListing fp = do
162− typ <- [t| [FilePath] |]
163− e <- ListE <$> ((runIO $ fmap fst <$> fileList fp) >>= mapM strToExp)
166-- | Get a directory tree in the IO monad.
118-- | Get a directory tree in the IO monad.
168-- This is the workhorse of 'embedDir'
120-- This is the workhorse of 'embedDir'
@@ -175,11 +127,7 @@ pairToExp _root (path, bs) = do
175 qAddDependentFile $ _root ++ '/' : path
127 qAddDependentFile $ _root ++ '/' : path
177 exp' <- bsToExp bs
129 exp' <- bsToExp bs
179−#if MIN_VERSION_template_haskell(2,16,0)
182− [LitE $ StringL path, exp']
130+ return $! TupE [LitE $ StringL path, exp']
184bsToExp :: B.ByteString -> Q Exp
132bsToExp :: B.ByteString -> Q Exp
185#if MIN_VERSION_template_haskell(2, 5, 0)
133#if MIN_VERSION_template_haskell(2, 5, 0)
@@ -187,11 +135,7 @@ bsToExp bs =
187 return $ VarE 'unsafePerformIO
135 return $ VarE 'unsafePerformIO
188 `AppE` (VarE 'unsafePackAddressLen
136 `AppE` (VarE 'unsafePackAddressLen
189 `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs)
137 `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs)
190−#if MIN_VERSION_template_haskell(2, 16, 0)
138+#if MIN_VERSION_template_haskell(2, 8, 0)
191− `AppE` LitE (bytesPrimL (
192− let B.PS ptr off sz = bs
193− in mkBytes ptr (fromIntegral off) (fromIntegral sz))))
194−#elif MIN_VERSION_template_haskell(2, 8, 0)
195 `AppE` LitE (StringPrimL $ B.unpack bs))
139 `AppE` LitE (StringPrimL $ B.unpack bs))
197 `AppE` LitE (StringPrimL $ B8.unpack bs))
141 `AppE` LitE (StringPrimL $ B8.unpack bs))
@@ -266,7 +210,7 @@ fileList' realTop top = do
266 mapM (liftPair2 . second B.readFile)
210 mapM (liftPair2 . second B.readFile)
267 dirs <- filterM (doesDirectoryExist . snd) all' >>=
211 dirs <- filterM (doesDirectoryExist . snd) all' >>=
268 mapM (fileList' realTop . fst)
212 mapM (fileList' realTop . fst)
269− return $ sortBy (comparing fst) $ concat $ files : dirs
213+ return $ concat $ files : dirs
271liftPair2 :: Monad m => (a, m b) -> m (a, b)
215liftPair2 :: Monad m => (a, m b) -> m (a, b)
272liftPair2 (a, b) = b >>= \b' -> return (a, b')
216liftPair2 (a, b) = b >>= \b' -> return (a, b')
@@ -392,50 +336,3 @@ the magic key. If you know for certain that there will only be one dummy space
392available, you can use the non-@With@ variants.
336available, you can use the non-@With@ variants.
396−-- | Take a relative file path and attach it to the root of the current
399−-- The idea here is that, when building with Stack, the build will always be
400−-- executed with a current working directory of the root of the project (where
401−-- your .cabal file is located). However, if you load up multiple projects with
402−-- @stack ghci@, the working directory may be something else entirely.
404−-- This function looks at the source location of the Haskell file calling it,
405−-- finds the first parent directory with a .cabal file, and uses that as the
406−-- root directory for fixing the relative path.
408−-- @$(makeRelativeToProject "data/foo.txt" >>= embedFile)@
411−makeRelativeToProject :: FilePath -> Q FilePath
412−makeRelativeToProject = makeRelativeToLocationPredicate $ (==) ".cabal" . takeExtension
414−-- | Take a predicate to infer the project root and a relative file path, the given file path is then attached to the inferred project root
416−-- This function looks at the source location of the Haskell file calling it,
417−-- finds the first parent directory with a file matching the given predicate, and uses that as the
418−-- root directory for fixing the relative path.
420−-- @$(makeRelativeToLocationPredicate ((==) ".cabal" . takeExtension) "data/foo.txt" >>= embedFile)@
423−makeRelativeToLocationPredicate :: (FilePath -> Bool) -> FilePath -> Q FilePath
424−makeRelativeToLocationPredicate isTargetFile rel = do
427− srcFP <- canonicalizePath $ loc_filename loc
428− mdir <- findProjectDir srcFP
430− Nothing -> error $ "Could not find .cabal file for path: " ++ srcFP
431− Just dir -> return $ dir </> rel
433− findProjectDir x = do
434− let dir = takeDirectory x
438− contents <- getDirectoryContents dir
439− if any isTargetFile contents
440− then return (Just dir)
441− else findProjectDir dir