libmagic-1.3.1: Magic/Utils.hsc

{- -*- Mode: haskell; -*-
Haskell magic Interface
Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>

This code is under a 3-clause BSD license; see COPYING for details.
-}

{- |
   Module     : Magic.Utils
   Copyright  : Copyright (C) 2005 John Goerzen
   License    : BSD

   Maintainer : Joey Hess,
   Maintainer : id\@joeyh.name
   Stability  : provisional
   Portability: portable

Utils

Written by John Goerzen, jgoerzen\@complete.org
-}

module Magic.Utils (flaglist2int, fromMagicPtr, withMagicPtr, checkIntError,
                    throwErrorIfNull, decodeOsPath)
where

import Foreign
import Foreign.C.Error
import Foreign.C.String
import Magic.TypesLL
import Magic.Types
import Foreign.C.Types
import Control.Concurrent.MVar
import System.OsPath.Types
import System.OsString.Internal.Types
import System.OsString.Encoding
import Data.Type.Coercion
import qualified Data.ByteString.Short as SBS

flaglist2int :: [MagicFlag] -> CInt
flaglist2int mfl =
    foldl (\c f -> c .|. (fromIntegral . fromEnum $ f)) 0 mfl

fromMagicPtr :: String -> IO (Ptr CMagic) -> IO Magic
fromMagicPtr caller action =
    do ptr <- throwErrnoIfNull caller action
       m <- newForeignPtr magic_close ptr
       mvar <- newMVar m
       return (Magic mvar)

throwErrorIfNull :: String -> Ptr CMagic -> IO (Ptr a) -> IO (Ptr a)
throwErrorIfNull caller m action =
    do res <- action
       if res == nullPtr
          then throwError caller m
          else return res

withMagicPtr :: Magic -> (Ptr CMagic -> IO a) -> IO a
withMagicPtr (Magic mvar) a = withMVar mvar $ \m -> withForeignPtr m a

throwError :: String -> Ptr CMagic -> IO a
throwError caller cmagic =
               do errormsg <- magic_error cmagic
                  if errormsg /= nullPtr
                     then do em <- peekCString errormsg
                             fail $ caller ++ ": " ++ em
                     else fail $ caller ++ ": got error code but no error message"

checkIntError :: String -> Ptr CMagic -> IO CInt -> IO ()
checkIntError caller cmagic action = 
    do res <- action
       if res == 0
          then return ()
          else throwError caller cmagic

decodeOsPath :: OsPath -> IO (SBS.ShortByteString)
decodeOsPath p = case coercionToPlatformTypes of
    Right (_, co) -> return (getPosixString (coerceWith co p))
    -- libmagic built for windows with MinGW by eg
    -- https://github.com/nscaife/file-windows does not use
    -- wide bytes as are in WindowsString, so convert it using
    -- the locale encoding
    Left (_, co) ->
            encodeWithBasePosix' =<< decodeWithBaseWindows
                (getWindowsString (coerceWith co p))

foreign import ccall unsafe "magic.h &magic_close"
  magic_close :: FunPtr (Ptr CMagic -> IO ())

foreign import ccall unsafe "magic.h magic_error"
  magic_error :: Ptr CMagic -> IO CString