Skip to content

Commit 2f204e7

Browse files
Gabriella439Gabriella439
authored
Implement language support for Bytes (#2499)
… as standardized in dhall-lang/dhall-lang#1323
1 parent 4ce3e65 commit 2f204e7

File tree

27 files changed

+339
-34
lines changed

27 files changed

+339
-34
lines changed

‎dhall-bash/src/Dhall/Bash.hs

+2
Original file line numberDiff line numberDiff line change
@@ -292,6 +292,8 @@ dhallToStatement expr0 var0 = go (Dhall.Core.normalize expr0)
292292
go e@(BoolEQ {}) = Left (UnsupportedStatement e)
293293
go e@(BoolNE {}) = Left (UnsupportedStatement e)
294294
go e@(BoolIf {}) = Left (UnsupportedStatement e)
295+
go e@(Bytes ) = Left (UnsupportedStatement e)
296+
go e@(BytesLit {}) = Left (UnsupportedStatement e)
295297
go e@(Natural ) = Left (UnsupportedStatement e)
296298
go e@(NaturalFold ) = Left (UnsupportedStatement e)
297299
go e@(NaturalBuild ) = Left (UnsupportedStatement e)

‎dhall-json/src/Dhall/JSON.hs

+6
Original file line numberDiff line numberDiff line change
@@ -797,6 +797,12 @@ convertToHomogeneousMaps (Conversion {..}) e0 = loop (Core.normalize e0)
797797
b' = loop b
798798
c' = loop c
799799

800+
Core.Bytes ->
801+
Core.Bytes
802+
803+
Core.BytesLit a ->
804+
Core.BytesLit a
805+
800806
Core.Natural ->
801807
Core.Natural
802808

‎dhall-nix/src/Dhall/Nix.hs

+13
Original file line numberDiff line numberDiff line change
@@ -163,6 +163,9 @@ data CompileError
163163
-- ^ We currently do not support threading around type information
164164
| CannotShowConstructor
165165
-- ^ We currently do not support the `showConstructor` keyword
166+
| BytesUnsupported
167+
-- ^ The Nix language does not support arbitrary bytes (most notably: null
168+
-- bytes)
166169
deriving (Typeable)
167170

168171
instance Show CompileError where
@@ -237,6 +240,13 @@ doesn't survive β-normalization, so if you see this error message there might b
237240
an internal error in ❰dhall-to-nix❱ that you should report.
238241
|]
239242

243+
show BytesUnsupported =
244+
Data.Text.unpack [NeatInterpolation.text|
245+
$_ERROR: Cannot translate ❰Bytes❱ to Nix
246+
247+
Explanation: The Nix language does not support bytes literals
248+
|]
249+
240250
_ERROR :: Data.Text.Text
241251
_ERROR = "\ESC[1;31mError\ESC[0m"
242252

@@ -376,6 +386,9 @@ dhallToNix e =
376386
b' <- loop b
377387
c' <- loop c
378388
return (Nix.mkIf a' b' c')
389+
loop Bytes = return untranslatable
390+
loop (BytesLit _) = do
391+
Left BytesUnsupported
379392
loop Natural = return untranslatable
380393
loop (NaturalLit n) = return (Nix.mkInt (fromIntegral n))
381394
loop NaturalFold = do

‎dhall-nixpkgs/Main.hs

+1
Original file line numberDiff line numberDiff line change
@@ -356,6 +356,7 @@ findExternalDependencies expression = do
356356
case importMode of
357357
Code -> return ()
358358
RawText -> return ()
359+
RawBytes -> return ()
359360
Location -> empty -- "as Location" imports aren't real dependencies
360361

361362
case importType of

‎dhall/dhall-lang

Submodule dhall-lang updated 183 files

‎dhall/dhall.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -170,6 +170,7 @@ Extra-Source-Files:
170170
dhall-lang/tests/**/*.dhallb
171171
dhall-lang/tests/**/*.hash
172172
dhall-lang/tests/**/*.txt
173+
dhall-lang/tests/**/*.bin
173174
dhall-lang/tests/import/cache/dhall/12203871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc
174175
dhall-lang/tests/import/cache/dhall/1220618f785ce8f3930a9144398f576f0a992544b51212bc9108c31b4e670dc6ed21
175176
tests/**/*.dhall

‎dhall/ghc-src/Dhall/Import/HTTP.hs

+13-8
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44

55
module Dhall.Import.HTTP
66
( fetchFromHttpUrl
7+
, fetchFromHttpUrlBytes
78
, originHeadersFileExpr
89
) where
910

@@ -38,11 +39,10 @@ import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..))
3839

