candid 0.3 → 0.3.1

raw patch · 11 files changed

+139/−40 lines, 11 filesdep ~basedep ~bytestringdep ~doctestPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, bytestring, doctest, megaparsec, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• candid.cabal +9/−9
• src/Codec/Candid.hs +13/−1
• src/Codec/Candid/Class.hs +1/−1
• src/Codec/Candid/Data.hs +3/−1
• src/Codec/Candid/Parse.hs +4/−1
• src/Codec/Candid/Service.hs +3/−2
• src/Codec/Candid/TH.hs +62/−7
• test/SpecTests.hs +2/−2
• test/THTests.hs +34/−16
• test/test.hs +2/−0

@@ -1,5 +1,11 @@ # Revision history for haskell-candid +## 0.3.1 -- 2022-01-10++* GHC-9.0 compatibility+* Import type definitions, not just service types from `.did` files+* The Candid file parser ignores init arguments+ ## 0.3 -- 2021-10-01  * Candid pretty-printing: Try to invert field names using word list

@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               candid-version:            0.3+version:            0.3.1 license:            Apache license-file:       LICENSE maintainer:         mail@joachim-breitner.de@@ -50,12 +50,12 @@         text >=1.2.3.1 && <1.3,         dlist >=0.8.0.8 && <1.1,         vector >=0.12.1.2 && <0.13,-        bytestring >=0.10.8.2 && <0.11,+        bytestring >=0.10.8.2 && <0.12,         mtl >=2.2.2 && <2.3,         transformers >=0.5.6.2 && <0.6,         hex-text >=0.1.0.0 && <0.2,         crc >=0.1.0.0 && <0.2,-        megaparsec >=8 && <9.1,+        megaparsec >=8 && <9.3,         parser-combinators >=1.2 && <1.4,         scientific >=0.3.6.2 && <0.4,         cereal >=0.5.8.1 && <0.6,@@ -65,7 +65,7 @@         row-types > 1.0.0.0 && < 1.1,         constraints >=0.12 && <0.14,         prettyprinter >=1.7 && <1.8,-        template-haskell >=2.14.0.0 && <2.17,+        template-haskell >=2.14.0.0 && <2.18,         base32 >=0.1.1.2 && <0.3,         split >=0.2.3.4 && <0.3,         file-embed@@ -79,7 +79,7 @@         candid -any,         optparse-applicative >=0.15.1.0 && <0.17,         text >=1.2.3.1 && <1.3,-        bytestring >=0.10.8.2 && <0.11,+        bytestring >=0.10.8.2 && <0.12,         hex-text >=0.1.0.0 && <0.2,         prettyprinter >=1.6.2 && <1.8 @@ -102,7 +102,7 @@         tasty-rerun >=1.1.17 && <1.2,         smallcheck >=1.2 && <1.3,         candid -any,-        bytestring >=0.10.8.2 && <0.11,+        bytestring >=0.10.8.2 && <0.12,         text >=1.2.3.1 && <1.3,         vector >=0.12.1.2 && <0.13,         prettyprinter >=1.6.2 && <1.8,@@ -110,7 +110,7 @@         row-types > 1.0.0.0 && < 1.1,         directory >=1.3.3.0 && <1.4,         filepath >=1.4.2.1 && <1.5,-        template-haskell >=2.14.0.0 && <2.17+        template-haskell >=2.14.0.0 && <2.18  test-suite doctest     type:             exitcode-stdio-1.0@@ -118,9 +118,9 @@     default-language: Haskell2010     ghc-options:      -threaded     build-depends:-        base >=4.12.0.0 && <4.15,+        base ==4.*,         candid -any,-        doctest >=0.8 && <0.18,+        doctest >=0.8 && <0.19,         row-types > 1.0.0.0 && < 1.1,         leb128-cereal ==1.2.*,         prettyprinter >=1.6.2 && <1.8

@@ -102,6 +102,8 @@  , candid  , candidFile  , candidType+ , candidDefs+ , candidDefsFile  -- ** Types and values @@ -328,7 +330,17 @@  -} -#if MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)+#if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)+{- $import2+>>> :set -XQuasiQuotes+>>> import Data.Row.Internal+>>> type Counter m = [candid| service : { get : () -> (int); inc : (int) -> (); } |]+>>> :info Counter+type Counter :: (* -> *) -> Row (*)+type Counter m = ("get" .== (() -> m Integer)) .+ ("inc" .== (Integer -> m ())) :: Row (*)+...+-}+#elif MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) {- $import2 >>> :set -XQuasiQuotes >>> import Data.Row.Internal

