Skip to content

Commit

Permalink
Initial working version with sample, undocumented
Browse files Browse the repository at this point in the history
  • Loading branch information
snoyberg committed Jul 23, 2009
1 parent b4cf151 commit c6f5fc3
Show file tree
Hide file tree
Showing 10 changed files with 132 additions and 0 deletions.
2 changes: 2 additions & 0 deletions .gitignore
@@ -0,0 +1,2 @@
dist
*.swp
61 changes: 61 additions & 0 deletions Data/FileEmbed.hs
@@ -0,0 +1,61 @@
{-# LANGUAGE TemplateHaskell #-}
module Data.FileEmbed
( embedFile
, embedDir
) where

import Language.Haskell.TH (runQ,
Exp(AppE, ListE, LitE, TupE),
Lit(IntegerL, StringL),
Q,
runIO)
import System.Directory (doesDirectoryExist, doesFileExist,
getDirectoryContents)
import Control.Monad (filterM)
import qualified Data.ByteString as B
import Control.Arrow ((&&&), second, first)
import Control.Applicative ((<$>))
import Data.Monoid (mappend)

embedFile :: FilePath -> Q Exp
embedFile fp = (runIO $ B.readFile fp) >>= bsToExp

embedDir :: FilePath -> Q Exp
embedDir fp = ListE <$> ((runIO $ fileList fp) >>= mapM pairToExp)

pairToExp :: (FilePath, B.ByteString) -> Q Exp
pairToExp (path, bs) = do
exp' <- bsToExp bs
return $! TupE [LitE $ StringL path, exp']

bsToExp :: B.ByteString -> Q Exp
bsToExp bs = do
pack <- runQ [| B.pack |]
return $!
AppE pack .
ListE .
map (LitE . IntegerL . fromIntegral) .
B.unpack $
bs

notHidden :: FilePath -> Bool
notHidden ('.':_) = False
notHidden _ = True

fileList :: FilePath -> IO [(FilePath, B.ByteString)]
fileList top = map (first tail) <$> fileList' top ""

fileList' :: FilePath -> FilePath -> IO [(FilePath, B.ByteString)]
fileList' realTop top = do
let prefix1 = top ++ "/"
prefix2 = realTop ++ prefix1
allContents <- filter notHidden <$> getDirectoryContents prefix2
let all' = map (mappend prefix1 &&& mappend prefix2) allContents
files <- filterM (doesFileExist . snd) all' >>=
mapM (liftPair2 . second B.readFile)
dirs <- filterM (doesDirectoryExist . snd) all' >>=
mapM (fileList' realTop . fst)
return $ concat $ files : dirs

liftPair2 :: Monad m => (a, m b) -> m (a, b)
liftPair2 (a, b) = b >>= \b' -> return (a, b')
25 changes: 25 additions & 0 deletions LICENSE
@@ -0,0 +1,25 @@
The following license covers this documentation, and the source code, except
where otherwise indicated.

Copyright 2008, Michael Snoyman. All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.

* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1 change: 1 addition & 0 deletions README
@@ -0,0 +1 @@
Use Template Haskell to embed file contents directly.
7 changes: 7 additions & 0 deletions Setup.lhs
@@ -0,0 +1,7 @@
#!/usr/bin/env runhaskell

> module Main where
> import Distribution.Simple

> main :: IO ()
> main = defaultMain
18 changes: 18 additions & 0 deletions file-embed.cabal
@@ -0,0 +1,18 @@
name: file-embed
version: 0.0.0
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
maintainer: Michael Snoyman <michael@snoyman.com>
synopsis: Use Template Haskell to embed file contents directly.
description: FIXME
category: Data
stability: unstable
cabal-version: >= 1.2
build-type: Simple
homepage: http://github.com/snoyberg/file-embed/tree/master

library
build-depends: base
exposed-modules:
ghc-options: -Wall
1 change: 1 addition & 0 deletions sample/bar
@@ -0,0 +1 @@
bar bar bar
1 change: 1 addition & 0 deletions sample/baz
@@ -0,0 +1 @@
baz baz baz
1 change: 1 addition & 0 deletions sample/bin
@@ -0,0 +1 @@
bin bin bin
15 changes: 15 additions & 0 deletions test.hs
@@ -0,0 +1,15 @@
{-# LANGUAGE TemplateHaskell #-}

import Data.FileEmbed
import qualified Data.ByteString as B

plainfile :: B.ByteString
plainfile = $(embedFile "sample/bar")

plaindir :: [(FilePath, B.ByteString)]
plaindir = $(embedDir "sample")

main :: IO ()
main = do
print plainfile
print plaindir

0 comments on commit c6f5fc3

Please sign in to comment.