composite-dhall 0.0.2.0 → 0.0.3.0

raw patch · 4 files changed

+100/−10 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• composite-dhall.cabal +1/−1
• src/Composite/Dhall.hs +84/−4
• test/Spec.hs +10/−5

@@ -1,5 +1,10 @@ # Changelog for composite-dhall +## v0.0.3.0++* Add `ToDhall` and `FromDhall` instances for `Rec []`+* Add `TextTemplate` and `runTextTemplate`.+ ## v0.0.2.0  * Add `ToDhall` and `FromDhall` instances for `Rec Maybe`.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           composite-dhall-version:        0.0.2.0+version:        0.0.3.0 synopsis:       Dhall instances for composite records. description:    Dhall instances for composite records. category:       Dhall

@@ -13,7 +13,7 @@ {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -module Composite.Dhall () where+module Composite.Dhall (TextTemplate (TextTemplate, unTextTemplate), runTextTemplate) where  import Composite.Record import Control.Applicative@@ -42,12 +42,16 @@   Dhall.Core.internalError     (name <> ": Unexpected constructor: " <> Dhall.Core.pretty expression) +-- ToDhall+ instance D.ToDhall (Rec f '[]) where   injectWith = pure (D.Encoder {..})     where       embed _ = RecordLit mempty       declared = Record mempty +-- Identity+ instance (KnownSymbol s, D.ToDhall (Record xs), D.ToDhall x) => D.ToDhall (Record (s :-> x ': xs)) where   injectWith = do     let f :: s :-> x@@ -63,6 +67,8 @@             mapR = unsafeExpectRecord "Composite Record" declaredR     pure $ D.Encoder {..} +-- Maybe+ 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@@ -78,12 +84,35 @@             mapR = unsafeExpectRecord "Composite Record" declaredR     pure $ D.Encoder {..} +-- List++instance (KnownSymbol s, D.ToDhall (Rec [] xs), D.ToDhall x) => D.ToDhall (Rec [] (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 {..}++---------------------------++-- FromDhall+ instance D.FromDhall (Rec f '[]) where   autoWith _ = D.Decoder {..}     where       extract _ = pure RNil       expected = pure $ Record (Dhall.Map.fromList []) +-- Identity+ instance (KnownSymbol s, D.FromDhall (Record xs), D.FromDhall x) => D.FromDhall (Record (s :-> x ': xs)) where   autoWith = do     let nL :: s :-> x@@ -113,6 +142,8 @@             _ -> die     pure (D.Decoder extract expected) +-- Maybe+ 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@@ -142,12 +173,41 @@             _ -> die     pure (D.Decoder extract expected) -deriving newtype instance (D.FromDhall b, D.ToDhall x) => D.FromDhall (Op b x)+-- List -deriving newtype instance (D.ToDhall x) => D.FromDhall (Predicate x)+instance (KnownSymbol s, D.FromDhall (Rec [] xs), D.FromDhall x) => D.FromDhall (Rec [] (s :-> x ': xs)) where+  autoWith = do+    let nL :: s :-> x+        nL = undefined -deriving newtype instance (D.ToDhall x) => D.FromDhall (Equivalence x)+    let nameL = valName nL +    D.Decoder extractL expectedL <- D.autoWith @[x]++    D.Decoder extractR expectedR <- D.autoWith @(Rec [] 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)++-- Op++deriving newtype instance (D.FromDhall b, D.ToDhall x) => D.FromDhall (Op b 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@@ -177,6 +237,9 @@             _ -> die     pure (D.Decoder extract expected) +-- Predicate+deriving newtype instance (D.ToDhall x) => D.FromDhall (Predicate x)+ 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@@ -206,6 +269,10 @@             _ -> die     pure (D.Decoder extract expected) +-- Equivalence++deriving newtype instance (D.ToDhall x) => D.FromDhall (Equivalence x)+ 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@@ -234,3 +301,16 @@                 _ -> die             _ -> die     pure (D.Decoder extract expected)++-- | The common case where a function from `a -> Text` can be used+-- in a record.+--+-- @since 0.0.3.0+newtype TextTemplate a = TextTemplate {unTextTemplate :: Op Text a}+  deriving newtype (D.FromDhall)++-- | Run a `TextTemplate` against a value.+--+-- @since 0.0.3.0+runTextTemplate :: TextTemplate a -> a -> Text+runTextTemplate (TextTemplate (Op f)) = f

@@ -12,7 +12,7 @@ module Main (main) where  import Composite-import Composite.Dhall ()+import Composite.Dhall import Composite.TH import Data.Functor.Contravariant import Data.Text@@ -31,8 +31,7 @@  type RecMaybe = Rec Maybe '[A, B] -newtype Template a = Template (Op Text a)-  deriving newtype (FromDhall)+type RecList = Rec [] '[A, B]  recId :: RecId recId = "foo" :*: 5 :*: RNil@@ -40,7 +39,10 @@ recMaybe :: RecMaybe recMaybe = Just "foo" :^: Just 5 :^: RNil -newtype Templates = Templates {unTemplates :: Rec Template '[A, B]}+recList :: RecList+recList = ["foo", "bar"] :^: [5, 4] :^: RNil++newtype Templates = Templates {unTemplates :: Rec TextTemplate '[A, B]}   deriving (FromDhall) via (Rec (Op Text) '[A, B])  tests :: TestTree@@ -55,7 +57,10 @@         assertEqual "" recMaybe x,       testCase "parses Contravariant" $ do         (_ :: Templates) <- input auto "./test/data/C.dhall"-        pure ()+        pure (),+      testCase "parses List Rec" $ do+        x <- input auto "./test/data/D.dhall"+        assertEqual "" recList x     ]  main :: IO ()