hinterface 0.7.0 → 0.8.0
raw patch · 4 files changed
+481/−58 lines, 4 filesdep ~monad-loggerdep ~vectorPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: monad-logger, vector
API changes (from Hackage documentation)
+ Foreign.Erlang.Term: Atom :: ByteString -> Term
+ Foreign.Erlang.Term: Binary :: ByteString -> Term
+ Foreign.Erlang.Term: Float :: Double -> Term
+ Foreign.Erlang.Term: Integer :: Integer -> Term
+ Foreign.Erlang.Term: List :: Vector Term -> Term -> Term
+ Foreign.Erlang.Term: Map :: Vector MapEntry -> Term
+ Foreign.Erlang.Term: MapEntry :: Term -> Term -> MapEntry
+ Foreign.Erlang.Term: NewReference :: ByteString -> Word8 -> [Word32] -> Term
+ Foreign.Erlang.Term: Nil :: Term
+ Foreign.Erlang.Term: Pid :: ByteString -> Word32 -> Word32 -> Word8 -> Term
+ Foreign.Erlang.Term: Port :: ByteString -> Word32 -> Word8 -> Term
+ Foreign.Erlang.Term: Reference :: ByteString -> Word32 -> Word8 -> Term
+ Foreign.Erlang.Term: String :: ByteString -> Term
+ Foreign.Erlang.Term: Tuple :: Vector Term -> Term
+ Foreign.Erlang.Term: [key] :: MapEntry -> Term
+ Foreign.Erlang.Term: [value] :: MapEntry -> Term
+ Foreign.Erlang.Term: data MapEntry
+ Foreign.Erlang.Term: instance GHC.Exts.IsList Foreign.Erlang.Term.Term
+ Foreign.Erlang.Term: instance GHC.Num.Num Foreign.Erlang.Term.Term
Files
- hinterface.cabal +5/−4
- src/Foreign/Erlang/Term.hs +153/−4
- stack.yaml +1/−1
- test/Foreign/Erlang/TermSpec.hs +322/−49
hinterface.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.22 name: hinterface-version: 0.7.0+version: 0.8.0 license: BSD3 license-file: LICENSE copyright: 2016-2018 Timo Koepke, Sven Heyll@@ -49,7 +49,7 @@ hs-source-dirs: src default-language: Haskell2010 default-extensions: OverloadedStrings NamedFieldPuns- FlexibleContexts+ FlexibleContexts PatternSynonyms ViewPatterns ghc-options: -Wall -O2 -funbox-strict-fields build-depends: QuickCheck >=2.11.3 && <2.12,@@ -98,5 +98,6 @@ bytestring >=0.10.8.2, hinterface -any, hspec >=2.4 && <2.6,- monad-logger >=0.3.29,- transformers >=0.5.5.0+ monad-logger >=0.3.30,+ transformers >=0.5.5.0,+ vector >=0.12.0.1
src/Foreign/Erlang/Term.hs view
@@ -5,13 +5,37 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-unused-binds #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-} module Foreign.Erlang.Term ( -- * External Term Format- Term()+ Term(..+ , Tuple2+ , Tuple3+ , Tuple4+ , Tuple5+ , Tuple6+ , Tuple7+ , List1+ , List2+ , List3+ , List4+ , List5+ , List6+ , List7+ , Map1+ , Map2+ , Map3+ , Map4+ , Map5+ , Map6+ , Map7+ ) , putTerm , getTerm+ , MapEntry(.., (:=>)) -- ** Conversion to and from External Term Format , ToTerm(..) , FromTerm(..)@@ -85,8 +109,6 @@ ) import Data.Vector ( (!) , Vector- , fromList- , toList ) import qualified Data.Vector as V ( length@@ -108,9 +130,11 @@ , (.&.) ) import Data.Monoid+import GHC.Exts as E import GHC.Generics --------------------------------------------------------------------------------+ data Term = Integer Integer | Float Double | Atom ByteString@@ -128,6 +152,105 @@ instance NFData Term +-- ** Pattern Synonyms for 'Term's+pattern Tuple2 :: Term -> Term -> Term+pattern Tuple2 t1 t2 <- Tuple (toList -> [t1,t2]) where+ Tuple2 t1 t2 = Tuple (fromList [t1,t2])++pattern Tuple3 :: Term -> Term -> Term -> Term+pattern Tuple3 t1 t2 t3 <- Tuple (toList -> [t1,t2,t3]) where+ Tuple3 t1 t2 t3 = Tuple (fromList [t1,t2,t3])++pattern Tuple4 :: Term -> Term -> Term -> Term -> Term+pattern Tuple4 t1 t2 t3 t4 <- Tuple (toList -> [t1,t2,t3,t4]) where+ Tuple4 t1 t2 t3 t4 = Tuple (fromList [t1,t2,t3,t4])++pattern Tuple5 :: Term -> Term -> Term -> Term -> Term -> Term+pattern Tuple5 t1 t2 t3 t4 t5 <- Tuple (toList -> [t1,t2,t3,t4,t5]) where+ Tuple5 t1 t2 t3 t4 t5 = Tuple (fromList [t1,t2,t3,t4,t5])++pattern Tuple6 :: Term+ -> Term -> Term -> Term -> Term -> Term -> Term+pattern Tuple6 t1 t2 t3 t4 t5 t6 <- Tuple (toList -> [t1,t2,t3,t4,t5,t6]) where+ Tuple6 t1 t2 t3 t4 t5 t6 = Tuple (fromList [t1,t2,t3,t4,t5,t6])++pattern Tuple7 :: Term+ -> Term -> Term -> Term -> Term -> Term -> Term -> Term+pattern Tuple7 t1 t2 t3 t4 t5 t6 t7 <- Tuple (toList -> [t1,t2,t3,t4,t5,t6,t7]) where+ Tuple7 t1 t2 t3 t4 t5 t6 t7 = Tuple (fromList [t1,t2,t3,t4,t5,t6,t7])++pattern List1 :: Term -> Term+pattern List1 t1 <- List (toList -> [t1]) Nil where+ List1 t1 = List (fromList [t1]) Nil++pattern List2 :: Term -> Term -> Term+pattern List2 t1 t2 <- List (toList -> [t1,t2]) Nil where+ List2 t1 t2 = List (fromList [t1,t2]) Nil++pattern List3 :: Term -> Term -> Term -> Term+pattern List3 t1 t2 t3 <- List (toList -> [t1,t2,t3]) Nil where+ List3 t1 t2 t3 = List (fromList [t1,t2,t3]) Nil++pattern List4 :: Term -> Term -> Term -> Term -> Term+pattern List4 t1 t2 t3 t4 <- List (toList -> [t1,t2,t3,t4]) Nil where+ List4 t1 t2 t3 t4 = List (fromList [t1,t2,t3,t4]) Nil++pattern List5 :: Term -> Term -> Term -> Term -> Term -> Term+pattern List5 t1 t2 t3 t4 t5 <- List (toList -> [t1,t2,t3,t4,t5]) Nil where+ List5 t1 t2 t3 t4 t5 = List (fromList [t1,t2,t3,t4,t5]) Nil++pattern List6 :: Term+ -> Term -> Term -> Term -> Term -> Term -> Term+pattern List6 t1 t2 t3 t4 t5 t6 <- List (toList -> [t1,t2,t3,t4,t5,t6]) Nil where+ List6 t1 t2 t3 t4 t5 t6 = List (fromList [t1,t2,t3,t4,t5,t6]) Nil++pattern List7 :: Term+ -> Term -> Term -> Term -> Term -> Term -> Term -> Term+pattern List7 t1 t2 t3 t4 t5 t6 t7 <- List (toList -> [t1,t2,t3,t4,t5,t6,t7]) Nil where+ List7 t1 t2 t3 t4 t5 t6 t7 = List (fromList [t1,t2,t3,t4,t5,t6,t7]) Nil++pattern (:=>) :: Term -> Term -> MapEntry+pattern k :=> v = MapEntry k v++pattern Map1 :: MapEntry -> Term+pattern Map1 t1 <- Map (toList -> [t1]) where+ Map1 t1 = Map (fromList [t1])++pattern Map2 :: MapEntry -> MapEntry -> Term+pattern Map2 t1 t2 <- Map (toList -> [t1,t2]) where+ Map2 t1 t2 = Map (fromList [t1,t2])++pattern Map3 :: MapEntry -> MapEntry -> MapEntry -> Term+pattern Map3 t1 t2 t3 <- Map (toList -> [t1,t2,t3]) where+ Map3 t1 t2 t3 = Map (fromList [t1,t2,t3])++pattern Map4 :: MapEntry+ -> MapEntry -> MapEntry -> MapEntry -> Term+pattern Map4 t1 t2 t3 t4 <- Map (toList -> [t1,t2,t3,t4]) where+ Map4 t1 t2 t3 t4 = Map (fromList [t1,t2,t3,t4])++pattern Map5 :: MapEntry+ -> MapEntry -> MapEntry -> MapEntry -> MapEntry -> Term+pattern Map5 t1 t2 t3 t4 t5 <- Map (toList -> [t1,t2,t3,t4,t5]) where+ Map5 t1 t2 t3 t4 t5 = Map (fromList [t1,t2,t3,t4,t5])++pattern Map6 :: MapEntry+ -> MapEntry -> MapEntry -> MapEntry -> MapEntry -> MapEntry -> Term+pattern Map6 t1 t2 t3 t4 t5 t6 <- Map (toList -> [t1,t2,t3,t4,t5,t6]) where+ Map6 t1 t2 t3 t4 t5 t6 = Map (fromList [t1,t2,t3,t4,t5,t6])++pattern Map7 :: MapEntry+ -> MapEntry+ -> MapEntry+ -> MapEntry+ -> MapEntry+ -> MapEntry+ -> MapEntry+ -> Term+pattern Map7 t1 t2 t3 t4 t5 t6 t7 <- Map (toList -> [t1,t2,t3,t4,t5,t6,t7]) where+ Map7 t1 t2 t3 t4 t5 t6 t7 = Map (fromList [t1,t2,t3,t4,t5,t6,t7])++ data MapEntry = MapEntry { key :: Term , value :: Term }@@ -258,13 +381,39 @@ instance IsString Term where fromString = atom . CS.pack +instance E.IsList Term where+ type Item Term = Term+ fromList xs = List (fromList xs) Nil+ toList (List xs Nil) = toList xs+ toList _ = []+ instance FromTerm Term where fromTerm = Just instance ToTerm Term where toTerm = P.id ++instance Num Term where+ (Integer x) + (Integer y) = Integer (x+y)+ (Float x) + (Float y) = Float (x+y)+ _ + _ = error "non numeric arguments to (+)"+ (Integer x) * (Integer y) = Integer (x*y)+ (Float x) * (Float y) = Float (x*y)+ _ * _ = error "non numeric arguments to (*)"+ abs (Integer x) = Integer (abs x)+ abs (Float x) = Float (abs x)+ abs _ = error "non numeric arguments to 'abs'"+ signum (Integer x) = Integer (signum x)+ signum (Float x) = Float (signum x)+ signum _ = error "non numeric arguments to 'signum'"+ negate (Integer x) = Integer (negate x)+ negate (Float x) = Float (negate x)+ negate _ = error "non numeric arguments to 'negate'"+ fromInteger = integer+ --------------------------------------------------------------------------------+ class ToTerm a where toTerm :: a -> Term
stack.yaml view
@@ -4,4 +4,4 @@ - . pvp-bounds: lower extra-deps: []-resolver: lts-12.9+resolver: lts-12.19
test/Foreign/Erlang/TermSpec.hs view
@@ -1,66 +1,339 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedLists #-} -module Foreign.Erlang.TermSpec ( spec ) where+module Foreign.Erlang.TermSpec+ ( spec+ )+where -import Data.Binary (decode, encode)-import Data.ByteString.Char8 ()-import qualified Data.ByteString.Lazy as B-import Data.Word ()+import Data.Binary ( decode+ , encode+ )+import Data.ByteString.Char8 ( )+import qualified Data.ByteString.Lazy as B+import Data.Word ( ) import Foreign.Erlang.Term import Test.Hspec import Test.QuickCheck+import Data.Vector ( fromList ) spec :: Spec spec = do- describe "Pid"- $ do it "has a Binary instance such that decode is the inverse of encode"- $ property- $ \ (p :: Pid) ->- fromTerm (decode (encode (toTerm p))) `shouldBe` (Just p)- it "represents all valid Erlang pids"- $ property- $ \ x y z ->- let p = pid "nodename" x y z- in fromTerm (decode (encode (toTerm p))) `shouldBe` (Just p)+ describe "Pid" $ do+ it "has a Binary instance such that decode is the inverse of encode"+ $ property+ $ \(p :: Pid) -> fromTerm (decode (encode (toTerm p))) `shouldBe` (Just p)+ it "represents all valid Erlang pids" $ property $ \x y z ->+ let p = pid "nodename" x y z+ in fromTerm (decode (encode (toTerm p))) `shouldBe` (Just p) describe "Integer" $ it "has a Binary instance such that decode is the inverse of encode" $ property- $ \ (i :: Integer) ->+ $ \(i :: Integer) -> fromTerm (decode (encode (integer i))) `shouldBe` (Just i)- describe "The largest small_big_ext Integer"- $ do let i = 2^(8 * 255) - 1- it "has a Binary instance such that decode is the inverse of encode"- $ fromTerm (decode (encode (integer i))) `shouldBe` (Just i)- it "is converted to a valid erlang binary"- $ B.unpack (encode (integer i)) `shouldBe`- [110,255,0- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255,255,255,255,255,255,255,255,255,255,255,255- ,255,255,255]+ describe "The largest small_big_ext Integer" $ do+ let i = 2 ^ (8 * 255) - 1+ it "has a Binary instance such that decode is the inverse of encode"+ $ fromTerm (decode (encode (integer i)))+ `shouldBe` (Just i)+ it "is converted to a valid erlang binary"+ $ B.unpack (encode (integer i))+ `shouldBe` [ 110+ , 255+ , 0+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ , 255+ ] describe "The smallest large_big_ext Integer" $ it "has a Binary instance such that decode is the inverse of encode"- $ let i = 2^(8 * 255)- in fromTerm (decode (encode (integer i))) `shouldBe` (Just i)- describe "Term"- $ it "has a Binary instance such that decode is the inverse of encode"- $ property- $ \ (t :: Term) ->- decode (encode t) `shouldBe` t+ $ let i = 2 ^ (8 * 255)+ in fromTerm (decode (encode (integer i))) `shouldBe` (Just i)+ describe "Term" $ do+ it "has a Binary instance such that decode is the inverse of encode"+ $ property+ $ \(t :: Term) -> decode (encode t) `shouldBe` t+ it "has an IsString instance that makes atoms" $ "testatom" `shouldBe` atom+ "testatom"+ describe "Pattern Synonyms" $ do+ it "Tuple3" $ do+ toTerm (Atom "test-atom", integer 1, integer 2)+ `shouldBe` Tuple3 "test-atom" (integer 1) (integer 2)+ (case toTerm (Atom "test-atom", integer 1, integer 2) of+ Tuple3 "test-atom" _ _ -> True+ _ -> False+ )+ `shouldBe` True+ it "List4" $ do+ List (fromList [integer 0, integer 1, integer 2]) Nil+ `shouldBe` toTerm (List3 (integer 0) (integer 1) (integer 2))+ (case List (fromList [integer 0, integer 1, integer 2]) Nil of+ List3 _ _ _ -> True+ _ -> False+ )+ `shouldBe` True+ it "Map2" $ do+ Map (fromList [MapEntry "k1" "v1", MapEntry "k2" "v2"])+ `shouldBe` toTerm (Map2 ("k1" :=> "v1") ("k2" :=> "v2"))+ (case Map (fromList [MapEntry "k1" "v1", MapEntry "k2" "v2"]) of+ Map2 ("k1" :=> "v1") ("k2" :=> "v2") -> True+ _ -> False+ )+ `shouldBe` True+ it "has an IsList that generates lists" $ do+ ["a1", "a2"]+ `shouldBe` toTerm (List (fromList ["a1", "a2"]) Nil)