@@ -522,7 +522,7 @@                   | (n,_) <- zip [0..] vs])        instance  $(tupT [ [t|Candid $v |] | v <- tvs ]) => CandidSeq $(tupT tvs) where-        asTypes = $(listE [ [| asType' @ $v |] | v <- tvs ])+        asTypes = $(listE [ [| asType' @($v) |] | v <- tvs ])         seqVal $(tupP pvs) = $(listE [ [| toCandidVal $v |] | v <- vs ])         fromVals $(foldr (`infixP` '(:)) wildP pvs)           = $( foldl (`uInfixE` varE '(<*>))

@@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-}+ -- | A few extra data types module Codec.Candid.Data where @@ -16,6 +17,7 @@ import Data.List.Split (chunksOf) import Data.Bifunctor import Control.Monad+import Data.Kind  data Reserved = Reserved  deriving (Eq, Ord, Show)@@ -43,7 +45,7 @@         Left $ "Principal id " ++ show s ++ " malformed; did you mean " ++ show expected ++ "?"     return p -newtype ServiceRef (r :: R.Row *) = ServiceRef { rawServiceRef :: Principal }+newtype ServiceRef (r :: R.Row Type) = ServiceRef { rawServiceRef :: Principal }  deriving (Eq, Ord, Show)  data FuncRef r = FuncRef { service :: Principal, method :: T.Text }

@@ -74,8 +74,11 @@ importP = withPredicate (const (Left "imports not yet supported")) $     [] <$ k "import" +-- NOTE: This discards "init" arguments:+-- https://github.com/dfinity/candid/blob/master/spec/Candid.md#core-grammar+-- See also https://github.com/nomeata/haskell-candid/issues/16 actorP :: Parser (DidService TypeName)-actorP = k "service" *> optional idP *> s ":" *> actorTypeP -- TODO could be a type id+actorP = k "service" *> optional idP *> s ":" *> optional (seqP *> s"->") *> actorTypeP -- TODO could be a type id  actorTypeP :: Parser (DidService TypeName) actorTypeP = braceSemi methP

@@ -19,6 +19,7 @@ import Data.Row import Data.Row.Records import Data.Row.Internal+import Data.Kind  import Codec.Candid.Class @@ -26,7 +27,7 @@ type RawService m = T.Text -> BS.ByteString -> m BS.ByteString type RawMethod m = BS.ByteString -> m BS.ByteString -class CandidMethod (m :: * -> *) f  | f -> m where+class CandidMethod (m :: Type -> Type) f  | f -> m where   fromMeth :: (forall a. String -> m a) -> f -> RawMethod m   toMeth :: (forall a. String -> m a) -> RawMethod m -> f @@ -52,7 +53,7 @@   (forall a. String -> m a) ->   RawService m ->   Rec r-toCandidService onErr f = fromLabels @ (CandidMethod m) $ \l ->+toCandidService onErr f = fromLabels @(CandidMethod m) $ \l ->   toMeth onErr (f (toKey l))  -- | Turns a typed candid service into a raw service. Typically used in a framework warpping Candid services.

