Add tags subcommand (#1398)

Fixes #370.

dhall/CHANGELOG.md

@@ -1,3 +1,7 @@
+Next release
+
+* Add `dhall tags` command that build tags file in [ETags](https://en.wikipedia.org/wiki/Ctags#Etags_2) format. Allow to index file or directory.
+
 1.26.1
 
 * TECHNICALLY BREAKING CHANGES: [Simplify `⫽` within projection](https://github.com/dhall-lang/dhall-haskell/pull/1283) / [Simplify nested record projections](https://github.com/dhall-lang/dhall-haskell/pull/1307)

dhall/dhall.cabal

@@ -367,6 +367,8 @@ Extra-Source-Files:
     tests/lint/success/*.dhall
     tests/diff/*.dhall
     tests/diff/*.txt
+    tests/etags/*.dhall
+    tests/etags/*.tags
     tests/recursive/*.dhall
     tests/regression/*.dhall
     tests/tutorial/*.dhall
@@ -485,6 +487,7 @@ Library
         Dhall.Core,
         Dhall.Crypto,
         Dhall.Diff,
+        Dhall.ETags,
         Dhall.Format,
         Dhall.Freeze,
         Dhall.Hash,
@@ -538,6 +541,7 @@ Test-Suite tasty
     Other-Modules:
         Dhall.Test.Dhall
         Dhall.Test.Diff
+        Dhall.Test.ETags
         Dhall.Test.Format
         Dhall.Test.Import
         Dhall.Test.Lint

dhall/doctest/Main.hs

@@ -32,4 +32,5 @@ main = do
             , prefix </> "src/Dhall.hs"
             , prefix </> "src/Dhall/Import.hs"
             , prefix </> "src/Dhall/Tutorial.hs"
+            , prefix </> "src/Dhall/ETags.hs"
             ]

dhall/src/Dhall/ETags.hs

@@ -0,0 +1,280 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+
+-- | This module contains the implementation of the @dhall tags@ command
+
+module Dhall.ETags
+    ( -- * ETags
+      generate
+    ) where
+
+import Control.Exception (handle, SomeException(..))
+import Data.List (isSuffixOf)
+import Data.Maybe (fromMaybe)
+import Data.Semigroup (Semigroup(..))
+import Dhall.Map (foldMapWithKey)
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Dhall.Util (Input(..))
+import Dhall.Core (Expr(..), Binding(..))
+import Dhall.Src (Src(srcStart))
+import Dhall.Parser (exprFromText)
+import System.FilePath ((</>), takeFileName)
+import Text.Megaparsec (sourceLine, sourceColumn, unPos)
+
+import qualified Data.ByteString as BS (length)
+import qualified Data.Map      as M
+import qualified Data.Text     as T
+import qualified Data.Text.IO  as TIO
+import qualified System.Directory as SD
+
+{- 
+    Documentation for ETags format is not very informative and not very correct.
+    You can find some documentation here:
+    https://en.wikipedia.org/wiki/Ctags#Etags_2
+    and you can also check the source code here:
+    http://cvs.savannah.gnu.org/viewvc/vtags/vtags/vtags.el?view=markup
+-}
+
+data LineColumn = LC 
+    { lcLine :: Int
+      -- ^ line number, starting from 1, where to find the tag
+    , lcColumn :: Int
+      -- ^ column of line where tag is
+    } deriving (Eq, Ord, Show)
+
+data LineOffset = LO 
+    { loLine :: Int
+      -- ^ line number, starting from 1, where to find the tag
+    , loOffset :: Int
+      -- ^ byte offset from start of file. Not sure if any editor uses it
+    } deriving (Eq, Ord, Show)
+
+newtype Tags = Tags (M.Map FilePath [(LineOffset, Tag)])
+
+instance Semigroup Tags where
+    (Tags ts1) <> (Tags ts2) = Tags (M.unionWith (<>) ts1 ts2)
+
+instance Monoid Tags where
+    mempty = Tags M.empty
+    mappend = (<>)
+
+{-| For example, for the line: @let foo = \"foo\"@ the tag is:
+    > Tag "let " "foo"
+-}
+data Tag = Tag
+    { tagPattern :: Text
+      -- ^ In vtags source code this field is named \"pattern\" and EMacs used it as
+      --   a regex pattern to locate line with tag. It's looking for ^<tag pattern>.
+      --   Looks like vi is not using it.
+    , tagName :: Text
+      -- ^ text, that editor compare with selected text. So it's really name of entity
+    } deriving (Show)
+
+type LineNumber = Int
+
+type ByteOffset = Int
+
+{-| Generate ETags for Dhall expressions
+-}
+generate
+    :: Input
+    -- ^ Where to look for files. This can be a directory name (@.@ for example),
+    --   a file name or `StandardInput`. If `StandardInput`, then this will wait for
+    --   file names from @STDIN@.
+    --   This way someone can combine tools in @bash@ to send, for example, output from
+    --   @find@ to the input of @dhall tags@.
+    -> Maybe [Text]
+    -- ^ List of suffixes for dhall files or Nothing to check all files
+    -> Bool
+    -- ^ Flag if `generate` should follow symlinks
+    -> IO Text
+    -- ^ Content for tags file
+generate inp sxs followSyms = do
+    files <- inputToFiles followSyms (map T.unpack <$> sxs) inp
+    tags <- traverse (\f -> handle (\(SomeException _) -> return mempty)
+                                   (fileTags f <$> TIO.readFile f)) files
+    return (showTags . mconcat $ tags)
+
+{-| Find tags in Text (second argument) and generates a list of them
+    To make tags for filenames that works in both emacs and vi, add two initial tags.
+    First for @filename@ for vi and second with @/filename@ for emacs.
+    Other tags are working for both.
+-}
+fileTags :: FilePath -> Text -> Tags
+fileTags f t = Tags (M.singleton f
+                    (initialMap <> getTagsFromText t))
+    where initialViTag = (LO 1 1, Tag "" (T.pack . takeFileName $ f))
+          initialEmacsTag = (LO 1 1, Tag "" ("/" <> (T.pack . takeFileName) f))
+          initialMap = [initialViTag, initialEmacsTag]
+
+getTagsFromText :: Text -> [(LineOffset, Tag)]
+getTagsFromText t = case exprFromText "" t of
+    Right expr -> fixPosAndDefinition t (getTagsFromExpr expr)
+    _ -> mempty
+
+{-| Used to update tag position and to build tag from term.
+    After getTagsFromExpr line and column in line are in `LineColumn` for each tag.
+    And tagPattern is not added.
+    Emacs use tag pattern to check if tag is on line. It compares line from start
+    with tag pattern and in case they are the same, relocate user.
+    fixPosAndDefinition change position to line and byte offset (`LineOffset`) and
+    add tag pattern. For example, for Dhall string:
+
+    >>> let dhallSource = "let foo = \"bar\"\nlet baz = \"qux\""
+
+    Input for this function is:
+
+    >>> foundTerms = [(LC 1 4, "foo"), (LC 2 4, "baz")]
+
+    And:
+
+    >>> fixPosAndDefinition dhallSource foundTerms
+    [(LO {loLine = 1, loOffset = 5},Tag {tagPattern = "let foo ", tagName = "foo"}),(LO {loLine = 2, loOffset = 21},Tag {tagPattern = "let baz ", tagName = "baz"})]
+
+    where 21 is byte offset from file start.
+-}
+fixPosAndDefinition :: Text -> [(LineColumn, Text)] -> [(LineOffset, Tag)]
+fixPosAndDefinition t = foldMap (\(LC ln c, term) ->
+             let (ln', offset, tPattern) = fromMaybe (fallbackInfoForText ln c)
+                                                     (infoForText term ln)
+             in [(LO ln' offset, Tag tPattern term)])
+    where mls :: M.Map Int (Text, Int) 
+          -- ^ mls is map that for each line has length of file before this map and line content.
+          --   In example above, first line is 15 bytes long and '\n', mls contain:
+          --   (1, (16, "let foo = "bar"")
+          --   That allow us to get byte offset easier.
+          mls = M.fromList . fst . foldl processLine ([], 0) . zip [1..] $ T.lines t
+
+          {-| processLine is a worker for `foldl` that generates the list of lines with
+              byte offsets from the start of the first line from a list of lines
+          -}
+          processLine
+              :: ([(LineNumber, (Text, ByteOffset))], ByteOffset)
+              -- ^ previous result and byte offset for the start of current line
+              -> (LineNumber, Text)
+              -> ([(LineNumber, (Text, ByteOffset))], ByteOffset)
+              -- ^ next result, where new line was added and byte offset for next line
+          processLine (numberedLinesWithSizes, bytesBeforeLine) (n, line) =
+              ((n, (line, bytesBeforeLine)): numberedLinesWithSizes, bytesBeforeNextLine)
+              where bytesBeforeNextLine = bytesBeforeLine + lengthInBytes line + 1
+
+          lineFromMap ln = fromMaybe ("", 0) (ln `M.lookup` mls)
+
+          lengthInBytes = BS.length . encodeUtf8
+
+          {-| get information about term from map of lines
+              In most cases, `LineColumn` after `getTagsFromExpr` points to byte before term.
+              It's better to have term in term pattern, so this function finds and updates
+              line number and byte offset and generate pattern.
+          -} 
+          infoForText
+              :: Text
+              -- ^ term to find
+              -> Int
+              -- ^ line where to start
+              -> Maybe (Int, Int, Text)
+              -- ^ (Line number, byte offset, pattern to find term in file)
+          infoForText term ln
+              | ln <= 0 = Nothing
+              | T.null part2 = infoForText term (ln - 1)
+              | otherwise = Just (ln, lsl + 1 + lengthInBytes part1, part1 <> termAndNext)
+              where (l, lsl) = lineFromMap ln
+                    (part1, part2) = T.breakOn term l
+                    termAndNext = T.take (T.length term + 1) part2
+
+          fallbackInfoForText ln c = (ln, lsl + 1 + lengthInBytes pat, pat)
+              where (l, lsl) = lineFromMap ln
+                    pat = T.take c l
+
+getTagsFromExpr :: Expr Src a -> [(LineColumn, Text)]
+getTagsFromExpr = go (LC 0 0) []
+    where go lpos mts = \case
+              (Let b e) -> go lpos (mts <> parseBinding lpos b) e
+              (Annot e1 e2) -> go lpos (go lpos mts e1) e2
+              (Record mr) -> mts <> tagsFromDhallMap lpos mr
+              (RecordLit mr) -> mts <> tagsFromDhallMap lpos mr
+              (Union mmr) -> mts <> tagsFromDhallMapMaybe lpos mmr
+              (Note s e) -> go (srcToLineColumn s) mts e
+              _ -> mts
+
+          tagsFromDhallMap lpos = foldMapWithKey (tagsFromDhallMapElement lpos)
+
+          tagsFromDhallMapMaybe lpos = foldMapWithKey (\k -> \case
+              Just e -> tagsFromDhallMapElement lpos k e
+              _ -> [(lpos, k)])
+
+          tagsFromDhallMapElement lpos k e = go pos [(pos, k)] e
+              where pos = firstPosFromExpr lpos e
+
+          parseBinding :: LineColumn -> Binding Src a -> [(LineColumn, Text)]
+          parseBinding lpos b = go p2 [(p0, variable b)] (value b)
+              where p0 = posFromBinding (bindingSrc0 b) lpos
+                    p1 = posFromBinding (bindingSrc1 b) p0
+                    p2 = posFromBinding (bindingSrc2 b) p1
+          posFromBinding src startPos = maybe startPos srcToLineColumn src
+
+srcToLineColumn :: Src -> LineColumn
+srcToLineColumn s = LC line column
+    where ssp = srcStart s
+          line = unPos . sourceLine $ ssp
+          column = unPos . sourceColumn $ ssp
+
+firstPosFromExpr :: LineColumn -> Expr Src a -> LineColumn
+firstPosFromExpr lpos = \case
+    (Note s _) -> srcToLineColumn s
+    _ -> lpos
+
+showTags :: Tags -> Text
+showTags (Tags ts) = T.concat . map (uncurry showFileTags) . M.toList $ ts
+
+showFileTags :: FilePath -> [(LineOffset, Tag)] -> T.Text
+showFileTags f ts = "\x0c\n" <> T.pack f <> "," <> (showInt . T.length) cs <> "\n" <> cs
+    where cs = T.concat . map (uncurry showPosTag) $ ts
+
+showPosTag :: LineOffset -> Tag -> Text
+showPosTag lo tag = def <>"\x7f" <> name <> "\x01" <> showInt line <>
+                    "," <> showInt offset <> "\n"
+    where line = loLine lo
+          offset = loOffset lo
+          def = tagPattern tag
+          name = tagName tag
+
+showInt :: Int -> Text
+showInt = T.pack . show
+
+{-| Generate list of files for a given `Input`
+-}
+inputToFiles
+    :: Bool
+    -- ^ If `True`, this function will follow  symbolic links
+    -> Maybe [String]
+    -- ^ List of suffixes. If `Nothing`, all files will be returned.
+    --   This parameter only works when the `Input` is an `InputFile` and point to a directory.
+    -> Input
+    -> IO [ FilePath ]
+    --   List of files.
+inputToFiles _ _ StandardInput = lines <$> getContents
+inputToFiles followSyms suffixes (InputFile path) = go path
+    where go p = do
+                   isD <- SD.doesDirectoryExist p
+                   isSL <- isSymLink
+                   if isD
+                     then if isSL && not followSyms
+                            then return []
+                            else do
+                                   -- filter . .. and hidden files .*
+                                   contents <- fmap (filter ((/=) '.' . head))
+                                                    (SD.getDirectoryContents p)
+                                   concat <$> mapM (go . (</>) p) contents
+                     else return [p | matchingSuffix || p == path]
+               where matchingSuffix = maybe True (any (`isSuffixOf` p)) suffixes
+                     isSymLink = 
+#if MIN_VERSION_directory(1,3,0)
+                                 SD.pathIsSymbolicLink p
+#elif MIN_VERSION_directory(1,2,6)
+                                 SD.isSymbolicLink pa
+#else
+                                 return False
+#endif

dhall/src/Dhall/Format.hs

@@ -54,8 +54,8 @@ format (Format {..}) =
     case formatMode of
         Modify {..} ->
             case inplace of
-                File file -> do
-                    (header, expr) <- Dhall.Util.getExpressionAndHeader censor (File file)
+                InputFile file -> do
+                    (header, expr) <- Dhall.Util.getExpressionAndHeader censor (InputFile file)
 
                     let doc =   Pretty.pretty header
                             <>  Pretty.unAnnotate (Dhall.Pretty.prettyCharacterSet characterSet expr)
@@ -83,8 +83,8 @@ format (Format {..}) =
                           (Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc))
         Check {..} -> do
             originalText <- case path of
-                File file     -> Data.Text.IO.readFile file
-                StandardInput -> Data.Text.IO.getContents
+                InputFile file -> Data.Text.IO.readFile file
+                StandardInput  -> Data.Text.IO.getContents
 
             (header, expr) <- Dhall.Util.getExpressionAndHeader censor path
 

dhall/src/Dhall/Freeze.hs

@@ -101,7 +101,7 @@ writeExpr inplace (header, expr) characterSet = do
     let unAnnotated = Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc)
 
     case inplace of
-        File f ->
+        InputFile f ->
             System.IO.withFile f System.IO.WriteMode (\handle -> do
                 Pretty.renderIO handle unAnnotated
                 Data.Text.IO.hPutStrLn handle "" )
@@ -142,8 +142,8 @@ freeze
     -> IO ()
 freeze inplace scope intent characterSet censor = do
     let directory = case inplace of
-            StandardInput -> "."
-            File file     -> System.FilePath.takeDirectory file
+            StandardInput  -> "."
+            InputFile file -> System.FilePath.takeDirectory file
 
     (header, parsedExpression) <- Dhall.Util.getExpressionAndHeader censor inplace
 

dhall/src/Dhall/Main.hs

@@ -63,6 +63,7 @@ import qualified Dhall.Hash
 import qualified Dhall.Import
 import qualified Dhall.Import.Types
 import qualified Dhall.Lint
+import qualified Dhall.ETags
 import qualified Dhall.Pretty
 import qualified Dhall.Repl
 import qualified Dhall.TypeCheck
@@ -105,6 +106,11 @@ data Mode
     | Hash
     | Diff { expr1 :: Text, expr2 :: Text }
     | Lint { inplace :: Input }
+    | ETags { input :: Input
+            , output :: Output
+            , suffixes :: Maybe [Text]
+            , followSymlinks :: Bool
+            }
     | Encode { file :: Input, json :: Bool }
     | Decode { file :: Input, json :: Bool }
     | Text { file :: Input }
@@ -183,6 +189,10 @@ parseMode =
             "lint"
             "Improve Dhall code by using newer language features and removing dead code"
             (Lint <$> parseInplace)
+    <|> subcommand
+            "tags"
+            "Generate ETags file"
+            (ETags <$> parseInput <*> parseTagsOutput <*> parseSuffixes <*> parseFollowSymlinks)
     <|> subcommand
             "format"
             "Standard code formatter for the Dhall language"
@@ -220,7 +230,7 @@ parseMode =
     parseFile = fmap f (optional p)
       where
         f  Nothing    = StandardInput
-        f (Just file) = File file
+        f (Just file) = InputFile file
 
         p = Options.Applicative.strOption
                 (   Options.Applicative.long "file"
@@ -295,7 +305,7 @@ parseMode =
     parseInplace = fmap f (optional p)
       where
         f  Nothing    = StandardInput
-        f (Just file) = File file
+        f (Just file) = InputFile file
 
         p = Options.Applicative.strOption
             (   Options.Applicative.long "inplace"
@@ -303,6 +313,46 @@ parseMode =
             <>  Options.Applicative.metavar "FILE"
             )
 
+    parseInput = fmap f (optional p)
+      where
+        f  Nothing    = StandardInput
+        f (Just path) = InputFile path
+
+        p = Options.Applicative.strOption
+            (   Options.Applicative.long "path"
+            <>  Options.Applicative.help "Index all files in path recursively. Will get list of files from STDIN if omitted."
+            <>  Options.Applicative.metavar "PATH"
+            )
+
+    parseTagsOutput = fmap f (optional p)
+      where
+        f  Nothing    = OutputFile "tags"
+        f (Just file) = OutputFile file
+
+        p = Options.Applicative.strOption
+            (   Options.Applicative.long "output"
+            <>  Options.Applicative.help "The name of the file that the tags are written to. Defaults to \"tags\""
+            <>  Options.Applicative.metavar "FILENAME"
+            )
+
+    parseSuffixes = fmap f (optional p)
+      where
+        f  Nothing    = Just [".dhall"]
+        f (Just "")   = Nothing
+        f (Just line) = Just (Data.Text.splitOn " " line)
+
+        p = Options.Applicative.strOption
+            (   Options.Applicative.long "suffixes"
+            <>  Options.Applicative.help "Index only files with suffixes. \"\" to index all files."
+            <>  Options.Applicative.metavar "SUFFIXES"
+            )
+
+    parseFollowSymlinks =
+        Options.Applicative.switch
+        (   Options.Applicative.long "follow-symlinks"
+        <>  Options.Applicative.help "Follow symlinks when recursing directories"
+        )
+
     parseJSONFlag =
         Options.Applicative.switch
         (   Options.Applicative.long "json"
@@ -351,7 +401,7 @@ command (Options {..}) = do
     GHC.IO.Encoding.setLocaleEncoding System.IO.utf8
 
     let rootDirectory = \case
-            File f        -> System.FilePath.takeDirectory f
+            InputFile f   -> System.FilePath.takeDirectory f
             StandardInput -> "."
 
     let toStatus = Dhall.Import.emptyStatus . rootDirectory
@@ -577,7 +627,7 @@ command (Options {..}) = do
             (header, expression) <- getExpressionAndHeader inplace
 
             case inplace of
-                File file -> do
+                InputFile file -> do
                     let lintedExpression = Dhall.Lint.lint expression
 
                     let doc =   Pretty.pretty header
@@ -617,7 +667,7 @@ command (Options {..}) = do
         Decode {..} -> do
             bytes <- do
                 case file of
-                    File f        -> Data.ByteString.Lazy.readFile f
+                    InputFile f   -> Data.ByteString.Lazy.readFile f
                     StandardInput -> Data.ByteString.Lazy.getContents
 
             term <- do
@@ -663,6 +713,16 @@ command (Options {..}) = do
 
                     Control.Exception.throwIO (Dhall.InvalidType {..})
 
+        ETags {..} -> do
+            tags <- Dhall.ETags.generate input suffixes followSymlinks
+
+            case output of
+                OutputFile file ->
+                    System.IO.withFile file System.IO.WriteMode (`Data.Text.IO.hPutStr` tags)
+
+                StandardOutput -> Data.Text.IO.putStrLn tags
+            
+
 -- | Entry point for the @dhall@ executable
 main :: IO ()
 main = do

dhall/src/Dhall/Util.hs

@@ -98,13 +98,13 @@ get :: (String -> Text -> Either ParseError a) -> Censor -> Input -> IO a
 get parser censor input = do
     inText <- do
         case input of
-            File file     -> Data.Text.IO.readFile file
-            StandardInput -> Data.Text.IO.getContents
+            InputFile file -> Data.Text.IO.readFile file
+            StandardInput  -> Data.Text.IO.getContents
 
     let name =
             case input of
-                File file     -> file
-                StandardInput -> "(stdin)"
+                InputFile file -> file
+                StandardInput  -> "(stdin)"
 
     let result = parser name inText
 
@@ -119,7 +119,7 @@ get parser censor input = do
 data Censor = NoCensor | Censor
 
 -- | Path to input
-data Input = StandardInput | File FilePath
+data Input = StandardInput | InputFile FilePath
 
 -- | Path to output
 data Output = StandardOutput | OutputFile FilePath

dhall/tests/Dhall/Test/ETags.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Dhall.Test.ETags where
+
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import Dhall.Util (Input(..))
+import Prelude hiding (FilePath)
+import Test.Tasty (TestTree)
+import Turtle (FilePath)
+
+import qualified Data.Text        as Text
+import qualified Data.Text.IO     as Text.IO
+import qualified Dhall.ETags      as ETags
+import qualified Dhall.Test.Util  as Test.Util
+import qualified Test.Tasty       as Tasty
+import qualified Test.Tasty.HUnit as Tasty.HUnit
+import qualified Turtle
+
+etagsDirectory :: FilePath
+etagsDirectory = "./tests/etags"
+
+getTests :: IO TestTree
+getTests = do
+    etagsTests <- Test.Util.discover (Turtle.chars <* ".dhall") etagsTest (Turtle.lstree etagsDirectory)
+
+    let testTree = Tasty.testGroup "etags tests" [ etagsTests, etagsDirTest ]
+
+    return testTree
+
+etagsTest :: Text -> TestTree
+etagsTest prefix =
+    Tasty.HUnit.testCase (Text.unpack prefix) $ do
+        let inputFile  = Text.unpack (prefix <> ".dhall")
+        let outputFile = Text.unpack (prefix <> ".tags")
+
+        actualTags <- fixPathSeparators <$> ETags.generate (InputFile inputFile) Nothing False
+
+        expectedTags <- Text.IO.readFile outputFile
+
+        let message = "The actual tags did not match the expected tags"
+
+        Tasty.HUnit.assertEqual message expectedTags actualTags
+
+etagsDirTest :: TestTree
+etagsDirTest =
+    Tasty.HUnit.testCase "all" $ do
+        let outputFile = Text.unpack . Turtle.format Turtle.fp $ etagsDirectory Turtle.</> "all.tags"
+
+        actualTags <- fmap fixPathSeparators
+                      (ETags.generate
+                          (InputFile (Text.unpack . Turtle.format Turtle.fp $ etagsDirectory))
+                          (Just [".dhall"])
+                          False)
+
+        expectedTags <- Text.IO.readFile outputFile
+
+        let message = "The actual tags did not match the expected tags for directory test"
+
+        Tasty.HUnit.assertEqual message expectedTags actualTags
+
+fixPathSeparators :: Text -> Text
+fixPathSeparators = Text.replace "\\" "/"

dhall/tests/Dhall/Test/Main.hs

@@ -5,6 +5,7 @@ import Test.Tasty      (TestTree)
 
 import qualified Dhall.Test.Dhall
 import qualified Dhall.Test.Diff
+import qualified Dhall.Test.ETags
 import qualified Dhall.Test.Format
 import qualified Dhall.Test.SemanticHash
 import qualified Dhall.Test.Import
@@ -35,6 +36,8 @@ getAllTests = do
 
     lintTests <- Dhall.Test.Lint.getTests
 
+    etagsTests <- Dhall.Test.ETags.getTests
+
     diffTests <- Dhall.Test.Diff.getTests
 
     semanticHashTests <- Dhall.Test.SemanticHash.getTests
@@ -49,6 +52,7 @@ getAllTests = do
                 , lintTests
                 , diffTests
                 , semanticHashTests
+                , etagsTests
                 , Dhall.Test.Regression.tests
                 , Dhall.Test.Tutorial.tests
                 , Dhall.Test.QuickCheck.tests

dhall/tests/etags/all.tags

@@ -0,0 +1,61 @@
+
+./tests/etags/let.dhall,66
+let.dhall
1,1
+/let.dhall
1,1
+let foo foo
1,5
+let bar bar
3,22
+
+./tests/etags/nonunicode.dhall,63
+nonunicode.dhall
1,1
+/nonunicode.dhall
1,1
+let foo foo
2,12
+
+./tests/etags/record.dhall,335
+record.dhall
1,1
+/record.dhall
1,1
+let Config Config
6,81
+      { home home
8,161
+      , privateKey privateKey
9,181
+      , publicKey publicKey
10,207
+      , name name
11,232
+      , name : { firstName firstName
11,241
+               , secondName secondName
12,275
+let makeUser makeUser
16,323
+let configs configs
30,804
+
+./tests/etags/recordlit.dhall,223
+recordlit.dhall
1,1
+/recordlit.dhall
1,1
+{ home home
8,143
+, privateKey privateKey
9,171
+, publicKey publicKey
10,215
+, name name
11,263
+, name = { firstName firstName
11,272
+         , secondName secondName
12,302
+
+./tests/etags/simple.dhall,254
+simple.dhall
1,1
+/simple.dhall
1,1
+let generate generate
6,100
+let makeUser makeUser
17,409
+let buildUser buildUser
26,680
+let Config Config
32,880
+      { home home
33,897
+      , privateKey privateKey
34,917
+      , publicKey publicKey
35,943
+
+./tests/etags/unicode.dhall,57
+unicode.dhall
1,1
+/unicode.dhall
1,1
+let foo foo
2,15
+
+./tests/etags/union.dhall,394
+union.dhall
1,1
+/union.dhall
1,1
+let Element Element
1,5
+let Element = < Left Left
1,17
+let Element = < Left : Natural | Right Right
1,34
+let Element = < Left : Natural | Right : Bool | Middle Middle
1,49
+let Element = < Left : Natural | Right : Bool | Middle : < Top Top
1,60
+let Element = < Left : Natural | Right : Bool | Middle : < Top : Text | Bottom Bottom
1,73
+let foo foo
3,95

dhall/tests/etags/let.dhall

@@ -0,0 +1,4 @@
+let foo = "foo"
+
+let bar = foo
+in bar

dhall/tests/etags/let.tags

@@ -0,0 +1,6 @@
+
+./tests/etags/let.dhall,66
+let.dhall
1,1
+/let.dhall
1,1
+let foo foo
1,5
+let bar bar
3,22

dhall/tests/etags/nonunicode.dhall

@@ -0,0 +1,3 @@
+-- abc
+let foo = "bar"
+in foo

dhall/tests/etags/nonunicode.tags

@@ -0,0 +1,5 @@
+
+./tests/etags/nonunicode.dhall,63
+nonunicode.dhall
1,1
+/nonunicode.dhall
1,1
+let foo foo
2,12

dhall/tests/etags/record.dhall

@@ -0,0 +1,35 @@
+{- You can optionally add types
+
+   `x : T` means that `x` has type `T`
+-}
+
+let Config : Type =
+      {- What happens if you add another field here? -}
+      { home : Text
+      , privateKey : Text
+      , publicKey : Text
+      , name : { firstName : Text
+               , secondName : Text
+               }
+      }
+
+let makeUser : Text -> Config = \(user : Text) ->
+      let home       : Text   = "/home/${user}"
+      let privateKey : Text   = "${home}/.ssh/id_ed25519"
+      let publicKey  : Text   = "${privateKey}.pub"
+      let config     : Config =
+            { home       = home
+            , privateKey = privateKey
+            , publicKey  = publicKey
+            , name = { firstName = user
+                     , secondName = ""
+                     }
+            }
+      in  config
+
+let configs : List Config =
+      [ makeUser "bill"
+      , makeUser "jane"
+      ]
+
+in  configs

dhall/tests/etags/record.tags

@@ -0,0 +1,13 @@
+
+./tests/etags/record.dhall,335
+record.dhall
1,1
+/record.dhall
1,1
+let Config Config
6,81
+      { home home
8,161
+      , privateKey privateKey
9,181
+      , publicKey publicKey
10,207
+      , name name
11,232
+      , name : { firstName firstName
11,241
+               , secondName secondName
12,275
+let makeUser makeUser
16,323
+let configs configs
30,804

dhall/tests/etags/recordlit.dhall

@@ -0,0 +1,14 @@
+{- This is an example Dhall configuration file
+
+   Can you spot the mistake?
+
+   Fix the typo, then move onto the "Definitions" example
+-}
+
+{ home       = "/home/bill"
+, privateKey = "/home/bill/.ssh/id_ed25519"
+, publicKey  = "/home/blil/.ssh/id_ed25519.pub"
+, name = { firstName = "Bill"
+         , secondName = "Bar"
+         }
+}

dhall/tests/etags/recordlit.tags

@@ -0,0 +1,10 @@
+
+./tests/etags/recordlit.dhall,223
+recordlit.dhall
1,1
+/recordlit.dhall
1,1
+{ home home
8,143
+, privateKey privateKey
9,171
+, publicKey publicKey
10,215
+, name name
11,263
+, name = { firstName firstName
11,272
+         , secondName secondName
12,302

dhall/tests/etags/simple.dhall

@@ -0,0 +1,39 @@
+{- Need to generate a lot of users?
+
+   Use the `generate` function from the Dhall Prelude
+-}
+
+let generate = https://prelude.dhall-lang.org/List/generate
+
+{- You can import Dhall expressions from URLs that support
+   CORS
+
+   The command-line tools also let you import from files,
+   environment variables, and URLs without CORS support.
+
+   Browse https://prelude.dhall-lang.org for more utilities
+-}
+
+let makeUser = \(user : Text) ->
+      let home       = "/home/${user}"
+      let privateKey = "${home}/.ssh/id_ed25519"
+      let publicKey  = "${privateKey}.pub"
+      in  { home = home
+          , privateKey = privateKey
+          , publicKey = publicKey
+          }
+
+let buildUser = \(index : Natural) ->
+      {- `Natural/show` is a "built-in", meaning that
+         you can use `Natural/show` without an import
+      -}
+      makeUser "build${Natural/show index}"
+
+let Config =
+      { home : Text
+      , privateKey : Text
+      , publicKey : Text
+      }
+
+in  {- Try generating 20 users instead of 10 -}
+    generate 10 Config buildUser

dhall/tests/etags/simple.tags

@@ -0,0 +1,11 @@
+
+./tests/etags/simple.dhall,254
+simple.dhall
1,1
+/simple.dhall
1,1
+let generate generate
6,100
+let makeUser makeUser
17,409
+let buildUser buildUser
26,680
+let Config Config
32,880
+      { home home
33,897
+      , privateKey privateKey
34,917
+      , publicKey publicKey
35,943

dhall/tests/etags/unicode.dhall

@@ -0,0 +1,3 @@
+-- αβξ
+let foo = "bar"
+in foo

dhall/tests/etags/unicode.tags

@@ -0,0 +1,5 @@
+
+./tests/etags/unicode.dhall,57
+unicode.dhall
1,1
+/unicode.dhall
1,1
+let foo foo
2,15

dhall/tests/etags/union.dhall

@@ -0,0 +1,4 @@
+let Element = < Left : Natural | Right : Bool | Middle : < Top : Text | Bottom : Bool> >
+
+let foo = Element.Left 6
+in foo

dhall/tests/etags/union.tags

@@ -0,0 +1,11 @@
+
+./tests/etags/union.dhall,394
+union.dhall
1,1
+/union.dhall
1,1
+let Element Element
1,5
+let Element = < Left Left
1,17
+let Element = < Left : Natural | Right Right
1,34
+let Element = < Left : Natural | Right : Bool | Middle Middle
1,49
+let Element = < Left : Natural | Right : Bool | Middle : < Top Top
1,60
+let Element = < Left : Natural | Right : Bool | Middle : < Top : Text | Bottom Bottom
1,73
+let foo foo
3,95