-- GENERATED by C->Haskell Compiler, version 0.20.1 The shapeless maps, 31 Oct 2014 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Data/ABC/Internal/IO.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

{- |
Module      : Data.ABC.Internal.IO
Copyright   : Galois, Inc. 2010-2014
License     : BSD3
Maintainer  : jhendrix@galois.com
Stability   : experimental
Portability : non-portable (c2hs, language extensions)

Binding of @base\/io\/io.h@ for reading and writing
networks to the file system.  ABC natively supports a variety of
different file formats.
-}

module Data.ABC.Internal.IO (
    -- * abcReadAiger.c
      ioReadAiger
    -- * abcWriteAiger.c
    , ioWriteAiger
    ) where

import Foreign
import Foreign.C

import Data.ABC.Internal.ABC
{-# LINE 28 "src/Data/ABC/Internal/IO.chs" #-}




-- abcReadAiger.c
ioReadAiger :: (String) -> (Bool) -> IO ((Abc_Ntk_t))
ioReadAiger a1 a2 =
  withCString a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  ioReadAiger'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 33 "src/Data/ABC/Internal/IO.chs" #-}

-- abcWriteAiger.c
ioWriteAiger :: (Abc_Ntk_t) -> (String) -> (Bool) -- fWriteSymbols
 -> (Bool) -- fCompact
 -> (Bool) -- fUnique
 -> IO ()
ioWriteAiger a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  let {a3' = fromBool a3} in 
  let {a4' = fromBool a4} in 
  let {a5' = fromBool a5} in 
  ioWriteAiger'_ a1' a2' a3' a4' a5' >>
  return ()

{-# LINE 41 "src/Data/ABC/Internal/IO.chs" #-}


foreign import ccall safe "Data/ABC/Internal/IO.chs.h Io_ReadAiger"
  ioReadAiger'_ :: ((Ptr CChar) -> (CInt -> (IO (Abc_Ntk_t))))

foreign import ccall safe "Data/ABC/Internal/IO.chs.h Io_WriteAiger"
  ioWriteAiger'_ :: ((Abc_Ntk_t) -> ((Ptr CChar) -> (CInt -> (CInt -> (CInt -> (IO ()))))))