@@ -4,7 +4,9 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} module Codec.Candid.TH- ( candid, candidFile, candidType, candidTypeQ+ ( candid, candidFile+ , candidType, candidTypeQ+ , candidDefs, candidDefsFile  , generateCandidDefs  ) where @@ -27,7 +29,7 @@ import qualified Language.Haskell.TH.Syntax as TH (Name) import Language.Haskell.TH.Quote import Language.Haskell.TH.Lib-import Language.Haskell.TH.Syntax (Q, lookupTypeName, newName, Dec)+import Language.Haskell.TH.Syntax (Q, lookupTypeName, newName, Dec, mkName)  import Codec.Candid.Parse import Codec.Candid.Data@@ -36,7 +38,9 @@ import Codec.Candid.FieldName import Codec.Candid.Class (Candid, AnnTrue, AnnFalse) --- | This quasi-quoter turns a Candid description into a Haskell type. It assumes a type variable @m@ to be in scope.+-- | This quasi-quoter turns a Candid service description into a Haskell type. It assumes a type variable @m@ to be in scope, and uses that as the monad for the service's methods.+--+-- Recursive types are not supported. candid :: QuasiQuoter candid = QuasiQuoter { quoteExp = err, quotePat = err, quoteDec = err, quoteType = quoteCandidService }   where err _ = fail "[candid| … |] can only be used as a type"@@ -45,12 +49,43 @@ candidFile :: QuasiQuoter candidFile = quoteFile candid +-- | This quasi-quoter turns all type definitions of a Canddi file into Haskell types, as one 'Row'. The `service` of the candid file is ignored.+--+-- Recursive types are not supported.+-- +-- This quasi-quoter works differently depending on context:+--+-- As a _type_, it expands to a row-types record with one entry per type+-- defined in the Candid file:+--+-- > type MyDefs = [candidDefs|type t = text; ... |]+-- >+-- > foo :: MyDefs .! "t"+--+-- As a _declaration_ (i.e. the module top level), it generates one type+-- synonym (@type Foo = ...@) per definition. This only works if the candid+-- type name is a valid Haskell type name (in particular, upper case). This may+-- improve in the future.+--+-- > [candidDefs|type Foo = text; ... |]+-- >+-- > foo :: Foo+--+-- You can use `-ddump-splices` to see the generated code.+candidDefs :: QuasiQuoter+candidDefs = QuasiQuoter { quoteExp = err, quotePat = err, quoteDec = quoteCandidDefsSym, quoteType = quoteCandidDefs }+  where err _ = fail "[candidDefs| … |] can only be used as a type or as declarations"++-- | As 'candid', but takes a filename+candidDefsFile :: QuasiQuoter+candidDefsFile = quoteFile candidDefs+ -- | This quasi-quoter turns works on individual candid types, e.g. -- -- > type InstallMode = [candidType| variant {install : null; reinstall : null; upgrade : null}; |] candidType :: QuasiQuoter candidType = QuasiQuoter { quoteExp = err, quotePat = err, quoteDec = err, quoteType = quoteCandidType }-  where err _ = fail "[candid| … |] can only be used as a type"+  where err _ = fail "[candidType| … |] can only be used as a type"  -- | Turns all candid type definitions into newtypes -- Used, so far, only in the Candid test suite runner@@ -74,12 +109,12 @@     return (decls, resolve)  -- | Inlines all candid type definitions, after checking for loops-inlineDefs :: forall k.  (Show k, Ord k) => [DidDef k] -> Q (k -> Q (), k -> Type Void)+inlineDefs :: forall k.  (Show k, Ord k) => [DidDef k] -> Q ([(k, Type Void)], k -> Q (), k -> Type Void) inlineDefs defs = do     for_ sccs $ \scc ->         fail $ "Cyclic type definitions not supported: " ++ intercalate ", " (map show scc)     for_ defs $ \(_, t) -> for_ t checkKey-    return (checkKey, f)+    return (M.toList m, checkKey, f)   where     sccs = [ tns | CyclicSCC tns <-         stronglyConnComp [ (tn, tn, toList t) | (tn, t) <- defs ] ]@@ -97,7 +132,7 @@   Right DidFile{ service = []} -> [t|R.Empty|]   Right DidFile{ defs = ds, service = s} -> do     Just m <- lookupTypeName "m"-    (check, inline) <- inlineDefs ds+    (_ds', check, inline) <- inlineDefs ds     for_ s $ \m -> for_ m (mapM_ check)     foldl1 (\a b -> [t|$(a) R..+ $(b)|])         [ [t|  $(litT (strTyLit (T.unpack methName)))@@ -107,6 +142,26 @@         , let results = map ((absurd <$>) . (>>= inline)) methResults         -- TODO annotations         ]++quoteCandidDefs :: String -> TypeQ+quoteCandidDefs s = case parseDid s of+  Left err -> fail err+  Right DidFile{ defs = []} -> [t|R.Empty|]+  Right DidFile{ defs = ds } -> do+    (ds', _check, _inline) <- inlineDefs ds+    foldl1 (\a b -> [t|$(a) R..+ $(b)|])+        [ [t|  $(litT (strTyLit (T.unpack n))) R..== $(typ (absurd <$> t)) |]+        | (n, t) <- ds'+        ]++quoteCandidDefsSym :: String -> DecsQ+quoteCandidDefsSym s = case parseDid s of+  Left err -> fail err+  Right DidFile{ defs = ds } ->+    forM ds $ \(n,t) -> tySynD (mangle n) [] (typ (mangle <$> t))+  where+    mangle :: T.Text -> TH.Name+    mangle = mkName . T.unpack  quoteCandidType :: String -> TypeQ quoteCandidType s = case parseDidType s of

@@ -83,9 +83,9 @@                          Nothing -> ""                          Just dsc -> " " ++ T.unpack dsc           , let parseInput (FromBinary blob) =-                  [| decode @ $(candidTypeQ testType) (BS.pack $(lift (BS.unpack blob))) |]+                  [| decode @($(candidTypeQ testType)) (BS.pack $(lift (BS.unpack blob))) |]                 parseInput (FromTextual txt) =-                  [| parseValues $(liftString (T.unpack txt)) >>= fromCandidVals @ $(candidTypeQ testType) |]+                  [| parseValues $(liftString (T.unpack txt)) >>= fromCandidVals @($(candidTypeQ testType)) |]           ])         |]      return (decls, testGroup)

