-- GENERATED by C->Haskell Compiler, version 0.25.2 Snowboundest, 31 Oct 2014 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Language/Libconfig/Bindings.chs" #-}
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

{-|
Module      :  Language.Libconfig.Bindings
Copyright   :  (c) Matthew Peddie 2014
License     :  BSD3

Maintainer  :  mpeddie@gmail.com
Stability   :  experimental
Portability :  GHC

Low-level FFI bindings to the <http://www.hyperrealm.com/libconfig/ libconfig>
configuration file library.  Please see the
<http://www.hyperrealm.com/libconfig/libconfig_manual.html libconfig manual>
for documentation on what the various functions actually do and the
underlying model of the libconfig API.  The documentation in this
module contains many usage examples which double as tests, but the
focus is only on FFI details and C-vs.-Haskell impedance mismatches.
As a result, there is no explanation of the behavior of many of the
functions.

-}

module Language.Libconfig.Bindings (
  -- * Doctest example setup

  -- $setup
  -- * Types
  Configuration
  , Setting
  , ConfigErr(..)
  , ConfigType(..)
  , isCollectionType
  , isScalarType
  , ConfigFormat(..)
    -- * Resource management
  , configInit
  , configNew
  , touchConfiguration
    -- * Config I/O
  , configReadFile
  , configWriteFile
  , configReadString
    -- * Safe (capable of returning an error) getting of primitive
    -- settings from the parent setting, by name.

    -- | These Haskell functions return 'Nothing' if the lookup fails,
    -- there is a type mismatch, etc.
  , configSettingLookupInt
  , configSettingLookupInt64
  , configSettingLookupFloat
  , configSettingLookupBool
  , configSettingLookupString
    -- * Unsafe getting of primitives

    -- |
    -- These functions are sketchy if used directly, because there is
    -- no way to distinguish between a successful result and a failure
    -- (at the @libconfig@ level).  Take care to only ever use these
    -- once you've already checked the 'ConfigType' of the 'Setting'
    -- using 'configSettingType'.
  , configSettingGetInt
  , configSettingGetInt64
  , configSettingGetFloat
  , configSettingGetBool
  , configSettingGetString
    -- * Setting of primitives

    -- | These functions return a value of type 'Maybe' @()@, indicating
    -- whether the action was successful.  (It may fail if, for
    -- example, there is a setting type mismatch.)
  , configSettingSetInt
  , configSettingSetInt64
  , configSettingSetFloat
  , configSettingSetBool
  , configSettingSetString
    -- * Unsafe getting of primitives from a collection

    -- |
    -- These functions are sketchy if used directly, because there is
    -- no way to distinguish between a successful result and a failure
    -- (at the @libconfig@ level).  Take care to only ever use these
    -- once you've already checked the 'ConfigType' of the element
    -- using 'configSettingType' or verified it for other elements of
    -- an array.
    --
    -- These functions may be used on collections with type
    -- 'GroupType', 'ArrayType' or 'ListType'.
  , configSettingGetIntElem
  , configSettingGetInt64Elem
  , configSettingGetFloatElem
  , configSettingGetBoolElem
  , configSettingGetStringElem
    -- * Setting of primitives within a collection

    -- | In the event of an out-of-bounds index or a type mismatch,
    -- these functions return 'Nothing'.  If the function succeeds,
    -- the Setting that is returned will be either the same 'Setting'
    -- that previously existed at that spot or a newly allocated one.
    --
    -- These functions may be used on collections with type
    -- 'ArrayType' or 'ListType' (but __not__ 'GroupType').
  , configSettingSetIntElem
  , configSettingSetInt64Elem
  , configSettingSetFloatElem
  , configSettingSetBoolElem
  , configSettingSetStringElem
    -- * Direct lookup by path

    -- | In the event of a name lookup failure or type mismatch, these
    -- functions return 'Nothing'.
  , configLookup
  , configLookupFrom
  , configLookupInt
  , configLookupInt64
  , configLookupFloat
  , configLookupBool
  , configLookupString
    -- * Collection management
  , configSettingIndex
  , configSettingLength
  , configSettingGetElem
  , configSettingGetMember
  , configSettingAdd
  , configSettingRemove
  , configSettingRemoveElem
    -- * Miscellaneous
  , configSettingName
  , configSettingParent
  , configSettingIsRoot
  , configRootSetting
  , configSettingSourceLine
  , configSettingSourceFile
    -- ** Formatting
  , configGetDefaultFormat
  , configSetDefaultFormat
  , configSettingGetFormat
  , configSettingSetFormat
  , configGetTabWidth
  , configSetTabWidth
    -- * Error reporting
  , configErrorFile
  , configErrorText
  , configErrorLine
  , configErrorType
    -- * Config file type system
  , configSettingType
  , configSettingIsGroup
  , configSettingIsList
  , configSettingIsArray
  , configSettingIsAggregate
  , configSettingIsNumber
  , configSettingIsScalar
  ) where

import Foreign
import Foreign.C
import Control.Monad ((>=>))
import Control.Applicative

import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)

-- $setup
--
-- All the examples run on the included test file @test/test.conf@,
-- which is reproduced here from the
-- <http://www.hyperrealm.com/libconfig/libconfig_manual.html#Configuration-Files libconfig manual>.
--
-- @
--      # Example application configuration file
--
--      version = "1.0";
--
--      application:
--      {
--        window:
--        {
--          title = "My Application";
--          size = { w = 640; h = 480; };
--          pos = { x = 350; y = 250; };
--        };
--
--        list = ( ( "abc", 123, true ), 1.234, ( /* an empty list */) );
--
--        books = ( { title  = "Treasure Island";
--                    author = "Robert Louis Stevenson";
--                    price  = 29.95;
--                    qty    = 5; },
--                  { title  = "Snow Crash";
--                    author = "Neal Stephenson";
--                    price  = 9.99;
--                    qty    = 8; } );
--
--        misc:
--        {
--          pi = 3.141592654;
--          bigint = 9223372036854775807L;
--          columns = [ "Last Name", "First Name", "MI" ];
--          bitmask = 0x1FC3;
--        };
--      };
-- @
--
-- The following setup actions are assumed for many of the usage
-- examples below.
--
-- >>> Just conf <- configNew "test/test.conf"
-- >>> Just app <- configLookup conf "application"
-- >>> Just misc <- configLookupFrom app "misc"
-- >>> Just winsize <- configLookupFrom app "window.size"
--
-- @conf'@ is used for modifying values.
--
-- >>> Just conf' <- configNew "test/test.conf"
--



-- | This is a set of possible errors that can occur when @libconfig@
-- tries to read in a config file.
data ConfigErr = ConfigErrNone
               | ConfigErrFileIo
               | ConfigErrParse
  deriving (Show,Eq)
instance Enum ConfigErr where
  succ ConfigErrNone = ConfigErrFileIo
  succ ConfigErrFileIo = ConfigErrParse
  succ ConfigErrParse = error "ConfigErr.succ: ConfigErrParse has no successor"

  pred ConfigErrFileIo = ConfigErrNone
  pred ConfigErrParse = ConfigErrFileIo
  pred ConfigErrNone = error "ConfigErr.pred: ConfigErrNone has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from ConfigErrParse

  fromEnum ConfigErrNone = 0
  fromEnum ConfigErrFileIo = 1
  fromEnum ConfigErrParse = 2

  toEnum 0 = ConfigErrNone
  toEnum 1 = ConfigErrFileIo
  toEnum 2 = ConfigErrParse
  toEnum unmatched = error ("ConfigErr.toEnum: Cannot match " ++ show unmatched)