3940
import qualified Control.Exception
4041
import qualified Control.Monad.Trans.State.Strict as State
42+
import qualified Data.ByteString.Lazy as ByteString.Lazy
4143
import qualified Data.HashMap.Strict as HashMap
4244
import qualified Data.Text as Text
4345
import qualified Data.Text.Encoding
44-
import qualified Data.Text.Lazy
45-
import qualified Data.Text.Lazy.Encoding
4646
import qualified Dhall.Util
4747
import qualified Network.HTTP.Client as HTTP
4848
import qualified Network.HTTP.Types
@@ -266,8 +266,9 @@ addHeaders originHeaders urlHeaders request =
266266
matchesKey :: CI ByteString -> HTTPHeader -> Bool
267267
matchesKey key (candidate, _value) = key == candidate
268268

269-
fetchFromHttpUrl :: URL -> Maybe [HTTPHeader] -> StateT Status IO Text.Text
270-
fetchFromHttpUrl childURL mheaders = do
269+
fetchFromHttpUrlBytes
270+
:: URL -> Maybe [HTTPHeader] -> StateT Status IO ByteString
271+
fetchFromHttpUrlBytes childURL mheaders = do
271272
Status { _loadOriginHeaders } <- State.get
272273

273274
originHeaders <- _loadOriginHeaders
@@ -300,16 +301,20 @@ fetchFromHttpUrl childURL mheaders = do
300301
_ -> do
301302
return ()
302303

303-
let bytes = HTTP.responseBody response
304+
return (ByteString.Lazy.toStrict (HTTP.responseBody response))
305+
306+
fetchFromHttpUrl :: URL -> Maybe [HTTPHeader] -> StateT Status IO Text.Text
307+
fetchFromHttpUrl childURL mheaders = do
308+
bytes <- fetchFromHttpUrlBytes childURL mheaders
304309

305-
case Data.Text.Lazy.Encoding.decodeUtf8' bytes of
310+
case Data.Text.Encoding.decodeUtf8' bytes of
306311
Left err -> liftIO (Control.Exception.throwIO err)
307-
Right text -> return (Data.Text.Lazy.toStrict text)
312+
Right text -> return text
308313

309314
originHeadersFileExpr :: IO (Expr Src Import)
310315
originHeadersFileExpr = do
311316
directoryStr <- getXdgDirectory XdgConfig "dhall"
312317
let components = map Text.pack (splitDirectories directoryStr)
313318
let directory = Directory (reverse components)
314319
let file = (File directory "headers.dhall")
315-
return (Embed (Import (ImportHashed Nothing (Local Absolute file)) Code))
320+
return (Embed (Import (ImportHashed Nothing (Local Absolute file)) Code))

‎dhall/ghcjs-src/Dhall/Import/HTTP.hs

+11-1
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
module Dhall.Import.HTTP
44
( fetchFromHttpUrl
5+
, fetchFromHttpUrlBytes
56
, originHeadersFileExpr
67
) where
78

@@ -14,7 +15,8 @@ import Dhall.Import.Types (Import, Status)
1415
import Dhall.Parser (Src)
1516
import Dhall.URL (renderURL)
1617

17-
import qualified Data.Text as Text
18+
import qualified Data.Text as Text
19+
import qualified Data.Text.Encoding as Text.Encoding
1820
import qualified JavaScript.XHR
1921

2022
fetchFromHttpUrl
@@ -38,5 +40,13 @@ fetchFromHttpUrl childURL Nothing = do
3840
fetchFromHttpUrl _ _ =
3941
fail "Dhall does not yet support custom headers when built using GHCJS"
4042

43+
fetchFromHTTPUrlBytes
44+
:: URL
45+
-> Maybe [(CI ByteString, ByteString)]
46+
-> StateT Status IO ByteString
47+
fetchFromHTTPUrlBytes childUrl mheader = do
48+
text <- fetchFromHTTPUrl childUrl mheader
49+
return (Text.Encoding.encodeUtf8 text)
50+
4151
originHeadersFileExpr :: IO (Expr Src Import)
4252
originHeadersFileExpr = return Missing

