@@ -3,7 +3,7 @@
33{-# LANGUAGE OverloadedStrings #-}
44-- | This module uses template Haskell. Following is a simplified explanation of usage for those unfamiliar with calling Template Haskell functions.
55--
6−-- The function @embedFile@ in this modules embeds a file into the exceutable
6+-- The function @embedFile@ in this modules embeds a file into the executable
77-- that you can use it at runtime. A file is represented as a @ByteString@.
88-- However, as you can see below, the type signature indicates a value of type
99-- @Q Exp@ will be returned. In order to convert this into a @ByteString@, you
@@ -19,9 +19,14 @@
1919module Data.FileEmbed
2020 ( -- * Embed at compile time
2121 embedFile
22+ , embedFileIfExists
2223 , embedOneFileOf
2324 , embedDir
25+ , embedDirListing
2426 , getDir
27+ -- * Embed as a IsString
28+ , embedStringFile
29+ , embedOneStringFileOf
2530 -- * Inject into an executable
2631 -- $inject
2732#if MIN_VERSION_template_haskell(2,5,0)
@@ -32,35 +37,45 @@ module Data.FileEmbed
3237 , injectFile
3338 , injectWith
3439 , injectFileWith
40+ -- * Relative path manipulation
41+ , makeRelativeToProject
42+ , makeRelativeToLocationPredicate
3543 -- * Internal
3644 , stringToBs
3745 , bsToExp
46+ , strToExp
3847 ) where
3948
4049import Language.Haskell.TH.Syntax
4150 ( Exp (AppE, ListE, LitE, TupE, SigE, VarE)
42−#if MIN_VERSION_template_haskell(2,5,0)
43− , Lit (StringL, StringPrimL, IntegerL)
44−#else
45− , Lit (StringL, IntegerL)
46−#endif
51+ , Lit (..)
4752 , Q
4853 , runIO
54+ , qLocation, loc_filename
4955#if MIN_VERSION_template_haskell(2,7,0)
5056 , Quasi(qAddDependentFile)
5157#endif
5258 )
59+#if MIN_VERSION_template_haskell(2,16,0)
60+import Language.Haskell.TH ( mkBytes, bytesPrimL )
61+import qualified Data.ByteString.Internal as B
62+#endif
5363import System.Directory (doesDirectoryExist, doesFileExist,
54− getDirectoryContents)
55−import Control.Exception (throw, ErrorCall(..))
56−import Control.Monad (filterM)
64+ getDirectoryContents, canonicalizePath)
65+import Control.Exception (throw, tryJust, ErrorCall(..))
66+import Control.Monad (filterM, guard)
5767import qualified Data.ByteString as B
5868import qualified Data.ByteString.Char8 as B8
5969import Control.Arrow ((&&&), second)
6070import Control.Applicative ((<$>))
6171import Data.ByteString.Unsafe (unsafePackAddressLen)
72+import System.IO.Error (isDoesNotExistError)
6273import System.IO.Unsafe (unsafePerformIO)
63−import System.FilePath ((</>))
74+import System.FilePath ((</>), takeDirectory, takeExtension)
75+import Data.String (fromString)
76+import Prelude as P
77+import Data.List (sortBy)
78+import Data.Ord (comparing)
6479
6580-- | Embed a single file in your source code.
6681--
@@ -75,13 +90,40 @@ embedFile fp =
7590#endif
7691 (runIO $ B.readFile fp) >>= bsToExp
7792
93+-- | Maybe embed a single file in your source code depending on whether or not file exists.
94+--
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.
97+--
98+-- > import qualified Data.ByteString
99+-- >
100+-- > maybeMyFile :: Maybe Data.ByteString.ByteString
101+-- > maybeMyFile = $(embedFileIfExists "dirName/fileName")
102+--
103+-- @since 0.0.14.0
104+embedFileIfExists :: FilePath -> Q Exp
105+embedFileIfExists fp = do
106+ mbs <- runIO maybeFile
107+ case mbs of
108+ Nothing -> [| Nothing |]
109+ Just bs -> do
110+#if MIN_VERSION_template_haskell(2,7,0)
111+ qAddDependentFile fp
112+#endif
113+ [| Just $(bsToExp bs) |]
114+ where
115+ maybeFile :: IO (Maybe B.ByteString)
116+ maybeFile =
117+ either (const Nothing) Just <$>
118+ tryJust (guard . isDoesNotExistError) (B.readFile fp)
119+
78120-- | Embed a single existing file in your source code
79121-- out of list a list of paths supplied.
80122--
81123-- > import qualified Data.ByteString
82124-- >
83125-- > myFile :: Data.ByteString.ByteString
84−-- > myFile = $(embedFile' [ "dirName/fileName", "src/dirName/fileName" ])
126+-- > myFile = $(embedOneFileOf [ "dirName/fileName", "src/dirName/fileName" ])
85127embedOneFileOf :: [FilePath] -> Q Exp
86128embedOneFileOf ps =
87129 (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do
@@ -109,6 +151,18 @@ embedDir fp = do
109151 e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
110152 return $ SigE e typ
111153
154+-- | Embed a directory listing recursively in your source code.
155+--
156+-- > myFiles :: [FilePath]
157+-- > myFiles = $(embedDirListing "dirName")
158+--
159+-- @since 0.0.11
160+embedDirListing :: FilePath -> Q Exp
161+embedDirListing fp = do
162+ typ <- [t| [FilePath] |]
163+ e <- ListE <$> ((runIO $ fmap fst <$> fileList fp) >>= mapM strToExp)
164+ return $ SigE e typ
165+
112166-- | Get a directory tree in the IO monad.
113167--
114168-- This is the workhorse of 'embedDir'
@@ -121,7 +175,11 @@ pairToExp _root (path, bs) = do
121175 qAddDependentFile $ _root ++ '/' : path
122176#endif
123177 exp' <- bsToExp bs
124− return $! TupE [LitE $ StringL path, exp']
178+ return $! TupE
179+#if MIN_VERSION_template_haskell(2,16,0)
180+ $ map Just
181+#endif
182+ [LitE $ StringL path, exp']
125183
126184bsToExp :: B.ByteString -> Q Exp
127185#if MIN_VERSION_template_haskell(2, 5, 0)
@@ -129,7 +187,11 @@ bsToExp bs =
129187 return $ VarE 'unsafePerformIO
130188 `AppE` (VarE 'unsafePackAddressLen
131189 `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs)
132−#if MIN_VERSION_template_haskell(2, 8, 0)
190+#if MIN_VERSION_template_haskell(2, 16, 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)
133195 `AppE` LitE (StringPrimL $ B.unpack bs))
134196#else
135197 `AppE` LitE (StringPrimL $ B8.unpack bs))
@@ -144,6 +206,51 @@ bsToExp bs = do
144206stringToBs :: String -> B.ByteString
145207stringToBs = B8.pack
146208
209+-- | Embed a single file in your source code.
210+--
211+-- > import Data.String
212+-- >
213+-- > myFile :: IsString a => a
214+-- > myFile = $(embedStringFile "dirName/fileName")
215+--
216+-- Since 0.0.9
217+embedStringFile :: FilePath -> Q Exp
218+embedStringFile fp =
219+#if MIN_VERSION_template_haskell(2,7,0)
220+ qAddDependentFile fp >>
221+#endif
222+ (runIO $ P.readFile fp) >>= strToExp
223+
224+-- | Embed a single existing string file in your source code
225+-- out of list a list of paths supplied.
226+--
227+-- Since 0.0.9
228+embedOneStringFileOf :: [FilePath] -> Q Exp
229+embedOneStringFileOf ps =
230+ (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do
231+#if MIN_VERSION_template_haskell(2,7,0)
232+ qAddDependentFile path
233+#endif
234+ strToExp content
235+ where
236+ readExistingFile :: [FilePath] -> IO ( FilePath, String )
237+ readExistingFile xs = do
238+ ys <- filterM doesFileExist xs
239+ case ys of
240+ (p:_) -> P.readFile p >>= \ c -> return ( p, c )
241+ _ -> throw $ ErrorCall "Cannot find file to embed as resource"
242+
243+strToExp :: String -> Q Exp
244+#if MIN_VERSION_template_haskell(2, 5, 0)
245+strToExp s =
246+ return $ VarE 'fromString
247+ `AppE` LitE (StringL s)
248+#else
249+strToExp s = do
250+ helper <- [| fromString |]
251+ return $! AppE helper $! LitE $! StringL s
252+#endif
253+
147254notHidden :: FilePath -> Bool
148255notHidden ('.':_) = False
149256notHidden _ = True
@@ -159,7 +266,7 @@ fileList' realTop top = do
159266 mapM (liftPair2 . second B.readFile)
160267 dirs <- filterM (doesDirectoryExist . snd) all' >>=
161268 mapM (fileList' realTop . fst)
162− return $ concat $ files : dirs
269+ return $ sortBy (comparing fst) $ concat $ files : dirs
163270
164271liftPair2 :: Monad m => (a, m b) -> m (a, b)
165272liftPair2 (a, b) = b >>= \b' -> return (a, b')
@@ -285,3 +392,50 @@ the magic key. If you know for certain that there will only be one dummy space
285392available, you can use the non-@With@ variants.
286393
287394-}
395+
396+-- | Take a relative file path and attach it to the root of the current
397+-- project.
398+--
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.
403+--
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.
407+--
408+-- @$(makeRelativeToProject "data/foo.txt" >>= embedFile)@
409+--
410+-- @since 0.0.10
411+makeRelativeToProject :: FilePath -> Q FilePath
412+makeRelativeToProject = makeRelativeToLocationPredicate $ (==) ".cabal" . takeExtension
413+
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
415+--
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.
419+--
420+-- @$(makeRelativeToLocationPredicate ((==) ".cabal" . takeExtension) "data/foo.txt" >>= embedFile)@
421+--
422+-- @since 0.0.15.0
423+makeRelativeToLocationPredicate :: (FilePath -> Bool) -> FilePath -> Q FilePath
424+makeRelativeToLocationPredicate isTargetFile rel = do
425+ loc <- qLocation
426+ runIO $ do
427+ srcFP <- canonicalizePath $ loc_filename loc
428+ mdir <- findProjectDir srcFP
429+ case mdir of
430+ Nothing -> error $ "Could not find .cabal file for path: " ++ srcFP
431+ Just dir -> return $ dir </> rel
432+ where
433+ findProjectDir x = do
434+ let dir = takeDirectory x
435+ if dir == x
436+ then return Nothing
437+ else do
438+ contents <- getDirectoryContents dir
439+ if any isTargetFile contents
440+ then return (Just dir)
441+ else findProjectDir dir