Binding docs + combinators for 1.26 (#1291)

* Add a haddock to explain the various `Binding` fields.

* Add combinators to make dealing with `Binding` less awkward.

With all of the source information flying around, manually
deconstructing and reconstructing `Binding`s is a pain. These
combinators cover some very common cases.

* Use `bindingExprs` to simplify `subExpressions`.

* Use bindingExprs and chunkExprs to simplify another traversal.

dhall/src/Dhall/Core.hs

@@ -57,12 +57,14 @@ module Dhall.Core (
     -- * Optics
     , subExpressions
     , chunkExprs
+    , bindingExprs
 
     -- * Let-blocks
     , multiLet
     , wrapInLets
     , MultiLet(..)
     , Binding(..)
+    , makeBinding
 
     -- * Miscellaneous
     , internalError
@@ -2176,12 +2178,7 @@ subExpressions _ (Var v) = pure (Var v)
 subExpressions f (Lam a b c) = Lam a <$> f b <*> f c
 subExpressions f (Pi a b c) = Pi a <$> f b <*> f c
 subExpressions f (App a b) = App <$> f a <*> f b
-subExpressions f (Let a b) = Let <$> adapt0 a <*> f b
-  where
-    adapt0 (Binding src0 c src1 d src2 e) =
-        Binding <$> pure src0 <*> pure c <*> pure src1 <*> traverse adapt1 d <*> pure src2 <*> f e
-
-    adapt1 (src2, g) = (,) <$> pure src2 <*> f g
+subExpressions f (Let a b) = Let <$> bindingExprs f a <*> f b
 subExpressions f (Annot a b) = Annot <$> f a <*> f b
 subExpressions _ Bool = pure Bool
 subExpressions _ (BoolLit b) = pure (BoolLit b)
@@ -2336,6 +2333,19 @@ wrapInLets bs e = foldr Let e bs
 
 data MultiLet s a = MultiLet (NonEmpty (Binding s a)) (Expr s a)
 
+{- | Record the binding part of a @let@ expression.
+
+For example,
+> let {- A -} x {- B -} : {- C -} Bool = {- D -} True in x
+will be instantiated as follows:
+
+* @bindingSrc0@ corresponds to the @A@ comment.
+* @variable@ is @"x"@
+* @bindingSrc1@ corresponds to the @B@ comment.
+* @annotation@ is 'Just' a pair, corresponding to the @C@ comment and @Bool@.
+* @bindingSrc2@ corresponds to the @D@ comment.
+* @value@ corresponds to @True@.
+-}
 data Binding s a = Binding
     { bindingSrc0 :: Maybe s
     , variable    :: Text
@@ -2352,3 +2362,23 @@ instance Bifunctor Binding where
         adapt0 (src3, d) = (fmap k src3, first k d)
 
     second = fmap
+
+{-| Traverse over the immediate 'Expr' children in a 'Binding'.
+-}
+bindingExprs
+  :: (Applicative f)
+  => (Expr s a -> f (Expr s b))
+  -> Binding s a -> f (Binding s b)
+bindingExprs f (Binding s0 n s1 t s2 v) =
+  Binding
+    <$> pure s0
+    <*> pure n
+    <*> pure s1
+    <*> traverse (traverse f) t
+    <*> pure s2
+    <*> f v
+
+{-| Construct a 'Binding' with no source information and no type annotation.
+-}
+makeBinding :: Text -> Expr s a -> Binding s a
+makeBinding name = Binding Nothing name Nothing Nothing Nothing

dhall/src/Dhall/Import.hs

@@ -158,8 +158,7 @@ import Data.Typeable (Typeable)
 import System.FilePath ((</>))
 import Dhall.Binary (StandardVersion(..))
 import Dhall.Core
-    ( Binding(..)
-    , Expr(..)
+    ( Expr(..)
     , Chunks(..)
     , Directory(..)
     , File(..)
@@ -169,6 +168,8 @@ import Dhall.Core
     , ImportMode(..)
     , Import(..)
     , URL(..)
+    , bindingExprs
+    , chunkExprs
     )
 #ifdef MIN_VERSION_http_client
 import Network.HTTP.Client (Manager)
@@ -906,13 +907,7 @@ loadWith expr₀ = case expr₀ of
   Lam a b c            -> Lam <$> pure a <*> loadWith b <*> loadWith c
   Pi a b c             -> Pi <$> pure a <*> loadWith b <*> loadWith c
   App a b              -> App <$> loadWith a <*> loadWith b
-  Let a b              -> Let <$> adapt0 a <*> loadWith b
-    where
-      adapt0 (Binding src0 c src1 d src2 e) =
-          Binding <$> pure src0 <*> pure c <*> pure src1 <*> traverse adapt1 d <*> pure src2 <*> loadWith e
-
-      adapt1 (src3, f) =
-          (,) <$> pure src3 <*> loadWith f
+  Let a b              -> Let <$> bindingExprs loadWith a <*> loadWith b
   Annot a b            -> Annot <$> loadWith a <*> loadWith b
   Bool                 -> pure Bool
   BoolLit a            -> pure (BoolLit a)
@@ -941,7 +936,7 @@ loadWith expr₀ = case expr₀ of
   DoubleLit a          -> pure (DoubleLit a)
   DoubleShow           -> pure DoubleShow
   Text                 -> pure Text
-  TextLit (Chunks a b) -> fmap TextLit (Chunks <$> mapM (mapM loadWith) a <*> pure b)
+  TextLit chunks       -> TextLit <$> chunkExprs loadWith chunks
   TextAppend a b       -> TextAppend <$> loadWith a <*> loadWith b
   TextShow             -> pure TextShow
   List                 -> pure List