composite-dhall 0.0.1.0 → 0.0.2.0

raw patch · 5 files changed

+280/−15 lines, 5 filesdep +composite-dhalldep +tastydep +tasty-hunitdep −lensdep ~dhallPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: composite-dhall, tasty, tasty-hunit, vinyl

Dependencies removed: lens

Dependency ranges changed: dhall

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• README.md +39/−0
• composite-dhall.cabal +25/−5
• src/Composite/Dhall.hs +148/−10
• test/Spec.hs +62/−0

@@ -1,5 +1,11 @@ # Changelog for composite-dhall +## v0.0.2.0++* Add `ToDhall` and `FromDhall` instances for `Rec Maybe`.+* Add `ToDhall` instances for `Predicate`, `Equivalence` and `Op b`.+* Add `FromDhall` instances for `Rec Predicate`, `Rec Equivalence` and `Rec (Op b)`+ ## v0.0.1.0  * Add `ToDhall` and `FromDhall` instances for composite `Record`s.

@@ -2,3 +2,42 @@  `ToDhall` and `FromDhall` instances for [composite](https://hackage.haskell.org/package/composite-base) records.++You can deserialise a normal dhall record such as++```{.dhall}+{ a = "foo"+, b = +5 }+```++using a `Record` like:++```{.haskell}+withLensesAndProxies+  [d|+    type A = "a" :-> Text++    type B = "b" :-> Int+    |]++type MyRec = Record '[A, B]+```++Similarly you can use a contravariant function as the base functor+to parse a collection of templates for different types.++```{.dhall}+{ a = \(x : Text) -> "Hello ${x}."+, b = \(y : Integer) -> "You are ${Integer/show y} years old."+}+```++We use a DerivingVia to avoid overlapping instances in composite:++```+newtype Template a = Template (Op Text a)+  deriving newtype (FromDhall)++newtype Templates = Templates {unTemplates :: Rec Template '[A, B]}+  deriving (FromDhall) via (Rec (Op Text) '[A, B])+```

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           composite-dhall-version:        0.0.1.0+version:        0.0.2.0 synopsis:       Dhall instances for composite records. description:    Dhall instances for composite records. category:       Dhall@@ -21,7 +21,7 @@  source-repository head   type: git-  location: https://gitlab.com/homotopic-tech/composite-dhall+  location: https://gitlab.homotopic.tech/haskell/composite-dhall  library   exposed-modules:@@ -30,10 +30,30 @@       Paths_composite_dhall   hs-source-dirs:       src+  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-missing-import-lists -Wno-implicit-prelude -Wno-monomorphism-restriction -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-orphans -Wno-safe -Wno-unsafe   build-depends:       base >=4.7 && <5-    , composite-base >=0.7.0.0 && <0.7.7-    , dhall >=1.39.0 && <1.40-    , lens >=5.0.0 && <5.1+    , composite-base >=0.7.0.0 && <0.8+    , dhall >=1.34.0 && <1.40     , text >=1.0 && <1.4+    , vinyl+  default-language: Haskell2010++test-suite composite-dhall-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_composite_dhall+  hs-source-dirs:+      test+  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-missing-import-lists -Wno-implicit-prelude -Wno-monomorphism-restriction -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-orphans -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , composite-base >=0.7.0.0 && <0.8+    , composite-dhall+    , dhall >=1.34.0 && <1.40+    , tasty+    , tasty-hunit+    , text >=1.0 && <1.4+    , vinyl   default-language: Haskell2010

@@ -1,26 +1,27 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}  module Composite.Dhall () where  import Composite.Record-import Composite.TH import Control.Applicative-import qualified Control.Lens as L import Data.Functor.Contravariant import Data.Text (Text)-import qualified Data.Text as T import Data.Void import qualified Dhall as D-import Dhall.Core hiding (File, Text, field)+import Dhall.Core hiding (File, Text) import Dhall.Map import Dhall.Src import GHC.TypeLits@@ -41,7 +42,7 @@   Dhall.Core.internalError     (name <> ": Unexpected constructor: " <> Dhall.Core.pretty expression) -instance D.ToDhall (Record '[]) where+instance D.ToDhall (Rec f '[]) where   injectWith = pure (D.Encoder {..})     where       embed _ = RecordLit mempty@@ -54,15 +55,30 @@     let name = valName f     let D.Encoder embedL declaredL = D.inject     let D.Encoder embedR declaredR = D.inject-    let embed (s :*: xs) = RecordLit (Dhall.Map.insert name (Dhall.Core.makeRecordField (embedL $ s)) mapR)+    let embed (s :*: xs) = RecordLit (Dhall.Map.insert name (Dhall.Core.makeRecordField (embedL s)) mapR)           where             mapR = unsafeExpectRecordLit "Composite Record" $ embedR xs-    let declared = Record (Dhall.Map.insert name (Dhall.Core.makeRecordField (declaredL)) mapR)+    let declared = Record (Dhall.Map.insert name (Dhall.Core.makeRecordField declaredL) mapR)           where             mapR = unsafeExpectRecord "Composite Record" declaredR     pure $ D.Encoder {..} -instance D.FromDhall (Record '[]) where+instance (KnownSymbol s, D.ToDhall (Rec Maybe xs), D.ToDhall x) => D.ToDhall (Rec Maybe (s :-> x ': xs)) where+  injectWith = do+    let f :: s :-> x+        f = undefined+    let name = valName f+    let D.Encoder embedL declaredL = D.inject+    let D.Encoder embedR declaredR = D.inject+    let embed (s :^: xs) = RecordLit (Dhall.Map.insert name (Dhall.Core.makeRecordField (embedL s)) mapR)+          where+            mapR = unsafeExpectRecordLit "Composite Record" $ embedR xs+    let declared = Record (Dhall.Map.insert name (Dhall.Core.makeRecordField declaredL) mapR)+          where+            mapR = unsafeExpectRecord "Composite Record" declaredR+    pure $ D.Encoder {..}++instance D.FromDhall (Rec f '[]) where   autoWith _ = D.Decoder {..}     where       extract _ = pure RNil@@ -92,6 +108,128 @@                   liftA2                     (:*:)                     (extractL expressionL)+                    (extractR expression)+                _ -> die+            _ -> die+    pure (D.Decoder extract expected)++instance (KnownSymbol s, D.FromDhall (Rec Maybe xs), D.FromDhall x) => D.FromDhall (Rec Maybe (s :-> x ': xs)) where+  autoWith = do+    let nL :: s :-> x+        nL = undefined++    let nameL = valName nL++    D.Decoder extractL expectedL <- D.autoWith @(Maybe x)++    D.Decoder extractR expectedR <- D.autoWith @(Rec Maybe xs)++    let ktsR = unsafeExpectRecord "Composite Record" <$> expectedR++    let expected = Record <$> (Dhall.Map.insert nameL . Dhall.Core.makeRecordField <$> expectedL <*> ktsR)+    let extract expression = do+          let die = D.typeError expected expression++          case expression of+            RecordLit kvs ->+              case Dhall.Core.recordFieldValue <$> Dhall.Map.lookup nameL kvs of+                Just expressionL ->+                  liftA2+                    (:^:)+                    (extractL expressionL)+                    (extractR expression)+                _ -> die+            _ -> die+    pure (D.Decoder extract expected)++deriving newtype instance (D.FromDhall b, D.ToDhall x) => D.FromDhall (Op b x)++deriving newtype instance (D.ToDhall x) => D.FromDhall (Predicate x)++deriving newtype instance (D.ToDhall x) => D.FromDhall (Equivalence x)++instance (KnownSymbol s, D.FromDhall (Rec (Op b) xs), D.FromDhall b, D.ToDhall x) => D.FromDhall (Rec (Op b) (s :-> x ': xs)) where+  autoWith = do+    let nL :: s :-> x+        nL = undefined++    let nameL = valName nL++    D.Decoder extractL expectedL <- D.autoWith @(Op b x)++    D.Decoder extractR expectedR <- D.autoWith @(Rec (Op b) xs)++    let ktsR = unsafeExpectRecord "Composite Record" <$> expectedR++    let expected = Record <$> (Dhall.Map.insert nameL . Dhall.Core.makeRecordField <$> expectedL <*> ktsR)+    let extract expression = do+          let die = D.typeError expected expression++          case expression of+            RecordLit kvs ->+              case Dhall.Core.recordFieldValue <$> Dhall.Map.lookup nameL kvs of+                Just expressionL ->+                  liftA2+                    (:&)+                    (contramap getVal <$> extractL expressionL)+                    (extractR expression)+                _ -> die+            _ -> die+    pure (D.Decoder extract expected)++instance (KnownSymbol s, D.FromDhall (Rec Predicate xs), D.ToDhall x) => D.FromDhall (Rec Predicate (s :-> x ': xs)) where+  autoWith = do+    let nL :: s :-> x+        nL = undefined++    let nameL = valName nL++    D.Decoder extractL expectedL <- D.autoWith @(Predicate x)++    D.Decoder extractR expectedR <- D.autoWith @(Rec Predicate xs)++    let ktsR = unsafeExpectRecord "Composite Record" <$> expectedR++    let expected = Record <$> (Dhall.Map.insert nameL . Dhall.Core.makeRecordField <$> expectedL <*> ktsR)+    let extract expression = do+          let die = D.typeError expected expression++          case expression of+            RecordLit kvs ->+              case Dhall.Core.recordFieldValue <$> Dhall.Map.lookup nameL kvs of+                Just expressionL ->+                  liftA2+                    (:&)+                    (contramap getVal <$> extractL expressionL)+                    (extractR expression)+                _ -> die+            _ -> die+    pure (D.Decoder extract expected)++instance (KnownSymbol s, D.FromDhall (Rec Equivalence xs), D.ToDhall x) => D.FromDhall (Rec Equivalence (s :-> x ': xs)) where+  autoWith = do+    let nL :: s :-> x+        nL = undefined++    let nameL = valName nL++    D.Decoder extractL expectedL <- D.autoWith @(Equivalence x)++    D.Decoder extractR expectedR <- D.autoWith @(Rec Equivalence xs)++    let ktsR = unsafeExpectRecord "Composite Record" <$> expectedR++    let expected = Record <$> (Dhall.Map.insert nameL . Dhall.Core.makeRecordField <$> expectedL <*> ktsR)+    let extract expression = do+          let die = D.typeError expected expression++          case expression of+            RecordLit kvs ->+              case Dhall.Core.recordFieldValue <$> Dhall.Map.lookup nameL kvs of+                Just expressionL ->+                  liftA2+                    (:&)+                    (contramap getVal <$> extractL expressionL)                     (extractR expression)                 _ -> die             _ -> die

@@ -0,0 +1,62 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}++module Main (main) where++import Composite+import Composite.Dhall ()+import Composite.TH+import Data.Functor.Contravariant+import Data.Text+import Dhall+import Test.Tasty+import Test.Tasty.HUnit++withLensesAndProxies+  [d|+    type A = "a" :-> Text++    type B = "b" :-> Int+    |]++type RecId = Record '[A, B]++type RecMaybe = Rec Maybe '[A, B]++newtype Template a = Template (Op Text a)+  deriving newtype (FromDhall)++recId :: RecId+recId = "foo" :*: 5 :*: RNil++recMaybe :: RecMaybe+recMaybe = Just "foo" :^: Just 5 :^: RNil++newtype Templates = Templates {unTemplates :: Rec Template '[A, B]}+  deriving (FromDhall) via (Rec (Op Text) '[A, B])++tests :: TestTree+tests =+  testGroup+    "Parsing Tests"+    [ testCase "parses Record" $ do+        x <- input auto "./test/data/A.dhall"+        assertEqual "" recId x,+      testCase "parses Maybe Rec" $ do+        x <- input auto "./test/data/B.dhall"+        assertEqual "" recMaybe x,+      testCase "parses Contravariant" $ do+        (_ :: Templates) <- input auto "./test/data/C.dhall"+        pure ()+    ]++main :: IO ()+main = defaultMain tests