@@ -3,6 +3,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}  module THTests (thTests) where @@ -10,26 +12,38 @@ import Test.Tasty import Test.Tasty.HUnit import Data.Row+import Type.Reflection  import Codec.Candid  thTests :: TestTree-thTests = testGroup "Using TH interface"-  [ testCase "demo1: direct" $ do-      x <- greet1 .! #greet $ "World"-      x @?= "Hello World"-  , testCase "demo1: via toCandidService" $ do-      x <- greet2 .! #greet $ "World"-      x @?= "World"-  , testCase "demo2: n-ary arguments" $ do-      x <- demo2 .! #greet $ ("World", True)-      x @?= "WorldTrue"-  , testCase "demo3: type definitions" $ do-      x <- demo3 .! #greet $ ("World", True)-      x @?= "WorldTrue"-  , testCase "demo4: tuple shorthands" $ do-      x <- demo4 .! #greet $ Unary (1,True, empty)-      x @?= Unary (#_0_ .== 2,False)+thTests = testGroup "TH"+  [ testGroup "Candid services"+    [ testCase "demo1: direct" $ do+        x <- greet1 .! #greet $ "World"+        x @?= "Hello World"+    , testCase "demo1: via toCandidService" $ do+        x <- greet2 .! #greet $ "World"+        x @?= "World"+    , testCase "demo2: n-ary arguments" $ do+        x <- demo2 .! #greet $ ("World", True)+        x @?= "WorldTrue"+    , testCase "demo3: type definitions" $ do+        x <- demo3 .! #greet $ ("World", True)+        x @?= "WorldTrue"+    , testCase "demo4: tuple shorthands" $ do+        x <- demo4 .! #greet $ Unary (1,True, empty)+        x @?= Unary (#_0_ .== 2,False)+    ]+  , testGroup "Candid tye definitions"+    [ testCase "with service" $ do+      typeRep @(Defs1 .! "t") @?= typeRep @T.Text+    , testCase "with anonymous service" $ do+      typeRep @(Defs2 .! "t") @?= typeRep @T.Text+    , testCase "as type definitions" $ do+      typeRep @T @?= typeRep @T.Text+    ]+   ]  -- NB: Fields in the wrong order@@ -57,3 +71,7 @@  demo4 :: Monad m => Rec (Demo4 m) demo4 = #greet .== \(Unary (i,b, _)) -> return $ Unary (#_0_ .== (i + 1), not b)++type Defs1 = [candidDefs|type t = text; service foo : {} |]+type Defs2 = [candidDefs|type t = text; service : {} |]+[candidDefs|type T = text; service : {} |]

@@ -398,6 +398,8 @@       DidFile [] [("foo", MethodType [TextT] [TextT] True True)]     , parseTest "service : { foo : (text) -> (text) oneway query }" $       DidFile [] [("foo", MethodType [TextT] [TextT] True True)]+    , parseTest "service : (opt SomeInit) -> { foo : (text) -> (text) oneway query }" $+      DidFile [] [("foo", MethodType [TextT] [TextT] True True)]     , parseTest "type t = int; service : { foo : (t) -> (t) }" $       DidFile [("t", IntT)] [("foo", MethodType [RefT "t"] [RefT "t"] False False)]     ]