{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.FileEmbed
(
embedFile
, embedFileIfExists
, embedOneFileOf
, embedDir
, embedDirListing
, getDir
, embedStringFile
, embedOneStringFileOf
#if MIN_VERSION_template_haskell(2,5,0)
, dummySpace
, dummySpaceWith
#endif
, inject
, injectFile
, injectWith
, injectFileWith
, makeRelativeToProject
, makeRelativeToLocationPredicate
, stringToBs
, bsToExp
, strToExp
) where
import Language.Haskell.TH.Syntax
( Exp (AppE, ListE, LitE, TupE, SigE, VarE)
, Lit (..)
, Q
, runIO
, qLocation, loc_filename
#if MIN_VERSION_template_haskell(2,7,0)
, Quasi(qAddDependentFile)
#endif
)
#if MIN_VERSION_template_haskell(2,16,0)
import Language.Haskell.TH ( mkBytes, bytesPrimL )
import qualified Data.ByteString.Internal as B
#endif
import System.Directory (doesDirectoryExist, doesFileExist,
getDirectoryContents, canonicalizePath)
import Control.Exception (throw, tryJust, ErrorCall(..))
import Control.Monad (filterM, guard)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Control.Arrow ((&&&), second)
import Control.Applicative ((<$>))
import Data.ByteString.Unsafe (unsafePackAddressLen)
import System.IO.Error (isDoesNotExistError)
import System.IO.Unsafe (unsafePerformIO)
import System.FilePath ((</>), takeDirectory, takeExtension)
import Data.String (fromString)
import Prelude as P
import Data.List (sortBy)
import Data.Ord (comparing)
embedFile :: FilePath -> Q Exp
embedFile :: FilePath -> Q Exp
embedFile FilePath
fp =
#if MIN_VERSION_template_haskell(2,7,0)
FilePath -> Q ()
forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddDependentFile FilePath
fp Q () -> Q ByteString -> Q ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
#endif
(IO ByteString -> Q ByteString
forall a. IO a -> Q a
runIO (IO ByteString -> Q ByteString) -> IO ByteString -> Q ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
B.readFile FilePath
fp) Q ByteString -> (ByteString -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Q Exp
bsToExp
embedFileIfExists :: FilePath -> Q Exp
embedFileIfExists :: FilePath -> Q Exp
embedFileIfExists FilePath
fp = do
Maybe ByteString
mbs <- IO (Maybe ByteString) -> Q (Maybe ByteString)
forall a. IO a -> Q a
runIO IO (Maybe ByteString)
maybeFile
case Maybe ByteString
mbs of
Maybe ByteString
Nothing -> [| Nothing |]
Just ByteString
bs -> do
#if MIN_VERSION_template_haskell(2,7,0)
FilePath -> Q ()
forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddDependentFile FilePath
fp
#endif
[| Just $(bsToExp bs) |]
where
maybeFile :: IO (Maybe B.ByteString)
maybeFile :: IO (Maybe ByteString)
maybeFile =
(() -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either () ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> () -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Either () ByteString -> Maybe ByteString)
-> IO (Either () ByteString) -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(IOError -> Maybe ()) -> IO ByteString -> IO (Either () ByteString)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError) (FilePath -> IO ByteString
B.readFile FilePath
fp)
embedOneFileOf :: [FilePath] -> Q Exp
embedOneFileOf :: [FilePath] -> Q Exp
embedOneFileOf [FilePath]
ps =
(IO (FilePath, ByteString) -> Q (FilePath, ByteString)
forall a. IO a -> Q a
runIO (IO (FilePath, ByteString) -> Q (FilePath, ByteString))
-> IO (FilePath, ByteString) -> Q (FilePath, ByteString)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO (FilePath, ByteString)
readExistingFile [FilePath]
ps) Q (FilePath, ByteString)
-> ((FilePath, ByteString) -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ( FilePath
path, ByteString
content ) -> do
#if MIN_VERSION_template_haskell(2,7,0)
FilePath -> Q ()
forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddDependentFile FilePath
path
#endif
ByteString -> Q Exp
bsToExp ByteString
content
where
readExistingFile :: [FilePath] -> IO ( FilePath, B.ByteString )
readExistingFile :: [FilePath] -> IO (FilePath, ByteString)
readExistingFile [FilePath]
xs = do
[FilePath]
ys <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
xs
case [FilePath]
ys of
(FilePath
p:[FilePath]
_) -> FilePath -> IO ByteString
B.readFile FilePath
p IO ByteString
-> (ByteString -> IO (FilePath, ByteString))
-> IO (FilePath, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ByteString
c -> (FilePath, ByteString) -> IO (FilePath, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ( FilePath
p, ByteString
c )
[FilePath]
_ -> ErrorCall -> IO (FilePath, ByteString)
forall a e. Exception e => e -> a
throw (ErrorCall -> IO (FilePath, ByteString))
-> ErrorCall -> IO (FilePath, ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> ErrorCall
ErrorCall FilePath
"Cannot find file to embed as resource"
embedDir :: FilePath -> Q Exp
embedDir :: FilePath -> Q Exp
embedDir FilePath
fp = do
Type
typ <- [t| [(FilePath, B.ByteString)] |]
Exp
e <- [Exp] -> Exp
ListE ([Exp] -> Exp) -> Q [Exp] -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((IO [(FilePath, ByteString)] -> Q [(FilePath, ByteString)]
forall a. IO a -> Q a
runIO (IO [(FilePath, ByteString)] -> Q [(FilePath, ByteString)])
-> IO [(FilePath, ByteString)] -> Q [(FilePath, ByteString)]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [(FilePath, ByteString)]
fileList FilePath
fp) Q [(FilePath, ByteString)]
-> ([(FilePath, ByteString)] -> Q [Exp]) -> Q [Exp]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((FilePath, ByteString) -> Q Exp)
-> [(FilePath, ByteString)] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> (FilePath, ByteString) -> Q Exp
pairToExp FilePath
fp))
Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Type -> Exp
SigE Exp
e Type
typ
embedDirListing :: FilePath -> Q Exp
embedDirListing :: FilePath -> Q Exp
embedDirListing FilePath
fp = do
Type
typ <- [t| [FilePath] |]
Exp
e <- [Exp] -> Exp
ListE ([Exp] -> Exp) -> Q [Exp] -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((IO [FilePath] -> Q [FilePath]
forall a. IO a -> Q a
runIO (IO [FilePath] -> Q [FilePath]) -> IO [FilePath] -> Q [FilePath]
forall a b. (a -> b) -> a -> b
$ ((FilePath, ByteString) -> FilePath)
-> [(FilePath, ByteString)] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, ByteString) -> FilePath
forall a b. (a, b) -> a
fst ([(FilePath, ByteString)] -> [FilePath])
-> IO [(FilePath, ByteString)] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [(FilePath, ByteString)]
fileList FilePath
fp) Q [FilePath] -> ([FilePath] -> Q [Exp]) -> Q [Exp]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Q Exp) -> [FilePath] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> Q Exp
strToExp)
Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Type -> Exp
SigE Exp
e Type
typ
getDir :: FilePath -> IO [(FilePath, B.ByteString)]
getDir :: FilePath -> IO [(FilePath, ByteString)]
getDir = FilePath -> IO [(FilePath, ByteString)]
fileList
pairToExp :: FilePath -> (FilePath, B.ByteString) -> Q Exp
pairToExp :: FilePath -> (FilePath, ByteString) -> Q Exp
pairToExp FilePath
_root (FilePath
path, ByteString
bs) = do
#if MIN_VERSION_template_haskell(2,7,0)
FilePath -> Q ()
forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddDependentFile (FilePath -> Q ()) -> FilePath -> Q ()
forall a b. (a -> b) -> a -> b
$ FilePath
_root FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
path
#endif
Exp
exp' <- ByteString -> Q Exp
bsToExp ByteString
bs
Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$! [Maybe Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
([Maybe Exp] -> Exp) -> [Maybe Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just
#endif
[Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ FilePath -> Lit
StringL FilePath
path, Exp
exp']
bsToExp :: B.ByteString -> Q Exp
#if MIN_VERSION_template_haskell(2, 5, 0)
bsToExp :: ByteString -> Q Exp
bsToExp ByteString
bs =
Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'unsafePerformIO
Exp -> Exp -> Exp
`AppE` (Name -> Exp
VarE 'unsafePackAddressLen
Exp -> Exp -> Exp
`AppE` Lit -> Exp
LitE (Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B8.length ByteString
bs)
#if MIN_VERSION_template_haskell(2, 16, 0)
Exp -> Exp -> Exp
`AppE` Lit -> Exp
LitE (Bytes -> Lit
bytesPrimL (
let B.PS ForeignPtr Word8
ptr Int
off Int
sz = ByteString
bs
in ForeignPtr Word8 -> Word -> Word -> Bytes
mkBytes ForeignPtr Word8
ptr (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz))))
#elif MIN_VERSION_template_haskell(2, 8, 0)
`AppE` LitE (StringPrimL $ B.unpack bs))
#else
`AppE` LitE (StringPrimL $ B8.unpack bs))
#endif
#else
bsToExp bs = do
helper <- [| stringToBs |]
let chars = B8.unpack bs
return $! AppE helper $! LitE $! StringL chars
#endif
stringToBs :: String -> B.ByteString
stringToBs :: FilePath -> ByteString
stringToBs = FilePath -> ByteString
B8.pack
embedStringFile :: FilePath -> Q Exp
embedStringFile :: FilePath -> Q Exp
embedStringFile FilePath
fp =
#if MIN_VERSION_template_haskell(2,7,0)
FilePath -> Q ()
forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddDependentFile FilePath
fp Q () -> Q FilePath -> Q FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
#endif
(IO FilePath -> Q FilePath
forall a. IO a -> Q a
runIO (IO FilePath -> Q FilePath) -> IO FilePath -> Q FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
P.readFile FilePath
fp) Q FilePath -> (FilePath -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Q Exp
strToExp
embedOneStringFileOf :: [FilePath] -> Q Exp
embedOneStringFileOf :: [FilePath] -> Q Exp
embedOneStringFileOf [FilePath]
ps =
(IO (FilePath, FilePath) -> Q (FilePath, FilePath)
forall a. IO a -> Q a
runIO (IO (FilePath, FilePath) -> Q (FilePath, FilePath))
-> IO (FilePath, FilePath) -> Q (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO (FilePath, FilePath)
readExistingFile [FilePath]
ps) Q (FilePath, FilePath) -> ((FilePath, FilePath) -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ( FilePath
path, FilePath
content ) -> do
#if MIN_VERSION_template_haskell(2,7,0)
FilePath -> Q ()
forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddDependentFile FilePath
path
#endif
FilePath -> Q Exp
strToExp FilePath
content
where
readExistingFile :: [FilePath] -> IO ( FilePath, String )
readExistingFile :: [FilePath] -> IO (FilePath, FilePath)
readExistingFile [FilePath]
xs = do
[FilePath]
ys <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
xs
case [FilePath]
ys of
(FilePath
p:[FilePath]
_) -> FilePath -> IO FilePath
P.readFile FilePath
p IO FilePath
-> (FilePath -> IO (FilePath, FilePath)) -> IO (FilePath, FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ FilePath
c -> (FilePath, FilePath) -> IO (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ( FilePath
p, FilePath
c )
[FilePath]
_ -> ErrorCall -> IO (FilePath, FilePath)
forall a e. Exception e => e -> a
throw (ErrorCall -> IO (FilePath, FilePath))
-> ErrorCall -> IO (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> ErrorCall
ErrorCall FilePath
"Cannot find file to embed as resource"
strToExp :: String -> Q Exp
#if MIN_VERSION_template_haskell(2, 5, 0)
strToExp :: FilePath -> Q Exp
strToExp FilePath
s =
Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'fromString
Exp -> Exp -> Exp
`AppE` Lit -> Exp
LitE (FilePath -> Lit
StringL FilePath
s)
#else
strToExp s = do
helper <- [| fromString |]
return $! AppE helper $! LitE $! StringL s
#endif
notHidden :: FilePath -> Bool
notHidden :: FilePath -> Bool
notHidden (Char
'.':FilePath
_) = Bool
False
notHidden FilePath
_ = Bool
True
fileList :: FilePath -> IO [(FilePath, B.ByteString)]
fileList :: FilePath -> IO [(FilePath, ByteString)]
fileList FilePath
top = FilePath -> FilePath -> IO [(FilePath, ByteString)]
fileList' FilePath
top FilePath
""
fileList' :: FilePath -> FilePath -> IO [(FilePath, B.ByteString)]
fileList' :: FilePath -> FilePath -> IO [(FilePath, ByteString)]
fileList' FilePath
realTop FilePath
top = do
[FilePath]
allContents <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
notHidden ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents (FilePath
realTop FilePath -> FilePath -> FilePath
</> FilePath
top)
let all' :: [(FilePath, FilePath)]
all' = (FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
top FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> (FilePath, FilePath)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (\FilePath
x -> FilePath
realTop FilePath -> FilePath -> FilePath
</> FilePath
top FilePath -> FilePath -> FilePath
</> FilePath
x)) [FilePath]
allContents
[(FilePath, ByteString)]
files <- ((FilePath, FilePath) -> IO Bool)
-> [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd) [(FilePath, FilePath)]
all' IO [(FilePath, FilePath)]
-> ([(FilePath, FilePath)] -> IO [(FilePath, ByteString)])
-> IO [(FilePath, ByteString)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
((FilePath, FilePath) -> IO (FilePath, ByteString))
-> [(FilePath, FilePath)] -> IO [(FilePath, ByteString)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((FilePath, IO ByteString) -> IO (FilePath, ByteString)
forall (m :: * -> *) a b. Monad m => (a, m b) -> m (a, b)
liftPair2 ((FilePath, IO ByteString) -> IO (FilePath, ByteString))
-> ((FilePath, FilePath) -> (FilePath, IO ByteString))
-> (FilePath, FilePath)
-> IO (FilePath, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> IO ByteString)
-> (FilePath, FilePath) -> (FilePath, IO ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second FilePath -> IO ByteString
B.readFile)
[[(FilePath, ByteString)]]
dirs <- ((FilePath, FilePath) -> IO Bool)
-> [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd) [(FilePath, FilePath)]
all' IO [(FilePath, FilePath)]
-> ([(FilePath, FilePath)] -> IO [[(FilePath, ByteString)]])
-> IO [[(FilePath, ByteString)]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
((FilePath, FilePath) -> IO [(FilePath, ByteString)])
-> [(FilePath, FilePath)] -> IO [[(FilePath, ByteString)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> FilePath -> IO [(FilePath, ByteString)]
fileList' FilePath
realTop (FilePath -> IO [(FilePath, ByteString)])
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> IO [(FilePath, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst)
[(FilePath, ByteString)] -> IO [(FilePath, ByteString)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, ByteString)] -> IO [(FilePath, ByteString)])
-> [(FilePath, ByteString)] -> IO [(FilePath, ByteString)]
forall a b. (a -> b) -> a -> b
$ ((FilePath, ByteString) -> (FilePath, ByteString) -> Ordering)
-> [(FilePath, ByteString)] -> [(FilePath, ByteString)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((FilePath, ByteString) -> FilePath)
-> (FilePath, ByteString) -> (FilePath, ByteString) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (FilePath, ByteString) -> FilePath
forall a b. (a, b) -> a
fst) ([(FilePath, ByteString)] -> [(FilePath, ByteString)])
-> [(FilePath, ByteString)] -> [(FilePath, ByteString)]
forall a b. (a -> b) -> a -> b
$ [[(FilePath, ByteString)]] -> [(FilePath, ByteString)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(FilePath, ByteString)]] -> [(FilePath, ByteString)])
-> [[(FilePath, ByteString)]] -> [(FilePath, ByteString)]
forall a b. (a -> b) -> a -> b
$ [(FilePath, ByteString)]
files [(FilePath, ByteString)]
-> [[(FilePath, ByteString)]] -> [[(FilePath, ByteString)]]
forall a. a -> [a] -> [a]
: [[(FilePath, ByteString)]]
dirs
liftPair2 :: Monad m => (a, m b) -> m (a, b)
liftPair2 :: (a, m b) -> m (a, b)
liftPair2 (a
a, m b
b) = m b
b m b -> (b -> m (a, b)) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
b' -> (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b')
magic :: B.ByteString -> B.ByteString
magic :: ByteString -> ByteString
magic ByteString
x = [ByteString] -> ByteString
B8.concat [ByteString
"fe", ByteString
x]
sizeLen :: Int
sizeLen :: Int
sizeLen = Int
20
getInner :: B.ByteString -> B.ByteString
getInner :: ByteString -> ByteString
getInner ByteString
b =
let (ByteString
sizeBS, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
sizeLen ByteString
b
in case ReadS Int
forall a. Read a => ReadS a
reads ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
B8.unpack ByteString
sizeBS of
(Int
i, FilePath
_):[(Int, FilePath)]
_ -> Int -> ByteString -> ByteString
B.take Int
i ByteString
rest
[] -> FilePath -> ByteString
forall a. HasCallStack => FilePath -> a
error FilePath
"Data.FileEmbed (getInner): Your dummy space has been corrupted."
padSize :: Int -> String
padSize :: Int -> FilePath
padSize Int
i =
let s :: FilePath
s = Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i
in Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int
sizeLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
s) Char
'0' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
#if MIN_VERSION_template_haskell(2,5,0)
dummySpace :: Int -> Q Exp
dummySpace :: Int -> Q Exp
dummySpace = ByteString -> Int -> Q Exp
dummySpaceWith ByteString
"MS"
dummySpaceWith :: B.ByteString -> Int -> Q Exp
dummySpaceWith :: ByteString -> Int -> Q Exp
dummySpaceWith ByteString
postfix Int
space = do
let size :: FilePath
size = Int -> FilePath
padSize Int
space
magic' :: ByteString
magic' = ByteString -> ByteString
magic ByteString
postfix
start :: FilePath
start = ByteString -> FilePath
B8.unpack ByteString
magic' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
size
magicLen :: Int
magicLen = ByteString -> Int
B8.length ByteString
magic'
len :: Int
len = Int
magicLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
space
chars :: Exp
chars = Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ [Word8] -> Lit
StringPrimL ([Word8] -> Lit) -> [Word8] -> Lit
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_template_haskell(2,6,0)
(Char -> Word8) -> FilePath -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) (FilePath -> [Word8]) -> FilePath -> [Word8]
forall a b. (a -> b) -> a -> b
$
#endif
FilePath
start FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate Int
space Char
'0'
[| getInner (B.drop magicLen (unsafePerformIO (unsafePackAddressLen len $(return chars)))) |]
#endif
inject :: B.ByteString
-> B.ByteString
-> Maybe B.ByteString
inject :: ByteString -> ByteString -> Maybe ByteString
inject = ByteString -> ByteString -> ByteString -> Maybe ByteString
injectWith ByteString
"MS"
injectWith :: B.ByteString
-> B.ByteString
-> B.ByteString
-> Maybe B.ByteString
injectWith :: ByteString -> ByteString -> ByteString -> Maybe ByteString
injectWith ByteString
postfix ByteString
toInj ByteString
orig =
if Int
toInjL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
size
then Maybe ByteString
forall a. Maybe a
Nothing
else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ByteString
before, ByteString
magic', FilePath -> ByteString
B8.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> FilePath
padSize Int
toInjL, ByteString
toInj, FilePath -> ByteString
B8.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
toInjL) Char
'0', ByteString
after]
where
magic' :: ByteString
magic' = ByteString -> ByteString
magic ByteString
postfix
toInjL :: Int
toInjL = ByteString -> Int
B.length ByteString
toInj
(ByteString
before, ByteString
rest) = ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
magic' ByteString
orig
(ByteString
sizeBS, ByteString
rest') = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
sizeLen (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B8.length ByteString
magic') ByteString
rest
size :: Int
size = case ReadS Int
forall a. Read a => ReadS a
reads ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
B8.unpack ByteString
sizeBS of
(Int
i, FilePath
_):[(Int, FilePath)]
_ -> Int
i
[] -> FilePath -> Int
forall a. HasCallStack => FilePath -> a
error (FilePath -> Int) -> FilePath -> Int
forall a b. (a -> b) -> a -> b
$ FilePath
"Data.FileEmbed (inject): Your dummy space has been corrupted. Size is: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
sizeBS
after :: ByteString
after = Int -> ByteString -> ByteString
B.drop Int
size ByteString
rest'
injectFile :: B.ByteString
-> FilePath
-> FilePath
-> IO ()
injectFile :: ByteString -> FilePath -> FilePath -> IO ()
injectFile = ByteString -> ByteString -> FilePath -> FilePath -> IO ()
injectFileWith ByteString
"MS"
injectFileWith :: B.ByteString
-> B.ByteString
-> FilePath
-> FilePath
-> IO ()
injectFileWith :: ByteString -> ByteString -> FilePath -> FilePath -> IO ()
injectFileWith ByteString
postfix ByteString
inj FilePath
srcFP FilePath
dstFP = do
ByteString
src <- FilePath -> IO ByteString
B.readFile FilePath
srcFP
case ByteString -> ByteString -> ByteString -> Maybe ByteString
injectWith ByteString
postfix ByteString
inj ByteString
src of
Maybe ByteString
Nothing -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Insufficient dummy space"
Just ByteString
dst -> FilePath -> ByteString -> IO ()
B.writeFile FilePath
dstFP ByteString
dst
makeRelativeToProject :: FilePath -> Q FilePath
makeRelativeToProject :: FilePath -> Q FilePath
makeRelativeToProject = (FilePath -> Bool) -> FilePath -> Q FilePath
makeRelativeToLocationPredicate ((FilePath -> Bool) -> FilePath -> Q FilePath)
-> (FilePath -> Bool) -> FilePath -> Q FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) FilePath
".cabal" (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension
makeRelativeToLocationPredicate :: (FilePath -> Bool) -> FilePath -> Q FilePath
makeRelativeToLocationPredicate :: (FilePath -> Bool) -> FilePath -> Q FilePath
makeRelativeToLocationPredicate FilePath -> Bool
isTargetFile FilePath
rel = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
IO FilePath -> Q FilePath
forall a. IO a -> Q a
runIO (IO FilePath -> Q FilePath) -> IO FilePath -> Q FilePath
forall a b. (a -> b) -> a -> b
$ do
FilePath
srcFP <- FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Loc -> FilePath
loc_filename Loc
loc
Maybe FilePath
mdir <- FilePath -> IO (Maybe FilePath)
findProjectDir FilePath
srcFP
case Maybe FilePath
mdir of
Maybe FilePath
Nothing -> FilePath -> IO FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not find .cabal file for path: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
srcFP
Just FilePath
dir -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
rel
where
findProjectDir :: FilePath -> IO (Maybe FilePath)
findProjectDir FilePath
x = do
let dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
x
if FilePath
dir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
x
then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
else do
[FilePath]
contents <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
if (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FilePath -> Bool
isTargetFile [FilePath]
contents
then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dir)
else FilePath -> IO (Maybe FilePath)
findProjectDir FilePath
dir