ehmry/dhall-haskell
ehmry/dhall-haskell
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove the constructors keyword (#829)

Browse Source 
... as standardized in https://github.com/dhall-lang/dhall-lang/pull/385
This commit is contained in:
Gabriel Gonzalez 2019-02-27 21:44:36 -08:00 committed by GitHub
parent 375688c97c
commit 36f0e55a5f
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
19 changed files with 21 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
dhall-bash/src/Dhall/Bash.hs
View File

@ -324,7 +324,6 @@ dhallToStatement expr0 var0 = go (Dhall.Core.normalize expr0)
go e@(CombineTypes {}) = Left (UnsupportedStatement e)
go e@(Prefer {}) = Left (UnsupportedStatement e)
go e@(Merge {}) = Left (UnsupportedStatement e)
go e@(Constructors {}) = Left (UnsupportedStatement e)
go e@(Field {}) = Left (UnsupportedStatement e)
go e@(Project {}) = Left (UnsupportedStatement e)
go e@(ImportAlt {}) = Left (UnsupportedStatement e)

5
dhall-json/src/Dhall/JSON.hs
View File

@ -667,11 +667,6 @@ convertToHomogeneousMaps (Conversion {..}) e0 = loop (Dhall.Core.normalize e0)
b' = loop b
c' = fmap loop c
Dhall.Core.Constructors a ->
Dhall.Core.Constructors a'
where
a' = loop a
Dhall.Core.Field a b ->
Dhall.Core.Field a' b
where

2
dhall/dhall-lang

@ -1 +1 @@
Subproject commit d3735dcc99e83a2c37cec66ec671df499a28611c
Subproject commit 9203c77bfa8f96b3bc9a26016da94d27537d13b9

8
dhall/src/Dhall/Binary.hs
View File

@ -352,10 +352,6 @@ encode (UnionLit x t₀ yTs₀) =
let y₁ = TString y₀
let _T₁ = encode _T₀
return (y₁, _T₁)
encode (Constructors u₀) =
TList [ TInt 13, u₁ ]
where
u₁ = encode u₀
encode (BoolLit b) =
TBool b
encode (BoolIf t₀ l₀ r₀) =
@ -678,10 +674,6 @@ decodeMaybe (TList [ TInt 12, TString x, t₁, TMap yTs₁ ]) = do
yTs₀ <- traverse process yTs₁
return (UnionLit x t₀ (Dhall.Map.fromList yTs₀))
decodeMaybe (TList [ TInt 13, u₁ ]) = do
u₀ <- decodeMaybe u₁
return (Constructors u₀)
decodeMaybe (TBool b) = do
return (BoolLit b)
decodeMaybe (TList [ TInt 14, t₁, l₁, r₁ ]) = do

27
dhall/src/Dhall/Core.hs
View File

@ -460,8 +460,6 @@ data Expr s a
-- | > Merge x y (Just t ) ~ merge x y : t
-- > Merge x y Nothing ~ merge x y
| Merge (Expr s a) (Expr s a) (Maybe (Expr s a))
-- | > Constructors e ~ constructors e
| Constructors (Expr s a)
-- | > Field e x ~ e.x
| Field (Expr s a) Text
-- | > Project e xs ~ e.{ xs }
@ -539,7 +537,6 @@ instance Functor (Expr s) where
fmap f (CombineTypes e1 e2) = CombineTypes (fmap f e1) (fmap f e2)
fmap f (Prefer e1 e2) = Prefer (fmap f e1) (fmap f e2)
fmap f (Merge e1 e2 maybeE) = Merge (fmap f e1) (fmap f e2) (fmap (fmap f) maybeE)
fmap f (Constructors e1) = Constructors (fmap f e1)
fmap f (Field e1 v) = Field (fmap f e1) v
fmap f (Project e1 vs) = Project (fmap f e1) vs
fmap f (Note s e1) = Note s (fmap f e1)
@ -617,7 +614,6 @@ instance Monad (Expr s) where
CombineTypes a b >>= k = CombineTypes (a >>= k) (b >>= k)
Prefer a b >>= k = Prefer (a >>= k) (b >>= k)
Merge a b c >>= k = Merge (a >>= k) (b >>= k) (fmap (>>= k) c)
Constructors a >>= k = Constructors (a >>= k)
Field a b >>= k = Field (a >>= k) b
Project a b >>= k = Project (a >>= k) b
Note a b >>= k = Note a (b >>= k)
@ -685,7 +681,6 @@ instance Bifunctor Expr where
first k (CombineTypes a b ) = CombineTypes (first k a) (first k b)
first k (Prefer a b ) = Prefer (first k a) (first k b)
first k (Merge a b c ) = Merge (first k a) (first k b) (fmap (first k) c)
first k (Constructors a ) = Constructors (first k a)
first k (Field a b ) = Field (first k a) b
first k (Project a b ) = Project (first k a) b
first k (Note a b ) = Note (k a) (first k b)
@ -961,9 +956,6 @@ shift d v (Merge a b c) = Merge a' b' c'
a' = shift d v a
b' = shift d v b
c' = fmap (shift d v) c
shift d v (Constructors a) = Constructors a'
where
a' = shift d v a
shift d v (Field a b) = Field a' b
where
a' = shift d v a
@ -1133,9 +1125,6 @@ subst x e (Merge a b c) = Merge a' b' c'
a' = subst x e a
b' = subst x e b
c' = fmap (subst x e) c
subst x e (Constructors a) = Constructors a'
where
a' = subst x e a
subst x e (Field a b) = Field a' b
where
a' = subst x e a
@ -1434,10 +1423,6 @@ alphaNormalize (Merge t₀ u₀ _T₀) =
u₁ = alphaNormalize u₀
_T₁ = fmap alphaNormalize _T₀
alphaNormalize (Constructors u₀) =
Constructors u₁
where
u₁ = alphaNormalize u₀
alphaNormalize (Field e₀ a) =
Field e₁ a
where
@ -1557,7 +1542,6 @@ denote (Combine a b ) = Combine (denote a) (denote b)
denote (CombineTypes a b ) = CombineTypes (denote a) (denote b)
denote (Prefer a b ) = Prefer (denote a) (denote b)
denote (Merge a b c ) = Merge (denote a) (denote b) (fmap denote c)
denote (Constructors a ) = Constructors (denote a)
denote (Field a b ) = Field (denote a) b
denote (Project a b ) = Project (denote a) b
denote (ImportAlt a b ) = ImportAlt (denote a) (denote b)
@ -1930,11 +1914,6 @@ normalizeWithM ctx e0 = loop (denote e0)
_ -> Merge x' y' <$> t'
where
t' = traverse loop t
Constructors t -> do
t' <- loop t
case t' of
u@(Union _) -> pure u
_ -> pure $ Constructors t'
Field r x -> do
r' <- loop r
case r' of
@ -2187,11 +2166,6 @@ isNormalized e0 = loop (denote e0)
Nothing -> True
_ -> True
_ -> True
Constructors t -> loop t &&
case t of
Union _ -> False
_ -> True
Field r x -> loop r &&
case r of
RecordLit kvs ->
@ -2373,7 +2347,6 @@ subExpressions f (Combine a b) = Combine <$> f a <*> f b
subExpressions f (CombineTypes a b) = CombineTypes <$> f a <*> f b
subExpressions f (Prefer a b) = Prefer <$> f a <*> f b
subExpressions f (Merge a b t) = Merge <$> f a <*> f b <*> traverse f t
subExpressions f (Constructors a) = Constructors <$> f a
subExpressions f (Field a b) = Field <$> f a <*> pure b
subExpressions f (Project a b) = Project <$> f a <*> pure b
subExpressions f (Note a b) = Note a <$> f b

16
dhall/src/Dhall/Diff.hs
View File

@ -642,10 +642,6 @@ skeleton (Merge {}) =
<> ignore
<> " "
<> ignore
skeleton (Constructors {}) =
keyword "constructors"
<> " "
<> ignore
skeleton (Field {}) =
ignore
<> dot
@ -974,12 +970,6 @@ diffApplicationExpression l@(App {}) r@(App {}) =
where
docs (App aL bL) (App aR bR) =
Data.List.NonEmpty.cons (diffImportExpression bL bR) (docs aL aR)
docs (Constructors aL) (Constructors aR) =
diffImportExpression aL aR :| [ keyword "constructors" ]
docs aL aR@(Constructors {}) =
pure (mismatch aL aR)
docs aL@(Constructors {}) aR =
pure (mismatch aL aR)
docs (Some aL) (Some aR) =
diffImportExpression aL aR :| [ builtin "Some" ]
docs aL aR@(Some {}) =
@ -992,12 +982,6 @@ diffApplicationExpression l@(App {}) r =
mismatch l r
diffApplicationExpression l r@(App {}) =
mismatch l r
diffApplicationExpression (Constructors l) (Constructors r) =
enclosed' mempty mempty (keyword "constructors" :| [ diffImportExpression l r ])
diffApplicationExpression l@(Constructors {}) r =
mismatch l r
diffApplicationExpression l r@(Constructors {}) =
mismatch l r
diffApplicationExpression (Some l) (Some r) =
enclosed' mempty mempty (builtin "Some" :| [ diffImportExpression l r ])
diffApplicationExpression l@(Some {}) r =

1
dhall/src/Dhall/Import.hs
View File

@ -916,7 +916,6 @@ loadWith expr₀ = case expr₀ of
CombineTypes a b -> CombineTypes <$> loadWith a <*> loadWith b
Prefer a b -> Prefer <$> loadWith a <*> loadWith b
Merge a b c -> Merge <$> loadWith a <*> loadWith b <*> mapM loadWith c
Constructors a -> Constructors <$> loadWith a
Field a b -> Field <$> loadWith a <*> pure b
Project a b -> Project <$> loadWith a <*> pure b
Note a b -> do

8
dhall/src/Dhall/Lint.hs
View File

@ -6,7 +6,6 @@ module Dhall.Lint
, removeLetInLet
, removeUnusedBindings
, optionalLitToSomeNone
, dropConstructorsKeyword
) where
import Control.Monad (mplus)
@ -24,7 +23,6 @@ import qualified Dhall.Core
* removes unused @let@ bindings with 'removeLetInLet'.
* consolidates nested @let@ bindings to use a multiple-@let@ binding with 'removeUnusedBindings'.
* switches legacy @List@-like @Optional@ literals to use @Some@ / @None@ instead with 'optionalLitToSomeNone'
* removes the `constructors` keyword with 'dropConstructorsKeyword'
-}
lint :: Expr s Import -> Expr t Import
lint =
@ -34,7 +32,6 @@ lint =
removeLetInLet e
`mplus` removeUnusedBindings e
`mplus` optionalLitToSomeNone e
`mplus` dropConstructorsKeyword e
)
. Dhall.Core.denote
@ -64,11 +61,6 @@ optionalLitToSomeNone (OptionalLit a Nothing) = Just (App None a)
optionalLitToSomeNone _ = Nothing
dropConstructorsKeyword :: Expr s a -> Maybe (Expr s a)
dropConstructorsKeyword (Constructors a) = Just a
dropConstructorsKeyword _ = Nothing
rewriteOf :: ASetter a b a b -> (b -> Maybe a) -> a -> b
rewriteOf l f = go where go = transformOf l (\x -> maybe x go (f x))

