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

-- 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 #-}

module System.AugeasHsc where

import Foreign.C.Types


{-# LINE 29 "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

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