{-# LINE 1 "src/Foreign/R/Type.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}


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

{-# LINE 13 "src/Foreign/R/Type.hsc" #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}

-- |
-- Copyright: (C) 2013 Amgen, Inc.
--
-- Definition of 'SEXPTYPE', which classifies the possible forms of an
-- R expression (a 'SEXP'). It is normally not necessary to import this module
-- directly, since it is reexported by "Foreign.R".
--
-- This is done in a separate module because we want to use hsc2hs rather than
-- c2hs for discharging the boilerplate around 'SEXPTYPE'. This is because
-- 'SEXPTYPE' is nearly but not quite a true enumeration and c2hs has trouble
-- dealing with that.
--
-- This module also defines a singleton version of 'SEXPTYPE', called
-- 'SSEXPTYPE'. This is actually a family of types, one for each possible
-- 'SEXPTYPE'. Singleton types are a way of emulating dependent types in
-- a language that does not have true dependent type. They are useful in
-- functions whose result type depends on the value of one of its arguments. See
-- e.g. 'Foreign.R.allocVector'.

module Foreign.R.Type
  ( SEXPTYPE(..)
  , SSEXPTYPE
  , Sing(..)
  , Logical(..)
  , PairList
  , IsVector
  , IsGenericVector
  , IsList
  , IsPairList
  , IsExpression
  ) where



import Foreign.R.Constraints
import Internal.Error

import qualified Language.Haskell.TH.Syntax as Hs
import qualified Language.Haskell.TH.Lib as Hs

import Data.Singletons.TH

import Control.DeepSeq (NFData(..))
import Foreign.R.Context

-- | R \"type\". Note that what R calls a \"type\" is not what is usually meant
-- by the term: there is really only a single type, called 'SEXP', and an
-- R "type" in fact refers to the /class/ or /form/ of the expression.
--
-- To better illustrate the distinction, note that any sane type system normally
-- has the /subject reduction property/: that the type of an expression is
-- invariant under reduction. For example, @(\x -> x) 1@ has type 'Int', and so
-- does the value of this expression, @2@, have type 'Int'. Yet the /form/ of
-- the expression is an application of a function to a literal, while the form
-- of its reduct is an integer literal.
--
-- We introduce convenient Haskell-like names for forms because this datatype is
-- used to index 'SEXP' and other types through the @DataKinds@ extension.
--
data SEXPTYPE
    = Nil
    | Symbol
    | List
    | Closure
    | Env
    | Promise
    | Lang
    | Special
    | Builtin
    | Char
    | Logical
    | Int
    | Real
    | Complex
    | String
    | DotDotDot
    | Any
    | Vector
    | Expr
    | Bytecode
    | ExtPtr
    | WeakRef
    | Raw
    | S4
    | New
    | Free
    | Fun
    deriving (Eq, Ord, Show)

instance Enum SEXPTYPE where
  fromEnum Nil        = 0
{-# LINE 106 "src/Foreign/R/Type.hsc" #-}
  fromEnum Symbol     = 1
{-# LINE 107 "src/Foreign/R/Type.hsc" #-}
  fromEnum List       = 2
{-# LINE 108 "src/Foreign/R/Type.hsc" #-}
  fromEnum Closure    = 3
{-# LINE 109 "src/Foreign/R/Type.hsc" #-}
  fromEnum Env        = 4
{-# LINE 110 "src/Foreign/R/Type.hsc" #-}
  fromEnum Promise    = 5
{-# LINE 111 "src/Foreign/R/Type.hsc" #-}
  fromEnum Lang       = 6
{-# LINE 112 "src/Foreign/R/Type.hsc" #-}
  fromEnum Special    = 7
{-# LINE 113 "src/Foreign/R/Type.hsc" #-}
  fromEnum Builtin    = 8
{-# LINE 114 "src/Foreign/R/Type.hsc" #-}
  fromEnum Char       = 9
{-# LINE 115 "src/Foreign/R/Type.hsc" #-}
  fromEnum Logical    = 10
{-# LINE 116 "src/Foreign/R/Type.hsc" #-}
  fromEnum Int        = 13
{-# LINE 117 "src/Foreign/R/Type.hsc" #-}
  fromEnum Real       = 14
{-# LINE 118 "src/Foreign/R/Type.hsc" #-}
  fromEnum Complex    = 15
{-# LINE 119 "src/Foreign/R/Type.hsc" #-}
  fromEnum String     = 16
{-# LINE 120 "src/Foreign/R/Type.hsc" #-}
  fromEnum DotDotDot  = 17
{-# LINE 121 "src/Foreign/R/Type.hsc" #-}
  fromEnum Any        = 18
{-# LINE 122 "src/Foreign/R/Type.hsc" #-}
  fromEnum Vector     = 19
{-# LINE 123 "src/Foreign/R/Type.hsc" #-}
  fromEnum Expr       = 20
{-# LINE 124 "src/Foreign/R/Type.hsc" #-}
  fromEnum Bytecode   = 21
{-# LINE 125 "src/Foreign/R/Type.hsc" #-}
  fromEnum ExtPtr     = 22
{-# LINE 126 "src/Foreign/R/Type.hsc" #-}
  fromEnum WeakRef    = 23
{-# LINE 127 "src/Foreign/R/Type.hsc" #-}
  fromEnum Raw        = 24
{-# LINE 128 "src/Foreign/R/Type.hsc" #-}
  fromEnum S4         = 25
{-# LINE 129 "src/Foreign/R/Type.hsc" #-}
  fromEnum New        = 30
{-# LINE 130 "src/Foreign/R/Type.hsc" #-}
  fromEnum Free       = 31
{-# LINE 131 "src/Foreign/R/Type.hsc" #-}
  fromEnum Fun        = 99
{-# LINE 132 "src/Foreign/R/Type.hsc" #-}

  toEnum (0)     = Nil
{-# LINE 134 "src/Foreign/R/Type.hsc" #-}
  toEnum (1)     = Symbol
{-# LINE 135 "src/Foreign/R/Type.hsc" #-}
  toEnum (2)    = List
{-# LINE 136 "src/Foreign/R/Type.hsc" #-}
  toEnum (3)     = Closure
{-# LINE 137 "src/Foreign/R/Type.hsc" #-}
  toEnum (4)     = Env
{-# LINE 138 "src/Foreign/R/Type.hsc" #-}
  toEnum (5)    = Promise
{-# LINE 139 "src/Foreign/R/Type.hsc" #-}
  toEnum (6)    = Lang
{-# LINE 140 "src/Foreign/R/Type.hsc" #-}
  toEnum (7) = Special
{-# LINE 141 "src/Foreign/R/Type.hsc" #-}
  toEnum (8) = Builtin
{-# LINE 142 "src/Foreign/R/Type.hsc" #-}
  toEnum (9)    = Char
{-# LINE 143 "src/Foreign/R/Type.hsc" #-}
  toEnum (10)     = Logical
{-# LINE 144 "src/Foreign/R/Type.hsc" #-}
  toEnum (13)     = Int
{-# LINE 145 "src/Foreign/R/Type.hsc" #-}
  toEnum (14)    = Real
{-# LINE 146 "src/Foreign/R/Type.hsc" #-}
  toEnum (15)    = Complex
{-# LINE 147 "src/Foreign/R/Type.hsc" #-}
  toEnum (16)     = String
{-# LINE 148 "src/Foreign/R/Type.hsc" #-}
  toEnum (17)     = DotDotDot
{-# LINE 149 "src/Foreign/R/Type.hsc" #-}
  toEnum (18)     = Any
{-# LINE 150 "src/Foreign/R/Type.hsc" #-}
  toEnum (19)     = Vector
{-# LINE 151 "src/Foreign/R/Type.hsc" #-}
  toEnum (20)    = Expr
{-# LINE 152 "src/Foreign/R/Type.hsc" #-}
  toEnum (21)   = Bytecode
{-# LINE 153 "src/Foreign/R/Type.hsc" #-}
  toEnum (22)  = ExtPtr
{-# LINE 154 "src/Foreign/R/Type.hsc" #-}
  toEnum (23) = WeakRef
{-# LINE 155 "src/Foreign/R/Type.hsc" #-}
  toEnum (24)     = Raw
{-# LINE 156 "src/Foreign/R/Type.hsc" #-}
  toEnum (25)      = S4
{-# LINE 157 "src/Foreign/R/Type.hsc" #-}
  toEnum (30)     = New
{-# LINE 158 "src/Foreign/R/Type.hsc" #-}
  toEnum (31)    = Free
{-# LINE 159 "src/Foreign/R/Type.hsc" #-}
  toEnum (99)     = Fun
{-# LINE 160 "src/Foreign/R/Type.hsc" #-}
  toEnum _                   = violation "toEnum" "Unknown R type."

instance NFData SEXPTYPE where
  rnf = (`seq` ())

genSingletons [''SEXPTYPE]

instance Hs.Lift SEXPTYPE where
  lift a = [| $(Hs.conE (Hs.mkName $ "Foreign.R.Type." ++ show a)) |]

-- | Used where the R documentation speaks of "pairlists", which are really just
-- regular lists.
type PairList = List

-- Use a macro to avoid having to define append at the type level.


-- | Constraint synonym grouping all vector forms into one class. @IsVector a@
-- holds iff R's @is.vector()@ returns @TRUE@.
type IsVector (a :: SEXPTYPE) = (SingI a, a :∈  'Char                    ': 'Logical                    ': 'Int                    ': 'Real                    ': 'Complex                    ': 'String                    ': 'Vector                    ': 'Expr                    ': 'WeakRef                    ': 'Raw ': '[])
{-# LINE 189 "src/Foreign/R/Type.hsc" #-}

-- | Non-atomic vector forms. See @src\/main\/memory.c:SET_VECTOR_ELT@ in the
-- R source distribution.
type IsGenericVector (a :: SEXPTYPE) = (SingI a, a :∈ [Vector, Expr, WeakRef])

-- | @IsList a@ holds iff R's @is.list()@ returns @TRUE@.
type IsList (a :: SEXPTYPE) = (SingI a, a :∈  'Char                    ': 'Logical                    ': 'Int                    ': 'Real                    ': 'Complex                    ': 'String                    ': 'Vector                    ': 'Expr                    ': 'WeakRef                    ': 'Raw ': List ': '[])
{-# LINE 196 "src/Foreign/R/Type.hsc" #-}

-- | @IsPairList a@ holds iff R's @is.pairlist()@ returns @TRUE@.
type IsPairList (a :: SEXPTYPE) = (SingI a, a :∈ [List, Nil])

-- | Constraint synonym grouping all expression forms into one class. According
-- to R internals, an expression is usually a 'Lang', but can sometimes also be
-- an 'Expr' or a 'Symbol'.
type IsExpression (a :: SEXPTYPE) = (SingI a, a :∈ [Lang, Expr, Symbol])