3
dhall/src/Dhall/Parser/Expression.hs
View File

@ -193,8 +193,7 @@ completeExpression embedded = completeExpression_
makeOperatorExpression applicationExpression precedence3Operator
applicationExpression = do
f <- (do _constructors; return Constructors)
<|> (do _Some; return Some)
f <- (do _Some; return Some)
<|> return id
a <- noted importExpression
b <- Text.Megaparsec.many (noted importExpression)

18
dhall/src/Dhall/Pretty/Internal.hs
View File

@ -702,19 +702,17 @@ prettyCharacterSet characterSet = prettyExpression
prettyApplicationExpression :: Pretty a => Expr s a -> Doc Ann
prettyApplicationExpression a0 = case a0 of
App _ _ -> result
Constructors _ -> result
Some _ -> result
Note _ b -> prettyApplicationExpression b
_ -> prettyImportExpression a0
App _ _ -> result
Some _ -> result
Note _ b -> prettyApplicationExpression b
_ -> prettyImportExpression a0
where
result = enclose' "" "" " " "" (fmap duplicate (reverse (docs a0)))
docs (App a b) = prettyImportExpression b : docs a
docs (Constructors b) = [ prettyImportExpression b , keyword "constructors" ]
docs (Some a) = [ prettyImportExpression a , builtin "Some" ]
docs (Note _ b) = docs b
docs b = [ prettyImportExpression b ]
docs (App a b) = prettyImportExpression b : docs a
docs (Some a) = [ prettyImportExpression a , builtin "Some" ]
docs (Note _ b) = docs b
docs b = [ prettyImportExpression b ]
prettyImportExpression :: Pretty a => Expr s a -> Doc Ann
prettyImportExpression (Embed a) =