‎dhall/src/Dhall/Binary.hs

+21-1
Original file line numberDiff line numberDiff line change
@@ -144,6 +144,7 @@ decodeExpressionInternal decodeEmbed = go
144144
| sb == "Type" -> return (Const Type)
145145
| sb == "Kind" -> return (Const Kind)
146146
| sb == "Sort" -> return (Const Sort)
147+
5 | sb == "Bytes" -> return Bytes
147148
6 | sb == "Double" -> return Double
148149
7 | sb == "Integer" -> return Integer
149150
| sb == "Natural" -> return Natural
@@ -650,6 +651,12 @@ decodeExpressionInternal decodeEmbed = go
650651
let minutes = sign (_HH * 60 + _MM)
651652

652653
return (TimeZoneLiteral (Time.TimeZone minutes False ""))
654+
655+
33 -> do
656+
b <- Decoding.decodeBytes
657+
658+
return (BytesLit b)
659+
653660
34 -> do
654661
t <- go
655662
return (ShowConstructor t)
@@ -737,6 +744,9 @@ encodeExpressionInternal encodeEmbed = go
737744
Bool ->
738745
Encoding.encodeUtf8ByteArray "Bool"
739746

747+
Bytes ->
748+
Encoding.encodeUtf8ByteArray "Bytes"
749+
740750
Optional ->
741751
Encoding.encodeUtf8ByteArray "Optional"
742752

@@ -830,6 +840,11 @@ encodeExpressionInternal encodeEmbed = go
830840
BoolNE l r ->
831841
encodeOperator 3 l r
832842

843+
BytesLit b ->
844+
encodeList2
845+
(Encoding.encodeInt 33)
846+
(Encoding.encodeBytes b)
847+
833848
NaturalPlus l r ->
834849
encodeOperator 4 l r
835850

@@ -1157,6 +1172,7 @@ decodeImport len = do
11571172
0 -> return Code
11581173
1 -> return RawText
11591174
2 -> return Location
1175+
3 -> return RawBytes
11601176
_ -> die ("Unexpected code for import mode: " <> show m)
11611177

11621178
let remote scheme = do
@@ -1295,7 +1311,11 @@ encodeImport import_ =
12951311
Just digest ->
12961312
Encoding.encodeBytes ("\x12\x20" <> Dhall.Crypto.unSHA256Digest digest)
12971313

1298-
m = Encoding.encodeInt (case importMode of Code -> 0; RawText -> 1; Location -> 2;)
1314+
m = Encoding.encodeInt (case importMode of
1315+
Code -> 0
1316+
RawText -> 1
1317+
Location -> 2
1318+
RawBytes -> 3 )
12991319

13001320
Import{..} = import_
13011321

‎dhall/src/Dhall/Diff.hs

+27-6
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ module Dhall.Diff (
1717
, diff
1818
) where
1919

20+
import Data.ByteString (ByteString)
2021
import Data.Foldable (fold, toList)
2122
import Data.List.NonEmpty (NonEmpty (..))
2223
import Data.Monoid (Any (..))
@@ -40,16 +41,16 @@ import Dhall.Syntax
4041
import Numeric.Natural (Natural)
4142
import Prettyprinter (Doc, Pretty)
4243

43-
import qualified Data.Algorithm.Diff as Algo.Diff
44+
import qualified Data.Algorithm.Diff as Algo.Diff
4445
import qualified Data.List.NonEmpty
4546
import qualified Data.Set
4647
import qualified Data.Text
47-
import qualified Data.Time as Time
48+
import qualified Data.Time as Time
4849
import qualified Dhall.Map
49-
import qualified Dhall.Normalize as Normalize
50-
import qualified Dhall.Pretty.Internal as Internal
51-
import qualified Dhall.Syntax as Syntax
52-
import qualified Prettyprinter as Pretty
50+
import qualified Dhall.Normalize as Normalize
51+
import qualified Dhall.Pretty.Internal as Internal
52+
import qualified Dhall.Syntax as Syntax
53+
import qualified Prettyprinter as Pretty
5354

