haskus-utils-compat (empty) → 1.0

raw patch · 3 files changed

+193/−0 lines, 3 filesdep +basedep +bytestringdep +directory

Dependencies added: base, bytestring, directory, filepath, haskus-binary, haskus-utils-data, template-haskell

Files

LICENSE +27/−0
haskus-utils-compat.cabal +39/−0
src/lib/Haskus/Utils/Embed/ByteString.hs +127/−0

+ LICENSE view

@@ -0,0 +1,27 @@+Copyright (c) 2013-2019, Haskus organization+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.++    * Neither the name of Sylvain Henry nor the names of other contributors +      may be used to endorse or promote products derived from this software +      without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 OWNER 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.

+ haskus-utils-compat.cabal view

@@ -0,0 +1,39 @@+name:                haskus-utils-compat+version:             1.0+synopsis:            Compatibility modules with other external packages (ByteString, etc.)+license:             BSD3+license-file:        LICENSE+author:              Sylvain Henry+maintainer:          sylvain@haskus.fr+homepage:            http://docs.haskus.org/+copyright:           Sylvain Henry 2019+category:            System+build-type:          Simple+cabal-version:       1.20++description:+   Compatibility modules with other external packages (ByteString, etc.)++source-repository head+  type: git+  location: git://github.com/haskus/haskus-utils.git++library+  exposed-modules:+    Haskus.Utils.Embed.ByteString++  other-modules:++  build-depends:       +         base                      >= 4.9 && < 5+      ,  template-haskell          >= 2.10+      ,  haskus-binary+      ,  haskus-utils-data+      ,  directory+      ,  filepath+      ,  bytestring++  build-tools: +  ghc-options:          -Wall+  default-language:     Haskell2010+  hs-source-dirs:       src/lib

+ src/lib/Haskus/Utils/Embed/ByteString.hs view

@@ -0,0 +1,127 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE DataKinds #-}++-- | Embed files as ByteStrings into an executable+module Haskus.Utils.Embed.ByteString+   ( bufferToByteString+   , embedBS+   , embedBSFile+   , embedBSOneFileOf+   , embedBSDir+   , module Haskus.Memory.Embed+   )+where++import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS+import GHC.Ptr+import System.IO.Unsafe+import System.Directory+import System.FilePath+import Control.Arrow++import Haskus.Memory.Buffer+import Haskus.Memory.Embed+import Haskus.Utils.Monad++----------------------------------------------------------------------+-- File embedding adapted from file-embed package (BSD3).+--+-- We use Haskus's buffer embedding facilities which are much faster then+-- file-embed's ones as of 2019-01-30.+--+-- See: https://hsyl20.fr/home/posts/2019-01-15-fast-file-embedding-with-ghc.html+----------------------------------------------------------------------++-- | Embed a single file in your source code.+--+-- > import qualified Data.ByteString+-- >+-- > myFile :: Data.ByteString.ByteString+-- > myFile = $(embedFile "dirName/fileName")+embedBSFile :: FilePath -> Q Exp+embedBSFile fp = do+   qAddDependentFile fp+   bs <- runIO $ BS.readFile fp+   embedBS bs++-- | Embed a single existing file in your source code+-- out of list a list of paths supplied.+--+-- > import qualified Data.ByteString+-- >+-- > myFile :: Data.ByteString.ByteString+-- > myFile = $(embedOneFileOf [ "dirName/fileName", "src/dirName/fileName" ])+embedBSOneFileOf :: [FilePath] -> Q Exp+embedBSOneFileOf ps =+  (runIO $ readExistingFile ps) >>= \(path, content) -> do+    qAddDependentFile path+    embedBS content+  where+    readExistingFile :: [FilePath] -> IO (FilePath, BS.ByteString)+    readExistingFile xs = do+      ys <- filterM doesFileExist xs+      case ys of+        (p:_) -> BS.readFile p >>= \c -> return (p, c)+        _     -> error "Cannot find file to embed as resource"++++-- | Embed a directory recursively in your source code.+--+-- > import qualified Data.ByteString+-- >+-- > myDir :: [(FilePath, Data.ByteString.ByteString)]+-- > myDir = $(embedDir "dirName")+embedBSDir :: FilePath -> Q Exp+embedBSDir fp = do+   typ <- [t| [(FilePath, BS.ByteString)] |]+   bufToBs <- [| bufferToByteString |]+   let embedPair (relpath,realpath) = do+         exp' <- embedFile realpath False Nothing Nothing Nothing+         return $! TupE [LitE $ StringL relpath, bufToBs `AppE` exp']+   e <- ListE <$> ((runIO $ listDirectoryRec fp) >>= mapM embedPair)+   return $ SigE e typ++-- | Embed a ByteString into an executable+embedBS :: BS.ByteString -> Q Exp+embedBS bs = do+   bufToBs <- [| bufferToByteString |]+   -- make an input BufferE from the ByteString+   buf <- runIO $ BS.unsafeUseAsCStringLen bs $ \(Ptr addr, sz) -> do+            return (BufferE addr (fromIntegral sz))+   -- embed it+   outBuf <- embedBuffer buf False Nothing Nothing Nothing+   -- keep the ByteString alive up to here+   runIO $ touch bs+   -- return an expression converting the embedded buffer into a ByteString+   return $ bufToBs `AppE` outBuf++-- | Convert an external buffer into a ByteString (O(1))+bufferToByteString :: Buffer mut pin 'NotFinalized 'External -> BS.ByteString+bufferToByteString b = unsafePerformIO $ do +   let pack addr sz = BS.unsafePackAddressLen (fromIntegral sz) addr+   case b of+      BufferE  addr sz -> pack addr sz+      BufferME addr sz -> pack addr sz++-- | List a directory recursively, only returning non-hidden files.+--+-- Return tuples (relative path, real path)+listDirectoryRec :: FilePath -> IO [(FilePath,FilePath)]+listDirectoryRec realTop = go ""+   where+      notHidden :: FilePath -> Bool+      notHidden ('.':_) = False+      notHidden _       = True++      go top = do+         allContents <- filter notHidden <$> getDirectoryContents (realTop </> top)+         let all' = map ((top </>) &&& (\x -> realTop </> top </> x)) allContents+         files <- filterM (doesFileExist . snd) all'+         dirs  <- filterM (doesDirectoryExist . snd) all' >>= mapM (go . fst)+         return $ concat $ files : dirs+