38
dhall/src/Dhall/Tutorial.hs
View File

@ -1144,48 +1144,28 @@ import Dhall
--
-- > data Example = Empty | Person { name :: Text, age :: Text }
--
-- You can resemble Haskell further by defining convenient constructors for each
-- alternative, like this:
-- You could resemble Haskell further by defining convenient constructors for
-- each alternative, like this:
--
-- > let Empty = < Empty = {=} | Person : { name : Text, age : Natural } >
-- > in let Person =
-- > λ(p : { name : Text, age : Natural }) → < Person = p | Empty : {} >
-- > let Empty = < Empty = {=} | Person : { name : Text, age : Natural } >
-- > let Person =
-- > λ(p : { name : Text, age : Natural }) → < Person = p | Empty : {} >
-- > in [ Empty
-- > , Person { name = "John", age = 23 }
-- > , Person { name = "Amy" , age = 25 }
-- > , Empty
-- > ]
--
-- ... and Dhall even provides the @constructors@ keyword to automate this
-- common pattern:
-- ... but there is no need to do so, since the Dhall language auto-generates
-- constructors for each alternative. You can access each constructor as if it
-- were a field of the union type:
--
-- > let MyType = constructors < Empty : {} | Person : { name : Text, age : Natural } >
-- > let MyType = < Empty : {} | Person : { name : Text, age : Natural } >
-- > in [ MyType.Empty {=}
-- > , MyType.Person { name = "John", age = 23 }
-- > , MyType.Person { name = "Amy" , age = 25 }
-- > ]
--
-- The @constructors@ keyword takes a union type argument and returns a record
-- with one field per union type constructor:
--
-- > $ dhall
-- > constructors < Empty : {} | Person : { name : Text, age : Natural } >
-- > <Ctrl-D>
-- >
-- > { Empty :
-- > ∀(Empty : {}) → < Empty : {} | Person : { age : Natural, name : Text } >
-- > , Person :
-- > ∀(Person : { age : Natural, name : Text })
-- > → < Empty : {} | Person : { age : Natural, name : Text } >
-- > }
-- >
-- > { Empty =
-- > λ(Empty : {}) → < Empty = Empty | Person : { age : Natural, name : Text } >
-- > , Person =
-- > λ(Person : { age : Natural, name : Text })
-- > → < Person = Person | Empty : {} >
-- > }
--
-- You can also extract fields during pattern matching such as in the following
-- function which renders each value to `Text`:
--