{-# LINE 227 "src/Language/Libconfig/Bindings.chs" #-}



-- | This is a set of possible @libconfig@ types.  Many functions will
-- return 'Nothing' if you attempt to use a value as the incorrect
-- type.  See the @libconfig@ manual for more details.
data ConfigType = NoneType
                | GroupType
                | IntType
                | Int64Type
                | FloatType
                | StringType
                | BoolType
                | ArrayType
                | ListType
                deriving (Eq, Show, Read, Ord, Enum, Bounded, Data, Typeable, Generic)

-- | Tells whether a 'ConfigType' value is a collection ('ListType',
-- 'ArrayType' or 'GroupType').
--
-- >>> isCollectionType GroupType
-- True
-- >>> isCollectionType BoolType
-- False
isCollectionType :: ConfigType -> Bool
isCollectionType ArrayType = True
isCollectionType ListType  = True
isCollectionType GroupType = True
isCollectionType _         = False

-- | Tells whether a 'ConfigType' value is a scalar (i.e. not a
-- collection).
--
-- >>> isScalarType FloatType
-- True
--
-- >>> isScalarType ListType
-- False
--
-- __Note:__
--
-- >>> isScalarType NoneType
-- True
isScalarType :: ConfigType -> Bool
isScalarType = not . isCollectionType


fromEnumIntegral :: (Enum c, Integral a) => c -> a
fromEnumIntegral = fromIntegral . fromEnum

toEnumIntegral :: (Enum c, Integral a) => a -> c
toEnumIntegral = toEnum . fromIntegral

-- | This is used for fine-grained configuration of how integers are
-- output when a config file is written.  See 'configGetDefaultFormat'
-- and the @libconfig@ manual.
data ConfigFormat = DefaultFormat
                  | HexFormat
                  deriving (Eq, Show, Read, Ord, Enum, Bounded, Data, Typeable, Generic)

data ConfigBool = ConfigFalse
                | ConfigTrue
                deriving (Eq, Show, Read, Ord, Enum, Bounded, Data, Typeable, Generic)

type ConfigListPtr = Ptr (ConfigList)
{-# LINE 291 "src/Language/Libconfig/Bindings.chs" #-}


type SettingPtr = Ptr (Setting')
{-# LINE 293 "src/Language/Libconfig/Bindings.chs" #-}


type ConfigPtr = Ptr (Config)
{-# LINE 295 "src/Language/Libconfig/Bindings.chs" #-}


data ConfigList = ConfigList {
  length'ConfigList :: CUInt
  , elements'ConfigList :: Ptr SettingPtr
  }

instance Storable ConfigList where
  sizeOf _ = 8
{-# LINE 303 "src/Language/Libconfig/Bindings.chs" #-}

  alignment _ = 4
{-# LINE 304 "src/Language/Libconfig/Bindings.chs" #-}

  peek p = ConfigList <$>
           (\ptr -> do {peekByteOff ptr 0 :: IO CUInt}) p <*>
           (\ptr -> do {peekByteOff ptr 4 :: IO (Ptr (SettingPtr))}) p
  poke p ConfigList{..} = do
    (\ptr val -> do {pokeByteOff ptr 0 (val :: CUInt)}) p length'ConfigList
    (\ptr val -> do {pokeByteOff ptr 4 (val :: (Ptr (SettingPtr)))}) p elements'ConfigList

data ConfigValue = IVal CInt
                 | LLVal CLLong
                 | FVal CDouble
                 | SVal CString
                 | List ConfigListPtr
                 | None

configValueType :: ConfigValue -> String
configValueType (IVal _) = "IVal"
configValueType (LLVal _) = "LLVal"
configValueType (FVal _) = "FVal"
configValueType (SVal _) = "SVal"
configValueType (List _) = "List"
configValueType None = "None"

data Setting' = Setting' {
    name'Setting :: CString
    , type'Setting :: CShort
    , format'Setting :: CShort
    , value'Setting :: ConfigValue
    , parent'Setting :: SettingPtr
    , config'Setting :: ConfigPtr
    , hook'Setting :: Ptr ()
    , line'Setting :: CUInt
    , file'Setting :: CString
    }

peekConfigValue :: Ptr b -> Int -> ConfigType -> IO ConfigValue
peekConfigValue p n IntType = IVal <$> (peekByteOff p n :: IO CInt)
peekConfigValue p n BoolType = IVal <$> (peekByteOff p n :: IO CInt)
peekConfigValue p n Int64Type = LLVal <$> (peekByteOff p n :: IO CLLong)
peekConfigValue p n FloatType = FVal <$> (peekByteOff p n :: IO CDouble)
peekConfigValue p n StringType = SVal <$> (peekByteOff p n :: IO CString)
peekConfigValue _ _ NoneType = return None
-- I hope this applies for all aggregate types . . .
peekConfigValue p n _ = List <$> (peekByteOff p n :: IO (Ptr ConfigList))

pokeConfigValue :: Ptr b -> Int -> ConfigValue -> ConfigType -> IO ()
pokeConfigValue p n (IVal x) IntType = pokeByteOff p n x
pokeConfigValue p n (IVal x) BoolType = pokeByteOff p n x
pokeConfigValue p n (LLVal x) Int64Type = pokeByteOff p n x
pokeConfigValue p n (FVal x) FloatType = pokeByteOff p n x
pokeConfigValue p n (SVal x) StringType = pokeByteOff p n x
pokeConfigValue _ _ None NoneType = return ()
pokeConfigValue p n (List x) ListType = pokeByteOff p n x
pokeConfigValue p n (List x) GroupType = pokeByteOff p n x
pokeConfigValue p n (List x) ArrayType = pokeByteOff p n x
pokeConfigValue _ _ v ty =
  error $ "Internal error: libconfig type mismatch between config_value_t '" ++
          configValueType v ++ "' and config_setting_t type tag '" ++
          show ty ++ "'!"

instance Storable Setting' where
  sizeOf _ = 36
{-# LINE 365 "src/Language/Libconfig/Bindings.chs" #-}

  alignment _ = 4
{-# LINE 366 "src/Language/Libconfig/Bindings.chs" #-}

  peek p = do
    nm <- (\ptr -> do {peekByteOff ptr 0 :: IO (Ptr CChar)}) p
    ty <- (\ptr -> do {peekByteOff ptr 4 :: IO CShort}) p
    fmt <- (\ptr -> do {peekByteOff ptr 6 :: IO CShort}) p
    val <- peekConfigValue p 8 (toEnumIntegral ty)
    Setting' nm ty fmt val <$>
           (\ptr -> do {peekByteOff ptr 16 :: IO (SettingPtr)}) p <*>
           (\ptr -> do {peekByteOff ptr 20 :: IO (ConfigPtr)}) p <*>
           (\ptr -> do {peekByteOff ptr 24 :: IO (Ptr ())}) p <*>
           (\ptr -> do {peekByteOff ptr 28 :: IO CUInt}) p <*>
           (\ptr -> do {peekByteOff ptr 32 :: IO (Ptr CChar)}) p
  poke p Setting'{..} = do
    (\ptr val -> do {pokeByteOff ptr 0 (val :: (Ptr CChar))}) p name'Setting
    (\ptr val -> do {pokeByteOff ptr 4 (val :: CShort)}) p type'Setting
    (\ptr val -> do {pokeByteOff ptr 6 (val :: CShort)}) p format'Setting
    pokeConfigValue p 8 value'Setting (toEnumIntegral type'Setting)
    (\ptr val -> do {pokeByteOff ptr 16 (val :: (SettingPtr))}) p parent'Setting
    (\ptr val -> do {pokeByteOff ptr 20 (val :: (ConfigPtr))}) p config'Setting
    (\ptr val -> do {pokeByteOff ptr 24 (val :: (Ptr ()))}) p hook'Setting
    (\ptr val -> do {pokeByteOff ptr 28 (val :: CUInt)}) p line'Setting
    (\ptr val -> do {pokeByteOff ptr 32 (val :: (Ptr CChar))}) p file'Setting

-- libconfig itself manages all the 'Setting's, including deallocation
-- and allocation, so we don't have to use a 'ForeignPtr' or
-- 'StablePtr' here.  TODO(MP): Ensure that a 'Setting' can't get used
-- outside the scope of its parent 'Configuration'

-- | Corresponds to a @libconfig@ @config_setting_t@ value; wrapped
-- opaquely for pointer safety.
newtype Setting = Setting { getSetting :: Ptr Setting' } deriving (Eq)

data Config = Config {
    root'Config :: SettingPtr
  , destructor'Config :: FunPtr (Ptr () -> IO ())
  , flags'Config :: CUShort
  , tab_width'Config :: CUShort
  , default_format'Config :: CShort
  , include_dir'Config :: CString
  , error_text'Config :: CString
  , error_file'Config :: CString
  , error_line'Config :: CInt
  , error_type'Config :: CInt
  , filenames'Config :: Ptr CString
  , num_filenames'Config :: CUInt
  }

instance Storable Config where
  sizeOf _ = 44
{-# LINE 414 "src/Language/Libconfig/Bindings.chs" #-}

  alignment _  = 4
{-# LINE 415 "src/Language/Libconfig/Bindings.chs" #-}

  peek p = Config <$>
           ((\ptr -> do {peekByteOff ptr 0 :: IO (SettingPtr)}) p) <*>
           ((\ptr -> do {peekByteOff ptr 4 :: IO (FunPtr ((Ptr ()) -> (IO ())))}) p) <*>
           ((\ptr -> do {peekByteOff ptr 8 :: IO CUShort}) p) <*>
           ((\ptr -> do {peekByteOff ptr 10 :: IO CUShort}) p) <*>
           ((\ptr -> do {peekByteOff ptr 12 :: IO CShort}) p) <*>
           ((\ptr -> do {peekByteOff ptr 16 :: IO (Ptr CChar)}) p) <*>
           ((\ptr -> do {peekByteOff ptr 20 :: IO (Ptr CChar)}) p) <*>
           ((\ptr -> do {peekByteOff ptr 24 :: IO (Ptr CChar)}) p) <*>
           ((\ptr -> do {peekByteOff ptr 28 :: IO CInt}) p) <*>
           ((\ptr -> do {peekByteOff ptr 32 :: IO CInt}) p) <*>
           ((\ptr -> do {peekByteOff ptr 36 :: IO (Ptr (Ptr CChar))}) p) <*>
           ((\ptr -> do {peekByteOff ptr 40 :: IO CUInt}) p)
  poke p Config{..} = do
           (\ptr val -> do {pokeByteOff ptr 0 (val :: (SettingPtr))}) p root'Config
           (\ptr val -> do {pokeByteOff ptr 4 (val :: (FunPtr ((Ptr ()) -> (IO ()))))}) p destructor'Config
           (\ptr val -> do {pokeByteOff ptr 8 (val :: CUShort)}) p flags'Config
           (\ptr val -> do {pokeByteOff ptr 10 (val :: CUShort)}) p tab_width'Config
           (\ptr val -> do {pokeByteOff ptr 12 (val :: CShort)}) p default_format'Config
           (\ptr val -> do {pokeByteOff ptr 16 (val :: (Ptr CChar))}) p include_dir'Config
           (\ptr val -> do {pokeByteOff ptr 20 (val :: (Ptr CChar))}) p error_text'Config
           (\ptr val -> do {pokeByteOff ptr 24 (val :: (Ptr CChar))}) p error_file'Config
           (\ptr val -> do {pokeByteOff ptr 28 (val :: CInt)}) p error_line'Config
           (\ptr val -> do {pokeByteOff ptr 32 (val :: CInt)}) p error_type'Config
           (\ptr val -> do {pokeByteOff ptr 36 (val :: (Ptr (Ptr CChar)))}) p filenames'Config
           (\ptr val -> do {pokeByteOff ptr 40 (val :: CUInt)}) p num_filenames'Config

foreign import ccall unsafe "src/Language/Libconfig.chs.h config_init"
  configInit' :: Ptr Config -> IO ()

foreign import ccall unsafe "src/Language/Libconfig.chs.h &config_destroy"
  configDestroy' :: FunPtr (Ptr Config -> IO ())

-- | Top-level configuration value, corresponding to the libconfig
-- @config_t@.  Wrapped opaquely for pointer-safety.
newtype Configuration = Configuration { getConfiguration :: ForeignPtr Config }
                      deriving (Eq)

-- | This function allocates a new 'Configuration' and initializes it.
configInit :: IO Configuration
configInit = do
  c <- mallocForeignPtr
  addForeignPtrFinalizer configDestroy' c
  withForeignPtr c configInit'
  return $ Configuration c

withConfiguration :: Configuration -> (Ptr Config -> IO a) -> IO a
withConfiguration (Configuration c) = withForeignPtr c

modifyConfiguration :: Configuration -> (Config -> Config) -> IO ()
modifyConfiguration (Configuration p) mf = withForeignPtr p $ \cp -> do
  c <- peek cp
  poke cp $ mf c

-- |
-- @libconfig@ manages storage for all 'Setting' objects via the
-- 'Configuration', so if a 'Configuration' goes out of scope, GHC may
-- get rid of it, and any 'Setting' objects may become invalid.  This
-- function can be used to ensure that a 'Configuration' doesn't get
-- automatically garbage-collected too early.
touchConfiguration :: Configuration -> IO ()
touchConfiguration = touchForeignPtr . getConfiguration

onConfiguration :: (Config -> a) -> Configuration -> IO a
onConfiguration f = flip withConfiguration (fmap f . peek)

{- Marshalling -}

checkPtr :: Storable a => Ptr a -> Maybe (Ptr a)
checkPtr p
  | nullPtr == p = Nothing
  | otherwise    = Just p

checkSetting :: Ptr Setting' -> Maybe Setting
checkSetting = fmap Setting . checkPtr

peekIntegral :: (Integral a, Storable a, Num b) => Ptr a -> IO b
peekIntegral = fmap fromIntegral . peek

peekFloat :: (Real a, Storable a, Fractional b) => Ptr a -> IO b
peekFloat = fmap realToFrac . peek

peekBool :: (Eq a, Num a, Storable a) => Ptr a -> IO Bool
peekBool = fmap toBool . peek

peekString :: Ptr CString -> IO String
peekString = peek >=> peekCString

asBool :: Integral a => a -> ConfigBool
asBool = toEnum . fromIntegral

checkBool :: Integral a => a -> Maybe ()
checkBool a = case asBool a of
  ConfigTrue  -> Just ()
  ConfigFalse -> Nothing

checkTuple :: (ConfigBool, a) -> Maybe a
checkTuple (ConfigTrue, x) = Just x
checkTuple _               = Nothing

{- Resource management -}

{- I/O -}

-- | Read in a 'Configuration' from the specified configuration file.
-- The 'Configuration' should already be initialized with
-- 'configInit'.
configReadFile :: (Configuration) -> (String) -> IO ((Maybe ()))
configReadFile a1 a2 =
  withConfiguration a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  configReadFile'_ a1' a2' >>= \res ->
  let {res' = checkBool res} in
  return (res')

{-# LINE 524 "src/Language/Libconfig/Bindings.chs" #-}


-- | Create a new 'Configuration' and read in the data from the
-- specified configuration file.
--
-- >> configNew s = configInit >>= \c -> configReadFile c s
configNew :: String -> IO (Maybe Configuration)
configNew s = do
  c <- configInit
  red <- configReadFile c s
  return $ case red of
            Nothing -> Nothing
            Just _  -> Just c

-- | Write out a 'Configuration' to the specified configuration file.
configWriteFile :: (Configuration) -> (String) -> IO ((Maybe ()))
configWriteFile a1 a2 =
  withConfiguration a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  configWriteFile'_ a1' a2' >>= \res ->
  let {res' = checkBool res} in
  return (res')

{-# LINE 540 "src/Language/Libconfig/Bindings.chs" #-}


-- | Read configuration data from a string.
configReadString :: (Configuration) -> (String) -> IO ((Maybe ()))
configReadString a1 a2 =
  withConfiguration a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  configReadString'_ a1' a2' >>= \res ->
  let {res' = checkBool res} in
  return (res')

{-# LINE 544 "src/Language/Libconfig/Bindings.chs" #-}


{- Unsafe getting -}

-- |
-- >>> Just appwinwidth <- configLookup conf "application.window.size.w"
-- >>> configSettingGetInt appwinwidth
-- 640
configSettingGetInt :: (Setting) -> IO ((Int))
configSettingGetInt a1 =
  let {a1' = getSetting a1} in 
  configSettingGetInt'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 552 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just miscbigint <- configLookup conf "application.misc.bigint"
-- >>> configSettingGetInt64 miscbigint
-- 9223372036854775807
configSettingGetInt64 :: (Setting) -> IO ((Int64))
configSettingGetInt64 a1 =
  let {a1' = getSetting a1} in 
  configSettingGetInt64'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 558 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just miscpi <- configLookup conf "application.misc.pi"
-- >>> configSettingGetFloat miscpi
-- 3.141592654
configSettingGetFloat :: (Setting) -> IO ((Double))
configSettingGetFloat a1 =
  let {a1' = getSetting a1} in 
  configSettingGetFloat'_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 564 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just listbool <- configLookup conf "application.list.[0].[2]"
-- >>> configSettingGetBool listbool
-- True
configSettingGetBool :: (Setting) -> IO ((Bool))
configSettingGetBool a1 =
  let {a1' = getSetting a1} in 
  configSettingGetBool'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 570 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just wintitle <- configLookup conf "application.window.title"
-- >>> configSettingGetString wintitle
-- "My Application"
configSettingGetString :: (Setting) -> IO ((String))
configSettingGetString a1 =
  let {a1' = getSetting a1} in 
  configSettingGetString'_ a1' >>= \res ->
  peekCString res >>= \res' ->
  return (res')

{-# LINE 576 "src/Language/Libconfig/Bindings.chs" #-}


{- Safe getting -}

configSettingLookupInt' :: (Setting) -> (String) -> IO ((ConfigBool), (Int))
configSettingLookupInt' a1 a2 =
  let {a1' = getSetting a1} in 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  configSettingLookupInt''_ a1' a2' a3' >>= \res ->
  let {res' = asBool res} in
  peekIntegral  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 581 "src/Language/Libconfig/Bindings.chs" #-}


configSettingLookupInt64' :: (Setting) -> (String) -> IO ((ConfigBool), (Int64))
configSettingLookupInt64' a1 a2 =
  let {a1' = getSetting a1} in 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  configSettingLookupInt64''_ a1' a2' a3' >>= \res ->
  let {res' = asBool res} in
  peekIntegral  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 584 "src/Language/Libconfig/Bindings.chs" #-}


configSettingLookupFloat' :: (Setting) -> (String) -> IO ((ConfigBool), (Double))
configSettingLookupFloat' a1 a2 =
  let {a1' = getSetting a1} in 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  configSettingLookupFloat''_ a1' a2' a3' >>= \res ->
  let {res' = asBool res} in
  peekFloat  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 587 "src/Language/Libconfig/Bindings.chs" #-}


configSettingLookupBool' :: (Setting) -> (String) -> IO ((ConfigBool), (Bool))
configSettingLookupBool' a1 a2 =
  let {a1' = getSetting a1} in 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  configSettingLookupBool''_ a1' a2' a3' >>= \res ->
  let {res' = asBool res} in
  peekBool  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 590 "src/Language/Libconfig/Bindings.chs" #-}


configSettingLookupString' :: (Setting) -> (String) -> IO ((ConfigBool), (String))
configSettingLookupString' a1 a2 =
  let {a1' = getSetting a1} in 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  configSettingLookupString''_ a1' a2' a3' >>= \res ->
  let {res' = asBool res} in
  peekString  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 593 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> configSettingLookupInt winsize "w"
-- Just 640
configSettingLookupInt :: Setting -> String -> IO (Maybe Int)
configSettingLookupInt s = fmap checkTuple . configSettingLookupInt' s

-- |
-- >>> configSettingLookupInt64 misc "bigint"
-- Just 9223372036854775807
configSettingLookupInt64 :: Setting -> String -> IO (Maybe Int64)
configSettingLookupInt64 s = fmap checkTuple . configSettingLookupInt64' s

-- |
-- >>> configSettingLookupFloat misc "pi"
-- Just 3.141592654
configSettingLookupFloat :: Setting -> String -> IO (Maybe Double)
configSettingLookupFloat s = fmap checkTuple . configSettingLookupFloat' s

-- | (The example configuration file does not contain any boolean
-- values that are direct children of a @config_setting_t@.)
configSettingLookupBool :: Setting -> String -> IO (Maybe Bool)
configSettingLookupBool s = fmap checkTuple . configSettingLookupBool' s

-- |
-- >>> Just win <- configLookupFrom app "window"
-- >>> configSettingLookupString win "title"
-- Just "My Application"
configSettingLookupString :: Setting -> String -> IO (Maybe String)
configSettingLookupString s = fmap checkTuple . configSettingLookupString' s

{- Setting values -}

-- |
-- >>> Just treasureqty <- configLookup conf' "application.books.[0].qty"
-- >>> configSettingSetInt treasureqty 222
-- Just ()
-- >>> configSettingGetInt treasureqty
-- 222
configSettingSetInt :: (Setting) -> (Int) -> IO ((Maybe ()))
configSettingSetInt a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  configSettingSetInt'_ a1' a2' >>= \res ->
  let {res' = checkBool res} in
  return (res')

{-# LINE 634 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just miscbigint <- configLookup conf' "application.misc.bigint"
-- >>> configSettingSetInt64 miscbigint 92233720368547758
-- Just ()
-- >>> configSettingGetInt64 miscbigint
-- 92233720368547758
configSettingSetInt64 :: (Setting) -> (Int64) -> IO ((Maybe ()))
configSettingSetInt64 a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  configSettingSetInt64'_ a1' a2' >>= \res ->
  let {res' = checkBool res} in
  return (res')

{-# LINE 643 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just treasureprice <- configLookup conf' "application.books.[0].price"
-- >>> configSettingSetFloat treasureprice 22.22
-- Just ()
-- >>> configSettingGetFloat treasureprice
-- 22.22
configSettingSetFloat :: (Setting) -> (Double) -> IO ((Maybe ()))
configSettingSetFloat a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = realToFrac a2} in 
  configSettingSetFloat'_ a1' a2' >>= \res ->
  let {res' = checkBool res} in
  return (res')

{-# LINE 652 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just listbool <- configLookup conf' "application.list.[0].[2]"
-- >>> configSettingSetBool listbool False
-- Just ()
-- >>> configSettingGetBool listbool
-- False
configSettingSetBool :: (Setting) -> (Bool) -> IO ((Maybe ()))
configSettingSetBool a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = fromBool a2} in 
  configSettingSetBool'_ a1' a2' >>= \res ->
  let {res' = checkBool res} in
  return (res')

{-# LINE 661 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just treasureauthor <- configLookup conf' "application.books.[0].author"
-- >>> configSettingSetString treasureauthor "Robert L. Stevenson"
-- Just ()
-- >>> configSettingGetString treasureauthor
-- "Robert L. Stevenson"
configSettingSetString :: (Setting) -> (String) -> IO ((Maybe ()))
configSettingSetString a1 a2 =
  let {a1' = getSetting a1} in 
  withCString a2 $ \a2' -> 
  configSettingSetString'_ a1' a2' >>= \res ->
  let {res' = checkBool res} in
  return (res')

{-# LINE 670 "src/Language/Libconfig/Bindings.chs" #-}


{- Unsafe getting elements in collections -}

-- |
-- >>> Just treasure <- configLookup conf "application.books.[0]"
-- >>> configSettingGetIntElem treasure 3
-- 5
configSettingGetIntElem :: (Setting) -> (Int) -> IO ((Int))
configSettingGetIntElem a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  configSettingGetIntElem'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 679 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just misc <- configLookup conf "application.misc"
-- >>> configSettingGetInt64Elem misc 1
-- 9223372036854775807
configSettingGetInt64Elem :: (Setting) -> (Int) -> IO ((Int64))
configSettingGetInt64Elem a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  configSettingGetInt64Elem'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 686 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just list <- configLookup conf "application.list"
-- >>> configSettingGetFloatElem list 1
-- 1.234
configSettingGetFloatElem :: (Setting) -> (Int) -> IO ((Double))
configSettingGetFloatElem a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  configSettingGetFloatElem'_ a1' a2' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 693 "src/Language/Libconfig/Bindings.chs" #-}


-- | (The example configuration does not contain any boolean values
-- that are direct children of collections of type
-- @config_setting_t@).
configSettingGetBoolElem :: (Setting) -> (Int) -> IO ((Bool))
configSettingGetBoolElem a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  configSettingGetBoolElem'_ a1' a2' >>= \res ->
  let {res' = toBool res} in
  return (res')

{-# LINE 699 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just win <- configLookup conf "application.window"
-- >>> configSettingGetStringElem win 0
-- "My Application"
configSettingGetStringElem :: (Setting) -> (Int) -> IO ((String))
configSettingGetStringElem a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  configSettingGetStringElem'_ a1' a2' >>= \res ->
  peekCString res >>= \res' ->
  return (res')

{-# LINE 706 "src/Language/Libconfig/Bindings.chs" #-}


{- Setting elements in collections -}

-- | (This example appends a new value of type 'IntType' to
-- @application.list@, because the example file contains no suitable
-- example values for us to modify.)
--
-- >>> Just list <- configLookup conf' "application.list"
-- >>> Just new3 <- configSettingSetIntElem list (-1) 22
-- >>> configSettingGetIntElem list 3
-- 22
-- >>> configSettingGetInt new3
-- 22
configSettingSetIntElem :: (Setting) -> (Int) -> (Int) -> IO ((Maybe Setting))
configSettingSetIntElem a1 a2 a3 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  configSettingSetIntElem'_ a1' a2' a3' >>= \res ->
  let {res' = checkSetting res} in
  return (res')

{-# LINE 721 "src/Language/Libconfig/Bindings.chs" #-}


-- | (This example appends a new value of type 'Int64Type' to
-- @application.list@, because the example file contains no suitable
-- example values for us to modify.)
--
-- >>> Just list <- configLookup conf' "application.list"
-- >>> Just new3 <- configSettingSetInt64Elem list (-1) 92233720368547758
-- >>> configSettingGetInt64Elem list 3
-- 92233720368547758
-- >>> configSettingGetInt64 new3
-- 92233720368547758
configSettingSetInt64Elem :: (Setting) -> (Int) -> (Int64) -> IO ((Maybe Setting))
configSettingSetInt64Elem a1 a2 a3 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  configSettingSetInt64Elem'_ a1' a2' a3' >>= \res ->
  let {res' = checkSetting res} in
  return (res')

{-# LINE 734 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just list <- configLookup conf' "application.list"
-- >>> Just new1 <- configSettingSetFloatElem list 1 0.2222
-- >>> configSettingGetFloatElem list 1
-- 0.2222
-- >>> configSettingGetFloat new1
-- 0.2222
configSettingSetFloatElem :: (Setting) -> (Int) -> (Double) -> IO ((Maybe Setting))
configSettingSetFloatElem a1 a2 a3 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = realToFrac a3} in 
  configSettingSetFloatElem'_ a1' a2' a3' >>= \res ->
  let {res' = checkSetting res} in
  return (res')

{-# LINE 744 "src/Language/Libconfig/Bindings.chs" #-}


-- | (This example appends a new value of type 'BoolType' to
-- @application.list@, because the example file contains no suitable
-- example values for us to modify.)
--
-- >>> Just list <- configLookup conf' "application.list"
-- >>> Just new3 <- configSettingSetBoolElem list (-1) False
-- >>> configSettingGetBoolElem list 3
-- False
-- >>> configSettingGetBool new3
-- False
configSettingSetBoolElem :: (Setting) -> (Int) -> (Bool) -> IO ((Maybe Setting))
configSettingSetBoolElem a1 a2 a3 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromBool a3} in 
  configSettingSetBoolElem'_ a1' a2' a3' >>= \res ->
  let {res' = checkSetting res} in
  return (res')

{-# LINE 757 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just misccols <- configLookup conf' "application.misc.columns"
-- >>> Just new0 <- configSettingSetStringElem misccols 0 "butts"
-- >>> configSettingGetStringElem misccols 0
-- "butts"
-- >>> configSettingGetString new0
-- "butts"
configSettingSetStringElem :: (Setting) -> (Int) -> (String) -> IO ((Maybe Setting))
configSettingSetStringElem a1 a2 a3 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  withCString a3 $ \a3' -> 
  configSettingSetStringElem'_ a1' a2' a3' >>= \res ->
  let {res' = checkSetting res} in
  return (res')

{-# LINE 767 "src/Language/Libconfig/Bindings.chs" #-}


{- Collection management -}

-- |
-- >>> Just col0 <- configLookup conf "application.misc.columns.[0]"
-- >>> configSettingIndex col0
-- 0
configSettingIndex :: (Setting) -> IO ((Int))
configSettingIndex a1 =
  let {a1' = getSetting a1} in 
  configSettingIndex'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 776 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just cols <- configLookup conf "application.misc.columns"
-- >>> configSettingLength cols
-- 3
configSettingLength :: (Setting) -> IO ((Int))
configSettingLength a1 =
  let {a1' = getSetting a1} in 
  configSettingLength'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 783 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just cols <- configLookup conf "application.misc.columns"
-- >>> Just col0 <- configSettingGetElem cols 0
-- >>> configSettingGetString col0
-- "Last Name"
configSettingGetElem :: (Setting) -> (Int) -> IO ((Maybe Setting))
configSettingGetElem a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  configSettingGetElem'_ a1' a2' >>= \res ->
  let {res' = checkSetting res} in
  return (res')

{-# LINE 791 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just miscpi <- configSettingGetMember misc "pi"
-- >>> configSettingGetFloat miscpi
-- 3.141592654
configSettingGetMember :: (Setting) -> (String) -> IO ((Maybe Setting))
configSettingGetMember a1 a2 =
  let {a1' = getSetting a1} in 
  withCString a2 $ \a2' -> 
  configSettingGetMember'_ a1' a2' >>= \res ->
  let {res' = checkSetting res} in
  return (res')

{-# LINE 798 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just misc' <- configLookup conf' "application.misc"
-- >>> Just randSeed <- configSettingAdd misc' "random_seed" IntType
-- >>> configSettingSetInt randSeed 55
-- Just ()
-- >>> configSettingGetInt randSeed
-- 55
-- >>> configSettingLookupInt misc' "random_seed"
-- Just 55
-- >>> configSettingGetIntElem misc' 4
-- 55
configSettingAdd :: (Setting) -> (String) -> (ConfigType) -> IO ((Maybe Setting))
configSettingAdd a1 a2 a3 =
  let {a1' = getSetting a1} in 
  withCString a2 $ \a2' -> 
  let {a3' = fromEnumIntegral a3} in 
  configSettingAdd'_ a1' a2' a3' >>= \res ->
  let {res' = checkSetting res} in
  return (res')

{-# LINE 813 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just misc' <- configLookup conf' "application.misc"
-- >>> configSettingLength misc'
-- 4
-- >>> configSettingRemove misc' "bitmask"
-- Just ()
-- >>> configSettingLength misc'
-- 3
configSettingRemove :: (Setting) -> (String) -> IO ((Maybe ()))
configSettingRemove a1 a2 =
  let {a1' = getSetting a1} in 
  withCString a2 $ \a2' -> 
  configSettingRemove'_ a1' a2' >>= \res ->
  let {res' = checkBool res} in
  return (res')

{-# LINE 824 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just misc' <- configLookup conf' "application.misc"
-- >>> configSettingLength misc'
-- 4
-- >>> configSettingRemoveElem misc' 2
-- Just ()
-- >>> configSettingLength misc'
-- 3
-- >>> Just new2 <- configSettingGetElem misc' 2
-- >>> configSettingType new2
-- IntType
-- >>> configSettingGetInt new2
-- 8131
configSettingRemoveElem :: (Setting) -> (Int) -> IO ((Maybe ()))
configSettingRemoveElem a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = fromIntegral a2} in 
  configSettingRemoveElem'_ a1' a2' >>= \res ->
  let {res' = checkBool res} in
  return (res')

{-# LINE 840 "src/Language/Libconfig/Bindings.chs" #-}


-- I haven't worked out a good way to do this one yet.  What's
-- necessary is to register a finalizer for 'freeStablePtr xp' with
-- the relevant 'Configuration' pointer.  Unfortunately, we can't go
-- from a 'Setting' to the ForeignPtr contained in a 'Configuration'.
--
-- Punting for now, since I don't even know what you use this for.

-- foreign import ccall unsafe "src/Language/Libconfig.chs.h config_setting_set_hook"
--   configSettingSetHook' :: Ptr Setting' -> Ptr () -> IO ()

-- configSettingSetHook :: Storable a => Setting -> a -> IO ()
-- configSettingSetHook (Setting s) x = do
--   xp <- newStablePtr x
--   cfgp <- config'Setting <$> peek s

-- configSettingGetHook :: Storable a => Setting -> IO a
-- configSettingGetHook (Setting s) = fmap (castPtr . hook'Setting) (peek s) >>= peek


{- Path search -}

-- |
-- >>> Just app <- configLookup conf "application"
-- >>> configSettingName app
-- Just "application"
configLookup :: (Configuration) -> (String) -> IO ((Maybe Setting))
configLookup a1 a2 =
  withConfiguration a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  configLookup'_ a1' a2' >>= \res ->
  let {res' = checkSetting res} in
  return (res')

{-# LINE 868 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just list <- configLookupFrom app "list"
-- >>> configSettingName list
-- Just "list"
configLookupFrom :: (Setting) -> (String) -> IO ((Maybe Setting))
configLookupFrom a1 a2 =
  let {a1' = getSetting a1} in 
  withCString a2 $ \a2' -> 
  configLookupFrom'_ a1' a2' >>= \res ->
  let {res' = checkSetting res} in
  return (res')

{-# LINE 875 "src/Language/Libconfig/Bindings.chs" #-}


configLookupInt' :: (Configuration) -> (String) -> IO ((ConfigBool), (Int))
configLookupInt' a1 a2 =
  withConfiguration a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  configLookupInt''_ a1' a2' a3' >>= \res ->
  let {res' = asBool res} in
  peekIntegral  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 879 "src/Language/Libconfig/Bindings.chs" #-}


configLookupInt64' :: (Configuration) -> (String) -> IO ((ConfigBool), (Int64))
configLookupInt64' a1 a2 =
  withConfiguration a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  configLookupInt64''_ a1' a2' a3' >>= \res ->
  let {res' = asBool res} in
  peekIntegral  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 883 "src/Language/Libconfig/Bindings.chs" #-}


configLookupFloat' :: (Configuration) -> (String) -> IO ((ConfigBool), (Double))
configLookupFloat' a1 a2 =
  withConfiguration a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  configLookupFloat''_ a1' a2' a3' >>= \res ->
  let {res' = asBool res} in
  peekFloat  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 887 "src/Language/Libconfig/Bindings.chs" #-}


configLookupBool' :: (Configuration) -> (String) -> IO ((ConfigBool), (Bool))
configLookupBool' a1 a2 =
  withConfiguration a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  configLookupBool''_ a1' a2' a3' >>= \res ->
  let {res' = asBool res} in
  peekBool  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 891 "src/Language/Libconfig/Bindings.chs" #-}


configLookupString' :: (Configuration) -> (String) -> IO ((ConfigBool), (String))
configLookupString' a1 a2 =
  withConfiguration a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  configLookupString''_ a1' a2' a3' >>= \res ->
  let {res' = asBool res} in
  peekString  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 895 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just appwinwidth <- configLookup conf "application.window.size.w"
-- >>> configSettingGetFormat appwinwidth
-- DefaultFormat
configSettingGetFormat :: (Setting) -> IO ((ConfigFormat))
configSettingGetFormat a1 =
  let {a1' = getSetting a1} in 
  configSettingGetFormat'_ a1' >>= \res ->
  let {res' = toEnumIntegral res} in
  return (res')

{-# LINE 903 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> Just appwinwidth' <- configLookup conf' "application.window.size.w"
-- >>> configSettingGetFormat appwinwidth'
-- DefaultFormat
-- >>> configSettingSetFormat appwinwidth' HexFormat
-- Just ()
-- >>> configSettingGetFormat appwinwidth'
-- HexFormat
configSettingSetFormat :: (Setting) -> (ConfigFormat) -> IO ((Maybe ()))
configSettingSetFormat a1 a2 =
  let {a1' = getSetting a1} in 
  let {a2' = fromEnumIntegral a2} in 
  configSettingSetFormat'_ a1' a2' >>= \res ->
  let {res' = checkBool res} in
  return (res')

{-# LINE 915 "src/Language/Libconfig/Bindings.chs" #-}


-- |
-- >>> configLookupInt conf "application.window.size.w"
-- Just 640
configLookupInt :: Configuration -> String -> IO (Maybe Int)
configLookupInt c = fmap checkTuple . configLookupInt' c

-- |
-- >>> configLookupInt64 conf "application.misc.bigint"
-- Just 9223372036854775807
configLookupInt64 :: Configuration -> String -> IO (Maybe Int64)
configLookupInt64 c = fmap checkTuple . configLookupInt64' c

-- |
-- >>> configLookupFloat conf "application.misc.pi"
-- Just 3.141592654
configLookupFloat :: Configuration -> String -> IO (Maybe Double)
configLookupFloat c = fmap checkTuple . configLookupFloat' c

-- |
-- >>> configLookupBool conf "application.list.[0].[2]"
-- Just True
configLookupBool :: Configuration -> String -> IO (Maybe Bool)
configLookupBool c = fmap checkTuple . configLookupBool' c


-- |
-- >>> configLookupString conf "application.window.title"
-- Just "My Application"
configLookupString :: Configuration -> String -> IO (Maybe String)
configLookupString c = fmap checkTuple . configLookupString' c

-- |
-- >>> Just list <- configLookup conf "application.list"
-- >>> configSettingType list
-- ListType
configSettingType :: Setting -> IO ConfigType
configSettingType = fmap (toEnumIntegral . type'Setting) . peek . getSetting

-- |
-- >>> Just grp <- configLookup conf "application.window"
-- >>> configSettingIsGroup grp
-- True
configSettingIsGroup :: Setting -> IO Bool
configSettingIsGroup = fmap (== GroupType) . configSettingType

-- |
-- >>> Just arr <- configLookup conf "application.misc.columns"
-- >>> configSettingIsArray arr
-- True
configSettingIsArray :: Setting -> IO Bool
configSettingIsArray = fmap (== ArrayType) . configSettingType

-- |
-- >>> Just list <- configLookup conf "application.list"
-- >>> configSettingIsList list
-- True
configSettingIsList :: Setting -> IO Bool
configSettingIsList = fmap (== ListType) . configSettingType

-- |
-- >>> Just grp <- configLookup conf "application.window"
-- >>> Just arr <- configLookup conf "application.misc.columns"
-- >>> Just list <- configLookup conf "application.list"
-- >>> Just width <- configLookup conf "application.window.size.w"
-- >>> mapM configSettingIsAggregate [grp, arr, list, width]
-- [True,True,True,False]
configSettingIsAggregate :: Setting -> IO Bool
configSettingIsAggregate =
  fmap (`elem` [ListType, GroupType, ArrayType]) . configSettingType

-- |
-- >>> Just int <- configLookup conf "application.window.pos.x"
-- >>> Just bigint <- configLookup conf "application.misc.bigint"
-- >>> Just float <- configLookup conf "application.misc.pi"
-- >>> Just grp <- configLookup conf "application.window"
-- >>> mapM configSettingIsNumber [int, bigint, float, grp]
-- [True,True,True,False]
configSettingIsNumber :: Setting -> IO Bool
configSettingIsNumber =
  fmap (`elem` [IntType, Int64Type, FloatType]) . configSettingType

-- |
-- >>> Just int <- configLookup conf "application.window.pos.x"
-- >>> Just bigint <- configLookup conf "application.misc.bigint"
-- >>> Just float <- configLookup conf "application.misc.pi"
-- >>> Just bool <- configLookup conf "application.list.[0].[2]"
-- >>> Just str <- configLookup conf "application.window.title"
-- >>> Just grp <- configLookup conf "application.window"
-- >>> mapM configSettingIsScalar [int, bigint, float, bool, str, grp]
-- [True,True,True,True,True,False]
configSettingIsScalar :: Setting -> IO Bool
configSettingIsScalar =
  fmap (`elem` [IntType, Int64Type, FloatType, BoolType, StringType]) .
  configSettingType

-- |
-- >>> Just list <- configLookup conf "application.list"
-- >>> configSettingName list
-- Just "list"
--
-- >>> Just list1 <- configLookup conf "application.list.[0]"
-- >>> configSettingName list1
-- Nothing
configSettingName :: Setting -> IO (Maybe String)
configSettingName (Setting sp) = do
  s <- peek sp
  if (name'Setting s == nullPtr)
    then return Nothing
    else Just <$> peekCString (name'Setting s)

-- |
-- >>> Just list <- configLookup conf "application.list"
-- >>> Just app <- configSettingParent list
-- >>> configSettingName app
-- Just "application"
configSettingParent :: Setting -> IO (Maybe Setting)
configSettingParent = fmap (checkSetting . parent'Setting) . peek . getSetting

-- |
-- >>> configSettingIsRoot app
-- False
-- >>> Just root <- configRootSetting conf
-- >>> configSettingIsRoot root
-- True
configSettingIsRoot :: Setting -> IO Bool
configSettingIsRoot = fmap ((==nullPtr) . parent'Setting) . peek . getSetting

-- |
-- >>> Just root <- configRootSetting conf
-- >>> Just version <- configSettingGetMember root "version"
-- >>> configSettingGetString version
-- "1.0"
configRootSetting :: Configuration -> IO (Maybe Setting)
configRootSetting =
  flip withForeignPtr (fmap (checkSetting . root'Config) . peek) . getConfiguration

-- |
-- >>> configGetDefaultFormat conf'
-- DefaultFormat
-- >>> configSetDefaultFormat conf' HexFormat
-- >>> configGetDefaultFormat conf'
-- HexFormat
configSetDefaultFormat :: Configuration -> ConfigFormat -> IO ()
configSetDefaultFormat c' f =
  modifyConfiguration c' $
  \c -> c { default_format'Config = fromIntegral $ fromEnum f }

-- |
-- >>> configGetDefaultFormat conf
-- DefaultFormat
configGetDefaultFormat :: Configuration -> IO ConfigFormat
configGetDefaultFormat =
  onConfiguration (toEnum . fromIntegral . default_format'Config)

-- |
-- >>> configGetTabWidth conf'
-- 2
-- >>> configSetTabWidth conf' 8
-- >>> configGetTabWidth conf'
-- 8
configSetTabWidth :: Configuration -> Int -> IO ()
configSetTabWidth c' w =
  modifyConfiguration c' $
  \c -> c { tab_width'Config = fromIntegral w }

-- |
-- >>> configGetTabWidth conf
-- 2
configGetTabWidth :: Configuration -> IO Int
configGetTabWidth =
  onConfiguration (fromIntegral . tab_width'Config)

-- |
-- >>> configSettingSourceLine app
-- 5
configSettingSourceLine :: Setting -> IO Int
configSettingSourceLine =
  fmap (fromIntegral . line'Setting) . peek . getSetting

-- |
-- >>> configSettingSourceFile app
-- "test/test.conf"
configSettingSourceFile :: Setting -> IO String
configSettingSourceFile (Setting s) = peek s >>= peekCString . file'Setting

configErrorFile :: Configuration -> IO (Maybe String)
configErrorFile c =
  withConfiguration c $
  \p -> do
    filePtr <- error_file'Config <$> peek p
    if filePtr == nullPtr
      then return Nothing
      else Just <$> peekCString filePtr

configErrorText :: Configuration -> IO (Maybe String)
configErrorText c =
  withConfiguration c $
  \p -> do
    textPtr <- error_text'Config <$> peek p
    if textPtr == nullPtr
      then return Nothing
      else Just <$> peekCString textPtr

configErrorLine :: Configuration -> IO Int
configErrorLine =
  onConfiguration (fromIntegral . error_line'Config)

configErrorType :: Configuration -> IO ConfigErr
configErrorType =
  onConfiguration (toEnum . fromIntegral . error_type'Config)

-- TODO(MP): Perhaps a MonadIO m => ConfigT m which both wraps non-IO
-- config actions and uses ExceptT or MaybeT to keep track of errors

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_read_file"
  configReadFile'_ :: ((ConfigPtr) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_write_file"
  configWriteFile'_ :: ((ConfigPtr) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_read_string"
  configReadString'_ :: ((ConfigPtr) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_get_int"
  configSettingGetInt'_ :: ((SettingPtr) -> (IO CInt))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_get_int64"
  configSettingGetInt64'_ :: ((SettingPtr) -> (IO CLLong))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_get_float"
  configSettingGetFloat'_ :: ((SettingPtr) -> (IO CDouble))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_get_bool"
  configSettingGetBool'_ :: ((SettingPtr) -> (IO CInt))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_get_string"
  configSettingGetString'_ :: ((SettingPtr) -> (IO (Ptr CChar)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_lookup_int"
  configSettingLookupInt''_ :: ((SettingPtr) -> ((Ptr CChar) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_lookup_int64"
  configSettingLookupInt64''_ :: ((SettingPtr) -> ((Ptr CChar) -> ((Ptr CLLong) -> (IO CInt))))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_lookup_float"
  configSettingLookupFloat''_ :: ((SettingPtr) -> ((Ptr CChar) -> ((Ptr CDouble) -> (IO CInt))))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_lookup_bool"
  configSettingLookupBool''_ :: ((SettingPtr) -> ((Ptr CChar) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_lookup_string"
  configSettingLookupString''_ :: ((SettingPtr) -> ((Ptr CChar) -> ((Ptr (Ptr CChar)) -> (IO CInt))))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_set_int"
  configSettingSetInt'_ :: ((SettingPtr) -> (CInt -> (IO CInt)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_set_int64"
  configSettingSetInt64'_ :: ((SettingPtr) -> (CLLong -> (IO CInt)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_set_float"
  configSettingSetFloat'_ :: ((SettingPtr) -> (CDouble -> (IO CInt)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_set_bool"
  configSettingSetBool'_ :: ((SettingPtr) -> (CInt -> (IO CInt)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_set_string"
  configSettingSetString'_ :: ((SettingPtr) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_get_int_elem"
  configSettingGetIntElem'_ :: ((SettingPtr) -> (CInt -> (IO CInt)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_get_int64_elem"
  configSettingGetInt64Elem'_ :: ((SettingPtr) -> (CInt -> (IO CLLong)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_get_float_elem"
  configSettingGetFloatElem'_ :: ((SettingPtr) -> (CInt -> (IO CDouble)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_get_bool_elem"
  configSettingGetBoolElem'_ :: ((SettingPtr) -> (CInt -> (IO CInt)))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_get_string_elem"
  configSettingGetStringElem'_ :: ((SettingPtr) -> (CInt -> (IO (Ptr CChar))))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_set_int_elem"
  configSettingSetIntElem'_ :: ((SettingPtr) -> (CInt -> (CInt -> (IO (SettingPtr)))))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_set_int64_elem"
  configSettingSetInt64Elem'_ :: ((SettingPtr) -> (CInt -> (CLLong -> (IO (SettingPtr)))))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_set_float_elem"
  configSettingSetFloatElem'_ :: ((SettingPtr) -> (CInt -> (CDouble -> (IO (SettingPtr)))))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_set_bool_elem"
  configSettingSetBoolElem'_ :: ((SettingPtr) -> (CInt -> (CInt -> (IO (SettingPtr)))))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_set_string_elem"
  configSettingSetStringElem'_ :: ((SettingPtr) -> (CInt -> ((Ptr CChar) -> (IO (SettingPtr)))))

foreign import ccall unsafe "Language/Libconfig/Bindings.chs.h config_setting_index"
  configSettingIndex'_ :: ((SettingPtr) -> (IO CInt))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_setting_length"
  configSettingLength'_ :: ((SettingPtr) -> (IO CInt))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_setting_get_elem"
  configSettingGetElem'_ :: ((SettingPtr) -> (CUInt -> (IO (SettingPtr))))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_setting_get_member"
  configSettingGetMember'_ :: ((SettingPtr) -> ((Ptr CChar) -> (IO (SettingPtr))))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_setting_add"
  configSettingAdd'_ :: ((SettingPtr) -> ((Ptr CChar) -> (CInt -> (IO (SettingPtr)))))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_setting_remove"
  configSettingRemove'_ :: ((SettingPtr) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_setting_remove_elem"
  configSettingRemoveElem'_ :: ((SettingPtr) -> (CUInt -> (IO CInt)))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_lookup"
  configLookup'_ :: ((ConfigPtr) -> ((Ptr CChar) -> (IO (SettingPtr))))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_lookup_from"
  configLookupFrom'_ :: ((SettingPtr) -> ((Ptr CChar) -> (IO (SettingPtr))))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_lookup_int"
  configLookupInt''_ :: ((ConfigPtr) -> ((Ptr CChar) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_lookup_int64"
  configLookupInt64''_ :: ((ConfigPtr) -> ((Ptr CChar) -> ((Ptr CLLong) -> (IO CInt))))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_lookup_float"
  configLookupFloat''_ :: ((ConfigPtr) -> ((Ptr CChar) -> ((Ptr CDouble) -> (IO CInt))))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_lookup_bool"
  configLookupBool''_ :: ((ConfigPtr) -> ((Ptr CChar) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_lookup_string"
  configLookupString''_ :: ((ConfigPtr) -> ((Ptr CChar) -> ((Ptr (Ptr CChar)) -> (IO CInt))))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_setting_get_format"
  configSettingGetFormat'_ :: ((SettingPtr) -> (IO CShort))

foreign import ccall safe "Language/Libconfig/Bindings.chs.h config_setting_set_format"
  configSettingSetFormat'_ :: ((SettingPtr) -> (CShort -> (IO CInt)))