5455
{-| This type is a `Doc` enriched with a `same` flag to efficiently track if
5556
any difference was detected
@@ -383,6 +384,10 @@ diffChunks cL cR
383384
(Right x, Right y) -> diff x y
384385
_ -> diffTextSkeleton
385386

387+
diffBytes :: ByteString -> ByteString -> Diff
388+
diffBytes l r =
389+
"0x" <> diffText (Internal.prettyBase16 l) (Internal.prettyBase16 r)
390+
386391
diffList
387392
:: (Eq a, Pretty a)
388393
=> Seq (Expr Void a) -> Seq (Expr Void a) -> Diff
@@ -532,6 +537,10 @@ skeleton (BoolIf {}) =
532537
<> keyword "else"
533538
<> " "
534539
<> ignore
540+
skeleton (BytesLit {}) =
541+
"0x\""
542+
<> ignore
543+
<> "\""
535544
skeleton (NaturalPlus {}) =
536545
ignore
537546
<> " "
@@ -1169,6 +1178,18 @@ diffPrimitiveExpression l@Bool r =
11691178
mismatch l r
11701179
diffPrimitiveExpression l r@Bool =
11711180
mismatch l r
1181+
diffPrimitiveExpression Bytes Bytes =
1182+
"…"
1183+
diffPrimitiveExpression l@Bytes r =
1184+
mismatch l r
1185+
diffPrimitiveExpression l r@Bytes =
1186+
mismatch l r
1187+
diffPrimitiveExpression (BytesLit l) (BytesLit r) =
1188+
diffBytes l r
1189+
diffPrimitiveExpression l@(BytesLit {}) r =
1190+
mismatch l r
1191+
diffPrimitiveExpression l r@(BytesLit {}) =
1192+
mismatch l r
11721193
diffPrimitiveExpression Natural Natural =
11731194
"…"
11741195
diffPrimitiveExpression l@Natural r =

‎dhall/src/Dhall/Eval.hs

+20
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,7 @@ module Dhall.Eval (
4949
) where
5050

5151
import Data.Bifunctor (first)
52+
import Data.ByteString (ByteString)
5253
import Data.Foldable (foldr', toList)
5354
import Data.List.NonEmpty (NonEmpty (..))
5455
import Data.Sequence (Seq, ViewL (..), ViewR (..))
@@ -170,6 +171,9 @@ data Val a
170171
| VBoolNE !(Val a) !(Val a)
171172
| VBoolIf !(Val a) !(Val a) !(Val a)
172173

174+
| VBytes
175+
| VBytesLit ByteString
176+
173177
| VNatural
174178
| VNaturalLit !Natural
175179
| VNaturalFold !(Val a) !(Val a) !(Val a) !(Val a)
@@ -490,6 +494,10 @@ eval !env t0 =
490494
(b', VBoolLit True, VBoolLit False) -> b'
491495
(_, t', f') | conv env t' f' -> t'
492496
(b', t', f') -> VBoolIf b' t' f'
497+
Bytes ->
498+
VBytes
499+
BytesLit b ->
500+
VBytesLit b
493501
Natural ->
494502
VNatural
495503
NaturalLit n ->
@@ -940,6 +948,10 @@ conv !env t0 t0' =
940948
conv env t t' && conv env u u'
941949
(VBoolIf t u v, VBoolIf t' u' v') ->
942950
conv env t t' && conv env u u' && conv env v v'
951+
(VBytes, VBytes) ->
952+
True
953+
(VBytesLit l, VBytesLit r) ->
954+
l == r
943955
(VNatural, VNatural) ->
944956
True
945957
(VNaturalLit n, VNaturalLit n') ->
@@ -1152,6 +1164,10 @@ quote !env !t0 =
11521164
BoolNE (quote env t) (quote env u)
11531165
VBoolIf t u v ->
11541166
BoolIf (quote env t) (quote env u) (quote env v)
1167+
VBytes ->
1168+
Bytes
1169+
VBytesLit b ->
1170+
BytesLit b
11551171
VNatural ->
11561172
Natural
11571173
VNaturalLit n ->
@@ -1351,6 +1367,10 @@ alphaNormalize = goEnv EmptyNames
13511367
BoolNE (go t) (go u)
13521368
BoolIf b t f ->
13531369
BoolIf (go b) (go t) (go f)
1370+
Bytes ->
1371+
Bytes
1372+
BytesLit b ->
1373+
BytesLit b
13541374
Natural ->
13551375
Natural
13561376
NaturalLit n ->

0 commit comments

Comments
 (0)