Initial working version with sample, undocumented

This commit is contained in:
Michael Snoyman 2009-07-23 21:42:43 +03:00
parent b4cf151dab
commit c6f5fc348f
10 changed files with 132 additions and 0 deletions

2
.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
dist
*.swp

61
Data/FileEmbed.hs Normal file
View File

@ -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
LICENSE Normal file
View File

@ -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
README
View File

@ -0,0 +1 @@
Use Template Haskell to embed file contents directly.

7
Setup.lhs Executable file
View File

@ -0,0 +1,7 @@
#!/usr/bin/env runhaskell
> module Main where
> import Distribution.Simple
> main :: IO ()
> main = defaultMain

18
file-embed.cabal Normal file
View File

@ -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
sample/bar Normal file
View File

@ -0,0 +1 @@
bar bar bar

1
sample/baz Normal file
View File

@ -0,0 +1 @@
baz baz baz

1
sample/bin Normal file
View File

@ -0,0 +1 @@
bin bin bin

15
test.hs Normal file
View File

@ -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