Skip to content

Instantly share code, notes, and snippets.

@lumie1337
Last active November 14, 2020 10:34
Show Gist options
  • Save lumie1337/7d2d33f082a03e330d212e84827180e8 to your computer and use it in GitHub Desktop.
Save lumie1337/7d2d33f082a03e330d212e84827180e8 to your computer and use it in GitHub Desktop.

Embed File in template haskell 2.16.0 and up

embedFile :: FilePath -> Q Exp
embedFile fp = do
    T.qAddDependentFile fp                    -- adding a file dependency for reloading
    bs <- T.runIO $ B.readFile fp             -- runIO to run IO in the Q Monad
    [|unsafePerformIO $ unsafePackAddressLen $(size bs) $(bytes bs)|]
  where
    size  = pure . T.LitE . T.integerL . fromIntegral . B8.length
    bytes = pure . T.LitE . T.bytesPrimL . bytestringToBytesLit 
    bytestringToBytesLit (B.PS ptr off sz) = T.mkBytes ptr (fromIntegral off) (fromIntegral sz)

Embed File in template haskell 2.15.0

bytes = pure . T.LitE . T.stringPrimL . B.unpack

Relevant Imports

{-# LANGUAGE TemplateHaskell #-}

import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B (PS(..))

import qualified Language.Haskell.TH.Syntax as T
import qualified Language.Haskell.TH.Lib as T

import Data.ByteString.Unsafe (unsafePackAddressLen)
import System.IO.Unsafe (unsafePerformIO)

Resource Abstraction

data Resource = EmbeddedResource FilePath B.ByteString
              | FileResource FilePath

loadResource :: Resource -> IO B.ByteString
loadResource (FileResource path)     = B.readFile path
loadResource (EmbeddedResource _ bs) = return bs

Lift Resource

shouldEmbedResources :: Bool
shouldEmbedResources = undefined -- implement this

liftResource :: FilePath -> Q Exp
liftResource fp = if shouldEmbedResources then [|EmbeddedResource $(lift fp) $(embedFile fp)|] else [|FileResource $(lift fp)|]

Example

main = do
  message <- loadResource $(liftResource "example.txt")
  B8.putStrLn message

Typed TH

There is liftTyped :: t -> Q (TExp t) since 2.16.0.0. Otherwise you can use liftTyped = unsafeTExpCoerce . lift.

import qualified Unsafe.Coerce as Unsafe

embedFile :: FilePath -> Q (TExp ByteString)
embedFile fp = do
    T.qAddDependentFile fp                    -- adding a file dependency for reloading
    bs <- T.runIO $ B.readFile fp             -- runIO to run IO in the Q Monad
    [||unsafePerformIO $ unsafePackAddressLen $$(size bs) $$(bytes bs)||]
  where
    size = T.unsafeTExpCoerce . pure . T.LitE . T.intergerL . fromIntegral . B8.length
    -- 2.15.0.0
    bytes = Unsafe.unsafeCoerce . T.unsafeTExpCoerce . pure . T.LitE . T.stringPrimL . B.unpack
    -- 2.16.0.0
    bytes = Unsafe.unsafeCoerce . T.unsafeTExpCoerce . pure . T.LitE . T.bytesPrimL . bytestringToBytesLit 
    bytestringToBytesLit (B.PS ptr off sz) = T.mkBytes ptr (fromIntegral off) (fromIntegral sz)

liftResource :: FilePath -> Q (TExp Resource)
liftResource fp = if shouldEmbedResources then [||EmbeddedResource $$(T.liftTyped fp) $$(embedFile fp)||] else [||FileResource $$(T.liftTyped fp)||]

Edited: Post Processing

type PP = B.ByteString -> B.ByteString

postProcessFile :: PP
postProcessFile bs = bs <> B8.pack "!"

liftResource :: FilePath -> Q (TExp PP) -> PP -> Q (TExp Resource)
liftResource fp postProcessQ postProcess = if shouldEmbedResources then [||EmbeddedResource $$(T.liftTyped fp) $$(embedFile fp postProcess)||] else [||FileResource $$(T.liftTyped fp) $$postProcessQ||]

embedFile :: FilePath -> PP -> Q Exp
embedFile fp postProcess = do
    T.qAddDependentFile fp                    -- adding a file dependency for reloading
    bs' <- T.runIO $ B.readFile fp            -- runIO to run IO in the Q Monad
    let bs = postProcess bs'
    [|unsafePerformIO $ unsafePackAddressLen $(size bs) $(bytes bs)|]
  where
    size  = pure . T.LitE . T.integerL . fromIntegral . B8.length
    bytes = pure . T.LitE . T.bytesPrimL . bytestringToBytesLit 
    bytestringToBytesLit (B.PS ptr off sz) = T.mkBytes ptr (fromIntegral off) (fromIntegral sz)

data Resource = EmbeddedResource FilePath B.ByteString
              | FileResource FilePath PP

loadResource :: Resource -> IO B.ByteString
loadResource (FileResource path postProcess) = do
  resource <- B.readFile path
  return $ postProcess resource
loadResource (EmbeddedResource _ bs) = return bs

Example

main = do
  message <- loadResource $(liftResource "example.txt" [|| postProcessFile ||] postProcessFile)
  B8.putStrLn message
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment