HsHyperEstraier-0.2: Text/HyperEstraier/Utils.hs

{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}
{-# LINE 1 "Text/HyperEstraier/Utils.hsc" #-}
module Text.HyperEstraier.Utils
{-# LINE 2 "Text/HyperEstraier/Utils.hsc" #-}
    ( withUTF8CString
    , withUTF8CString'
    , packMallocUTF8CString
    , copyUTF8CString

    , marshalOpts

    , withArrayOfPtrs
    )
    where

import           Data.Bits
import qualified Data.ByteString as BS
import           Data.Encoding
import           Data.Encoding.UTF8
import           Foreign.C.String
import           Foreign.Marshal.Array
import           Foreign.Ptr


-- Yet another withUTF8CString. Hope GHC officially supports this!
withUTF8CString :: String -> (CString -> IO a) -> IO a
withUTF8CString = BS.useAsCString . encode UTF8


withUTF8CString' :: Maybe String -> (CString -> IO a) -> IO a
withUTF8CString' (Just str) f = BS.useAsCString (encode UTF8 str) f
withUTF8CString' Nothing f    = f nullPtr


packMallocUTF8CString :: CString -> IO String
packMallocUTF8CString = return . decode UTF8 . BS.packMallocCString


copyUTF8CString :: CString -> IO String
copyUTF8CString cstr = BS.copyCString cstr >>= return . decode UTF8

-- (.) の型は (b -> c) -> (a -> b) -> a -> c である。(.) は同じ arity
-- の函數を繋げる。map は二引數函數なので、それと繋げる方も二引數にしな
-- ければならない。所で foldl (.|.) 0 の型は Bits a => [a] -> a で一引
-- 數である。これを (foldl (.|.) 0 .) にすると、その型は Bits b => (a
-- -> [b]) -> a -> b になり、單純に Bits a のリストを取ってゐた函數が
-- 「何かの値を取って Bits b のリストを返す函數」と「その何かの値」を取
-- る函數に變化する。それを (.) の左邊に置くと、((foldl (.|.) 0 .) .)
-- の型は Bits c => (a -> b -> [c]) -> a -> b -> c になる。この函數に
-- map を適用すると、map の型は (a -> b) -> [a] -> [b] なので、結果は
-- Bits b => (a -> b) -> [a] -> b になる。
--
-- point-free って難しいね。
marshalOpts :: Bits b => (a -> b) -> [a] -> b
marshalOpts = (foldl (.|.) 0 .) . map


withArrayOfPtrs :: (a -> (Ptr b -> IO c) -> IO c)
                -> [a]
                -> (Ptr (Ptr b) -> IO c)
                -> IO c
withArrayOfPtrs withXPtr xs f
    = withXPtrList xs [] $ \ xPtrs ->
      withArray xPtrs f
    where
      -- withXPtrList :: [a] -> [Ptr b] -> ([Ptr b] -> IO c) -> IO c
      withXPtrList []     acc f = f acc
      withXPtrList (x:xs) acc f = withXPtr x $ \ xPtr ->
                                  withXPtrList xs (acc ++ [xPtr]) f