module Fay.Types.FFI
  ( FundamentalType (..)
  , SerializeContext (..)
  ) where

import qualified Fay.Exts.NoAnnotation as N

-- | These are the data types that are serializable directly to native
-- JS data types. Strings, floating points and arrays. The others are:
-- actions in the JS monad, which are thunks that shouldn't be forced
-- when serialized but wrapped up as JS zero-arg functions, and
-- unknown types can't be converted but should at least be forced.
data FundamentalType
   -- Recursive types.
 = FunctionType [FundamentalType]
 | JsType FundamentalType
 | ListType FundamentalType
 | TupleType [FundamentalType]
 | UserDefined N.Name [FundamentalType]
 | Defined FundamentalType
 | Nullable FundamentalType
 -- Simple types.
 | DateType
 | StringType
 | DoubleType
 | IntType
 | BoolType
 | PtrType
 --  Automatically serialize this type.
 | Automatic
 -- Unknown.
 | UnknownType
   deriving (Int -> FundamentalType -> ShowS
[FundamentalType] -> ShowS
FundamentalType -> String
(Int -> FundamentalType -> ShowS)
-> (FundamentalType -> String)
-> ([FundamentalType] -> ShowS)
-> Show FundamentalType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FundamentalType] -> ShowS
$cshowList :: [FundamentalType] -> ShowS
show :: FundamentalType -> String
$cshow :: FundamentalType -> String
showsPrec :: Int -> FundamentalType -> ShowS
$cshowsPrec :: Int -> FundamentalType -> ShowS
Show)

-- | The serialization context indicates whether we're currently
-- serializing some value or a particular field in a user-defined data
-- type.
data SerializeContext = SerializeAnywhere | SerializeUserArg Int
  deriving (SerializeContext -> SerializeContext -> Bool
(SerializeContext -> SerializeContext -> Bool)
-> (SerializeContext -> SerializeContext -> Bool)
-> Eq SerializeContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SerializeContext -> SerializeContext -> Bool
$c/= :: SerializeContext -> SerializeContext -> Bool
== :: SerializeContext -> SerializeContext -> Bool
$c== :: SerializeContext -> SerializeContext -> Bool
Eq, ReadPrec [SerializeContext]
ReadPrec SerializeContext
Int -> ReadS SerializeContext
ReadS [SerializeContext]
(Int -> ReadS SerializeContext)
-> ReadS [SerializeContext]
-> ReadPrec SerializeContext
-> ReadPrec [SerializeContext]
-> Read SerializeContext
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SerializeContext]
$creadListPrec :: ReadPrec [SerializeContext]
readPrec :: ReadPrec SerializeContext
$creadPrec :: ReadPrec SerializeContext
readList :: ReadS [SerializeContext]
$creadList :: ReadS [SerializeContext]
readsPrec :: Int -> ReadS SerializeContext
$creadsPrec :: Int -> ReadS SerializeContext
Read, Int -> SerializeContext -> ShowS
[SerializeContext] -> ShowS
SerializeContext -> String
(Int -> SerializeContext -> ShowS)
-> (SerializeContext -> String)
-> ([SerializeContext] -> ShowS)
-> Show SerializeContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerializeContext] -> ShowS
$cshowList :: [SerializeContext] -> ShowS
show :: SerializeContext -> String
$cshow :: SerializeContext -> String
showsPrec :: Int -> SerializeContext -> ShowS
$cshowsPrec :: Int -> SerializeContext -> ShowS
Show)