mirror of
https://github.com/typeable/file-embed.git
synced 2024-10-05 20:07:29 +03:00
Initial working version with sample, undocumented
This commit is contained in:
parent
b4cf151dab
commit
c6f5fc348f
2
.gitignore
vendored
Normal file
2
.gitignore
vendored
Normal file
@ -0,0 +1,2 @@
|
||||
dist
|
||||
*.swp
|
61
Data/FileEmbed.hs
Normal file
61
Data/FileEmbed.hs
Normal 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
25
LICENSE
Normal 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.
|
7
Setup.lhs
Executable file
7
Setup.lhs
Executable 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
18
file-embed.cabal
Normal 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
1
sample/bar
Normal file
@ -0,0 +1 @@
|
||||
bar bar bar
|
1
sample/baz
Normal file
1
sample/baz
Normal file
@ -0,0 +1 @@
|
||||
baz baz baz
|
1
sample/bin
Normal file
1
sample/bin
Normal file
@ -0,0 +1 @@
|
||||
bin bin bin
|
15
test.hs
Normal file
15
test.hs
Normal 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
|
Loading…
Reference in New Issue
Block a user