dhall 1.1.0 → 1.2.0

raw patch · 7 files changed

+513/−216 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +98/−0
• dhall.cabal +1/−1
• src/Dhall.hs +77/−38
• src/Dhall/Core.hs +45/−13
• src/Dhall/Import.hs +183/−87
• src/Dhall/Parser.hs +103/−77
• src/Dhall/Tutorial.hs +6/−0

@@ -1,3 +1,101 @@+1.2.0++* BREAKING CHANGE: Add support for customizing derived `Interpret` instances+    * This is a breaking change to the Dhall library API since this changes the+      signature of the `Interpret` class by replacing the `auto` method with a+      more general `autoWith` method.  This `autoWith` now takes an+      `InterpretOptions` argument that lets you customize derived field and+      constuctor names+    * In practice user programs that use the common path will be unaffected by+      this change+    * This is not a breaking change to the Dhall language+* BREAKING CHANGE: Type annotations now bind more tightly than lambda+  abstraction+    * This is a breaking change to the Dhall language.  An expression like this:++      ```+      λ(x : A) → y : B+      ```++      ... used to parenthesized implicitly as:++      ```+      (λ(x : A) → y) : T+      ```++      ... but is now parenthesized implicitly as:++      ```+      λ(x : A) → (y : T)+      ```++      This is now consistent with Haskell's precedence and also consistent with+      the precedence of `List` and `Optional` type annotations++    * This change affects programs with an expression like this:++      ```+      -- Assuming that `y : B`+      λ(x : A) → y : A → B+      ```++      The above program would type-check before this change but not type-check+      after this change.  You would you need to fix the above program by either+      changing the type signature to annotate just the type of `y` like this:++      ```+      λ(x : A) → y : B+      ```++      ... or by adding explicit parentheses like this:++      ```+      (λ(x : A) → y) : A → B+      ```++    * This is not a breaking change to the Dhall library API+* BREAKING CHANGE: Add support for importing a path's contents as raw `Text` by+  adding `as Text` after the import+    * This is a breaking change to the Dhall language+    * This is technically a breaking change, but is extremely unlikely to affect+      you program.  This only changes the behavior of old programs that had an+      expression of the form:++      ```+      /some/imported/function as Text+      ```++      ... where `/some/imported/function` is an imported function being applied+      to two arguments, the first of which is a bound variable named `as` and+      the second of which is the type `Text`+    * This is not a breaking change to the Dhall library API+* BREAKING CHANGE: Add support for importing environment variables using+  `env:VAR` syntax+    * This is a breaking change to the Dhall library API since it adds a new+      `Path` constructor+    * This also technically a breaking change to the Dhall language but+      extremely unlikely to affect your program.  This only changes the behavior+      of old programs that had an expression of the form:++      ```+      env:VAR+      ```++      ... where `env` was the name of a bound variable and `:VAR` was a type+      annotation without spaces around the type annotation operator++      After this change the program would be interpreted as an import of the+      contents for the environment variable named `VAR`+* BREAKING CHANGE: Support importing paths relative to home directory using+  `~/some/path` syntax+    * This is a breaking change to the Dhall library API since it adds a new+      field to the `File` constructor indicating whether or not the imported+      path is relative to the home directory+    * This is not a breaking change to the Dhall language and the new syntax+      does not override any old syntax+* Permit trailing commas and bars in record/union syntax+* Improve location information for parsing errors+ 1.1.0  * BREAKING CHANGE: Non-empty lists no longer require a type annotation

@@ -1,5 +1,5 @@ Name: dhall-Version: 1.1.0+Version: 1.2.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple Tested-With: GHC == 7.10.2, GHC == 8.0.1

