{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE Strict                     #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# OPTIONS_GHC -fno-warn-unused-binds  #-}

module Foreign.Erlang.Term
    ( ExternalTerm(..)
     , -- * Term Format
       Term(..
          , Tuple2
          , Tuple3
          , Tuple4
          , Tuple5
          , Tuple6
          , Tuple7
          , List1
          , List2
          , List3
          , List4
          , List5
          , List6
          , List7
          , Map1
          , Map2
          , Map3
          , Map4
          , Map5
          , Map6
          , Map7
          )
    , MapEntry(.., (:=>))
      -- ** Conversion to and from External Term Format
    , ToTerm(..)
    , toTerms
    , FromTerm(..)
    , fromTerms
    , fromTermA
      -- ** Constructors
    , integer
      -- *** Static numbers
    , SInteger(..)
    , float
    , atom
      -- *** Static atoms
    , SAtom(..)
    , port
    , pid
    , Pid(..)
    , tuple
    , Tuple1(..)
    , string
    , list
    , improperList
    , ref
      -- ** Recognizers
    , isInteger
    , isFloat
    , isAtom
    , isReference
    , isPort
    , isPid
    , isTuple
    , isMap
    , isList
    , isBinary
      -- ** Accessors
    , node
    , atomName
    , length
    , element
    , toString
    , toIntegerTerm
      -- ** Matchers
    , matchAtom
    , matchTuple
    )
where

import           GHC.TypeLits
import           Prelude                 hiding ( id
                                                , length
                                                )
import qualified Prelude                       as P
                                                ( id )
import           Control.Applicative            ( Alternative(..) )
import           Control.Category               ( (>>>) )
import           Control.DeepSeq
import           Control.Monad                 as M
                                                ( replicateM )
import           Data.String
import           Data.ByteString                ( ByteString, pack )
import           Data.ByteString.Char8          ( unpack )
import qualified Data.ByteString               as BS
                                                ( head
                                                , length
                                                , tail
                                                , unpack
                                                , foldr'
                                                )
import qualified Data.ByteString.Char8         as CS
                                                ( ByteString
                                                , pack
                                                , unpack
                                                )
import           Data.Vector                    ( (!)
                                                , Vector
                                                )
import qualified Data.Vector                   as V
                                                ( length
                                                , replicateM
                                                , tail
                                                )
import qualified Data.List                     as L
                                                ( length
                                                , unfoldr
                                                , length
                                                )
import           Data.Binary
import           Data.Binary.Put
import           Data.Binary.Get         hiding ( getBytes )
import           Util.Binary
import           Test.QuickCheck
import           Data.Int
import           Data.Bits                      ( shiftR
                                                , (.&.)
                                                )
import           Data.List.NonEmpty     (NonEmpty(..))
import           Data.Monoid
import           GHC.Exts as E
import           GHC.Generics
import GHC.Stack (HasCallStack)

--------------------------------------------------------------------------------

newtype ExternalTerm = MkExternalTerm { ExternalTerm -> Term
fromExternalTerm :: Term }
  deriving (ExternalTerm -> ExternalTerm -> Bool
(ExternalTerm -> ExternalTerm -> Bool)
-> (ExternalTerm -> ExternalTerm -> Bool) -> Eq ExternalTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalTerm -> ExternalTerm -> Bool
$c/= :: ExternalTerm -> ExternalTerm -> Bool
== :: ExternalTerm -> ExternalTerm -> Bool
$c== :: ExternalTerm -> ExternalTerm -> Bool
Eq, (forall x. ExternalTerm -> Rep ExternalTerm x)
-> (forall x. Rep ExternalTerm x -> ExternalTerm)
-> Generic ExternalTerm
forall x. Rep ExternalTerm x -> ExternalTerm
forall x. ExternalTerm -> Rep ExternalTerm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExternalTerm x -> ExternalTerm
$cfrom :: forall x. ExternalTerm -> Rep ExternalTerm x
Generic, Int -> ExternalTerm -> ShowS
[ExternalTerm] -> ShowS
ExternalTerm -> String
(Int -> ExternalTerm -> ShowS)
-> (ExternalTerm -> String)
-> ([ExternalTerm] -> ShowS)
-> Show ExternalTerm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternalTerm] -> ShowS
$cshowList :: [ExternalTerm] -> ShowS
show :: ExternalTerm -> String
$cshow :: ExternalTerm -> String
showsPrec :: Int -> ExternalTerm -> ShowS
$cshowsPrec :: Int -> ExternalTerm -> ShowS
Show, ExternalTerm -> ()
(ExternalTerm -> ()) -> NFData ExternalTerm
forall a. (a -> ()) -> NFData a
rnf :: ExternalTerm -> ()
$crnf :: ExternalTerm -> ()
NFData, Gen ExternalTerm
Gen ExternalTerm
-> (ExternalTerm -> [ExternalTerm]) -> Arbitrary ExternalTerm
ExternalTerm -> [ExternalTerm]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
shrink :: ExternalTerm -> [ExternalTerm]
$cshrink :: ExternalTerm -> [ExternalTerm]
arbitrary :: Gen ExternalTerm
$carbitrary :: Gen ExternalTerm
Arbitrary)

instance Binary ExternalTerm where
  put :: ExternalTerm -> Put
put (MkExternalTerm Term
t) = do
    Word8 -> Put
putWord8 Word8
magicVersion
    Term -> Put
forall t. Binary t => t -> Put
put Term
t
  get :: Get ExternalTerm
get = do
    HasCallStack => Word8 -> Get ()
Word8 -> Get ()
matchWord8 Word8
magicVersion
    Term -> ExternalTerm
MkExternalTerm (Term -> ExternalTerm) -> Get Term -> Get ExternalTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Term
forall t. Binary t => Get t
get

--------------------------------------------------------------------------------

data Term = Integer Integer
          | Float Double
          | Atom ByteString
          | Reference ByteString Word32 Word8
          | Port ByteString Word32 Word8
          | Pid ByteString Word32 Word32 Word8
          | Tuple (Vector Term)
          | Map (Vector MapEntry)
          | Nil
          | String ByteString
          | List (Vector Term) Term
          | Binary ByteString
          | NewReference ByteString Word8 [Word32]
    deriving (Term -> Term -> Bool
(Term -> Term -> Bool) -> (Term -> Term -> Bool) -> Eq Term
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Term -> Term -> Bool
$c/= :: Term -> Term -> Bool
== :: Term -> Term -> Bool
$c== :: Term -> Term -> Bool
Eq, (forall x. Term -> Rep Term x)
-> (forall x. Rep Term x -> Term) -> Generic Term
forall x. Rep Term x -> Term
forall x. Term -> Rep Term x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Term x -> Term
$cfrom :: forall x. Term -> Rep Term x
Generic)

instance NFData Term

-- ** Pattern Synonyms for 'Term's
pattern Tuple2 :: Term -> Term -> Term
pattern $bTuple2 :: Term -> Term -> Term
$mTuple2 :: forall r. Term -> (Term -> Term -> r) -> (Void# -> r) -> r
Tuple2 t1 t2 <- Tuple (toList -> [t1,t2]) where
    Tuple2 Term
t1 Term
t2  = Vector Term -> Term
Tuple ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2])

pattern Tuple3 :: Term -> Term -> Term -> Term
pattern $bTuple3 :: Term -> Term -> Term -> Term
$mTuple3 :: forall r. Term -> (Term -> Term -> Term -> r) -> (Void# -> r) -> r
Tuple3 t1 t2 t3 <- Tuple (toList -> [t1,t2,t3]) where
    Tuple3 Term
t1 Term
t2 Term
t3  = Vector Term -> Term
Tuple ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2,Item (Vector Term)
Term
t3])

pattern Tuple4 :: Term -> Term -> Term -> Term -> Term
pattern $bTuple4 :: Term -> Term -> Term -> Term -> Term
$mTuple4 :: forall r.
Term -> (Term -> Term -> Term -> Term -> r) -> (Void# -> r) -> r
Tuple4 t1 t2 t3 t4 <- Tuple (toList -> [t1,t2,t3,t4]) where
    Tuple4 Term
t1 Term
t2 Term
t3 Term
t4  = Vector Term -> Term
Tuple ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2,Item (Vector Term)
Term
t3,Item (Vector Term)
Term
t4])

pattern Tuple5 :: Term -> Term -> Term -> Term -> Term -> Term
pattern $bTuple5 :: Term -> Term -> Term -> Term -> Term -> Term
$mTuple5 :: forall r.
Term
-> (Term -> Term -> Term -> Term -> Term -> r) -> (Void# -> r) -> r
Tuple5 t1 t2 t3 t4 t5 <- Tuple (toList -> [t1,t2,t3,t4,t5]) where
    Tuple5 Term
t1 Term
t2 Term
t3 Term
t4 Term
t5  = Vector Term -> Term
Tuple ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2,Item (Vector Term)
Term
t3,Item (Vector Term)
Term
t4,Item (Vector Term)
Term
t5])

pattern Tuple6 :: Term
                        -> Term -> Term -> Term -> Term -> Term -> Term
pattern $bTuple6 :: Term -> Term -> Term -> Term -> Term -> Term -> Term
$mTuple6 :: forall r.
Term
-> (Term -> Term -> Term -> Term -> Term -> Term -> r)
-> (Void# -> r)
-> r
Tuple6 t1 t2 t3 t4 t5 t6 <- Tuple (toList -> [t1,t2,t3,t4,t5,t6]) where
    Tuple6 Term
t1 Term
t2 Term
t3 Term
t4 Term
t5 Term
t6  = Vector Term -> Term
Tuple ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2,Item (Vector Term)
Term
t3,Item (Vector Term)
Term
t4,Item (Vector Term)
Term
t5,Item (Vector Term)
Term
t6])

pattern Tuple7 :: Term
                        -> Term -> Term -> Term -> Term -> Term -> Term -> Term
pattern $bTuple7 :: Term -> Term -> Term -> Term -> Term -> Term -> Term -> Term
$mTuple7 :: forall r.
Term
-> (Term -> Term -> Term -> Term -> Term -> Term -> Term -> r)
-> (Void# -> r)
-> r
Tuple7 t1 t2 t3 t4 t5 t6 t7 <- Tuple (toList -> [t1,t2,t3,t4,t5,t6,t7]) where
    Tuple7 Term
t1 Term
t2 Term
t3 Term
t4 Term
t5 Term
t6 Term
t7  = Vector Term -> Term
Tuple ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2,Item (Vector Term)
Term
t3,Item (Vector Term)
Term
t4,Item (Vector Term)
Term
t5,Item (Vector Term)
Term
t6,Item (Vector Term)
Term
t7])

pattern List1 :: Term -> Term
pattern $bList1 :: Term -> Term
$mList1 :: forall r. Term -> (Term -> r) -> (Void# -> r) -> r
List1 t1 <- List (toList -> [t1]) Nil where
    List1 Term
t1  = Vector Term -> Term -> Term
List ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1]) Term
Nil

