binembed-0.1.0.2: Data/BinEmbed.hs

------------------------------------------------------------------------
-- |
-- Module      :  Data.BinEmbed
-- Copyright   :  Claude Heiland-Allen 2010
-- Maintainer  :  claude@mathr.co.uk
--
-- Support code used by the output of @binembed --output-hs=@.
--
-- For example, given @MyData.binembed@ listing some files, you might
-- get at the contents embedded into your executable using:
--
-- > import MyData   -- which re-exports this module
-- > main = do
-- >   myData' <- unBinEmbed myData
-- >   ...
--
-- See the 'binembed-example' package for a more detailed example.

module Data.BinEmbed
  ( Node(File, Dir)
  , unBinEmbed
  , unBinEmbedFile
  ) where

import Prelude hiding (sequence)

import Foreign.Ptr (Ptr, castPtr, minusPtr)
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafePackCStringLen)
import Data.Foldable (Foldable, foldMap)
import Data.Traversable (Traversable, traverse, sequence)
import Data.Map (Map)

-- | A directory tree
data Node a
  = File a                     -- ^ A file has contents.
  | Dir (Map String (Node a))  -- ^ A directory has named @Node@s.
  deriving (Show, Read, Eq, Ord)

instance Functor Node where
  fmap f (File a) = File (           f  a)
  fmap f (Dir  a) = Dir  (fmap (fmap f) a)

instance Foldable Node where
  foldMap f (File a) =                  f  a
  foldMap f (Dir  a) = foldMap (foldMap f) a

instance Traversable Node where
  traverse f (File a) = File `fmap`                    f  a
  traverse f (Dir  a) = Dir  `fmap` traverse (traverse f) a

-- | Unpack embedded data.
unBinEmbed :: Node (IO ByteString) -> IO (Node ByteString)
unBinEmbed = sequence

-- | Repack the contents between two pointers.  Your code probably
--   doesn't need to call this, but it's needed in generated code.
{-   The usage in the code output by @binembed --output-hs=@ is safe,
--   because the embedded file data is in a .rodata section (ie, it is
--   immutable).
-}
unBinEmbedFile :: Ptr () -> Ptr () -> IO ByteString
unBinEmbedFile s e = unsafePackCStringLen (castPtr s, e `minusPtr` s)