diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +1.42.3 + +* [Fix the typechecking rule for `Optional` + `with`](https://github.com/dhall-lang/dhall-haskell/pull/2650) +* [Add `*WithIndex` instances for `Map`](https://github.com/dhall-lang/dhall-haskell/pull/2633) +* [`dhall package`: Add support for automatic sub-packags](https://github.com/dhall-lang/dhall-haskell/pull/2639) +* [`dhall to-directory-tree`: Add `binary-file` support](https://github.com/dhall-lang/dhall-haskell/pull/2641) +* [Support GHC 9.12.1](https://github.com/dhall-lang/dhall-haskell/pull/2649) +* [`dhall to-directory-tree`: create parents of files when using fixpoint representation](https://github.com/dhall-lang/dhall-haskell/pull/2653) + 1.42.2 * [Supports standard version 23.1.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v23.1.0) diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/BinaryFileEntry.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/BinaryFileEntry.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/BinaryFileEntry.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:75148ae19175750e38705e11cda8dcc775b2ac08f22518ff2ef3f33a6273ef15 + ? ./Type.dhall + +in Entry Bytes diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/FileEntry.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/FileEntry.dhall deleted file mode 100644 --- a/dhall-lang/Prelude/DirectoryTree/Entry/FileEntry.dhall +++ /dev/null @@ -1,6 +0,0 @@ -let Entry = - missing - sha256:75148ae19175750e38705e11cda8dcc775b2ac08f22518ff2ef3f33a6273ef15 - ? ./Type.dhall - -in Entry Text diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/TextFileEntry.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/TextFileEntry.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/TextFileEntry.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:75148ae19175750e38705e11cda8dcc775b2ac08f22518ff2ef3f33a6273ef15 + ? ./Type.dhall + +in Entry Text diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/binary-file.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/binary-file.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/binary-file.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:742610b2a13e55ae6e344b54aa8a7ee1bfec8e8b313a1132eae9286309b520e6 + ? ./entry.dhall + +in Entry Bytes diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/file.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/file.dhall deleted file mode 100644 --- a/dhall-lang/Prelude/DirectoryTree/Entry/file.dhall +++ /dev/null @@ -1,6 +0,0 @@ -let Entry = - missing - sha256:742610b2a13e55ae6e344b54aa8a7ee1bfec8e8b313a1132eae9286309b520e6 - ? ./entry.dhall - -in Entry Text diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/package.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/package.dhall --- a/dhall-lang/Prelude/DirectoryTree/Entry/package.dhall +++ b/dhall-lang/Prelude/DirectoryTree/Entry/package.dhall @@ -1,19 +1,27 @@ -{ Directory = +{ BinaryFileEntry = missing + sha256:f027db2893f6f38bbe6d868a91f22de530e85407237f00b147427c87d32bf55c + ? ./BinaryFileEntry.dhall +, DirectoryEntry = + missing sha256:163a4536fdd05ce122d793ceda01d03fcffb29463817ae8b7b5601bf4a06ce6e ? ./DirectoryEntry.dhall -, File = - missing - sha256:23a8cb29d96aeb623501519d9a62c5c49659e8d1c30b4ae4f2399809e3fd3a01 - ? ./FileEntry.dhall , Metadata = missing sha256:8c240a00094238a73904af63ac0924b3e6aba1655312f20a2a27f88554e2febe ? ./Metadata.dhall +, TextFileEntry = + missing + sha256:23a8cb29d96aeb623501519d9a62c5c49659e8d1c30b4ae4f2399809e3fd3a01 + ? ./TextFileEntry.dhall , Type = missing sha256:75148ae19175750e38705e11cda8dcc775b2ac08f22518ff2ef3f33a6273ef15 ? ./Type.dhall +, binary-file = + missing + sha256:bd49df43268c259e3d0bef995917c3ab517ae7b98bf1faac8f4a7e8a602e3465 + ? ./binary-file.dhall , directory = missing sha256:0bee17310a21efa5b06f139b6731fdcee4f9e0245ef711c2b0127b8938dfed2e @@ -22,8 +30,8 @@ missing sha256:742610b2a13e55ae6e344b54aa8a7ee1bfec8e8b313a1132eae9286309b520e6 ? ./entry.dhall -, file = +, text-file = missing sha256:c5d76fd43216668d03df9945183fe7b3c55486aedcc77324c3372bd63e283b78 - ? ./file.dhall + ? ./text-file.dhall } diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/text-file.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/text-file.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/text-file.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:742610b2a13e55ae6e344b54aa8a7ee1bfec8e8b313a1132eae9286309b520e6 + ? ./entry.dhall + +in Entry Text diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/Make.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/Make.dhall --- a/dhall-lang/Prelude/DirectoryTree/Tree/Make.dhall +++ b/dhall-lang/Prelude/DirectoryTree/Tree/Make.dhall @@ -3,10 +3,18 @@ sha256:163a4536fdd05ce122d793ceda01d03fcffb29463817ae8b7b5601bf4a06ce6e ? ../Entry/DirectoryEntry.dhall -let File = +let BinaryFile = missing + sha256:f027db2893f6f38bbe6d868a91f22de530e85407237f00b147427c87d32bf55c + ? ../Entry/BinaryFileEntry.dhall + +let TextFile = + missing sha256:23a8cb29d96aeb623501519d9a62c5c49659e8d1c30b4ae4f2399809e3fd3a01 - ? ../Entry/FileEntry.dhall + ? ../Entry/TextFileEntry.dhall in \(tree : Type) -> - { directory : Directory tree -> tree, file : File -> tree } + { directory : Directory tree -> tree + , binary-file : BinaryFile -> tree + , file : TextFile -> tree + } diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/Type.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/Type.dhall --- a/dhall-lang/Prelude/DirectoryTree/Tree/Type.dhall +++ b/dhall-lang/Prelude/DirectoryTree/Tree/Type.dhall @@ -1,6 +1,6 @@ let Make = missing - sha256:235d511ed943dded33b46b1717df263037329394e27fb4b9c677eda5af924458 + sha256:33c52c16f76b41c3635b57a38ce0286f1ad8b3163a3f07a3b41b808ac5bfeb5b ? ./Make.dhall in forall (tree : Type) -> forall (make : Make tree) -> List tree diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/makeTree.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/makeTree.dhall --- a/dhall-lang/Prelude/DirectoryTree/Tree/makeTree.dhall +++ b/dhall-lang/Prelude/DirectoryTree/Tree/makeTree.dhall @@ -5,7 +5,7 @@ -} let Make = missing - sha256:235d511ed943dded33b46b1717df263037329394e27fb4b9c677eda5af924458 + sha256:33c52c16f76b41c3635b57a38ce0286f1ad8b3163a3f07a3b41b808ac5bfeb5b ? ./Make.dhall let Metadata = diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/makeTreeFromList.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/makeTreeFromList.dhall --- a/dhall-lang/Prelude/DirectoryTree/Tree/makeTreeFromList.dhall +++ b/dhall-lang/Prelude/DirectoryTree/Tree/makeTreeFromList.dhall @@ -6,7 +6,7 @@ -} let Make = missing - sha256:235d511ed943dded33b46b1717df263037329394e27fb4b9c677eda5af924458 + sha256:33c52c16f76b41c3635b57a38ce0286f1ad8b3163a3f07a3b41b808ac5bfeb5b ? ./Make.dhall let Metadata = @@ -21,7 +21,7 @@ let makeTreesFromList = missing - sha256:34ed54a0fc4072cbcb32d0b40adc3ad4e5d978c8dcd7fece9670bf0616f4ab18 + sha256:02fce5b194da66c2f98bd05af0a3bfdccf0b57d7971f17bcafee436652d9a88e ? ./makeTreesFromList.dhall let makeTreeFromList diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/makeTreesFromList.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/makeTreesFromList.dhall --- a/dhall-lang/Prelude/DirectoryTree/Tree/makeTreesFromList.dhall +++ b/dhall-lang/Prelude/DirectoryTree/Tree/makeTreesFromList.dhall @@ -5,7 +5,7 @@ -} let Make = missing - sha256:235d511ed943dded33b46b1717df263037329394e27fb4b9c677eda5af924458 + sha256:33c52c16f76b41c3635b57a38ce0286f1ad8b3163a3f07a3b41b808ac5bfeb5b ? ./Make.dhall let Metadata = diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/package.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/package.dhall --- a/dhall-lang/Prelude/DirectoryTree/Tree/package.dhall +++ b/dhall-lang/Prelude/DirectoryTree/Tree/package.dhall @@ -1,21 +1,21 @@ { Make = missing - sha256:235d511ed943dded33b46b1717df263037329394e27fb4b9c677eda5af924458 + sha256:33c52c16f76b41c3635b57a38ce0286f1ad8b3163a3f07a3b41b808ac5bfeb5b ? ./Make.dhall , Type = missing - sha256:01820cec8324cb701b6cc99e1dbbc8aacf0115db7795c6c3a023e4f1818fea79 + sha256:60b4d351213c6d851d7b2163ada40290b3c492a27326a2066fdec1a3915fb33b ? ./Type.dhall , makeTree = missing - sha256:e67054bceeb8f55968d89dbaa4b60b726a4ec544e49bd0c5622d5b487610e804 + sha256:2c1339fa63b4947864e1a6eede3c296288b53cf91a09d0d6881ae56790342e44 ? ./makeTree.dhall , makeTreeFromList = missing - sha256:ca73533264b52ed9eb29f51e7ac6dfc83c94c9051c5c52486d84b4a3ef7f0274 + sha256:b894c9398e123d7262320684ac6301c2efe44d9d4f5a303b99d14e9be6b3150f ? ./makeTreeFromList.dhall , makeTreesFromList = missing - sha256:34ed54a0fc4072cbcb32d0b40adc3ad4e5d978c8dcd7fece9670bf0616f4ab18 + sha256:02fce5b194da66c2f98bd05af0a3bfdccf0b57d7971f17bcafee436652d9a88e ? ./makeTreesFromList.dhall } diff --git a/dhall-lang/Prelude/DirectoryTree/package.dhall b/dhall-lang/Prelude/DirectoryTree/package.dhall --- a/dhall-lang/Prelude/DirectoryTree/package.dhall +++ b/dhall-lang/Prelude/DirectoryTree/package.dhall @@ -4,7 +4,7 @@ ? ./Access/package.dhall , Entry = missing - sha256:86da03766dbfeab3750ecd1012f6155dd904024351be20085dac3c79f27b22c7 + sha256:795db8b6c2bc28fdff6fbcc832c5b4cb6931c1f62ffa84674280c24d4f2eacd8 ? ./Entry/package.dhall , Group = missing @@ -16,7 +16,7 @@ ? ./Mode/package.dhall , Tree = missing - sha256:d2cb84de6b084bfaeb42e6212e7085be9ee03ff2684cf9d04e0d8b4478f42aa7 + sha256:6a64c27fa8a0c95830a4cc836651257235da0d985b7f93d11813cdb7a72e646b ? ./Tree/package.dhall , User = missing diff --git a/dhall-lang/tests/parser/success/builtinsA.dhall b/dhall-lang/tests/parser/success/builtinsA.dhall --- a/dhall-lang/tests/parser/success/builtinsA.dhall +++ b/dhall-lang/tests/parser/success/builtinsA.dhall @@ -1,37 +1,40 @@ -[ Natural/fold -, Natural/build -, Natural/isZero -, Natural/even -, Natural/odd -, Natural/toInteger -, Natural/show -, Integer/toDouble -, Integer/show -, Integer/negate -, Integer/clamp -, Natural/subtract +[ Date/show , Double/show +, Integer/clamp +, Integer/negate +, Integer/show +, Integer/toDouble , List/build , List/fold -, List/length , List/head -, List/last , List/indexed +, List/last +, List/length , List/reverse -, Text/show +, Natural/build +, Natural/even +, Natural/fold +, Natural/isZero +, Natural/odd +, Natural/show +, Natural/subtract +, Natural/toInteger , Text/replace +, Text/show +, Time/show +, TimeZone/show , Bool -, True +, Bytes +, Date +, Double , False -, Optional -, None -, Natural , Integer -, Double -, Text -, Bytes , List -, Type -, Kind -, Sort +, Natural +, None +, Optional +, Text +, Time +, TimeZone +, True ] diff --git a/dhall-lang/tests/parser/success/builtinsB.dhallb b/dhall-lang/tests/parser/success/builtinsB.dhallb --- a/dhall-lang/tests/parser/success/builtinsB.dhallb +++ b/dhall-lang/tests/parser/success/builtinsB.dhallb @@ -1,1 +1,1 @@ -˜&ölNatural/foldmNatural/buildnNatural/isZerolNatural/evenkNatural/oddqNatural/toIntegerlNatural/showpInteger/toDoublelInteger/shownInteger/negatemInteger/clamppNatural/subtractkDouble/showjList/buildiList/foldkList/lengthiList/headiList/lastlList/indexedlList/reverseiText/showlText/replacedBoolõôhOptionaldNonegNaturalgIntegerfDoubledTexteBytesdListdTypedKinddSort +˜)öiDate/showkDouble/showmInteger/clampnInteger/negatelInteger/showpInteger/toDoublejList/buildiList/foldiList/headlList/indexediList/lastkList/lengthlList/reversemNatural/buildlNatural/evenlNatural/foldnNatural/isZerokNatural/oddlNatural/showpNatural/subtractqNatural/toIntegerlText/replaceiText/showiTime/showmTimeZone/showdBooleBytesdDatefDoubleôgIntegerdListgNaturaldNonehOptionaldTextdTimehTimeZoneõ diff --git a/dhall-lang/tests/parser/success/listWithCommentA.dhall b/dhall-lang/tests/parser/success/listWithCommentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/listWithCommentA.dhall @@ -0,0 +1,3 @@ +[ + 1, -- item one +{- foo -} 2, 3 ] diff --git a/dhall-lang/tests/parser/success/listWithCommentB.dhallb b/dhall-lang/tests/parser/success/listWithCommentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/listWithCommentB.dhallb @@ -0,0 +1,1 @@ +…ö‚‚‚ diff --git a/dhall-lang/tests/parser/success/mixedBlockLineCommentA.dhall b/dhall-lang/tests/parser/success/mixedBlockLineCommentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/mixedBlockLineCommentA.dhall @@ -0,0 +1,6 @@ +{- foo -} +-- bar +{- --baz -} +-- {- qux -} + +1 diff --git a/dhall-lang/tests/parser/success/mixedBlockLineCommentB.dhallb b/dhall-lang/tests/parser/success/mixedBlockLineCommentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/mixedBlockLineCommentB.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/parser/success/text/multilinePreserveCommentA.dhall b/dhall-lang/tests/parser/success/text/multilinePreserveCommentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilinePreserveCommentA.dhall @@ -0,0 +1,8 @@ +{- A comment within the interior of a multi-line literal counts as part of the + literal +-} + +'' +-- Hello +{- world -} +'' diff --git a/dhall-lang/tests/parser/success/text/multilinePreserveCommentB.dhallb b/dhall-lang/tests/parser/success/text/multilinePreserveCommentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilinePreserveCommentB.dhallb @@ -0,0 +1,2 @@ +‚u-- Hello +{- world -} diff --git a/dhall-lang/tests/parser/success/text/preserveCommentA.dhall b/dhall-lang/tests/parser/success/text/preserveCommentA.dhall --- a/dhall-lang/tests/parser/success/text/preserveCommentA.dhall +++ b/dhall-lang/tests/parser/success/text/preserveCommentA.dhall @@ -1,8 +1,1 @@ -{- A comment within the interior of a multi-line literal counts as part of the - literal --} - -'' --- Hello -{- world -} -'' +"-- $--$--{--}$" diff --git a/dhall-lang/tests/parser/success/text/preserveCommentB.dhallb b/dhall-lang/tests/parser/success/text/preserveCommentB.dhallb --- a/dhall-lang/tests/parser/success/text/preserveCommentB.dhallb +++ b/dhall-lang/tests/parser/success/text/preserveCommentB.dhallb @@ -1,2 +1,1 @@ -‚u-- Hello -{- world -} +‚n-- $--$--{--}$ diff --git a/dhall-lang/tests/parser/success/text/unicodeBracedA.dhall b/dhall-lang/tests/parser/success/text/unicodeBracedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodeBracedA.dhall @@ -0,0 +1,1 @@ +"\u{1}\u{10}\u{100}\u{1000}\u{10000}\u{100000}" diff --git a/dhall-lang/tests/parser/success/text/unicodeBracedB.dhallb b/dhall-lang/tests/parser/success/text/unicodeBracedB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodeBracedB.dhallb @@ -0,0 +1,1 @@ +‚oĀက𐀀ô€€€ diff --git a/dhall-lang/tests/parser/success/text/unicodeEscapedA.dhall b/dhall-lang/tests/parser/success/text/unicodeEscapedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodeEscapedA.dhall @@ -0,0 +1,1 @@ +"A\u2115B\u{1FA00}C\u{43}D\u{00000001F574}E\u0022F" diff --git a/dhall-lang/tests/parser/success/text/unicodeEscapedB.dhallb b/dhall-lang/tests/parser/success/text/unicodeEscapedB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodeEscapedB.dhallb @@ -0,0 +1,1 @@ +‚sAℕB🨀CCD🕴E"F diff --git a/dhall-lang/tests/parser/success/text/unicodePlane16A.dhall b/dhall-lang/tests/parser/success/text/unicodePlane16A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodePlane16A.dhall @@ -0,0 +1,1 @@ +"\u{10fffd}\u{1fffd}" diff --git a/dhall-lang/tests/parser/success/text/unicodePlane16B.dhallb b/dhall-lang/tests/parser/success/text/unicodePlane16B.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodePlane16B.dhallb @@ -0,0 +1,1 @@ +‚hô¿½ðŸ¿½ diff --git a/dhall-lang/tests/parser/success/unit/DeBruijnIndexA.dhall b/dhall-lang/tests/parser/success/unit/DeBruijnIndexA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DeBruijnIndexA.dhall @@ -0,0 +1,1 @@ +x == x@0 diff --git a/dhall-lang/tests/parser/success/unit/DeBruijnIndexB.dhallb b/dhall-lang/tests/parser/success/unit/DeBruijnIndexB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DeBruijnIndexB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitSecretelyIntA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitSecretelyIntA.dhall deleted file mode 100644 --- a/dhall-lang/tests/parser/success/unit/DoubleLitSecretelyIntA.dhall +++ /dev/null @@ -1,5 +0,0 @@ -{- - Some languages do not make principled distinctions between number types, so - this checks that this Double is not silently considered as a Natural --} -1.0 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitSecretelyIntB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitSecretelyIntB.dhallb deleted file mode 100644 Binary files a/dhall-lang/tests/parser/success/unit/DoubleLitSecretelyIntB.dhallb and /dev/null differ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntA.dhall @@ -0,0 +1,5 @@ +{- + Some languages do not make principled distinctions between number types, so + this checks that this Double is not silently considered as a Natural +-} +1.0 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ForallUnicodeA.dhall b/dhall-lang/tests/parser/success/unit/ForallUnicodeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ForallUnicodeA.dhall @@ -0,0 +1,1 @@ +∀(x : T) -> y diff --git a/dhall-lang/tests/parser/success/unit/ForallUnicodeB.dhallb b/dhall-lang/tests/parser/success/unit/ForallUnicodeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ForallUnicodeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ListWithNewlineA.dhall b/dhall-lang/tests/parser/success/unit/ListWithNewlineA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListWithNewlineA.dhall @@ -0,0 +1,11 @@ +[ [ + 1, + 2, + 3, + ] +, [ + , 1 + , 2 + , 3 + ] +] diff --git a/dhall-lang/tests/parser/success/unit/ListWithNewlineB.dhallb b/dhall-lang/tests/parser/success/unit/ListWithNewlineB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListWithNewlineB.dhallb @@ -0,0 +1,1 @@ +„ö…ö‚‚‚…ö‚‚‚ diff --git a/dhall-lang/tests/parser/success/unit/RecordFieldAccessA.dhall b/dhall-lang/tests/parser/success/unit/RecordFieldAccessA.dhall deleted file mode 100644 --- a/dhall-lang/tests/parser/success/unit/RecordFieldAccessA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -r.x diff --git a/dhall-lang/tests/parser/success/unit/RecordFieldAccessB.dhallb b/dhall-lang/tests/parser/success/unit/RecordFieldAccessB.dhallb deleted file mode 100644 Binary files a/dhall-lang/tests/parser/success/unit/RecordFieldAccessB.dhallb and /dev/null differ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasA.dhall @@ -0,0 +1,1 @@ +{ , =, } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasB.dhallb @@ -0,0 +1,1 @@ +‚  diff --git a/dhall-lang/tests/parser/success/unit/RecordProjectFieldsA.dhall b/dhall-lang/tests/parser/success/unit/RecordProjectFieldsA.dhall deleted file mode 100644 --- a/dhall-lang/tests/parser/success/unit/RecordProjectFieldsA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -r.{ x, y, z } diff --git a/dhall-lang/tests/parser/success/unit/RecordProjectFieldsB.dhallb b/dhall-lang/tests/parser/success/unit/RecordProjectFieldsB.dhallb deleted file mode 100644 Binary files a/dhall-lang/tests/parser/success/unit/RecordProjectFieldsB.dhallb and /dev/null differ diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeEmptyA.dhall b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyA.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeEmptyB.dhallb b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyB.dhallb @@ -0,0 +1,1 @@ +‚  diff --git a/dhall-lang/tests/parser/success/unit/ShowConstructorA.dhall b/dhall-lang/tests/parser/success/unit/ShowConstructorA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ShowConstructorA.dhall @@ -0,0 +1,1 @@ +showConstructor .A diff --git a/dhall-lang/tests/parser/success/unit/ShowConstructorB.dhallb b/dhall-lang/tests/parser/success/unit/ShowConstructorB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ShowConstructorB.dhallb @@ -0,0 +1,1 @@ +‚"ƒ ‚ ¡aAöaA diff --git a/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueA.dhall b/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueA.dhall @@ -0,0 +1,1 @@ +showConstructor (.A False) diff --git a/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueB.dhallb b/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocA.dhall @@ -0,0 +1,1 @@ +w === x === y === z diff --git a/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeA.dhall --- a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeA.dhall +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeA.dhall @@ -1,1 +1,1 @@ -x //\\ y +x /\ y diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocA.dhall --- a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocA.dhall +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocA.dhall @@ -1,1 +1,1 @@ -w //\\ x //\\ y //\\ z +w /\ x /\ y /\ z diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocB.dhallb Binary files a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocB.dhallb and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeB.dhallb Binary files a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeB.dhallb and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeA.dhall --- a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeA.dhall +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeA.dhall @@ -1,1 +1,1 @@ -x /\ y +x //\\ y diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocA.dhall --- a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocA.dhall +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocA.dhall @@ -1,1 +1,1 @@ -w /\ x /\ y /\ z +w //\\ x //\\ y //\\ z diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocB.dhallb Binary files a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocB.dhallb and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeB.dhallb Binary files a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeB.dhallb and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeB.dhallb differ diff --git a/dhall.cabal b/dhall.cabal --- a/dhall.cabal +++ b/dhall.cabal @@ -1,6 +1,6 @@ Cabal-Version: 2.4 Name: dhall -Version: 1.42.2 +Version: 1.42.3 Build-Type: Simple License: BSD-3-Clause License-File: LICENSE @@ -215,7 +215,7 @@ case-insensitive < 1.3 , cborg >= 0.2.0.0 && < 0.3 , cborg-json >= 0.2.2.0 && < 0.3 , - containers >= 0.5.8.0 && < 0.8 , + containers >= 0.5.8.0 && < 0.9 , contravariant < 1.6 , data-fix < 0.4 , deepseq < 1.6 , @@ -229,23 +229,23 @@ haskeline >= 0.7.2.1 && < 0.9 , hashable >= 1.2 && < 1.6 , indexed-traversable < 0.2 , - lens-family-core >= 1.0.0 && < 2.2 , + microlens >= 0.4.14.0 && < 0.5 , + microlens-mtl >= 0.1 && < 0.3 , -- megaparsec follows SemVer: https://github.com/mrkkrp/megaparsec/issues/469#issuecomment-927918469 megaparsec >= 8 && < 10 , mmorph < 1.3 , mtl >= 2.2.1 && < 2.4 , network-uri >= 2.6 && < 2.7 , - optparse-applicative >= 0.14.0.0 && < 0.19, + optparse-applicative >= 0.14.0.0 && < 0.20, parsers >= 0.12.4 && < 0.13, parser-combinators , prettyprinter >= 1.7.0 && < 1.8 , prettyprinter-ansi-terminal >= 1.1.2 && < 1.2 , pretty-simple < 4.2 , - profunctors >= 3.1.2 && < 5.7 , repline >= 0.4.0.0 && < 0.5 , serialise >= 0.2.0.0 && < 0.3 , scientific >= 0.3.0.0 && < 0.4 , - template-haskell >= 2.13.0.0 && < 2.23, + template-haskell >= 2.13.0.0 && < 2.24, text >= 0.11.1.0 && < 2.2 , text-manipulate >= 0.2.0.1 && < 0.4 , text-short >= 0.1 && < 0.2 , @@ -447,7 +447,7 @@ generic-random >= 1.3.0.0 && < 1.6 , http-client , http-client-tls , - QuickCheck >= 2.14 && < 2.16, + QuickCheck >= 2.14 && < 2.17, quickcheck-instances >= 0.3.12 && < 0.4 , special-values < 0.2 , spoon < 0.4 , diff --git a/src/Dhall.hs b/src/Dhall.hs --- a/src/Dhall.hs +++ b/src/Dhall.hs @@ -69,7 +69,8 @@ import Dhall.Syntax (Expr (..), Import) import Dhall.TypeCheck (DetailedTypeError (..), TypeError) import GHC.Generics -import Lens.Family (LensLike', view) +import Lens.Micro (Lens', lens) +import Lens.Micro.Extras (view) import Prelude hiding (maybe, sequence) import System.FilePath (takeDirectory) @@ -83,7 +84,7 @@ import qualified Dhall.Pretty.Internal import qualified Dhall.Substitution import qualified Dhall.TypeCheck -import qualified Lens.Family +import qualified Lens.Micro as Lens import Dhall.Marshal.Decode import Dhall.Marshal.Encode @@ -111,22 +112,16 @@ -- | Access the directory to resolve imports relative to. -- -- @since 1.16 -rootDirectory - :: (Functor f) - => LensLike' f InputSettings FilePath -rootDirectory k s = - fmap (\x -> s { _rootDirectory = x }) (k (_rootDirectory s)) +rootDirectory :: Lens' InputSettings FilePath +rootDirectory = lens _rootDirectory (\s x -> s { _rootDirectory = x }) -- | Access the name of the source to report locations from; this is -- only used in error messages, so it's okay if this is a best guess -- or something symbolic. -- -- @since 1.16 -sourceName - :: (Functor f) - => LensLike' f InputSettings FilePath -sourceName k s = - fmap (\x -> s { _sourceName = x}) (k (_sourceName s)) +sourceName :: Lens' InputSettings FilePath +sourceName = lens _sourceName (\s x -> s { _sourceName = x}) -- | @since 1.16 data EvaluateSettings = EvaluateSettings @@ -152,59 +147,49 @@ -- -- @since 1.16 startingContext - :: (Functor f, HasEvaluateSettings s) - => LensLike' f s (Dhall.Context.Context (Expr Src Void)) -startingContext = evaluateSettings . l - where - l :: (Functor f) - => LensLike' f EvaluateSettings (Dhall.Context.Context (Expr Src Void)) - l k s = fmap (\x -> s { _startingContext = x}) (k (_startingContext s)) + :: (HasEvaluateSettings s) + => Lens' s (Dhall.Context.Context (Expr Src Void)) +startingContext = + evaluateSettings + . lens _startingContext (\s x -> s { _startingContext = x}) -- | Access the custom substitutions. -- -- @since 1.30 substitutions - :: (Functor f, HasEvaluateSettings s) - => LensLike' f s (Dhall.Substitution.Substitutions Src Void) -substitutions = evaluateSettings . l - where - l :: (Functor f) - => LensLike' f EvaluateSettings (Dhall.Substitution.Substitutions Src Void) - l k s = fmap (\x -> s { _substitutions = x }) (k (_substitutions s)) + :: (HasEvaluateSettings s) + => Lens' s (Dhall.Substitution.Substitutions Src Void) +substitutions = + evaluateSettings + . lens _substitutions (\s x -> s { _substitutions = x }) -- | Access the custom normalizer. -- -- @since 1.16 normalizer - :: (Functor f, HasEvaluateSettings s) - => LensLike' f s (Maybe (Core.ReifiedNormalizer Void)) -normalizer = evaluateSettings . l - where - l :: (Functor f) - => LensLike' f EvaluateSettings (Maybe (Core.ReifiedNormalizer Void)) - l k s = fmap (\x -> s { _normalizer = x }) (k (_normalizer s)) + :: (HasEvaluateSettings s) + => Lens' s (Maybe (Core.ReifiedNormalizer Void)) +normalizer = + evaluateSettings + . lens _normalizer (\s x -> s { _normalizer = x }) -- | Access the HTTP manager initializer. -- -- @since 1.36 newManager - :: (Functor f, HasEvaluateSettings s) - => LensLike' f s (IO Dhall.Import.Manager) -newManager = evaluateSettings . l - where - l :: (Functor f) - => LensLike' f EvaluateSettings (IO Dhall.Import.Manager) - l k s = fmap (\x -> s { _newManager = x }) (k (_newManager s)) + :: (HasEvaluateSettings s) + => Lens' s (IO Dhall.Import.Manager) +newManager = + evaluateSettings + . lens _newManager (\s x -> s { _newManager = x }) -- | @since 1.16 class HasEvaluateSettings s where - evaluateSettings - :: (Functor f) - => LensLike' f s EvaluateSettings + evaluateSettings :: Lens' s EvaluateSettings instance HasEvaluateSettings InputSettings where - evaluateSettings k s = - fmap (\x -> s { _evaluateSettings = x }) (k (_evaluateSettings s)) + evaluateSettings = + lens _evaluateSettings (\s x -> s { _evaluateSettings = x }) instance HasEvaluateSettings EvaluateSettings where evaluateSettings = id @@ -278,9 +263,9 @@ let EvaluateSettings{..} = _evaluateSettings let transform = - Lens.Family.set Dhall.Import.substitutions _substitutions - . Lens.Family.set Dhall.Import.normalizer _normalizer - . Lens.Family.set Dhall.Import.startingContext _startingContext + Lens.set Dhall.Import.substitutions _substitutions + . Lens.set Dhall.Import.normalizer _normalizer + . Lens.set Dhall.Import.startingContext _startingContext let status = transform (Dhall.Import.emptyStatusWithManager _newManager _rootDirectory) diff --git a/src/Dhall/Core.hs b/src/Dhall/Core.hs --- a/src/Dhall/Core.hs +++ b/src/Dhall/Core.hs @@ -87,7 +87,7 @@ import Dhall.Src (Src (..)) import Dhall.Syntax import Instances.TH.Lift () -import Lens.Family (over) +import Lens.Micro (over) import Prettyprinter (Pretty) import qualified Control.Exception diff --git a/src/Dhall/DirectoryTree.hs b/src/Dhall/DirectoryTree.hs --- a/src/Dhall/DirectoryTree.hs +++ b/src/Dhall/DirectoryTree.hs @@ -259,7 +259,8 @@ makeType :: Expector (Expr Src Void) makeType = Record . Map.fromList <$> sequenceA [ makeConstructor "directory" (Decode.auto :: Decoder DirectoryEntry) - , makeConstructor "file" (Decode.auto :: Decoder FileEntry) + , makeConstructor "file" (Decode.auto :: Decoder TextFileEntry) + , makeConstructor "binary-file" (Decode.auto :: Decoder BinaryFileEntry) ] where makeConstructor :: Text -> Decoder b -> Expector (Text, RecordField Src Void) @@ -295,13 +296,16 @@ processEntryWith path entry $ \path' content -> do Directory.createDirectoryIfMissing allowSeparators path' processFilesystemEntryList allowSeparators path' content -processFilesystemEntry allowSeparators path (FileEntry entry) = do - Util.printWarning "`file` is deprecated and will be removed eventually. Please use `text-file` instead." - processFilesystemEntry allowSeparators path (TextFileEntry entry) -processFilesystemEntry _ path (BinaryFileEntry entry) = - processEntryWith path entry ByteString.writeFile -processFilesystemEntry _ path (TextFileEntry entry) = - processEntryWith path entry Text.IO.writeFile +processFilesystemEntry allowSeparators path (BinaryFileEntry entry) = + processEntryWith path entry $ \path' content -> do + when allowSeparators $ do + Directory.createDirectoryIfMissing True (FilePath.takeDirectory path') + ByteString.writeFile path' content +processFilesystemEntry allowSeparators path (TextFileEntry entry) = + processEntryWith path entry $ \path' content -> do + when allowSeparators $ do + Directory.createDirectoryIfMissing True (FilePath.takeDirectory path') + Text.IO.writeFile path' content -- | A helper function used by 'processFilesystemEntry'. processEntryWith diff --git a/src/Dhall/DirectoryTree/Types.hs b/src/Dhall/DirectoryTree/Types.hs --- a/src/Dhall/DirectoryTree/Types.hs +++ b/src/Dhall/DirectoryTree/Types.hs @@ -12,9 +12,11 @@ -- | Types used by the implementation of the @to-directory-tree@ subcommand module Dhall.DirectoryTree.Types - ( FilesystemEntry(..) + ( FilesystemEntry(DirectoryEntry, BinaryFileEntry, TextFileEntry, FileEntry) , DirectoryEntry , FileEntry + , BinaryFileEntry + , TextFileEntry , Entry(..) , User(..) , Group(..) @@ -67,16 +69,25 @@ type DirectoryEntry = Entry (Seq FilesystemEntry) -- | A file in the filesystem. +{-# DEPRECATED FileEntry "`FileEntry` is deprecated and will be removed eventually. Please use `TextFileEntry` instead." #-} type FileEntry = Entry Text +-- | A binary file in the filesystem. +type BinaryFileEntry = Entry ByteString + +-- | A text file in the filesystem. +type TextFileEntry = Entry Text + -- | A filesystem entry. data FilesystemEntry = DirectoryEntry (Entry (Seq FilesystemEntry)) - | FileEntry (Entry Text) - | BinaryFileEntry (Entry ByteString) - | TextFileEntry (Entry Text) + | BinaryFileEntry BinaryFileEntry + | TextFileEntry TextFileEntry deriving (Eq, Generic, Ord, Show) +pattern FileEntry :: Entry Text -> FilesystemEntry +pattern FileEntry entry = TextFileEntry entry + instance FromDhall FilesystemEntry where autoWith normalizer = Decoder { expected = pure $ Var (V "tree" 0) @@ -84,11 +95,9 @@ Make "directory" entry -> DirectoryEntry <$> extract (autoWith normalizer) entry Make "file" entry -> - FileEntry <$> extract (autoWith normalizer) entry + TextFileEntry <$> extract (autoWith normalizer) entry Make "binary-file" entry -> BinaryFileEntry <$> extract (autoWith normalizer) entry - Make "text-file" entry -> - TextFileEntry <$> extract (autoWith normalizer) entry expr -> Decode.typeError (expected (Decode.autoWith normalizer :: Decoder FilesystemEntry)) expr } diff --git a/src/Dhall/Eval.hs b/src/Dhall/Eval.hs --- a/src/Dhall/Eval.hs +++ b/src/Dhall/Eval.hs @@ -57,7 +57,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Sequence (Seq, ViewL (..), ViewR (..)) import Data.Text (Text) -import Data.Time (Day, TimeOfDay(..), TimeZone) +import Data.Time (Day, TimeOfDay (..), TimeZone) import Data.Void (Void) import Dhall.Map (Map) import Dhall.Set (Set) diff --git a/src/Dhall/Freeze.hs b/src/Dhall/Freeze.hs --- a/src/Dhall/Freeze.hs +++ b/src/Dhall/Freeze.hs @@ -49,7 +49,8 @@ , Transitivity (..) , handleMultipleChecksFailed ) -import Lens.Family (set, view) +import Lens.Micro (set, transformMOf, transformOf) +import Lens.Micro.Extras (view) import System.Console.ANSI (hSupportsANSI) import qualified Control.Exception as Exception @@ -58,7 +59,6 @@ import qualified Dhall import qualified Dhall.Core as Core import qualified Dhall.Import -import qualified Dhall.Optics import qualified Dhall.Pretty import qualified Dhall.TypeCheck import qualified Dhall.Util as Util @@ -433,11 +433,11 @@ | import1 == import2 = Embed import1 simplify expression_ = expression_ - Dhall.Optics.transformOf Core.subExpressions simplify <$> case intent of + transformOf Core.subExpressions simplify <$> case intent of Secure -> - traverse freezeFunction (Dhall.Optics.transformOf Core.subExpressions uncache expression) + traverse freezeFunction (transformOf Core.subExpressions uncache expression) Cache -> - Dhall.Optics.transformMOf Core.subExpressions cache expression + transformMOf Core.subExpressions cache expression -- https://github.com/dhall-lang/dhall-haskell/issues/2347 toMissing :: Import -> Import diff --git a/src/Dhall/Import.hs b/src/Dhall/Import.hs --- a/src/Dhall/Import.hs +++ b/src/Dhall/Import.hs @@ -210,7 +210,7 @@ , SourcedException (..) , Src (..) ) -import Lens.Family.State.Strict (zoom) +import Lens.Micro.Mtl (zoom) import qualified Codec.CBOR.Write as Write import qualified Codec.Serialise diff --git a/src/Dhall/Import/Headers.hs b/src/Dhall/Import/Headers.hs --- a/src/Dhall/Import/Headers.hs +++ b/src/Dhall/Import/Headers.hs @@ -10,12 +10,7 @@ , toOriginHeaders ) where -import Control.Applicative - ( Alternative (..) -#if !MIN_VERSION_base(4,18,0) - , liftA2 -#endif - ) +import Control.Applicative (Alternative (..), liftA2) import Control.Exception (SomeException) import Control.Monad.Catch (handle, throwM) import Data.Text (Text) diff --git a/src/Dhall/Import/Types.hs b/src/Dhall/Import/Types.hs --- a/src/Dhall/Import/Types.hs +++ b/src/Dhall/Import/Types.hs @@ -23,7 +23,7 @@ ) import Dhall.Map (Map) import Dhall.Parser (Src) -import Lens.Family (LensLike') +import Lens.Micro (Lens', lens) import Prettyprinter (Pretty (..)) #ifdef WITH_HTTP @@ -164,45 +164,40 @@ _cacheWarning = CacheNotWarned -- | Lens from a `Status` to its `_stack` field -stack :: Functor f => LensLike' f Status (NonEmpty Chained) -stack k s = fmap (\x -> s { _stack = x }) (k (_stack s)) +stack :: Lens' Status (NonEmpty Chained) +stack = lens _stack (\s x -> s { _stack = x }) -- | Lens from a `Status` to its `_graph` field -graph :: Functor f => LensLike' f Status [Depends] -graph k s = fmap (\x -> s { _graph = x }) (k (_graph s)) +graph :: Lens' Status [Depends] +graph = lens _graph (\s x -> s { _graph = x }) -- | Lens from a `Status` to its `_cache` field -cache :: Functor f => LensLike' f Status (Map Chained ImportSemantics) -cache k s = fmap (\x -> s { _cache = x }) (k (_cache s)) +cache :: Lens' Status (Map Chained ImportSemantics) +cache = lens _cache (\s x -> s { _cache = x }) -- | Lens from a `Status` to its `_remote` field -remote - :: Functor f - => LensLike' f Status (URL -> StateT Status IO Data.Text.Text) -remote k s = fmap (\x -> s { _remote = x }) (k (_remote s)) +remote :: Lens' Status (URL -> StateT Status IO Data.Text.Text) +remote = lens _remote (\s x -> s { _remote = x }) -- | Lens from a `Status` to its `_remote` field -remoteBytes - :: Functor f - => LensLike' f Status (URL -> StateT Status IO Data.ByteString.ByteString) -remoteBytes k s = fmap (\x -> s { _remoteBytes = x }) (k (_remoteBytes s)) +remoteBytes :: Lens' Status (URL -> StateT Status IO Data.ByteString.ByteString) +remoteBytes = lens _remoteBytes (\s x -> s { _remoteBytes = x }) -- | Lens from a `Status` to its `_substitutions` field -substitutions :: Functor f => LensLike' f Status (Dhall.Substitution.Substitutions Src Void) -substitutions k s = fmap (\x -> s { _substitutions = x }) (k (_substitutions s)) +substitutions :: Lens' Status (Dhall.Substitution.Substitutions Src Void) +substitutions = lens _substitutions (\s x -> s { _substitutions = x }) -- | Lens from a `Status` to its `_normalizer` field -normalizer :: Functor f => LensLike' f Status (Maybe (ReifiedNormalizer Void)) -normalizer k s = fmap (\x -> s {_normalizer = x}) (k (_normalizer s)) +normalizer :: Lens' Status (Maybe (ReifiedNormalizer Void)) +normalizer = lens _normalizer (\s x -> s {_normalizer = x}) -- | Lens from a `Status` to its `_startingContext` field -startingContext :: Functor f => LensLike' f Status (Context (Expr Src Void)) -startingContext k s = - fmap (\x -> s { _startingContext = x }) (k (_startingContext s)) +startingContext :: Lens' Status (Context (Expr Src Void)) +startingContext = lens _startingContext (\s x -> s { _startingContext = x }) -- | Lens from a `Status` to its `_cacheWarning` field -cacheWarning :: Functor f => LensLike' f Status CacheWarning -cacheWarning k s = fmap (\x -> s { _cacheWarning = x }) (k (_cacheWarning s)) +cacheWarning :: Lens' Status CacheWarning +cacheWarning = lens _cacheWarning (\s x -> s { _cacheWarning = x }) {-| This exception indicates that there was an internal error in Dhall's import-related logic diff --git a/src/Dhall/Lint.hs b/src/Dhall/Lint.hs --- a/src/Dhall/Lint.hs +++ b/src/Dhall/Lint.hs @@ -40,8 +40,7 @@ import qualified Data.Text as Text import qualified Dhall.Core as Core import qualified Dhall.Map -import qualified Dhall.Optics -import qualified Lens.Family +import qualified Lens.Micro as Lens {-| Automatically improve a Dhall expression @@ -53,7 +52,7 @@ * fixes paths of the form @.\/..\/foo@ to @..\/foo@ -} lint :: Eq s => Expr s Import -> Expr s Import -lint = Dhall.Optics.rewriteOf subExpressions rewrite +lint = Lens.rewriteOf subExpressions rewrite where rewrite e = fixAssert e @@ -144,7 +143,7 @@ isOrContainsAssert :: Expr s a -> Bool isOrContainsAssert (Assert _) = True -isOrContainsAssert e = Lens.Family.anyOf subExpressions isOrContainsAssert e +isOrContainsAssert e = Lens.anyOf subExpressions isOrContainsAssert e -- | The difference between -- diff --git a/src/Dhall/Main.hs b/src/Dhall/Main.hs --- a/src/Dhall/Main.hs +++ b/src/Dhall/Main.hs @@ -27,6 +27,7 @@ import Data.Foldable (for_) import Data.List.NonEmpty (NonEmpty (..), nonEmpty) import Data.Maybe (fromMaybe) +import Data.Monoid (Endo (..)) import Data.Text (Text) import Data.Void (Void) import Dhall.Freeze (Intent (..), Scope (..)) @@ -36,7 +37,7 @@ , SemanticCacheMode (..) , _semanticCacheMode ) -import Dhall.Package (writePackage) +import Dhall.Package (PackagingMode (..), writePackage) import Dhall.Parser (Src) import Dhall.Pretty ( Ann @@ -47,6 +48,7 @@ import Dhall.Schemas (Schemas (..)) import Dhall.TypeCheck (Censored (..), DetailedTypeError (..), TypeError) import Dhall.Version (dhallVersionString) +import Lens.Micro (set) import Options.Applicative (Parser, ParserInfo) import Prettyprinter (Doc, Pretty) import System.Exit (ExitCode, exitFailure) @@ -95,6 +97,7 @@ import qualified Dhall.Import.Types import qualified Dhall.Lint import qualified Dhall.Map +import qualified Dhall.Package import qualified Dhall.Pretty import qualified Dhall.Repl import qualified Dhall.Schemas @@ -163,7 +166,10 @@ | DirectoryTree { allowSeparators :: Bool, file :: Input, path :: FilePath } | Schemas { file :: Input, outputMode :: OutputMode, schemas :: Text } | SyntaxTree { file :: Input, noted :: Bool } - | Package { name :: Maybe String, files :: NonEmpty FilePath } + | Package + { packageOptions :: Endo Dhall.Package.Options + , packageFiles :: NonEmpty FilePath + } -- | This specifies how to resolve transitive dependencies data ResolveMode @@ -316,7 +322,7 @@ Miscellaneous "package" "Create a package.dhall referencing the provided paths" - (Package <$> parsePackageName <*> parsePackageFiles) + (Package <$> parsePackageOptions <*> parsePackageFiles) <|> subcommand Miscellaneous "tags" @@ -566,14 +572,25 @@ <> Options.Applicative.help "Cache the hashed expression" ) - parsePackageName = optional $ - Options.Applicative.strOption - ( Options.Applicative.long "name" - <> Options.Applicative.help "The filename of the package" - <> Options.Applicative.metavar "NAME" - <> Options.Applicative.action "file" + parsePackageOptions :: Parser (Endo Dhall.Package.Options) + parsePackageOptions = do + packageMode <- (optional . Options.Applicative.flag' RecursiveSubpackages) + ( Options.Applicative.short 'r' + <> Options.Applicative.long "recursive" + <> Options.Applicative.help "Create packages for all subdirectories first." ) + packageFileName <- (optional . Options.Applicative.strOption) + ( Options.Applicative.long "name" + <> Options.Applicative.help "The filename of the package" + <> Options.Applicative.metavar "NAME" + <> Options.Applicative.action "file" + ) + + pure $ + maybe mempty (Endo . set Dhall.Package.packagingMode) packageMode <> + maybe mempty (Endo . set Dhall.Package.packageFileName) packageFileName + parsePackageFiles = (:|) <$> p <*> Options.Applicative.many p where p = Options.Applicative.strArgument @@ -1041,7 +1058,12 @@ denoted = Dhall.Core.denote expression in Text.Pretty.Simple.pPrintNoColor denoted - Package {..} -> writePackage (fromMaybe Unicode chosenCharacterSet) name files + Package {..} -> do + let options = appEndo + (maybe mempty (Endo . set Dhall.Package.characterSet) chosenCharacterSet + <> packageOptions + ) Dhall.Package.defaultOptions + writePackage options packageFiles -- | Entry point for the @dhall@ executable main :: IO () diff --git a/src/Dhall/Map.hs b/src/Dhall/Map.hs --- a/src/Dhall/Map.hs +++ b/src/Dhall/Map.hs @@ -1,9 +1,11 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveLift #-} -{-# LANGUAGE ExplicitForAll #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} -- | `Map` type used to represent records and unions @@ -76,9 +78,12 @@ import Language.Haskell.TH.Syntax (Lift) import Prelude hiding (filter, lookup) +import qualified Data.Foldable.WithIndex as Foldable.WithIndex +import qualified Data.Functor.WithIndex as Functor.WithIndex import qualified Data.List import qualified Data.Map.Strict import qualified Data.Set +import qualified Data.Traversable.WithIndex as Traversable.WithIndex import qualified GHC.Exts import qualified Prelude @@ -157,6 +162,18 @@ fromList = Dhall.Map.fromList toList = Dhall.Map.toList + +instance Ord k => Foldable.WithIndex.FoldableWithIndex k (Map k) where + ifoldMap = foldMapWithKey + {-# INLINABLE ifoldMap #-} + +instance Functor.WithIndex.FunctorWithIndex k (Map k) where + imap = mapWithKey + {-# INLINABLE imap #-} + +instance Ord k => Traversable.WithIndex.TraversableWithIndex k (Map k) where + itraverse = traverseWithKey + {-# INLINABLE itraverse #-} -- | Create an empty `Map` empty :: Ord k => Map k v diff --git a/src/Dhall/Marshal/Decode.hs b/src/Dhall/Marshal/Decode.hs --- a/src/Dhall/Marshal/Decode.hs +++ b/src/Dhall/Marshal/Decode.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ApplicativeDo #-} -{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DerivingStrategies #-} @@ -136,12 +136,7 @@ ) where -import Control.Applicative - ( empty -#if !MIN_VERSION_base(4,18,0) - , liftA2 -#endif - ) +import Control.Applicative (empty, liftA2) import Control.Exception (Exception) import Control.Monad (guard) import Control.Monad.Trans.State.Strict @@ -180,9 +175,9 @@ import qualified Data.Foldable import qualified Data.Functor.Compose import qualified Data.Functor.Product -import qualified Data.HashMap.Strict as HashMap +import qualified Data.HashMap.Strict as HashMap import qualified Data.HashSet -import qualified Data.List as List +import qualified Data.List as List import qualified Data.List.NonEmpty import qualified Data.Map import qualified Data.Maybe @@ -192,9 +187,9 @@ import qualified Data.Text import qualified Data.Text.Lazy import qualified Data.Text.Short -import qualified Data.Time as Time +import qualified Data.Time as Time import qualified Data.Vector -import qualified Dhall.Core as Core +import qualified Dhall.Core as Core import qualified Dhall.Map import qualified Dhall.Util diff --git a/src/Dhall/Marshal/Encode.hs b/src/Dhall/Marshal/Encode.hs --- a/src/Dhall/Marshal/Encode.hs +++ b/src/Dhall/Marshal/Encode.hs @@ -78,7 +78,7 @@ import qualified Data.ByteString.Lazy import qualified Data.ByteString.Short import qualified Data.Functor.Product -import qualified Data.HashMap.Strict as HashMap +import qualified Data.HashMap.Strict as HashMap import qualified Data.HashSet import qualified Data.Map import qualified Data.Scientific @@ -87,10 +87,10 @@ import qualified Data.Text import qualified Data.Text.Lazy import qualified Data.Text.Short -import qualified Data.Time as Time +import qualified Data.Time as Time import qualified Data.Vector import qualified Data.Void -import qualified Dhall.Core as Core +import qualified Dhall.Core as Core import qualified Dhall.Map import Dhall.Marshal.Internal diff --git a/src/Dhall/Normalize.hs b/src/Dhall/Normalize.hs --- a/src/Dhall/Normalize.hs +++ b/src/Dhall/Normalize.hs @@ -48,7 +48,7 @@ import qualified Dhall.Eval as Eval import qualified Dhall.Map import qualified Dhall.Syntax as Syntax -import qualified Lens.Family as Lens +import qualified Lens.Micro as Lens {-| Returns `True` if two expressions are α-equivalent and β-equivalent and `False` otherwise diff --git a/src/Dhall/Optics.hs b/src/Dhall/Optics.hs --- a/src/Dhall/Optics.hs +++ b/src/Dhall/Optics.hs @@ -3,10 +3,13 @@ for convenience -} -module Dhall.Optics +{-# LANGUAGE RankNTypes #-} + +module Dhall.Optics {-# DEPRECATED "Use the definitions from Lens.Micro of the microlens package directly." #-} ( Optic , Optic' -- * Utilities + , anyOf , rewriteOf , transformOf , rewriteMOf @@ -18,65 +21,63 @@ ) where import Control.Applicative (Const (..), WrappedMonad (..)) -import Data.Functor.Contravariant (Contravariant (contramap)) -import Data.Profunctor (Profunctor (dimap)) -import Data.Profunctor.Unsafe ((#.)) -import Lens.Family (ASetter, LensLike, LensLike', over) +import Data.Monoid (Any (..)) +import Lens.Micro (ASetter, LensLike, Traversal, SimpleGetter) +import Lens.Micro.Internal ((#.)) +import qualified Lens.Micro + +-- | Identical to @"Control.Lens.Getter".`Control.Lens.Getter.Getting`@ +type Getting r s a = (a -> Const r a) -> s -> Const r s + +-- | Identical to @"Control.Lens.Type".`Control.Lens.Type.Optic`@ +type Optic p f s t a b = p a (f b) -> p s (f t) + +-- | Identical to @"Control.Lens.Type".`Control.Lens.Type.Optic'`@ +type Optic' p f s a = Optic p f s s a a + +-- | Identical to @"Control.Lens".`Control.Lens.anyOf`@ +anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool +anyOf = Lens.Micro.anyOf +{-# INLINE anyOf #-} + -- | Identical to @"Control.Lens".`Control.Lens.rewriteOf`@ 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)) +rewriteOf = Lens.Micro.rewriteOf {-# INLINE rewriteOf #-} -- | Identical to @"Control.Lens".`Control.Lens.transformOf`@ transformOf :: ASetter a b a b -> (b -> b) -> a -> b -transformOf l f = go - where - go = f . over l go +transformOf = Lens.Micro.transformOf {-# INLINE transformOf #-} -- | Identical to @"Control.Lens".`Control.Lens.rewriteMOf`@ rewriteMOf :: Monad m => LensLike (WrappedMonad m) a b a b -> (b -> m (Maybe a)) -> a -> m b -rewriteMOf l f = go - where - go = transformMOf l (\x -> f x >>= maybe (return x) go) +rewriteMOf = Lens.Micro.rewriteMOf {-# INLINE rewriteMOf #-} -- | Identical to @"Control.Lens".`Control.Lens.transformMOf`@ transformMOf :: Monad m => LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b -transformMOf l f = go - where - go t = mapMOf l go t >>= f +transformMOf = Lens.Micro.transformMOf {-# INLINE transformMOf #-} -- | Identical to @"Control.Lens".`Control.Lens.mapMOf`@ mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t -mapMOf l cmd = unwrapMonad #. l (WrapMonad #. cmd) +mapMOf = Lens.Micro.mapMOf {-# INLINE mapMOf #-} -- | Identical to @"Control.Lens.Plated".`Control.Lens.Plated.cosmosOf`@ -cosmosOf :: (Applicative f, Contravariant f) => LensLike' f a a -> LensLike' f a a -cosmosOf d f s = f s *> d (cosmosOf d f) s +cosmosOf :: Traversal s t s t -> Traversal s t s b +cosmosOf = Lens.Micro.cosmosOf {-# INLINE cosmosOf #-} --- | Identical to @"Control.Lens.Type".`Control.Lens.Type.Optic`@ -type Optic p f s t a b = p a (f b) -> p s (f t) - --- | Identical to @"Control.Lens.Type".`Control.Lens.Type.Optic'`@ -type Optic' p f s a = Optic p f s s a a - -- | Identical to @"Control.Lens.Getter".`Control.Lens.Getter.to`@ -to :: (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a -to k = dimap k (contramap k) +to :: (s -> a) -> SimpleGetter s a +to = Lens.Micro.to {-# INLINE to #-} - --- | Identical to @"Control.Lens.Getter".`Control.Lens.Getter.Getting`@ -type Getting r s a = (a -> Const r a) -> s -> Const r s -- | Identical to @"Control.Lens.Fold".`Control.Lens.Fold.foldOf`@ foldOf :: Getting a s a -> s -> a diff --git a/src/Dhall/Package.hs b/src/Dhall/Package.hs --- a/src/Dhall/Package.hs +++ b/src/Dhall/Package.hs @@ -5,7 +5,13 @@ -- | Create a package.dhall from files and directory contents. module Dhall.Package - ( writePackage + ( Options + , defaultOptions + , characterSet + , packageFileName + , packagingMode + , PackagingMode(..) + , writePackage , getPackagePathAndContent , PackageError(..) ) where @@ -13,7 +19,6 @@ import Control.Exception (Exception, throwIO) import Control.Monad import Data.List.NonEmpty (NonEmpty (..)) -import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as Text import Data.Traversable (for) @@ -34,16 +39,59 @@ import Dhall.Pretty (CharacterSet (..)) import qualified Dhall.Pretty import Dhall.Util (_ERROR, renderExpression) +import Lens.Micro (Lens', lens) import System.Directory import System.FilePath +-- | Options for package creation. +data Options = Options + { optionsCharacterSet :: CharacterSet + , optionsPackageFileName :: String + , optionsPackagingMode :: PackagingMode + } + +-- | The default options used for packaging. +-- +-- The default values for the different settings are: +-- +-- * The character set used is the one given by 'Dhall.Pretty.defaultCharacterSet'. +-- * The package file name is @package.dhall@. +-- * The packaging mode is 'OnlyThisPackage'. +defaultOptions :: Options +defaultOptions = Options + { optionsCharacterSet = Dhall.Pretty.defaultCharacterSet + , optionsPackageFileName = "package.dhall" + , optionsPackagingMode = OnlyThisPackage + } + +-- | Access the character set used to render the package content. +characterSet :: Lens' Options CharacterSet +characterSet = lens optionsCharacterSet (\s x -> s { optionsCharacterSet = x }) + +-- | Access the file name used for the package file. +packageFileName :: Lens' Options String +packageFileName = + lens optionsPackageFileName (\s x -> s { optionsPackageFileName = x }) + +-- | Access the packaging mode. +-- See the documentation of 'getPackagePathAndContent'. +packagingMode :: Lens' Options PackagingMode +packagingMode = + lens optionsPackagingMode (\s x -> s { optionsPackagingMode = x }) + +-- | Whether to recursively create a package for each subdirectory or not. +-- See the documentation of 'getPackagePathAndContent'. +data PackagingMode + = OnlyThisPackage + | RecursiveSubpackages + -- | Create a package.dhall from files and directory contents. -- For a description of how the package file is constructed see -- 'getPackagePathAndContent'. -writePackage :: CharacterSet -> Maybe String -> NonEmpty FilePath -> IO () -writePackage characterSet outputFn inputs = do - (outputPath, expr) <- getPackagePathAndContent outputFn inputs - renderExpression characterSet True (Just outputPath) expr +writePackage :: Options -> NonEmpty FilePath -> IO () +writePackage options inputs = do + (outputPath, expr) <- getPackagePathAndContent options inputs + renderExpression (optionsCharacterSet options) True (Just outputPath) expr -- | Get the path and the Dhall expression for a package file. -- @@ -62,11 +110,18 @@ -- * If the path points to a directory, all files with a @.dhall@ extensions -- in that directory are included in the package. -- +-- If you passed `Recurse` to the this function, then in addition to these +-- files all subdirectories are traversed and a sub-package created for each +-- one. That sub-package will be included in the package too. +-- -- * If the path points to a regular file, it is included in the package -- unless it is the path of the package file itself. -- -getPackagePathAndContent :: Maybe String -> NonEmpty FilePath -> IO (FilePath, Expr s Import) -getPackagePathAndContent outputFn (path :| paths) = do +getPackagePathAndContent + :: Options + -> NonEmpty FilePath + -> IO (FilePath, Expr s Import) +getPackagePathAndContent options (path :| paths) = do outputDir <- do isDirectory <- doesDirectoryExist path return $ if isDirectory then path else takeDirectory path @@ -82,9 +137,13 @@ return relativeDir resultMap <- go Map.empty checkOutputDir (path:paths) - return (outputDir outputFn', RecordLit $ Map.sort resultMap) + return (outputDir outputFn, RecordLit $ Map.sort resultMap) where - go :: Map Text (RecordField s Import) -> (FilePath -> IO FilePath) -> [FilePath] -> IO (Map Text (RecordField s Import)) + go + :: Map Text (RecordField s Import) + -> (FilePath -> IO FilePath) + -> [FilePath] + -> IO (Map Text (RecordField s Import)) go !acc _checkOutputDir [] = return acc go !acc checkOutputDir (p:ps) = do isDirectory <- doesDirectoryExist p @@ -92,22 +151,41 @@ if | isDirectory -> do void $ checkOutputDir p entries <- listDirectory p - let entries' = filter (\entry -> takeExtension entry == ".dhall") entries - go acc checkOutputDir (map (p ) entries' <> ps) + (dhallFiles, subdirectories) <- foldMap + ( \entry -> do + let entry' = p entry + isDirectoryEntry <- doesDirectoryExist entry' + return $ if isDirectoryEntry + then (mempty, [entry']) + else if hasDhallExtension entry + then ([entry'], mempty) + else mempty + ) entries + subpackages <- case optionsPackagingMode options of + RecursiveSubpackages -> + for subdirectories $ \subdirectory -> do + writePackage options (subdirectory :| []) + return (subdirectory outputFn) + OnlyThisPackage -> return [] + go acc checkOutputDir (dhallFiles <> subpackages <> ps) | isFile -> do dir <- checkOutputDir $ takeDirectory p let p' = normalise $ dir takeFileName p - let resultMap = if p' == outputFn' + let resultMap = if p' == outputFn then Map.empty - else filepathToMap outputFn' p' + else filepathToMap outputFn p' acc' <- mergeMaps acc resultMap go acc' checkOutputDir ps | otherwise -> throwIO $ InvalidPath p - outputFn' = fromMaybe "package.dhall" outputFn + hasDhallExtension :: FilePath -> Bool + hasDhallExtension entry = takeExtension entry == ".dhall" + + outputFn :: String + outputFn = optionsPackageFileName options -- | Construct a nested 'Map' from a 'FilePath'. -- For example, the filepath @some/file/path.dhall@ will result in something diff --git a/src/Dhall/Parser/Combinators.hs b/src/Dhall/Parser/Combinators.hs --- a/src/Dhall/Parser/Combinators.hs +++ b/src/Dhall/Parser/Combinators.hs @@ -23,12 +23,7 @@ ) where -import Control.Applicative - ( Alternative (..) -#if !MIN_VERSION_base(4,18,0) - , liftA2 -#endif - ) +import Control.Applicative (Alternative (..), liftA2) import Control.Exception (Exception) import Control.Monad (MonadPlus (..)) import Data.String (IsString (..)) diff --git a/src/Dhall/Parser/Expression.hs b/src/Dhall/Parser/Expression.hs --- a/src/Dhall/Parser/Expression.hs +++ b/src/Dhall/Parser/Expression.hs @@ -8,13 +8,7 @@ -- | Parsing Dhall expressions. module Dhall.Parser.Expression where -import Control.Applicative - ( Alternative (..) -#if !MIN_VERSION_base(4,18,0) - , liftA2 -#endif - , optional - ) +import Control.Applicative (Alternative (..), liftA2, optional) import Data.Foldable (foldl') import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) diff --git a/src/Dhall/Pretty.hs b/src/Dhall/Pretty.hs --- a/src/Dhall/Pretty.hs +++ b/src/Dhall/Pretty.hs @@ -8,6 +8,7 @@ , prettyExpr , CharacterSet(..) + , defaultCharacterSet , detectCharacterSet , prettyCharacterSet diff --git a/src/Dhall/Pretty/Internal.hs b/src/Dhall/Pretty/Internal.hs --- a/src/Dhall/Pretty/Internal.hs +++ b/src/Dhall/Pretty/Internal.hs @@ -20,6 +20,7 @@ , prettySrcExpr , CharacterSet(..) + , defaultCharacterSet , detectCharacterSet , prettyCharacterSet , prettyImportExpression @@ -86,12 +87,12 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) import Dhall.Map (Map) -import Dhall.Optics (cosmosOf, foldOf, to) import Dhall.Src (Src (..)) import Dhall.Syntax import {-# SOURCE #-} Dhall.Syntax.Instances.Pretty () import GHC.Generics (Generic) import Language.Haskell.TH.Syntax (Lift) +import Lens.Micro (cosmosOf, foldMapOf) import Numeric.Natural (Natural) import Prettyprinter (Doc, Pretty, space) @@ -155,11 +156,16 @@ parseJSON v@(String _) = unexpected v parseJSON v = typeMismatch "String" v +-- | The character set used by default in functions throughout the Dhall code +-- base. +defaultCharacterSet :: CharacterSet +defaultCharacterSet = Unicode + -- | Detect which character set is used for the syntax of an expression -- If any parts of the expression uses the Unicode syntax, the whole expression -- is deemed to be using the Unicode syntax. detectCharacterSet :: Expr Src a -> CharacterSet -detectCharacterSet = foldOf (cosmosOf subExpressions . to exprToCharacterSet) +detectCharacterSet = foldMapOf (cosmosOf subExpressions) exprToCharacterSet where exprToCharacterSet = \case Embed _ -> mempty -- Don't go down the embed route, otherwise: <> @@ -176,7 +182,7 @@ prettyExpr = prettySrcExpr . denote prettySrcExpr :: Pretty a => Expr Src a -> Doc Ann -prettySrcExpr = prettyCharacterSet Unicode +prettySrcExpr = prettyCharacterSet defaultCharacterSet {-| Internal utility for pretty-printing, used when generating element lists to supply to `enclose` or `enclose'`. This utility indicates that the diff --git a/src/Dhall/Schemas.hs b/src/Dhall/Schemas.hs --- a/src/Dhall/Schemas.hs +++ b/src/Dhall/Schemas.hs @@ -41,13 +41,13 @@ import qualified Dhall.Import as Import import qualified Dhall.Map as Map import qualified Dhall.Normalize as Normalize -import qualified Dhall.Optics as Optics import qualified Dhall.Parser as Parser import qualified Dhall.Pretty import qualified Dhall.Substitution as Substitution import qualified Dhall.Syntax as Syntax import qualified Dhall.TypeCheck as TypeCheck import qualified Dhall.Util as Util +import qualified Lens.Micro as Lens import qualified Prettyprinter as Pretty import qualified Prettyprinter.Render.Terminal as Pretty.Terminal import qualified Prettyprinter.Render.Text as Pretty.Text @@ -195,7 +195,7 @@ let rewrittenExpression :: Expr Src Import rewrittenExpression = - fmap Void.absurd (Optics.transformOf Syntax.subExpressions schemasRewrite normalizedExpression) + fmap Void.absurd (Lens.transformOf Syntax.subExpressions schemasRewrite normalizedExpression) if Normalize.freeIn (V "schemas" 0) rewrittenExpression then return (Let (Syntax.makeBinding "schemas" _schemas) rewrittenExpression) diff --git a/src/Dhall/Syntax/Expr.hs b/src/Dhall/Syntax/Expr.hs --- a/src/Dhall/Syntax/Expr.hs +++ b/src/Dhall/Syntax/Expr.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneKindSignatures #-} module Dhall.Syntax.Expr diff --git a/src/Dhall/Syntax/Instances/Applicative.hs b/src/Dhall/Syntax/Instances/Applicative.hs --- a/src/Dhall/Syntax/Instances/Applicative.hs +++ b/src/Dhall/Syntax/Instances/Applicative.hs @@ -9,7 +9,7 @@ import Dhall.Syntax.Operations import Dhall.Syntax.RecordField -import qualified Lens.Family as Lens +import qualified Lens.Micro as Lens instance Applicative (Expr s) where pure = Embed diff --git a/src/Dhall/Syntax/Instances/Bifunctor.hs b/src/Dhall/Syntax/Instances/Bifunctor.hs --- a/src/Dhall/Syntax/Instances/Bifunctor.hs +++ b/src/Dhall/Syntax/Instances/Bifunctor.hs @@ -10,7 +10,7 @@ import Dhall.Syntax.Operations import Dhall.Syntax.RecordField -import qualified Lens.Family as Lens +import qualified Lens.Micro as Lens instance Bifunctor Binding where first k (Binding src0 a src1 b src2 c) = diff --git a/src/Dhall/Syntax/Instances/Functor.hs b/src/Dhall/Syntax/Instances/Functor.hs --- a/src/Dhall/Syntax/Instances/Functor.hs +++ b/src/Dhall/Syntax/Instances/Functor.hs @@ -13,7 +13,7 @@ import Dhall.Syntax.RecordField import Dhall.Syntax.Types -import qualified Lens.Family as Lens +import qualified Lens.Micro as Lens deriving instance Functor (Binding s) deriving instance Functor (Chunks s) diff --git a/src/Dhall/Syntax/Instances/Lift.hs b/src/Dhall/Syntax/Instances/Lift.hs --- a/src/Dhall/Syntax/Instances/Lift.hs +++ b/src/Dhall/Syntax/Instances/Lift.hs @@ -19,9 +19,11 @@ #if !MIN_VERSION_template_haskell(2,21,0) import qualified Data.Fixed as Fixed #endif -import qualified Data.Time as Time +import qualified Data.Time as Time +#if !MIN_VERSION_time(1,14,0) deriving instance Lift Time.Day +#endif deriving instance Lift Time.TimeOfDay deriving instance Lift Time.TimeZone #if !MIN_VERSION_template_haskell(2,21,0) diff --git a/src/Dhall/Syntax/Instances/Monad.hs b/src/Dhall/Syntax/Instances/Monad.hs --- a/src/Dhall/Syntax/Instances/Monad.hs +++ b/src/Dhall/Syntax/Instances/Monad.hs @@ -9,7 +9,7 @@ import Dhall.Syntax.Operations import Dhall.Syntax.RecordField -import qualified Lens.Family as Lens +import qualified Lens.Micro as Lens instance Monad (Expr s) where return = pure diff --git a/src/Dhall/Syntax/Operations.hs b/src/Dhall/Syntax/Operations.hs --- a/src/Dhall/Syntax/Operations.hs +++ b/src/Dhall/Syntax/Operations.hs @@ -38,7 +38,7 @@ import qualified Data.HashSet import qualified Data.Text -import qualified Lens.Family as Lens +import qualified Lens.Micro as Lens -- | A traversal over the immediate sub-expressions of an expression. diff --git a/src/Dhall/TH.hs b/src/Dhall/TH.hs --- a/src/Dhall/TH.hs +++ b/src/Dhall/TH.hs @@ -27,7 +27,7 @@ import Dhall.Syntax (Expr (..), FunctionBinding (..), Var (..)) import GHC.Generics (Generic) import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ) -import Lens.Family (view) +import Lens.Micro.Extras (view) import Prettyprinter (Pretty) import Language.Haskell.TH.Syntax diff --git a/src/Dhall/TypeCheck.hs b/src/Dhall/TypeCheck.hs --- a/src/Dhall/TypeCheck.hs +++ b/src/Dhall/TypeCheck.hs @@ -47,9 +47,9 @@ , Val (..) , (~>) ) -import Dhall.Pretty (Ann, UnescapedLabel(..)) +import Dhall.Pretty (Ann, UnescapedLabel (..)) import Dhall.Src (Src) -import Lens.Family (over) +import Lens.Micro (anyOf, over) import Prettyprinter (Doc, Pretty (..), vsep) import Dhall.Syntax @@ -81,7 +81,6 @@ import qualified Dhall.Pretty.Internal import qualified Dhall.Syntax as Syntax import qualified Dhall.Util -import qualified Lens.Family import qualified Prettyprinter as Pretty import qualified Prettyprinter.Render.String as Pretty @@ -1004,7 +1003,7 @@ n < 0 containsBadVar e = - Lens.Family.anyOf + anyOf Dhall.Core.subExpressions containsBadVar e @@ -1315,12 +1314,21 @@ VOptional _O' -> do case ks of - WithQuestion :| _ -> do + + -- (Some x) with ? = v is valid iff the type of x is the same as the type of v. + WithQuestion :| [] -> do tV' <- loop ctx v if Eval.conv values _O' tV' then return (VOptional _O') else die OptionalWithTypeMismatch + -- (Some x) with ?.a.b = v is valid iff the type of x.a.b is the same as the type of v. + WithQuestion :| k₁ : ks' -> do + tV' <- with _O' (k₁ :| ks') v + if Eval.conv values _O' tV' + then return (VOptional _O') + else die OptionalWithTypeMismatch + WithLabel k :| _ -> die (NotAQuestionPath k) _ -> die (NotWithARecord e₀ (quote names tE')) -- TODO: NotWithARecordOrOptional @@ -1370,7 +1378,6 @@ | Untyped | MissingListType | MismatchedListElements Int (Expr s a) (Expr s a) (Expr s a) - | InvalidListElement Int (Expr s a) (Expr s a) (Expr s a) | InvalidListType (Expr s a) | ListLitInvariant | InvalidSome (Expr s a) (Expr s a) (Expr s a) @@ -1379,13 +1386,11 @@ | InvalidFieldType Text (Expr s a) | InvalidAlternativeType Text (Expr s a) | ListAppendMismatch (Expr s a) (Expr s a) - | MustUpdateARecord (Expr s a) (Expr s a) (Expr s a) | MustCombineARecord Char (Expr s a) (Expr s a) | InvalidDuplicateField Text (Expr s a) (Expr s a) | InvalidRecordCompletion Text (Expr s a) | CompletionSchemaMustBeARecord (Expr s a) (Expr s a) | CombineTypesRequiresRecordType (Expr s a) (Expr s a) - | RecordTypeMismatch Const Const (Expr s a) (Expr s a) | DuplicateFieldCannotBeMerged (NonEmpty Text) | FieldCollision (NonEmpty Text) | FieldTypeCollision (NonEmpty Text) @@ -1402,7 +1407,6 @@ | HandlerInputTypeMismatch Text (Expr s a) (Expr s a) | DisallowedHandlerType Text (Expr s a) (Expr s a) Text | HandlerOutputTypeMismatch Text (Expr s a) Text (Expr s a) - | InvalidHandlerOutputType Text (Expr s a) (Expr s a) | MissingMergeType | HandlerNotAFunction Text (Expr s a) | CantAccess Text (Expr s a) (Expr s a) @@ -2452,47 +2456,6 @@ txt1 = pretty i txt3 = insert expr2 -prettyTypeMessage (InvalidListElement i expr0 _expr1 expr2) = - ErrorMessages {..} - where - short = "List element has the wrong type\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr2) - - hints = [] - - long = - "Explanation: Every element in the list must have a type matching the type \n\ - \annotation at the end of the list \n\ - \ \n\ - \For example, this is a valid ❰List❱: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────┐ \n\ - \ │ [1, 2, 3] : List Natural │ Every element in this ❰List❱ is an ❰Natural❱ \n\ - \ └──────────────────────────┘ \n\ - \ \n\ - \ \n\ - \.. but this is " <> _NOT <> " a valid ❰List❱: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────┐ \n\ - \ │ [1, \"ABC\", 3] : List Natural │ The second element is not an ❰Natural❱ \n\ - \ └──────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Your ❰List❱ elements should have this type: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... but the element at index #" <> txt1 <> " has this type instead: \n\ - \ \n\ - \" <> txt3 <> "\n" - where - txt0 = insert expr0 - txt1 = pretty i - txt3 = insert expr2 - prettyTypeMessage (InvalidSome expr0 expr1 expr2) = ErrorMessages {..} where short = "❰Some❱ argument has the wrong type" @@ -2737,57 +2700,6 @@ txt0 = insert expr0 txt1 = pretty fieldName -prettyTypeMessage (MustUpdateARecord withExpression expression typeExpression) = - ErrorMessages {..} - where - short = "You can only update records" - - hints = [] - - long = - "Explanation: You can update records using the ❰with❱ keyword, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────┐ \n\ - \ │ { x = { y = 1 } } with x.y = 2 │ \n\ - \ └────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────────────────────────────┐ \n\ - \ │ λ(r : { foo : { bar : Bool } }) → r with foo.bar = False } │ \n\ - \ └────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot update values that are not records. \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ 1 with x = True │ \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: Not a record \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \The following expression is not permitted: \n\ - \ \n\ - \" <> insert withExpression' <> "\n\ - \ \n\ - \... because the left argument to ❰with❱: \n\ - \ \n\ - \" <> insert expression <> "\n\ - \ \n\ - \... is not a record, but is actually a: \n\ - \ \n\ - \" <> insert typeExpression <> "\n" - where - withExpression' = case withExpression of - With record keys value -> With (Dhall.Core.normalize record) keys value - _ -> withExpression - prettyTypeMessage (MustCombineARecord c expression typeExpression) = ErrorMessages {..} where @@ -2960,59 +2872,6 @@ txt0 = insert expr0 txt1 = insert expr1 -prettyTypeMessage (RecordTypeMismatch const0 const1 expr0 expr1) = - ErrorMessages {..} - where - short = "Record type mismatch" - - hints = [] - - long = - "Explanation: You can only use the ❰⩓❱ operator on record types if they are both \n\ - \ ❰Type❱s or ❰Kind❱s: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────┐ \n\ - \ │ { age : Natural } ⩓ { name : Text } │ Valid: Both arguments are ❰Type❱s \n\ - \ └─────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────┐ \n\ - \ │ { Input : Type } ⩓ { Output : Type } │ Valid: Both arguments are ❰Kind❱s \n\ - \ └──────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot combine a ❰Type❱ and a ❰Kind❱: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────┐ \n\ - \ │ { Input : Type } ⩓ { name : Text } │ Invalid: The arguments do not match \n\ - \ └────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to combine the following record type: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... with this record types: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but the former record type is a: \n\ - \ \n\ - \" <> txt2 <> "\n\ - \ \n\ - \... but the latter record type is a: \n\ - \ \n\ - \" <> txt3 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - txt2 = insert const0 - txt3 = insert const1 - prettyTypeMessage (DuplicateFieldCannotBeMerged ks) = ErrorMessages {..} where short = "Duplicate field cannot be merged: " <> pretty (toPath ks) @@ -3526,72 +3385,6 @@ \ \n\ \" <> insert variable <> "\n" -prettyTypeMessage (InvalidHandlerOutputType expr0 expr1 expr2) = - ErrorMessages {..} - where - short = "Wrong handler output type\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr2) - - hints = [] - - long = - "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\ - \a record with one handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... as long as the output type of each handler function matches the declared \n\ - \type of the result: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────────────────────┐ \n\ - \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ - \ └───────────────────────────────────────────────────────────┘ \n\ - \ ⇧ ⇧ \n\ - \ These output types ... \n\ - \ \n\ - \ ... must match the declared type of the ❰merge❱ \n\ - \ ⇩ \n\ - \ ┌─────────────────────────────┐ \n\ - \ │ merge handlers union : Bool │ \n\ - \ └─────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Text │ \n\ - \ └──────────────────────────────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: Doesn't match output of either handler\n\ - \ \n\ - \ \n\ - \Your handler for the following alternative: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... needs to return an output value of type: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but actually returns an output value of a different type: \n\ - \ \n\ - \" <> txt2 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - txt2 = insert expr2 - prettyTypeMessage (HandlerOutputTypeMismatch key0 expr0 key1 expr1) = ErrorMessages {..} where @@ -4873,8 +4666,6 @@ pure MissingListType MismatchedListElements a b c d -> MismatchedListElements <$> pure a <*> f b <*> f c <*> f d - InvalidListElement a b c d -> - InvalidListElement <$> pure a <*> f b <*> f c <*> f d InvalidListType a -> InvalidListType <$> f a ListLitInvariant -> @@ -4893,8 +4684,6 @@ ListAppendMismatch <$> f a <*> f b InvalidDuplicateField a b c -> InvalidDuplicateField a <$> f b <*> f c - MustUpdateARecord a b c -> - MustUpdateARecord <$> f a <*> f b <*> f c MustCombineARecord a b c -> MustCombineARecord <$> pure a <*> f b <*> f c InvalidRecordCompletion a l -> @@ -4903,8 +4692,6 @@ CompletionSchemaMustBeARecord <$> f l <*> f r CombineTypesRequiresRecordType a b -> CombineTypesRequiresRecordType <$> f a <*> f b - RecordTypeMismatch a b c d -> - RecordTypeMismatch <$> pure a <*> pure b <*> f c <*> f d DuplicateFieldCannotBeMerged a -> pure (DuplicateFieldCannotBeMerged a) FieldCollision a -> @@ -4937,8 +4724,6 @@ DisallowedHandlerType <$> pure a <*> f b <*> f c <*> pure d HandlerOutputTypeMismatch a b c d -> HandlerOutputTypeMismatch <$> pure a <*> f b <*> pure c <*> f d - InvalidHandlerOutputType a b c -> - InvalidHandlerOutputType <$> pure a <*> f b <*> f c MissingMergeType -> pure MissingMergeType HandlerNotAFunction a b -> diff --git a/tests/Dhall/Test/DirectoryTree.hs b/tests/Dhall/Test/DirectoryTree.hs --- a/tests/Dhall/Test/DirectoryTree.hs +++ b/tests/Dhall/Test/DirectoryTree.hs @@ -1,23 +1,24 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} module Dhall.Test.DirectoryTree (tests) where import Control.Monad -import Data.Either (partitionEithers) +import Data.Either (partitionEithers) import Data.Either.Validation import Dhall.DirectoryTree -import Lens.Family (set) -import System.FilePath (()) +import Lens.Micro (set) +import System.FilePath (()) import Test.Tasty import Test.Tasty.HUnit +import qualified Data.List import qualified Data.Text.IO import qualified Dhall import qualified Dhall.Core -import qualified System.Directory as Directory -import qualified System.FilePath as FilePath +import qualified System.Directory as Directory +import qualified System.FilePath as FilePath import qualified System.PosixCompat.Files as Files tests :: TestTree @@ -26,6 +27,7 @@ [ fixpointedType , fixpointedEmpty , fixpointedSimple + , fixpointedAllowPathSeparators #ifndef mingw32_HOST_OS , fixpointedPermissions , fixpointedUserGroup @@ -54,12 +56,25 @@ let outDir = "./tests/to-directory-tree/fixpoint-simple.out" path = "./tests/to-directory-tree/fixpoint-simple.dhall" entries <- runDirectoryTree False outDir path - entries @?= + entries @?= Data.List.sort [ Directory outDir , File $ outDir "file" , Directory $ outDir "directory" ] +fixpointedAllowPathSeparators :: TestTree +fixpointedAllowPathSeparators = testCase "allow-path-separators" $ do + let outDir = "./tests/to-directory-tree/fixpoint-allow-path-separators.out" + path = "./tests/to-directory-tree/fixpoint-allow-path-separators.dhall" + entries <- runDirectoryTree True outDir path + entries @?= Data.List.sort + [ Directory outDir + , Directory $ outDir "non-existent-1" + , File $ outDir "non-existent-1" "file" + , Directory $ outDir "non-existent-2" + , Directory $ outDir "non-existent-2" "directory" + ] + {- This test is disabled on Windows as it fails due to limitations of the : expected: 448 @@ -84,14 +99,14 @@ expr <- Dhall.inputExpr file entries <- decodeDirectoryTree expr entries @?= - [ FileEntry $ Entry + [ TextFileEntry $ Entry { entryName = "ids" , entryContent = "" , entryUser = Just (UserId 0) , entryGroup = Just (GroupId 0) , entryMode = Nothing } - , FileEntry $ Entry + , TextFileEntry $ Entry { entryName = "names" , entryContent = "" , entryUser = Just (UserName "user") @@ -116,12 +131,12 @@ toDirectoryTree allowSeparators outDir $ Dhall.Core.denote expr - walkFsTree outDir + Data.List.sort <$> walkFsTree outDir data WalkEntry = Directory FilePath | File FilePath - deriving (Eq, Show) + deriving (Eq, Ord, Show) walkFsTree :: FilePath -> IO [WalkEntry] walkFsTree dir = do diff --git a/tests/Dhall/Test/Package.hs b/tests/Dhall/Test/Package.hs --- a/tests/Dhall/Test/Package.hs +++ b/tests/Dhall/Test/Package.hs @@ -3,7 +3,7 @@ module Dhall.Test.Package where -import Control.Exception (Exception, displayException, try) +import Control.Exception (Exception, displayException, finally, try) import Data.List.NonEmpty (NonEmpty (..)) import Data.Void (Void) import Dhall.Core @@ -19,6 +19,8 @@ ) import qualified Dhall.Map as Map import Dhall.Package +import Lens.Micro (set) +import qualified System.Directory as Directory import System.FilePath (()) import Test.Tasty import Test.Tasty.HUnit @@ -31,6 +33,7 @@ , packageEmptyDirectory , packageSingleDirectory , packageNested + , packageRecursive , packageMissingFile , packageFilesDifferentDirs , packageIncompatibleFiles @@ -43,7 +46,7 @@ let package :: Expr Void Import package = RecordLit Map.empty - (output, expr) <- getPackagePathAndContent Nothing ("./tests/package/package.dhall" :| []) + (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/package.dhall" :| []) assertEqual "path" path output assertEqual "content" package expr @@ -55,7 +58,10 @@ package = RecordLit $ Map.singleton "package" $ makeRecordField $ Embed packageDhall - (output, expr) <- getPackagePathAndContent (Just "custom.dhall") ("./tests/package/package.dhall" :| []) + let options :: Options + options = set packageFileName "custom.dhall" defaultOptions + + (output, expr) <- getPackagePathAndContent options ("./tests/package/package.dhall" :| []) assertEqual "path" path output assertEqual "content" package expr @@ -67,7 +73,7 @@ package = RecordLit $ Map.singleton "test" $ makeRecordField $ Embed testDhall - (output, expr) <- getPackagePathAndContent Nothing ("./tests/package/dir/test.dhall" :| []) + (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/dir/test.dhall" :| []) assertEqual "path" path output assertEqual "content" package expr @@ -78,7 +84,7 @@ let package :: Expr Void Import package = RecordLit Map.empty - (output, expr) <- getPackagePathAndContent Nothing ("./tests/package/empty" :| []) + (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/empty" :| []) assertEqual "path" path output assertEqual "content" package expr @@ -90,7 +96,7 @@ package = RecordLit $ Map.singleton "test" $ makeRecordField $ Embed testDhall - (output, expr) <- getPackagePathAndContent Nothing ("./tests/package/dir" :| []) + (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/dir" :| []) assertEqual "path" path output assertEqual "content" package expr @@ -108,7 +114,7 @@ , ("test", makeRecordField $ Embed testDhall) ] - (output, expr) <- getPackagePathAndContent Nothing + (output, expr) <- getPackagePathAndContent defaultOptions ( "./tests/package/test.dhall" :| [ "./tests/package/dir/test.dhall" , "./tests/package/other/package.dhall" @@ -116,10 +122,34 @@ assertEqual "path" path output assertEqual "content" package expr +packageRecursive :: TestTree +packageRecursive = testCase "recursively create subpackages" $ removePackagesAfter $ do + let path = "./tests/package/dir" "package.dhall" + + let package :: Expr Void Import + package = RecordLit $ Map.fromList + [ ("subdirectory1", makeRecordField $ Embed subdirectoryPackageDhall1) + , ("subdirectory2", makeRecordField $ Embed subdirectoryPackageDhall2) + , ("test", makeRecordField $ Embed testDhall) + ] + + let options :: Options + options = set packagingMode RecursiveSubpackages defaultOptions + + (output, expr) <- getPackagePathAndContent options + ( "./tests/package/dir" :| [] ) + assertEqual "path" path output + assertEqual "content" package expr + where + removePackagesAfter :: IO a -> IO a + removePackagesAfter action = action `finally` do + Directory.removePathForcibly "./tests/package/dir/subdirectory1/package.dhall" + Directory.removePathForcibly "./tests/package/dir/subdirectory2/package.dhall" + packageMissingFile :: TestTree packageMissingFile = testCase "missing file" $ do let action :: IO (FilePath, Expr Void Import) - action = getPackagePathAndContent Nothing ("./tests/package/missing.dhall" :| []) + action = getPackagePathAndContent defaultOptions ("./tests/package/missing.dhall" :| []) assertThrow action $ \case InvalidPath "./tests/package/missing.dhall" -> True @@ -128,7 +158,10 @@ packageFilesDifferentDirs :: TestTree packageFilesDifferentDirs = testCase "files from different directories" $ do let action :: IO (FilePath, Expr Void Import) - action = getPackagePathAndContent Nothing ("./tests/package/dir/test.dhall" :| ["./tests/package/test/test.dhall"]) + action = getPackagePathAndContent defaultOptions + ( "./tests/package/dir/test.dhall" :| + [ "./tests/package/test/test.dhall" + ]) assertThrow action $ \case AmbiguousOutputDirectory "./tests/package/dir" "./tests/package/test" -> True @@ -137,7 +170,10 @@ packageIncompatibleFiles :: TestTree packageIncompatibleFiles = testCase "files that are incompatible" $ do let action :: IO (FilePath, Expr Void Import) - action = getPackagePathAndContent Nothing ("./tests/package/test.dhall" :| ["./tests/package/test/test.dhall"]) + action = getPackagePathAndContent defaultOptions + ( "./tests/package/test.dhall" :| + [ "./tests/package/test/test.dhall" + ]) assertThrow action $ \case IncompatiblePaths xs -> xs == [ testDhall , testTestDhall ] @@ -190,6 +226,28 @@ } , importMode = Code } + +subdirectoryPackageDhall1 :: Import +subdirectoryPackageDhall1 = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local Here $ File + { directory = Directory {components = ["subdirectory1"]} + , file = "package.dhall"} + } + , importMode = Code + } + +subdirectoryPackageDhall2 :: Import +subdirectoryPackageDhall2 = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local Here $ File + { directory = Directory {components = ["subdirectory2"]} + , file = "package.dhall"} + } + , importMode = Code + } testTestDhall :: Import testTestDhall = Import diff --git a/tests/Dhall/Test/QuickCheck.hs b/tests/Dhall/Test/QuickCheck.hs --- a/tests/Dhall/Test/QuickCheck.hs +++ b/tests/Dhall/Test/QuickCheck.hs @@ -103,7 +103,7 @@ import qualified Dhall.Set import qualified Dhall.TypeCheck import qualified Generic.Random -import qualified Lens.Family as Lens +import qualified Lens.Micro as Lens import qualified Numeric.Natural as Nat import qualified Test.QuickCheck import qualified Test.Tasty diff --git a/tests/Dhall/Test/Regression.hs b/tests/Dhall/Test/Regression.hs --- a/tests/Dhall/Test/Regression.hs +++ b/tests/Dhall/Test/Regression.hs @@ -7,7 +7,7 @@ import Data.Either.Validation (Validation (..)) import Data.Void (Void) -import Dhall.Core (Expr(..), ReifiedNormalizer(..)) +import Dhall.Core (Expr (..), ReifiedNormalizer (..)) import Dhall.Import (Imported, MissingImports (..)) import Dhall.Parser (SourcedException (..), Src) import Dhall.TypeCheck (TypeError) @@ -25,7 +25,7 @@ import qualified Dhall.Pretty import qualified Dhall.Test.Util as Util import qualified Dhall.TypeCheck -import qualified Lens.Family as Lens +import qualified Lens.Micro as Lens import qualified Prettyprinter import qualified Prettyprinter.Render.Text import qualified System.Timeout diff --git a/tests/Dhall/Test/Substitution.hs b/tests/Dhall/Test/Substitution.hs --- a/tests/Dhall/Test/Substitution.hs +++ b/tests/Dhall/Test/Substitution.hs @@ -11,7 +11,7 @@ import qualified Data.Either.Validation import qualified Dhall import qualified Dhall.Map -import qualified Lens.Family as Lens +import qualified Lens.Micro as Lens data Result = Failure Integer | Success String deriving (Eq, Dhall.Generic, Show) diff --git a/tests/Dhall/Test/Util.hs b/tests/Dhall/Test/Util.hs --- a/tests/Dhall/Test/Util.hs +++ b/tests/Dhall/Test/Util.hs @@ -71,9 +71,9 @@ #if defined(WITH_HTTP) && defined(NETWORK_TESTS) import qualified Data.Foldable #else -import Control.Monad.IO.Class (MonadIO (..)) -import Dhall.Core (Directory (..), File (..), URL (..)) -import Lens.Family.State.Strict (zoom) +import Control.Monad.IO.Class (MonadIO (..)) +import Dhall.Core (Directory (..), File (..), URL (..)) +import Lens.Micro.Mtl (zoom) import qualified Data.Foldable import qualified Data.Text.Encoding diff --git a/tests/package/dir/subdirectory1/test.dhall b/tests/package/dir/subdirectory1/test.dhall new file mode 100644 --- /dev/null +++ b/tests/package/dir/subdirectory1/test.dhall diff --git a/tests/package/dir/subdirectory2/wrong-extension.txt b/tests/package/dir/subdirectory2/wrong-extension.txt new file mode 100644 --- /dev/null +++ b/tests/package/dir/subdirectory2/wrong-extension.txt diff --git a/tests/to-directory-tree/fixpoint-allow-path-separators.dhall b/tests/to-directory-tree/fixpoint-allow-path-separators.dhall new file mode 100644 --- /dev/null +++ b/tests/to-directory-tree/fixpoint-allow-path-separators.dhall @@ -0,0 +1,25 @@ +let User = (./fixpoint-helper.dhall).User + +let Group = (./fixpoint-helper.dhall).Group + +let Mode = (./fixpoint-helper.dhall).Mode + +let Make = (./fixpoint-helper.dhall).Make + +in \(r : Type) -> + \(make : Make r) -> + [ make.file + { name = "non-existent-1/file" + , content = "" + , user = None User + , group = None Group + , mode = None Mode + } + , make.directory + { name = "non-existent-2/directory" + , content = [] : List r + , user = None User + , group = None Group + , mode = None Mode + } + ] diff --git a/tests/to-directory-tree/fixpoint-helper.dhall b/tests/to-directory-tree/fixpoint-helper.dhall --- a/tests/to-directory-tree/fixpoint-helper.dhall +++ b/tests/to-directory-tree/fixpoint-helper.dhall @@ -21,6 +21,10 @@ } let Make = - \(r : Type) -> { directory : Entry (List r) -> r, file : Entry Text -> r } + \(r : Type) -> + { directory : Entry (List r) -> r + , binary-file : Entry Bytes -> r + , file : Entry Text -> r + } in { User, Group, Access, Mode, Entry, Make } diff --git a/tests/to-directory-tree/fixpoint-simple.dhall b/tests/to-directory-tree/fixpoint-simple.dhall --- a/tests/to-directory-tree/fixpoint-simple.dhall +++ b/tests/to-directory-tree/fixpoint-simple.dhall @@ -8,18 +8,18 @@ in \(r : Type) -> \(make : Make r) -> - [ make.file - { name = "file" - , content = "" - , user = None User - , group = None Group - , mode = None Mode - } - , make.directory - { name = "directory" - , content = [] : List r - , user = None User - , group = None Group - , mode = None Mode - } - ] + [ make.file + { name = "file" + , content = "" + , user = None User + , group = None Group + , mode = None Mode + } + , make.directory + { name = "directory" + , content = [] : List r + , user = None User + , group = None Group + , mode = None Mode + } + ] diff --git a/tests/to-directory-tree/type.dhall b/tests/to-directory-tree/type.dhall --- a/tests/to-directory-tree/type.dhall +++ b/tests/to-directory-tree/type.dhall @@ -23,9 +23,14 @@ in forall (result : Type) -> let DirectoryEntry = Entry (List result) - let FileEntry = Entry Text + let BinaryFileEntry = Entry Bytes + let TextFileEntry = Entry Text + let Make = - { directory : DirectoryEntry -> result, file : FileEntry -> result } + { directory : DirectoryEntry -> result + , binary-file : BinaryFileEntry -> result + , file : TextFileEntry -> result + } in forall (make : Make) -> List result