pattern List2 :: Term -> Term -> Term
pattern $bList2 :: Term -> Term -> Term
$mList2 :: forall r. Term -> (Term -> Term -> r) -> (Void# -> r) -> r
List2 t1 t2 <- List (toList -> [t1,t2]) Nil where
    List2 Term
t1 Term
t2  = Vector Term -> Term -> Term
List ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2]) Term
Nil

pattern List3 :: Term -> Term -> Term -> Term
pattern $bList3 :: Term -> Term -> Term -> Term
$mList3 :: forall r. Term -> (Term -> Term -> Term -> r) -> (Void# -> r) -> r
List3 t1 t2 t3 <- List (toList -> [t1,t2,t3]) Nil where
    List3 Term
t1 Term
t2 Term
t3  = Vector Term -> Term -> Term
List ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2,Item (Vector Term)
Term
t3]) Term
Nil

pattern List4 :: Term -> Term -> Term -> Term -> Term
pattern $bList4 :: Term -> Term -> Term -> Term -> Term
$mList4 :: forall r.
Term -> (Term -> Term -> Term -> Term -> r) -> (Void# -> r) -> r
List4 t1 t2 t3 t4 <- List (toList -> [t1,t2,t3,t4]) Nil where
    List4 Term
t1 Term
t2 Term
t3 Term
t4  = Vector Term -> Term -> Term
List ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2,Item (Vector Term)
Term
t3,Item (Vector Term)
Term
t4]) Term
Nil

pattern List5 :: Term -> Term -> Term -> Term -> Term -> Term
pattern $bList5 :: Term -> Term -> Term -> Term -> Term -> Term
$mList5 :: forall r.
Term
-> (Term -> Term -> Term -> Term -> Term -> r) -> (Void# -> r) -> r
List5 t1 t2 t3 t4 t5 <- List (toList -> [t1,t2,t3,t4,t5]) Nil where
    List5 Term
t1 Term
t2 Term
t3 Term
t4 Term
t5  = Vector Term -> Term -> Term
List ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2,Item (Vector Term)
Term
t3,Item (Vector Term)
Term
t4,Item (Vector Term)
Term
t5]) Term
Nil

pattern List6 :: Term
                       -> Term -> Term -> Term -> Term -> Term -> Term
pattern $bList6 :: Term -> Term -> Term -> Term -> Term -> Term -> Term
$mList6 :: forall r.
Term
-> (Term -> Term -> Term -> Term -> Term -> Term -> r)
-> (Void# -> r)
-> r
List6 t1 t2 t3 t4 t5 t6 <- List (toList -> [t1,t2,t3,t4,t5,t6]) Nil where
    List6 Term
t1 Term
t2 Term
t3 Term
t4 Term
t5 Term
t6  = Vector Term -> Term -> Term
List ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2,Item (Vector Term)
Term
t3,Item (Vector Term)
Term
t4,Item (Vector Term)
Term
t5,Item (Vector Term)
Term
t6]) Term
Nil

pattern List7 :: Term
                       -> Term -> Term -> Term -> Term -> Term -> Term -> Term
pattern $bList7 :: Term -> Term -> Term -> Term -> Term -> Term -> Term -> Term
$mList7 :: forall r.
Term
-> (Term -> Term -> Term -> Term -> Term -> Term -> Term -> r)
-> (Void# -> r)
-> r
List7 t1 t2 t3 t4 t5 t6 t7 <- List (toList -> [t1,t2,t3,t4,t5,t6,t7]) Nil where
    List7 Term
t1 Term
t2 Term
t3 Term
t4 Term
t5 Term
t6 Term
t7  = Vector Term -> Term -> Term
List ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)
Term
t1,Item (Vector Term)
Term
t2,Item (Vector Term)
Term
t3,Item (Vector Term)
Term
t4,Item (Vector Term)
Term
t5,Item (Vector Term)
Term
t6,Item (Vector Term)
Term
t7]) Term
Nil