7
dhall/src/Dhall/TypeCheck.hs
View File

@ -789,13 +789,6 @@ typeWithA tpa = loop
_ -> Left (TypeError ctx e (HandlerNotAFunction kY tX))
mapM_ process (Dhall.Map.toList ktsY)
return t
loop ctx e@(Constructors t ) = do
_ <- loop ctx t
case Dhall.Core.normalize t of
u@(Union _) -> loop ctx u
t' -> Left (TypeError ctx e (ConstructorsRequiresAUnionType t t'))
loop ctx e@(Field r x ) = do
t <- fmap Dhall.Core.normalize (loop ctx r)

4
dhall/tests/Dhall/Test/Import.hs
View File

@ -48,10 +48,6 @@ tests =
"a semantic integrity check if fields are reordered"
"./dhall-lang/tests/import/success/"
"./dhall-lang/tests/import/success/fieldOrderA.dhall"
, shouldNotFailRelative
"a semantic integrity check when importing an expression using `constructors`"
"./dhall-lang/tests/import/success/"
"./dhall-lang/tests/import/success/issue553B.dhall"
]
]

3
dhall/tests/Dhall/Test/Parser.hs
View File

@ -107,9 +107,6 @@ tests =
, shouldParse
"merge"
"./dhall-lang/tests/parser/success/merge"
, shouldParse
"constructors"
"./dhall-lang/tests/parser/success/constructors"
, shouldParse
"fields"
"./dhall-lang/tests/parser/success/fields"

