{-# LINE 1 "System/AugeasHsc.hsc" #-}
-- file: Augeas.hsc
{-# LINE 2 "System/AugeasHsc.hsc" #-}

-- Haskell bindings for the Augeas library
-- Copyright (c) 2009-2012, Jude Nagurney

-- This library is free software; you can redistribute it and/or modify it 
-- under the terms of the GNU Lesser General Public License as published by 
-- the Free Software Foundation; either version 3 of the License, or 
-- (at your option) any later version.

-- This library 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 Lesser General Public 
-- License for more details.

-- You should have received a copy of the GNU Lesser General Public License 
-- along with this library; 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, EmptyDataDecls, StandaloneDeriving #-}


{-# LINE 30 "System/AugeasHsc.hsc" #-}

module System.AugeasHsc where

import Foreign.C.Types
import Foreign.Storable


{-# LINE 37 "System/AugeasHsc.hsc" #-}


-- ----------------------------------
-- Maps to aug_flags enum in augeas.h
-- ----------------------------------

newtype AugFlag = AugFlag { unAugFlag :: CInt }
        deriving (Eq, Show)

none  :: AugFlag
none  = AugFlag 0
save_backup  :: AugFlag
save_backup  = AugFlag 1
save_newfile  :: AugFlag
save_newfile  = AugFlag 2
type_check  :: AugFlag
type_check  = AugFlag 4
no_stdinc  :: AugFlag
no_stdinc  = AugFlag 8
save_noop  :: AugFlag
save_noop  = AugFlag 16
no_load  :: AugFlag
no_load  = AugFlag 32
no_modl_autoload  :: AugFlag
no_modl_autoload  = AugFlag 64
enable_span  :: AugFlag
enable_span  = AugFlag 128

{-# LINE 59 "System/AugeasHsc.hsc" #-}

-- ---------------------------------
-- Maps to auf_errcode_t in augeas.h
-- ---------------------------------

newtype AugErrCode = AugErrCode { unAugErrCode :: CInt }
        deriving (Eq, Show)

no_error  :: AugErrCode
no_error  = AugErrCode 0
err_no_memory  :: AugErrCode
err_no_memory  = AugErrCode 1
err_internal  :: AugErrCode
err_internal  = AugErrCode 2
err_bad_path  :: AugErrCode
err_bad_path  = AugErrCode 3
err_no_match  :: AugErrCode
err_no_match  = AugErrCode 4
err_multi_matches  :: AugErrCode
err_multi_matches  = AugErrCode 5
err_syntax  :: AugErrCode
err_syntax  = AugErrCode 6
err_no_lens  :: AugErrCode
err_no_lens  = AugErrCode 7
err_multi_xfm  :: AugErrCode
err_multi_xfm  = AugErrCode 8
err_no_span  :: AugErrCode
err_no_span  = AugErrCode 9
err_mv_desc  :: AugErrCode
err_mv_desc  = AugErrCode 10
err_cmd_run  :: AugErrCode
err_cmd_run  = AugErrCode 11

{-# LINE 88 "System/AugeasHsc.hsc" #-}


data AugeasXmlNode