hinterface 0.8.0 → 0.8.1

raw patch · 3 files changed

+75/−3 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

hinterface.cabal +12/−2
src/Foreign/Erlang/Term.hs +1/−1
test/Foreign/Erlang/Term2Experimental.hs +62/−0

hinterface.cabal view

@@ -1,6 +1,6 @@ cabal-version: >=1.22 name: hinterface-version: 0.8.0+version: 0.8.1 license: BSD3 license-file: LICENSE copyright: 2016-2018 Timo Koepke, Sven Heyll@@ -87,8 +87,18 @@         Foreign.Erlang.HandshakeSpec         Foreign.Erlang.ControlMessageSpec         Foreign.Erlang.TermSpec+        Foreign.Erlang.Term2Experimental     default-language: Haskell2010-    default-extensions: OverloadedStrings NamedFieldPuns+    default-extensions: AllowAmbiguousTypes ConstraintKinds DataKinds+                        DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable+                        ExistentialQuantification FlexibleContexts FlexibleInstances+                        FunctionalDependencies GADTs GeneralizedNewtypeDeriving+                        KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns+                        OverloadedLists OverloadedStrings PatternSynonyms RankNTypes+                        ScopedTypeVariables StandaloneDeriving TemplateHaskell+                        TupleSections TypeApplications TypeFamilies TypeInType+                        TypeOperators ViewPatterns+    other-extensions: CPP IncoherentInstances Strict StrictData     ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N     build-depends:         QuickCheck >=2.11.3 && <2.12,

src/Foreign/Erlang/Term.hs view

@@ -775,7 +775,7 @@      put (Binary b) = do         putWord8 binary_ext-        putLength16beByteString b+        putLength32beByteString b      put (NewReference node' creation ids) = do         putWord8 new_reference_ext

+ test/Foreign/Erlang/Term2Experimental.hs view

@@ -0,0 +1,62 @@+{-# OPTIONS_GHC -Wno-unticked-promoted-constructors -Wno-missing-pattern-synonym-signatures #-}+module Foreign.Erlang.Term2Experimental where++import           GHC.TypeLits+import           Data.Proxy+import qualified Foreign.Erlang.Term as SomeTerm+import qualified Data.Vector as V+import Data.String++data Terms =+  Atoms | AtomSymbols Symbol | Integers | Nils | Tupels [Terms] | Lists Terms Terms++data Term (t :: Terms) where+  Atom :: String -> Term 'Atoms+  AtomSymbol :: forall a . KnownSymbol a => Term ('AtomSymbols a)+  Integer :: Integer -> Term 'Integers+  Nil :: Term 'Nils+  Unit :: Term ('Tupels '[])+  ConsTuple :: Term t -> Term ('Tupels ts) -> Term ('Tupels (t ': ts))+  List :: [Term e] -> Term t -> Term ('Lists e t)++pattern Tup1 t1 = ConsTuple t1 Unit+pattern Tup2 t1 t2 = ConsTuple t1 (Tup1 t2)+pattern Tup3 t1 t2 t3 = ConsTuple t1 (Tup2 t2 t3)+pattern Tup4 t1 t2 t3 t4 = ConsTuple t1 (Tup3 t2 t3 t4)+pattern Tup5 t1 t2 t3 t4 t5 = ConsTuple t1 (Tup4 t2 t3 t4 t5)+pattern Tup6 t1 t2 t3 t4 t5 t6 = ConsTuple t1 (Tup5 t2 t3 t4 t5 t6)+pattern Tup7 t1 t2 t3 t4 t5 t6 t7 = ConsTuple t1 (Tup6 t2 t3 t4 t5 t6 t7)++instance SomeTerm.FromTerm (Term Atoms) where+  fromTerm a@(SomeTerm.Atom _) = Just (Atom (show a))+  fromTerm _ = Nothing++instance SomeTerm.FromTerm (Term Atoms) where+  fromTerm a@(SomeTerm.Atom _) = Just (Atom (show a))+  fromTerm _ = Nothing++instance SomeTerm.ToTerm (Term t) where+  toTerm (Atom a) = SomeTerm.atom (fromString a)+  toTerm a@AtomSymbol =+    let px :: Term (AtomSymbols s) -> Proxy s+        px _ = Proxy+    in  SomeTerm.atom (fromString (symbolVal (px a)))+  toTerm (Integer i) = SomeTerm.integer i+  toTerm Nil = SomeTerm.Nil+  toTerm (List xs t) = SomeTerm.List (V.fromList (fmap SomeTerm.toTerm xs)) (SomeTerm.toTerm t)+  toTerm Unit = SomeTerm.tuple []+  toTerm xs@(ConsTuple _ _) = SomeTerm.tuple (go xs)+   where+     go :: Term (Tupels x_ys) -> [SomeTerm.Term]+     go (ConsTuple x ys) = SomeTerm.toTerm x : go ys+     go Unit = []++type EventTerm t = Term ('Tupels '[ 'AtomSymbols "Event" , t])++pattern Event :: Term t -> EventTerm t+pattern Event xx = Tup2 AtomSymbol xx++type BlubDown = 'Tupels [AtomSymbols "BlubDown" , Integers, Atoms ]++pattern BlubEvent :: Term 'Integers -> EventTerm BlubDown+pattern BlubEvent blubIndex  <- Event (Tup3 AtomSymbol blubIndex _)