1
dhall/tests/Dhall/Test/QuickCheck.hs
View File

@ -237,7 +237,6 @@ instance (Arbitrary s, Arbitrary a) => Arbitrary (Expr s a) where
, ( 1, lift2 CombineTypes)
, ( 1, lift2 Prefer)
, ( 1, lift3 Merge)
, ( 1, lift1 Constructors)
, ( 1, lift2 Field)
, ( 1, lift2 Project)
, ( 7, lift1 Embed)

11
dhall/tests/Dhall/Test/Regression.hs
View File

@ -20,7 +20,6 @@ import qualified System.Timeout
import qualified Test.Tasty
import qualified Test.Tasty.HUnit
import Control.DeepSeq (($!!))
import Dhall.Import (Imported)
import Dhall.Parser (Src)
import Dhall.TypeCheck (TypeError, X)
@ -35,7 +34,6 @@ tests =
, issue151
, issue164
, issue201
, issue209
, issue216
, issue253
, parsing0
@ -132,15 +130,6 @@ issue201 = Test.Tasty.HUnit.testCase "Issue #201" (do
_ <- Util.code "./tests/regression/issue201.dhall"
return () )
issue209 :: TestTree
issue209 = Test.Tasty.HUnit.testCase "Issue #209" (do
-- Verify that pretty-printing `constructors` doesn't trigger an infinite
-- loop
e <- Util.code "./tests/regression/issue209.dhall"
let text = Dhall.Core.pretty e
Just _ <- System.Timeout.timeout 1000000 (Control.Exception.evaluate $!! text)
return () )
issue216 :: TestTree
issue216 = Test.Tasty.HUnit.testCase "Issue #216" (do
-- Verify that pretty-printing preserves string interpolation

1
dhall/tests/regression/issue209.dhall
View File

@ -1 +0,0 @@
constructors <>

2
dhall/tests/tutorial/unions3A.dhall
View File

@ -1,4 +1,4 @@
let MyType = constructors < Empty : {} | Person : { name : Text, age : Natural } >
let MyType = < Empty : {} | Person : { name : Text, age : Natural } >
in [ MyType.Empty {=}
, MyType.Person { name = "John", age = 23 }
, MyType.Person { name = "Amy" , age = 25 }

2
dhall/tests/tutorial/unions4A.dhall
View File

@ -1 +1 @@
constructors < Empty : {} | Person : { name : Text, age : Natural } >
< Empty : {} | Person : { name : Text, age : Natural } >