augeas-0.1: System/Augeas.hs
-- file: Setup.hs
-- Haskell bindings for the Augeas library
-- Copyright (c) 2009, Jude Nagurney
--
-- This program is free software; you can redistribute it and/or modify it
-- under the terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 2 of the License, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful, but
-- WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License along with this program;
-- if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
-- MA 02111-1307 USA
--
-- Contact the author at
-- jude@pwan.org
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-|
This module provides FFI bindings for the Augeas API (<http://augeas.net/docs/api.html>).
/Note aug_close is not surfaced in the API because because the ForeignPtr returned by/
/aug_init uses aug_close as its finializer./
-}
module System.Augeas
(
-- * Types
Augeas
, AugFlag,
none, save_backup, save_newfile, type_check
, AugMatch
, exactly_one, no_match, invalid_match
, AugRet
, success, System.Augeas.error
, AugBefore
, just_before, just_after
-- * Functions
, aug_init
, aug_get
, aug_set
, aug_insert
, aug_rm
, aug_mv
, aug_match
, aug_save
, aug_print
) where
import System.IO
import System.Posix.IO
import System.Posix.Types
import Foreign
import Foreign.C.Types
import Foreign.C.String
import GHC.Handle
import Data.ByteString
import AugeasHsc
-- --------------
-- Augeas pointer
-- --------------
{-|
A pointer to the Augeas tree structure
Not using a typed pointer (as per RWH p416) because of the compiler warning
-}
--newtype Augeas = Augeas (Ptr Augeas)
-- deriving (Eq, Show)
type Augeas = ()
-- ---------
-- aug_match
-- ---------
{-|
The possible 'aug_get' return values.
-}
newtype AugMatch = AugMatch CInt
deriving (Eq, Show)
{-|
Exactly one match was found.
-}
exactly_one :: AugMatch
exactly_one = AugMatch 1
{-|
No matches were found
-}
no_match :: AugMatch
no_match = AugMatch 0
{-|
Either an invalid paths, or multiple matches were found.
-}
invalid_match :: AugMatch
invalid_match = AugMatch (-1)
-- -------
-- aug_ret
-- -------
{-|
The possible return values for the 'aug_set', 'aug_insert', 'aug_mv', 'aug_save', and 'aug_print' functions
-}
newtype AugRet = AugRet CInt
deriving (Eq, Show)
{-|
The function worked as expected
-}
success :: AugRet
success = AugRet 0
{-|
The function failed
-}
error :: AugRet
error = AugRet (-1)
-- ----------
-- aug_before
-- ----------
{-|
The possible BEFORE values fro the aug_insert function
-}
newtype AugBefore = AugBefore CInt
deriving (Eq, Show)
{-|
Insert the LABEL just before the PATH
-}
just_before :: AugBefore
just_before = AugBefore 1
{-|
Insert the LABEL just after the PATH
-}
just_after :: AugBefore
just_after = AugBefore 0
-- utility functions
combineFlags :: [AugFlag] -> AugFlag
combineFlags = AugFlag . Prelude.foldr ((.|.) . unAugFlag) 0
-- --------
-- aug_init
-- --------
-- TODO: Replace loadpath string with a dedicated loadpath type ?
foreign import ccall unsafe "augeas.h aug_init"
c_aug_init :: CString -> CString -> AugFlag -> IO (Ptr Augeas)
{-|
Initialize the library.
Use ROOT as the filesystem root. If ROOT is NULL, use the value of the
environment variable AUGEAS_ROOT. If that doesn't exist either, use \"\/\".
LOADPATH is a colon-spearated list of directories that modules should be
searched in. This is in addition to the standard load path and the
directories in AUGEAS_LENS_LIB
FLAGS is a list of AugFlags
Return a ForeignPtr to the Augeas tree upon success. If initialization
fails, returns Nothing.
/Note that the ForeignPtr returned by the function is using aug_close as a finializer,/
/so aug_close is called automatically when the Augeas pointer goes out of scope./
/Therefore, there is no need to surface aug_close in the library./
-}
aug_init :: ByteString -- ^ ROOT
-> ByteString -- ^ LOADPATH
-> [AugFlag] -- ^ FLAGS
-> IO (Maybe (ForeignPtr Augeas)) -- ^ Augeas pointer
aug_init bstr1 bstr2 flags =
useAsCString bstr1 $ \root -> do
useAsCString bstr2 $ \loadpath -> do
aug_ptr <- c_aug_init root loadpath (combineFlags flags)
if (aug_ptr == nullPtr)
then do
return Nothing
else do
ret_ptr <- newForeignPtr c_aug_close aug_ptr -- release with aug_close
return (Just ret_ptr)
-- ---------
-- aug_close
-- ---------
foreign import ccall unsafe "augeas.h &aug_close"
c_aug_close :: FinalizerPtr Augeas
--{-|
-- from augeas.h:
-- Close this Augeas instance and free any storage associated with
-- it. After running AUG_CLOSE, AUG is invalid and can not be used for any
-- more operations.
---}
--aug_close :: FinalizerPtr Augeas
--aug_close = c_aug_close
-- -------
-- aug_get
-- -------
foreign import ccall unsafe "augeas.h aug_get"
c_aug_get :: Ptr Augeas -- aug
-> CString -- path
-> Ptr CString -- value
-> IO (AugMatch) -- return_value
{-|
Lookup the value associated with PATH. VALUE can be NULL, in which case
it is ignored. If VALUE is not NULL, it is used to return a pointer to
the value associated with PATH if PATH matches exactly one node. If PATH
matches no nodes or more than one node, *VALUE is set to NULL.
Return AugMatch.exactly_one if there is exactly one node matching PATH, AugMatch.no_match if there is none,
and AugMatch.invalid_match if there is more than one node matching PATH, or if
PATH is not a legal path expression.
-}
aug_get :: Ptr Augeas -- ^ Augeas pointer
-> ByteString -- ^ PATH
-> IO (Either AugMatch (Maybe String)) -- ^ Either AugMatch or VALUE
aug_get aug_ptr bstr1 =
useAsCString bstr1 $ \path -> do
alloca $ \value -> do
ret <- c_aug_get aug_ptr path value
if ret == exactly_one
then do
if value == nullPtr
then do
return (Left ret)
else do
peeked <- peek value
if peeked == nullPtr
then do
return (Right Nothing)
else do
str_peeked <- peekCString peeked
return (Right (Just str_peeked))
else do
return (Left ret)
-- -------
-- aug_set
-- -------
foreign import ccall unsafe "augeas.h aug_set"
c_aug_set :: Ptr Augeas -- aug
-> CString -- path
-> CString -- value
-> IO (AugRet) -- return value
{-|
Set the value associated with PATH to VALUE. VALUE is copied into the
internal data structure. Intermediate entries are created if they don't
exist.
Return AugRet.success on success, AugRet.error on error. It is an error if more than one
node matches PATH.
-}
aug_set :: Ptr Augeas -- ^ Augeas pointer
-> ByteString -- ^ PATH
-> ByteString -- ^ VALUE
-> IO (AugRet) -- ^ return value
aug_set aug_ptr bs1 bs2 =
useAsCString bs1 $ \path -> do
useAsCString bs2 $ \value -> do
ret <- c_aug_set aug_ptr path value
return ret
-- ----------
-- aug_insert
-- ----------
foreign import ccall unsafe "augeas.h aug_insert"
c_aug_insert :: Ptr Augeas -- aug
-> CString -- path
-> CString -- label
-> AugBefore -- before
-> IO (AugRet) -- return value
{-|
Create a new sibling LABEL for PATH by inserting into the tree just
before PATH if BEFORE == just_before or just after PATH if BEFORE == just_after.
PATH must match exactly one existing node in the tree, and LABEL must be
a label, i.e. not contain a '/', '*' or end with a bracketed index
'[N]'.
Return AugRet.success on success, and AugRet.error if the insertion fails.
-}
aug_insert :: Ptr Augeas -- ^ Augeas pointer
-> ByteString -- ^ PTH
-> ByteString -- ^ LABEL
-> AugBefore -- ^ BEFORE
-> IO (AugRet) -- ^ return value
aug_insert aug_ptr bs1 bs2 before =
useAsCString bs1 $ \path -> do
useAsCString bs2 $ \label -> do
ret <- c_aug_insert aug_ptr path label before
return ret
-- ------
-- aug_rm
-- ------
foreign import ccall unsafe "augeas.h aug_rm"
c_aug_rm :: Ptr Augeas -- aug
-> CString -- path
-> IO (CInt) -- return value
{-|
Remove path and all its children. Returns the number of entries removed.
All nodes that match PATH, and their descendants, are removed.
-}
aug_rm :: Ptr Augeas -- ^ Augeas pointer
-> ByteString -- ^ PATH
-> IO (CInt) -- ^ number of entries removed
aug_rm aug_ptr bs_path =
useAsCString bs_path $ \path -> do
ret <- c_aug_rm aug_ptr path
return ret
-- ------
-- aug_mv
-- ------
foreign import ccall unsafe "augeas.h aug_mv"
c_aug_mv :: Ptr Augeas -- aug
-> CString -- src
-> CString -- dst
-> IO (AugRet) -- return value
{- |
Move the node SRC to DST. SRC must match exactly one node in the
tree. DST must either match exactly one node in the tree, or may not
exist yet. If DST exists already, it and all its descendants are
deleted. If DST does not exist yet, it and all its missing ancestors are
created.
Note that the node SRC always becomes the node DST: when you move \/a\/b
to \/x, the node \/a\/b is now called \/x, no matter whether \/x existed
initially or not.
Return AugRet.success on success and AugRet.error on failure.
-}
aug_mv :: Ptr Augeas -- ^ Augeas pointer
-> ByteString -- ^ SRC
-> ByteString -- ^ DEST
-> IO (AugRet) -- ^ return value
aug_mv aug_ptr bs_src bs_dst =
useAsCString bs_src $ \src -> do
useAsCString bs_dst $ \dst -> do
ret <- c_aug_mv aug_ptr src dst
return ret
-- ---------
-- aug_match
-- ---------
foreign import ccall unsafe "augeas.h aug_match"
c_aug_match :: Ptr Augeas -- aug
-> CString -- path
-> Ptr (Ptr CString) -- matches
-> IO (CInt) -- return value
{-|
Return the number of matches of the path expression PATH in AUG. If
MATCHES is non-NULL, an array with the returned number of elements will
be allocated and filled with the paths of the matches. The caller must
free both the array and the entries in it. The returned paths are
sufficiently qualified to make sure that they match exactly one node in
the current tree.
If MATCHES is NULL, nothing is allocated and only the number
of matches is returned.
Returns -1 on error, or the total number of matches (which might be 0).
Path expressions use a very simple subset of XPath: the path PATH
consists of a number of segments, separated by '/'; each segment can
either be a '*', matching any tree node, or a string, optionally
followed by an index in brackets, matching tree nodes labelled with
exactly that string. If no index is specified, the expression matches
all nodes with that label; the index can be a positive number N, which
matches exactly the Nth node with that label (counting from 1), or the
special expression 'last()' which matches the last node with the given
label. All matches are done in fixed positions in the tree, and nothing
matches more than one path segment.
-}
aug_match :: Ptr Augeas -- ^ Augeas pointer
-> ByteString -- ^ PATH
-> IO (Int, Maybe [String]) -- ^ (match count, MATCHES)
aug_match aug_ptr bs_path =
useAsCString bs_path $ \path -> do
alloca $ \matches -> do
ret <- c_aug_match aug_ptr path matches
if ret == -1
then do
return (-1, Nothing)
else do
matches_cstrs <- peekArray (fromIntegral ret) =<< peek matches
-- There's got to be a better way to map (IO [CString]) to (IO [String]) ...
matches_strs <- Prelude.foldr (\t io_l -> do s <- peekCString t; l <- io_l; return (s:l)) (return []) matches_cstrs
return (fromIntegral ret, Just matches_strs)
-- --------
-- aug_save
-- --------
foreign import ccall unsafe "augeas.h aug_save"
c_aug_save :: Ptr Augeas -- aug
-> IO (AugRet) -- return value
{-|
Write all pending changes to disk.
Return AugRet.error if an error is encountered, AugRet.success on success.
Only files that had any changes made to them are written.
If AUG_SAVE_NEWFILE is set in the FLAGS passed to AUG_INIT, create
changed files as new files with the extension ".augnew", and leave teh
original file unmodified.
Otherwise, if AUG_SAVE_BACKUP is set in the FLAGS passed to AUG_INIT,
move the original file to a new file with extension ".augsave".
If neither of these flags is set, overwrite the original file.
-}
aug_save :: Ptr Augeas -- ^ Augeas pointer
-> IO (AugRet) -- ^ return value
aug_save aug_ptr =
do
ret <- c_aug_save aug_ptr
return ret
-- ---------
-- aug_print
-- ---------
-- FILE *fdopen(int fildes, const char *mode);
foreign import ccall "" fdopen :: Fd -> CString -> IO (Ptr CFile)
foreign import ccall "" fflush :: (Ptr CFile) -> IO (Int)
foreign import ccall "" fclose :: (Ptr CFile) -> IO (Int)
handleToCFile :: Handle -> String -> IO (Ptr CFile)
handleToCFile h m =
do iomode <- newCString m
-- Duplicate the handle, so the original stays open after the handleToFd call closes the duplicate
dup_h <- hDuplicate h
fd <- handleToFd dup_h
fdopen fd iomode
-- surface aug_print
foreign import ccall unsafe "augeas.h aug_print"
c_aug_print :: Ptr Augeas -- aug
-> Ptr CFile -- out
-> CString -- path
-> IO (AugRet) -- return value
{-|
Print each node matching PATH and its descendants to OUT.
Return AugRet.success on success, or AugRet.error on failure
-}
aug_print :: Ptr Augeas -- ^ Augeas pointer
-> Handle -- ^ Already opened file handle
-> ByteString -- ^ PATH
-> IO (AugRet) -- ^ return value
aug_print aug_ptr fptr_out bs_path =
do
useAsCString bs_path $ \path -> do
out <- handleToCFile fptr_out "w"
ret <- c_aug_print aug_ptr out path
fflush out
fclose out
return(ret)