-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Exomizer/Extern/Args.chs" #-}
-- | Interface for options / result
{-# LANGUAGE RecordWildCards #-}

module Exomizer.Extern.Args
  ( withCrunchOptions
  , withCrunchInfo
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import           Foreign.C
import           Foreign.Marshal.Alloc
import           Foreign.Marshal.Utils
import           Foreign.Ptr

import           Exomizer.Data.Args



-- | @since 1.0.0
withCrunchOptions :: CrunchOptions -> (Ptr CrunchOptions -> IO a) -> IO a
{-# INLINE withCrunchOptions #-}
withCrunchOptions co action =
  let
    CrunchOptions{..} = fixCrunchOptions co
  in
    withNullableCString coEncoding $ \encodingPtr ->
      allocaBytesAligned
        32
{-# LINE 27 "src/Exomizer/Extern/Args.chs" #-}

        8
{-# LINE 28 "src/Exomizer/Extern/Args.chs" #-}

        $ \coPtr -> do
          (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) coPtr encodingPtr
          (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CInt)}) coPtr (fromIntegral coMaxPasses)
          (\ptr val -> do {C2HSImp.pokeByteOff ptr 12 (val :: C2HSImp.CInt)}) coPtr (fromIntegral coMaxLen)
          (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: C2HSImp.CInt)}) coPtr (fromIntegral coMaxOffset)
          (\ptr val -> do {C2HSImp.pokeByteOff ptr 20 (val :: C2HSImp.CInt)}) coPtr (fromBool coUseLiteralSequences)
          (\ptr val -> do {C2HSImp.pokeByteOff ptr 24 (val :: C2HSImp.CInt)}) coPtr (fromBool coFavourSpeed)
          (\ptr val -> do {C2HSImp.pokeByteOff ptr 28 (val :: C2HSImp.CInt)}) coPtr (fromBool True)
          action coPtr

-- | @since 1.0.0
withCrunchInfo :: (Ptr CrunchInfo -> IO a) -> IO (a, CrunchInfo)
{-# INLINE withCrunchInfo #-}
withCrunchInfo action = do
  allocaBytesAligned
    108
{-# LINE 44 "src/Exomizer/Extern/Args.chs" #-}

    4
{-# LINE 45 "src/Exomizer/Extern/Args.chs" #-}

    $ \ciPtr -> do
      res <- action ciPtr
      ci <-
        CrunchInfo
          <$> toBool `fmap` (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CInt}) ciPtr
          <*> fromIntegral `fmap` (\ptr -> do {C2HSImp.peekByteOff ptr 4 :: IO C2HSImp.CInt}) ciPtr
          <*> (peekCString =<< (\ptr -> do {return $ ptr `C2HSImp.plusPtr` 8 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) ciPtr)
      return (res, ci)

-- helper

withNullableCString :: Maybe String -> (Ptr CChar -> IO a) -> IO a
{-# INLINE withNullableCString #-}
withNullableCString  Nothing      action = action nullPtr
withNullableCString (Just string) action = withCString string action