pattern (:=>) :: Term -> Term -> MapEntry
pattern k $b:=> :: Term -> Term -> MapEntry
$m:=> :: forall r. MapEntry -> (Term -> Term -> r) -> (Void# -> r) -> r
:=> v = MapEntry k v

pattern Map1 :: MapEntry -> Term
pattern $bMap1 :: MapEntry -> Term
$mMap1 :: forall r. Term -> (MapEntry -> r) -> (Void# -> r) -> r
Map1 t1 <- Map (toList -> [t1]) where
    Map1 MapEntry
t1  = Vector MapEntry -> Term
Map ([Item (Vector MapEntry)] -> Vector MapEntry
forall l. IsList l => [Item l] -> l
fromList [Item (Vector MapEntry)
MapEntry
t1])

pattern Map2 :: MapEntry -> MapEntry -> Term
pattern $bMap2 :: MapEntry -> MapEntry -> Term
$mMap2 :: forall r. Term -> (MapEntry -> MapEntry -> r) -> (Void# -> r) -> r
Map2 t1 t2 <- Map (toList -> [t1,t2]) where
    Map2 MapEntry
t1 MapEntry
t2  = Vector MapEntry -> Term
Map ([Item (Vector MapEntry)] -> Vector MapEntry
forall l. IsList l => [Item l] -> l
fromList [Item (Vector MapEntry)
MapEntry
t1,Item (Vector MapEntry)
MapEntry
t2])

pattern Map3 :: MapEntry -> MapEntry -> MapEntry -> Term
pattern $bMap3 :: MapEntry -> MapEntry -> MapEntry -> Term
$mMap3 :: forall r.
Term
-> (MapEntry -> MapEntry -> MapEntry -> r) -> (Void# -> r) -> r
Map3 t1 t2 t3 <- Map (toList -> [t1,t2,t3]) where
    Map3 MapEntry
t1 MapEntry
t2 MapEntry
t3  = Vector MapEntry -> Term
Map ([Item (Vector MapEntry)] -> Vector MapEntry
forall l. IsList l => [Item l] -> l
fromList [Item (Vector MapEntry)
MapEntry
t1,Item (Vector MapEntry)
MapEntry
t2,Item (Vector MapEntry)
MapEntry
t3])

pattern Map4 :: MapEntry
                      -> MapEntry -> MapEntry -> MapEntry -> Term
pattern $bMap4 :: MapEntry -> MapEntry -> MapEntry -> MapEntry -> Term
$mMap4 :: forall r.
Term
-> (MapEntry -> MapEntry -> MapEntry -> MapEntry -> r)
-> (Void# -> r)
-> r
Map4 t1 t2 t3 t4 <- Map (toList -> [t1,t2,t3,t4]) where
    Map4 MapEntry
t1 MapEntry
t2 MapEntry
t3 MapEntry
t4  = Vector MapEntry -> Term
Map ([Item (Vector MapEntry)] -> Vector MapEntry
forall l. IsList l => [Item l] -> l
fromList [Item (Vector MapEntry)
MapEntry
t1,Item (Vector MapEntry)
MapEntry
t2,Item (Vector MapEntry)
MapEntry
t3,Item (Vector MapEntry)
MapEntry
t4])

pattern Map5 :: MapEntry
                      -> MapEntry -> MapEntry -> MapEntry -> MapEntry -> Term
pattern $bMap5 :: MapEntry -> MapEntry -> MapEntry -> MapEntry -> MapEntry -> Term
$mMap5 :: forall r.
Term
-> (MapEntry -> MapEntry -> MapEntry -> MapEntry -> MapEntry -> r)
-> (Void# -> r)
-> r
Map5 t1 t2 t3 t4 t5 <- Map (toList -> [t1,t2,t3,t4,t5]) where
    Map5 MapEntry
t1 MapEntry
t2 MapEntry
t3 MapEntry
t4 MapEntry
t5  = Vector MapEntry -> Term
Map ([Item (Vector MapEntry)] -> Vector MapEntry
forall l. IsList l => [Item l] -> l
fromList [Item (Vector MapEntry)
MapEntry
t1,Item (Vector MapEntry)
MapEntry
t2,Item (Vector MapEntry)
MapEntry
t3,Item (Vector MapEntry)
MapEntry
t4,Item (Vector MapEntry)
MapEntry
t5])

pattern Map6 :: MapEntry
                      -> MapEntry -> MapEntry -> MapEntry -> MapEntry -> MapEntry -> Term
pattern $bMap6 :: MapEntry
-> MapEntry -> MapEntry -> MapEntry -> MapEntry -> MapEntry -> Term
$mMap6 :: forall r.
Term
-> (MapEntry
    -> MapEntry -> MapEntry -> MapEntry -> MapEntry -> MapEntry -> r)
-> (Void# -> r)
-> r
Map6 t1 t2 t3 t4 t5 t6 <- Map (toList -> [t1,t2,t3,t4,t5,t6]) where
    Map6 MapEntry
t1 MapEntry
t2 MapEntry
t3 MapEntry
t4 MapEntry
t5 MapEntry
t6  = Vector MapEntry -> Term
Map ([Item (Vector MapEntry)] -> Vector MapEntry
forall l. IsList l => [Item l] -> l
fromList [Item (Vector MapEntry)
MapEntry
t1,Item (Vector MapEntry)
MapEntry
t2,Item (Vector MapEntry)
MapEntry
t3,Item (Vector MapEntry)
MapEntry
t4,Item (Vector MapEntry)
MapEntry
t5,Item (Vector MapEntry)
MapEntry
t6])

pattern Map7 :: MapEntry
                      -> MapEntry
                      -> MapEntry
                      -> MapEntry
                      -> MapEntry
                      -> MapEntry
                      -> MapEntry
                      -> Term
pattern $bMap7 :: MapEntry
-> MapEntry
-> MapEntry
-> MapEntry
-> MapEntry
-> MapEntry
-> MapEntry
-> Term
$mMap7 :: forall r.
Term
-> (MapEntry
    -> MapEntry
    -> MapEntry
    -> MapEntry
    -> MapEntry
    -> MapEntry
    -> MapEntry
    -> r)
-> (Void# -> r)
-> r
Map7 t1 t2 t3 t4 t5 t6 t7 <- Map (toList -> [t1,t2,t3,t4,t5,t6,t7]) where
    Map7 MapEntry
t1 MapEntry
t2 MapEntry
t3 MapEntry
t4 MapEntry
t5 MapEntry
t6 MapEntry
t7  = Vector MapEntry -> Term
Map ([Item (Vector MapEntry)] -> Vector MapEntry
forall l. IsList l => [Item l] -> l
fromList [Item (Vector MapEntry)
MapEntry
t1,Item (Vector MapEntry)
MapEntry
t2,Item (Vector MapEntry)
MapEntry
t3,Item (Vector MapEntry)
MapEntry
t4,Item (Vector MapEntry)
MapEntry
t5,Item (Vector MapEntry)
MapEntry
t6,Item (Vector MapEntry)
MapEntry
t7])


data MapEntry = MapEntry { MapEntry -> Term
key   :: Term
                         , MapEntry -> Term
value :: Term
                         }
    deriving (MapEntry -> MapEntry -> Bool
(MapEntry -> MapEntry -> Bool)
-> (MapEntry -> MapEntry -> Bool) -> Eq MapEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapEntry -> MapEntry -> Bool
$c/= :: MapEntry -> MapEntry -> Bool
== :: MapEntry -> MapEntry -> Bool
$c== :: MapEntry -> MapEntry -> Bool
Eq, (forall x. MapEntry -> Rep MapEntry x)
-> (forall x. Rep MapEntry x -> MapEntry) -> Generic MapEntry
forall x. Rep MapEntry x -> MapEntry
forall x. MapEntry -> Rep MapEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MapEntry x -> MapEntry
$cfrom :: forall x. MapEntry -> Rep MapEntry x
Generic)

instance NFData MapEntry

-- number < atom < reference < fun < port < pid < tuple < map < nil < list < bit string
instance Ord Term where
    (Integer Integer
i) compare :: Term -> Term -> Ordering
`compare` (Integer Integer
i') =
        Integer
i Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Integer
i'
    (Integer Integer
i) `compare` (Float Double
d') =
        Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Double
d'
    (Integer Integer
_) `compare` Term
_ =
        Ordering
LT

    (Float Double
d) `compare` (Float Double
d') =
        Double
d Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Double
d'
    (Float Double
d) `compare` (Integer Integer
i') =
        Double
d Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i'
    (Float Double
_) `compare` Term
_ = Ordering
LT

    (Atom ByteString
a) `compare` (Atom ByteString
a') =
        ByteString
a ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ByteString
a'
    (Atom ByteString
_) `compare` Term
_ = Ordering
LT

    (Reference ByteString
node' Word32
id Word8
creation) `compare` (Reference ByteString
node'' Word32
id' Word8
creation') =
        (ByteString
node', Word32
id, Word8
creation) (ByteString, Word32, Word8)
-> (ByteString, Word32, Word8) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (ByteString
node'', Word32
id', Word8
creation')
    Reference{} `compare` Term
_ =
        Ordering
LT

    (NewReference ByteString
node' Word8
creation [Word32]
ids) `compare` (NewReference ByteString
node'' Word8
creation' [Word32]
ids') =
        (ByteString
node', Word8
creation, [Word32]
ids) (ByteString, Word8, [Word32])
-> (ByteString, Word8, [Word32]) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (ByteString
node'', Word8
creation', [Word32]
ids')
    NewReference{} `compare` Term
_ =
        Ordering
LT

    (Port ByteString
node' Word32
id Word8
creation) `compare` (Port ByteString
node'' Word32
id' Word8
creation') =
        (ByteString
node', Word32
id, Word8
creation) (ByteString, Word32, Word8)
-> (ByteString, Word32, Word8) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (ByteString
node'', Word32
id', Word8
creation')
    Port{} `compare` Term
_ =
        Ordering
LT

    (Pid ByteString
node' Word32
id Word32
serial Word8
creation) `compare` (Pid ByteString
node'' Word32
id' Word32
serial' Word8
creation') =
        (ByteString
node', Word32
id, Word32
serial, Word8
creation) (ByteString, Word32, Word32, Word8)
-> (ByteString, Word32, Word32, Word8) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (ByteString
node'', Word32
id', Word32
serial', Word8
creation')
    Pid{} `compare` Term
_ =
        Ordering
LT

    (Tuple Vector Term
v) `compare` (Tuple Vector Term
v') =
        Vector Term
v Vector Term -> Vector Term -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Vector Term
v'
    (Tuple Vector Term
_) `compare` Term
_ = Ordering
LT

    (Map Vector MapEntry
e) `compare` (Map Vector MapEntry
e') =
        Vector MapEntry
e Vector MapEntry -> Vector MapEntry -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Vector MapEntry
e'
    (Map Vector MapEntry
_) `compare` Term
_ = Ordering
LT

    Term
Nil `compare` Term
Nil = Ordering
EQ
    Term
Nil `compare` Term
_ = Ordering
LT

    (String ByteString
s) `compare` (String ByteString
s') =
        ByteString
s ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ByteString
s'
    (String ByteString
s) `compare` (List Vector Term
v' Term
t') =
        (ByteString -> Vector Term
toVector ByteString
s, Term
Nil) (Vector Term, Term) -> (Vector Term, Term) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Vector Term
v', Term
t')
    (String ByteString
_) `compare` Term
_ =
        Ordering
LT

    (List Vector Term
v Term
t) `compare` (List Vector Term
v' Term
t') =
        (Vector Term
v, Term
t) (Vector Term, Term) -> (Vector Term, Term) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Vector Term
v', Term
t')
    (List Vector Term
v Term
t) `compare` (String ByteString
s') =
        (Vector Term
v, Term
t) (Vector Term, Term) -> (Vector Term, Term) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (ByteString -> Vector Term
toVector ByteString
s', Term
Nil)
    (List Vector Term
_ Term
_) `compare` Term
_ =
        Ordering
LT

    (Binary ByteString
b) `compare` (Binary ByteString
b') =
        ByteString
b ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ByteString
b'
    (Binary ByteString
_) `compare` Term
_ =
        Ordering
LT

toVector :: ByteString -> Vector Term
toVector :: ByteString -> Vector Term
toVector = ByteString -> [Word8]
BS.unpack (ByteString -> [Word8])
-> ([Word8] -> Vector Term) -> ByteString -> Vector Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Word8 -> Term) -> [Word8] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Integer) -> (Integer -> Term) -> Word8 -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Integer -> Term
Integer) ([Word8] -> [Term])
-> ([Term] -> Vector Term) -> [Word8] -> Vector Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Term] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList

instance Ord MapEntry where
    MapEntry{key :: MapEntry -> Term
key = Term
k,value :: MapEntry -> Term
value = Term
v} compare :: MapEntry -> MapEntry -> Ordering
`compare` MapEntry{key :: MapEntry -> Term
key = Term
k',value :: MapEntry -> Term
value = Term
v'} =
        (Term
k, Term
v) (Term, Term) -> (Term, Term) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Term
k', Term
v') -- FIXME integer keys are less than float keys

instance Show Term where
    showsPrec :: Int -> Term -> ShowS
showsPrec Int
_ (Integer Integer
i) = Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
i
    showsPrec Int
_ (Float Double
d) = Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
d
    showsPrec Int
_ (Atom ByteString
a) = Char -> ShowS
showChar Char
'\'' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (ByteString -> String
unpack ByteString
a) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\''
    showsPrec Int
_ (Reference ByteString
nodeName Word32
id Word8
_creation) =
         String -> ShowS
showString String
"#Ref<" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (ByteString -> String
unpack ByteString
nodeName) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. Show a => a -> ShowS
shows Word32
id ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'>'
    showsPrec Int
_ (Port ByteString
nodeName Word32
id Word8
_creation) =
         String -> ShowS
showString String
"#Port<" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (ByteString -> String
unpack ByteString
nodeName) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. Show a => a -> ShowS
shows Word32
id ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar  Char
'>'
    showsPrec Int
_ (Pid ByteString
nodeName Word32
id Word32
serial Word8
_creation) =
         String -> ShowS
showString String
"#Pid<" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (ByteString -> String
unpack ByteString
nodeName) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. Show a => a -> ShowS
shows Word32
id ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. Show a => a -> ShowS
shows Word32
serial ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'>'
    showsPrec Int
_ (Tuple Vector Term
v) = Char -> ShowS
showChar Char
'{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Term -> ShowS
forall a. Show a => Vector a -> ShowS
showsVectorAsList Vector Term
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
    showsPrec Int
_ (Map Vector MapEntry
e) = String -> ShowS
showString String
"#{" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector MapEntry -> ShowS
forall a. Show a => Vector a -> ShowS
showsVectorAsList Vector MapEntry
e ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
    showsPrec Int
_ Term
Nil = String -> ShowS
showString String
"[]"
    showsPrec Int
_ (String ByteString
s) = ByteString -> ShowS
forall a. Show a => a -> ShowS
shows ByteString
s
    showsPrec Int
_ (List Vector Term
v Term
Nil) = Char -> ShowS
showChar Char
'[' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Term -> ShowS
forall a. Show a => Vector a -> ShowS
showsVectorAsList Vector Term
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']'
    showsPrec Int
_ (List Vector Term
v Term
t) = Char -> ShowS
showChar Char
'[' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Term -> ShowS
forall a. Show a => Vector a -> ShowS
showsVectorAsList Vector Term
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'|' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> ShowS
forall a. Show a => a -> ShowS
shows Term
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']'
    showsPrec Int
_ (Binary ByteString
b) = String -> ShowS
showString String
"<<" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShowS
showsByteStringAsIntList ByteString
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
">>"
    showsPrec Int
_ (NewReference ByteString
nodeName Word8
_creation [Word32]
ids) =
         String -> ShowS
showString String
"#Ref<" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (ByteString -> String
unpack ByteString
nodeName) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo String -> ShowS
forall a. Endo a -> a -> a
appEndo ((Word32 -> Endo String) -> [Word32] -> Endo String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Word32
i -> ShowS -> Endo String
forall a. (a -> a) -> Endo a
Endo (Char -> ShowS
showChar Char
'.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. Show a => a -> ShowS
shows Word32
i)) [Word32]
ids) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'>'

instance Show MapEntry where
    showsPrec :: Int -> MapEntry -> ShowS
showsPrec Int
_ MapEntry{Term
key :: Term
key :: MapEntry -> Term
key,Term
value :: Term
value :: MapEntry -> Term
value} =
        Term -> ShowS
forall a. Show a => a -> ShowS
shows Term
key ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" => " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> ShowS
forall a. Show a => a -> ShowS
shows Term
value

showsVectorAsList :: Show a => Vector a -> ShowS
showsVectorAsList :: Vector a -> ShowS
showsVectorAsList Vector a
v
  | Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ShowS
forall a. a -> a
P.id
  | Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = a -> ShowS
forall a. Show a => a -> ShowS
shows (Vector a
v Vector a -> Int -> a
forall a. Vector a -> Int -> a
! Int
0)
  | Bool
otherwise =
    a -> ShowS
forall a. Show a => a -> ShowS
shows (Vector a
v Vector a -> Int -> a
forall a. Vector a -> Int -> a
! Int
0) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Endo String -> ShowS
forall a. Endo a -> a -> a
appEndo ((a -> Endo String) -> Vector a -> Endo String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\a
t -> ShowS -> Endo String
forall a. (a -> a) -> Endo a
Endo (Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
t)) (Vector a -> Vector a
forall a. Vector a -> Vector a
V.tail Vector a
v))

showsByteStringAsIntList :: ByteString -> ShowS
showsByteStringAsIntList :: ByteString -> ShowS
showsByteStringAsIntList ByteString
b
  | ByteString -> Int
BS.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ShowS
forall a. a -> a
P.id
  | ByteString -> Int
BS.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Word8 -> ShowS
forall a. Show a => a -> ShowS
shows (ByteString -> Word8
BS.head ByteString
b)
  | Bool
otherwise =
    Word8 -> ShowS
forall a. Show a => a -> ShowS
shows (ByteString -> Word8
BS.head ByteString
b) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Endo String -> ShowS
forall a. Endo a -> a -> a
appEndo
      ((Word8 -> Endo String) -> [Word8] -> Endo String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Word8
t -> ShowS -> Endo String
forall a. (a -> a) -> Endo a
Endo (Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
forall a. Show a => a -> ShowS
shows Word8
t)) (ByteString -> [Word8]
BS.unpack (ByteString -> ByteString
BS.tail ByteString
b)))

instance IsString Term where
    fromString :: String -> Term
fromString = ByteString -> Term
atom (ByteString -> Term) -> (String -> ByteString) -> String -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
CS.pack

instance E.IsList Term where
    type Item Term = Term
    fromList :: [Item Term] -> Term
fromList [Item Term]
xs = Vector Term -> Term -> Term
List ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)]
[Item Term]
xs) Term
Nil
    toList :: Term -> [Item Term]
toList (List Vector Term
xs Term
Nil) = Vector Term -> [Item (Vector Term)]
forall l. IsList l => l -> [Item l]
toList Vector Term
xs
    toList Term
_             = []

instance FromTerm Term where
    fromTerm :: Term -> Maybe Term
fromTerm = Term -> Maybe Term
forall a. a -> Maybe a
Just

instance ToTerm Term where
    toTerm :: Term -> Term
toTerm = Term -> Term
forall a. a -> a
P.id


instance Num Term where
 (Integer Integer
x) + :: Term -> Term -> Term
+ (Integer Integer
y) = Integer -> Term
Integer (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
y)
 (Float Double
x) + (Float Double
y) = Double -> Term
Float (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y)
 Term
_ + Term
_ = String -> Term
forall a. HasCallStack => String -> a
error String
"non numeric arguments to (+)"
 (Integer Integer
x) * :: Term -> Term -> Term
* (Integer Integer
y) = Integer -> Term
Integer (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
y)
 (Float Double
x) * (Float Double
y) = Double -> Term
Float (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y)
 Term
_ * Term
_ = String -> Term
forall a. HasCallStack => String -> a
error String
"non numeric arguments to (*)"
 abs :: Term -> Term
abs (Integer Integer
x)  = Integer -> Term
Integer (Integer -> Integer
forall a. Num a => a -> a
abs Integer
x)
 abs (Float Double
x)  = Double -> Term
Float (Double -> Double
forall a. Num a => a -> a
abs Double
x)
 abs Term
_ = String -> Term
forall a. HasCallStack => String -> a
error String
"non numeric arguments to 'abs'"
 signum :: Term -> Term
signum (Integer Integer
x)  = Integer -> Term
Integer (Integer -> Integer
forall a. Num a => a -> a
signum Integer
x)
 signum (Float Double
x)  = Double -> Term
Float (Double -> Double
forall a. Num a => a -> a
signum Double
x)
 signum Term
_ = String -> Term
forall a. HasCallStack => String -> a
error String
"non numeric arguments to 'signum'"
 negate :: Term -> Term
negate (Integer Integer
x)  = Integer -> Term
Integer (Integer -> Integer
forall a. Num a => a -> a
negate Integer
x)
 negate (Float Double
x)  = Double -> Term
Float (Double -> Double
forall a. Num a => a -> a
negate Double
x)
 negate Term
_ = String -> Term
forall a. HasCallStack => String -> a
error String
"non numeric arguments to 'negate'"
 fromInteger :: Integer -> Term
fromInteger = Integer -> Term
integer

--------------------------------------------------------------------------------

class ToTerm a where
    toTerm :: a -> Term

class FromTerm a where
    fromTerm :: Term -> Maybe a

fromTermA :: (FromTerm a, Alternative m) => Term -> m a
fromTermA :: Term -> m a
fromTermA Term
t = case Term -> Maybe a
forall a. FromTerm a => Term -> Maybe a
fromTerm Term
t of
    Just a
x  -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    Maybe a
Nothing -> m a
forall (f :: * -> *) a. Alternative f => f a
empty

instance FromTerm () where
    fromTerm :: Term -> Maybe ()
fromTerm (Tuple Vector Term
ts) | Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> Maybe ()
forall a. a -> Maybe a
Just ()
    fromTerm Term
_ = Maybe ()
forall a. Maybe a
Nothing

instance FromTerm Double where
    fromTerm :: Term -> Maybe Double
fromTerm (Float Double
f) = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
f
    fromTerm Term
_ = Maybe Double
forall a. Maybe a
Nothing

instance FromTerm Bool where
    fromTerm :: Term -> Maybe Bool
fromTerm Term
"true" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    fromTerm Term
"false" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    fromTerm Term
_ = Maybe Bool
forall a. Maybe a
Nothing
instance FromTerm Integer where
    fromTerm :: Term -> Maybe Integer
fromTerm (Integer Integer
i) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    fromTerm Term
_ = Maybe Integer
forall a. Maybe a
Nothing

instance FromTerm String where
    fromTerm :: Term -> Maybe String
fromTerm (String ByteString
s) = String -> Maybe String
forall a. a -> Maybe a
Just (ByteString -> String
CS.unpack ByteString
s)
    fromTerm Term
_ = Maybe String
forall a. Maybe a
Nothing

instance (FromTerm a) => FromTerm (Tuple1 a) where
    fromTerm :: Term -> Maybe (Tuple1 a)
fromTerm (Tuple Vector Term
ts) | Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = a -> Tuple1 a
forall a. a -> Tuple1 a
Tuple1 (a -> Tuple1 a) -> Maybe a -> Maybe (Tuple1 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Maybe a
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
0)
    fromTerm Term
_ = Maybe (Tuple1 a)
forall a. Maybe a
Nothing

instance (FromTerm a, FromTerm b) => FromTerm (a, b) where
    fromTerm :: Term -> Maybe (a, b)
fromTerm (Tuple Vector Term
ts) | Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = (,) (a -> b -> (a, b)) -> Maybe a -> Maybe (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Maybe a
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
0) Maybe (b -> (a, b)) -> Maybe b -> Maybe (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> Maybe b
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
1)
    fromTerm Term
_ = Maybe (a, b)
forall a. Maybe a
Nothing

instance (FromTerm a, FromTerm b, FromTerm c) => FromTerm (a, b, c) where
    fromTerm :: Term -> Maybe (a, b, c)
fromTerm (Tuple Vector Term
ts) | Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = (,,) (a -> b -> c -> (a, b, c))
-> Maybe a -> Maybe (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Maybe a
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
0) Maybe (b -> c -> (a, b, c)) -> Maybe b -> Maybe (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> Maybe b
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
1) Maybe (c -> (a, b, c)) -> Maybe c -> Maybe (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> Maybe c
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
2)
    fromTerm Term
_ = Maybe (a, b, c)
forall a. Maybe a
Nothing

instance (FromTerm a, FromTerm b, FromTerm c, FromTerm d) => FromTerm (a, b, c, d) where
    fromTerm :: Term -> Maybe (a, b, c, d)
fromTerm (Tuple Vector Term
ts) | Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Maybe a -> Maybe (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Maybe a
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
0)
                                                   Maybe (b -> c -> d -> (a, b, c, d))
-> Maybe b -> Maybe (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> Maybe b
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
1)
                                                   Maybe (c -> d -> (a, b, c, d))
-> Maybe c -> Maybe (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> Maybe c
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
2)
                                                   Maybe (d -> (a, b, c, d)) -> Maybe d -> Maybe (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> Maybe d
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
3)
    fromTerm Term
_ = Maybe (a, b, c, d)
forall a. Maybe a
Nothing

instance (FromTerm a, FromTerm b, FromTerm c, FromTerm d, FromTerm e) => FromTerm (a, b, c, d, e) where
    fromTerm :: Term -> Maybe (a, b, c, d, e)
fromTerm (Tuple Vector Term
ts) | Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Maybe a -> Maybe (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Maybe a
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
0)
                                                    Maybe (b -> c -> d -> e -> (a, b, c, d, e))
-> Maybe b -> Maybe (c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> Maybe b
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
1)
                                                    Maybe (c -> d -> e -> (a, b, c, d, e))
-> Maybe c -> Maybe (d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> Maybe c
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
2)
                                                    Maybe (d -> e -> (a, b, c, d, e))
-> Maybe d -> Maybe (e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> Maybe d
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
3)
                                                    Maybe (e -> (a, b, c, d, e)) -> Maybe e -> Maybe (a, b, c, d, e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> Maybe e
forall a. FromTerm a => Term -> Maybe a
fromTerm (Vector Term
ts Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! Int
4)
    fromTerm Term
_ = Maybe (a, b, c, d, e)
forall a. Maybe a
Nothing

instance FromTerm a => FromTerm (NonEmpty a) where
    fromTerm :: Term -> Maybe (NonEmpty a)
fromTerm (List (Vector Term -> [Item (Vector Term)]
forall l. IsList l => l -> [Item l]
toList -> [Item (Vector Term)]
xs) Term
Nil) =
        case [Maybe a] -> Maybe [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Term -> Maybe a
forall a. FromTerm a => Term -> Maybe a
fromTerm (Term -> Maybe a) -> [Term] -> [Maybe a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Item (Vector Term)]
[Term]
xs) of
            Just (a
h:[a]
t) -> NonEmpty a -> Maybe (NonEmpty a)
forall a. a -> Maybe a
Just (a
h a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
t)
            Maybe [a]
_ -> Maybe (NonEmpty a)
forall a. Maybe a
Nothing
    fromTerm Term
_ = Maybe (NonEmpty a)
forall a. Maybe a
Nothing

instance FromTerm a => FromTerm (Maybe a) where
    fromTerm :: Term -> Maybe (Maybe a)
fromTerm (Tuple2 Term
"ok" Term
x) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Maybe a
forall a. FromTerm a => Term -> Maybe a
fromTerm Term
x
    fromTerm Term
"error" = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
    fromTerm Term
_ = Maybe (Maybe a)
forall a. Maybe a
Nothing

instance (FromTerm a, FromTerm b) => FromTerm (Either a b) where
    fromTerm :: Term -> Maybe (Either a b)
fromTerm (Tuple2 Term
"ok" Term
x) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Maybe b -> Maybe (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Maybe b
forall a. FromTerm a => Term -> Maybe a
fromTerm Term
x
    fromTerm (Tuple2 Term
"error" Term
x) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Maybe a -> Maybe (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Maybe a
forall a. FromTerm a => Term -> Maybe a
fromTerm Term
x
    fromTerm Term
_ = Maybe (Either a b)
forall a. Maybe a
Nothing

fromTerms :: FromTerm a => Term -> Maybe [a]
fromTerms :: Term -> Maybe [a]
fromTerms (List (Vector Term -> [Item (Vector Term)]
forall l. IsList l => l -> [Item l]
toList -> [Item (Vector Term)]
xs) Term
Nil) = [Maybe a] -> Maybe [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Term -> Maybe a
forall a. FromTerm a => Term -> Maybe a
fromTerm (Term -> Maybe a) -> [Term] -> [Maybe a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Item (Vector Term)]
[Term]
xs)
fromTerms Term
_ = Maybe [a]
forall a. Maybe a
Nothing

instance ToTerm () where
    toTerm :: () -> Term
toTerm () = [Term] -> Term
tuple []

instance ToTerm Integer where
    toTerm :: Integer -> Term
toTerm = Integer -> Term
Integer

instance ToTerm String where
    toTerm :: String -> Term
toTerm = ByteString -> Term
String (ByteString -> Term) -> (String -> ByteString) -> String -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
CS.pack

instance ToTerm Bool where
    toTerm :: Bool -> Term
toTerm Bool
True = Term
"true"
    toTerm Bool
False = Term
"false"

instance ToTerm Double where
    toTerm :: Double -> Term
toTerm = Double -> Term
Float

instance (ToTerm a) => ToTerm (Tuple1 a) where
    toTerm :: Tuple1 a -> Term
toTerm (Tuple1 a
a) = [Term] -> Term
tuple [ a -> Term
forall a. ToTerm a => a -> Term
toTerm a
a ]

instance (ToTerm a, ToTerm b) => ToTerm (a, b) where
    toTerm :: (a, b) -> Term
toTerm (a
a, b
b) = [Term] -> Term
tuple [ a -> Term
forall a. ToTerm a => a -> Term
toTerm a
a, b -> Term
forall a. ToTerm a => a -> Term
toTerm b
b ]

instance (ToTerm a, ToTerm b, ToTerm c) => ToTerm (a, b, c) where
    toTerm :: (a, b, c) -> Term
toTerm (a
a, b
b, c
c) = [Term] -> Term
tuple [ a -> Term
forall a. ToTerm a => a -> Term
toTerm a
a, b -> Term
forall a. ToTerm a => a -> Term
toTerm b
b, c -> Term
forall a. ToTerm a => a -> Term
toTerm c
c ]

instance (ToTerm a, ToTerm b, ToTerm c, ToTerm d) => ToTerm (a, b, c, d) where
    toTerm :: (a, b, c, d) -> Term
toTerm (a
a, b
b, c
c, d
d) = [Term] -> Term
tuple [ a -> Term
forall a. ToTerm a => a -> Term
toTerm a
a, b -> Term
forall a. ToTerm a => a -> Term
toTerm b
b, c -> Term
forall a. ToTerm a => a -> Term
toTerm c
c, d -> Term
forall a. ToTerm a => a -> Term
toTerm d
d ]

instance (ToTerm a, ToTerm b, ToTerm c, ToTerm d, ToTerm e) => ToTerm (a, b, c, d, e) where
    toTerm :: (a, b, c, d, e) -> Term
toTerm (a
a, b
b, c
c, d
d, e
e) =
        [Term] -> Term
tuple [ a -> Term
forall a. ToTerm a => a -> Term
toTerm a
a, b -> Term
forall a. ToTerm a => a -> Term
toTerm b
b, c -> Term
forall a. ToTerm a => a -> Term
toTerm c
c, d -> Term
forall a. ToTerm a => a -> Term
toTerm d
d, e -> Term
forall a. ToTerm a => a -> Term
toTerm e
e ]

instance ToTerm a => ToTerm (NonEmpty a) where
    toTerm :: NonEmpty a -> Term
toTerm = [a] -> Term
forall a. ToTerm a => [a] -> Term
toTerms ([a] -> Term) -> (NonEmpty a -> [a]) -> NonEmpty a -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall l. IsList l => l -> [Item l]
toList

instance ToTerm a => ToTerm (Maybe a) where
    toTerm :: Maybe a -> Term
toTerm (Just a
x) = Term -> Term -> Term
Tuple2 Term
"ok" (a -> Term
forall a. ToTerm a => a -> Term
toTerm a
x)
    toTerm Maybe a
Nothing = Term
"error"

instance (ToTerm a, ToTerm b) => ToTerm (Either a b) where
    toTerm :: Either a b -> Term
toTerm (Left a
x) = Term -> Term -> Term
Tuple2 Term
"error" (a -> Term
forall a. ToTerm a => a -> Term
toTerm a
x)
    toTerm (Right b
x) = Term -> Term -> Term
Tuple2 Term
"ok" (b -> Term
forall a. ToTerm a => a -> Term
toTerm b
x)

toTerms :: ToTerm a => [a] -> Term
toTerms :: [a] -> Term
toTerms [a]
xs = Vector Term -> Term -> Term
List ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList (a -> Term
forall a. ToTerm a => a -> Term
toTerm (a -> Term) -> [a] -> [Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs)) Term
Nil

--------------------------------------------------------------------------------
-- | Construct an integer
integer
    :: Integer -- ^ Int
    -> Term
integer :: Integer -> Term
integer = Integer -> Term
Integer

-- | A static/constant number.
data SInteger (n :: Nat) = SInteger

instance (KnownNat n) => Show (SInteger n) where
  showsPrec :: Int -> SInteger n -> ShowS
showsPrec Int
d SInteger n
s =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (String -> ShowS
showString String
"SInteger '" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (SInteger n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal SInteger n
s) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\'')

instance forall (n :: Nat) . (KnownNat n) => FromTerm (SInteger n) where
    fromTerm :: Term -> Maybe (SInteger n)
fromTerm (Integer Integer
n') = let sn :: SInteger n
sn = SInteger n
forall (n :: Nat). SInteger n
SInteger
                                sn :: SInteger n
                            in
                                if Integer
n' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== SInteger n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal SInteger n
sn then SInteger n -> Maybe (SInteger n)
forall a. a -> Maybe a
Just SInteger n
sn else Maybe (SInteger n)
forall a. Maybe a
Nothing
    fromTerm Term
_ = Maybe (SInteger n)
forall a. Maybe a
Nothing

instance forall (n :: Nat) . (KnownNat n) => ToTerm (SInteger n) where
    toTerm :: SInteger n -> Term
toTerm = Integer -> Term
integer (Integer -> Term) -> (SInteger n -> Integer) -> SInteger n -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SInteger n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal

-- | Construct a float
float
    :: Double -- ^ IEEE float
    -> Term
float :: Double -> Term
float = Double -> Term
Float

-- | Construct an atom
atom
    :: ByteString -- ^ AtomName
    -> Term
atom :: ByteString -> Term
atom = ByteString -> Term
Atom

-- | A static/constant atom.
data SAtom (atom :: Symbol) = SAtom

instance (KnownSymbol atom) => Show (SAtom atom) where
  showsPrec :: Int -> SAtom atom -> ShowS
showsPrec Int
d SAtom atom
s =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (String -> ShowS
showString String
"SAtom '" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (SAtom atom -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal SAtom atom
s) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\'')

instance forall (atom :: Symbol) . (KnownSymbol atom) => FromTerm (SAtom atom) where
    fromTerm :: Term -> Maybe (SAtom atom)
fromTerm (Atom ByteString
atom') = if ByteString
atom' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
CS.pack (SAtom atom -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (SAtom atom
forall (atom :: Symbol). SAtom atom
SAtom :: SAtom atom)) then SAtom atom -> Maybe (SAtom atom)
forall a. a -> Maybe a
Just SAtom atom
forall (atom :: Symbol). SAtom atom
SAtom else Maybe (SAtom atom)
forall a. Maybe a
Nothing
    fromTerm Term
_ = Maybe (SAtom atom)
forall a. Maybe a
Nothing

instance forall (atom :: Symbol) . (KnownSymbol atom) => ToTerm (SAtom atom) where
    toTerm :: SAtom atom -> Term
toTerm = ByteString -> Term
atom (ByteString -> Term)
-> (SAtom atom -> ByteString) -> SAtom atom -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
CS.pack (String -> ByteString)
-> (SAtom atom -> String) -> SAtom atom -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAtom atom -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal

-- reference
-- | Construct a port
port
    :: ByteString -- ^ Node name
    -> Word32     -- ^ ID
    -> Word8      -- ^ Creation
    -> Term
port :: ByteString -> Word32 -> Word8 -> Term
port = ByteString -> Word32 -> Word8 -> Term
Port

pid
    :: ByteString -- ^ Node name
    -> Word32     -- ^ ID
    -> Word32     -- ^ Serial
    -> Word8      -- ^ Creation
    -> Pid
pid :: ByteString -> Word32 -> Word32 -> Word8 -> Pid
pid = (((Word32 -> Word32 -> Word8 -> Term)
 -> Word32 -> Word32 -> Word8 -> Pid)
-> (ByteString -> Word32 -> Word32 -> Word8 -> Term)
-> ByteString
-> Word32
-> Word32
-> Word8
-> Pid
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((Word32 -> Word32 -> Word8 -> Term)
  -> Word32 -> Word32 -> Word8 -> Pid)
 -> (ByteString -> Word32 -> Word32 -> Word8 -> Term)
 -> ByteString
 -> Word32
 -> Word32
 -> Word8
 -> Pid)
-> ((Term -> Pid)
    -> (Word32 -> Word32 -> Word8 -> Term)
    -> Word32
    -> Word32
    -> Word8
    -> Pid)
-> (Term -> Pid)
-> (ByteString -> Word32 -> Word32 -> Word8 -> Term)
-> ByteString
-> Word32
-> Word32
-> Word8
-> Pid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word32 -> Word8 -> Term) -> Word32 -> Word8 -> Pid)
-> (Word32 -> Word32 -> Word8 -> Term)
-> Word32
-> Word32
-> Word8
-> Pid
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((Word32 -> Word8 -> Term) -> Word32 -> Word8 -> Pid)
 -> (Word32 -> Word32 -> Word8 -> Term)
 -> Word32
 -> Word32
 -> Word8
 -> Pid)
-> ((Term -> Pid)
    -> (Word32 -> Word8 -> Term) -> Word32 -> Word8 -> Pid)
-> (Term -> Pid)
-> (Word32 -> Word32 -> Word8 -> Term)
-> Word32
-> Word32
-> Word8
-> Pid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word8 -> Term) -> Word8 -> Pid)
-> (Word32 -> Word8 -> Term) -> Word32 -> Word8 -> Pid
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((Word8 -> Term) -> Word8 -> Pid)
 -> (Word32 -> Word8 -> Term) -> Word32 -> Word8 -> Pid)
-> ((Term -> Pid) -> (Word8 -> Term) -> Word8 -> Pid)
-> (Term -> Pid)
-> (Word32 -> Word8 -> Term)
-> Word32
-> Word8
-> Pid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Pid) -> (Word8 -> Term) -> Word8 -> Pid
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) Term -> Pid
MkPid ByteString -> Word32 -> Word32 -> Word8 -> Term
Pid

newtype Pid = MkPid Term
    deriving (Pid -> Term
(Pid -> Term) -> ToTerm Pid
forall a. (a -> Term) -> ToTerm a
toTerm :: Pid -> Term
$ctoTerm :: Pid -> Term
ToTerm, Term -> Maybe Pid
(Term -> Maybe Pid) -> FromTerm Pid
forall a. (Term -> Maybe a) -> FromTerm a
fromTerm :: Term -> Maybe Pid
$cfromTerm :: Term -> Maybe Pid
FromTerm, Pid -> Pid -> Bool
(Pid -> Pid -> Bool) -> (Pid -> Pid -> Bool) -> Eq Pid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pid -> Pid -> Bool
$c/= :: Pid -> Pid -> Bool
== :: Pid -> Pid -> Bool
$c== :: Pid -> Pid -> Bool
Eq, Eq Pid
Eq Pid
-> (Pid -> Pid -> Ordering)
-> (Pid -> Pid -> Bool)
-> (Pid -> Pid -> Bool)
-> (Pid -> Pid -> Bool)
-> (Pid -> Pid -> Bool)
-> (Pid -> Pid -> Pid)
-> (Pid -> Pid -> Pid)
-> Ord Pid
Pid -> Pid -> Bool
Pid -> Pid -> Ordering
Pid -> Pid -> Pid
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pid -> Pid -> Pid
$cmin :: Pid -> Pid -> Pid
max :: Pid -> Pid -> Pid
$cmax :: Pid -> Pid -> Pid
>= :: Pid -> Pid -> Bool
$c>= :: Pid -> Pid -> Bool
> :: Pid -> Pid -> Bool
$c> :: Pid -> Pid -> Bool
<= :: Pid -> Pid -> Bool
$c<= :: Pid -> Pid -> Bool
< :: Pid -> Pid -> Bool
$c< :: Pid -> Pid -> Bool
compare :: Pid -> Pid -> Ordering
$ccompare :: Pid -> Pid -> Ordering
$cp1Ord :: Eq Pid
Ord)

instance Show Pid where
    show :: Pid -> String
show (MkPid Term
p) = Term -> String
forall a. Show a => a -> String
show Term
p

-- | Construct a tuple
tuple
    :: [Term] -- ^ Elements
    -> Term
tuple :: [Term] -> Term
tuple = Vector Term -> Term
Tuple (Vector Term -> Term) -> ([Term] -> Vector Term) -> [Term] -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Term] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList

newtype Tuple1 a = Tuple1 a
    deriving (Tuple1 a -> Tuple1 a -> Bool
(Tuple1 a -> Tuple1 a -> Bool)
-> (Tuple1 a -> Tuple1 a -> Bool) -> Eq (Tuple1 a)
forall a. Eq a => Tuple1 a -> Tuple1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tuple1 a -> Tuple1 a -> Bool
$c/= :: forall a. Eq a => Tuple1 a -> Tuple1 a -> Bool
== :: Tuple1 a -> Tuple1 a -> Bool
$c== :: forall a. Eq a => Tuple1 a -> Tuple1 a -> Bool
Eq, Eq (Tuple1 a)
Eq (Tuple1 a)
-> (Tuple1 a -> Tuple1 a -> Ordering)
-> (Tuple1 a -> Tuple1 a -> Bool)
-> (Tuple1 a -> Tuple1 a -> Bool)
-> (Tuple1 a -> Tuple1 a -> Bool)
-> (Tuple1 a -> Tuple1 a -> Bool)
-> (Tuple1 a -> Tuple1 a -> Tuple1 a)
-> (Tuple1 a -> Tuple1 a -> Tuple1 a)
-> Ord (Tuple1 a)
Tuple1 a -> Tuple1 a -> Bool
Tuple1 a -> Tuple1 a -> Ordering
Tuple1 a -> Tuple1 a -> Tuple1 a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Tuple1 a)
forall a. Ord a => Tuple1 a -> Tuple1 a -> Bool
forall a. Ord a => Tuple1 a -> Tuple1 a -> Ordering
forall a. Ord a => Tuple1 a -> Tuple1 a -> Tuple1 a
min :: Tuple1 a -> Tuple1 a -> Tuple1 a
$cmin :: forall a. Ord a => Tuple1 a -> Tuple1 a -> Tuple1 a
max :: Tuple1 a -> Tuple1 a -> Tuple1 a
$cmax :: forall a. Ord a => Tuple1 a -> Tuple1 a -> Tuple1 a
>= :: Tuple1 a -> Tuple1 a -> Bool
$c>= :: forall a. Ord a => Tuple1 a -> Tuple1 a -> Bool
> :: Tuple1 a -> Tuple1 a -> Bool
$c> :: forall a. Ord a => Tuple1 a -> Tuple1 a -> Bool
<= :: Tuple1 a -> Tuple1 a -> Bool
$c<= :: forall a. Ord a => Tuple1 a -> Tuple1 a -> Bool
< :: Tuple1 a -> Tuple1 a -> Bool
$c< :: forall a. Ord a => Tuple1 a -> Tuple1 a -> Bool
compare :: Tuple1 a -> Tuple1 a -> Ordering
$ccompare :: forall a. Ord a => Tuple1 a -> Tuple1 a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Tuple1 a)
Ord)

instance (Show a) => Show (Tuple1 a) where
  show :: Tuple1 a -> String
show (Tuple1 a
a) = String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

-- map
-- | Construct a list
string
    :: ByteString -- ^ Characters
    -> Term
string :: ByteString -> Term
string = ByteString -> Term
String

-- | Construct a list
list
    :: [Term] -- ^ Elements
    -> Term
list :: [Term] -> Term
list [] = Term
Nil
list [Term]
ts = [Term] -> Term -> Term
improperList [Term]
ts Term
Nil

-- | Construct an improper list (if Tail is not Nil)
improperList
    :: [Term] -- ^ Elements
    -> Term   -- ^ Tail
    -> Term
improperList :: [Term] -> Term -> Term
improperList [] Term
_ = String -> Term
forall a. HasCallStack => String -> a
error String
"Illegal improper list"
improperList [Term]
ts Term
t = Vector Term -> Term -> Term
List ([Item (Vector Term)] -> Vector Term
forall l. IsList l => [Item l] -> l
fromList [Item (Vector Term)]
[Term]
ts) Term
t -- FIXME could check if is string

-- binary
-- | Construct a new reference
ref
    :: ByteString -- ^ Node name
    -> Word8     -- ^ Creation
    -> [Word32]  -- ^ ID ...
    -> Term
ref :: ByteString -> Word8 -> [Word32] -> Term
ref = ByteString -> Word8 -> [Word32] -> Term
NewReference

--------------------------------------------------------------------------------
isInteger, isFloat, isAtom, isReference, isPort, isPid, isTuple, isMap, isList, isBinary
    :: Term -> Bool
-- | Test if term is an integer
isInteger :: Term -> Bool
isInteger (Integer Integer
_) = Bool
True
isInteger Term
_           = Bool
False

-- | Test if term is a float
isFloat :: Term -> Bool
isFloat (Float Double
_) = Bool
True
isFloat Term
_         = Bool
False

-- | Test if term is an atom
isAtom :: Term -> Bool
isAtom (Atom ByteString
_) = Bool
True
isAtom Term
_        = Bool
False

-- | Test if term is a reference
isReference :: Term -> Bool
isReference Reference {} = Bool
True
isReference NewReference {} = Bool
True
isReference Term
_                    = Bool
False

-- | Test if term is a port
isPort :: Term -> Bool
isPort Port {} = Bool
True
isPort Term
_            = Bool
False

-- | Test if term is a pid
isPid :: Term -> Bool
isPid Pid {} = Bool
True
isPid Term
_             = Bool
False

-- | Test if term is a tuple
isTuple :: Term -> Bool
isTuple (Tuple Vector Term
_) = Bool
True
isTuple Term
_         = Bool
False

-- | Test if term is a map
isMap :: Term -> Bool
isMap (Map Vector MapEntry
_) = Bool
True
isMap Term
_       = Bool
False

-- | Test if term is a list
isList :: Term -> Bool
isList Term
Nil        = Bool
True
isList (String ByteString
_) = Bool
True
isList (List Vector Term
_ Term
_) = Bool
True
isList Term
_          = Bool
False

-- | Test if term is a binary
isBinary :: Term -> Bool
isBinary (Binary ByteString
_) = Bool
True
isBinary Term
_          = Bool
False

--------------------------------------------------------------------------------
node :: Term -> Term
node :: Term -> Term
node (Reference ByteString
nodeName Word32
_id Word8
_creation) = ByteString -> Term
atom ByteString
nodeName
node (Port ByteString
nodeName Word32
_id Word8
_creation) = ByteString -> Term
atom ByteString
nodeName
node (Pid ByteString
nodeName Word32
_id Word32
_serial Word8
_creation) = ByteString -> Term
atom ByteString
nodeName
node (NewReference ByteString
nodeName Word8
_creation [Word32]
_ids) = ByteString -> Term
atom ByteString
nodeName
node Term
term = String -> Term
forall a. HasCallStack => String -> a
error (String -> Term) -> String -> Term
forall a b. (a -> b) -> a -> b
$ String
"Bad arg for node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
term

atomName :: Term -> ByteString
atomName :: Term -> ByteString
atomName (Atom ByteString
name) = ByteString
name
atomName Term
term        = String -> ByteString
forall a. HasCallStack => String -> a
error (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"Bad arg for atomName: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
term

length :: Term -> Int
length :: Term -> Int
length (Tuple  Vector Term
v  ) = Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
v
length (String ByteString
bs ) = ByteString -> Int
BS.length ByteString
bs
length (List Vector Term
v Term
Nil) = Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
v
length Term
term         = String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"Bad arg for length: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
term

element :: Int -> Term -> Term
element :: Int -> Term -> Term
element Int
n (Tuple Vector Term
v) = Vector Term
v Vector Term -> Int -> Term
forall a. Vector a -> Int -> a
! (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
element Int
_ Term
term      = String -> Term
forall a. HasCallStack => String -> a
error (String -> Term) -> String -> Term
forall a b. (a -> b) -> a -> b
$ String
"Not a tuple: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
term

toString :: Term -> Maybe ByteString
toString :: Term -> Maybe ByteString
toString (String ByteString
bs) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs
toString Term
_           = Maybe ByteString
forall a. Maybe a
Nothing

toIntegerTerm :: Term -> Maybe Integer
toIntegerTerm :: Term -> Maybe Integer
toIntegerTerm (Integer Integer
i) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
toIntegerTerm Term
_           = Maybe Integer
forall a. Maybe a
Nothing

matchTuple :: Term -> Maybe [Term]
matchTuple :: Term -> Maybe [Term]
matchTuple (Tuple Vector Term
v) = [Term] -> Maybe [Term]
forall a. a -> Maybe a
Just (Vector Term -> [Item (Vector Term)]
forall l. IsList l => l -> [Item l]
toList Vector Term
v)
matchTuple Term
_         = Maybe [Term]
forall a. Maybe a
Nothing

matchAtom :: Term -> ByteString -> Maybe ByteString
matchAtom :: Term -> ByteString -> Maybe ByteString
matchAtom (Atom ByteString
n) ByteString
m | ByteString
m ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
n    = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
n
                      | Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing
matchAtom Term
_ ByteString
_ = Maybe ByteString
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
instance Binary Term where
    put :: Term -> Put
put (Integer Integer
i)
        | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0x00 Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0xFF = do
              Word8 -> Put
putWord8 Word8
smallIntegerExt
              Word8 -> Put
putWord8 (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
        | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= -Integer
0x80000000 Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0x7FFFFFFF = do
              Word8 -> Put
putWord8 Word8
integerExt
              Word32 -> Put
putWord32be (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
        | Bool
otherwise =
            -- NOTE: the biggest number presentable is 2^maxBits bits long where
            -- maxBits = 2^32 * 8 = 2^35 - OTOH addressable main memory: 2^64 *
            -- 8 bits = 2^67 bits, even with tomorrows 2048 bit address buses
            -- for 256 bit words this would be at most 2^2056 addressable bits.
            -- largeBigIntegerExt allows 2^(2^35) = 2^34359738368 addressable bits ..
            -- hence YES by all practical means 'otherwise' is the correct
            -- function clause guard.
           do let digits :: [Word8]
digits = (Integer -> Maybe (Word8, Integer)) -> Integer -> [Word8]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr Integer -> Maybe (Word8, Integer)
forall b a. (Integral b, Num a, Bits b) => b -> Maybe (a, b)
takeLSB (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)
                    where takeLSB :: b -> Maybe (a, b)
takeLSB b
x
                            | b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0     = Maybe (a, b)
forall a. Maybe a
Nothing
                            | Bool
otherwise = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b
x b -> b -> b
forall a. Bits a => a -> a -> a
Data.Bits..&. b
0xff), b
x b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
              if [Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Word8]
digits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256
                then do Word8 -> Put
putWord8 Word8
smallBigIntegerExt
                        Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Word8]
digits))
                else do Word8 -> Put
putWord8 Word8
largeBigIntegerExt
                        Word32 -> Put
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Word8]
digits))
              Word8 -> Put
putWord8 (if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 then Word8
0 else Word8
1)
              (Word8 -> Put) -> [Word8] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
digits

    put (Float Double
d) = do
        Word8 -> Put
putWord8 Word8
newFloatExt
        Double -> Put
putDoublebe Double
d

    put (Atom ByteString
n) = HasCallStack => ByteString -> Put
ByteString -> Put
putAtom ByteString
n

    put (Reference ByteString
nodeName Word32
id Word8
creation) = do
        Word8 -> Put
putWord8 Word8
referenceExt
        HasCallStack => ByteString -> Put
ByteString -> Put
putAtom ByteString
nodeName
        Word32 -> Put
putWord32be Word32
id
        Word8 -> Put
putWord8 Word8
creation

    put (Port ByteString
nodeName Word32
id Word8
creation) = do
        Word8 -> Put
putWord8 Word8
portExt
        HasCallStack => ByteString -> Put
ByteString -> Put
putAtom ByteString
nodeName
        Word32 -> Put
putWord32be Word32
id
        Word8 -> Put
putWord8 Word8
creation

    put (Pid ByteString
nodeName Word32
id Word32
serial Word8
creation) = do
        Word8 -> Put
putWord8 Word8
pidExt
        HasCallStack => ByteString -> Put
ByteString -> Put
putAtom ByteString
nodeName
        Word32 -> Put
putWord32be Word32
id
        Word32 -> Put
putWord32be Word32
serial
        Word8 -> Put
putWord8 Word8
creation

    put (Tuple Vector Term
v)
        | Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256 = do
              Word8 -> Put
putWord8 Word8
smallTupleExt
              Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
v)
              (Term -> Put) -> Vector Term -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Term -> Put
forall t. Binary t => t -> Put
put Vector Term
v
        | Bool
otherwise = do
              Word8 -> Put
putWord8 Word8
largeTupleExt
              Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
v)
              (Term -> Put) -> Vector Term -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Term -> Put
forall t. Binary t => t -> Put
put Vector Term
v

    put (Map Vector MapEntry
e) = do
        Word8 -> Put
putWord8 Word8
mapExt
        Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector MapEntry -> Int
forall a. Vector a -> Int
V.length Vector MapEntry
e)
        (MapEntry -> Put) -> Vector MapEntry -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MapEntry -> Put
forall t. Binary t => t -> Put
put Vector MapEntry
e

    put Term
Nil = Word8 -> Put
putWord8 Word8
nilExt

    put (String ByteString
s) = do
        Word8 -> Put
putWord8 Word8
stringExt
        HasCallStack => ByteString -> Put
ByteString -> Put
putLength16beByteString ByteString
s

    put (List Vector Term
v Term
t) = do
        Word8 -> Put
putWord8 Word8
listExt
        Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Term -> Int
forall a. Vector a -> Int
V.length Vector Term
v)
        (Term -> Put) -> Vector Term -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Term -> Put
forall t. Binary t => t -> Put
put Vector Term
v
        Term -> Put
forall t. Binary t => t -> Put
put Term
t

    put (Binary ByteString
b) = do
        Word8 -> Put
putWord8 Word8
binaryExt
        HasCallStack => ByteString -> Put
ByteString -> Put
putLength32beByteString ByteString
b

    put (NewReference ByteString
node' Word8
creation [Word32]
ids) = do
        Word8 -> Put
putWord8 Word8
newReferenceExt
        Word16 -> Put
putWord16be (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word32] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Word32]
ids)
        HasCallStack => ByteString -> Put
ByteString -> Put
putAtom ByteString
node'
        Word8 -> Put
putWord8 Word8
creation
        (Word32 -> Put) -> [Word32] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word32 -> Put
putWord32be [Word32]
ids

    get :: Get Term
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get Term) -> Get Term
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get Term
get'
      where
        get' :: Word8 -> Get Term
        get' :: Word8 -> Get Term
get' Word8
tag
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
smallIntegerExt = Integer -> Term
Integer (Integer -> Term) -> (Word8 -> Integer) -> Word8 -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Term) -> Get Word8 -> Get Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
integerExt = Integer -> Term
Integer (Integer -> Term) -> (Word32 -> Integer) -> Word32 -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int32 -> Integer) -> (Word32 -> Int32) -> Word32 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Int32) (Word32 -> Term) -> Get Word32 -> Get Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
smallBigIntegerExt = Get Word8
getWord8    Get Word8 -> (Word8 -> Get Term) -> Get Term
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Get Term
Int -> Get Term
getBigInteger (Int -> Get Term) -> (Word8 -> Int) -> Word8 -> Get Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
largeBigIntegerExt = Get Word32
getWord32be Get Word32 -> (Word32 -> Get Term) -> Get Term
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Get Term
Int -> Get Term
getBigInteger (Int -> Get Term) -> (Word32 -> Int) -> Word32 -> Get Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
atomExt = ByteString -> Term
Atom (ByteString -> Term) -> Get ByteString -> Get Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
HasCallStack => Get ByteString
getLength16beByteString
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
portExt = HasCallStack => Word8 -> Get ()
Word8 -> Get ()
matchWord8 Word8
atomExt Get () -> Get Term -> Get Term
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> Word32 -> Word8 -> Term
Port (ByteString -> Word32 -> Word8 -> Term)
-> Get ByteString -> Get (Word32 -> Word8 -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
HasCallStack => Get ByteString
getLength16beByteString Get (Word32 -> Word8 -> Term) -> Get Word32 -> Get (Word8 -> Term)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be Get (Word8 -> Term) -> Get Word8 -> Get Term
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8)
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
pidExt = HasCallStack => Word8 -> Get ()
Word8 -> Get ()
matchWord8 Word8
atomExt Get () -> Get Term -> Get Term
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> Word32 -> Word32 -> Word8 -> Term
Pid (ByteString -> Word32 -> Word32 -> Word8 -> Term)
-> Get ByteString -> Get (Word32 -> Word32 -> Word8 -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
HasCallStack => Get ByteString
getLength16beByteString Get (Word32 -> Word32 -> Word8 -> Term)
-> Get Word32 -> Get (Word32 -> Word8 -> Term)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be Get (Word32 -> Word8 -> Term) -> Get Word32 -> Get (Word8 -> Term)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be Get (Word8 -> Term) -> Get Word8 -> Get Term
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8)
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
smallTupleExt = Vector Term -> Term
Tuple (Vector Term -> Term) -> Get (Vector Term) -> Get Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word8
getWord8 Get Word8 -> (Word8 -> Get (Vector Term)) -> Get (Vector Term)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get (Vector Term)
forall a. (HasCallStack, Binary a) => Int -> Get (Vector a)
_getVector (Int -> Get (Vector Term))
-> (Word8 -> Int) -> Word8 -> Get (Vector Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
largeTupleExt = Vector Term -> Term
Tuple (Vector Term -> Term) -> Get (Vector Term) -> Get Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word32
getWord32be Get Word32 -> (Word32 -> Get (Vector Term)) -> Get (Vector Term)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get (Vector Term)
forall a. (HasCallStack, Binary a) => Int -> Get (Vector a)
_getVector (Int -> Get (Vector Term))
-> (Word32 -> Int) -> Word32 -> Get (Vector Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
mapExt = Vector MapEntry -> Term
Map (Vector MapEntry -> Term) -> Get (Vector MapEntry) -> Get Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word32
getWord32be Get Word32
-> (Word32 -> Get (Vector MapEntry)) -> Get (Vector MapEntry)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get (Vector MapEntry)
forall a. (HasCallStack, Binary a) => Int -> Get (Vector a)
_getVector (Int -> Get (Vector MapEntry))
-> (Word32 -> Int) -> Word32 -> Get (Vector MapEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
nilExt = Term -> Get Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
Nil
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
stringExt = ByteString -> Term
String (ByteString -> Term) -> Get ByteString -> Get Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
HasCallStack => Get ByteString
getLength16beByteString
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
listExt = Vector Term -> Term -> Term
List (Vector Term -> Term -> Term)
-> Get (Vector Term) -> Get (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word32
getWord32be Get Word32 -> (Word32 -> Get (Vector Term)) -> Get (Vector Term)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get (Vector Term)
forall a. (HasCallStack, Binary a) => Int -> Get (Vector a)
_getVector (Int -> Get (Vector Term))
-> (Word32 -> Int) -> Word32 -> Get (Vector Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Get (Term -> Term) -> Get Term -> Get Term
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Term
forall t. Binary t => Get t
get
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
binaryExt = ByteString -> Term
Binary (ByteString -> Term) -> Get ByteString -> Get Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
HasCallStack => Get ByteString
getLength32beByteString
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
newReferenceExt = do
                      Word16
len <- Get Word16
getWord16be
                      HasCallStack => Word8 -> Get ()
Word8 -> Get ()
matchWord8 Word8
atomExt
                      ByteString -> Word8 -> [Word32] -> Term
NewReference (ByteString -> Word8 -> [Word32] -> Term)
-> Get ByteString -> Get (Word8 -> [Word32] -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
HasCallStack => Get ByteString
getLength16beByteString Get (Word8 -> [Word32] -> Term)
-> Get Word8 -> Get ([Word32] -> Term)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8 Get ([Word32] -> Term) -> Get [Word32] -> Get Term
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get [Word32]
forall a. (HasCallStack, Binary a) => Int -> Get [a]
_getList (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len)
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
smallAtomExt = ByteString -> Term
Atom (ByteString -> Term) -> Get ByteString -> Get Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
HasCallStack => Get ByteString
getLength8ByteString
            | Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
newFloatExt = Double -> Term
Float (Double -> Term) -> Get Double -> Get Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getDoublebe
            | Bool
otherwise = String -> Get Term
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Term) -> String -> Get Term
forall a b. (a -> b) -> a -> b
$ String
"Unsupported tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag

instance Binary MapEntry where
    put :: MapEntry -> Put
put MapEntry{Term
key :: Term
key :: MapEntry -> Term
key,Term
value :: Term
value :: MapEntry -> Term
value} = do
        Term -> Put
forall t. Binary t => t -> Put
put Term
key
        Term -> Put
forall t. Binary t => t -> Put
put Term
value
    get :: Get MapEntry
get = Term -> Term -> MapEntry
MapEntry (Term -> Term -> MapEntry) -> Get Term -> Get (Term -> MapEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Term
forall t. Binary t => Get t
get Get (Term -> MapEntry) -> Get Term -> Get MapEntry
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Term
forall t. Binary t => Get t
get

--------------------------------------------------------------------------------

putAtom :: HasCallStack => ByteString -> Put
putAtom :: ByteString -> Put
putAtom ByteString
a = do
    Word8 -> Put
putWord8 Word8
atomExt
    HasCallStack => ByteString -> Put
ByteString -> Put
putLength16beByteString ByteString
a

--------------------------------------------------------------------------------

getBigInteger :: HasCallStack => Int -> Get Term
getBigInteger :: Int -> Get Term
getBigInteger Int
len = Word8 -> ByteString -> Term
forall a. (Eq a, Num a) => a -> ByteString -> Term
mkBigInteger (Word8 -> ByteString -> Term)
-> Get Word8 -> Get (ByteString -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (ByteString -> Term) -> Get ByteString -> Get Term
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
len
  where
    mkBigInteger :: a -> ByteString -> Term
mkBigInteger a
signByte ByteString
bs = Integer -> Term
Integer
        ((if a
signByte a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then Integer
1 else (-Integer
1)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
absInt)
        where absInt :: Integer
absInt = (Word8 -> Integer -> Integer) -> Integer -> ByteString -> Integer
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr' (\Word8
b Integer
acc -> Integer
256 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Integer
0 ByteString
bs

--------------------------------------------------------------------------------
_getVector :: HasCallStack => Binary a => Int -> Get (Vector a)
_getVector :: Int -> Get (Vector a)
_getVector Int
len = Int -> Get a -> Get (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
len Get a
forall t. Binary t => Get t
get

_getList :: HasCallStack => Binary a => Int -> Get [a]
_getList :: Int -> Get [a]
_getList Int
len = Int -> Get a -> Get [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
M.replicateM Int
len Get a
forall t. Binary t => Get t
get

--------------------------------------------------------------------------------
magicVersion :: Word8
magicVersion :: Word8
magicVersion = Word8
131

smallIntegerExt, integerExt, floatExt, atomExt, referenceExt, portExt, pidExt
    :: Word8
smallTupleExt, largeTupleExt, mapExt, nilExt, stringExt, listExt, binaryExt
    :: Word8
smallBigIntegerExt, largeBigIntegerExt, newReferenceExt, smallAtomExt, functionExt, newFunctionExt
    :: Word8
exportExt, bitBinaryExt, newFloatExt, atomUtf8Ext, smallAtomUtf8Ext
    :: Word8
smallIntegerExt :: Word8
smallIntegerExt = Word8
97

integerExt :: Word8
integerExt = Word8
98

floatExt :: Word8
floatExt = Word8
99

atomExt :: Word8
atomExt = Word8
100

referenceExt :: Word8
referenceExt = Word8
101

portExt :: Word8
portExt = Word8
102

pidExt :: Word8
pidExt = Word8
103

smallTupleExt :: Word8
smallTupleExt = Word8
104

largeTupleExt :: Word8
largeTupleExt = Word8
105

mapExt :: Word8
mapExt = Word8
116

nilExt :: Word8
nilExt = Word8
106

stringExt :: Word8
stringExt = Word8
107

listExt :: Word8
listExt = Word8
108

binaryExt :: Word8
binaryExt = Word8
109

smallBigIntegerExt :: Word8
smallBigIntegerExt = Word8
110

largeBigIntegerExt :: Word8
largeBigIntegerExt = Word8
111

newReferenceExt :: Word8
newReferenceExt = Word8
114

smallAtomExt :: Word8
smallAtomExt = Word8
115

functionExt :: Word8
functionExt = Word8
117

newFunctionExt :: Word8
newFunctionExt = Word8
112

exportExt :: Word8
exportExt = Word8
113

bitBinaryExt :: Word8
bitBinaryExt = Word8
77

newFloatExt :: Word8
newFloatExt = Word8
70

atomUtf8Ext :: Word8
atomUtf8Ext = Word8
118

smallAtomUtf8Ext :: Word8
smallAtomUtf8Ext = Word8
119

instance Arbitrary Term where
    arbitrary :: Gen Term
arbitrary = [Gen Term] -> Gen Term
forall a. [Gen a] -> Gen a
oneof [ ByteString -> Term
atom (ByteString -> Term) -> Gen ByteString -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen ByteString -> Gen ByteString
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Gen ByteString
arbitraryUnquotedAtom
                      , [Term] -> Term
tuple ([Term] -> Term) -> Gen [Term] -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen [Term] -> Gen [Term]
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Gen [Term]
forall a. Arbitrary a => Gen a
arbitrary
                      , ByteString -> Term
string (ByteString -> Term) -> Gen ByteString -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen ByteString -> Gen ByteString
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Gen ByteString
arbitraryUnquotedAtom
                      , (Int -> Gen Term) -> Gen Term
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Term) -> Gen Term) -> (Int -> Gen Term) -> Gen Term
forall a b. (a -> b) -> a -> b
$
                          \Int
qcs -> if Int
qcs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                                  then [Term] -> Term -> Term
improperList ([Term] -> Term -> Term) -> Gen [Term] -> Gen (Term -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NonEmptyList Term -> [Term]
forall a. NonEmptyList a -> [a]
getNonEmpty (NonEmptyList Term -> [Term])
-> Gen (NonEmptyList Term) -> Gen [Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen (NonEmptyList Term) -> Gen (NonEmptyList Term)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Gen (NonEmptyList Term)
forall a. Arbitrary a => Gen a
arbitrary)
                                                    Gen (Term -> Term) -> Gen Term -> Gen Term
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int) -> Gen Term -> Gen Term
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Gen Term
forall a. Arbitrary a => Gen a
arbitrary
                                  else [Term] -> Term
list ([Term] -> Term) -> Gen [Term] -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen [Term] -> Gen [Term]
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Gen [Term]
forall a. Arbitrary a => Gen a
arbitrary
                      , ByteString -> Word8 -> [Word32] -> Term
ref (ByteString -> Word8 -> [Word32] -> Term)
-> Gen ByteString -> Gen (Word8 -> [Word32] -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen ByteString -> Gen ByteString
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
forall a. (Eq a, Num a) => a -> a
smaller Gen ByteString
arbitraryUnquotedAtom
                            Gen (Word8 -> [Word32] -> Term)
-> Gen Word8 -> Gen ([Word32] -> Term)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int) -> Gen Word8 -> Gen Word8
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
forall a. (Eq a, Num a) => a -> a
smaller Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
                            Gen ([Word32] -> Term) -> Gen [Word32] -> Gen Term
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int) -> Gen [Word32] -> Gen [Word32]
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
forall a. (Eq a, Num a) => a -> a
smaller Gen [Word32]
forall a. Arbitrary a => Gen a
arbitrary
                      , (Pid -> Term
forall a. ToTerm a => a -> Term
toTerm :: Pid -> Term) (Pid -> Term) -> Gen Pid -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen Pid -> Gen Pid
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
forall a. (Eq a, Num a) => a -> a
smaller Gen Pid
forall a. Arbitrary a => Gen a
arbitrary
                      , Double -> Term
float (Double -> Term) -> Gen Double -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen Double -> Gen Double
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
forall a. (Eq a, Num a) => a -> a
smaller Gen Double
forall a. Arbitrary a => Gen a
arbitrary
                      , (Integer -> Term
forall a. ToTerm a => a -> Term
toTerm :: Integer -> Term) (Integer -> Term) -> Gen Integer -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen Integer -> Gen Integer
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
forall a. (Eq a, Num a) => a -> a
smaller Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
                      , ByteString -> Term
Binary (ByteString -> Term) -> ([Word8] -> ByteString) -> [Word8] -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
pack ([Word8] -> Term) -> Gen [Word8] -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary
                      ]

smaller :: (Eq a, Num a) => a -> a
smaller :: a -> a
smaller a
0 = a
0
smaller a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1

arbitraryUnquotedAtom :: Gen CS.ByteString
arbitraryUnquotedAtom :: Gen ByteString
arbitraryUnquotedAtom =
  String -> ByteString
CS.pack (String -> ByteString) -> Gen String -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 (String -> Gen Char
forall a. [a] -> Gen a
elements ([Char
'a' .. Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'_'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9']))

instance Arbitrary Pid where
    arbitrary :: Gen Pid
arbitrary = ByteString -> Word32 -> Word32 -> Word8 -> Pid
pid (ByteString -> Word32 -> Word32 -> Word8 -> Pid)
-> Gen ByteString -> Gen (Word32 -> Word32 -> Word8 -> Pid)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen ByteString -> Gen ByteString
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
forall a. (Eq a, Num a) => a -> a
smaller Gen ByteString
arbitraryUnquotedAtom
                    Gen (Word32 -> Word32 -> Word8 -> Pid)
-> Gen Word32 -> Gen (Word32 -> Word8 -> Pid)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int) -> Gen Word32 -> Gen Word32
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
forall a. (Eq a, Num a) => a -> a
smaller Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
                    Gen (Word32 -> Word8 -> Pid) -> Gen Word32 -> Gen (Word8 -> Pid)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int) -> Gen Word32 -> Gen Word32
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
forall a. (Eq a, Num a) => a -> a
smaller Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
                    Gen (Word8 -> Pid) -> Gen Word8 -> Gen Pid
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int) -> Gen Word8 -> Gen Word8
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
forall a. (Eq a, Num a) => a -> a
smaller Gen Word8
forall a. Arbitrary a => Gen a
arbitrary