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


{-# LINE 1 "src/System/Wordexp.chs" #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | wordexp (and wordfree) Haskell wrapper
module System.Wordexp
 ( -- * Wrapper
   wordexp
   -- * Flags
 , Flags, nosubst, errors, noundef
   -- * Errors
 , WordexpError (..)
 ) where



import Control.Exception (Exception)
import Control.Monad
import Data.Data (Data)
import Data.Typeable (Typeable)
import Foreign
import Foreign.C
import Foreign.C.Types

import Data.Array (Ix)




-- | Opaque wordexp_t struct image in Haskellland
data Wordexp


-- | wordexp flags enum image in Haskellland
data FLAGS = WRDE_DOOFFS
           | WRDE_APPEND
           | WRDE_NOCMD
           | WRDE_REUSE
           | WRDE_SHOWERR
           | WRDE_UNDEF
  deriving (Show,Read,Eq,Ord,Bounded,Ix,Data,Typeable)
instance Enum FLAGS where
  succ WRDE_DOOFFS = WRDE_APPEND
  succ WRDE_APPEND = WRDE_NOCMD
  succ WRDE_NOCMD = WRDE_REUSE
  succ WRDE_REUSE = WRDE_SHOWERR
  succ WRDE_SHOWERR = WRDE_UNDEF
  succ WRDE_UNDEF = error "FLAGS.succ: WRDE_UNDEF has no successor"

  pred WRDE_APPEND = WRDE_DOOFFS
  pred WRDE_NOCMD = WRDE_APPEND
  pred WRDE_REUSE = WRDE_NOCMD
  pred WRDE_SHOWERR = WRDE_REUSE
  pred WRDE_UNDEF = WRDE_SHOWERR
  pred WRDE_DOOFFS = error "FLAGS.pred: WRDE_DOOFFS 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 WRDE_UNDEF

  fromEnum WRDE_DOOFFS = 1
  fromEnum WRDE_APPEND = 2
  fromEnum WRDE_NOCMD = 4
  fromEnum WRDE_REUSE = 8
  fromEnum WRDE_SHOWERR = 16
  fromEnum WRDE_UNDEF = 32

  toEnum 1 = WRDE_DOOFFS
  toEnum 2 = WRDE_APPEND
  toEnum 4 = WRDE_NOCMD
  toEnum 8 = WRDE_REUSE
  toEnum 16 = WRDE_SHOWERR
  toEnum 32 = WRDE_UNDEF
  toEnum unmatched = error ("FLAGS.toEnum: Cannot match " ++ show unmatched)

{-# LINE 43 "src/System/Wordexp.chs" #-}


-- | wordexp flags
--
-- Not every flag is supported since some of them do not make much sense in Haskell anyway
newtype Flags = Flags Int
  deriving (Show, Read, Eq, Ord, Bounded, Bits, Ix, Data, Typeable)

instance Semigroup Flags where
  (<>) = (.|.)
  {-# INLINE (<>) #-}

instance Monoid Flags where
  mempty = Flags 0
  mappend = (<>)
  {-# INLINE mappend #-}

-- | Disable command substitution in patterns, treat them as errors
nosubst :: Flags
nosubst = Flags $ fromEnum WRDE_NOCMD
{-# INLINE nosubst #-}

-- | Do not hide shell error messages in /dev/null, print them right away
errors :: Flags
errors = Flags $ fromEnum WRDE_SHOWERR
{-# INLINE errors #-}

-- | Do not accept undefined shell variables, treat them as errors
noundef :: Flags
noundef = Flags $ fromEnum WRDE_UNDEF
{-# INLINE noundef #-}


-- | Possible wordexp errors
data WordexpError = OutOfSpace
                  | IllegalCharacterOccurence
                  | UndefinedShellVariable
                  | CommandSubstitution
                  | ShellSyntaxError
  deriving (Show,Read,Eq,Ord,Bounded,Ix,Data,Typeable)
instance Enum WordexpError where
  succ OutOfSpace = IllegalCharacterOccurence
  succ IllegalCharacterOccurence = UndefinedShellVariable
  succ UndefinedShellVariable = CommandSubstitution
  succ CommandSubstitution = ShellSyntaxError
  succ ShellSyntaxError = error "WordexpError.succ: ShellSyntaxError has no successor"

  pred IllegalCharacterOccurence = OutOfSpace
  pred UndefinedShellVariable = IllegalCharacterOccurence
  pred CommandSubstitution = UndefinedShellVariable
  pred ShellSyntaxError = CommandSubstitution
  pred OutOfSpace = error "WordexpError.pred: OutOfSpace 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 ShellSyntaxError

  fromEnum OutOfSpace = 1
  fromEnum IllegalCharacterOccurence = 2
  fromEnum UndefinedShellVariable = 3
  fromEnum CommandSubstitution = 4
  fromEnum ShellSyntaxError = 5

  toEnum 1 = OutOfSpace
  toEnum 2 = IllegalCharacterOccurence
  toEnum 3 = UndefinedShellVariable
  toEnum 4 = CommandSubstitution
  toEnum 5 = ShellSyntaxError
  toEnum unmatched = error ("WordexpError.toEnum: Cannot match " ++ show unmatched)

{-# LINE 87 "src/System/Wordexp.chs" #-}


instance Exception WordexpError


-- | wordexp wrapper
--
-- Allows to specify desired flags, return expanded strings or encountered error if any
wordexp :: Flags -> String -> IO (Either WordexpError [String])
wordexp (Flags f) s =
  withCString s $ \cs ->
    allocaBytes size $ \p -> do
      ret <- c_wordexp cs p (fromIntegral f)
      case ret of
        0 -> do
          c <- fromIntegral `fmap` wordc p
          v <- wordv p
          xs <- forM [0 .. c-1] $ peekElemOff v >=> peekCString
          c_wordfree p
          return $ Right xs
        e -> return . Left . toEnum $ fromIntegral e
 where
  size = sizeOf (undefined :: CSize) + sizeOf (undefined :: Ptr CString) + sizeOf (undefined :: CSize)
  {-# INLINE size #-}

  wordc :: Ptr Wordexp -> IO CSize
  wordc p = peekByteOff p 0
  {-# INLINE wordc #-}

  wordv :: Ptr Wordexp -> IO (Ptr CString)
  wordv p = peekByteOff p (sizeOf (undefined :: CSize))
  {-# INLINE wordv #-}


foreign import ccall unsafe "wordexp"
  c_wordexp :: CString -> Ptr Wordexp -> CInt -> IO CInt

foreign import ccall unsafe "wordfree"
  c_wordfree :: Ptr Wordexp -> IO ()