composite-dhall (empty) → 0.0.1.0

raw patch · 5 files changed

+176/−0 lines, 5 filesdep +basedep +composite-basedep +dhall

Dependencies added: base, composite-base, dhall, lens, text

Files

• ChangeLog.md +5/−0
• LICENSE +30/−0
• README.md +4/−0
• composite-dhall.cabal +39/−0
• src/Composite/Dhall.hs +98/−0

@@ -0,0 +1,5 @@+# Changelog for composite-dhall++## v0.0.1.0++* Add `ToDhall` and `FromDhall` instances for composite `Record`s.

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,4 @@+# composite-dhall++`ToDhall` and `FromDhall` instances for+[composite](https://hackage.haskell.org/package/composite-base) records.

@@ -0,0 +1,39 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           composite-dhall+version:        0.0.1.0+synopsis:       Dhall instances for composite records.+description:    Dhall instances for composite records.+category:       Dhall+author:         Daniel Firth+maintainer:     dan.firth@homotopic.tech+copyright:      2021 Daniel Firth+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://gitlab.com/homotopic-tech/composite-dhall++library+  exposed-modules:+      Composite.Dhall+  other-modules:+      Paths_composite_dhall+  hs-source-dirs:+      src+  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+    , text >=1.0 && <1.4+  default-language: Haskell2010

@@ -0,0 +1,98 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++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.Map+import Dhall.Src+import GHC.TypeLits++unsafeExpectRecordLit ::+  Text -> Expr Src Void -> Dhall.Map.Map Text (RecordField Src Void)+unsafeExpectRecordLit _ (RecordLit kvs) =+  kvs+unsafeExpectRecordLit name expression =+  Dhall.Core.internalError+    (name <> ": Unexpected constructor: " <> Dhall.Core.pretty expression)++unsafeExpectRecord ::+  Text -> Expr Src Void -> Dhall.Map.Map Text (RecordField Src Void)+unsafeExpectRecord _ (Record kts) =+  kts+unsafeExpectRecord name expression =+  Dhall.Core.internalError+    (name <> ": Unexpected constructor: " <> Dhall.Core.pretty expression)++instance D.ToDhall (Record '[]) where+  injectWith = pure (D.Encoder {..})+    where+      embed _ = RecordLit mempty+      declared = Record mempty++instance (KnownSymbol s, D.ToDhall (Record xs), D.ToDhall x) => D.ToDhall (Record (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 (Record '[]) where+  autoWith _ = D.Decoder {..}+    where+      extract _ = pure RNil+      expected = pure $ Record (Dhall.Map.fromList [])++instance (KnownSymbol s, D.FromDhall (Record xs), D.FromDhall x) => D.FromDhall (Record (s :-> x ': xs)) where+  autoWith = do+    let nL :: s :-> x+        nL = undefined++    let nameL = valName nL++    D.Decoder extractL expectedL <- D.autoWith @x++    D.Decoder extractR expectedR <- D.autoWith @(Record 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)