@@ -22,6 +22,9 @@     , Type     , Interpret(..)     , InvalidType(..)+    , auto+    , InterpretOptions(..)+    , defaultInterpretOptions     , bool     , natural     , integer@@ -29,6 +32,7 @@     , text     , maybe     , vector+    , GenericInterpret(..)      -- * Re-exports     , Natural@@ -379,46 +383,80 @@     types. -} class Interpret a where-    auto :: Type a-    default auto :: (Generic a, GenericInterpret (Rep a)) => Type a-    auto = fmap GHC.Generics.to genericAuto+    autoWith:: InterpretOptions -> Type a+    default autoWith+        :: (Generic a, GenericInterpret (Rep a)) => InterpretOptions -> Type a+    autoWith options = fmap GHC.Generics.to (genericAutoWith options)  instance Interpret Bool where-    auto = bool+    autoWith _ = bool  instance Interpret Natural where-    auto = natural+    autoWith _ = natural  instance Interpret Integer where-    auto = integer+    autoWith _ = integer  instance Interpret Double where-    auto = double+    autoWith _ = double  instance Interpret Text where-    auto = text+    autoWith _ = text  instance Interpret a => Interpret (Maybe a) where-    auto = maybe auto+    autoWith opts = maybe (autoWith opts)  instance Interpret a => Interpret (Vector a) where-    auto = vector auto+    autoWith opts = vector (autoWith opts) +{-| Use the default options for interpreting a configuration file++> auto = autoWith defaultInterpretOptions+-}+auto :: Interpret a => Type a+auto = autoWith defaultInterpretOptions++{-| Use these options to tweak how Dhall derives a generic implementation of+    `Interpret`+-}+data InterpretOptions = InterpretOptions+    { fieldModifier       :: Text -> Text+    -- ^ Function used to transform Haskell field names into their corresponding+    --   Dhall field names+    , constructorModifier :: Text -> Text+    -- ^ Function used to transform Haskell constructor names into their+    --   corresponding Dhall alternative names+    }++{-| Default interpret options, which you can tweak or override, like this:++> autoWith+>     (defaultInterpretOptions { fieldModifier = Data.Text.Lazy.dropWhile (== '_') })+-}+defaultInterpretOptions :: InterpretOptions+defaultInterpretOptions = InterpretOptions+    { fieldModifier       = id+    , constructorModifier = id+    }++{-| This is the underlying class that powers the `Interpret` class's support+    for automatically deriving a generic implementation+-} class GenericInterpret f where-    genericAuto :: Type (f a)+    genericAutoWith :: InterpretOptions -> Type (f a)  instance GenericInterpret f => GenericInterpret (M1 D d f) where-    genericAuto = fmap M1 genericAuto+    genericAutoWith = fmap (fmap M1) genericAutoWith  instance GenericInterpret V1 where-    genericAuto = Type {..}+    genericAutoWith _ = Type {..}       where         extract _ = Nothing          expected = Union Data.Map.empty  instance (Constructor c1, Constructor c2, GenericInterpret f1, GenericInterpret f2) => GenericInterpret (M1 C c1 f1 :+: M1 C c2 f2) where-    genericAuto = Type {..}+    genericAutoWith options@(InterpretOptions {..}) = Type {..}       where         nL :: M1 i c1 f1 a         nL = undefined@@ -426,8 +464,8 @@         nR :: M1 i c2 f2 a         nR = undefined -        nameL = Data.Text.Lazy.pack (conName nL)-        nameR = Data.Text.Lazy.pack (conName nR)+        nameL = constructorModifier (Data.Text.Lazy.pack (conName nL))+        nameR = constructorModifier (Data.Text.Lazy.pack (conName nR))          extract (UnionLit name e _)             | name == nameL = fmap (L1 . M1) (extractL e)@@ -438,16 +476,16 @@         expected =             Union (Data.Map.fromList [(nameL, expectedL), (nameR, expectedR)]) -        Type extractL expectedL = genericAuto-        Type extractR expectedR = genericAuto+        Type extractL expectedL = genericAutoWith options+        Type extractR expectedR = genericAutoWith options  instance (Constructor c, GenericInterpret (f :+: g), GenericInterpret h) => GenericInterpret ((f :+: g) :+: M1 C c h) where-    genericAuto = Type {..}+    genericAutoWith options@(InterpretOptions {..}) = Type {..}       where         n :: M1 i c h a         n = undefined -        name = Data.Text.Lazy.pack (conName n)+        name = constructorModifier (Data.Text.Lazy.pack (conName n))          extract u@(UnionLit name' e _)             | name == name' = fmap (R1 . M1) (extractR e)@@ -456,16 +494,16 @@          expected = Union (Data.Map.insert name expectedR expectedL) -        Type extractL (Union expectedL) = genericAuto-        Type extractR        expectedR  = genericAuto+        Type extractL (Union expectedL) = genericAutoWith options+        Type extractR        expectedR  = genericAutoWith options  instance (Constructor c, GenericInterpret f, GenericInterpret (g :+: h)) => GenericInterpret (M1 C c f :+: (g :+: h)) where-    genericAuto = Type {..}+    genericAutoWith options@(InterpretOptions {..}) = Type {..}       where         n :: M1 i c f a         n = undefined -        name = Data.Text.Lazy.pack (conName n)+        name = constructorModifier (Data.Text.Lazy.pack (conName n))          extract u@(UnionLit name' e _)             | name == name' = fmap (L1 . M1) (extractL e)@@ -474,31 +512,31 @@          expected = Union (Data.Map.insert name expectedL expectedR) -        Type extractL        expectedL  = genericAuto-        Type extractR (Union expectedR) = genericAuto+        Type extractL        expectedL  = genericAutoWith options+        Type extractR (Union expectedR) = genericAutoWith options  instance (GenericInterpret (f :+: g), GenericInterpret (h :+: i)) => GenericInterpret ((f :+: g) :+: (h :+: i)) where-    genericAuto = Type {..}+    genericAutoWith options = Type {..}       where         extract e = fmap L1 (extractL e) <|> fmap R1 (extractR e)          expected = Union (Data.Map.union expectedL expectedR) -        Type extractL (Union expectedL) = genericAuto-        Type extractR (Union expectedR) = genericAuto+        Type extractL (Union expectedL) = genericAutoWith options+        Type extractR (Union expectedR) = genericAutoWith options  instance GenericInterpret f => GenericInterpret (M1 C c f) where-    genericAuto = fmap M1 genericAuto+    genericAutoWith = fmap (fmap M1) genericAutoWith  instance GenericInterpret U1 where-    genericAuto = Type {..}+    genericAutoWith _ = Type {..}       where         extract _ = Just U1          expected = Record (Data.Map.fromList [])  instance (GenericInterpret f, GenericInterpret g) => GenericInterpret (f :*: g) where-    genericAuto = Type {..}+    genericAutoWith options = Type {..}       where         extract = liftA2 (liftA2 (:*:)) extractL extractR @@ -506,11 +544,11 @@           where             Record ktsL = expectedL             Record ktsR = expectedR-        Type extractL expectedL = genericAuto-        Type extractR expectedR = genericAuto+        Type extractL expectedL = genericAutoWith options+        Type extractR expectedR = genericAutoWith options  instance (Selector s, Interpret a) => GenericInterpret (M1 S s (K1 i a)) where-    genericAuto = Type {..}+    genericAutoWith opts@(InterpretOptions {..}) = Type {..}       where         n :: M1 i s f a         n = undefined@@ -519,12 +557,13 @@             case selName n of                 ""   -> Nothing                 name -> do-                    e <- Data.Map.lookup (Data.Text.Lazy.pack name) m+                    let name' = fieldModifier (Data.Text.Lazy.pack name)+                    e <- Data.Map.lookup name' m                     fmap (M1 . K1) (extract' e)         extract  _            = Nothing          expected = Record (Data.Map.fromList [(key, expected')])           where-            key = Data.Text.Lazy.pack (selName n)+            key = fieldModifier (Data.Text.Lazy.pack (selName n)) -        Type extract' expected' = auto+        Type extract' expected' = autoWith opts

@@ -1,11 +1,12 @@-{-# LANGUAGE BangPatterns               #-}-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DeriveFoldable             #-}-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE DeriveTraversable          #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE QuasiQuotes                #-}-{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE DeriveFoldable    #-}+{-# LANGUAGE DeriveFunctor     #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE RankNTypes        #-}+{-# LANGUAGE RecordWildCards   #-} {-# OPTIONS_GHC -Wall #-}  {-| This module contains the core calculus for the Dhall language.@@ -17,6 +18,9 @@ module Dhall.Core (     -- * Syntax       Const(..)+    , HasHome(..)+    , PathType(..)+    , PathMode(..)     , Path(..)     , Var(..)     , Expr(..)@@ -85,14 +89,25 @@ instance Buildable Const where     build = buildConst --- | Path to an external resource-data Path-    = File FilePath+-- | Whether or not a path is relative to the user's home directory+data HasHome = Home | Homeless deriving (Eq, Ord, Show)++-- | The type of path to import (i.e. local vs. remote vs. environment)+data PathType+    = File HasHome FilePath+    -- ^ Local path     | URL  Text+    -- ^ Remote resource+    | Env  Text+    -- ^ Environment variable     deriving (Eq, Ord, Show) -instance Buildable Path where-    build (File file)+instance Buildable PathType where+    build (File Home     file)+        = "~/" <> build txt+      where+        txt = Text.fromStrict (either id id (Filesystem.toText file))+    build (File Homeless file)         |  Text.isPrefixOf  "./" txt         || Text.isPrefixOf   "/" txt         || Text.isPrefixOf "../" txt@@ -102,6 +117,23 @@       where         txt = Text.fromStrict (either id id (Filesystem.toText file))     build (URL  str ) = build str <> " "+    build (Env  env ) = "env:" <> build env++-- | How to interpret the path's contents (i.e. as Dhall code or raw text)+data PathMode = Code | RawText deriving (Eq, Ord, Show)++-- | Path to an external resource+data Path = Path+    { pathType :: PathType+    , pathMode :: PathMode+    } deriving (Eq, Ord, Show)++instance Buildable Path where+    build (Path {..}) = build pathType <> suffix+      where+        suffix = case pathMode of+            RawText -> "as Text"+            Code    -> ""  {-| Label for a bound variable 

@@ -1,6 +1,7 @@ {-# LANGUAGE CPP                #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RecordWildCards    #-} {-# OPTIONS_GHC -Wall #-}  {-| Dhall lets you import external expressions located either in local files or@@ -59,12 +60,47 @@     You can also reuse directory names as expressions.  If you provide a path     to a local or remote directory then the compiler will look for a file named     @\@@ within that directory and use that file to represent the directory.++    You can also import expressions stored within environment variables using+    @env:NAME@, where @NAME@ is the name of the environment variable.  For+    example:++    > $ export FOO=1+    > $ export BAR='"Hi"'+    > $ export BAZ='λ(x : Bool) → x == False'+    > $ dhall <<< "{ foo = env:FOO , bar = env:BAR , baz = env:BAZ }"+    > { bar : Text, baz : ∀(x : Bool) → Bool, foo : Integer }+    > +    > { bar = "Hi", baz = λ(x : Bool) → x == False, foo = 1 }++    If you wish to import the raw contents of a path as @Text@ then add+    @as Text@ to the end of the import:++    > $ dhall <<< "http://example.com as Text"+    > Text+    > +    > "<!doctype html>\n<html>\n<head>\n    <title>Example Domain</title>\n\n    <meta+    >  charset=\"utf-8\" />\n    <meta http-equiv=\"Content-type\" content=\"text/html+    > ; charset=utf-8\" />\n    <meta name=\"viewport\" content=\"width=device-width, +    > initial-scale=1\" />\n    <style type=\"text/css\">\n    body {\n        backgro+    > und-color: #f0f0f2;\n        margin: 0;\n        padding: 0;\n        font-famil+    > y: \"Open Sans\", \"Helvetica Neue\", Helvetica, Arial, sans-serif;\n        \n +    >    }\n    div {\n        width: 600px;\n        margin: 5em auto;\n        paddi+    > ng: 50px;\n        background-color: #fff;\n        border-radius: 1em;\n    }\n+    >     a:link, a:visited {\n        color: #38488f;\n        text-decoration: none;+    > \n    }\n    @media (max-width: 700px) {\n        body {\n            background+    > -color: #fff;\n        }\n        div {\n            width: auto;\n            m+    > argin: 0 auto;\n            border-radius: 0;\n            padding: 1em;\n      +    >   }\n    }\n    </style>    \n</head>\n\n<body>\n<div>\n    <h1>Example Domain</+    > h1>\n    <p>This domain is established to be used for illustrative examples in d+    > ocuments. You may use this\n    domain in examples without prior coordination or+    >  asking for permission.</p>\n    <p><a href=\"http://www.iana.org/domains/exampl+    > e\">More information...</a></p>\n</div>\n</body>\n</html>\n" -}  module Dhall.Import (     -- * Import-      exprFromFile-    , exprFromURL+      exprFromPath     , load     , Cycle(..)     , ReferentiallyOpaque(..)@@ -91,7 +127,8 @@ #endif import Data.Typeable (Typeable) import Filesystem.Path ((</>), FilePath)-import Dhall.Core (Expr, Path(..))+import Dhall.Core+    (Expr(..), HasHome(..), PathMode(..), PathType(..), Path(..)) import Dhall.Parser (Parser(..), ParseError(..), Src) import Dhall.TypeCheck (X(..)) #if MIN_VERSION_http_client(0,5,0)@@ -118,6 +155,7 @@ import qualified Network.HTTP.Client              as HTTP import qualified Network.HTTP.Client.TLS          as HTTP import qualified Filesystem.Path.CurrentOS        as Filesystem+import qualified System.Environment import qualified Text.Parser.Combinators import qualified Text.Parser.Token import qualified Text.Trifecta@@ -248,6 +286,19 @@             "\n"         <>  "\ESC[1;31mError\ESC[0m: Missing file\n" +-- | Exception thrown when an environment variable is missing+newtype MissingEnvironmentVariable = MissingEnvironmentVariable { name :: Text }+    deriving (Typeable)++instance Exception MissingEnvironmentVariable++instance Show MissingEnvironmentVariable where+    show (MissingEnvironmentVariable {..}) =+            "\n"+        <>  "\ESC[1;31mError\ESC[0m: Missing environment variable\n"+        <>  "\n"+        <>  "↳ " <> Text.unpack name+ data Status = Status     { _stack   :: [Path]     , _cache   :: Map Path (Expr Src X)@@ -255,7 +306,7 @@     }  canonicalizeAll :: [Path] -> [Path]-canonicalizeAll = map canonicalize . List.tails+canonicalizeAll = map canonicalizePath . List.tails  stack :: Lens' Status [Path] stack k s = fmap (\x -> s { _stack = x }) (k (_stack s))@@ -302,14 +353,15 @@     `Text` for O(1) access to the end of the string.  The only reason we use     `String` at all is for consistency with the @http-client@ library. -}-canonicalize :: [Path] -> Path-canonicalize  []                 = File "."-canonicalize (File file0:paths0) =-    if Filesystem.relative file0-    then go          file0 paths0-    else File (clean file0)+canonicalize :: [PathType] -> PathType+canonicalize  []                          = File Homeless "."+canonicalize (File hasHome0 file0:paths0) =+    if Filesystem.relative file0 && hasHome0 == Homeless+    then go file0 paths0+    else File hasHome0 (clean file0)   where-    go currPath  []               = File (clean currPath)+    go currPath  []               = File hasHome0 (clean currPath)+    go currPath (Env  _   :_    ) = File hasHome0 (clean currPath)     go currPath (URL  url0:_    ) = combine prefix suffix       where         prefix = parentURL (removeAtFromURL url0)@@ -335,14 +387,27 @@                     path' = Text.fromStrict (case Filesystem.toText path of                         Left  txt -> txt                         Right txt -> txt )-    go currPath (File file:paths) =-        if Filesystem.relative file-        then go          file'  paths-        else File (clean file')+    go currPath (File hasHome file:paths) =+        if Filesystem.relative file && hasHome == Homeless+        then go file' paths+        else File hasHome0 (clean file')       where         file' = Filesystem.parent (removeAtFromFile file) </> currPath canonicalize (URL path:_) = URL path+canonicalize (Env env :_) = Env env +canonicalizePath :: [Path] -> Path+canonicalizePath [] =+    Path+        { pathMode = Code+        , pathType = canonicalize []+        }+canonicalizePath (path:paths) =+    Path+        { pathMode = pathMode path+        , pathType = canonicalize (map pathType (path:paths))+        }+ parentURL :: Text -> Text parentURL = Text.dropWhileEnd (/= '/') @@ -366,85 +431,119 @@         Nothing -> p         Just p' -> p' --- | Parse an expression from a `FilePath` containing a Dhall program-exprFromFile :: FilePath -> IO (Expr Src Path)-exprFromFile path = do-    let string = Filesystem.Path.CurrentOS.encodeString path+-- | Parse an expression from a `Path` containing a Dhall program+exprFromPath :: Manager -> Path -> IO (Expr Src Path)+exprFromPath m (Path {..}) = case pathType of+    File hasHome file -> do+        path <- case hasHome of+            Home -> do+                home <- liftIO Filesystem.getHomeDirectory+                return (home </> file)+            Homeless -> do+                return file -    -- Unfortunately, GHC throws an `InappropriateType` exception when trying to-    -- to read a directory, but does not export the exception, so I must resort-    -- to a more heavy-handed `catch`-    let handler :: IOException -> IO (Result (Expr Src Path))-        handler e = do-            let string' = Filesystem.Path.CurrentOS.encodeString (path </> "@")+        case pathMode of+            Code -> do+                exists <- Filesystem.isFile path+                if exists+                    then return ()+                    else Control.Exception.throwIO MissingFile -            -- If the fallback fails, reuse the original exception to avoid user-            -- confusion-            Text.Trifecta.parseFromFileEx parser string' `onException` throwIO e+                let string = Filesystem.Path.CurrentOS.encodeString path -    exists <- Filesystem.isFile path-    if exists-        then return ()-        else Control.Exception.throwIO MissingFile+                -- Unfortunately, GHC throws an `InappropriateType` exception+                -- when trying to read a directory, but does not export the+                -- exception, so I must resort to a more heavy-handed `catch`+                let handler :: IOException -> IO (Result (Expr Src Path))+                    handler e = do+                        let string' =+                                Filesystem.Path.CurrentOS.encodeString+                                    (path </> "@") -    x <- Text.Trifecta.parseFromFileEx parser string `catch` handler-    case x of-        Failure errInfo -> throwIO (ParseError (Text.Trifecta._errDoc errInfo))-        Success expr    -> return expr-  where-    parser = unParser (do-        Text.Parser.Token.whiteSpace-        r <- Dhall.Parser.expr-        Text.Parser.Combinators.eof-        return r )+                        -- If the fallback fails, reuse the original exception+                        -- to avoid user confusion+                        Text.Trifecta.parseFromFileEx parser string'+                            `onException` throwIO e --- | Parse an expression from a URL hosting a Dhall program-exprFromURL :: Manager -> Text -> IO (Expr Src Path)-exprFromURL m url = do-    request <- HTTP.parseUrlThrow (Text.unpack url)+                x <- Text.Trifecta.parseFromFileEx parser string `catch` handler+                case x of+                    Failure errInfo -> do+                        throwIO (ParseError (Text.Trifecta._errDoc errInfo))+                    Success expr -> do+                        return expr+            RawText -> do+                text <- Filesystem.readTextFile path+                return (TextLit (build text))+    URL url -> do+        request <- HTTP.parseUrlThrow (Text.unpack url) -    let handler :: HTTP.HttpException -> IO (HTTP.Response ByteString)+        let handler :: HTTP.HttpException -> IO (HTTP.Response ByteString) #if MIN_VERSION_http_client(0,5,0)-        handler err@(HttpExceptionRequest _ (StatusCodeException _ _)) = do+            handler err@(HttpExceptionRequest _ (StatusCodeException _ _)) = do #else-        handler err@(StatusCodeException _ _ _) = do+            handler err@(StatusCodeException _ _ _) = do #endif-            let request' = request { HTTP.path = HTTP.path request <> "/@" }-            -- If the fallback fails, reuse the original exception to avoid user-            -- confusion-            HTTP.httpLbs request' m `onException` throwIO (PrettyHttpException err)-        handler err = throwIO (PrettyHttpException err)-    response <- HTTP.httpLbs request m `catch` handler+                let request' = request { HTTP.path = HTTP.path request <> "/@" }+                -- If the fallback fails, reuse the original exception to avoid+                -- user confusion+                HTTP.httpLbs request' m `onException` throwIO (PrettyHttpException err)+            handler err = throwIO (PrettyHttpException err)+        response <- HTTP.httpLbs request m `catch` handler -    let bytes = HTTP.responseBody response+        let bytes = HTTP.responseBody response -    text <- case Data.Text.Lazy.Encoding.decodeUtf8' bytes of-        Left  err  -> throwIO err-        Right text -> return text+        text <- case Data.Text.Lazy.Encoding.decodeUtf8' bytes of+            Left  err  -> throwIO err+            Right text -> return text -    let urlBytes = Data.Text.Lazy.Encoding.encodeUtf8 url-    let delta = Directed (Data.ByteString.Lazy.toStrict urlBytes) 0 0 0 0-    case Text.Trifecta.parseString parser delta (Text.unpack text) of-        Failure err -> do-            -- Also try the fallback in case of a parse error, since the parse-            -- error might signify that this URL points to a directory list-            let err' = ParseError (Text.Trifecta._errDoc err)+        case pathMode of+            Code -> do+                let urlBytes = Data.Text.Lazy.Encoding.encodeUtf8 url+                let delta =+                        Directed (Data.ByteString.Lazy.toStrict urlBytes) 0 0 0 0+                case Text.Trifecta.parseString parser delta (Text.unpack text) of+                    Failure err -> do+                        -- Also try the fallback in case of a parse error, since+                        -- the parse error might signify that this URL points to+                        -- a directory list+                        let err' = ParseError (Text.Trifecta._errDoc err) -            request' <- HTTP.parseUrlThrow (Text.unpack url)+                        request' <- HTTP.parseUrlThrow (Text.unpack url) -            let request'' = request' { HTTP.path = HTTP.path request' <> "/@" }-            response' <- HTTP.httpLbs request'' m `onException` throwIO err'+                        let request'' =+                                request'+                                    { HTTP.path = HTTP.path request' <> "/@" }+                        response' <- HTTP.httpLbs request'' m+                            `onException` throwIO err' -            let bytes' = HTTP.responseBody response'+                        let bytes' = HTTP.responseBody response' -            text' <- case Data.Text.Lazy.Encoding.decodeUtf8' bytes' of-                Left  _     -> throwIO err'-                Right text' -> return text'+                        text' <- case Data.Text.Lazy.Encoding.decodeUtf8' bytes' of+                            Left  _     -> throwIO err'+                            Right text' -> return text' -            case Text.Trifecta.parseString parser delta (Text.unpack text') of-                Failure _    -> throwIO err'-                Success expr -> return expr-        Success expr -> return expr+                        case Text.Trifecta.parseString parser delta (Text.unpack text') of+                            Failure _    -> throwIO err'+                            Success expr -> return expr+                    Success expr -> return expr+            RawText -> do+                return (TextLit (build text))+    Env env -> do+        x <- System.Environment.lookupEnv (Text.unpack env)+        case x of+            Just str -> do+                case pathMode of+                    Code -> do+                        let envBytes = Data.Text.Lazy.Encoding.encodeUtf8 env+                        let delta =+                                Directed (Data.ByteString.Lazy.toStrict envBytes) 0 0 0 0+                        case Text.Trifecta.parseString parser delta str of+                            Failure errInfo -> do+                                throwIO (ParseError (Text.Trifecta._errDoc errInfo))+                            Success expr    -> do+                                return expr+                    RawText -> return (TextLit (build str))+            Nothing  -> throwIO (MissingEnvironmentVariable env)   where     parser = unParser (do         Text.Parser.Token.whiteSpace@@ -463,28 +562,25 @@      let handler :: SomeException -> IO (Expr Src Path)         handler e = throwIO (Imported (p:paths) e)-    case canonicalize (p:paths) of-        File file -> do-            liftIO (exprFromFile file `catch` handler)-        URL  url  -> do-            m <- needManager-            liftIO (exprFromURL m url `catch` handler)+    m <- needManager+    liftIO (exprFromPath m (canonicalizePath (p:paths)) `catch` handler)  -- | Load a `Path` as a \"static\" expression (with all imports resolved) loadStatic :: Path -> StateT Status IO (Expr Src X) loadStatic path = do     paths <- zoom stack State.get -    let local (URL url) = case HTTP.parseUrlThrow (Text.unpack url) of+    let local (Path (URL url ) _) = case HTTP.parseUrlThrow (Text.unpack url) of             Nothing      -> False             Just request -> case HTTP.host request of                 "127.0.0.1" -> True                 "localhost" -> True                 _           -> False-        local (File _)  = True+        local (Path (File _ _) _) = True+        local (Path (Env  _  ) _) = True -    let parent = canonicalize paths-    let here   = canonicalize (path:paths)+    let parent = canonicalizePath paths+    let here   = canonicalizePath (path:paths)      if local here && not (local parent)         then liftIO (throwIO (Imported paths (ReferentiallyOpaque path)))

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}  -- | This module contains Dhall's parsing logic @@ -29,9 +30,8 @@ import Data.Text.Lazy.Builder (Builder) import Data.Typeable (Typeable) import Data.Vector (Vector)-import Dhall.Core (Const(..), Expr(..), Path(..), Var(..))-import Filesystem.Path (FilePath)-import Prelude hiding (FilePath, const, pi)+import Dhall.Core+import Prelude hiding (const, pi) import Text.PrettyPrint.ANSI.Leijen (Doc) import Text.Parser.Combinators (choice, try, (<?>)) import Text.Parser.Token (IdentifierStyle(..), TokenParsing(..))@@ -51,7 +51,6 @@ import qualified Data.Text.Lazy.Builder import qualified Data.Text.Lazy.Encoding import qualified Data.Vector-import qualified Dhall.Core import qualified Filesystem.Path.CurrentOS import qualified Text.Parser.Char import qualified Text.Parser.Combinators@@ -128,6 +127,7 @@         , "if"         , "then"         , "else"+        , "as"         , "Natural"         , "Natural/fold"         , "Natural/build"@@ -183,6 +183,19 @@     _ <- Text.Parser.Token.symbol string     return () +sepBy :: Parser a -> Parser b -> Parser [a]+sepBy p sep = sepBy1 p sep <|> pure []++sepBy1 :: Parser a -> Parser b -> Parser [a]+sepBy1 p sep = do+    a <- p+    b <- optional sep+    case b of+        Nothing -> return [a]+        Just _  -> do+            as <- sepBy p sep+            return (a:as)+ stringLiteral :: Parser Builder stringLiteral = Text.Parser.Token.stringLiteral <|> doubleSingleQuoteString @@ -259,31 +272,16 @@ -- | Parser for a top-level Dhall expression. The expression is parameterized -- over any parseable type, allowing the language to be extended as needed. exprA :: Show a => Parser a -> Parser (Expr Src a)-exprA embedded = noted (do-    a <- exprB embedded--    let exprA0 = do-            symbol ":"-            b <- exprA embedded-            return (Annot a b)--    let exprA1 = pure a--    exprA0 <|> exprA1 )--exprB :: Show a => Parser a -> Parser (Expr Src a)-exprB embedded = choice-    [   noted      exprB0-    ,   noted      exprB1-    ,   noted      exprB3-    ,   noted      exprB5-    ,   noted (try exprB6)-    ,   noted      exprB7-    ,   noted (try exprB2)-    ,              exprB8+exprA embedded = choice+    [   noted      exprA0+    ,   noted      exprA1+    ,   noted      exprA2+    ,   noted      exprA3+    ,   noted (try exprA4)+    ,              exprA5     ]   where-    exprB0 = do+    exprA0 = do         lambda         symbol "("         a <- label@@ -291,25 +289,19 @@         b <- exprA embedded         symbol ")"         arrow-        c <- exprB embedded+        c <- exprA embedded         return (Lam a b c) -    exprB1 = do+    exprA1 = do         reserve "if"         a <- exprA embedded         reserve "then"-        b <- exprB embedded+        b <- exprA embedded         reserve "else"-        c <- exprC embedded+        c <- exprA embedded         return (BoolIf a b c) -    exprB2 = do-        a <- exprC embedded-        arrow-        b <- exprB embedded-        return (Pi "_" a b)--    exprB3 = do+    exprA2 = do         pi         symbol "("         a <- label@@ -317,10 +309,10 @@         b <- exprA embedded         symbol ")"         arrow-        c <- exprB embedded+        c <- exprA embedded         return (Pi a b c) -    exprB5 = do+    exprA3 = do         reserve "let"         a <- label         b <- optional (do@@ -329,10 +321,33 @@         symbol "="         c <- exprA embedded         reserve "in"-        d <- exprB embedded+        d <- exprA embedded         return (Let a b c d) -    exprB6 = do+    exprA4 = do+        a <- exprC embedded+        arrow+        b <- exprA embedded+        return (Pi "_" a b)++    exprA5 = exprB embedded++exprB :: Show a => Parser a -> Parser (Expr Src a)+exprB embedded = choice+    [   noted      exprB0+    ,   noted (try exprB1)+    ,   noted      exprB2+    ]+  where+    exprB0 = do+        reserve "merge"+        a <- exprE embedded+        b <- exprE embedded+        symbol ":"+        c <- exprD embedded+        return (Merge a b c)++    exprB1 = do         symbol "["         a <- elems embedded         symbol "]"@@ -341,16 +356,18 @@         c <- exprE embedded         return (b c a) -    exprB7 = do-        reserve "merge"-        a <- exprE embedded-        b <- exprE embedded-        symbol ":"-        c <- exprD embedded-        return (Merge a b c)+    exprB2 = do+        a <- exprC embedded -    exprB8 = exprC embedded+        let exprB2A= do+                symbol ":"+                b <- exprA embedded+                return (Annot a b) +        let exprB2B = pure a++        exprB2A <|> exprB2B+ listLike :: Parser (Expr Src a -> Vector (Expr Src a) -> Expr Src a) listLike =     (   listLike0@@ -391,12 +408,13 @@ --   arguments exprD :: Show a => Parser a -> Parser (Expr Src a) exprD embedded = do-    es <- some (noted (try (exprE embedded)))+    e  <- noted (exprE embedded)+    es <- many (noted (try (exprE embedded)))     let app nL@(Note (Src before _ bytesL) _) nR@(Note (Src _ after bytesR) _) =             Note (Src before after (bytesL <> bytesR)) (App nL nR)         app _ _ = Dhall.Core.internalError             ("Dhall.Parser.exprD: foldl1 app (" <> Data.Text.pack (show es) <> ")")-    return (Data.List.foldl1 app es)+    return (Data.List.foldl1 app (e:es))  exprE :: Show a => Parser a -> Parser (Expr Src a) exprE embedded = noted (do@@ -609,7 +627,7 @@  elems :: Show a => Parser a -> Parser (Vector (Expr Src a)) elems embedded = do-    a <- Text.Parser.Combinators.sepBy (exprA embedded) (symbol ",")+    a <- sepBy (exprA embedded) (symbol ",")     return (Data.Vector.fromList a)  recordLit :: Show a => Parser a -> Parser (Expr Src a)@@ -629,8 +647,7 @@         return (RecordLit b)  fieldValues :: Show a => Parser a -> Parser [(Text, Expr Src a)]-fieldValues embedded =-    Text.Parser.Combinators.sepBy1 (fieldValue embedded) (symbol ",")+fieldValues embedded = sepBy1 (fieldValue embedded) (symbol ",")  fieldValue :: Show a => Parser a -> Parser (Text, Expr Src a) fieldValue embedded = do@@ -648,8 +665,7 @@     return (Record b)  fieldTypes :: Show a => Parser a -> Parser [(Text, Expr Src a)]-fieldTypes embedded =-    Text.Parser.Combinators.sepBy (fieldType embedded) (symbol ",")+fieldTypes embedded = sepBy (fieldType embedded) (symbol ",")  fieldType :: Show a => Parser a -> Parser (Text, Expr Src a) fieldType embedded = do@@ -667,8 +683,7 @@     return (Union b)  alternativeTypes :: Show a => Parser a -> Parser [(Text, Expr Src a)]-alternativeTypes embedded =-    Text.Parser.Combinators.sepBy (alternativeType embedded) (symbol "|")+alternativeTypes embedded = sepBy (alternativeType embedded) (symbol "|")  alternativeType :: Show a => Parser a -> Parser (Text, Expr Src a) alternativeType embedded = do@@ -710,22 +725,20 @@  import_ :: Parser Path import_ = do-    a <- import0 <|> import1+    pathType <- file <|> url <|> env     Text.Parser.Token.whiteSpace-    return a-  where-    import0 = do-        a <- file-        return (File a)--    import1 = do-        a <- url-        return (URL a)+    let rawText = do+            _ <- reserve "as"+            _ <- reserve "Text"+            return RawText+    pathMode <- rawText <|> pure Code+    return (Path {..}) -file :: Parser FilePath+file :: Parser PathType file =  try (token file0)     <|>      token file1     <|>      token file2+    <|>      token file3   where     file0 = do         a <- Text.Parser.Char.string "/"@@ -733,37 +746,50 @@         case b of             '\\':_ -> empty -- So that "/\" parses as the operator and not a path             _      -> return ()-        return (Filesystem.Path.CurrentOS.decodeString (a <> b))+        return (File Homeless (Filesystem.Path.CurrentOS.decodeString (a <> b)))      file1 = do         a <- Text.Parser.Char.string "./"         b <- many (Text.Parser.Char.satisfy (not . Data.Char.isSpace))-        return (Filesystem.Path.CurrentOS.decodeString (a <> b))+        return (File Homeless (Filesystem.Path.CurrentOS.decodeString (a <> b)))      file2 = do         a <- Text.Parser.Char.string "../"         b <- many (Text.Parser.Char.satisfy (not . Data.Char.isSpace))-        return (Filesystem.Path.CurrentOS.decodeString (a <> b))+        return (File Homeless (Filesystem.Path.CurrentOS.decodeString (a <> b))) -url :: Parser Text+    file3 = do+        _ <- Text.Parser.Char.string "~"+        _ <- some (Text.Parser.Char.string "/")+        b <- many (Text.Parser.Char.satisfy (not . Data.Char.isSpace))+        return (File Home (Filesystem.Path.CurrentOS.decodeString b))++url :: Parser PathType url =   try url0     <|> url1   where     url0 = do         a <- Text.Parser.Char.string "https://"         b <- many (Text.Parser.Char.satisfy (not . Data.Char.isSpace))-        return (Data.Text.Lazy.pack (a <> b))+        return (URL (Data.Text.Lazy.pack (a <> b)))      url1 = do         a <- Text.Parser.Char.string "http://"         b <- many (Text.Parser.Char.satisfy (not . Data.Char.isSpace))-        return (Data.Text.Lazy.pack (a <> b))+        return (URL (Data.Text.Lazy.pack (a <> b))) +env :: Parser PathType+env = do+    _ <- Text.Parser.Char.string "env:"+    a <- many (Text.Parser.Char.satisfy (not . Data.Char.isSpace))+    return (Env (Data.Text.Lazy.pack a))+ -- | A parsing error newtype ParseError = ParseError Doc deriving (Typeable)  instance Show ParseError where-    show (ParseError doc) = show doc+    show (ParseError doc) =+      "\n\ESC[1;31mError\ESC[0m: Invalid input\n\n" <> show doc  instance Exception ParseError 

@@ -417,6 +417,12 @@ -- Dhall expression anywhere that you can host UTF8-encoded text on the web, such -- as Github, a pastebin, or your own web server. --+-- You can also import Dhall expressions from environment variables, too:+--+-- > >>> System.Environment.setEnv "FOO" "1"+-- > >>> input auto "env:FOO" :: IO Integer+-- > 1+-- -- You can import types, too.  For example, we can change our @./bar@ file to: -- -- > $ echo "[3.0, 4.0, 5.0] : List ./type" > ./bar