139 lines
4.1 KiB
Diff
139 lines
4.1 KiB
Diff
From 2e6f4a373fc05968e6dadcc49185d64a69eeddf4 Mon Sep 17 00:00:00 2001
|
|
From: Joey Hess <joey@kitenet.net>
|
|
Date: Mon, 15 Apr 2013 12:38:22 -0400
|
|
Subject: [PATCH] remove TH
|
|
|
|
---
|
|
Data/.FileEmbed.hs.swp | Bin 4096 -> 0 bytes
|
|
Data/FileEmbed.hs | 77 +------------------------------------------------
|
|
2 files changed, 1 insertion(+), 76 deletions(-)
|
|
delete mode 100644 Data/.FileEmbed.hs.swp
|
|
|
|
diff --git a/Data/.FileEmbed.hs.swp b/Data/.FileEmbed.hs.swp
|
|
deleted file mode 100644
|
|
index 7570045ca90875097c2d56ba885d26dcf344bc27..0000000000000000000000000000000000000000
|
|
GIT binary patch
|
|
literal 0
|
|
HcmV?d00001
|
|
|
|
literal 4096
|
|
zcmYc?2=nw+FxN9?00IF9h8Ufkz&R6G7!1T17_#zHD?!49Kzd#&Athk>I*@_-X_+~x
|
|
zx~aKIsVTY!dIowXdgl5ri6x2pZa{HYkg#4xF;T{iDjE%e(GVau1WHTNbS-!pjExKp
|
|
sl$8_}goQ$h)j6teGz3ONU^E0qLtr!nMnhmU1V%$(Gz3ONV3>pe0P*q}cmMzZ
|
|
|
|
diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs
|
|
index 66f7004..b15e331 100644
|
|
--- a/Data/FileEmbed.hs
|
|
+++ b/Data/FileEmbed.hs
|
|
@@ -1,31 +1,12 @@
|
|
-{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE CPP #-}
|
|
module Data.FileEmbed
|
|
( -- * Embed at compile time
|
|
- embedFile
|
|
- , embedDir
|
|
- , getDir
|
|
+ getDir
|
|
-- * Inject into an executable
|
|
-#if MIN_VERSION_template_haskell(2,5,0)
|
|
- , dummySpace
|
|
-#endif
|
|
, inject
|
|
, injectFile
|
|
) where
|
|
|
|
-import Language.Haskell.TH.Syntax
|
|
- ( Exp (AppE, ListE, LitE, TupE, SigE)
|
|
-#if MIN_VERSION_template_haskell(2,5,0)
|
|
- , Lit (StringL, StringPrimL, IntegerL)
|
|
-#else
|
|
- , Lit (StringL, IntegerL)
|
|
-#endif
|
|
- , Q
|
|
- , runIO
|
|
-#if MIN_VERSION_template_haskell(2,7,0)
|
|
- , Quasi(qAddDependentFile)
|
|
-#endif
|
|
- )
|
|
import System.Directory (doesDirectoryExist, doesFileExist,
|
|
getDirectoryContents)
|
|
import Control.Monad (filterM)
|
|
@@ -37,51 +18,12 @@ import Data.ByteString.Unsafe (unsafePackAddressLen)
|
|
import System.IO.Unsafe (unsafePerformIO)
|
|
import System.FilePath ((</>))
|
|
|
|
--- | Embed a single file in your source code.
|
|
---
|
|
--- > import qualified Data.ByteString
|
|
--- >
|
|
--- > myFile :: Data.ByteString.ByteString
|
|
--- > myFile = $(embedFile "dirName/fileName")
|
|
-embedFile :: FilePath -> Q Exp
|
|
-embedFile fp =
|
|
-#if MIN_VERSION_template_haskell(2,7,0)
|
|
- qAddDependentFile fp >>
|
|
-#endif
|
|
- (runIO $ B.readFile fp) >>= bsToExp
|
|
-
|
|
--- | Embed a directory recusrively in your source code.
|
|
---
|
|
--- > import qualified Data.ByteString
|
|
--- >
|
|
--- > myDir :: [(FilePath, Data.ByteString.ByteString)]
|
|
--- > myDir = $(embedDir "dirName")
|
|
-embedDir :: FilePath -> Q Exp
|
|
-embedDir fp = do
|
|
- typ <- [t| [(FilePath, B.ByteString)] |]
|
|
- e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
|
|
- return $ SigE e typ
|
|
-
|
|
-- | Get a directory tree in the IO monad.
|
|
--
|
|
-- This is the workhorse of 'embedDir'
|
|
getDir :: FilePath -> IO [(FilePath, B.ByteString)]
|
|
getDir = fileList
|
|
|
|
-pairToExp :: FilePath -> (FilePath, B.ByteString) -> Q Exp
|
|
-pairToExp _root (path, bs) = do
|
|
-#if MIN_VERSION_template_haskell(2,7,0)
|
|
- qAddDependentFile $ _root ++ '/' : path
|
|
-#endif
|
|
- exp' <- bsToExp bs
|
|
- return $! TupE [LitE $ StringL path, exp']
|
|
-
|
|
-bsToExp :: B.ByteString -> Q Exp
|
|
-bsToExp bs = do
|
|
- helper <- [| stringToBs |]
|
|
- let chars = B8.unpack bs
|
|
- return $! AppE helper $! LitE $! StringL chars
|
|
-
|
|
stringToBs :: String -> B.ByteString
|
|
stringToBs = B8.pack
|
|
|
|
@@ -123,23 +65,6 @@ padSize i =
|
|
let s = show i
|
|
in replicate (sizeLen - length s) '0' ++ s
|
|
|
|
-#if MIN_VERSION_template_haskell(2,5,0)
|
|
-dummySpace :: Int -> Q Exp
|
|
-dummySpace space = do
|
|
- let size = padSize space
|
|
- let start = magic ++ size
|
|
- let chars = LitE $ StringPrimL $
|
|
-#if MIN_VERSION_template_haskell(2,6,0)
|
|
- map (toEnum . fromEnum) $
|
|
-#endif
|
|
- start ++ replicate space '0'
|
|
- let len = LitE $ IntegerL $ fromIntegral $ length start + space
|
|
- upi <- [|unsafePerformIO|]
|
|
- pack <- [|unsafePackAddressLen|]
|
|
- getInner' <- [|getInner|]
|
|
- return $ getInner' `AppE` (upi `AppE` (pack `AppE` len `AppE` chars))
|
|
-#endif
|
|
-
|
|
inject :: B.ByteString -- ^ bs to inject
|
|
-> B.ByteString -- ^ original BS containing dummy
|
|
-> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
|
|
--
|
|
1.8.2.rc3
|
|
|