{-# LINE 1 "src/Foreign/R/Parse.hsc" #-}
-- |
-- Copyright: (C) 2013 Amgen, Inc.
--
-- Bindings for @<R/R_ext/Parse.h>@.

{-# LANGUAGE CPP #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ForeignFunctionInterface #-}

{-# LINE 13 "src/Foreign/R/Parse.hsc" #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}

{-# LINE 15 "src/Foreign/R/Parse.hsc" #-}



module Foreign.R.Parse
  ( parseVector
  , ParseStatus(..)
  ) where

import Foreign.R.Constraints
import qualified Foreign.R as R

import Foreign
import Foreign.C

-- | The return code of a call to 'parseVector', indicating whether the parser
-- failed or succeeded.
data ParseStatus
  = PARSE_NULL
  | PARSE_OK
  | PARSE_INCOMPLETE
  | PARSE_ERROR
  | PARSE_EOF
  deriving (Eq, Show)

instance Enum ParseStatus where
  fromEnum PARSE_NULL       = 0
{-# LINE 41 "src/Foreign/R/Parse.hsc" #-}
  fromEnum PARSE_OK         = 1
{-# LINE 42 "src/Foreign/R/Parse.hsc" #-}
  fromEnum PARSE_INCOMPLETE = 2
{-# LINE 43 "src/Foreign/R/Parse.hsc" #-}
  fromEnum PARSE_ERROR      = 3
{-# LINE 44 "src/Foreign/R/Parse.hsc" #-}
  fromEnum PARSE_EOF        = 4
{-# LINE 45 "src/Foreign/R/Parse.hsc" #-}
  toEnum i = case i of
    (0)       -> PARSE_NULL
{-# LINE 47 "src/Foreign/R/Parse.hsc" #-}
    (1)         -> PARSE_OK
{-# LINE 48 "src/Foreign/R/Parse.hsc" #-}
    (2) -> PARSE_INCOMPLETE
{-# LINE 49 "src/Foreign/R/Parse.hsc" #-}
    (3)      -> PARSE_ERROR
{-# LINE 50 "src/Foreign/R/Parse.hsc" #-}
    (4)        -> PARSE_EOF
{-# LINE 51 "src/Foreign/R/Parse.hsc" #-}
    _ -> error "ParseStatus.fromEnum: can't mach value"

-- | @parseVector text num status source@ parses the input string into an AST.
-- @source@, if provided, names the origin of @text@ (e.g. a filename). @num@
-- limits the number of expressions to parse, or @-1@ if no limit.

-- TODO: use ParseStatus or write a wrapper for parseVector.
parseVector
  :: (In a [R.Nil, R.String])
  => R.SEXP s R.String
  -> Int
  -> Ptr CInt
  -> R.SEXP s a
  -> IO (R.SEXP s R.Expr)
parseVector (R.unsexp -> s) (fromIntegral -> cnt) reti (R.unsexp -> input) =
  R.sexp <$> c_parseVector s cnt reti input
 
foreign import ccall "R_ext/Parse.h R_ParseVector" c_parseVector
  :: R.SEXP0 -> CInt -> Ptr CInt -> R.SEXP0 -> IO R.SEXP0