From 7ce308efa27484b03752399f4b9505efdb2b56b4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 14:52:27 -0400
Subject: [PATCH 001/228] Stub in a tags package.

---
 cabal.project                     |  2 +-
 semantic-tags/LICENSE             | 21 +++++++++++++
 semantic-tags/README.md           | 18 ++++++++++++
 semantic-tags/Setup.hs            |  2 ++
 semantic-tags/semantic-tags.cabal | 49 +++++++++++++++++++++++++++++++
 semantic-tags/test/Doctest.hs     | 12 ++++++++
 6 files changed, 103 insertions(+), 1 deletion(-)
 create mode 100644 semantic-tags/LICENSE
 create mode 100644 semantic-tags/README.md
 create mode 100644 semantic-tags/Setup.hs
 create mode 100644 semantic-tags/semantic-tags.cabal
 create mode 100644 semantic-tags/test/Doctest.hs

diff --git a/cabal.project b/cabal.project
index 2a7af0f0f..bb948301f 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,4 +1,4 @@
-packages: . semantic-core semantic-python
+packages: . semantic-core semantic-python semantic-tags
 
 jobs: $ncpus
 
diff --git a/semantic-tags/LICENSE b/semantic-tags/LICENSE
new file mode 100644
index 000000000..331b241b3
--- /dev/null
+++ b/semantic-tags/LICENSE
@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2019 GitHub
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/semantic-tags/README.md b/semantic-tags/README.md
new file mode 100644
index 000000000..1a0662907
--- /dev/null
+++ b/semantic-tags/README.md
@@ -0,0 +1,18 @@
+# semantic-tags
+
+Tags computation over ASTs.
+
+
+## Development
+
+This project consists of a Haskell package named `semantic-tags`. The library’s sources are in [`src`][].
+
+Development of `semantic-tags` is typically done using `cabal v2-build`:
+
+```shell
+cabal v2-build # build the library
+cabal v2-repl  # load the package into ghci
+cabal v2-test  # build and run the doctests
+```
+
+[`src`]: https://github.com/github/semantic/tree/master/semantic-tags/src
diff --git a/semantic-tags/Setup.hs b/semantic-tags/Setup.hs
new file mode 100644
index 000000000..9a994af67
--- /dev/null
+++ b/semantic-tags/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
new file mode 100644
index 000000000..db82745b7
--- /dev/null
+++ b/semantic-tags/semantic-tags.cabal
@@ -0,0 +1,49 @@
+cabal-version:       2.4
+
+name:                semantic-tags
+version:             0.0.0.0
+synopsis:            Tags computation
+description:         Tags computation for ASTs derived from tree-sitter grammars.
+homepage:            https://github.com/github/semantic/tree/master/semantic-core#readme
+bug-reports:         https://github.com/github/semantic/issues
+license:             MIT
+license-file:        LICENSE
+author:              The Semantic authors
+maintainer:          opensource+semantic@github.com
+copyright:           (c) 2019 GitHub, Inc.
+category:            Language
+build-type:          Simple
+stability:           alpha
+extra-source-files:  README.md
+
+tested-with:         GHC == 8.6.5
+
+library
+  -- exposed-modules:
+  -- other-modules:
+  -- other-extensions:
+  build-depends:
+      base                         >= 4.12 && < 5
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options:
+    -Weverything
+    -Wno-missing-local-signatures
+    -Wno-missing-import-lists
+    -Wno-implicit-prelude
+    -Wno-safe
+    -Wno-unsafe
+    -Wno-name-shadowing
+    -Wno-monomorphism-restriction
+    -Wno-missed-specialisations
+    -Wno-all-missed-specialisations
+    -Wno-star-is-type
+
+test-suite doctest
+  type:                exitcode-stdio-1.0
+  main-is:             Doctest.hs
+  build-depends:       base
+                     , doctest >=0.7 && <1.0
+                     , semantic-tags
+  hs-source-dirs:      test
+  default-language:    Haskell2010
diff --git a/semantic-tags/test/Doctest.hs b/semantic-tags/test/Doctest.hs
new file mode 100644
index 000000000..ed2c0d09c
--- /dev/null
+++ b/semantic-tags/test/Doctest.hs
@@ -0,0 +1,12 @@
+module Main
+( main
+) where
+
+import System.Environment
+import Test.DocTest
+
+main :: IO ()
+main = do
+  args <- getArgs
+  autogen <- fmap (<> "/build/doctest/autogen") <$> lookupEnv "HASKELL_DIST_DIR"
+  doctest (maybe id ((:) . ("-i" <>)) autogen ("-isemantic-tags/src" : "--fast" : if null args then ["semantic-tags/src"] else args))

From d04f363ee76dbe7251e3acbfadd597ece17cb05f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 14:55:44 -0400
Subject: [PATCH 002/228] Stub in a module for precise taggable terms.

---
 semantic-tags/semantic-tags.cabal          | 3 ++-
 semantic-tags/src/Tags/Taggable/Precise.hs | 2 ++
 2 files changed, 4 insertions(+), 1 deletion(-)
 create mode 100644 semantic-tags/src/Tags/Taggable/Precise.hs

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index db82745b7..95d9e7f16 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -19,7 +19,8 @@ extra-source-files:  README.md
 tested-with:         GHC == 8.6.5
 
 library
-  -- exposed-modules:
+  exposed-modules:
+    Tags.Taggable.Precise
   -- other-modules:
   -- other-extensions:
   build-depends:
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
new file mode 100644
index 000000000..4597d6b6e
--- /dev/null
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -0,0 +1,2 @@
+module Tags.Taggable.Precise
+() where

From b7f9b4ea207c493e888de57ba4b3674bc10b023e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 14:56:56 -0400
Subject: [PATCH 003/228] Depend on tree-sitter & tree-sitter-python.

---
 semantic-tags/semantic-tags.cabal | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 95d9e7f16..ac89ef646 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -24,7 +24,9 @@ library
   -- other-modules:
   -- other-extensions:
   build-depends:
-      base                         >= 4.12 && < 5
+      base               >= 4.12 && < 5
+    , tree-sitter        == 0.3.0.0
+    , tree-sitter-python == 0.4.0.0
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:

From 48cd097a6b9f13867ede5b8de0fadf2c8a9aed1c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 17:02:20 -0400
Subject: [PATCH 004/228] Define a Python newtype wrapping a module.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 4597d6b6e..a21ac20d0 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,2 +1,7 @@
 module Tags.Taggable.Precise
-() where
+( Python(..)
+) where
+
+import qualified TreeSitter.Python.AST as Python
+
+newtype Python a = Python { getPython :: Python.Module a }

From 4a5d9d9e4a76b1edb6a78dd42896178ca1028620 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 17:20:01 -0400
Subject: [PATCH 005/228] Copy Span, Pos, and Tag in.

Span & Pos should likely live in semantic-ast eventually, while Tag will live in semantic-tags.
---
 semantic-tags/semantic-tags.cabal          |  8 ++--
 semantic-tags/src/Tags/Taggable/Precise.hs | 44 ++++++++++++++++++++++
 2 files changed, 49 insertions(+), 3 deletions(-)

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index ac89ef646..a7c7dbc15 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -24,9 +24,11 @@ library
   -- other-modules:
   -- other-extensions:
   build-depends:
-      base               >= 4.12 && < 5
-    , tree-sitter        == 0.3.0.0
-    , tree-sitter-python == 0.4.0.0
+      aeson              ^>= 1.4.2.0
+    , base                >= 4.12 && < 5
+    , text               ^>= 1.2.3.1
+    , tree-sitter         == 0.3.0.0
+    , tree-sitter-python  == 0.4.0.0
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index a21ac20d0..15c337649 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,7 +1,51 @@
+{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
 module Tags.Taggable.Precise
 ( Python(..)
 ) where
 
+import           Data.Aeson as A
+import           Data.Text (Text)
+import           GHC.Generics (Generic)
 import qualified TreeSitter.Python.AST as Python
 
+data Span = Span
+  { spanStart :: {-# UNPACK #-} !Pos
+  , spanEnd   :: {-# UNPACK #-} !Pos
+  }
+  deriving (Eq, Ord, Generic)
+
+instance Show Span where
+  showsPrec _ s = shows (spanStart s) . showString ".." . shows (spanEnd s)
+
+instance A.ToJSON Span where
+  toJSON s = A.object
+    [ "start" .= spanStart s
+    , "end"   .= spanEnd   s
+    ]
+
+data Pos = Pos
+  { posLine   :: {-# UNPACK #-} !Int
+  , posColumn :: {-# UNPACK #-} !Int
+  }
+  deriving (Eq, Ord, Generic)
+
+instance Show Pos where
+  showsPrec _ p = showChar '[' . shows (posLine p) . showString ", " . shows (posColumn p) . showChar ']'
+
+instance A.ToJSON Pos where
+  toJSON p = A.toJSON [posLine p, posColumn p]
+
+data Tag = Tag
+  { name :: Text
+  , kind :: Text
+  , span :: Span
+  , context :: [Text]
+  , line :: Maybe Text
+  , docs :: Maybe Text
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Tag
+
+
 newtype Python a = Python { getPython :: Python.Module a }

From 82beaa501fd174919e3c5fccd52411f8ad485f07 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 17:57:44 -0400
Subject: [PATCH 006/228] :fire: offsetRange.

---
 src/Data/Range.hs | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/src/Data/Range.hs b/src/Data/Range.hs
index 3a6209245..2ce01dde0 100644
--- a/src/Data/Range.hs
+++ b/src/Data/Range.hs
@@ -3,7 +3,6 @@ module Data.Range
 ( Range(..)
 , emptyRange
 , rangeLength
-, offsetRange
 , intersectsRange
 , subtractRange
 ) where
@@ -24,10 +23,6 @@ emptyRange = Range 0 0
 rangeLength :: Range -> Int
 rangeLength range = end range - start range
 
--- | Offset a range by a constant delta.
-offsetRange :: Range -> Int -> Range
-offsetRange a b = Range (start a + b) (end a + b)
-
 -- | Test two ranges for intersection.
 intersectsRange :: Range -> Range -> Bool
 intersectsRange range1 range2 = start range1 < end range2 && start range2 < end range1

From 290345fc43c3a2b029a1bd0ebf60984fdaf81581 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 17:58:05 -0400
Subject: [PATCH 007/228] Copy in Blob, Language, Range, Source, and Span.

---
 semantic-tags/semantic-tags.cabal          |  6 ++
 semantic-tags/src/Data/Blob.hs             | 39 +++++++++++
 semantic-tags/src/Data/Language.hs         | 28 ++++++++
 semantic-tags/src/Data/Range.hs            | 40 ++++++++++++
 semantic-tags/src/Data/Source.hs           | 75 ++++++++++++++++++++++
 semantic-tags/src/Data/Span.hs             | 36 +++++++++++
 semantic-tags/src/Tags/Taggable/Precise.hs | 28 +-------
 7 files changed, 225 insertions(+), 27 deletions(-)
 create mode 100644 semantic-tags/src/Data/Blob.hs
 create mode 100644 semantic-tags/src/Data/Language.hs
 create mode 100644 semantic-tags/src/Data/Range.hs
 create mode 100644 semantic-tags/src/Data/Source.hs
 create mode 100644 semantic-tags/src/Data/Span.hs

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index a7c7dbc15..65eb997bc 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -20,12 +20,18 @@ tested-with:         GHC == 8.6.5
 
 library
   exposed-modules:
+    Data.Blob
+    Data.Language
+    Data.Range
+    Data.Source
+    Data.Span
     Tags.Taggable.Precise
   -- other-modules:
   -- other-extensions:
   build-depends:
       aeson              ^>= 1.4.2.0
     , base                >= 4.12 && < 5
+    , bytestring         ^>= 0.10.8.2
     , text               ^>= 1.2.3.1
     , tree-sitter         == 0.3.0.0
     , tree-sitter-python  == 0.4.0.0
diff --git a/semantic-tags/src/Data/Blob.hs b/semantic-tags/src/Data/Blob.hs
new file mode 100644
index 000000000..8ffa2006f
--- /dev/null
+++ b/semantic-tags/src/Data/Blob.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Data.Blob
+( File(..)
+, Blob(..)
+, blobLanguage
+, blobPath
+, makeBlob
+) where
+
+import Data.Language
+import Data.Source as Source
+import Data.Text (Text)
+import GHC.Generics (Generic)
+
+-- | A 'FilePath' paired with its corresponding 'Language'.
+-- Unpacked to have the same size overhead as (FilePath, Language).
+data File = File
+  { filePath     :: FilePath
+  , fileLanguage :: Language
+  }
+  deriving (Show, Eq, Generic)
+
+-- | The source, path information, and language of a file read from disk.
+data Blob = Blob
+  { blobSource   :: Source -- ^ The UTF-8 encoded source text of the blob.
+  , blobFile     :: File   -- ^ Path/language information for this blob.
+  , blobOid      :: Text   -- ^ Git OID for this blob, mempty if blob is not from a git db.
+  }
+  deriving (Show, Eq, Generic)
+
+blobLanguage :: Blob -> Language
+blobLanguage = fileLanguage . blobFile
+
+blobPath :: Blob -> FilePath
+blobPath = filePath . blobFile
+
+makeBlob :: Source -> FilePath -> Language -> Text -> Blob
+makeBlob s p l = Blob s (File p l)
+{-# INLINE makeBlob #-}
diff --git a/semantic-tags/src/Data/Language.hs b/semantic-tags/src/Data/Language.hs
new file mode 100644
index 000000000..69bdd2c3f
--- /dev/null
+++ b/semantic-tags/src/Data/Language.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Data.Language
+( Language (..)
+) where
+
+import Data.Aeson
+import GHC.Generics (Generic)
+
+-- | The various languages we support.
+-- Please do not reorder any of the field names: the current implementation of 'Primitive'
+-- delegates to the auto-generated 'Enum' instance.
+data Language
+  = Unknown
+  | Go
+  | Haskell
+  | Java
+  | JavaScript
+  | JSON
+  | JSX
+  | Markdown
+  | Python
+  | Ruby
+  | TypeScript
+  | PHP
+  | TSX
+  deriving (Bounded, Enum, Eq, Generic, Ord, Read, Show)
+
+instance ToJSON Language
diff --git a/semantic-tags/src/Data/Range.hs b/semantic-tags/src/Data/Range.hs
new file mode 100644
index 000000000..1a4180cb5
--- /dev/null
+++ b/semantic-tags/src/Data/Range.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Data.Range
+( Range(..)
+, rangeLength
+, intersectsRange
+, subtractRange
+) where
+
+import GHC.Generics (Generic)
+
+-- | A half-open interval of integers, defined by start & end indices.
+data Range = Range { start :: {-# UNPACK #-} !Int, end :: {-# UNPACK #-} !Int }
+  deriving (Eq, Generic, Ord)
+
+-- | Return the length of the range.
+rangeLength :: Range -> Int
+rangeLength range = end range - start range
+
+-- | Test two ranges for intersection.
+intersectsRange :: Range -> Range -> Bool
+intersectsRange range1 range2 = start range1 < end range2 && start range2 < end range1
+
+subtractRange :: Range -> Range -> Range
+subtractRange range1 range2 = Range (start range1) (end range1 - rangeLength (Range (start range2) (max (end range1) (end range2))))
+
+
+-- Instances
+
+-- $
+-- prop> a <> (b <> c) === (a <> b) <> (c :: Range)
+instance Semigroup Range where
+  Range start1 end1 <> Range start2 end2 = Range (min start1 start2) (max end1 end2)
+
+instance Show Range where
+  showsPrec _ r = showChar '[' . shows (start r) . showString " .. " . shows (end r) . showChar ']'
+
+
+-- $setup
+-- >>> import Test.QuickCheck
+-- >>> instance Arbitrary Range where arbitrary = Range <$> arbitrary <*> arbitrary ; shrink (Range s e) = Range <$> shrink s <*> shrink e
diff --git a/semantic-tags/src/Data/Source.hs b/semantic-tags/src/Data/Source.hs
new file mode 100644
index 000000000..afc14fdde
--- /dev/null
+++ b/semantic-tags/src/Data/Source.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
+module Data.Source
+( Source
+, sourceBytes
+, fromUTF8
+-- Measurement
+, sourceLength
+, nullSource
+, totalRange
+-- En/decoding
+, fromText
+, toText
+-- Slicing
+, slice
+, dropSource
+) where
+
+import           Data.Aeson (FromJSON (..), withText)
+import qualified Data.ByteString as B
+import           Data.Range
+import           Data.String (IsString (..))
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import           GHC.Generics
+
+
+-- | The contents of a source file. This is represented as a UTF-8
+-- 'ByteString' under the hood. Construct these with 'fromUTF8'; obviously,
+-- passing 'fromUTF8' non-UTF8 bytes will cause crashes.
+newtype Source = Source { sourceBytes :: B.ByteString }
+  deriving (Eq, Semigroup, Monoid, IsString, Show, Generic)
+
+fromUTF8 :: B.ByteString -> Source
+fromUTF8 = Source
+
+instance FromJSON Source where
+  parseJSON = withText "Source" (pure . fromText)
+
+-- Measurement
+
+sourceLength :: Source -> Int
+sourceLength = B.length . sourceBytes
+
+nullSource :: Source -> Bool
+nullSource = B.null . sourceBytes
+
+-- | Return a 'Range' that covers the entire text.
+totalRange :: Source -> Range
+totalRange = Range 0 . B.length . sourceBytes
+
+
+-- En/decoding
+
+-- | Return a 'Source' from a 'Text'.
+fromText :: T.Text -> Source
+fromText = Source . T.encodeUtf8
+
+-- | Return the Text contained in the 'Source'.
+toText :: Source -> T.Text
+toText = T.decodeUtf8 . sourceBytes
+
+
+-- | Return a 'Source' that contains a slice of the given 'Source'.
+slice :: Range -> Source -> Source
+slice range = take . drop
+  where drop = dropSource (start range)
+        take = takeSource (rangeLength range)
+
+dropSource :: Int -> Source -> Source
+dropSource i = Source . drop . sourceBytes
+  where drop = B.drop i
+
+takeSource :: Int -> Source -> Source
+takeSource i = Source . take . sourceBytes
+  where take = B.take i
diff --git a/semantic-tags/src/Data/Span.hs b/semantic-tags/src/Data/Span.hs
new file mode 100644
index 000000000..1f04d3c6d
--- /dev/null
+++ b/semantic-tags/src/Data/Span.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
+module Data.Span
+( Span(..)
+, Pos(..)
+) where
+
+import           Data.Aeson ((.=))
+import qualified Data.Aeson as A
+import           GHC.Generics (Generic)
+
+data Span = Span
+  { spanStart :: {-# UNPACK #-} !Pos
+  , spanEnd   :: {-# UNPACK #-} !Pos
+  }
+  deriving (Eq, Ord, Generic)
+
+instance Show Span where
+  showsPrec _ s = shows (spanStart s) . showString ".." . shows (spanEnd s)
+
+instance A.ToJSON Span where
+  toJSON s = A.object
+    [ "start" .= spanStart s
+    , "end"   .= spanEnd   s
+    ]
+
+data Pos = Pos
+  { posLine   :: {-# UNPACK #-} !Int
+  , posColumn :: {-# UNPACK #-} !Int
+  }
+  deriving (Eq, Ord, Generic)
+
+instance Show Pos where
+  showsPrec _ p = showChar '[' . shows (posLine p) . showString ", " . shows (posColumn p) . showChar ']'
+
+instance A.ToJSON Pos where
+  toJSON p = A.toJSON [posLine p, posColumn p]
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 15c337649..89c33b359 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -4,37 +4,11 @@ module Tags.Taggable.Precise
 ) where
 
 import           Data.Aeson as A
+import           Data.Span
 import           Data.Text (Text)
 import           GHC.Generics (Generic)
 import qualified TreeSitter.Python.AST as Python
 
-data Span = Span
-  { spanStart :: {-# UNPACK #-} !Pos
-  , spanEnd   :: {-# UNPACK #-} !Pos
-  }
-  deriving (Eq, Ord, Generic)
-
-instance Show Span where
-  showsPrec _ s = shows (spanStart s) . showString ".." . shows (spanEnd s)
-
-instance A.ToJSON Span where
-  toJSON s = A.object
-    [ "start" .= spanStart s
-    , "end"   .= spanEnd   s
-    ]
-
-data Pos = Pos
-  { posLine   :: {-# UNPACK #-} !Int
-  , posColumn :: {-# UNPACK #-} !Int
-  }
-  deriving (Eq, Ord, Generic)
-
-instance Show Pos where
-  showsPrec _ p = showChar '[' . shows (posLine p) . showString ", " . shows (posColumn p) . showChar ']'
-
-instance A.ToJSON Pos where
-  toJSON p = A.toJSON [posLine p, posColumn p]
-
 data Tag = Tag
   { name :: Text
   , kind :: Text

From 8486340462157b3e8e8a916a65b0d804b086213e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 18:05:20 -0400
Subject: [PATCH 008/228] Copy in Location.

---
 semantic-tags/semantic-tags.cabal  |  1 +
 semantic-tags/src/Data/Location.hs | 16 ++++++++++++++++
 2 files changed, 17 insertions(+)
 create mode 100644 semantic-tags/src/Data/Location.hs

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 65eb997bc..2ac4a053b 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -22,6 +22,7 @@ library
   exposed-modules:
     Data.Blob
     Data.Language
+    Data.Location
     Data.Range
     Data.Source
     Data.Span
diff --git a/semantic-tags/src/Data/Location.hs b/semantic-tags/src/Data/Location.hs
new file mode 100644
index 000000000..16fcae7c2
--- /dev/null
+++ b/semantic-tags/src/Data/Location.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Data.Location
+( Location(..)
+, Span(..)
+, Range(..)
+) where
+
+import Data.Range
+import Data.Span
+import GHC.Generics (Generic)
+
+data Location = Location
+  { locationByteRange :: {-# UNPACK #-} !Range
+  , locationSpan      :: {-# UNPACK #-} !Span
+  }
+  deriving (Eq, Generic, Ord, Show)

From 56cd54f98fa12f455a96fce019dad57a4272740d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 18:42:56 -0400
Subject: [PATCH 009/228] Stub in a tagging algorithm.

---
 semantic-tags/semantic-tags.cabal          |  1 +
 semantic-tags/src/Tags/Taggable/Precise.hs | 78 +++++++++++++++++++++-
 2 files changed, 76 insertions(+), 3 deletions(-)

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 2ac4a053b..a294452ae 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -33,6 +33,7 @@ library
       aeson              ^>= 1.4.2.0
     , base                >= 4.12 && < 5
     , bytestring         ^>= 0.10.8.2
+    , fused-effects      ^>= 0.5
     , text               ^>= 1.2.3.1
     , tree-sitter         == 0.3.0.0
     , tree-sitter-python  == 0.4.0.0
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 89c33b359..bc8fa404d 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,12 +1,17 @@
-{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DeriveGeneric, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
 module Tags.Taggable.Precise
 ( Python(..)
+, runTagging
 ) where
 
+import           Control.Effect.Reader
 import           Data.Aeson as A
-import           Data.Span
+import           Data.Blob
+import           Data.Monoid (Endo(..))
+import           Data.Location
 import           Data.Text (Text)
-import           GHC.Generics (Generic)
+import           GHC.Generics
 import qualified TreeSitter.Python.AST as Python
 
 data Tag = Tag
@@ -23,3 +28,70 @@ instance ToJSON Tag
 
 
 newtype Python a = Python { getPython :: Python.Module a }
+  deriving (Eq, Generic, Ord, Show)
+
+type ContextToken = (Text, Maybe Range)
+
+runTagging :: Blob -> [Text] -> Python Location -> [Tag]
+runTagging blob symbolsToSummarize
+  = ($ [])
+  . appEndo
+  . run
+  . runReader @[ContextToken] []
+  . runReader blob
+  . runReader symbolsToSummarize
+  . tag
+  . getPython where
+
+class ToTag t where
+  tag
+    :: ( Carrier sig m
+       , Member (Reader Blob) sig
+       , Member (Reader [ContextToken]) sig
+       , Member (Reader [Text]) sig
+       )
+    => t Location
+    -> m (Endo [Tag])
+
+instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag t where
+  tag = tag' @strategy
+
+
+class ToTagBy (strategy :: Strategy) t where
+  tag'
+    :: ( Carrier sig m
+       , Member (Reader Blob) sig
+       , Member (Reader [ContextToken]) sig
+       , Member (Reader [Text]) sig
+       )
+    => t Location
+    -> m (Endo [Tag])
+
+
+data Strategy = Generic | Custom
+
+type family ToTagInstance t :: Strategy where
+  ToTagInstance Python.FunctionDefinition = 'Custom
+  ToTagInstance _                         = 'Generic
+
+instance ToTagBy 'Custom Python.FunctionDefinition where
+  tag' Python.FunctionDefinition {} = pure mempty
+
+
+instance (Generic (t Location), GToTag (Rep (t Location))) => ToTagBy 'Generic t where
+  tag' = gtag . from
+
+
+class GToTag t where
+  gtag
+    :: ( Carrier sig m
+       , Member (Reader Blob) sig
+       , Member (Reader [ContextToken]) sig
+       , Member (Reader [Text]) sig
+       )
+    => t Location
+    -> m (Endo [Tag])
+
+
+instance GToTag (M1 i c f) where
+  gtag _ = pure mempty

From 1ff74600ce0cd9e2c2dac3ee519ec4a983f59cf3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 18:45:55 -0400
Subject: [PATCH 010/228] Use sets instead of lists for inclusion.

---
 semantic-tags/semantic-tags.cabal          | 1 +
 semantic-tags/src/Tags/Taggable/Precise.hs | 9 +++++----
 2 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index a294452ae..a8c99c660 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -33,6 +33,7 @@ library
       aeson              ^>= 1.4.2.0
     , base                >= 4.12 && < 5
     , bytestring         ^>= 0.10.8.2
+    , containers         ^>= 0.6.0.1
     , fused-effects      ^>= 0.5
     , text               ^>= 1.2.3.1
     , tree-sitter         == 0.3.0.0
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index bc8fa404d..cd07c0a22 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -10,6 +10,7 @@ import           Data.Aeson as A
 import           Data.Blob
 import           Data.Monoid (Endo(..))
 import           Data.Location
+import qualified Data.Set as Set
 import           Data.Text (Text)
 import           GHC.Generics
 import qualified TreeSitter.Python.AST as Python
@@ -32,7 +33,7 @@ newtype Python a = Python { getPython :: Python.Module a }
 
 type ContextToken = (Text, Maybe Range)
 
-runTagging :: Blob -> [Text] -> Python Location -> [Tag]
+runTagging :: Blob -> Set.Set Text -> Python Location -> [Tag]
 runTagging blob symbolsToSummarize
   = ($ [])
   . appEndo
@@ -48,7 +49,7 @@ class ToTag t where
     :: ( Carrier sig m
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
-       , Member (Reader [Text]) sig
+       , Member (Reader (Set.Set Text)) sig
        )
     => t Location
     -> m (Endo [Tag])
@@ -62,7 +63,7 @@ class ToTagBy (strategy :: Strategy) t where
     :: ( Carrier sig m
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
-       , Member (Reader [Text]) sig
+       , Member (Reader (Set.Set Text)) sig
        )
     => t Location
     -> m (Endo [Tag])
@@ -87,7 +88,7 @@ class GToTag t where
     :: ( Carrier sig m
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
-       , Member (Reader [Text]) sig
+       , Member (Reader (Set.Set Text)) sig
        )
     => t Location
     -> m (Endo [Tag])

From 62e682bdbe9271cb749c0637bb3a171279ae9025 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 18:47:56 -0400
Subject: [PATCH 011/228] Define a datatype of kinds.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index cd07c0a22..29780299b 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -23,11 +23,22 @@ data Tag = Tag
   , line :: Maybe Text
   , docs :: Maybe Text
   }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Generic, Show)
 
 instance ToJSON Tag
 
 
+data Kind
+  = Function
+  | Method
+  | Class
+  | Module
+  | Call
+  deriving (Bounded, Enum, Eq, Generic, Show)
+
+instance ToJSON Kind
+
+
 newtype Python a = Python { getPython :: Python.Module a }
   deriving (Eq, Generic, Ord, Show)
 

From 5b8ff5d50b52b6bad4d7da1410fc57770e645d74 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 18:49:25 -0400
Subject: [PATCH 012/228] Serialize Kind to JSON as a String.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 29780299b..c98592adc 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -36,7 +36,9 @@ data Kind
   | Call
   deriving (Bounded, Enum, Eq, Generic, Show)
 
-instance ToJSON Kind
+instance ToJSON Kind where
+  toJSON = toJSON . show
+  toEncoding = toEncoding . show
 
 
 newtype Python a = Python { getPython :: Python.Module a }

From d9efe629adb7636eae20802f1566393b13650b4a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 18:49:33 -0400
Subject: [PATCH 013/228] Use a Kind instead of Text in Tag.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index c98592adc..d1d4390d5 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -17,7 +17,7 @@ import qualified TreeSitter.Python.AST as Python
 
 data Tag = Tag
   { name :: Text
-  , kind :: Text
+  , kind :: Kind
   , span :: Span
   , context :: [Text]
   , line :: Maybe Text

From bb57769b538bc3d4455e7493e262ff33ace0d0bc Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 18:49:50 -0400
Subject: [PATCH 014/228] Use a set of kinds.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index d1d4390d5..8d6b56c16 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -46,7 +46,7 @@ newtype Python a = Python { getPython :: Python.Module a }
 
 type ContextToken = (Text, Maybe Range)
 
-runTagging :: Blob -> Set.Set Text -> Python Location -> [Tag]
+runTagging :: Blob -> Set.Set Kind -> Python Location -> [Tag]
 runTagging blob symbolsToSummarize
   = ($ [])
   . appEndo
@@ -62,7 +62,7 @@ class ToTag t where
     :: ( Carrier sig m
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
-       , Member (Reader (Set.Set Text)) sig
+       , Member (Reader (Set.Set Kind)) sig
        )
     => t Location
     -> m (Endo [Tag])
@@ -76,7 +76,7 @@ class ToTagBy (strategy :: Strategy) t where
     :: ( Carrier sig m
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
-       , Member (Reader (Set.Set Text)) sig
+       , Member (Reader (Set.Set Kind)) sig
        )
     => t Location
     -> m (Endo [Tag])
@@ -101,7 +101,7 @@ class GToTag t where
     :: ( Carrier sig m
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
-       , Member (Reader (Set.Set Text)) sig
+       , Member (Reader (Set.Set Kind)) sig
        )
     => t Location
     -> m (Endo [Tag])

From a9e551d4e9abd2f0054a2814a40c2d3d3b860ad4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 18:50:31 -0400
Subject: [PATCH 015/228] =?UTF-8?q?:fire:=20the=20set=20of=20kinds;=20we?=
 =?UTF-8?q?=E2=80=99re=20not=20going=20to=20filter=20like=20that.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-tags/semantic-tags.cabal          | 1 -
 semantic-tags/src/Tags/Taggable/Precise.hs | 9 ++-------
 2 files changed, 2 insertions(+), 8 deletions(-)

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index a8c99c660..a294452ae 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -33,7 +33,6 @@ library
       aeson              ^>= 1.4.2.0
     , base                >= 4.12 && < 5
     , bytestring         ^>= 0.10.8.2
-    , containers         ^>= 0.6.0.1
     , fused-effects      ^>= 0.5
     , text               ^>= 1.2.3.1
     , tree-sitter         == 0.3.0.0
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 8d6b56c16..6d197903f 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -10,7 +10,6 @@ import           Data.Aeson as A
 import           Data.Blob
 import           Data.Monoid (Endo(..))
 import           Data.Location
-import qualified Data.Set as Set
 import           Data.Text (Text)
 import           GHC.Generics
 import qualified TreeSitter.Python.AST as Python
@@ -46,14 +45,13 @@ newtype Python a = Python { getPython :: Python.Module a }
 
 type ContextToken = (Text, Maybe Range)
 
-runTagging :: Blob -> Set.Set Kind -> Python Location -> [Tag]
-runTagging blob symbolsToSummarize
+runTagging :: Blob -> Python Location -> [Tag]
+runTagging blob
   = ($ [])
   . appEndo
   . run
   . runReader @[ContextToken] []
   . runReader blob
-  . runReader symbolsToSummarize
   . tag
   . getPython where
 
@@ -62,7 +60,6 @@ class ToTag t where
     :: ( Carrier sig m
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
-       , Member (Reader (Set.Set Kind)) sig
        )
     => t Location
     -> m (Endo [Tag])
@@ -76,7 +73,6 @@ class ToTagBy (strategy :: Strategy) t where
     :: ( Carrier sig m
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
-       , Member (Reader (Set.Set Kind)) sig
        )
     => t Location
     -> m (Endo [Tag])
@@ -101,7 +97,6 @@ class GToTag t where
     :: ( Carrier sig m
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
-       , Member (Reader (Set.Set Kind)) sig
        )
     => t Location
     -> m (Endo [Tag])

From 088d280c3dd5c05177cd8667081510bb400319da Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Sep 2019 19:49:23 -0400
Subject: [PATCH 016/228] Define ToTag &c. at kind *.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 6d197903f..dd80db21c 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -61,7 +61,7 @@ class ToTag t where
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
        )
-    => t Location
+    => t
     -> m (Endo [Tag])
 
 instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag t where
@@ -74,21 +74,21 @@ class ToTagBy (strategy :: Strategy) t where
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
        )
-    => t Location
+    => t
     -> m (Endo [Tag])
 
 
 data Strategy = Generic | Custom
 
 type family ToTagInstance t :: Strategy where
-  ToTagInstance Python.FunctionDefinition = 'Custom
-  ToTagInstance _                         = 'Generic
+  ToTagInstance (Python.FunctionDefinition Location) = 'Custom
+  ToTagInstance _                                    = 'Generic
 
-instance ToTagBy 'Custom Python.FunctionDefinition where
+instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
   tag' Python.FunctionDefinition {} = pure mempty
 
 
-instance (Generic (t Location), GToTag (Rep (t Location))) => ToTagBy 'Generic t where
+instance (Generic t, GToTag (Rep t)) => ToTagBy 'Generic t where
   tag' = gtag . from
 
 
@@ -98,7 +98,7 @@ class GToTag t where
        , Member (Reader Blob) sig
        , Member (Reader [ContextToken]) sig
        )
-    => t Location
+    => t a
     -> m (Endo [Tag])
 
 

From 2384f0f92a3a2ed3b41a8191fa3774eaf649f662 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 10:19:59 -0400
Subject: [PATCH 017/228] Define a custom ToTagBy instance for Location.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index dd80db21c..3f736f14c 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -81,9 +81,13 @@ class ToTagBy (strategy :: Strategy) t where
 data Strategy = Generic | Custom
 
 type family ToTagInstance t :: Strategy where
+  ToTagInstance Location                             = 'Custom
   ToTagInstance (Python.FunctionDefinition Location) = 'Custom
   ToTagInstance _                                    = 'Generic
 
+instance ToTagBy 'Custom Location where
+  tag' _ = pure mempty
+
 instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
   tag' Python.FunctionDefinition {} = pure mempty
 

From 1161e21564b1ad74f8d10782727e2699e862f117 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 10:20:18 -0400
Subject: [PATCH 018/228] Define a custom ToTagBy instance for lists.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 3f736f14c..aae3c5bf9 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -8,7 +8,7 @@ module Tags.Taggable.Precise
 import           Control.Effect.Reader
 import           Data.Aeson as A
 import           Data.Blob
-import           Data.Monoid (Endo(..))
+import           Data.Monoid (Ap(..), Endo(..))
 import           Data.Location
 import           Data.Text (Text)
 import           GHC.Generics
@@ -82,12 +82,16 @@ data Strategy = Generic | Custom
 
 type family ToTagInstance t :: Strategy where
   ToTagInstance Location                             = 'Custom
+  ToTagInstance [_]                                  = 'Custom
   ToTagInstance (Python.FunctionDefinition Location) = 'Custom
   ToTagInstance _                                    = 'Generic
 
 instance ToTagBy 'Custom Location where
   tag' _ = pure mempty
 
+instance ToTag t => ToTagBy 'Custom [t] where
+  tag' = getAp . foldMap (Ap . tag)
+
 instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
   tag' Python.FunctionDefinition {} = pure mempty
 

From a52393f40589aba02e3d5354bd77f70ace892552 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 10:20:30 -0400
Subject: [PATCH 019/228] Define a custom ToTagBy instance for Either.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index aae3c5bf9..620e803c4 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -83,6 +83,7 @@ data Strategy = Generic | Custom
 type family ToTagInstance t :: Strategy where
   ToTagInstance Location                             = 'Custom
   ToTagInstance [_]                                  = 'Custom
+  ToTagInstance (Either _ _)                         = 'Custom
   ToTagInstance (Python.FunctionDefinition Location) = 'Custom
   ToTagInstance _                                    = 'Generic
 
@@ -92,6 +93,9 @@ instance ToTagBy 'Custom Location where
 instance ToTag t => ToTagBy 'Custom [t] where
   tag' = getAp . foldMap (Ap . tag)
 
+instance (ToTag l, ToTag r) => ToTagBy 'Custom (Either l r) where
+  tag' = either tag tag
+
 instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
   tag' Python.FunctionDefinition {} = pure mempty
 

From aa5c081802761cf8e6bb7b9acb9ea056ae826234 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 10:20:42 -0400
Subject: [PATCH 020/228] Define a GToTag instance for products.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 620e803c4..1872af750 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DeriveGeneric, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DeriveGeneric, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# LANGUAGE StandaloneDeriving #-}
 module Tags.Taggable.Precise
 ( Python(..)
@@ -116,3 +116,6 @@ class GToTag t where
 
 instance GToTag (M1 i c f) where
   gtag _ = pure mempty
+
+instance (GToTag f, GToTag g) => GToTag (f :*: g) where
+  gtag (f :*: g) = (<>) <$> gtag f <*> gtag g

From eb24f268bc861de4cd7a178816c127f5b576757c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 10:20:51 -0400
Subject: [PATCH 021/228] Define a GToTag instance for constants.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 1872af750..a5f2a2230 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -119,3 +119,6 @@ instance GToTag (M1 i c f) where
 
 instance (GToTag f, GToTag g) => GToTag (f :*: g) where
   gtag (f :*: g) = (<>) <$> gtag f <*> gtag g
+
+instance ToTag t => GToTag (K1 R t) where
+  gtag = tag . unK1

From f788d8fd50fbd1974f2dbd3824d3aefbe4f63e98 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 10:21:36 -0400
Subject: [PATCH 022/228] Define a GToTag instance for sums.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index a5f2a2230..759a39854 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -120,5 +120,9 @@ instance GToTag (M1 i c f) where
 instance (GToTag f, GToTag g) => GToTag (f :*: g) where
   gtag (f :*: g) = (<>) <$> gtag f <*> gtag g
 
+instance (GToTag f, GToTag g) => GToTag (f :+: g) where
+  gtag (L1 l) = gtag l
+  gtag (R1 r) = gtag r
+
 instance ToTag t => GToTag (K1 R t) where
   gtag = tag . unK1

From 5ad0e9e58ccfb08fb6e41a1de604dac9b2ba7981 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 10:22:18 -0400
Subject: [PATCH 023/228] Define a custom ToTagBy instance for Text.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 759a39854..cdb3d76b1 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -82,6 +82,7 @@ data Strategy = Generic | Custom
 
 type family ToTagInstance t :: Strategy where
   ToTagInstance Location                             = 'Custom
+  ToTagInstance Text                                 = 'Custom
   ToTagInstance [_]                                  = 'Custom
   ToTagInstance (Either _ _)                         = 'Custom
   ToTagInstance (Python.FunctionDefinition Location) = 'Custom
@@ -90,6 +91,9 @@ type family ToTagInstance t :: Strategy where
 instance ToTagBy 'Custom Location where
   tag' _ = pure mempty
 
+instance ToTagBy 'Custom Text where
+  tag' _ = pure mempty
+
 instance ToTag t => ToTagBy 'Custom [t] where
   tag' = getAp . foldMap (Ap . tag)
 

From bd9052452a6f779fa1d7bb8144c6e3ce129aec2c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 10:22:45 -0400
Subject: [PATCH 024/228] Define a GToTag for U1.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index cdb3d76b1..8e166aa80 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -130,3 +130,6 @@ instance (GToTag f, GToTag g) => GToTag (f :+: g) where
 
 instance ToTag t => GToTag (K1 R t) where
   gtag = tag . unK1
+
+instance GToTag U1 where
+  gtag _ = pure mempty

From c1304cbdf20f2b1221331bb2a500f766c8127c1c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 10:23:10 -0400
Subject: [PATCH 025/228] Define the GToTag instance for metadata by induction.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 8e166aa80..a8a14634e 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -118,8 +118,8 @@ class GToTag t where
     -> m (Endo [Tag])
 
 
-instance GToTag (M1 i c f) where
-  gtag _ = pure mempty
+instance GToTag f => GToTag (M1 i c f) where
+  gtag = gtag . unM1
 
 instance (GToTag f, GToTag g) => GToTag (f :*: g) where
   gtag (f :*: g) = (<>) <$> gtag f <*> gtag g

From dd7c1ce6f8b6a6c54336eace56fa4515ecbd544f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 12:09:47 -0400
Subject: [PATCH 026/228] Construct tags for Python functions.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index a8a14634e..4e12a0f30 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -9,6 +9,7 @@ import           Control.Effect.Reader
 import           Data.Aeson as A
 import           Data.Blob
 import           Data.Monoid (Ap(..), Endo(..))
+import           Data.List.NonEmpty (NonEmpty(..))
 import           Data.Location
 import           Data.Text (Text)
 import           GHC.Generics
@@ -101,8 +102,17 @@ instance (ToTag l, ToTag r) => ToTagBy 'Custom (Either l r) where
   tag' = either tag tag
 
 instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
-  tag' Python.FunctionDefinition {} = pure mempty
+  tag' Python.FunctionDefinition
+    { ann
+    , name = Python.Identifier { bytes = name }
+    , body = Python.Block { extraChildren }
+    } = case extraChildren of
+      x:_ | isDocComment x -> pure (Endo (Tag name Function (locationSpan ann) [] Nothing Nothing :))
+      _                    -> pure (Endo (Tag name Function (locationSpan ann) [] Nothing Nothing :))
 
+isDocComment :: Either (Python.CompoundStatement a) (Python.SimpleStatement a) -> Bool
+isDocComment (Right (Python.ExpressionStatementSimpleStatement (Python.ExpressionStatement { extraChildren = Left (Python.PrimaryExpressionExpression Python.StringPrimaryExpression{}) :|_ }))) = True
+isDocComment _ = False
 
 instance (Generic t, GToTag (Rep t)) => ToTagBy 'Generic t where
   tag' = gtag . from

From 4a7d90cf36675c91afa704c41e71d71abb51fac4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 12:52:52 -0400
Subject: [PATCH 027/228] Pass Source around instead of the entire Blob.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 4e12a0f30..48b11ec3b 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -7,10 +7,10 @@ module Tags.Taggable.Precise
 
 import           Control.Effect.Reader
 import           Data.Aeson as A
-import           Data.Blob
 import           Data.Monoid (Ap(..), Endo(..))
 import           Data.List.NonEmpty (NonEmpty(..))
 import           Data.Location
+import           Data.Source
 import           Data.Text (Text)
 import           GHC.Generics
 import qualified TreeSitter.Python.AST as Python
@@ -46,20 +46,20 @@ newtype Python a = Python { getPython :: Python.Module a }
 
 type ContextToken = (Text, Maybe Range)
 
-runTagging :: Blob -> Python Location -> [Tag]
-runTagging blob
+runTagging :: Source -> Python Location -> [Tag]
+runTagging source
   = ($ [])
   . appEndo
   . run
   . runReader @[ContextToken] []
-  . runReader blob
+  . runReader source
   . tag
   . getPython where
 
 class ToTag t where
   tag
     :: ( Carrier sig m
-       , Member (Reader Blob) sig
+       , Member (Reader Source) sig
        , Member (Reader [ContextToken]) sig
        )
     => t
@@ -72,7 +72,7 @@ instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag t where
 class ToTagBy (strategy :: Strategy) t where
   tag'
     :: ( Carrier sig m
-       , Member (Reader Blob) sig
+       , Member (Reader Source) sig
        , Member (Reader [ContextToken]) sig
        )
     => t
@@ -121,7 +121,7 @@ instance (Generic t, GToTag (Rep t)) => ToTagBy 'Generic t where
 class GToTag t where
   gtag
     :: ( Carrier sig m
-       , Member (Reader Blob) sig
+       , Member (Reader Source) sig
        , Member (Reader [ContextToken]) sig
        )
     => t a

From 7052ee9411cae8f5f977b5fb0e6c4ea8a0e6cf34 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 12:53:42 -0400
Subject: [PATCH 028/228] :fire: the copy of Data.Blob.

---
 semantic-tags/semantic-tags.cabal |  1 -
 semantic-tags/src/Data/Blob.hs    | 39 -------------------------------
 2 files changed, 40 deletions(-)
 delete mode 100644 semantic-tags/src/Data/Blob.hs

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index a294452ae..5c251ceaa 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -20,7 +20,6 @@ tested-with:         GHC == 8.6.5
 
 library
   exposed-modules:
-    Data.Blob
     Data.Language
     Data.Location
     Data.Range
diff --git a/semantic-tags/src/Data/Blob.hs b/semantic-tags/src/Data/Blob.hs
deleted file mode 100644
index 8ffa2006f..000000000
--- a/semantic-tags/src/Data/Blob.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-module Data.Blob
-( File(..)
-, Blob(..)
-, blobLanguage
-, blobPath
-, makeBlob
-) where
-
-import Data.Language
-import Data.Source as Source
-import Data.Text (Text)
-import GHC.Generics (Generic)
-
--- | A 'FilePath' paired with its corresponding 'Language'.
--- Unpacked to have the same size overhead as (FilePath, Language).
-data File = File
-  { filePath     :: FilePath
-  , fileLanguage :: Language
-  }
-  deriving (Show, Eq, Generic)
-
--- | The source, path information, and language of a file read from disk.
-data Blob = Blob
-  { blobSource   :: Source -- ^ The UTF-8 encoded source text of the blob.
-  , blobFile     :: File   -- ^ Path/language information for this blob.
-  , blobOid      :: Text   -- ^ Git OID for this blob, mempty if blob is not from a git db.
-  }
-  deriving (Show, Eq, Generic)
-
-blobLanguage :: Blob -> Language
-blobLanguage = fileLanguage . blobFile
-
-blobPath :: Blob -> FilePath
-blobPath = filePath . blobFile
-
-makeBlob :: Source -> FilePath -> Language -> Text -> Blob
-makeBlob s p l = Blob s (File p l)
-{-# INLINE makeBlob #-}

From 1c83f9c2acc503142f454f47c390a3540e1929c1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 12:54:14 -0400
Subject: [PATCH 029/228] Ignore .ghci_history files.

---
 .gitignore | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.gitignore b/.gitignore
index d267679dd..9352acf31 100644
--- a/.gitignore
+++ b/.gitignore
@@ -12,6 +12,7 @@ cabal.project.local*
 dist
 dist-newstyle
 .ghc.environment.*
+.ghci_history
 
 tmp/
 /bin/

From 7d493a94cadb1cd7f32021446b63720d382b90fd Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 13:06:17 -0400
Subject: [PATCH 030/228] :fire: the custom Show instance for Range.

---
 semantic-tags/src/Data/Range.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/semantic-tags/src/Data/Range.hs b/semantic-tags/src/Data/Range.hs
index 1a4180cb5..467194e7f 100644
--- a/semantic-tags/src/Data/Range.hs
+++ b/semantic-tags/src/Data/Range.hs
@@ -10,7 +10,7 @@ import GHC.Generics (Generic)
 
 -- | A half-open interval of integers, defined by start & end indices.
 data Range = Range { start :: {-# UNPACK #-} !Int, end :: {-# UNPACK #-} !Int }
-  deriving (Eq, Generic, Ord)
+  deriving (Eq, Generic, Ord, Show)
 
 -- | Return the length of the range.
 rangeLength :: Range -> Int
@@ -31,9 +31,6 @@ subtractRange range1 range2 = Range (start range1) (end range1 - rangeLength (Ra
 instance Semigroup Range where
   Range start1 end1 <> Range start2 end2 = Range (min start1 start2) (max end1 end2)
 
-instance Show Range where
-  showsPrec _ r = showChar '[' . shows (start r) . showString " .. " . shows (end r) . showChar ']'
-
 
 -- $setup
 -- >>> import Test.QuickCheck

From 6d56a096b6f2fed07d52a5c443fc7414907cfd82 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 14:38:54 -0400
Subject: [PATCH 031/228] Slice out the docs.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 48b11ec3b..913031eec 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -103,16 +103,19 @@ instance (ToTag l, ToTag r) => ToTagBy 'Custom (Either l r) where
 
 instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
   tag' Python.FunctionDefinition
-    { ann
+    { ann = Location _ span
     , name = Python.Identifier { bytes = name }
     , body = Python.Block { extraChildren }
-    } = case extraChildren of
-      x:_ | isDocComment x -> pure (Endo (Tag name Function (locationSpan ann) [] Nothing Nothing :))
-      _                    -> pure (Endo (Tag name Function (locationSpan ann) [] Nothing Nothing :))
+    } = do
+      src <- ask @Source
+      let docs = case extraChildren of
+            x:_ | Just (Python.String { ann }) <- docComment x -> Just (toText (slice (locationByteRange ann) src))
+            _                                                  -> Nothing
+      pure (Endo (Tag name Function span [] Nothing docs :))
 
-isDocComment :: Either (Python.CompoundStatement a) (Python.SimpleStatement a) -> Bool
-isDocComment (Right (Python.ExpressionStatementSimpleStatement (Python.ExpressionStatement { extraChildren = Left (Python.PrimaryExpressionExpression Python.StringPrimaryExpression{}) :|_ }))) = True
-isDocComment _ = False
+docComment :: Either (Python.CompoundStatement a) (Python.SimpleStatement a) -> Maybe (Python.String a)
+docComment (Right (Python.ExpressionStatementSimpleStatement (Python.ExpressionStatement { extraChildren = Left (Python.PrimaryExpressionExpression (Python.StringPrimaryExpression s)) :|_ }))) = Just s
+docComment _ = Nothing
 
 instance (Generic t, GToTag (Rep t)) => ToTagBy 'Generic t where
   tag' = gtag . from

From 53d84e0150891740c77d1de156ae6ae79a92f9c1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 14:42:04 -0400
Subject: [PATCH 032/228] Slice out the first line of the function definition.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 913031eec..1063ccc06 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -11,7 +11,7 @@ import           Data.Monoid (Ap(..), Endo(..))
 import           Data.List.NonEmpty (NonEmpty(..))
 import           Data.Location
 import           Data.Source
-import           Data.Text (Text)
+import           Data.Text as T
 import           GHC.Generics
 import qualified TreeSitter.Python.AST as Python
 
@@ -103,20 +103,24 @@ instance (ToTag l, ToTag r) => ToTagBy 'Custom (Either l r) where
 
 instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
   tag' Python.FunctionDefinition
-    { ann = Location _ span
+    { ann = Location Range { start } span
     , name = Python.Identifier { bytes = name }
-    , body = Python.Block { extraChildren }
+    , body = Python.Block { ann = Location Range { start = end } _, extraChildren }
     } = do
       src <- ask @Source
       let docs = case extraChildren of
             x:_ | Just (Python.String { ann }) <- docComment x -> Just (toText (slice (locationByteRange ann) src))
             _                                                  -> Nothing
-      pure (Endo (Tag name Function span [] Nothing docs :))
+          sliced = slice (Range start end) src
+      pure (Endo (Tag name Function span [] (Just (firstLine sliced)) docs :))
 
 docComment :: Either (Python.CompoundStatement a) (Python.SimpleStatement a) -> Maybe (Python.String a)
 docComment (Right (Python.ExpressionStatementSimpleStatement (Python.ExpressionStatement { extraChildren = Left (Python.PrimaryExpressionExpression (Python.StringPrimaryExpression s)) :|_ }))) = Just s
 docComment _ = Nothing
 
+firstLine :: Source -> Text
+firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
+
 instance (Generic t, GToTag (Rep t)) => ToTagBy 'Generic t where
   tag' = gtag . from
 

From 1597d9d5d2041015ab1d244334368553694a9e1f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 15:12:22 -0400
Subject: [PATCH 033/228] Define Unmarshal instances for Range, Span, and
 Location.

---
 semantic-tags/src/Data/Location.hs |  5 +++++
 semantic-tags/src/Data/Range.hs    | 13 +++++++++++--
 semantic-tags/src/Data/Span.hs     | 24 ++++++++++++++++--------
 3 files changed, 32 insertions(+), 10 deletions(-)

diff --git a/semantic-tags/src/Data/Location.hs b/semantic-tags/src/Data/Location.hs
index 16fcae7c2..a87bf5a73 100644
--- a/semantic-tags/src/Data/Location.hs
+++ b/semantic-tags/src/Data/Location.hs
@@ -5,12 +5,17 @@ module Data.Location
 , Range(..)
 ) where
 
+import Control.Applicative (liftA2)
 import Data.Range
 import Data.Span
 import GHC.Generics (Generic)
+import TreeSitter.Unmarshal
 
 data Location = Location
   { locationByteRange :: {-# UNPACK #-} !Range
   , locationSpan      :: {-# UNPACK #-} !Span
   }
   deriving (Eq, Generic, Ord, Show)
+
+instance Unmarshal Location where
+  unmarshalNodes = liftA2 Location <$> unmarshalNodes <*> unmarshalNodes
diff --git a/semantic-tags/src/Data/Range.hs b/semantic-tags/src/Data/Range.hs
index 467194e7f..41fa24967 100644
--- a/semantic-tags/src/Data/Range.hs
+++ b/semantic-tags/src/Data/Range.hs
@@ -7,6 +7,8 @@ module Data.Range
 ) where
 
 import GHC.Generics (Generic)
+import TreeSitter.Node
+import TreeSitter.Unmarshal
 
 -- | A half-open interval of integers, defined by start & end indices.
 data Range = Range { start :: {-# UNPACK #-} !Int, end :: {-# UNPACK #-} !Int }
@@ -24,13 +26,20 @@ subtractRange :: Range -> Range -> Range
 subtractRange range1 range2 = Range (start range1) (end range1 - rangeLength (Range (start range2) (max (end range1) (end range2))))
 
 
--- Instances
-
 -- $
 -- prop> a <> (b <> c) === (a <> b) <> (c :: Range)
 instance Semigroup Range where
   Range start1 end1 <> Range start2 end2 = Range (min start1 start2) (max end1 end2)
 
+instance Unmarshal Range where
+  unmarshalNodes _ = do
+    node <- peekNode
+    case node of
+      Just node -> do
+        let start = fromIntegral (nodeStartByte node)
+            end = fromIntegral (nodeEndByte node)
+        pure (Range start end)
+      Nothing -> fail "expected a node but didn't get one"
 
 -- $setup
 -- >>> import Test.QuickCheck
diff --git a/semantic-tags/src/Data/Span.hs b/semantic-tags/src/Data/Span.hs
index 1f04d3c6d..d45679c64 100644
--- a/semantic-tags/src/Data/Span.hs
+++ b/semantic-tags/src/Data/Span.hs
@@ -7,15 +7,14 @@ module Data.Span
 import           Data.Aeson ((.=))
 import qualified Data.Aeson as A
 import           GHC.Generics (Generic)
+import           TreeSitter.Node
+import           TreeSitter.Unmarshal
 
 data Span = Span
   { spanStart :: {-# UNPACK #-} !Pos
   , spanEnd   :: {-# UNPACK #-} !Pos
   }
-  deriving (Eq, Ord, Generic)
-
-instance Show Span where
-  showsPrec _ s = shows (spanStart s) . showString ".." . shows (spanEnd s)
+  deriving (Eq, Ord, Generic, Show)
 
 instance A.ToJSON Span where
   toJSON s = A.object
@@ -23,14 +22,23 @@ instance A.ToJSON Span where
     , "end"   .= spanEnd   s
     ]
 
+instance Unmarshal Span where
+  unmarshalNodes _ = do
+    node <- peekNode
+    case node of
+      Just node -> do
+        let spanStart = pointToPos (nodeStartPoint node)
+            spanEnd = pointToPos (nodeEndPoint node)
+        pure (Span spanStart spanEnd)
+      Nothing -> fail "expected a node but didn't get one"
+    where pointToPos (TSPoint line column) = Pos (fromIntegral line) (fromIntegral column)
+
+
 data Pos = Pos
   { posLine   :: {-# UNPACK #-} !Int
   , posColumn :: {-# UNPACK #-} !Int
   }
-  deriving (Eq, Ord, Generic)
-
-instance Show Pos where
-  showsPrec _ p = showChar '[' . shows (posLine p) . showString ", " . shows (posColumn p) . showChar ']'
+  deriving (Eq, Ord, Generic, Show)
 
 instance A.ToJSON Pos where
   toJSON p = A.toJSON [posLine p, posColumn p]

From 79625da5eed98cbbc80ec632bf52e8b7b2547fe0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 15:26:40 -0400
Subject: [PATCH 034/228] :fire: the Python newtype.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 11 +++--------
 1 file changed, 3 insertions(+), 8 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 1063ccc06..c83fc7313 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,8 +1,7 @@
 {-# LANGUAGE AllowAmbiguousTypes, DataKinds, DeriveGeneric, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# LANGUAGE StandaloneDeriving #-}
 module Tags.Taggable.Precise
-( Python(..)
-, runTagging
+( runTagging
 ) where
 
 import           Control.Effect.Reader
@@ -41,20 +40,16 @@ instance ToJSON Kind where
   toEncoding = toEncoding . show
 
 
-newtype Python a = Python { getPython :: Python.Module a }
-  deriving (Eq, Generic, Ord, Show)
-
 type ContextToken = (Text, Maybe Range)
 
-runTagging :: Source -> Python Location -> [Tag]
+runTagging :: Source -> Python.Module Location -> [Tag]
 runTagging source
   = ($ [])
   . appEndo
   . run
   . runReader @[ContextToken] []
   . runReader source
-  . tag
-  . getPython where
+  . tag where
 
 class ToTag t where
   tag

From a232f2e0185fa96c1626e9e19f8bd2a5e7e140f5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 16:11:17 -0400
Subject: [PATCH 035/228] :fire: Data.Language.

---
 semantic-tags/semantic-tags.cabal  |  1 -
 semantic-tags/src/Data/Language.hs | 28 ----------------------------
 2 files changed, 29 deletions(-)
 delete mode 100644 semantic-tags/src/Data/Language.hs

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 5c251ceaa..60d4c2aa7 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -20,7 +20,6 @@ tested-with:         GHC == 8.6.5
 
 library
   exposed-modules:
-    Data.Language
     Data.Location
     Data.Range
     Data.Source
diff --git a/semantic-tags/src/Data/Language.hs b/semantic-tags/src/Data/Language.hs
deleted file mode 100644
index 69bdd2c3f..000000000
--- a/semantic-tags/src/Data/Language.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-module Data.Language
-( Language (..)
-) where
-
-import Data.Aeson
-import GHC.Generics (Generic)
-
--- | The various languages we support.
--- Please do not reorder any of the field names: the current implementation of 'Primitive'
--- delegates to the auto-generated 'Enum' instance.
-data Language
-  = Unknown
-  | Go
-  | Haskell
-  | Java
-  | JavaScript
-  | JSON
-  | JSX
-  | Markdown
-  | Python
-  | Ruby
-  | TypeScript
-  | PHP
-  | TSX
-  deriving (Bounded, Enum, Eq, Generic, Ord, Read, Show)
-
-instance ToJSON Language

From 40cb091501ed31023fcc1f371171bc2dbd925b21 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:17:22 -0400
Subject: [PATCH 036/228] Use a writer effect to accumulate tags.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 22 ++++++++++++++--------
 1 file changed, 14 insertions(+), 8 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index c83fc7313..835ed40b1 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -5,8 +5,10 @@ module Tags.Taggable.Precise
 ) where
 
 import           Control.Effect.Reader
+import           Control.Effect.Writer
 import           Data.Aeson as A
-import           Data.Monoid (Ap(..), Endo(..))
+import           Data.Foldable (traverse_)
+import           Data.Monoid (Endo(..))
 import           Data.List.NonEmpty (NonEmpty(..))
 import           Data.Location
 import           Data.Source
@@ -47,6 +49,7 @@ runTagging source
   = ($ [])
   . appEndo
   . run
+  . execWriter
   . runReader @[ContextToken] []
   . runReader source
   . tag where
@@ -56,9 +59,10 @@ class ToTag t where
     :: ( Carrier sig m
        , Member (Reader Source) sig
        , Member (Reader [ContextToken]) sig
+       , Member (Writer (Endo [Tag])) sig
        )
     => t
-    -> m (Endo [Tag])
+    -> m ()
 
 instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag t where
   tag = tag' @strategy
@@ -69,9 +73,10 @@ class ToTagBy (strategy :: Strategy) t where
     :: ( Carrier sig m
        , Member (Reader Source) sig
        , Member (Reader [ContextToken]) sig
+       , Member (Writer (Endo [Tag])) sig
        )
     => t
-    -> m (Endo [Tag])
+    -> m ()
 
 
 data Strategy = Generic | Custom
@@ -85,13 +90,13 @@ type family ToTagInstance t :: Strategy where
   ToTagInstance _                                    = 'Generic
 
 instance ToTagBy 'Custom Location where
-  tag' _ = pure mempty
+  tag' _ = pure ()
 
 instance ToTagBy 'Custom Text where
-  tag' _ = pure mempty
+  tag' _ = pure ()
 
 instance ToTag t => ToTagBy 'Custom [t] where
-  tag' = getAp . foldMap (Ap . tag)
+  tag' = traverse_ tag
 
 instance (ToTag l, ToTag r) => ToTagBy 'Custom (Either l r) where
   tag' = either tag tag
@@ -107,7 +112,7 @@ instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
             x:_ | Just (Python.String { ann }) <- docComment x -> Just (toText (slice (locationByteRange ann) src))
             _                                                  -> Nothing
           sliced = slice (Range start end) src
-      pure (Endo (Tag name Function span [] (Just (firstLine sliced)) docs :))
+      tell (Endo (Tag name Function span [] (Just (firstLine sliced)) docs :))
 
 docComment :: Either (Python.CompoundStatement a) (Python.SimpleStatement a) -> Maybe (Python.String a)
 docComment (Right (Python.ExpressionStatementSimpleStatement (Python.ExpressionStatement { extraChildren = Left (Python.PrimaryExpressionExpression (Python.StringPrimaryExpression s)) :|_ }))) = Just s
@@ -125,9 +130,10 @@ class GToTag t where
     :: ( Carrier sig m
        , Member (Reader Source) sig
        , Member (Reader [ContextToken]) sig
+       , Member (Writer (Endo [Tag])) sig
        )
     => t a
-    -> m (Endo [Tag])
+    -> m ()
 
 
 instance GToTag f => GToTag (M1 i c f) where

From b8d54ae7a41c63329f450abe79ecacedf9eb184c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:20:01 -0400
Subject: [PATCH 037/228] Recur through function definitions.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 835ed40b1..5e818cd2a 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -105,6 +105,8 @@ instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
   tag' Python.FunctionDefinition
     { ann = Location Range { start } span
     , name = Python.Identifier { bytes = name }
+    , parameters
+    , returnType
     , body = Python.Block { ann = Location Range { start = end } _, extraChildren }
     } = do
       src <- ask @Source
@@ -113,6 +115,9 @@ instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
             _                                                  -> Nothing
           sliced = slice (Range start end) src
       tell (Endo (Tag name Function span [] (Just (firstLine sliced)) docs :))
+      tag parameters
+      tag returnType
+      traverse_ tag extraChildren
 
 docComment :: Either (Python.CompoundStatement a) (Python.SimpleStatement a) -> Maybe (Python.String a)
 docComment (Right (Python.ExpressionStatementSimpleStatement (Python.ExpressionStatement { extraChildren = Left (Python.PrimaryExpressionExpression (Python.StringPrimaryExpression s)) :|_ }))) = Just s

From 97706b763376e2678bdac2c66ad49816db6d7ecb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:20:40 -0400
Subject: [PATCH 038/228] Keep a list of Kinds for context.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 5e818cd2a..efc46f76f 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -20,7 +20,7 @@ data Tag = Tag
   { name :: Text
   , kind :: Kind
   , span :: Span
-  , context :: [Text]
+  , context :: [Kind]
   , line :: Maybe Text
   , docs :: Maybe Text
   }

From 925515634172b91e66dc78e6f6e8a75a92c5d37b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:23:54 -0400
Subject: [PATCH 039/228] Rename the import.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index efc46f76f..ce3045831 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -14,7 +14,7 @@ import           Data.Location
 import           Data.Source
 import           Data.Text as T
 import           GHC.Generics
-import qualified TreeSitter.Python.AST as Python
+import qualified TreeSitter.Python.AST as Py
 
 data Tag = Tag
   { name :: Text
@@ -44,7 +44,7 @@ instance ToJSON Kind where
 
 type ContextToken = (Text, Maybe Range)
 
-runTagging :: Source -> Python.Module Location -> [Tag]
+runTagging :: Source -> Py.Module Location -> [Tag]
 runTagging source
   = ($ [])
   . appEndo
@@ -86,7 +86,7 @@ type family ToTagInstance t :: Strategy where
   ToTagInstance Text                                 = 'Custom
   ToTagInstance [_]                                  = 'Custom
   ToTagInstance (Either _ _)                         = 'Custom
-  ToTagInstance (Python.FunctionDefinition Location) = 'Custom
+  ToTagInstance (Py.FunctionDefinition Location) = 'Custom
   ToTagInstance _                                    = 'Generic
 
 instance ToTagBy 'Custom Location where
@@ -101,17 +101,17 @@ instance ToTag t => ToTagBy 'Custom [t] where
 instance (ToTag l, ToTag r) => ToTagBy 'Custom (Either l r) where
   tag' = either tag tag
 
-instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
-  tag' Python.FunctionDefinition
+instance ToTagBy 'Custom (Py.FunctionDefinition Location) where
+  tag' Py.FunctionDefinition
     { ann = Location Range { start } span
-    , name = Python.Identifier { bytes = name }
+    , name = Py.Identifier { bytes = name }
     , parameters
     , returnType
-    , body = Python.Block { ann = Location Range { start = end } _, extraChildren }
+    , body = Py.Block { ann = Location Range { start = end } _, extraChildren }
     } = do
       src <- ask @Source
       let docs = case extraChildren of
-            x:_ | Just (Python.String { ann }) <- docComment x -> Just (toText (slice (locationByteRange ann) src))
+            x:_ | Just (Py.String { ann }) <- docComment x -> Just (toText (slice (locationByteRange ann) src))
             _                                                  -> Nothing
           sliced = slice (Range start end) src
       tell (Endo (Tag name Function span [] (Just (firstLine sliced)) docs :))
@@ -119,8 +119,8 @@ instance ToTagBy 'Custom (Python.FunctionDefinition Location) where
       tag returnType
       traverse_ tag extraChildren
 
-docComment :: Either (Python.CompoundStatement a) (Python.SimpleStatement a) -> Maybe (Python.String a)
-docComment (Right (Python.ExpressionStatementSimpleStatement (Python.ExpressionStatement { extraChildren = Left (Python.PrimaryExpressionExpression (Python.StringPrimaryExpression s)) :|_ }))) = Just s
+docComment :: Either (Py.CompoundStatement a) (Py.SimpleStatement a) -> Maybe (Py.String a)
+docComment (Right (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = Left (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression s)) :|_ }))) = Just s
 docComment _ = Nothing
 
 firstLine :: Source -> Text

From 933f6846c340a717d1c1f4ca10a6bfd702184747 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:26:33 -0400
Subject: [PATCH 040/228] Carry a list of kinds around.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index ce3045831..360b98801 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -42,15 +42,13 @@ instance ToJSON Kind where
   toEncoding = toEncoding . show
 
 
-type ContextToken = (Text, Maybe Range)
-
 runTagging :: Source -> Py.Module Location -> [Tag]
 runTagging source
   = ($ [])
   . appEndo
   . run
   . execWriter
-  . runReader @[ContextToken] []
+  . runReader @[Kind] []
   . runReader source
   . tag where
 
@@ -58,7 +56,7 @@ class ToTag t where
   tag
     :: ( Carrier sig m
        , Member (Reader Source) sig
-       , Member (Reader [ContextToken]) sig
+       , Member (Reader [Kind]) sig
        , Member (Writer (Endo [Tag])) sig
        )
     => t
@@ -72,7 +70,7 @@ class ToTagBy (strategy :: Strategy) t where
   tag'
     :: ( Carrier sig m
        , Member (Reader Source) sig
-       , Member (Reader [ContextToken]) sig
+       , Member (Reader [Kind]) sig
        , Member (Writer (Endo [Tag])) sig
        )
     => t
@@ -134,7 +132,7 @@ class GToTag t where
   gtag
     :: ( Carrier sig m
        , Member (Reader Source) sig
-       , Member (Reader [ContextToken]) sig
+       , Member (Reader [Kind]) sig
        , Member (Writer (Endo [Tag])) sig
        )
     => t a

From bc676e4891e7687a54ccff60bf7c35533559126c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:27:25 -0400
Subject: [PATCH 041/228] Extend the local context.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 360b98801..4a357fd92 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -113,9 +113,10 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Location) where
             _                                                  -> Nothing
           sliced = slice (Range start end) src
       tell (Endo (Tag name Function span [] (Just (firstLine sliced)) docs :))
-      tag parameters
-      tag returnType
-      traverse_ tag extraChildren
+      local (Function:) $ do
+        tag parameters
+        tag returnType
+        traverse_ tag extraChildren
 
 docComment :: Either (Py.CompoundStatement a) (Py.SimpleStatement a) -> Maybe (Py.String a)
 docComment (Right (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = Left (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression s)) :|_ }))) = Just s

From 91488c7923021c9e9d5a0a28e1a46f91d9374d5b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:27:46 -0400
Subject: [PATCH 042/228] Use the local context.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 4a357fd92..45ff10d0f 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -108,11 +108,12 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Location) where
     , body = Py.Block { ann = Location Range { start = end } _, extraChildren }
     } = do
       src <- ask @Source
+      ctx <- ask @[Kind]
       let docs = case extraChildren of
             x:_ | Just (Py.String { ann }) <- docComment x -> Just (toText (slice (locationByteRange ann) src))
             _                                                  -> Nothing
           sliced = slice (Range start end) src
-      tell (Endo (Tag name Function span [] (Just (firstLine sliced)) docs :))
+      tell (Endo (Tag name Function span ctx (Just (firstLine sliced)) docs :))
       local (Function:) $ do
         tag parameters
         tag returnType

From f56cc535e8a2d1e523cdfaa05c50f86f3f78a0fe Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:29:18 -0400
Subject: [PATCH 043/228] Align.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 45ff10d0f..198b0d5f0 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -80,12 +80,12 @@ class ToTagBy (strategy :: Strategy) t where
 data Strategy = Generic | Custom
 
 type family ToTagInstance t :: Strategy where
-  ToTagInstance Location                             = 'Custom
-  ToTagInstance Text                                 = 'Custom
-  ToTagInstance [_]                                  = 'Custom
-  ToTagInstance (Either _ _)                         = 'Custom
+  ToTagInstance Location                         = 'Custom
+  ToTagInstance Text                             = 'Custom
+  ToTagInstance [_]                              = 'Custom
+  ToTagInstance (Either _ _)                     = 'Custom
   ToTagInstance (Py.FunctionDefinition Location) = 'Custom
-  ToTagInstance _                                    = 'Generic
+  ToTagInstance _                                = 'Generic
 
 instance ToTagBy 'Custom Location where
   tag' _ = pure ()

From 3bb38471ed9dfb508129e4deecf0f5ad3f1a8a15 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:32:34 -0400
Subject: [PATCH 044/228] Define a helper to yield individual tags.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 198b0d5f0..e5e23b393 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -113,12 +113,15 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Location) where
             x:_ | Just (Py.String { ann }) <- docComment x -> Just (toText (slice (locationByteRange ann) src))
             _                                                  -> Nothing
           sliced = slice (Range start end) src
-      tell (Endo (Tag name Function span ctx (Just (firstLine sliced)) docs :))
+      yield (Tag name Function span ctx (Just (firstLine sliced)) docs)
       local (Function:) $ do
         tag parameters
         tag returnType
         traverse_ tag extraChildren
 
+yield :: (Carrier sig m, Member (Writer (Endo [Tag])) sig) => Tag -> m ()
+yield = tell . Endo . (:)
+
 docComment :: Either (Py.CompoundStatement a) (Py.SimpleStatement a) -> Maybe (Py.String a)
 docComment (Right (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = Left (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression s)) :|_ }))) = Just s
 docComment _ = Nothing

From 79022143c0eeda10f4f08ea00b9d8afe0c5c10c4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:38:05 -0400
Subject: [PATCH 045/228] Alignment.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index e5e23b393..2fd0f3df2 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -111,7 +111,7 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Location) where
       ctx <- ask @[Kind]
       let docs = case extraChildren of
             x:_ | Just (Py.String { ann }) <- docComment x -> Just (toText (slice (locationByteRange ann) src))
-            _                                                  -> Nothing
+            _                                              -> Nothing
           sliced = slice (Range start end) src
       yield (Tag name Function span ctx (Just (firstLine sliced)) docs)
       local (Function:) $ do

From 0a62bab659a1eb379489e12c2c39af9134999bfd Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:39:40 -0400
Subject: [PATCH 046/228] Simplify the extraction of doc comments.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 2fd0f3df2..7d3f3dfcf 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -8,6 +8,7 @@ import           Control.Effect.Reader
 import           Control.Effect.Writer
 import           Data.Aeson as A
 import           Data.Foldable (traverse_)
+import           Data.Maybe (listToMaybe)
 import           Data.Monoid (Endo(..))
 import           Data.List.NonEmpty (NonEmpty(..))
 import           Data.Location
@@ -109,9 +110,9 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Location) where
     } = do
       src <- ask @Source
       ctx <- ask @[Kind]
-      let docs = case extraChildren of
-            x:_ | Just (Py.String { ann }) <- docComment x -> Just (toText (slice (locationByteRange ann) src))
-            _                                              -> Nothing
+      let docs = case listToMaybe extraChildren >>= docComment of
+            Just Py.String { ann } -> Just (toText (slice (locationByteRange ann) src))
+            _                      -> Nothing
           sliced = slice (Range start end) src
       yield (Tag name Function span ctx (Just (firstLine sliced)) docs)
       local (Function:) $ do

From d0c30bf4b5488142d00d0b6a66e4a13fb592630e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Sep 2019 17:41:17 -0400
Subject: [PATCH 047/228] Slice the source in docComment.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 7d3f3dfcf..54345ea8d 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -110,9 +110,7 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Location) where
     } = do
       src <- ask @Source
       ctx <- ask @[Kind]
-      let docs = case listToMaybe extraChildren >>= docComment of
-            Just Py.String { ann } -> Just (toText (slice (locationByteRange ann) src))
-            _                      -> Nothing
+      let docs = listToMaybe extraChildren >>= docComment src
           sliced = slice (Range start end) src
       yield (Tag name Function span ctx (Just (firstLine sliced)) docs)
       local (Function:) $ do
@@ -123,9 +121,9 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Location) where
 yield :: (Carrier sig m, Member (Writer (Endo [Tag])) sig) => Tag -> m ()
 yield = tell . Endo . (:)
 
-docComment :: Either (Py.CompoundStatement a) (Py.SimpleStatement a) -> Maybe (Py.String a)
-docComment (Right (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = Left (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression s)) :|_ }))) = Just s
-docComment _ = Nothing
+docComment :: Source -> Either (Py.CompoundStatement Location) (Py.SimpleStatement Location) -> Maybe Text
+docComment src (Right (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = Left (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression Py.String { ann })) :|_ }))) = Just (toText (slice (locationByteRange ann) src))
+docComment _ _ = Nothing
 
 firstLine :: Source -> Text
 firstLine = T.take 180 . T.takeWhile (/= '\n') . toText

From 892a5c56c5ea46a32cdaab68144ee146361f29bd Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Sep 2019 18:35:52 -0400
Subject: [PATCH 048/228] Depend on semantic-source.

---
 semantic-tags/semantic-tags.cabal          |  5 +-
 semantic-tags/src/Data/Location.hs         | 21 ------
 semantic-tags/src/Data/Range.hs            | 46 -------------
 semantic-tags/src/Data/Source.hs           | 75 ----------------------
 semantic-tags/src/Data/Span.hs             | 44 -------------
 semantic-tags/src/Tags/Taggable/Precise.hs | 33 +++++-----
 6 files changed, 18 insertions(+), 206 deletions(-)
 delete mode 100644 semantic-tags/src/Data/Location.hs
 delete mode 100644 semantic-tags/src/Data/Range.hs
 delete mode 100644 semantic-tags/src/Data/Source.hs
 delete mode 100644 semantic-tags/src/Data/Span.hs

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 60d4c2aa7..d7bcbe835 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -20,10 +20,6 @@ tested-with:         GHC == 8.6.5
 
 library
   exposed-modules:
-    Data.Location
-    Data.Range
-    Data.Source
-    Data.Span
     Tags.Taggable.Precise
   -- other-modules:
   -- other-extensions:
@@ -32,6 +28,7 @@ library
     , base                >= 4.12 && < 5
     , bytestring         ^>= 0.10.8.2
     , fused-effects      ^>= 0.5
+    , semantic-source    ^>= 0.0
     , text               ^>= 1.2.3.1
     , tree-sitter         == 0.3.0.0
     , tree-sitter-python  == 0.4.0.0
diff --git a/semantic-tags/src/Data/Location.hs b/semantic-tags/src/Data/Location.hs
deleted file mode 100644
index a87bf5a73..000000000
--- a/semantic-tags/src/Data/Location.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-module Data.Location
-( Location(..)
-, Span(..)
-, Range(..)
-) where
-
-import Control.Applicative (liftA2)
-import Data.Range
-import Data.Span
-import GHC.Generics (Generic)
-import TreeSitter.Unmarshal
-
-data Location = Location
-  { locationByteRange :: {-# UNPACK #-} !Range
-  , locationSpan      :: {-# UNPACK #-} !Span
-  }
-  deriving (Eq, Generic, Ord, Show)
-
-instance Unmarshal Location where
-  unmarshalNodes = liftA2 Location <$> unmarshalNodes <*> unmarshalNodes
diff --git a/semantic-tags/src/Data/Range.hs b/semantic-tags/src/Data/Range.hs
deleted file mode 100644
index 41fa24967..000000000
--- a/semantic-tags/src/Data/Range.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-module Data.Range
-( Range(..)
-, rangeLength
-, intersectsRange
-, subtractRange
-) where
-
-import GHC.Generics (Generic)
-import TreeSitter.Node
-import TreeSitter.Unmarshal
-
--- | A half-open interval of integers, defined by start & end indices.
-data Range = Range { start :: {-# UNPACK #-} !Int, end :: {-# UNPACK #-} !Int }
-  deriving (Eq, Generic, Ord, Show)
-
--- | Return the length of the range.
-rangeLength :: Range -> Int
-rangeLength range = end range - start range
-
--- | Test two ranges for intersection.
-intersectsRange :: Range -> Range -> Bool
-intersectsRange range1 range2 = start range1 < end range2 && start range2 < end range1
-
-subtractRange :: Range -> Range -> Range
-subtractRange range1 range2 = Range (start range1) (end range1 - rangeLength (Range (start range2) (max (end range1) (end range2))))
-
-
--- $
--- prop> a <> (b <> c) === (a <> b) <> (c :: Range)
-instance Semigroup Range where
-  Range start1 end1 <> Range start2 end2 = Range (min start1 start2) (max end1 end2)
-
-instance Unmarshal Range where
-  unmarshalNodes _ = do
-    node <- peekNode
-    case node of
-      Just node -> do
-        let start = fromIntegral (nodeStartByte node)
-            end = fromIntegral (nodeEndByte node)
-        pure (Range start end)
-      Nothing -> fail "expected a node but didn't get one"
-
--- $setup
--- >>> import Test.QuickCheck
--- >>> instance Arbitrary Range where arbitrary = Range <$> arbitrary <*> arbitrary ; shrink (Range s e) = Range <$> shrink s <*> shrink e
diff --git a/semantic-tags/src/Data/Source.hs b/semantic-tags/src/Data/Source.hs
deleted file mode 100644
index afc14fdde..000000000
--- a/semantic-tags/src/Data/Source.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-module Data.Source
-( Source
-, sourceBytes
-, fromUTF8
--- Measurement
-, sourceLength
-, nullSource
-, totalRange
--- En/decoding
-, fromText
-, toText
--- Slicing
-, slice
-, dropSource
-) where
-
-import           Data.Aeson (FromJSON (..), withText)
-import qualified Data.ByteString as B
-import           Data.Range
-import           Data.String (IsString (..))
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import           GHC.Generics
-
-
--- | The contents of a source file. This is represented as a UTF-8
--- 'ByteString' under the hood. Construct these with 'fromUTF8'; obviously,
--- passing 'fromUTF8' non-UTF8 bytes will cause crashes.
-newtype Source = Source { sourceBytes :: B.ByteString }
-  deriving (Eq, Semigroup, Monoid, IsString, Show, Generic)
-
-fromUTF8 :: B.ByteString -> Source
-fromUTF8 = Source
-
-instance FromJSON Source where
-  parseJSON = withText "Source" (pure . fromText)
-
--- Measurement
-
-sourceLength :: Source -> Int
-sourceLength = B.length . sourceBytes
-
-nullSource :: Source -> Bool
-nullSource = B.null . sourceBytes
-
--- | Return a 'Range' that covers the entire text.
-totalRange :: Source -> Range
-totalRange = Range 0 . B.length . sourceBytes
-
-
--- En/decoding
-
--- | Return a 'Source' from a 'Text'.
-fromText :: T.Text -> Source
-fromText = Source . T.encodeUtf8
-
--- | Return the Text contained in the 'Source'.
-toText :: Source -> T.Text
-toText = T.decodeUtf8 . sourceBytes
-
-
--- | Return a 'Source' that contains a slice of the given 'Source'.
-slice :: Range -> Source -> Source
-slice range = take . drop
-  where drop = dropSource (start range)
-        take = takeSource (rangeLength range)
-
-dropSource :: Int -> Source -> Source
-dropSource i = Source . drop . sourceBytes
-  where drop = B.drop i
-
-takeSource :: Int -> Source -> Source
-takeSource i = Source . take . sourceBytes
-  where take = B.take i
diff --git a/semantic-tags/src/Data/Span.hs b/semantic-tags/src/Data/Span.hs
deleted file mode 100644
index d45679c64..000000000
--- a/semantic-tags/src/Data/Span.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
-module Data.Span
-( Span(..)
-, Pos(..)
-) where
-
-import           Data.Aeson ((.=))
-import qualified Data.Aeson as A
-import           GHC.Generics (Generic)
-import           TreeSitter.Node
-import           TreeSitter.Unmarshal
-
-data Span = Span
-  { spanStart :: {-# UNPACK #-} !Pos
-  , spanEnd   :: {-# UNPACK #-} !Pos
-  }
-  deriving (Eq, Ord, Generic, Show)
-
-instance A.ToJSON Span where
-  toJSON s = A.object
-    [ "start" .= spanStart s
-    , "end"   .= spanEnd   s
-    ]
-
-instance Unmarshal Span where
-  unmarshalNodes _ = do
-    node <- peekNode
-    case node of
-      Just node -> do
-        let spanStart = pointToPos (nodeStartPoint node)
-            spanEnd = pointToPos (nodeEndPoint node)
-        pure (Span spanStart spanEnd)
-      Nothing -> fail "expected a node but didn't get one"
-    where pointToPos (TSPoint line column) = Pos (fromIntegral line) (fromIntegral column)
-
-
-data Pos = Pos
-  { posLine   :: {-# UNPACK #-} !Int
-  , posColumn :: {-# UNPACK #-} !Int
-  }
-  deriving (Eq, Ord, Generic, Show)
-
-instance A.ToJSON Pos where
-  toJSON p = A.toJSON [posLine p, posColumn p]
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 54345ea8d..276f72044 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -11,10 +11,11 @@ import           Data.Foldable (traverse_)
 import           Data.Maybe (listToMaybe)
 import           Data.Monoid (Endo(..))
 import           Data.List.NonEmpty (NonEmpty(..))
-import           Data.Location
-import           Data.Source
 import           Data.Text as T
 import           GHC.Generics
+import           Source.Loc
+import           Source.Range
+import           Source.Source
 import qualified TreeSitter.Python.AST as Py
 
 data Tag = Tag
@@ -43,7 +44,7 @@ instance ToJSON Kind where
   toEncoding = toEncoding . show
 
 
-runTagging :: Source -> Py.Module Location -> [Tag]
+runTagging :: Source -> Py.Module Loc -> [Tag]
 runTagging source
   = ($ [])
   . appEndo
@@ -81,14 +82,14 @@ class ToTagBy (strategy :: Strategy) t where
 data Strategy = Generic | Custom
 
 type family ToTagInstance t :: Strategy where
-  ToTagInstance Location                         = 'Custom
-  ToTagInstance Text                             = 'Custom
-  ToTagInstance [_]                              = 'Custom
-  ToTagInstance (Either _ _)                     = 'Custom
-  ToTagInstance (Py.FunctionDefinition Location) = 'Custom
-  ToTagInstance _                                = 'Generic
+  ToTagInstance Loc                         = 'Custom
+  ToTagInstance Text                        = 'Custom
+  ToTagInstance [_]                         = 'Custom
+  ToTagInstance (Either _ _)                = 'Custom
+  ToTagInstance (Py.FunctionDefinition Loc) = 'Custom
+  ToTagInstance _                           = 'Generic
 
-instance ToTagBy 'Custom Location where
+instance ToTagBy 'Custom Loc where
   tag' _ = pure ()
 
 instance ToTagBy 'Custom Text where
@@ -100,18 +101,18 @@ instance ToTag t => ToTagBy 'Custom [t] where
 instance (ToTag l, ToTag r) => ToTagBy 'Custom (Either l r) where
   tag' = either tag tag
 
-instance ToTagBy 'Custom (Py.FunctionDefinition Location) where
+instance ToTagBy 'Custom (Py.FunctionDefinition Loc) where
   tag' Py.FunctionDefinition
-    { ann = Location Range { start } span
+    { ann = Loc Range { start } span
     , name = Py.Identifier { bytes = name }
     , parameters
     , returnType
-    , body = Py.Block { ann = Location Range { start = end } _, extraChildren }
+    , body = Py.Block { ann = Loc Range { start = end } _, extraChildren }
     } = do
       src <- ask @Source
       ctx <- ask @[Kind]
       let docs = listToMaybe extraChildren >>= docComment src
-          sliced = slice (Range start end) src
+          sliced = slice src (Range start end)
       yield (Tag name Function span ctx (Just (firstLine sliced)) docs)
       local (Function:) $ do
         tag parameters
@@ -121,8 +122,8 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Location) where
 yield :: (Carrier sig m, Member (Writer (Endo [Tag])) sig) => Tag -> m ()
 yield = tell . Endo . (:)
 
-docComment :: Source -> Either (Py.CompoundStatement Location) (Py.SimpleStatement Location) -> Maybe Text
-docComment src (Right (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = Left (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression Py.String { ann })) :|_ }))) = Just (toText (slice (locationByteRange ann) src))
+docComment :: Source -> Either (Py.CompoundStatement Loc) (Py.SimpleStatement Loc) -> Maybe Text
+docComment src (Right (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = Left (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression Py.String { ann })) :|_ }))) = Just (toText (slice src (byteRange ann)))
 docComment _ _ = Nothing
 
 firstLine :: Source -> Text

From 0f1982339774e246ff7f69e431655be1f223296f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 14:46:50 -0400
Subject: [PATCH 049/228] :fire: the context field.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 276f72044..0c2b953bc 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -22,7 +22,6 @@ data Tag = Tag
   { name :: Text
   , kind :: Kind
   , span :: Span
-  , context :: [Kind]
   , line :: Maybe Text
   , docs :: Maybe Text
   }
@@ -110,10 +109,9 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Loc) where
     , body = Py.Block { ann = Loc Range { start = end } _, extraChildren }
     } = do
       src <- ask @Source
-      ctx <- ask @[Kind]
       let docs = listToMaybe extraChildren >>= docComment src
           sliced = slice src (Range start end)
-      yield (Tag name Function span ctx (Just (firstLine sliced)) docs)
+      yield (Tag name Function span (Just (firstLine sliced)) docs)
       local (Function:) $ do
         tag parameters
         tag returnType

From 1098dd3667ef2422ad3191bd06cd87f833348a07 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 14:48:29 -0400
Subject: [PATCH 050/228] :fire: the context.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 11 +++--------
 1 file changed, 3 insertions(+), 8 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 0c2b953bc..b38502723 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -49,7 +49,6 @@ runTagging source
   . appEndo
   . run
   . execWriter
-  . runReader @[Kind] []
   . runReader source
   . tag where
 
@@ -57,7 +56,6 @@ class ToTag t where
   tag
     :: ( Carrier sig m
        , Member (Reader Source) sig
-       , Member (Reader [Kind]) sig
        , Member (Writer (Endo [Tag])) sig
        )
     => t
@@ -71,7 +69,6 @@ class ToTagBy (strategy :: Strategy) t where
   tag'
     :: ( Carrier sig m
        , Member (Reader Source) sig
-       , Member (Reader [Kind]) sig
        , Member (Writer (Endo [Tag])) sig
        )
     => t
@@ -112,10 +109,9 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Loc) where
       let docs = listToMaybe extraChildren >>= docComment src
           sliced = slice src (Range start end)
       yield (Tag name Function span (Just (firstLine sliced)) docs)
-      local (Function:) $ do
-        tag parameters
-        tag returnType
-        traverse_ tag extraChildren
+      tag parameters
+      tag returnType
+      traverse_ tag extraChildren
 
 yield :: (Carrier sig m, Member (Writer (Endo [Tag])) sig) => Tag -> m ()
 yield = tell . Endo . (:)
@@ -135,7 +131,6 @@ class GToTag t where
   gtag
     :: ( Carrier sig m
        , Member (Reader Source) sig
-       , Member (Reader [Kind]) sig
        , Member (Writer (Endo [Tag])) sig
        )
     => t a

From 11f8f62057bd933dbcd6fa4d1de8f32af5510f6e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 14:49:48 -0400
Subject: [PATCH 051/228] :fire: the ToJSON instances for Tag & Kind.

---
 semantic-tags/semantic-tags.cabal          | 3 +--
 semantic-tags/src/Tags/Taggable/Precise.hs | 7 -------
 2 files changed, 1 insertion(+), 9 deletions(-)

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index d7bcbe835..8e0f3dd1d 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -24,8 +24,7 @@ library
   -- other-modules:
   -- other-extensions:
   build-depends:
-      aeson              ^>= 1.4.2.0
-    , base                >= 4.12 && < 5
+      base                >= 4.12 && < 5
     , bytestring         ^>= 0.10.8.2
     , fused-effects      ^>= 0.5
     , semantic-source    ^>= 0.0
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index b38502723..3f502154b 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -6,7 +6,6 @@ module Tags.Taggable.Precise
 
 import           Control.Effect.Reader
 import           Control.Effect.Writer
-import           Data.Aeson as A
 import           Data.Foldable (traverse_)
 import           Data.Maybe (listToMaybe)
 import           Data.Monoid (Endo(..))
@@ -27,8 +26,6 @@ data Tag = Tag
   }
   deriving (Eq, Generic, Show)
 
-instance ToJSON Tag
-
 
 data Kind
   = Function
@@ -38,10 +35,6 @@ data Kind
   | Call
   deriving (Bounded, Enum, Eq, Generic, Show)
 
-instance ToJSON Kind where
-  toJSON = toJSON . show
-  toEncoding = toEncoding . show
-
 
 runTagging :: Source -> Py.Module Loc -> [Tag]
 runTagging source

From 97e47f95ba62a1404ddd77baeac076e8e6e60619 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 14:50:36 -0400
Subject: [PATCH 052/228] Stub in a module for Tag.

---
 semantic-tags/semantic-tags.cabal | 1 +
 semantic-tags/src/Tags/Tag.hs     | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-tags/src/Tags/Tag.hs

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 8e0f3dd1d..69cd3e3c1 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -20,6 +20,7 @@ tested-with:         GHC == 8.6.5
 
 library
   exposed-modules:
+    Tags.Tag
     Tags.Taggable.Precise
   -- other-modules:
   -- other-extensions:
diff --git a/semantic-tags/src/Tags/Tag.hs b/semantic-tags/src/Tags/Tag.hs
new file mode 100644
index 000000000..736ff574c
--- /dev/null
+++ b/semantic-tags/src/Tags/Tag.hs
@@ -0,0 +1,2 @@
+module Tags.Tag
+() where

From 1cd9be5cc4a22a4e6094f20362defeb083df71a2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 14:52:27 -0400
Subject: [PATCH 053/228] Move Tag & Kind to Tags.Tag.

---
 semantic-tags/src/Tags/Tag.hs              | 24 +++++++++++++++++++++-
 semantic-tags/src/Tags/Taggable/Precise.hs | 20 +-----------------
 2 files changed, 24 insertions(+), 20 deletions(-)

diff --git a/semantic-tags/src/Tags/Tag.hs b/semantic-tags/src/Tags/Tag.hs
index 736ff574c..247e6f115 100644
--- a/semantic-tags/src/Tags/Tag.hs
+++ b/semantic-tags/src/Tags/Tag.hs
@@ -1,2 +1,24 @@
 module Tags.Tag
-() where
+( Tag(..)
+, Kind(..)
+) where
+
+import Data.Text (Text)
+import Source.Span
+
+data Tag = Tag
+  { name :: Text
+  , kind :: Kind
+  , span :: Span
+  , line :: Maybe Text
+  , docs :: Maybe Text
+  }
+  deriving (Eq, Show)
+
+data Kind
+  = Function
+  | Method
+  | Class
+  | Module
+  | Call
+  deriving (Bounded, Enum, Eq, Show)
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 3f502154b..7173a2312 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -15,27 +15,9 @@ import           GHC.Generics
 import           Source.Loc
 import           Source.Range
 import           Source.Source
+import           Tags.Tag
 import qualified TreeSitter.Python.AST as Py
 
-data Tag = Tag
-  { name :: Text
-  , kind :: Kind
-  , span :: Span
-  , line :: Maybe Text
-  , docs :: Maybe Text
-  }
-  deriving (Eq, Generic, Show)
-
-
-data Kind
-  = Function
-  | Method
-  | Class
-  | Module
-  | Call
-  deriving (Bounded, Enum, Eq, Generic, Show)
-
-
 runTagging :: Source -> Py.Module Loc -> [Tag]
 runTagging source
   = ($ [])

From 5dccc3522b687999b01154a11da4e455418e2040 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 14:53:07 -0400
Subject: [PATCH 054/228] :fire: a redundant language extension.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 7173a2312..05ebdecbe 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DeriveGeneric, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# LANGUAGE StandaloneDeriving #-}
 module Tags.Taggable.Precise
 ( runTagging

From 69f5d8b1a3355cf657a4f0cab35b5c5c682c9757 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 15:01:13 -0400
Subject: [PATCH 055/228] Define a class to project elements out of :+:-trees.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 05ebdecbe..bf4394840 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -127,3 +127,7 @@ instance ToTag t => GToTag (K1 R t) where
 
 instance GToTag U1 where
   gtag _ = pure mempty
+
+
+class Element sub sup where
+  prj :: sup a -> Maybe (sub a)

From 6d377927077acbb0d8259fd617d5fec27bab6d9f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 15:01:27 -0400
Subject: [PATCH 056/228] Define an Element instance for matching leaves.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index bf4394840..9339db6ea 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -131,3 +131,7 @@ instance GToTag U1 where
 
 class Element sub sup where
   prj :: sup a -> Maybe (sub a)
+
+instance {-# OVERLAPPABLE #-}
+         Element t t where
+  prj = Just

From fe76c3dca6458c97b984a3953c017addc8bbc7cb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 15:01:38 -0400
Subject: [PATCH 057/228] Define an Element instance for reassociating
 left-nested trees.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 9339db6ea..387b10402 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -135,3 +135,11 @@ class Element sub sup where
 instance {-# OVERLAPPABLE #-}
          Element t t where
   prj = Just
+
+instance {-# OVERLAPPABLE #-}
+         Element t (l1 :+: l2 :+: r)
+      => Element t ((l1 :+: l2) :+: r) where
+  prj = prj . reassoc where
+    reassoc (L1 (L1 l)) = L1 l
+    reassoc (L1 (R1 l)) = R1 (L1 l)
+    reassoc (R1 r)      = R1 (R1 r)

From 4199011b42b3eba837b88167287b51d591e23567 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 15:02:17 -0400
Subject: [PATCH 058/228] Define an Element instance for matching on the left.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 387b10402..52e834f9e 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -143,3 +143,8 @@ instance {-# OVERLAPPABLE #-}
     reassoc (L1 (L1 l)) = L1 l
     reassoc (L1 (R1 l)) = R1 (L1 l)
     reassoc (R1 r)      = R1 (R1 r)
+
+instance {-# OVERLAPPABLE #-}
+         Element t (t :+: r) where
+  prj (L1 l) = Just l
+  prj _      = Nothing

From f9d968637258f80d5cc40dd62bf912d6f241e497 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 15:02:24 -0400
Subject: [PATCH 059/228] Define an Element instance for matching on the right.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 52e834f9e..8a6e5969c 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -148,3 +148,9 @@ instance {-# OVERLAPPABLE #-}
          Element t (t :+: r) where
   prj (L1 l) = Just l
   prj _      = Nothing
+
+instance {-# OVERLAPPABLE #-}
+         Element t r
+      => Element t (l :+: r) where
+  prj (R1 r) = prj r
+  prj _      = Nothing

From 422e6f883694502c93d1c578031a2ecc2d6a372d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 16:48:50 -0400
Subject: [PATCH 060/228] Use :+: in place of Either.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 8a6e5969c..f1ea9b508 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -56,7 +56,7 @@ type family ToTagInstance t :: Strategy where
   ToTagInstance Loc                         = 'Custom
   ToTagInstance Text                        = 'Custom
   ToTagInstance [_]                         = 'Custom
-  ToTagInstance (Either _ _)                = 'Custom
+  ToTagInstance ((_ :+: _) _)               = 'Custom
   ToTagInstance (Py.FunctionDefinition Loc) = 'Custom
   ToTagInstance _                           = 'Generic
 
@@ -69,8 +69,9 @@ instance ToTagBy 'Custom Text where
 instance ToTag t => ToTagBy 'Custom [t] where
   tag' = traverse_ tag
 
-instance (ToTag l, ToTag r) => ToTagBy 'Custom (Either l r) where
-  tag' = either tag tag
+instance (ToTag (l a), ToTag (r a)) => ToTagBy 'Custom ((l :+: r) a) where
+  tag' (L1 l) = tag l
+  tag' (R1 r) = tag r
 
 instance ToTagBy 'Custom (Py.FunctionDefinition Loc) where
   tag' Py.FunctionDefinition
@@ -91,8 +92,8 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Loc) where
 yield :: (Carrier sig m, Member (Writer (Endo [Tag])) sig) => Tag -> m ()
 yield = tell . Endo . (:)
 
-docComment :: Source -> Either (Py.CompoundStatement Loc) (Py.SimpleStatement Loc) -> Maybe Text
-docComment src (Right (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = Left (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression Py.String { ann })) :|_ }))) = Just (toText (slice src (byteRange ann)))
+docComment :: Source -> (Py.CompoundStatement :+: Py.SimpleStatement) Loc -> Maybe Text
+docComment src (R1 (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = L1 (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression Py.String { ann })) :|_ }))) = Just (toText (slice src (byteRange ann)))
 docComment _ _ = Nothing
 
 firstLine :: Source -> Text

From c4daf7bcea02474a6dc69ff74b8e5d120c55f18b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:14:49 -0400
Subject: [PATCH 061/228] Use Generic1 representations for ToTagBy 'Generic.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index f1ea9b508..a6d495c3a 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -99,9 +99,11 @@ docComment _ _ = Nothing
 firstLine :: Source -> Text
 firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
 
-instance (Generic t, GToTag (Rep t)) => ToTagBy 'Generic t where
-  tag' = gtag . from
+instance (Generic1 t, GToTag (Rep1 t)) => ToTagBy 'Generic (t Loc) where
+  tag' = gtag . from1
 
+instance (Foldable f, ToTag (g Loc)) => ToTagBy 'Generic (f (g Loc)) where
+  tag' = mapM_ tag
 
 class GToTag t where
   gtag
@@ -109,7 +111,7 @@ class GToTag t where
        , Member (Reader Source) sig
        , Member (Writer (Endo [Tag])) sig
        )
-    => t a
+    => t Loc
     -> m ()
 
 
@@ -126,6 +128,15 @@ instance (GToTag f, GToTag g) => GToTag (f :+: g) where
 instance ToTag t => GToTag (K1 R t) where
   gtag = tag . unK1
 
+instance GToTag Par1 where
+  gtag _ = pure ()
+
+instance ToTag (t Loc) => GToTag (Rec1 t) where
+  gtag = tag . unRec1
+
+instance (Foldable f, GToTag g) => GToTag (f :.: g) where
+  gtag = mapM_ gtag . unComp1
+
 instance GToTag U1 where
   gtag _ = pure mempty
 

From 683ab79c06e919601842fe684d20f666eda623d0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:36:45 -0400
Subject: [PATCH 062/228] Stub in a custom ToTagBy instance for class
 definitions.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index a6d495c3a..ff3185990 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -58,6 +58,7 @@ type family ToTagInstance t :: Strategy where
   ToTagInstance [_]                         = 'Custom
   ToTagInstance ((_ :+: _) _)               = 'Custom
   ToTagInstance (Py.FunctionDefinition Loc) = 'Custom
+  ToTagInstance (Py.ClassDefinition Loc)    = 'Custom
   ToTagInstance _                           = 'Generic
 
 instance ToTagBy 'Custom Loc where
@@ -89,6 +90,9 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Loc) where
       tag returnType
       traverse_ tag extraChildren
 
+instance ToTagBy 'Custom (Py.ClassDefinition Loc) where
+  tag' Py.ClassDefinition {} = pure ()
+
 yield :: (Carrier sig m, Member (Writer (Endo [Tag])) sig) => Tag -> m ()
 yield = tell . Endo . (:)
 

From 4993275b5c14f5c67aa8a3d1f88e4a1a8c998e03 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:36:55 -0400
Subject: [PATCH 063/228] Stub in a custom ToTagBy instance for calls.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index ff3185990..618fae96b 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -59,6 +59,7 @@ type family ToTagInstance t :: Strategy where
   ToTagInstance ((_ :+: _) _)               = 'Custom
   ToTagInstance (Py.FunctionDefinition Loc) = 'Custom
   ToTagInstance (Py.ClassDefinition Loc)    = 'Custom
+  ToTagInstance (Py.Call Loc)               = 'Custom
   ToTagInstance _                           = 'Generic
 
 instance ToTagBy 'Custom Loc where
@@ -93,6 +94,9 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Loc) where
 instance ToTagBy 'Custom (Py.ClassDefinition Loc) where
   tag' Py.ClassDefinition {} = pure ()
 
+instance ToTagBy 'Custom (Py.Call Loc) where
+  tag' Py.Call {} = pure ()
+
 yield :: (Carrier sig m, Member (Writer (Endo [Tag])) sig) => Tag -> m ()
 yield = tell . Endo . (:)
 

From ea917d2d0d0e9913fce8f72af887e57483a910cb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:37:14 -0400
Subject: [PATCH 064/228] :fire: a redundant language extension.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 618fae96b..b263d5396 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
-{-# LANGUAGE StandaloneDeriving #-}
 module Tags.Taggable.Precise
 ( runTagging
 ) where

From 26d064d4510146d8c55537276b27d418dffd21ce Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:38:53 -0400
Subject: [PATCH 065/228] =?UTF-8?q?Don=E2=80=99t=20call=20ToTag=20for=20co?=
 =?UTF-8?q?nstant=20fields.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index b263d5396..9e1ad2aad 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -132,8 +132,8 @@ instance (GToTag f, GToTag g) => GToTag (f :+: g) where
   gtag (L1 l) = gtag l
   gtag (R1 r) = gtag r
 
-instance ToTag t => GToTag (K1 R t) where
-  gtag = tag . unK1
+instance GToTag (K1 R t) where
+  gtag _ = pure ()
 
 instance GToTag Par1 where
   gtag _ = pure ()

From 6e0a69603eb3e3d76db6fe8a2dc437d83d3e463b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:39:33 -0400
Subject: [PATCH 066/228] :fire: the ToTagBy instance for Loc.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 9e1ad2aad..e0c9fe8f1 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -52,7 +52,6 @@ class ToTagBy (strategy :: Strategy) t where
 data Strategy = Generic | Custom
 
 type family ToTagInstance t :: Strategy where
-  ToTagInstance Loc                         = 'Custom
   ToTagInstance Text                        = 'Custom
   ToTagInstance [_]                         = 'Custom
   ToTagInstance ((_ :+: _) _)               = 'Custom
@@ -61,9 +60,6 @@ type family ToTagInstance t :: Strategy where
   ToTagInstance (Py.Call Loc)               = 'Custom
   ToTagInstance _                           = 'Generic
 
-instance ToTagBy 'Custom Loc where
-  tag' _ = pure ()
-
 instance ToTagBy 'Custom Text where
   tag' _ = pure ()
 

From 7922af23fe6f7e12b1df1172f1bb25c97aa99047 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:39:58 -0400
Subject: [PATCH 067/228] :fire: the ToTagBy instance for Text.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index e0c9fe8f1..648702161 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -52,7 +52,6 @@ class ToTagBy (strategy :: Strategy) t where
 data Strategy = Generic | Custom
 
 type family ToTagInstance t :: Strategy where
-  ToTagInstance Text                        = 'Custom
   ToTagInstance [_]                         = 'Custom
   ToTagInstance ((_ :+: _) _)               = 'Custom
   ToTagInstance (Py.FunctionDefinition Loc) = 'Custom
@@ -60,9 +59,6 @@ type family ToTagInstance t :: Strategy where
   ToTagInstance (Py.Call Loc)               = 'Custom
   ToTagInstance _                           = 'Generic
 
-instance ToTagBy 'Custom Text where
-  tag' _ = pure ()
-
 instance ToTag t => ToTagBy 'Custom [t] where
   tag' = traverse_ tag
 

From 2ba64b1e081699bb55403912cb3ca8df67b5f66c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:40:37 -0400
Subject: [PATCH 068/228] :fire: the ToTagInstance for lists.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 648702161..b16a114a2 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -52,16 +52,12 @@ class ToTagBy (strategy :: Strategy) t where
 data Strategy = Generic | Custom
 
 type family ToTagInstance t :: Strategy where
-  ToTagInstance [_]                         = 'Custom
   ToTagInstance ((_ :+: _) _)               = 'Custom
   ToTagInstance (Py.FunctionDefinition Loc) = 'Custom
   ToTagInstance (Py.ClassDefinition Loc)    = 'Custom
   ToTagInstance (Py.Call Loc)               = 'Custom
   ToTagInstance _                           = 'Generic
 
-instance ToTag t => ToTagBy 'Custom [t] where
-  tag' = traverse_ tag
-
 instance (ToTag (l a), ToTag (r a)) => ToTagBy 'Custom ((l :+: r) a) where
   tag' (L1 l) = tag l
   tag' (R1 r) = tag r

From ca854d1b2854f3d4744dee9abadc49dc2aca3e47 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:45:45 -0400
Subject: [PATCH 069/228] Define ToTagBy at * -> *.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 29 ++++++++++------------
 1 file changed, 13 insertions(+), 16 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index b16a114a2..aa715a2bd 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -35,7 +35,7 @@ class ToTag t where
     => t
     -> m ()
 
-instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag t where
+instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag (t Loc) where
   tag = tag' @strategy
 
 
@@ -45,24 +45,24 @@ class ToTagBy (strategy :: Strategy) t where
        , Member (Reader Source) sig
        , Member (Writer (Endo [Tag])) sig
        )
-    => t
+    => t Loc
     -> m ()
 
 
 data Strategy = Generic | Custom
 
 type family ToTagInstance t :: Strategy where
-  ToTagInstance ((_ :+: _) _)               = 'Custom
-  ToTagInstance (Py.FunctionDefinition Loc) = 'Custom
-  ToTagInstance (Py.ClassDefinition Loc)    = 'Custom
-  ToTagInstance (Py.Call Loc)               = 'Custom
-  ToTagInstance _                           = 'Generic
+  ToTagInstance (_ :+: _)             = 'Custom
+  ToTagInstance Py.FunctionDefinition = 'Custom
+  ToTagInstance Py.ClassDefinition    = 'Custom
+  ToTagInstance Py.Call               = 'Custom
+  ToTagInstance _                     = 'Generic
 
-instance (ToTag (l a), ToTag (r a)) => ToTagBy 'Custom ((l :+: r) a) where
+instance (ToTag (l Loc), ToTag (r Loc)) => ToTagBy 'Custom (l :+: r) where
   tag' (L1 l) = tag l
   tag' (R1 r) = tag r
 
-instance ToTagBy 'Custom (Py.FunctionDefinition Loc) where
+instance ToTagBy 'Custom Py.FunctionDefinition where
   tag' Py.FunctionDefinition
     { ann = Loc Range { start } span
     , name = Py.Identifier { bytes = name }
@@ -75,13 +75,13 @@ instance ToTagBy 'Custom (Py.FunctionDefinition Loc) where
           sliced = slice src (Range start end)
       yield (Tag name Function span (Just (firstLine sliced)) docs)
       tag parameters
-      tag returnType
+      traverse_ tag returnType
       traverse_ tag extraChildren
 
-instance ToTagBy 'Custom (Py.ClassDefinition Loc) where
+instance ToTagBy 'Custom Py.ClassDefinition where
   tag' Py.ClassDefinition {} = pure ()
 
-instance ToTagBy 'Custom (Py.Call Loc) where
+instance ToTagBy 'Custom Py.Call where
   tag' Py.Call {} = pure ()
 
 yield :: (Carrier sig m, Member (Writer (Endo [Tag])) sig) => Tag -> m ()
@@ -94,12 +94,9 @@ docComment _ _ = Nothing
 firstLine :: Source -> Text
 firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
 
-instance (Generic1 t, GToTag (Rep1 t)) => ToTagBy 'Generic (t Loc) where
+instance (Generic1 t, GToTag (Rep1 t)) => ToTagBy 'Generic t where
   tag' = gtag . from1
 
-instance (Foldable f, ToTag (g Loc)) => ToTagBy 'Generic (f (g Loc)) where
-  tag' = mapM_ tag
-
 class GToTag t where
   gtag
     :: ( Carrier sig m

From ea8d5a8817d58989f971c1f4fed10c1a74ef8b81 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:47:10 -0400
Subject: [PATCH 070/228] Define ToTag at * -> *.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index aa715a2bd..44649e1c9 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -32,10 +32,10 @@ class ToTag t where
        , Member (Reader Source) sig
        , Member (Writer (Endo [Tag])) sig
        )
-    => t
+    => t Loc
     -> m ()
 
-instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag (t Loc) where
+instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag t where
   tag = tag' @strategy
 
 
@@ -58,7 +58,7 @@ type family ToTagInstance t :: Strategy where
   ToTagInstance Py.Call               = 'Custom
   ToTagInstance _                     = 'Generic
 
-instance (ToTag (l Loc), ToTag (r Loc)) => ToTagBy 'Custom (l :+: r) where
+instance (ToTag l, ToTag r) => ToTagBy 'Custom (l :+: r) where
   tag' (L1 l) = tag l
   tag' (R1 r) = tag r
 
@@ -123,7 +123,7 @@ instance GToTag (K1 R t) where
 instance GToTag Par1 where
   gtag _ = pure ()
 
-instance ToTag (t Loc) => GToTag (Rec1 t) where
+instance ToTag t => GToTag (Rec1 t) where
   gtag = tag . unRec1
 
 instance (Foldable f, GToTag g) => GToTag (f :.: g) where

From 61915b815229c3b18c1b3eb5444ebd20ba341392 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:50:20 -0400
Subject: [PATCH 071/228] Flesh out the ToTagBy instance for
 Py.ClassDefinition.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 44649e1c9..678c2230f 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -79,7 +79,18 @@ instance ToTagBy 'Custom Py.FunctionDefinition where
       traverse_ tag extraChildren
 
 instance ToTagBy 'Custom Py.ClassDefinition where
-  tag' Py.ClassDefinition {} = pure ()
+  tag' Py.ClassDefinition
+    { ann = Loc Range { start } span
+    , name = Py.Identifier { bytes = name }
+    , superclasses
+    , body = Py.Block { ann = Loc Range { start = end } _, extraChildren }
+    } = do
+      src <- ask @Source
+      let docs = listToMaybe extraChildren >>= docComment src
+          sliced = slice src (Range start end)
+      yield (Tag name Class span (Just (firstLine sliced)) docs)
+      traverse_ tag superclasses
+      traverse_ tag extraChildren
 
 instance ToTagBy 'Custom Py.Call where
   tag' Py.Call {} = pure ()

From e816d602607372901783b96ca9f32bbe6faaf4a9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:51:43 -0400
Subject: [PATCH 072/228] Flesh out the ToTagBy instance for calls.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 678c2230f..bf828f2a4 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -93,6 +93,15 @@ instance ToTagBy 'Custom Py.ClassDefinition where
       traverse_ tag extraChildren
 
 instance ToTagBy 'Custom Py.Call where
+  tag' Py.Call
+    { ann = Loc range span
+    , function = Py.IdentifierPrimaryExpression Py.Identifier { bytes = name }
+    , arguments
+    } = do
+      src <- ask @Source
+      let sliced = slice src range
+      yield (Tag name Call span (Just (firstLine sliced)) Nothing)
+      tag arguments
   tag' Py.Call {} = pure ()
 
 yield :: (Carrier sig m, Member (Writer (Endo [Tag])) sig) => Tag -> m ()

From b5cffe8ebe706a23c9f4ae9f07e7760d492bc4f3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 17:52:22 -0400
Subject: [PATCH 073/228] Tags always have lines.

---
 semantic-tags/src/Tags/Tag.hs              | 2 +-
 semantic-tags/src/Tags/Taggable/Precise.hs | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-tags/src/Tags/Tag.hs b/semantic-tags/src/Tags/Tag.hs
index 247e6f115..b8561255d 100644
--- a/semantic-tags/src/Tags/Tag.hs
+++ b/semantic-tags/src/Tags/Tag.hs
@@ -10,7 +10,7 @@ data Tag = Tag
   { name :: Text
   , kind :: Kind
   , span :: Span
-  , line :: Maybe Text
+  , line :: Text
   , docs :: Maybe Text
   }
   deriving (Eq, Show)
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index bf828f2a4..3cfa577d8 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -73,7 +73,7 @@ instance ToTagBy 'Custom Py.FunctionDefinition where
       src <- ask @Source
       let docs = listToMaybe extraChildren >>= docComment src
           sliced = slice src (Range start end)
-      yield (Tag name Function span (Just (firstLine sliced)) docs)
+      yield (Tag name Function span (firstLine sliced) docs)
       tag parameters
       traverse_ tag returnType
       traverse_ tag extraChildren
@@ -88,7 +88,7 @@ instance ToTagBy 'Custom Py.ClassDefinition where
       src <- ask @Source
       let docs = listToMaybe extraChildren >>= docComment src
           sliced = slice src (Range start end)
-      yield (Tag name Class span (Just (firstLine sliced)) docs)
+      yield (Tag name Class span (firstLine sliced) docs)
       traverse_ tag superclasses
       traverse_ tag extraChildren
 
@@ -100,7 +100,7 @@ instance ToTagBy 'Custom Py.Call where
     } = do
       src <- ask @Source
       let sliced = slice src range
-      yield (Tag name Call span (Just (firstLine sliced)) Nothing)
+      yield (Tag name Call span (firstLine sliced) Nothing)
       tag arguments
   tag' Py.Call {} = pure ()
 

From b7a93aed3d0e2bc6f897b67ec4c56bce52c5620d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 18:00:36 -0400
Subject: [PATCH 074/228] Define a class for projecting out the members of a
 sum.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 3cfa577d8..48b80d0dc 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -178,3 +178,8 @@ instance {-# OVERLAPPABLE #-}
       => Element t (l :+: r) where
   prj (R1 r) = prj r
   prj _      = Nothing
+
+
+class GSum t where
+  type Members t :: (* -> *)
+  gmembers :: t a -> Members t a

From 30dad2da720c2c070b1c1df4ab765076f32e92d4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 18:00:46 -0400
Subject: [PATCH 075/228] Define a GSum instance for M1.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 48b80d0dc..9fdca6d64 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -183,3 +183,7 @@ instance {-# OVERLAPPABLE #-}
 class GSum t where
   type Members t :: (* -> *)
   gmembers :: t a -> Members t a
+
+instance GSum f => GSum (M1 i c f) where
+  type Members (M1 i c f) = Members f
+  gmembers = gmembers . unM1

From 5231b4f282c5c8af45079087dc8f509890200659 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 18:01:00 -0400
Subject: [PATCH 076/228] Define a GSum instance for sums.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 9fdca6d64..d11f5925b 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -187,3 +187,8 @@ class GSum t where
 instance GSum f => GSum (M1 i c f) where
   type Members (M1 i c f) = Members f
   gmembers = gmembers . unM1
+
+instance (GSum f, GSum g) => GSum (f :+: g) where
+  type Members (f :+: g) = Members f :+: Members g
+  gmembers (L1 l) = L1 (gmembers l)
+  gmembers (R1 r) = R1 (gmembers r)

From 377fe62b9a087dbd2b44bc9ba3e1b9e8d481f5e1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 18:01:06 -0400
Subject: [PATCH 077/228] Define a GSum instance for Rec1.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index d11f5925b..e5d447c93 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -192,3 +192,7 @@ instance (GSum f, GSum g) => GSum (f :+: g) where
   type Members (f :+: g) = Members f :+: Members g
   gmembers (L1 l) = L1 (gmembers l)
   gmembers (R1 r) = R1 (gmembers r)
+
+instance GSum (Rec1 f) where
+  type Members (Rec1 f) = f
+  gmembers = unRec1

From 2420a52d68c12c17568e9cc40b5bb2b16f9f95ee Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 23 Sep 2019 18:01:17 -0400
Subject: [PATCH 078/228] Use GSum to project function identifiers out.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index e5d447c93..c91712676 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances, ViewPatterns #-}
 module Tags.Taggable.Precise
 ( runTagging
 ) where
@@ -95,7 +95,7 @@ instance ToTagBy 'Custom Py.ClassDefinition where
 instance ToTagBy 'Custom Py.Call where
   tag' Py.Call
     { ann = Loc range span
-    , function = Py.IdentifierPrimaryExpression Py.Identifier { bytes = name }
+    , function = prj . members -> Just Py.Identifier { bytes = name }
     , arguments
     } = do
       src <- ask @Source
@@ -180,6 +180,9 @@ instance {-# OVERLAPPABLE #-}
   prj _      = Nothing
 
 
+members :: (Generic1 t, GSum (Rep1 t)) => t a -> Members (Rep1 t) a
+members = gmembers . from1
+
 class GSum t where
   type Members t :: (* -> *)
   gmembers :: t a -> Members t a

From 482e5d705b236ff24636c2281aa3caa2c21eaaf7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 11:23:01 -0400
Subject: [PATCH 079/228] Revert "Use GSum to project function identifiers
 out."

This reverts commit 2420a52d68c12c17568e9cc40b5bb2b16f9f95ee.
---
 semantic-tags/src/Tags/Taggable/Precise.hs | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index c91712676..e5d447c93 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances, ViewPatterns #-}
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Tags.Taggable.Precise
 ( runTagging
 ) where
@@ -95,7 +95,7 @@ instance ToTagBy 'Custom Py.ClassDefinition where
 instance ToTagBy 'Custom Py.Call where
   tag' Py.Call
     { ann = Loc range span
-    , function = prj . members -> Just Py.Identifier { bytes = name }
+    , function = Py.IdentifierPrimaryExpression Py.Identifier { bytes = name }
     , arguments
     } = do
       src <- ask @Source
@@ -180,9 +180,6 @@ instance {-# OVERLAPPABLE #-}
   prj _      = Nothing
 
 
-members :: (Generic1 t, GSum (Rep1 t)) => t a -> Members (Rep1 t) a
-members = gmembers . from1
-
 class GSum t where
   type Members t :: (* -> *)
   gmembers :: t a -> Members t a

From 160f61355d0ea736b1ecaf9fbafaff59fd487acb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 11:23:04 -0400
Subject: [PATCH 080/228] Revert "Define a GSum instance for Rec1."

This reverts commit 377fe62b9a087dbd2b44bc9ba3e1b9e8d481f5e1.
---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index e5d447c93..d11f5925b 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -192,7 +192,3 @@ instance (GSum f, GSum g) => GSum (f :+: g) where
   type Members (f :+: g) = Members f :+: Members g
   gmembers (L1 l) = L1 (gmembers l)
   gmembers (R1 r) = R1 (gmembers r)
-
-instance GSum (Rec1 f) where
-  type Members (Rec1 f) = f
-  gmembers = unRec1

From 578223a17f525d108dde16e9559a1055100c573a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 11:23:08 -0400
Subject: [PATCH 081/228] Revert "Define a GSum instance for sums."

This reverts commit 5231b4f282c5c8af45079087dc8f509890200659.
---
 semantic-tags/src/Tags/Taggable/Precise.hs | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index d11f5925b..9fdca6d64 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -187,8 +187,3 @@ class GSum t where
 instance GSum f => GSum (M1 i c f) where
   type Members (M1 i c f) = Members f
   gmembers = gmembers . unM1
-
-instance (GSum f, GSum g) => GSum (f :+: g) where
-  type Members (f :+: g) = Members f :+: Members g
-  gmembers (L1 l) = L1 (gmembers l)
-  gmembers (R1 r) = R1 (gmembers r)

From 257290085867b1214950dc26722432ea3e76ef8f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 11:23:10 -0400
Subject: [PATCH 082/228] Revert "Define a GSum instance for M1."

This reverts commit 30dad2da720c2c070b1c1df4ab765076f32e92d4.
---
 semantic-tags/src/Tags/Taggable/Precise.hs | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 9fdca6d64..48b80d0dc 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -183,7 +183,3 @@ instance {-# OVERLAPPABLE #-}
 class GSum t where
   type Members t :: (* -> *)
   gmembers :: t a -> Members t a
-
-instance GSum f => GSum (M1 i c f) where
-  type Members (M1 i c f) = Members f
-  gmembers = gmembers . unM1

From f613113ddaeb1b007192c408f01d5bed12473c4a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 11:23:13 -0400
Subject: [PATCH 083/228] Revert "Define a class for projecting out the members
 of a sum."

This reverts commit b7a93aed3d0e2bc6f897b67ec4c56bce52c5620d.
---
 semantic-tags/src/Tags/Taggable/Precise.hs | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 48b80d0dc..3cfa577d8 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -178,8 +178,3 @@ instance {-# OVERLAPPABLE #-}
       => Element t (l :+: r) where
   prj (R1 r) = prj r
   prj _      = Nothing
-
-
-class GSum t where
-  type Members t :: (* -> *)
-  gmembers :: t a -> Members t a

From c45b96f577e576443c2874880fa2fd127b36821a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 12:19:47 -0400
Subject: [PATCH 084/228] Define a type family computing boolean or.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 3cfa577d8..0a5568e54 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -156,6 +156,12 @@ instance GToTag U1 where
 class Element sub sup where
   prj :: sup a -> Maybe (sub a)
 
+
+type family a || b where
+  'True || _     = 'True
+  _     || 'True = 'True
+  _     || _     = 'False
+
 instance {-# OVERLAPPABLE #-}
          Element t t where
   prj = Just

From e05860cc812c5847cd3a4f39a376429d4a230589 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 12:22:01 -0400
Subject: [PATCH 085/228] Define a type family computing occurrence within a
 nested sum.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 0a5568e54..5c4964242 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -157,6 +157,11 @@ class Element sub sup where
   prj :: sup a -> Maybe (sub a)
 
 
+type family Elem sub sup where
+  Elem t t         = 'True
+  Elem t (l :+: r) = Elem t l || Elem t r
+  Elem _ _         = 'False
+
 type family a || b where
   'True || _     = 'True
   _     || 'True = 'True

From 16fa52194d8f5f4b4e1f5f2c1fddf2ef5685b312 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 12:22:18 -0400
Subject: [PATCH 086/228] Abstract projection out into a helper indexed by
 occurrence.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 32 +++++++++++++---------
 1 file changed, 19 insertions(+), 13 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 5c4964242..26c539e8e 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -156,6 +156,9 @@ instance GToTag U1 where
 class Element sub sup where
   prj :: sup a -> Maybe (sub a)
 
+instance (Element' elem sub sup, elem ~ Elem sub sup) => Element sub sup where
+  prj = prj' @elem
+
 
 type family Elem sub sup where
   Elem t t         = 'True
@@ -167,25 +170,28 @@ type family a || b where
   _     || 'True = 'True
   _     || _     = 'False
 
-instance {-# OVERLAPPABLE #-}
-         Element t t where
-  prj = Just
+class Element' (elem :: Bool) sub sup where
+  prj' :: sup a -> Maybe (sub a)
 
 instance {-# OVERLAPPABLE #-}
-         Element t (l1 :+: l2 :+: r)
-      => Element t ((l1 :+: l2) :+: r) where
-  prj = prj . reassoc where
+         Element' 'True t t where
+  prj' = Just
+
+instance {-# OVERLAPPABLE #-}
+         Element' 'True t (l1 :+: l2 :+: r)
+      => Element' 'True t ((l1 :+: l2) :+: r) where
+  prj' = prj' @'True . reassoc where
     reassoc (L1 (L1 l)) = L1 l
     reassoc (L1 (R1 l)) = R1 (L1 l)
     reassoc (R1 r)      = R1 (R1 r)
 
 instance {-# OVERLAPPABLE #-}
-         Element t (t :+: r) where
-  prj (L1 l) = Just l
-  prj _      = Nothing
+         Element' 'True t (t :+: r) where
+  prj' (L1 l) = Just l
+  prj' _      = Nothing
 
 instance {-# OVERLAPPABLE #-}
-         Element t r
-      => Element t (l :+: r) where
-  prj (R1 r) = prj r
-  prj _      = Nothing
+         Element' 'True t r
+      => Element' 'True t (l :+: r) where
+  prj' (R1 r) = prj' @'True r
+  prj' _      = Nothing

From 986349d6d4b5fd527dc7375cc8040b220f52a637 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 12:23:09 -0400
Subject: [PATCH 087/228] Define a type family to show a sum.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 26c539e8e..25d7111e0 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -11,6 +11,7 @@ import           Data.Monoid (Endo(..))
 import           Data.List.NonEmpty (NonEmpty(..))
 import           Data.Text as T
 import           GHC.Generics
+import           GHC.TypeLits (ErrorMessage(..))
 import           Source.Loc
 import           Source.Range
 import           Source.Source
@@ -195,3 +196,12 @@ instance {-# OVERLAPPABLE #-}
       => Element' 'True t (l :+: r) where
   prj' (R1 r) = prj' @'True r
   prj' _      = Nothing
+
+
+type family ShowSum t where
+  ShowSum (l :+: r) = ShowSum' ('Text "{ ") (l :+: r) ':$$: 'Text "}"
+  ShowSum t         = 'Text "{ " ':<>: 'ShowType t ':<>: 'Text " }"
+
+type family ShowSum' p t where
+  ShowSum' p (l :+: r) = ShowSum' p l ':$$: ShowSum' ('Text ", ") r
+  ShowSum' p t         = p ':<>: 'ShowType t

From 5d7f3552ab85b09997ce466d808f203c8c832730 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 12:23:50 -0400
Subject: [PATCH 088/228] =?UTF-8?q?Define=20an=20instance=20of=20Element'?=
 =?UTF-8?q?=20to=20give=20a=20custom=20type=20error=20when=20a=20member=20?=
 =?UTF-8?q?isn=E2=80=99t=20found.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 25d7111e0..a58540a18 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -11,7 +11,7 @@ import           Data.Monoid (Endo(..))
 import           Data.List.NonEmpty (NonEmpty(..))
 import           Data.Text as T
 import           GHC.Generics
-import           GHC.TypeLits (ErrorMessage(..))
+import           GHC.TypeLits (ErrorMessage(..), TypeError)
 import           Source.Loc
 import           Source.Range
 import           Source.Source
@@ -205,3 +205,9 @@ type family ShowSum t where
 type family ShowSum' p t where
   ShowSum' p (l :+: r) = ShowSum' p l ':$$: ShowSum' ('Text ", ") r
   ShowSum' p t         = p ':<>: 'ShowType t
+
+instance TypeError
+           (     'ShowType t ':<>: 'Text " is not in"
+           ':$$: ShowSum u)
+      => Element' 'False t u where
+  prj' _ = Nothing

From 25b3dcc738ddf9fde36b6cd216ebb6be5d83ac64 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 12:31:33 -0400
Subject: [PATCH 089/228] Export Element.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index a58540a18..7803f278a 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Tags.Taggable.Precise
 ( runTagging
+, Element(..)
 ) where
 
 import           Control.Effect.Reader

From ee5d1b0a3ff64f08438140e902b77aa34c60236a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 14:06:06 -0400
Subject: [PATCH 090/228] Stub in a file for Element.

---
 semantic-tags/semantic-tags.cabal | 1 +
 semantic-tags/src/AST/Element.hs  | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-tags/src/AST/Element.hs

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 69cd3e3c1..5cfec8c75 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -20,6 +20,7 @@ tested-with:         GHC == 8.6.5
 
 library
   exposed-modules:
+    AST.Element
     Tags.Tag
     Tags.Taggable.Precise
   -- other-modules:
diff --git a/semantic-tags/src/AST/Element.hs b/semantic-tags/src/AST/Element.hs
new file mode 100644
index 000000000..24fad5dc8
--- /dev/null
+++ b/semantic-tags/src/AST/Element.hs
@@ -0,0 +1,2 @@
+module AST.Element
+() where

From 6e7b373214b8bb9aca2cdb0808424c30a7a5e531 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 14:10:27 -0400
Subject: [PATCH 091/228] :fire: a redundant language extension.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 7803f278a..97ea4551e 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Tags.Taggable.Precise
 ( runTagging
 , Element(..)

From 1aa4e9a87fb3c51feaee09bd5b39b5c653938b14 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 14:11:03 -0400
Subject: [PATCH 092/228] Move Element into AST.Element.

---
 semantic-tags/src/AST/Element.hs           | 65 +++++++++++++++++++++-
 semantic-tags/src/Tags/Taggable/Precise.hs | 61 --------------------
 2 files changed, 64 insertions(+), 62 deletions(-)

diff --git a/semantic-tags/src/AST/Element.hs b/semantic-tags/src/AST/Element.hs
index 24fad5dc8..a0a34e84e 100644
--- a/semantic-tags/src/AST/Element.hs
+++ b/semantic-tags/src/AST/Element.hs
@@ -1,2 +1,65 @@
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module AST.Element
-() where
+( Element(..)
+) where
+
+import GHC.Generics
+import GHC.TypeLits (ErrorMessage(..), TypeError)
+
+class Element sub sup where
+  prj :: sup a -> Maybe (sub a)
+
+instance (Element' elem sub sup, elem ~ Elem sub sup) => Element sub sup where
+  prj = prj' @elem
+
+
+type family Elem sub sup where
+  Elem t t         = 'True
+  Elem t (l :+: r) = Elem t l || Elem t r
+  Elem _ _         = 'False
+
+type family a || b where
+  'True || _     = 'True
+  _     || 'True = 'True
+  _     || _     = 'False
+
+class Element' (elem :: Bool) sub sup where
+  prj' :: sup a -> Maybe (sub a)
+
+instance {-# OVERLAPPABLE #-}
+         Element' 'True t t where
+  prj' = Just
+
+instance {-# OVERLAPPABLE #-}
+         Element' 'True t (l1 :+: l2 :+: r)
+      => Element' 'True t ((l1 :+: l2) :+: r) where
+  prj' = prj' @'True . reassoc where
+    reassoc (L1 (L1 l)) = L1 l
+    reassoc (L1 (R1 l)) = R1 (L1 l)
+    reassoc (R1 r)      = R1 (R1 r)
+
+instance {-# OVERLAPPABLE #-}
+         Element' 'True t (t :+: r) where
+  prj' (L1 l) = Just l
+  prj' _      = Nothing
+
+instance {-# OVERLAPPABLE #-}
+         Element' 'True t r
+      => Element' 'True t (l :+: r) where
+  prj' (R1 r) = prj' @'True r
+  prj' _      = Nothing
+
+
+type family ShowSum t where
+  ShowSum (l :+: r) = ShowSum' ('Text "{ ") (l :+: r) ':$$: 'Text "}"
+  ShowSum t         = 'Text "{ " ':<>: 'ShowType t ':<>: 'Text " }"
+
+type family ShowSum' p t where
+  ShowSum' p (l :+: r) = ShowSum' p l ':$$: ShowSum' ('Text ", ") r
+  ShowSum' p t         = p ':<>: 'ShowType t
+
+instance TypeError
+           (     'ShowType t ':<>: 'Text " is not in"
+           ':$$: ShowSum u)
+      => Element' 'False t u where
+  prj' _ = Nothing
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 97ea4551e..21d7862fa 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Tags.Taggable.Precise
 ( runTagging
-, Element(..)
 ) where
 
 import           Control.Effect.Reader
@@ -12,7 +11,6 @@ import           Data.Monoid (Endo(..))
 import           Data.List.NonEmpty (NonEmpty(..))
 import           Data.Text as T
 import           GHC.Generics
-import           GHC.TypeLits (ErrorMessage(..), TypeError)
 import           Source.Loc
 import           Source.Range
 import           Source.Source
@@ -153,62 +151,3 @@ instance (Foldable f, GToTag g) => GToTag (f :.: g) where
 
 instance GToTag U1 where
   gtag _ = pure mempty
-
-
-class Element sub sup where
-  prj :: sup a -> Maybe (sub a)
-
-instance (Element' elem sub sup, elem ~ Elem sub sup) => Element sub sup where
-  prj = prj' @elem
-
-
-type family Elem sub sup where
-  Elem t t         = 'True
-  Elem t (l :+: r) = Elem t l || Elem t r
-  Elem _ _         = 'False
-
-type family a || b where
-  'True || _     = 'True
-  _     || 'True = 'True
-  _     || _     = 'False
-
-class Element' (elem :: Bool) sub sup where
-  prj' :: sup a -> Maybe (sub a)
-
-instance {-# OVERLAPPABLE #-}
-         Element' 'True t t where
-  prj' = Just
-
-instance {-# OVERLAPPABLE #-}
-         Element' 'True t (l1 :+: l2 :+: r)
-      => Element' 'True t ((l1 :+: l2) :+: r) where
-  prj' = prj' @'True . reassoc where
-    reassoc (L1 (L1 l)) = L1 l
-    reassoc (L1 (R1 l)) = R1 (L1 l)
-    reassoc (R1 r)      = R1 (R1 r)
-
-instance {-# OVERLAPPABLE #-}
-         Element' 'True t (t :+: r) where
-  prj' (L1 l) = Just l
-  prj' _      = Nothing
-
-instance {-# OVERLAPPABLE #-}
-         Element' 'True t r
-      => Element' 'True t (l :+: r) where
-  prj' (R1 r) = prj' @'True r
-  prj' _      = Nothing
-
-
-type family ShowSum t where
-  ShowSum (l :+: r) = ShowSum' ('Text "{ ") (l :+: r) ':$$: 'Text "}"
-  ShowSum t         = 'Text "{ " ':<>: 'ShowType t ':<>: 'Text " }"
-
-type family ShowSum' p t where
-  ShowSum' p (l :+: r) = ShowSum' p l ':$$: ShowSum' ('Text ", ") r
-  ShowSum' p t         = p ':<>: 'ShowType t
-
-instance TypeError
-           (     'ShowType t ':<>: 'Text " is not in"
-           ':$$: ShowSum u)
-      => Element' 'False t u where
-  prj' _ = Nothing

From ad43b0c1a2db280ae1143926a9fccb4a27a83505 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 14:11:38 -0400
Subject: [PATCH 093/228] :fire: AST.Element for now.

---
 semantic-tags/semantic-tags.cabal |  1 -
 semantic-tags/src/AST/Element.hs  | 65 -------------------------------
 2 files changed, 66 deletions(-)
 delete mode 100644 semantic-tags/src/AST/Element.hs

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 5cfec8c75..69cd3e3c1 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -20,7 +20,6 @@ tested-with:         GHC == 8.6.5
 
 library
   exposed-modules:
-    AST.Element
     Tags.Tag
     Tags.Taggable.Precise
   -- other-modules:
diff --git a/semantic-tags/src/AST/Element.hs b/semantic-tags/src/AST/Element.hs
deleted file mode 100644
index a0a34e84e..000000000
--- a/semantic-tags/src/AST/Element.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
-module AST.Element
-( Element(..)
-) where
-
-import GHC.Generics
-import GHC.TypeLits (ErrorMessage(..), TypeError)
-
-class Element sub sup where
-  prj :: sup a -> Maybe (sub a)
-
-instance (Element' elem sub sup, elem ~ Elem sub sup) => Element sub sup where
-  prj = prj' @elem
-
-
-type family Elem sub sup where
-  Elem t t         = 'True
-  Elem t (l :+: r) = Elem t l || Elem t r
-  Elem _ _         = 'False
-
-type family a || b where
-  'True || _     = 'True
-  _     || 'True = 'True
-  _     || _     = 'False
-
-class Element' (elem :: Bool) sub sup where
-  prj' :: sup a -> Maybe (sub a)
-
-instance {-# OVERLAPPABLE #-}
-         Element' 'True t t where
-  prj' = Just
-
-instance {-# OVERLAPPABLE #-}
-         Element' 'True t (l1 :+: l2 :+: r)
-      => Element' 'True t ((l1 :+: l2) :+: r) where
-  prj' = prj' @'True . reassoc where
-    reassoc (L1 (L1 l)) = L1 l
-    reassoc (L1 (R1 l)) = R1 (L1 l)
-    reassoc (R1 r)      = R1 (R1 r)
-
-instance {-# OVERLAPPABLE #-}
-         Element' 'True t (t :+: r) where
-  prj' (L1 l) = Just l
-  prj' _      = Nothing
-
-instance {-# OVERLAPPABLE #-}
-         Element' 'True t r
-      => Element' 'True t (l :+: r) where
-  prj' (R1 r) = prj' @'True r
-  prj' _      = Nothing
-
-
-type family ShowSum t where
-  ShowSum (l :+: r) = ShowSum' ('Text "{ ") (l :+: r) ':$$: 'Text "}"
-  ShowSum t         = 'Text "{ " ':<>: 'ShowType t ':<>: 'Text " }"
-
-type family ShowSum' p t where
-  ShowSum' p (l :+: r) = ShowSum' p l ':$$: ShowSum' ('Text ", ") r
-  ShowSum' p t         = p ':<>: 'ShowType t
-
-instance TypeError
-           (     'ShowType t ':<>: 'Text " is not in"
-           ':$$: ShowSum u)
-      => Element' 'False t u where
-  prj' _ = Nothing

From aa350b9db6369fa17d7cd29251fdeef9279d74eb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 14:14:12 -0400
Subject: [PATCH 094/228] Stub in a module for Python tagging.

---
 semantic-tags/semantic-tags.cabal         | 1 +
 semantic-tags/src/Language/Python/Tags.hs | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-tags/src/Language/Python/Tags.hs

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 69cd3e3c1..23a463fbb 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -20,6 +20,7 @@ tested-with:         GHC == 8.6.5
 
 library
   exposed-modules:
+    Language.Python.Tags
     Tags.Tag
     Tags.Taggable.Precise
   -- other-modules:
diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
new file mode 100644
index 000000000..425d2b02f
--- /dev/null
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -0,0 +1,2 @@
+module Language.Python.Tags
+() where

From 0ca230c1d6b9377920d9cae511e70b6b048f3c01 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:01:38 -0400
Subject: [PATCH 095/228] Define a type synonym for Tags.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 21d7862fa..45d6c9e2e 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Tags.Taggable.Precise
 ( runTagging
+, Tags
 ) where
 
 import           Control.Effect.Reader
@@ -26,11 +27,13 @@ runTagging source
   . runReader source
   . tag where
 
+type Tags = Endo [Tag]
+
 class ToTag t where
   tag
     :: ( Carrier sig m
        , Member (Reader Source) sig
-       , Member (Writer (Endo [Tag])) sig
+       , Member (Writer Tags) sig
        )
     => t Loc
     -> m ()
@@ -43,7 +46,7 @@ class ToTagBy (strategy :: Strategy) t where
   tag'
     :: ( Carrier sig m
        , Member (Reader Source) sig
-       , Member (Writer (Endo [Tag])) sig
+       , Member (Writer Tags) sig
        )
     => t Loc
     -> m ()
@@ -104,7 +107,7 @@ instance ToTagBy 'Custom Py.Call where
       tag arguments
   tag' Py.Call {} = pure ()
 
-yield :: (Carrier sig m, Member (Writer (Endo [Tag])) sig) => Tag -> m ()
+yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
 yield = tell . Endo . (:)
 
 docComment :: Source -> (Py.CompoundStatement :+: Py.SimpleStatement) Loc -> Maybe Text
@@ -121,7 +124,7 @@ class GToTag t where
   gtag
     :: ( Carrier sig m
        , Member (Reader Source) sig
-       , Member (Writer (Endo [Tag])) sig
+       , Member (Writer Tags) sig
        )
     => t Loc
     -> m ()

From e8c1348d36242ce60095f24f7010d94e62701abb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:01:50 -0400
Subject: [PATCH 096/228] Export yield.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 45d6c9e2e..61433d9bb 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -2,6 +2,7 @@
 module Tags.Taggable.Precise
 ( runTagging
 , Tags
+, yield
 ) where
 
 import           Control.Effect.Reader

From 2bfb9c3ef8c4657a4a800bc5b9f9a185d2767ad0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:02:31 -0400
Subject: [PATCH 097/228] Move yield up.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 61433d9bb..750d3c3ff 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -39,6 +39,11 @@ class ToTag t where
     => t Loc
     -> m ()
 
+
+yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
+yield = tell . Endo . (:)
+
+
 instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag t where
   tag = tag' @strategy
 
@@ -108,9 +113,6 @@ instance ToTagBy 'Custom Py.Call where
       tag arguments
   tag' Py.Call {} = pure ()
 
-yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
-yield = tell . Endo . (:)
-
 docComment :: Source -> (Py.CompoundStatement :+: Py.SimpleStatement) Loc -> Maybe Text
 docComment src (R1 (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = L1 (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression Py.String { ann })) :|_ }))) = Just (toText (slice src (byteRange ann)))
 docComment _ _ = Nothing

From 7108915e21868e2c0f52d22088b1050650c2d210 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:09:18 -0400
Subject: [PATCH 098/228] :fire: a redundant where clause.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 750d3c3ff..739c92060 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -26,7 +26,7 @@ runTagging source
   . run
   . execWriter
   . runReader source
-  . tag where
+  . tag
 
 type Tags = Endo [Tag]
 

From c6189128b6580658fc86d125faea20fe78f545b4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:09:31 -0400
Subject: [PATCH 099/228] Return unit explicitly.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 739c92060..36c7f1a20 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -156,4 +156,4 @@ instance (Foldable f, GToTag g) => GToTag (f :.: g) where
   gtag = mapM_ gtag . unComp1
 
 instance GToTag U1 where
-  gtag _ = pure mempty
+  gtag _ = pure ()

From e91504eb36c20d679a7034f8e96d2d214ec20659 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:10:18 -0400
Subject: [PATCH 100/228] Rename tag to tags.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 55 +++++++++++-----------
 1 file changed, 28 insertions(+), 27 deletions(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 36c7f1a20..409353fed 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -2,6 +2,7 @@
 module Tags.Taggable.Precise
 ( runTagging
 , Tags
+, ToTag(..)
 , yield
 ) where
 
@@ -26,12 +27,12 @@ runTagging source
   . run
   . execWriter
   . runReader source
-  . tag
+  . tags
 
 type Tags = Endo [Tag]
 
 class ToTag t where
-  tag
+  tags
     :: ( Carrier sig m
        , Member (Reader Source) sig
        , Member (Writer Tags) sig
@@ -45,11 +46,11 @@ yield = tell . Endo . (:)
 
 
 instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag t where
-  tag = tag' @strategy
+  tags = tags' @strategy
 
 
 class ToTagBy (strategy :: Strategy) t where
-  tag'
+  tags'
     :: ( Carrier sig m
        , Member (Reader Source) sig
        , Member (Writer Tags) sig
@@ -68,11 +69,11 @@ type family ToTagInstance t :: Strategy where
   ToTagInstance _                     = 'Generic
 
 instance (ToTag l, ToTag r) => ToTagBy 'Custom (l :+: r) where
-  tag' (L1 l) = tag l
-  tag' (R1 r) = tag r
+  tags' (L1 l) = tags l
+  tags' (R1 r) = tags r
 
 instance ToTagBy 'Custom Py.FunctionDefinition where
-  tag' Py.FunctionDefinition
+  tags' Py.FunctionDefinition
     { ann = Loc Range { start } span
     , name = Py.Identifier { bytes = name }
     , parameters
@@ -83,12 +84,12 @@ instance ToTagBy 'Custom Py.FunctionDefinition where
       let docs = listToMaybe extraChildren >>= docComment src
           sliced = slice src (Range start end)
       yield (Tag name Function span (firstLine sliced) docs)
-      tag parameters
-      traverse_ tag returnType
-      traverse_ tag extraChildren
+      tags parameters
+      traverse_ tags returnType
+      traverse_ tags extraChildren
 
 instance ToTagBy 'Custom Py.ClassDefinition where
-  tag' Py.ClassDefinition
+  tags' Py.ClassDefinition
     { ann = Loc Range { start } span
     , name = Py.Identifier { bytes = name }
     , superclasses
@@ -98,11 +99,11 @@ instance ToTagBy 'Custom Py.ClassDefinition where
       let docs = listToMaybe extraChildren >>= docComment src
           sliced = slice src (Range start end)
       yield (Tag name Class span (firstLine sliced) docs)
-      traverse_ tag superclasses
-      traverse_ tag extraChildren
+      traverse_ tags superclasses
+      traverse_ tags extraChildren
 
 instance ToTagBy 'Custom Py.Call where
-  tag' Py.Call
+  tags' Py.Call
     { ann = Loc range span
     , function = Py.IdentifierPrimaryExpression Py.Identifier { bytes = name }
     , arguments
@@ -110,8 +111,8 @@ instance ToTagBy 'Custom Py.Call where
       src <- ask @Source
       let sliced = slice src range
       yield (Tag name Call span (firstLine sliced) Nothing)
-      tag arguments
-  tag' Py.Call {} = pure ()
+      tags arguments
+  tags' Py.Call {} = pure ()
 
 docComment :: Source -> (Py.CompoundStatement :+: Py.SimpleStatement) Loc -> Maybe Text
 docComment src (R1 (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = L1 (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression Py.String { ann })) :|_ }))) = Just (toText (slice src (byteRange ann)))
@@ -121,10 +122,10 @@ firstLine :: Source -> Text
 firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
 
 instance (Generic1 t, GToTag (Rep1 t)) => ToTagBy 'Generic t where
-  tag' = gtag . from1
+  tags' = gtags . from1
 
 class GToTag t where
-  gtag
+  gtags
     :: ( Carrier sig m
        , Member (Reader Source) sig
        , Member (Writer Tags) sig
@@ -134,26 +135,26 @@ class GToTag t where
 
 
 instance GToTag f => GToTag (M1 i c f) where
-  gtag = gtag . unM1
+  gtags = gtags . unM1
 
 instance (GToTag f, GToTag g) => GToTag (f :*: g) where
-  gtag (f :*: g) = (<>) <$> gtag f <*> gtag g
+  gtags (f :*: g) = (<>) <$> gtags f <*> gtags g
 
 instance (GToTag f, GToTag g) => GToTag (f :+: g) where
-  gtag (L1 l) = gtag l
-  gtag (R1 r) = gtag r
+  gtags (L1 l) = gtags l
+  gtags (R1 r) = gtags r
 
 instance GToTag (K1 R t) where
-  gtag _ = pure ()
+  gtags _ = pure ()
 
 instance GToTag Par1 where
-  gtag _ = pure ()
+  gtags _ = pure ()
 
 instance ToTag t => GToTag (Rec1 t) where
-  gtag = tag . unRec1
+  gtags = tags . unRec1
 
 instance (Foldable f, GToTag g) => GToTag (f :.: g) where
-  gtag = mapM_ gtag . unComp1
+  gtags = mapM_ gtags . unComp1
 
 instance GToTag U1 where
-  gtag _ = pure ()
+  gtags _ = pure ()

From 6be281d36a46825391a06db04ed57db0acf49844 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:15:41 -0400
Subject: [PATCH 101/228] Move all the Python-specific stuff into its own
 module.

---
 semantic-tags/src/Language/Python/Tags.hs  | 147 ++++++++++++++++++++-
 semantic-tags/src/Tags/Taggable/Precise.hs | 136 +------------------
 2 files changed, 153 insertions(+), 130 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index 425d2b02f..abbf521f1 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -1,2 +1,147 @@
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Language.Python.Tags
-() where
+( Term(..)
+) where
+
+import           Control.Effect.Reader
+import           Control.Effect.Writer
+import           Data.Foldable (traverse_)
+import           Data.Maybe (listToMaybe)
+import           Data.List.NonEmpty (NonEmpty(..))
+import           Data.Text as T
+import           GHC.Generics
+import           Source.Loc
+import           Source.Range
+import           Source.Source
+import           Tags.Tag
+import qualified Tags.Taggable.Precise as Tags
+import qualified TreeSitter.Python.AST as Py
+
+class ToTag t where
+  tags
+    :: ( Carrier sig m
+       , Member (Reader Source) sig
+       , Member (Writer Tags.Tags) sig
+       )
+    => t Loc
+    -> m ()
+
+newtype Term a = Term { getTerm :: Py.Module a }
+
+instance Tags.ToTag Term where
+  tags = tags . getTerm
+
+
+instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag t where
+  tags = tags' @strategy
+
+
+class ToTagBy (strategy :: Strategy) t where
+  tags'
+    :: ( Carrier sig m
+        , Member (Reader Source) sig
+        , Member (Writer Tags.Tags) sig
+        )
+    => t Loc
+    -> m ()
+
+
+data Strategy = Generic | Custom
+
+type family ToTagInstance t :: Strategy where
+  ToTagInstance (_ :+: _)             = 'Custom
+  ToTagInstance Py.FunctionDefinition = 'Custom
+  ToTagInstance Py.ClassDefinition    = 'Custom
+  ToTagInstance Py.Call               = 'Custom
+  ToTagInstance _                     = 'Generic
+
+instance (ToTag l, ToTag r) => ToTagBy 'Custom (l :+: r) where
+  tags' (L1 l) = tags l
+  tags' (R1 r) = tags r
+
+instance ToTagBy 'Custom Py.FunctionDefinition where
+  tags' Py.FunctionDefinition
+    { ann = Loc Range { start } span
+    , name = Py.Identifier { bytes = name }
+    , parameters
+    , returnType
+    , body = Py.Block { ann = Loc Range { start = end } _, extraChildren }
+    } = do
+      src <- ask @Source
+      let docs = listToMaybe extraChildren >>= docComment src
+          sliced = slice src (Range start end)
+      Tags.yield (Tag name Function span (firstLine sliced) docs)
+      tags parameters
+      traverse_ tags returnType
+      traverse_ tags extraChildren
+
+instance ToTagBy 'Custom Py.ClassDefinition where
+  tags' Py.ClassDefinition
+    { ann = Loc Range { start } span
+    , name = Py.Identifier { bytes = name }
+    , superclasses
+    , body = Py.Block { ann = Loc Range { start = end } _, extraChildren }
+    } = do
+      src <- ask @Source
+      let docs = listToMaybe extraChildren >>= docComment src
+          sliced = slice src (Range start end)
+      Tags.yield (Tag name Class span (firstLine sliced) docs)
+      traverse_ tags superclasses
+      traverse_ tags extraChildren
+
+instance ToTagBy 'Custom Py.Call where
+  tags' Py.Call
+    { ann = Loc range span
+    , function = Py.IdentifierPrimaryExpression Py.Identifier { bytes = name }
+    , arguments
+    } = do
+      src <- ask @Source
+      let sliced = slice src range
+      Tags.yield (Tag name Call span (firstLine sliced) Nothing)
+      tags arguments
+  tags' Py.Call {} = pure ()
+
+docComment :: Source -> (Py.CompoundStatement :+: Py.SimpleStatement) Loc -> Maybe Text
+docComment src (R1 (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = L1 (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression Py.String { ann })) :|_ }))) = Just (toText (slice src (byteRange ann)))
+docComment _ _ = Nothing
+
+firstLine :: Source -> Text
+firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
+
+instance (Generic1 t, GToTag (Rep1 t)) => ToTagBy 'Generic t where
+  tags' = gtags . from1
+
+class GToTag t where
+  gtags
+    :: ( Carrier sig m
+        , Member (Reader Source) sig
+        , Member (Writer Tags.Tags) sig
+        )
+    => t Loc
+    -> m ()
+
+
+instance GToTag f => GToTag (M1 i c f) where
+  gtags = gtags . unM1
+
+instance (GToTag f, GToTag g) => GToTag (f :*: g) where
+  gtags (f :*: g) = (<>) <$> gtags f <*> gtags g
+
+instance (GToTag f, GToTag g) => GToTag (f :+: g) where
+  gtags (L1 l) = gtags l
+  gtags (R1 r) = gtags r
+
+instance GToTag (K1 R t) where
+  gtags _ = pure ()
+
+instance GToTag Par1 where
+  gtags _ = pure ()
+
+instance ToTag t => GToTag (Rec1 t) where
+  gtags = tags . unRec1
+
+instance (Foldable f, GToTag g) => GToTag (f :.: g) where
+  gtags = mapM_ gtags . unComp1
+
+instance GToTag U1 where
+  gtags _ = pure ()
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 409353fed..645af6d76 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -6,21 +6,14 @@ module Tags.Taggable.Precise
 , yield
 ) where
 
-import           Control.Effect.Reader
-import           Control.Effect.Writer
-import           Data.Foldable (traverse_)
-import           Data.Maybe (listToMaybe)
-import           Data.Monoid (Endo(..))
-import           Data.List.NonEmpty (NonEmpty(..))
-import           Data.Text as T
-import           GHC.Generics
-import           Source.Loc
-import           Source.Range
-import           Source.Source
-import           Tags.Tag
-import qualified TreeSitter.Python.AST as Py
+import Control.Effect.Reader
+import Control.Effect.Writer
+import Data.Monoid (Endo(..))
+import Source.Loc
+import Source.Source
+import Tags.Tag
 
-runTagging :: Source -> Py.Module Loc -> [Tag]
+runTagging :: ToTag t => Source -> t Loc -> [Tag]
 runTagging source
   = ($ [])
   . appEndo
@@ -43,118 +36,3 @@ class ToTag t where
 
 yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
 yield = tell . Endo . (:)
-
-
-instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag t where
-  tags = tags' @strategy
-
-
-class ToTagBy (strategy :: Strategy) t where
-  tags'
-    :: ( Carrier sig m
-       , Member (Reader Source) sig
-       , Member (Writer Tags) sig
-       )
-    => t Loc
-    -> m ()
-
-
-data Strategy = Generic | Custom
-
-type family ToTagInstance t :: Strategy where
-  ToTagInstance (_ :+: _)             = 'Custom
-  ToTagInstance Py.FunctionDefinition = 'Custom
-  ToTagInstance Py.ClassDefinition    = 'Custom
-  ToTagInstance Py.Call               = 'Custom
-  ToTagInstance _                     = 'Generic
-
-instance (ToTag l, ToTag r) => ToTagBy 'Custom (l :+: r) where
-  tags' (L1 l) = tags l
-  tags' (R1 r) = tags r
-
-instance ToTagBy 'Custom Py.FunctionDefinition where
-  tags' Py.FunctionDefinition
-    { ann = Loc Range { start } span
-    , name = Py.Identifier { bytes = name }
-    , parameters
-    , returnType
-    , body = Py.Block { ann = Loc Range { start = end } _, extraChildren }
-    } = do
-      src <- ask @Source
-      let docs = listToMaybe extraChildren >>= docComment src
-          sliced = slice src (Range start end)
-      yield (Tag name Function span (firstLine sliced) docs)
-      tags parameters
-      traverse_ tags returnType
-      traverse_ tags extraChildren
-
-instance ToTagBy 'Custom Py.ClassDefinition where
-  tags' Py.ClassDefinition
-    { ann = Loc Range { start } span
-    , name = Py.Identifier { bytes = name }
-    , superclasses
-    , body = Py.Block { ann = Loc Range { start = end } _, extraChildren }
-    } = do
-      src <- ask @Source
-      let docs = listToMaybe extraChildren >>= docComment src
-          sliced = slice src (Range start end)
-      yield (Tag name Class span (firstLine sliced) docs)
-      traverse_ tags superclasses
-      traverse_ tags extraChildren
-
-instance ToTagBy 'Custom Py.Call where
-  tags' Py.Call
-    { ann = Loc range span
-    , function = Py.IdentifierPrimaryExpression Py.Identifier { bytes = name }
-    , arguments
-    } = do
-      src <- ask @Source
-      let sliced = slice src range
-      yield (Tag name Call span (firstLine sliced) Nothing)
-      tags arguments
-  tags' Py.Call {} = pure ()
-
-docComment :: Source -> (Py.CompoundStatement :+: Py.SimpleStatement) Loc -> Maybe Text
-docComment src (R1 (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = L1 (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression Py.String { ann })) :|_ }))) = Just (toText (slice src (byteRange ann)))
-docComment _ _ = Nothing
-
-firstLine :: Source -> Text
-firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
-
-instance (Generic1 t, GToTag (Rep1 t)) => ToTagBy 'Generic t where
-  tags' = gtags . from1
-
-class GToTag t where
-  gtags
-    :: ( Carrier sig m
-       , Member (Reader Source) sig
-       , Member (Writer Tags) sig
-       )
-    => t Loc
-    -> m ()
-
-
-instance GToTag f => GToTag (M1 i c f) where
-  gtags = gtags . unM1
-
-instance (GToTag f, GToTag g) => GToTag (f :*: g) where
-  gtags (f :*: g) = (<>) <$> gtags f <*> gtags g
-
-instance (GToTag f, GToTag g) => GToTag (f :+: g) where
-  gtags (L1 l) = gtags l
-  gtags (R1 r) = gtags r
-
-instance GToTag (K1 R t) where
-  gtags _ = pure ()
-
-instance GToTag Par1 where
-  gtags _ = pure ()
-
-instance ToTag t => GToTag (Rec1 t) where
-  gtags = tags . unRec1
-
-instance (Foldable f, GToTag g) => GToTag (f :.: g) where
-  gtags = mapM_ gtags . unComp1
-
-instance GToTag U1 where
-  gtags _ = pure ()

From 12be927e842b231d58de47b563d816c1d39a4989 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:16:30 -0400
Subject: [PATCH 102/228] Rename ToTag to ToTags.

---
 semantic-tags/src/Language/Python/Tags.hs  | 10 +++++-----
 semantic-tags/src/Tags/Taggable/Precise.hs |  6 +++---
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index abbf521f1..2d40d81f3 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -17,7 +17,7 @@ import           Tags.Tag
 import qualified Tags.Taggable.Precise as Tags
 import qualified TreeSitter.Python.AST as Py
 
-class ToTag t where
+class ToTags t where
   tags
     :: ( Carrier sig m
        , Member (Reader Source) sig
@@ -28,11 +28,11 @@ class ToTag t where
 
 newtype Term a = Term { getTerm :: Py.Module a }
 
-instance Tags.ToTag Term where
+instance Tags.ToTags Term where
   tags = tags . getTerm
 
 
-instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTag t where
+instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTags t where
   tags = tags' @strategy
 
 
@@ -55,7 +55,7 @@ type family ToTagInstance t :: Strategy where
   ToTagInstance Py.Call               = 'Custom
   ToTagInstance _                     = 'Generic
 
-instance (ToTag l, ToTag r) => ToTagBy 'Custom (l :+: r) where
+instance (ToTags l, ToTags r) => ToTagBy 'Custom (l :+: r) where
   tags' (L1 l) = tags l
   tags' (R1 r) = tags r
 
@@ -137,7 +137,7 @@ instance GToTag (K1 R t) where
 instance GToTag Par1 where
   gtags _ = pure ()
 
-instance ToTag t => GToTag (Rec1 t) where
+instance ToTags t => GToTag (Rec1 t) where
   gtags = tags . unRec1
 
 instance (Foldable f, GToTag g) => GToTag (f :.: g) where
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 645af6d76..cc985722e 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -2,7 +2,7 @@
 module Tags.Taggable.Precise
 ( runTagging
 , Tags
-, ToTag(..)
+, ToTags(..)
 , yield
 ) where
 
@@ -13,7 +13,7 @@ import Source.Loc
 import Source.Source
 import Tags.Tag
 
-runTagging :: ToTag t => Source -> t Loc -> [Tag]
+runTagging :: ToTags t => Source -> t Loc -> [Tag]
 runTagging source
   = ($ [])
   . appEndo
@@ -24,7 +24,7 @@ runTagging source
 
 type Tags = Endo [Tag]
 
-class ToTag t where
+class ToTags t where
   tags
     :: ( Carrier sig m
        , Member (Reader Source) sig

From c6a4f7d617ecd1aee8597ae3650a323fa47f48a2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:17:56 -0400
Subject: [PATCH 103/228] :fire: redundant language extensions.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index cc985722e..01b54c378 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Tags.Taggable.Precise
 ( runTagging
 , Tags

From 585da5e91a62b884566b798a7d17351c3987cd8c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:18:53 -0400
Subject: [PATCH 104/228] Alignment.

---
 semantic-tags/src/Language/Python/Tags.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index 2d40d81f3..ef2117124 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -39,9 +39,9 @@ instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTags t where
 class ToTagBy (strategy :: Strategy) t where
   tags'
     :: ( Carrier sig m
-        , Member (Reader Source) sig
-        , Member (Writer Tags.Tags) sig
-        )
+       , Member (Reader Source) sig
+       , Member (Writer Tags.Tags) sig
+       )
     => t Loc
     -> m ()
 
@@ -114,9 +114,9 @@ instance (Generic1 t, GToTag (Rep1 t)) => ToTagBy 'Generic t where
 class GToTag t where
   gtags
     :: ( Carrier sig m
-        , Member (Reader Source) sig
-        , Member (Writer Tags.Tags) sig
-        )
+       , Member (Reader Source) sig
+       , Member (Writer Tags.Tags) sig
+       )
     => t Loc
     -> m ()
 

From dac58cfca47542c2004220c4a1f8d7d4627ad28c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:21:17 -0400
Subject: [PATCH 105/228] Sequence the operations with >>.

---
 semantic-tags/src/Language/Python/Tags.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index ef2117124..82a750ce1 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -125,7 +125,7 @@ instance GToTag f => GToTag (M1 i c f) where
   gtags = gtags . unM1
 
 instance (GToTag f, GToTag g) => GToTag (f :*: g) where
-  gtags (f :*: g) = (<>) <$> gtags f <*> gtags g
+  gtags (f :*: g) = gtags f >> gtags g
 
 instance (GToTag f, GToTag g) => GToTag (f :+: g) where
   gtags (L1 l) = gtags l

From f25af24099af254f85352f9cdebb413006999dda Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:33:31 -0400
Subject: [PATCH 106/228] Define a class abstracting the job of folding over
 syntax.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 37 +++++++++++++++++++++-
 1 file changed, 36 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 01b54c378..c78952128 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,14 +1,16 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeApplications, TypeOperators #-}
 module Tags.Taggable.Precise
 ( runTagging
 , Tags
 , ToTags(..)
 , yield
+, GFold1(..)
 ) where
 
 import Control.Effect.Reader
 import Control.Effect.Writer
 import Data.Monoid (Endo(..))
+import GHC.Generics
 import Source.Loc
 import Source.Source
 import Tags.Tag
@@ -36,3 +38,36 @@ class ToTags t where
 
 yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
 yield = tell . Endo . (:)
+
+
+class GFold1 c t where
+  gfold1
+    :: Monoid b
+    => (forall f . c f => f a -> b)
+    -> t a
+    -> b
+
+instance GFold1 c f => GFold1 c (M1 i c' f) where
+  gfold1 alg = gfold1 @c alg . unM1
+
+instance (GFold1 c f, GFold1 c g) => GFold1 c (f :*: g) where
+  gfold1 alg (f :*: g) = gfold1 @c alg f <> gfold1 @c alg g
+
+instance (GFold1 c f, GFold1 c g) => GFold1 c (f :+: g) where
+  gfold1 alg (L1 l) = gfold1 @c alg l
+  gfold1 alg (R1 r) = gfold1 @c alg r
+
+instance GFold1 c (K1 R t) where
+  gfold1 _ _ = mempty
+
+instance GFold1 c Par1 where
+  gfold1 _ _ = mempty
+
+instance c t => GFold1 c (Rec1 t) where
+  gfold1 alg (Rec1 t) = alg t
+
+instance (Foldable f, GFold1 c g) => GFold1 c (f :.: g) where
+  gfold1 alg = foldMap (gfold1 @c alg) . unComp1
+
+instance GFold1 c U1 where
+  gfold1 _ _ = mempty

From 80ccf3c9858f6dad181facf041445b48529588e7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:35:23 -0400
Subject: [PATCH 107/228] Replace GToTag with GFold1 ToTags.

---
 semantic-tags/src/Language/Python/Tags.hs | 40 ++---------------------
 1 file changed, 3 insertions(+), 37 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index 82a750ce1..45a63090b 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -7,6 +7,7 @@ import           Control.Effect.Reader
 import           Control.Effect.Writer
 import           Data.Foldable (traverse_)
 import           Data.Maybe (listToMaybe)
+import           Data.Monoid (Ap(..))
 import           Data.List.NonEmpty (NonEmpty(..))
 import           Data.Text as T
 import           GHC.Generics
@@ -108,40 +109,5 @@ docComment _ _ = Nothing
 firstLine :: Source -> Text
 firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
 
-instance (Generic1 t, GToTag (Rep1 t)) => ToTagBy 'Generic t where
-  tags' = gtags . from1
-
-class GToTag t where
-  gtags
-    :: ( Carrier sig m
-       , Member (Reader Source) sig
-       , Member (Writer Tags.Tags) sig
-       )
-    => t Loc
-    -> m ()
-
-
-instance GToTag f => GToTag (M1 i c f) where
-  gtags = gtags . unM1
-
-instance (GToTag f, GToTag g) => GToTag (f :*: g) where
-  gtags (f :*: g) = gtags f >> gtags g
-
-instance (GToTag f, GToTag g) => GToTag (f :+: g) where
-  gtags (L1 l) = gtags l
-  gtags (R1 r) = gtags r
-
-instance GToTag (K1 R t) where
-  gtags _ = pure ()
-
-instance GToTag Par1 where
-  gtags _ = pure ()
-
-instance ToTags t => GToTag (Rec1 t) where
-  gtags = tags . unRec1
-
-instance (Foldable f, GToTag g) => GToTag (f :.: g) where
-  gtags = mapM_ gtags . unComp1
-
-instance GToTag U1 where
-  gtags _ = pure ()
+instance (Generic1 t, Tags.GFold1 ToTags (Rep1 t)) => ToTagBy 'Generic t where
+  tags' = getAp . Tags.gfold1 @ToTags (Ap . tags) . from1

From f79131600316bbec832fdf4a86883ec8f2fdb6ac Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:42:40 -0400
Subject: [PATCH 108/228] Rename ToTagBy to ToTagsBy.

---
 semantic-tags/src/Language/Python/Tags.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index 45a63090b..dbeeb8ab3 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -33,11 +33,11 @@ instance Tags.ToTags Term where
   tags = tags . getTerm
 
 
-instance (ToTagBy strategy t, strategy ~ ToTagInstance t) => ToTags t where
+instance (ToTagsBy strategy t, strategy ~ ToTagInstance t) => ToTags t where
   tags = tags' @strategy
 
 
-class ToTagBy (strategy :: Strategy) t where
+class ToTagsBy (strategy :: Strategy) t where
   tags'
     :: ( Carrier sig m
        , Member (Reader Source) sig
@@ -56,11 +56,11 @@ type family ToTagInstance t :: Strategy where
   ToTagInstance Py.Call               = 'Custom
   ToTagInstance _                     = 'Generic
 
-instance (ToTags l, ToTags r) => ToTagBy 'Custom (l :+: r) where
+instance (ToTags l, ToTags r) => ToTagsBy 'Custom (l :+: r) where
   tags' (L1 l) = tags l
   tags' (R1 r) = tags r
 
-instance ToTagBy 'Custom Py.FunctionDefinition where
+instance ToTagsBy 'Custom Py.FunctionDefinition where
   tags' Py.FunctionDefinition
     { ann = Loc Range { start } span
     , name = Py.Identifier { bytes = name }
@@ -76,7 +76,7 @@ instance ToTagBy 'Custom Py.FunctionDefinition where
       traverse_ tags returnType
       traverse_ tags extraChildren
 
-instance ToTagBy 'Custom Py.ClassDefinition where
+instance ToTagsBy 'Custom Py.ClassDefinition where
   tags' Py.ClassDefinition
     { ann = Loc Range { start } span
     , name = Py.Identifier { bytes = name }
@@ -90,7 +90,7 @@ instance ToTagBy 'Custom Py.ClassDefinition where
       traverse_ tags superclasses
       traverse_ tags extraChildren
 
-instance ToTagBy 'Custom Py.Call where
+instance ToTagsBy 'Custom Py.Call where
   tags' Py.Call
     { ann = Loc range span
     , function = Py.IdentifierPrimaryExpression Py.Identifier { bytes = name }
@@ -109,5 +109,5 @@ docComment _ _ = Nothing
 firstLine :: Source -> Text
 firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
 
-instance (Generic1 t, Tags.GFold1 ToTags (Rep1 t)) => ToTagBy 'Generic t where
+instance (Generic1 t, Tags.GFold1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = getAp . Tags.gfold1 @ToTags (Ap . tags) . from1

From 60c3e359dea856b22d7ecd03d2f8b84a1f002aa7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:42:58 -0400
Subject: [PATCH 109/228] Rename ToTagInstance to ToTagsInstance.

---
 semantic-tags/src/Language/Python/Tags.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index dbeeb8ab3..f3f45ebc4 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -33,7 +33,7 @@ instance Tags.ToTags Term where
   tags = tags . getTerm
 
 
-instance (ToTagsBy strategy t, strategy ~ ToTagInstance t) => ToTags t where
+instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
   tags = tags' @strategy
 
 
@@ -49,12 +49,12 @@ class ToTagsBy (strategy :: Strategy) t where
 
 data Strategy = Generic | Custom
 
-type family ToTagInstance t :: Strategy where
-  ToTagInstance (_ :+: _)             = 'Custom
-  ToTagInstance Py.FunctionDefinition = 'Custom
-  ToTagInstance Py.ClassDefinition    = 'Custom
-  ToTagInstance Py.Call               = 'Custom
-  ToTagInstance _                     = 'Generic
+type family ToTagsInstance t :: Strategy where
+  ToTagsInstance (_ :+: _)             = 'Custom
+  ToTagsInstance Py.FunctionDefinition = 'Custom
+  ToTagsInstance Py.ClassDefinition    = 'Custom
+  ToTagsInstance Py.Call               = 'Custom
+  ToTagsInstance _                     = 'Generic
 
 instance (ToTags l, ToTags r) => ToTagsBy 'Custom (l :+: r) where
   tags' (L1 l) = tags l

From 09f294a70d757d05a369773ee2e5a45b4b471aec Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:46:30 -0400
Subject: [PATCH 110/228] Rename gfold1 to gfoldMap1.

---
 semantic-tags/src/Language/Python/Tags.hs  |  2 +-
 semantic-tags/src/Tags/Taggable/Precise.hs | 20 ++++++++++----------
 2 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index f3f45ebc4..8ff26e2e2 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -110,4 +110,4 @@ firstLine :: Source -> Text
 firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
 
 instance (Generic1 t, Tags.GFold1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
-  tags' = getAp . Tags.gfold1 @ToTags (Ap . tags) . from1
+  tags' = getAp . Tags.gfoldMap1 @ToTags (Ap . tags) . from1
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index c78952128..44a4ca5ca 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -41,33 +41,33 @@ yield = tell . Endo . (:)
 
 
 class GFold1 c t where
-  gfold1
+  gfoldMap1
     :: Monoid b
     => (forall f . c f => f a -> b)
     -> t a
     -> b
 
 instance GFold1 c f => GFold1 c (M1 i c' f) where
-  gfold1 alg = gfold1 @c alg . unM1
+  gfoldMap1 alg = gfoldMap1 @c alg . unM1
 
 instance (GFold1 c f, GFold1 c g) => GFold1 c (f :*: g) where
-  gfold1 alg (f :*: g) = gfold1 @c alg f <> gfold1 @c alg g
+  gfoldMap1 alg (f :*: g) = gfoldMap1 @c alg f <> gfoldMap1 @c alg g
 
 instance (GFold1 c f, GFold1 c g) => GFold1 c (f :+: g) where
-  gfold1 alg (L1 l) = gfold1 @c alg l
-  gfold1 alg (R1 r) = gfold1 @c alg r
+  gfoldMap1 alg (L1 l) = gfoldMap1 @c alg l
+  gfoldMap1 alg (R1 r) = gfoldMap1 @c alg r
 
 instance GFold1 c (K1 R t) where
-  gfold1 _ _ = mempty
+  gfoldMap1 _ _ = mempty
 
 instance GFold1 c Par1 where
-  gfold1 _ _ = mempty
+  gfoldMap1 _ _ = mempty
 
 instance c t => GFold1 c (Rec1 t) where
-  gfold1 alg (Rec1 t) = alg t
+  gfoldMap1 alg (Rec1 t) = alg t
 
 instance (Foldable f, GFold1 c g) => GFold1 c (f :.: g) where
-  gfold1 alg = foldMap (gfold1 @c alg) . unComp1
+  gfoldMap1 alg = foldMap (gfoldMap1 @c alg) . unComp1
 
 instance GFold1 c U1 where
-  gfold1 _ _ = mempty
+  gfoldMap1 _ _ = mempty

From 03635d00a23e6a6dbe95aae59f0550e65535cbd6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:47:06 -0400
Subject: [PATCH 111/228] Rename GFold1 to GFoldable1.

---
 semantic-tags/src/Language/Python/Tags.hs  |  2 +-
 semantic-tags/src/Tags/Taggable/Precise.hs | 20 ++++++++++----------
 2 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index 8ff26e2e2..e10fc2e00 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -109,5 +109,5 @@ docComment _ _ = Nothing
 firstLine :: Source -> Text
 firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
 
-instance (Generic1 t, Tags.GFold1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
+instance (Generic1 t, Tags.GFoldable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = getAp . Tags.gfoldMap1 @ToTags (Ap . tags) . from1
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 44a4ca5ca..9c12daaff 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -4,7 +4,7 @@ module Tags.Taggable.Precise
 , Tags
 , ToTags(..)
 , yield
-, GFold1(..)
+, GFoldable1(..)
 ) where
 
 import Control.Effect.Reader
@@ -40,34 +40,34 @@ yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
 yield = tell . Endo . (:)
 
 
-class GFold1 c t where
+class GFoldable1 c t where
   gfoldMap1
     :: Monoid b
     => (forall f . c f => f a -> b)
     -> t a
     -> b
 
-instance GFold1 c f => GFold1 c (M1 i c' f) where
+instance GFoldable1 c f => GFoldable1 c (M1 i c' f) where
   gfoldMap1 alg = gfoldMap1 @c alg . unM1
 
-instance (GFold1 c f, GFold1 c g) => GFold1 c (f :*: g) where
+instance (GFoldable1 c f, GFoldable1 c g) => GFoldable1 c (f :*: g) where
   gfoldMap1 alg (f :*: g) = gfoldMap1 @c alg f <> gfoldMap1 @c alg g
 
-instance (GFold1 c f, GFold1 c g) => GFold1 c (f :+: g) where
+instance (GFoldable1 c f, GFoldable1 c g) => GFoldable1 c (f :+: g) where
   gfoldMap1 alg (L1 l) = gfoldMap1 @c alg l
   gfoldMap1 alg (R1 r) = gfoldMap1 @c alg r
 
-instance GFold1 c (K1 R t) where
+instance GFoldable1 c (K1 R t) where
   gfoldMap1 _ _ = mempty
 
-instance GFold1 c Par1 where
+instance GFoldable1 c Par1 where
   gfoldMap1 _ _ = mempty
 
-instance c t => GFold1 c (Rec1 t) where
+instance c t => GFoldable1 c (Rec1 t) where
   gfoldMap1 alg (Rec1 t) = alg t
 
-instance (Foldable f, GFold1 c g) => GFold1 c (f :.: g) where
+instance (Foldable f, GFoldable1 c g) => GFoldable1 c (f :.: g) where
   gfoldMap1 alg = foldMap (gfoldMap1 @c alg) . unComp1
 
-instance GFold1 c U1 where
+instance GFoldable1 c U1 where
   gfoldMap1 _ _ = mempty

From a6010a1436b5b395e2f469bfd015c6cb2de9411f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 16:59:53 -0400
Subject: [PATCH 112/228] Recur through indirect calls.

---
 semantic-tags/src/Language/Python/Tags.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index e10fc2e00..36284deea 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -100,7 +100,7 @@ instance ToTagsBy 'Custom Py.Call where
       let sliced = slice src range
       Tags.yield (Tag name Call span (firstLine sliced) Nothing)
       tags arguments
-  tags' Py.Call {} = pure ()
+  tags' Py.Call { function, arguments } = tags function >> tags arguments
 
 docComment :: Source -> (Py.CompoundStatement :+: Py.SimpleStatement) Loc -> Maybe Text
 docComment src (R1 (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatement { extraChildren = L1 (Py.PrimaryExpressionExpression (Py.StringPrimaryExpression Py.String { ann })) :|_ }))) = Just (toText (slice src (byteRange ann)))

From e5ecd7c849c9f5c79a75e31226b6cd44867ec6cf Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 17:02:01 -0400
Subject: [PATCH 113/228] Move the definition of Term up.

---
 semantic-tags/src/Language/Python/Tags.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index 36284deea..8f46c4d02 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -18,6 +18,12 @@ import           Tags.Tag
 import qualified Tags.Taggable.Precise as Tags
 import qualified TreeSitter.Python.AST as Py
 
+newtype Term a = Term { getTerm :: Py.Module a }
+
+instance Tags.ToTags Term where
+  tags = tags . getTerm
+
+
 class ToTags t where
   tags
     :: ( Carrier sig m
@@ -27,12 +33,6 @@ class ToTags t where
     => t Loc
     -> m ()
 
-newtype Term a = Term { getTerm :: Py.Module a }
-
-instance Tags.ToTags Term where
-  tags = tags . getTerm
-
-
 instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
   tags = tags' @strategy
 

From 6baa33d0d6414baed866444ae82e6becca9c5877 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 17:03:23 -0400
Subject: [PATCH 114/228] Spacing.

---
 semantic-tags/src/Language/Python/Tags.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index 8f46c4d02..e15bb1b11 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -56,6 +56,7 @@ type family ToTagsInstance t :: Strategy where
   ToTagsInstance Py.Call               = 'Custom
   ToTagsInstance _                     = 'Generic
 
+
 instance (ToTags l, ToTags r) => ToTagsBy 'Custom (l :+: r) where
   tags' (L1 l) = tags l
   tags' (R1 r) = tags r
@@ -109,5 +110,6 @@ docComment _ _ = Nothing
 firstLine :: Source -> Text
 firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
 
+
 instance (Generic1 t, Tags.GFoldable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = getAp . Tags.gfoldMap1 @ToTags (Ap . tags) . from1

From 661b414df45dc7ff3233224b30d179b0a0d7d504 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 17:04:22 -0400
Subject: [PATCH 115/228] Take in Source, not Text.

---
 semantic-tags/src/Language/Python/Tags.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index e15bb1b11..ef13706ca 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -13,7 +13,7 @@ import           Data.Text as T
 import           GHC.Generics
 import           Source.Loc
 import           Source.Range
-import           Source.Source
+import           Source.Source as Source
 import           Tags.Tag
 import qualified Tags.Taggable.Precise as Tags
 import qualified TreeSitter.Python.AST as Py
@@ -108,7 +108,7 @@ docComment src (R1 (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatemen
 docComment _ _ = Nothing
 
 firstLine :: Source -> Text
-firstLine = T.take 180 . T.takeWhile (/= '\n') . toText
+firstLine = T.takeWhile (/= '\n') . toText . Source.take 180
 
 
 instance (Generic1 t, Tags.GFoldable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where

From ea2d2ca324a42ec945e2189ff0c6c4427e3b2aa1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 17:04:53 -0400
Subject: [PATCH 116/228] Rename the import of Data.Text.

---
 semantic-tags/src/Language/Python/Tags.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index ef13706ca..9fa161cfa 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -9,7 +9,7 @@ import           Data.Foldable (traverse_)
 import           Data.Maybe (listToMaybe)
 import           Data.Monoid (Ap(..))
 import           Data.List.NonEmpty (NonEmpty(..))
-import           Data.Text as T
+import           Data.Text as Text
 import           GHC.Generics
 import           Source.Loc
 import           Source.Range
@@ -108,7 +108,7 @@ docComment src (R1 (Py.ExpressionStatementSimpleStatement (Py.ExpressionStatemen
 docComment _ _ = Nothing
 
 firstLine :: Source -> Text
-firstLine = T.takeWhile (/= '\n') . toText . Source.take 180
+firstLine = Text.takeWhile (/= '\n') . toText . Source.take 180
 
 
 instance (Generic1 t, Tags.GFoldable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where

From e05a98cc2da173ed9126ea4aed7943de8ca78fdb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 17:07:16 -0400
Subject: [PATCH 117/228] :memo: gfoldMap1.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 9c12daaff..73a10c2b2 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -41,6 +41,7 @@ yield = tell . Endo . (:)
 
 
 class GFoldable1 c t where
+  -- | Generically map functions over fields of kind @* -> *@, monoidally combining the results.
   gfoldMap1
     :: Monoid b
     => (forall f . c f => f a -> b)

From 4a5ab1107a06aacc3fea3f847677e0f1d5023c71 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 17:09:01 -0400
Subject: [PATCH 118/228] Note a FIXME.

---
 semantic-tags/src/Tags/Taggable/Precise.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 73a10c2b2..439214209 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -40,6 +40,7 @@ yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
 yield = tell . Endo . (:)
 
 
+-- FIXME: move GFoldable1 into semantic-ast.
 class GFoldable1 c t where
   -- | Generically map functions over fields of kind @* -> *@, monoidally combining the results.
   gfoldMap1

From 32bd132c75c330054b50abecec4117004d37e47a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 17:15:43 -0400
Subject: [PATCH 119/228] Define ToTag purely.

---
 semantic-tags/src/Language/Python/Tags.hs  |  2 +-
 semantic-tags/src/Tags/Taggable/Precise.hs | 32 +++++++++-------------
 2 files changed, 14 insertions(+), 20 deletions(-)

diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index 9fa161cfa..cfa2d693b 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -21,7 +21,7 @@ import qualified TreeSitter.Python.AST as Py
 newtype Term a = Term { getTerm :: Py.Module a }
 
 instance Tags.ToTags Term where
-  tags = tags . getTerm
+  tags src = Tags.runTagging src . tags . getTerm
 
 
 class ToTags t where
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Taggable/Precise.hs
index 439214209..697b3b2c6 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Taggable/Precise.hs
@@ -1,12 +1,13 @@
 {-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeApplications, TypeOperators #-}
 module Tags.Taggable.Precise
-( runTagging
-, Tags
+( Tags
 , ToTags(..)
 , yield
+, runTagging
 , GFoldable1(..)
 ) where
 
+import Control.Effect.Pure
 import Control.Effect.Reader
 import Control.Effect.Writer
 import Data.Monoid (Endo(..))
@@ -15,29 +16,22 @@ import Source.Loc
 import Source.Source
 import Tags.Tag
 
-runTagging :: ToTags t => Source -> t Loc -> [Tag]
+type Tags = Endo [Tag]
+
+class ToTags t where
+  tags :: Source -> t Loc -> [Tag]
+
+
+yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
+yield = tell . Endo . (:)
+
+runTagging :: Source -> ReaderC Source (WriterC Tags PureC) () -> [Tag]
 runTagging source
   = ($ [])
   . appEndo
   . run
   . execWriter
   . runReader source
-  . tags
-
-type Tags = Endo [Tag]
-
-class ToTags t where
-  tags
-    :: ( Carrier sig m
-       , Member (Reader Source) sig
-       , Member (Writer Tags) sig
-       )
-    => t Loc
-    -> m ()
-
-
-yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
-yield = tell . Endo . (:)
 
 
 -- FIXME: move GFoldable1 into semantic-ast.

From 0ca8e7cc2d07a73a2f5fea65514dcd2d7fc497ca Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 24 Sep 2019 17:17:54 -0400
Subject: [PATCH 120/228] Rename Tags.Taggable.Precise to Tags.Tagging.Precise.

---
 semantic-tags/semantic-tags.cabal                       | 2 +-
 semantic-tags/src/Language/Python/Tags.hs               | 2 +-
 semantic-tags/src/Tags/{Taggable => Tagging}/Precise.hs | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)
 rename semantic-tags/src/Tags/{Taggable => Tagging}/Precise.hs (98%)

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 23a463fbb..cf8f8345c 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -22,7 +22,7 @@ library
   exposed-modules:
     Language.Python.Tags
     Tags.Tag
-    Tags.Taggable.Precise
+    Tags.Tagging.Precise
   -- other-modules:
   -- other-extensions:
   build-depends:
diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index cfa2d693b..66aeee9bf 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -15,7 +15,7 @@ import           Source.Loc
 import           Source.Range
 import           Source.Source as Source
 import           Tags.Tag
-import qualified Tags.Taggable.Precise as Tags
+import qualified Tags.Tagging.Precise as Tags
 import qualified TreeSitter.Python.AST as Py
 
 newtype Term a = Term { getTerm :: Py.Module a }
diff --git a/semantic-tags/src/Tags/Taggable/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
similarity index 98%
rename from semantic-tags/src/Tags/Taggable/Precise.hs
rename to semantic-tags/src/Tags/Tagging/Precise.hs
index 697b3b2c6..94bea224b 100644
--- a/semantic-tags/src/Tags/Taggable/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeApplications, TypeOperators #-}
-module Tags.Taggable.Precise
+module Tags.Tagging.Precise
 ( Tags
 , ToTags(..)
 , yield

From 19e9d7f61bb2d3d2a800796f29bb50006eac2eef Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 10:09:59 -0400
Subject: [PATCH 121/228] Reformat the parse command flags.

---
 src/Semantic/CLI.hs | 38 +++++++++++++++++++++++++++++---------
 1 file changed, 29 insertions(+), 9 deletions(-)

diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 30a439945..f33e39acc 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -102,15 +102,35 @@ parseCommand :: Mod CommandFields (Task.TaskEff Builder)
 parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)"))
   where
     parseArgumentsParser = do
-      renderer <- flag  (parseTermBuilder TermSExpression) (parseTermBuilder TermSExpression) (long "sexpression" <> help "Output s-expression parse trees (default)")
-              <|> flag'                                    (parseTermBuilder TermJSONTree)    (long "json"        <> help "Output JSON parse trees")
-              <|> flag'                                    (parseTermBuilder TermJSONGraph)   (long "json-graph"  <> help "Output JSON adjacency list")
-              <|> flag'                                    (parseSymbolsBuilder JSON)         (long "symbols"       <> help "Output JSON symbol list")
-              <|> flag'                                    (parseSymbolsBuilder JSON)         (long "json-symbols"  <> help "Output JSON symbol list")
-              <|> flag'                                    (parseSymbolsBuilder Proto)        (long "proto-symbols" <> help "Output JSON symbol list")
-              <|> flag'                                    (parseTermBuilder TermDotGraph)    (long "dot"         <> help "Output DOT graph parse trees")
-              <|> flag'                                    (parseTermBuilder TermShow)        (long "show"        <> help "Output using the Show instance (debug only, format subject to change without notice)")
-              <|> flag'                                    (parseTermBuilder TermQuiet)       (long "quiet"       <> help "Don't produce output, but show timing stats")
+      renderer
+        <-  flag  (parseTermBuilder TermSExpression)
+                  (parseTermBuilder TermSExpression)
+                  (  long "sexpression"
+                  <> help "Output s-expression parse trees (default)")
+        <|> flag' (parseTermBuilder TermJSONTree)
+                  (  long "json"
+                  <> help "Output JSON parse trees")
+        <|> flag' (parseTermBuilder TermJSONGraph)
+                  (  long "json-graph"
+                  <> help "Output JSON adjacency list")
+        <|> flag' (parseSymbolsBuilder JSON)
+                  (  long "symbols"
+                  <> help "Output JSON symbol list")
+        <|> flag' (parseSymbolsBuilder JSON)
+                  (  long "json-symbols"
+                  <> help "Output JSON symbol list")
+        <|> flag' (parseSymbolsBuilder Proto)
+                  (  long "proto-symbols"
+                  <> help "Output JSON symbol list")
+        <|> flag' (parseTermBuilder TermDotGraph)
+                  (  long "dot"
+                  <> help "Output DOT graph parse trees")
+        <|> flag' (parseTermBuilder TermShow)
+                  (  long "show"
+                  <> help "Output using the Show instance (debug only, format subject to change without notice)")
+        <|> flag' (parseTermBuilder TermQuiet)
+                  (  long "quiet"
+                  <> help "Don't produce output, but show timing stats")
       filesOrStdin <- FilesFromGitRepo
                       <$> option str (long "gitDir" <> help "A .git directory to read from")
                       <*> option shaReader (long "sha" <> help "The commit SHA1 to read from")

From 5f449f479e5efadb2ca645a83d7767c8af033cca Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 10:38:06 -0400
Subject: [PATCH 122/228] Define a datatype representing the types of ASTs we
 can operate over.

---
 src/Semantic/CLI.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index f33e39acc..0a6083bb3 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -98,6 +98,11 @@ diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute change
       filesOrStdin <- Right <$> some (Both <$> argument filePathReader (metavar "FILE_A") <*> argument filePathReader (metavar "FILE_B")) <|> pure (Left stdin)
       pure $ Task.readBlobPairs filesOrStdin >>= renderer
 
+data ASTMode
+  = ALaCarte
+  | Precise
+  deriving (Eq, Ord, Show)
+
 parseCommand :: Mod CommandFields (Task.TaskEff Builder)
 parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)"))
   where

From fc153ec5932d2fde9adc28e25130fa304fd0cd0b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 10:38:22 -0400
Subject: [PATCH 123/228] Define a datatype representing the selection of a
 mode for a given language.

---
 src/Semantic/CLI.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 0a6083bb3..fa3d7b3a1 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -98,6 +98,11 @@ diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute change
       filesOrStdin <- Right <$> some (Both <$> argument filePathReader (metavar "FILE_A") <*> argument filePathReader (metavar "FILE_B")) <|> pure (Left stdin)
       pure $ Task.readBlobPairs filesOrStdin >>= renderer
 
+newtype LanguageModes = LanguageModes
+  { pythonMode :: ASTMode
+  }
+  deriving (Eq, Ord, Show)
+
 data ASTMode
   = ALaCarte
   | Precise

From a20063353e66f10c8bba8fafdeed6a7567af205f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 10:48:38 -0400
Subject: [PATCH 124/228] Derive a Read instance for ASTMode.

---
 src/Semantic/CLI.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index fa3d7b3a1..39820887e 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -106,7 +106,7 @@ newtype LanguageModes = LanguageModes
 data ASTMode
   = ALaCarte
   | Precise
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Read, Show)
 
 parseCommand :: Mod CommandFields (Task.TaskEff Builder)
 parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)"))

From 2b650143cb7ad8248fe566142bd54b2d1ba12253 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:19:36 -0400
Subject: [PATCH 125/228] Derive Bounded & Enum instances for ASTMode.

---
 src/Semantic/CLI.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 39820887e..a433b7197 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -106,7 +106,7 @@ newtype LanguageModes = LanguageModes
 data ASTMode
   = ALaCarte
   | Precise
-  deriving (Eq, Ord, Read, Show)
+  deriving (Bounded, Enum, Eq, Ord, Read, Show)
 
 parseCommand :: Mod CommandFields (Task.TaskEff Builder)
 parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)"))

From c7b611cc52bbe815c85f33ab931490e4e86dab5e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:19:42 -0400
Subject: [PATCH 126/228] Define an option for the Python mode.

---
 src/Semantic/CLI.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index a433b7197..431728d72 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -112,6 +112,8 @@ parseCommand :: Mod CommandFields (Task.TaskEff Builder)
 parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)"))
   where
     parseArgumentsParser = do
+      language <- LanguageModes
+        <$> option auto (long "python-mode" <> help "The AST representation to use for Python sources" <> metavar "ALaCarte|Precise" <> value ALaCarte <> showDefault <> completer (listCompleter (map show (enumFrom @ASTMode minBound))))
       renderer
         <-  flag  (parseTermBuilder TermSExpression)
                   (parseTermBuilder TermSExpression)

From ea6184367b92b4592d3b6996656b045c98b69726 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:20:21 -0400
Subject: [PATCH 127/228] Reformat the Python mode parser.

---
 src/Semantic/CLI.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 431728d72..883f6c561 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -113,7 +113,12 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
   where
     parseArgumentsParser = do
       language <- LanguageModes
-        <$> option auto (long "python-mode" <> help "The AST representation to use for Python sources" <> metavar "ALaCarte|Precise" <> value ALaCarte <> showDefault <> completer (listCompleter (map show (enumFrom @ASTMode minBound))))
+        <$> option auto (  long "python-mode"
+                        <> help "The AST representation to use for Python sources"
+                        <> metavar "ALaCarte|Precise"
+                        <> value ALaCarte
+                        <> showDefault
+                        <> completer (listCompleter (map show (enumFrom @ASTMode minBound))))
       renderer
         <-  flag  (parseTermBuilder TermSExpression)
                   (parseTermBuilder TermSExpression)

From 95b83e983c0b5303fc53d21e9b7118d3edf9a509 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:20:38 -0400
Subject: [PATCH 128/228] :fire: the completer.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

It doesn’t seem to work anyway.
---
 src/Semantic/CLI.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 883f6c561..c1bb54e6b 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -117,8 +117,7 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
                         <> help "The AST representation to use for Python sources"
                         <> metavar "ALaCarte|Precise"
                         <> value ALaCarte
-                        <> showDefault
-                        <> completer (listCompleter (map show (enumFrom @ASTMode minBound))))
+                        <> showDefault)
       renderer
         <-  flag  (parseTermBuilder TermSExpression)
                   (parseTermBuilder TermSExpression)

From d773ca82826b810f135f895f648ce2e8c5d43ac0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:32:57 -0400
Subject: [PATCH 129/228] Move LanguageModes & ASTMode into Data.Language.

---
 src/Data/Language.hs | 13 +++++++++++++
 src/Semantic/CLI.hs  | 14 ++------------
 2 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/src/Data/Language.hs b/src/Data/Language.hs
index b1a5892a1..ca8242458 100644
--- a/src/Data/Language.hs
+++ b/src/Data/Language.hs
@@ -10,6 +10,8 @@ module Data.Language
   , codeNavLanguages
   , textToLanguage
   , languageToText
+  , LanguageModes(..)
+  , ASTMode(..)
   ) where
 
 import           Data.Aeson
@@ -137,3 +139,14 @@ textToLanguage = \case
   "TSX" -> TSX
   "PHP" -> PHP
   _ -> Unknown
+
+
+newtype LanguageModes = LanguageModes
+  { pythonMode :: ASTMode
+  }
+  deriving (Eq, Ord, Show)
+
+data ASTMode
+  = ALaCarte
+  | Precise
+  deriving (Bounded, Enum, Eq, Ord, Read, Show)
diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index c1bb54e6b..b03c7e1b7 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -98,25 +98,15 @@ diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute change
       filesOrStdin <- Right <$> some (Both <$> argument filePathReader (metavar "FILE_A") <*> argument filePathReader (metavar "FILE_B")) <|> pure (Left stdin)
       pure $ Task.readBlobPairs filesOrStdin >>= renderer
 
-newtype LanguageModes = LanguageModes
-  { pythonMode :: ASTMode
-  }
-  deriving (Eq, Ord, Show)
-
-data ASTMode
-  = ALaCarte
-  | Precise
-  deriving (Bounded, Enum, Eq, Ord, Read, Show)
-
 parseCommand :: Mod CommandFields (Task.TaskEff Builder)
 parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)"))
   where
     parseArgumentsParser = do
-      language <- LanguageModes
+      language <- Language.LanguageModes
         <$> option auto (  long "python-mode"
                         <> help "The AST representation to use for Python sources"
                         <> metavar "ALaCarte|Precise"
-                        <> value ALaCarte
+                        <> value Language.ALaCarte
                         <> showDefault)
       renderer
         <-  flag  (parseTermBuilder TermSExpression)

From 58c5eac144341fc81becb4a22b45a41700d3c65a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:34:08 -0400
Subject: [PATCH 130/228] Rename the language mode types.

---
 src/Data/Language.hs | 10 +++++-----
 src/Semantic/CLI.hs  |  2 +-
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Data/Language.hs b/src/Data/Language.hs
index ca8242458..a93e3469d 100644
--- a/src/Data/Language.hs
+++ b/src/Data/Language.hs
@@ -10,8 +10,8 @@ module Data.Language
   , codeNavLanguages
   , textToLanguage
   , languageToText
-  , LanguageModes(..)
-  , ASTMode(..)
+  , PerLanguageModes(..)
+  , LanguageMode(..)
   ) where
 
 import           Data.Aeson
@@ -141,12 +141,12 @@ textToLanguage = \case
   _ -> Unknown
 
 
-newtype LanguageModes = LanguageModes
-  { pythonMode :: ASTMode
+newtype PerLanguageModes = PerLanguageModes
+  { pythonMode :: LanguageMode
   }
   deriving (Eq, Ord, Show)
 
-data ASTMode
+data LanguageMode
   = ALaCarte
   | Precise
   deriving (Bounded, Enum, Eq, Ord, Read, Show)
diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index b03c7e1b7..995c63673 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -102,7 +102,7 @@ parseCommand :: Mod CommandFields (Task.TaskEff Builder)
 parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)"))
   where
     parseArgumentsParser = do
-      language <- Language.LanguageModes
+      language <- Language.PerLanguageModes
         <$> option auto (  long "python-mode"
                         <> help "The AST representation to use for Python sources"
                         <> metavar "ALaCarte|Precise"

From b6ca57e87a2fe5e24e418590e0f1cf5d1c297a7a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:38:24 -0400
Subject: [PATCH 131/228] Combine the flags for JSON symbols output.

---
 src/Semantic/CLI.hs | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 995c63673..11afbed09 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -121,9 +121,7 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
                   <> help "Output JSON adjacency list")
         <|> flag' (parseSymbolsBuilder JSON)
                   (  long "symbols"
-                  <> help "Output JSON symbol list")
-        <|> flag' (parseSymbolsBuilder JSON)
-                  (  long "json-symbols"
+                  <> long "json-symbols"
                   <> help "Output JSON symbol list")
         <|> flag' (parseSymbolsBuilder Proto)
                   (  long "proto-symbols"

From d066b31081b827cf0d4781e5dc564278f9dfa452 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:38:42 -0400
Subject: [PATCH 132/228] Fix the help text for the protobuf symbols output.

---
 src/Semantic/CLI.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 11afbed09..1d02f686e 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -125,7 +125,7 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
                   <> help "Output JSON symbol list")
         <|> flag' (parseSymbolsBuilder Proto)
                   (  long "proto-symbols"
-                  <> help "Output JSON symbol list")
+                  <> help "Output protobufs symbol list")
         <|> flag' (parseTermBuilder TermDotGraph)
                   (  long "dot"
                   <> help "Output DOT graph parse trees")

From f68c710a58e6c65873e85e92da88743bf9bd723a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:42:14 -0400
Subject: [PATCH 133/228] Pass the language modes to parseSymbolsBuilder.

---
 src/Semantic/Api/Symbols.hs |  5 +++--
 src/Semantic/CLI.hs         | 18 +++++++++---------
 2 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs
index 206f12ff0..82eb90d06 100644
--- a/src/Semantic/Api/Symbols.hs
+++ b/src/Semantic/Api/Symbols.hs
@@ -10,6 +10,7 @@ import           Control.Exception
 import           Control.Lens
 import           Data.Blob hiding (File (..))
 import           Data.ByteString.Builder
+import           Data.Language
 import           Data.Maybe
 import           Data.Term
 import qualified Data.Text as T
@@ -54,8 +55,8 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap
           , symbolSpan = converting #? span
           }
 
-parseSymbolsBuilder :: (Member Distribute sig, ParseEffects sig m, Traversable t) => Format ParseTreeSymbolResponse -> t Blob -> m Builder
-parseSymbolsBuilder format blobs = parseSymbols blobs >>= serialize format
+parseSymbolsBuilder :: (Member Distribute sig, ParseEffects sig m, Traversable t) => Format ParseTreeSymbolResponse -> PerLanguageModes -> t Blob -> m Builder
+parseSymbolsBuilder format _ blobs = parseSymbols blobs >>= serialize format
 
 parseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t Blob -> m ParseTreeSymbolResponse
 parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs go
diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 1d02f686e..108da11f0 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -102,21 +102,21 @@ parseCommand :: Mod CommandFields (Task.TaskEff Builder)
 parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)"))
   where
     parseArgumentsParser = do
-      language <- Language.PerLanguageModes
+      languageModes <- Language.PerLanguageModes
         <$> option auto (  long "python-mode"
                         <> help "The AST representation to use for Python sources"
                         <> metavar "ALaCarte|Precise"
                         <> value Language.ALaCarte
                         <> showDefault)
       renderer
-        <-  flag  (parseTermBuilder TermSExpression)
-                  (parseTermBuilder TermSExpression)
+        <-  flag  (const (parseTermBuilder TermSExpression))
+                  (const (parseTermBuilder TermSExpression))
                   (  long "sexpression"
                   <> help "Output s-expression parse trees (default)")
-        <|> flag' (parseTermBuilder TermJSONTree)
+        <|> flag' (const (parseTermBuilder TermJSONTree))
                   (  long "json"
                   <> help "Output JSON parse trees")
-        <|> flag' (parseTermBuilder TermJSONGraph)
+        <|> flag' (const (parseTermBuilder TermJSONGraph))
                   (  long "json-graph"
                   <> help "Output JSON adjacency list")
         <|> flag' (parseSymbolsBuilder JSON)
@@ -126,13 +126,13 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
         <|> flag' (parseSymbolsBuilder Proto)
                   (  long "proto-symbols"
                   <> help "Output protobufs symbol list")
-        <|> flag' (parseTermBuilder TermDotGraph)
+        <|> flag' (const (parseTermBuilder TermDotGraph))
                   (  long "dot"
                   <> help "Output DOT graph parse trees")
-        <|> flag' (parseTermBuilder TermShow)
+        <|> flag' (const (parseTermBuilder TermShow))
                   (  long "show"
                   <> help "Output using the Show instance (debug only, format subject to change without notice)")
-        <|> flag' (parseTermBuilder TermQuiet)
+        <|> flag' (const (parseTermBuilder TermQuiet))
                   (  long "quiet"
                   <> help "Don't produce output, but show timing stats")
       filesOrStdin <- FilesFromGitRepo
@@ -144,7 +144,7 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
                         <|> IncludePathsFromHandle <$> flag' stdin (long "only-stdin" <> help "Include only the paths given to stdin"))
                   <|> FilesFromPaths <$> some (argument filePathReader (metavar "FILES..."))
                   <|> pure (FilesFromHandle stdin)
-      pure $ Task.readBlobs filesOrStdin >>= renderer
+      pure $ Task.readBlobs filesOrStdin >>= renderer languageModes
 
 tsParseCommand :: Mod CommandFields (Task.TaskEff Builder)
 tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Generate raw tree-sitter parse trees for path(s)"))

From 10093b1088094fbb99f2acfb2a7cf022795f49f2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:43:17 -0400
Subject: [PATCH 134/228] Pass the language modes to parseTermBuilder.

---
 src/Semantic/Api/Terms.hs | 14 +++++++-------
 src/Semantic/CLI.hs       | 14 +++++++-------
 2 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/src/Semantic/Api/Terms.hs b/src/Semantic/Api/Terms.hs
index 9ae71df52..e8e16ac12 100644
--- a/src/Semantic/Api/Terms.hs
+++ b/src/Semantic/Api/Terms.hs
@@ -69,13 +69,13 @@ data TermOutputFormat
   deriving (Eq, Show)
 
 parseTermBuilder :: (Traversable t, Member Distribute sig, ParseEffects sig m, MonadIO m)
-  => TermOutputFormat-> t Blob -> m Builder
-parseTermBuilder TermJSONTree    = distributeFoldMap jsonTerm >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blobs.
-parseTermBuilder TermJSONGraph   = termGraph >=> serialize Format.JSON
-parseTermBuilder TermSExpression = distributeFoldMap sexpTerm
-parseTermBuilder TermDotGraph    = distributeFoldMap dotGraphTerm
-parseTermBuilder TermShow        = distributeFoldMap showTerm
-parseTermBuilder TermQuiet       = distributeFoldMap quietTerm
+  => TermOutputFormat -> PerLanguageModes -> t Blob -> m Builder
+parseTermBuilder TermJSONTree    _ = distributeFoldMap jsonTerm >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blobs.
+parseTermBuilder TermJSONGraph   _ = termGraph >=> serialize Format.JSON
+parseTermBuilder TermSExpression _ = distributeFoldMap sexpTerm
+parseTermBuilder TermDotGraph    _ = distributeFoldMap dotGraphTerm
+parseTermBuilder TermShow        _ = distributeFoldMap showTerm
+parseTermBuilder TermQuiet       _ = distributeFoldMap quietTerm
 
 jsonTerm :: (ParseEffects sig m) => Blob -> m (Rendering.JSON.JSON "trees" SomeJSON)
 jsonTerm blob = (doParse blob >>= withSomeTerm (pure . renderJSONTerm blob)) `catchError` jsonError blob
diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 108da11f0..d486523dc 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -109,14 +109,14 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
                         <> value Language.ALaCarte
                         <> showDefault)
       renderer
-        <-  flag  (const (parseTermBuilder TermSExpression))
-                  (const (parseTermBuilder TermSExpression))
+        <-  flag  (parseTermBuilder TermSExpression)
+                  (parseTermBuilder TermSExpression)
                   (  long "sexpression"
                   <> help "Output s-expression parse trees (default)")
-        <|> flag' (const (parseTermBuilder TermJSONTree))
+        <|> flag' (parseTermBuilder TermJSONTree)
                   (  long "json"
                   <> help "Output JSON parse trees")
-        <|> flag' (const (parseTermBuilder TermJSONGraph))
+        <|> flag' (parseTermBuilder TermJSONGraph)
                   (  long "json-graph"
                   <> help "Output JSON adjacency list")
         <|> flag' (parseSymbolsBuilder JSON)
@@ -126,13 +126,13 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
         <|> flag' (parseSymbolsBuilder Proto)
                   (  long "proto-symbols"
                   <> help "Output protobufs symbol list")
-        <|> flag' (const (parseTermBuilder TermDotGraph))
+        <|> flag' (parseTermBuilder TermDotGraph)
                   (  long "dot"
                   <> help "Output DOT graph parse trees")
-        <|> flag' (const (parseTermBuilder TermShow))
+        <|> flag' (parseTermBuilder TermShow)
                   (  long "show"
                   <> help "Output using the Show instance (debug only, format subject to change without notice)")
-        <|> flag' (const (parseTermBuilder TermQuiet))
+        <|> flag' (parseTermBuilder TermQuiet)
                   (  long "quiet"
                   <> help "Don't produce output, but show timing stats")
       filesOrStdin <- FilesFromGitRepo

From b394bcd816aec4f1bd68f273dd65846314de5e06 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:46:16 -0400
Subject: [PATCH 135/228] Pass the modes to parseSymbols.

---
 src/Semantic/Api/Symbols.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs
index 82eb90d06..d4a326833 100644
--- a/src/Semantic/Api/Symbols.hs
+++ b/src/Semantic/Api/Symbols.hs
@@ -56,10 +56,10 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap
           }
 
 parseSymbolsBuilder :: (Member Distribute sig, ParseEffects sig m, Traversable t) => Format ParseTreeSymbolResponse -> PerLanguageModes -> t Blob -> m Builder
-parseSymbolsBuilder format _ blobs = parseSymbols blobs >>= serialize format
+parseSymbolsBuilder format modes blobs = parseSymbols modes blobs >>= serialize format
 
-parseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t Blob -> m ParseTreeSymbolResponse
-parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs go
+parseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => PerLanguageModes -> t Blob -> m ParseTreeSymbolResponse
+parseSymbols _ blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs go
   where
     go :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m) => Blob -> m File
     go blob@Blob{..} = (doParse blob >>= withSomeTerm renderToSymbols) `catchError` (\(SomeException e) -> pure $ errorFile (show e))

From 44f9a11a623c772f27bc2ea1be0744835643c6d0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:48:07 -0400
Subject: [PATCH 136/228] Define a helper to look up the mode for a given
 language.

---
 src/Data/Language.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/src/Data/Language.hs b/src/Data/Language.hs
index a93e3469d..21b81ef84 100644
--- a/src/Data/Language.hs
+++ b/src/Data/Language.hs
@@ -12,6 +12,7 @@ module Data.Language
   , languageToText
   , PerLanguageModes(..)
   , LanguageMode(..)
+  , modeForLanguage
   ) where
 
 import           Data.Aeson
@@ -150,3 +151,8 @@ data LanguageMode
   = ALaCarte
   | Precise
   deriving (Bounded, Enum, Eq, Ord, Read, Show)
+
+modeForLanguage :: PerLanguageModes -> Language -> LanguageMode
+modeForLanguage modes = \case
+  Python -> pythonMode modes
+  _      -> ALaCarte

From a05f91cede345af739f38cb347dd08e0befd20db Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 11:55:31 -0400
Subject: [PATCH 137/228] Pass the language mode around with a Reader effect.

---
 src/Semantic/Api/Symbols.hs | 13 ++++++-------
 src/Semantic/Api/Terms.hs   | 17 +++++++++--------
 src/Semantic/CLI.hs         |  3 ++-
 3 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs
index d4a326833..93ba48509 100644
--- a/src/Semantic/Api/Symbols.hs
+++ b/src/Semantic/Api/Symbols.hs
@@ -10,7 +10,6 @@ import           Control.Exception
 import           Control.Lens
 import           Data.Blob hiding (File (..))
 import           Data.ByteString.Builder
-import           Data.Language
 import           Data.Maybe
 import           Data.Term
 import qualified Data.Text as T
@@ -31,7 +30,7 @@ import           Tags.Tagging
 legacyParseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t Blob -> m Legacy.ParseTreeSymbolResponse
 legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap go blobs
   where
-    go :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m) => Blob -> m [Legacy.File]
+    go :: ParseEffects sig m => Blob -> m [Legacy.File]
     go blob@Blob{..} = (doParse blob >>= withSomeTerm renderToSymbols) `catchError` (\(SomeException _) -> pure (pure emptyFile))
       where
         emptyFile = tagsToFile []
@@ -55,13 +54,13 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap
           , symbolSpan = converting #? span
           }
 
-parseSymbolsBuilder :: (Member Distribute sig, ParseEffects sig m, Traversable t) => Format ParseTreeSymbolResponse -> PerLanguageModes -> t Blob -> m Builder
-parseSymbolsBuilder format modes blobs = parseSymbols modes blobs >>= serialize format
+parseSymbolsBuilder :: (Member Distribute sig, ParseEffects sig m, Traversable t) => Format ParseTreeSymbolResponse -> t Blob -> m Builder
+parseSymbolsBuilder format blobs = parseSymbols blobs >>= serialize format
 
-parseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => PerLanguageModes -> t Blob -> m ParseTreeSymbolResponse
-parseSymbols _ blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs go
+parseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t Blob -> m ParseTreeSymbolResponse
+parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs go
   where
-    go :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m) => Blob -> m File
+    go :: ParseEffects sig m => Blob -> m File
     go blob@Blob{..} = (doParse blob >>= withSomeTerm renderToSymbols) `catchError` (\(SomeException e) -> pure $ errorFile (show e))
       where
         blobLanguage' = blobLanguage blob
diff --git a/src/Semantic/Api/Terms.hs b/src/Semantic/Api/Terms.hs
index e8e16ac12..5a3500375 100644
--- a/src/Semantic/Api/Terms.hs
+++ b/src/Semantic/Api/Terms.hs
@@ -16,6 +16,7 @@ module Semantic.Api.Terms
 
 import           Analysis.ConstructorName (ConstructorName)
 import           Control.Effect.Error
+import           Control.Effect.Reader
 import           Control.Lens
 import           Control.Monad
 import           Control.Monad.IO.Class
@@ -69,13 +70,13 @@ data TermOutputFormat
   deriving (Eq, Show)
 
 parseTermBuilder :: (Traversable t, Member Distribute sig, ParseEffects sig m, MonadIO m)
-  => TermOutputFormat -> PerLanguageModes -> t Blob -> m Builder
-parseTermBuilder TermJSONTree    _ = distributeFoldMap jsonTerm >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blobs.
-parseTermBuilder TermJSONGraph   _ = termGraph >=> serialize Format.JSON
-parseTermBuilder TermSExpression _ = distributeFoldMap sexpTerm
-parseTermBuilder TermDotGraph    _ = distributeFoldMap dotGraphTerm
-parseTermBuilder TermShow        _ = distributeFoldMap showTerm
-parseTermBuilder TermQuiet       _ = distributeFoldMap quietTerm
+  => TermOutputFormat -> t Blob -> m Builder
+parseTermBuilder TermJSONTree    = distributeFoldMap jsonTerm >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blobs.
+parseTermBuilder TermJSONGraph   = termGraph >=> serialize Format.JSON
+parseTermBuilder TermSExpression = distributeFoldMap sexpTerm
+parseTermBuilder TermDotGraph    = distributeFoldMap dotGraphTerm
+parseTermBuilder TermShow        = distributeFoldMap showTerm
+parseTermBuilder TermQuiet       = distributeFoldMap quietTerm
 
 jsonTerm :: (ParseEffects sig m) => Blob -> m (Rendering.JSON.JSON "trees" SomeJSON)
 jsonTerm blob = (doParse blob >>= withSomeTerm (pure . renderJSONTerm blob)) `catchError` jsonError blob
@@ -101,7 +102,7 @@ quietTerm blob = showTiming blob <$> time' ( (doParse blob >>= withSomeTerm (fma
       in stringUtf8 (status <> "\t" <> show (blobLanguage blob) <> "\t" <> blobPath blob <> "\t" <> show duration <> " ms\n")
 
 
-type ParseEffects sig m = (Member (Error SomeException) sig, Member Task sig, Carrier sig m)
+type ParseEffects sig m = (Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Task sig, Carrier sig m)
 
 type TermConstraints =
  '[ Taggable
diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index d486523dc..0e3ae2ad9 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE ApplicativeDo #-}
 module Semantic.CLI (main) where
 
+import           Control.Effect.Reader
 import           Control.Exception as Exc (displayException)
 import           Data.Blob
 import           Data.Blob.IO
@@ -144,7 +145,7 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
                         <|> IncludePathsFromHandle <$> flag' stdin (long "only-stdin" <> help "Include only the paths given to stdin"))
                   <|> FilesFromPaths <$> some (argument filePathReader (metavar "FILES..."))
                   <|> pure (FilesFromHandle stdin)
-      pure $ Task.readBlobs filesOrStdin >>= renderer languageModes
+      pure $ Task.readBlobs filesOrStdin >>= runReader languageModes . renderer
 
 tsParseCommand :: Mod CommandFields (Task.TaskEff Builder)
 tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Generate raw tree-sitter parse trees for path(s)"))

From a0e723a22d6acc052483a7fa9d34da0e540a7684 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 12:02:01 -0400
Subject: [PATCH 138/228] Stub in an overall Python module.

---
 semantic-tags/semantic-tags.cabal    | 1 +
 semantic-tags/src/Language/Python.hs | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-tags/src/Language/Python.hs

diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index cf8f8345c..17a225b2d 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -20,6 +20,7 @@ tested-with:         GHC == 8.6.5
 
 library
   exposed-modules:
+    Language.Python
     Language.Python.Tags
     Tags.Tag
     Tags.Tagging.Precise
diff --git a/semantic-tags/src/Language/Python.hs b/semantic-tags/src/Language/Python.hs
new file mode 100644
index 000000000..52a9f18cb
--- /dev/null
+++ b/semantic-tags/src/Language/Python.hs
@@ -0,0 +1,2 @@
+module Language.Python
+() where

From f33e678c7afe728c1d1d6d54045b9ae58e3f447c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 25 Sep 2019 12:04:13 -0400
Subject: [PATCH 139/228] Move Term into Language.Python.

---
 semantic-tags/src/Language/Python.hs      | 12 +++++++++++-
 semantic-tags/src/Language/Python/Tags.hs |  8 +-------
 2 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/semantic-tags/src/Language/Python.hs b/semantic-tags/src/Language/Python.hs
index 52a9f18cb..ed619cdae 100644
--- a/semantic-tags/src/Language/Python.hs
+++ b/semantic-tags/src/Language/Python.hs
@@ -1,2 +1,12 @@
 module Language.Python
-() where
+( Term(..)
+) where
+
+import qualified Language.Python.Tags as PyTags
+import qualified Tags.Tagging.Precise as Tags
+import qualified TreeSitter.Python.AST as Py
+
+newtype Term a = Term { getTerm :: Py.Module a }
+
+instance Tags.ToTags Term where
+  tags src = Tags.runTagging src . PyTags.tags . getTerm
diff --git a/semantic-tags/src/Language/Python/Tags.hs b/semantic-tags/src/Language/Python/Tags.hs
index 66aeee9bf..7aea8809c 100644
--- a/semantic-tags/src/Language/Python/Tags.hs
+++ b/semantic-tags/src/Language/Python/Tags.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Language.Python.Tags
-( Term(..)
+( ToTags(..)
 ) where
 
 import           Control.Effect.Reader
@@ -18,12 +18,6 @@ import           Tags.Tag
 import qualified Tags.Tagging.Precise as Tags
 import qualified TreeSitter.Python.AST as Py
 
-newtype Term a = Term { getTerm :: Py.Module a }
-
-instance Tags.ToTags Term where
-  tags src = Tags.runTagging src . tags . getTerm
-
-
 class ToTags t where
   tags
     :: ( Carrier sig m

From 726329d6597343536c9f63867b0a0d001334fd49 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:16:05 -0400
Subject: [PATCH 140/228] Rename runParser to runParserToAST.

---
 src/Parsing/TreeSitter.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 8c9e0b16e..3ae554fb1 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -32,8 +32,8 @@ data Result grammar
   = Failed
   | Succeeded (AST [] grammar)
 
-runParser :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Result grammar)
-runParser parser blobSource  = unsafeUseAsCStringLen (Source.bytes blobSource) $ \ (source, len) -> do
+runParserToAST :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Result grammar)
+runParserToAST parser blobSource  = unsafeUseAsCStringLen (Source.bytes blobSource) $ \ (source, len) -> do
     alloca (\ rootPtr -> do
       let acquire = do
             -- Change this to TS.ts_parser_loop_until_cancelled if you want to test out cancellation
@@ -72,7 +72,7 @@ parseToAST parseTimeout language b@Blob{..} = bracket (liftIO TS.ts_parser_new)
     TS.ts_parser_halt_on_error parser (CBool 1)
     TS.ts_parser_set_language parser language
   result <- if compatible then
-    liftIO $ runParser parser blobSource
+    liftIO $ runParserToAST parser blobSource
   else
     Failed <$ trace "tree-sitter: incompatible versions"
   case result of

From 70c9b865f00886840d61a031ff693412092468d4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:16:45 -0400
Subject: [PATCH 141/228] :fire: redundant do blocks.

---
 src/Parsing/TreeSitter.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 3ae554fb1..70ae6f34a 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -35,7 +35,7 @@ data Result grammar
 runParserToAST :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Result grammar)
 runParserToAST parser blobSource  = unsafeUseAsCStringLen (Source.bytes blobSource) $ \ (source, len) -> do
     alloca (\ rootPtr -> do
-      let acquire = do
+      let acquire =
             -- Change this to TS.ts_parser_loop_until_cancelled if you want to test out cancellation
             TS.ts_parser_parse_string parser nullPtr source len
 
@@ -43,7 +43,7 @@ runParserToAST parser blobSource  = unsafeUseAsCStringLen (Source.bytes blobSour
             | t == nullPtr = pure ()
             | otherwise = TS.ts_tree_delete t
 
-      let go treePtr = do
+      let go treePtr =
             if treePtr == nullPtr
               then pure Failed
               else do

From fc6d4091d6a107f3ac0fd7dee7b8e868f8445b9c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:17:18 -0400
Subject: [PATCH 142/228] Spacing.

---
 src/Parsing/TreeSitter.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 70ae6f34a..0c7695c06 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -33,7 +33,7 @@ data Result grammar
   | Succeeded (AST [] grammar)
 
 runParserToAST :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Result grammar)
-runParserToAST parser blobSource  = unsafeUseAsCStringLen (Source.bytes blobSource) $ \ (source, len) -> do
+runParserToAST parser blobSource = unsafeUseAsCStringLen (Source.bytes blobSource) $ \ (source, len) -> do
     alloca (\ rootPtr -> do
       let acquire =
             -- Change this to TS.ts_parser_loop_until_cancelled if you want to test out cancellation

From c8baf4a4ba4a2b3b4900036793b06e5e2605e15c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:17:50 -0400
Subject: [PATCH 143/228] :fire: more do blocks.

---
 src/Parsing/TreeSitter.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 0c7695c06..203c09bd4 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -33,24 +33,24 @@ data Result grammar
   | Succeeded (AST [] grammar)
 
 runParserToAST :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Result grammar)
-runParserToAST parser blobSource = unsafeUseAsCStringLen (Source.bytes blobSource) $ \ (source, len) -> do
-    alloca (\ rootPtr -> do
+runParserToAST parser blobSource = unsafeUseAsCStringLen (Source.bytes blobSource) $ \ (source, len) ->
+    alloca (\ rootPtr ->
       let acquire =
             -- Change this to TS.ts_parser_loop_until_cancelled if you want to test out cancellation
             TS.ts_parser_parse_string parser nullPtr source len
 
-      let release t
+          release t
             | t == nullPtr = pure ()
             | otherwise = TS.ts_tree_delete t
 
-      let go treePtr =
+          go treePtr =
             if treePtr == nullPtr
               then pure Failed
               else do
                 TS.ts_tree_root_node_p treePtr rootPtr
                 ptr <- peek rootPtr
                 Succeeded <$> anaM toAST ptr
-      Exc.bracket acquire release go)
+      in Exc.bracket acquire release go)
 
 -- | Parse 'Source' with the given 'TS.Language' and return its AST.
 -- Returns Nothing if the operation timed out.

From 1a05c46bf08798feaf5a62efda9b0f22f9a2640a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:17:59 -0400
Subject: [PATCH 144/228] Dedent.

---
 src/Parsing/TreeSitter.hs | 30 +++++++++++++++---------------
 1 file changed, 15 insertions(+), 15 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 203c09bd4..0f09097ad 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -34,23 +34,23 @@ data Result grammar
 
 runParserToAST :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Result grammar)
 runParserToAST parser blobSource = unsafeUseAsCStringLen (Source.bytes blobSource) $ \ (source, len) ->
-    alloca (\ rootPtr ->
-      let acquire =
-            -- Change this to TS.ts_parser_loop_until_cancelled if you want to test out cancellation
-            TS.ts_parser_parse_string parser nullPtr source len
+  alloca (\ rootPtr ->
+    let acquire =
+          -- Change this to TS.ts_parser_loop_until_cancelled if you want to test out cancellation
+          TS.ts_parser_parse_string parser nullPtr source len
 
-          release t
-            | t == nullPtr = pure ()
-            | otherwise = TS.ts_tree_delete t
+        release t
+          | t == nullPtr = pure ()
+          | otherwise = TS.ts_tree_delete t
 
-          go treePtr =
-            if treePtr == nullPtr
-              then pure Failed
-              else do
-                TS.ts_tree_root_node_p treePtr rootPtr
-                ptr <- peek rootPtr
-                Succeeded <$> anaM toAST ptr
-      in Exc.bracket acquire release go)
+        go treePtr =
+          if treePtr == nullPtr
+            then pure Failed
+            else do
+              TS.ts_tree_root_node_p treePtr rootPtr
+              ptr <- peek rootPtr
+              Succeeded <$> anaM toAST ptr
+    in Exc.bracket acquire release go)
 
 -- | Parse 'Source' with the given 'TS.Language' and return its AST.
 -- Returns Nothing if the operation timed out.

From aafe9f47bc14765cb8cd34449d119cf2c4953020 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:19:02 -0400
Subject: [PATCH 145/228] Reformat an if statement.

---
 src/Parsing/TreeSitter.hs | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 0f09097ad..da4e2eb51 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -43,13 +43,12 @@ runParserToAST parser blobSource = unsafeUseAsCStringLen (Source.bytes blobSourc
           | t == nullPtr = pure ()
           | otherwise = TS.ts_tree_delete t
 
-        go treePtr =
-          if treePtr == nullPtr
-            then pure Failed
-            else do
-              TS.ts_tree_root_node_p treePtr rootPtr
-              ptr <- peek rootPtr
-              Succeeded <$> anaM toAST ptr
+        go treePtr = if treePtr == nullPtr then
+          pure Failed
+        else do
+          TS.ts_tree_root_node_p treePtr rootPtr
+          ptr <- peek rootPtr
+          Succeeded <$> anaM toAST ptr
     in Exc.bracket acquire release go)
 
 -- | Parse 'Source' with the given 'TS.Language' and return its AST.

From 0b0b2ef427c53e11e3563d1874c6dfa8dcb49de4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:20:25 -0400
Subject: [PATCH 146/228] :fire: Result.

---
 src/Parsing/TreeSitter.hs | 16 ++++++----------
 1 file changed, 6 insertions(+), 10 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index da4e2eb51..01588edd5 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -28,11 +28,7 @@ import qualified TreeSitter.Node as TS
 import qualified TreeSitter.Parser as TS
 import qualified TreeSitter.Tree as TS
 
-data Result grammar
-  = Failed
-  | Succeeded (AST [] grammar)
-
-runParserToAST :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Result grammar)
+runParserToAST :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Maybe (AST [] grammar))
 runParserToAST parser blobSource = unsafeUseAsCStringLen (Source.bytes blobSource) $ \ (source, len) ->
   alloca (\ rootPtr ->
     let acquire =
@@ -44,11 +40,11 @@ runParserToAST parser blobSource = unsafeUseAsCStringLen (Source.bytes blobSourc
           | otherwise = TS.ts_tree_delete t
 
         go treePtr = if treePtr == nullPtr then
-          pure Failed
+          pure Nothing
         else do
           TS.ts_tree_root_node_p treePtr rootPtr
           ptr <- peek rootPtr
-          Succeeded <$> anaM toAST ptr
+          Just <$> anaM toAST ptr
     in Exc.bracket acquire release go)
 
 -- | Parse 'Source' with the given 'TS.Language' and return its AST.
@@ -73,10 +69,10 @@ parseToAST parseTimeout language b@Blob{..} = bracket (liftIO TS.ts_parser_new)
   result <- if compatible then
     liftIO $ runParserToAST parser blobSource
   else
-    Failed <$ trace "tree-sitter: incompatible versions"
+    Nothing <$ trace "tree-sitter: incompatible versions"
   case result of
-    Failed          -> Nothing  <$ trace ("tree-sitter: parsing failed " <> blobPath b)
-    (Succeeded ast) -> Just ast <$ trace ("tree-sitter: parsing succeeded " <> blobPath b)
+    Nothing  -> Nothing  <$ trace ("tree-sitter: parsing failed " <> blobPath b)
+    Just ast -> Just ast <$ trace ("tree-sitter: parsing succeeded " <> blobPath b)
 
 toAST :: forall grammar . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node)
 toAST node@TS.Node{..} = do

From b563f20edbaa2a182ba9442c94272353899240d1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:25:22 -0400
Subject: [PATCH 147/228] Define a helper to run an action with a parser.

---
 src/Parsing/TreeSitter.hs | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 01588edd5..e2f4272fa 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -92,3 +92,12 @@ nodeRange TS.Node{..} = Range (fromIntegral nodeStartByte) (fromIntegral nodeEnd
 nodeSpan :: TS.Node -> Span
 nodeSpan TS.Node{..} = nodeStartPoint `seq` nodeEndPoint `seq` Span (pointPos nodeStartPoint) (pointPos nodeEndPoint)
   where pointPos TS.TSPoint{..} = pointRow `seq` pointColumn `seq` Pos (1 + fromIntegral pointRow) (1 + fromIntegral pointColumn)
+
+
+withParser :: (Carrier sig m, Member Resource sig, MonadIO m) => Ptr TS.Language -> (Ptr TS.Parser -> m a) -> m a
+withParser language action = bracket
+  (liftIO   TS.ts_parser_new)
+  (liftIO . TS.ts_parser_delete)
+  $ \ parser -> do
+    _ <- liftIO (TS.ts_parser_set_language parser language)
+    action parser

From c399f0d637fefe71cf4cd3412302094f2a25f668 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:35:21 -0400
Subject: [PATCH 148/228] Use withParser to define parseToAST.

---
 src/Parsing/TreeSitter.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index e2f4272fa..efca092a2 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -60,7 +60,7 @@ parseToAST :: ( Bounded grammar
            -> Ptr TS.Language
            -> Blob
            -> m (Maybe (AST [] grammar))
-parseToAST parseTimeout language b@Blob{..} = bracket (liftIO TS.ts_parser_new) (liftIO . TS.ts_parser_delete) $ \ parser -> do
+parseToAST parseTimeout language b@Blob{..} = withParser language $ \ parser -> do
   compatible <- liftIO $ do
     let timeoutMicros = fromIntegral $ toMicroseconds parseTimeout
     TS.ts_parser_set_timeout_micros parser timeoutMicros

From 2745c69aa158c6668d4232617446f02b97a7c6cc Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:45:50 -0400
Subject: [PATCH 149/228] Rely on the TS definition of withParser.

---
 src/Parsing/TreeSitter.hs | 25 +++++++------------------
 1 file changed, 7 insertions(+), 18 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index efca092a2..f25de1a23 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -6,7 +6,6 @@ module Parsing.TreeSitter
 
 import Prologue hiding (bracket)
 
-import           Control.Effect.Resource
 import           Control.Effect.Trace
 import qualified Control.Exception as Exc (bracket)
 import           Data.ByteString.Unsafe (unsafeUseAsCStringLen)
@@ -52,7 +51,6 @@ runParserToAST parser blobSource = unsafeUseAsCStringLen (Source.bytes blobSourc
 parseToAST :: ( Bounded grammar
               , Carrier sig m
               , Enum grammar
-              , Member Resource sig
               , Member Trace sig
               , MonadIO m
               )
@@ -60,16 +58,16 @@ parseToAST :: ( Bounded grammar
            -> Ptr TS.Language
            -> Blob
            -> m (Maybe (AST [] grammar))
-parseToAST parseTimeout language b@Blob{..} = withParser language $ \ parser -> do
-  compatible <- liftIO $ do
+parseToAST parseTimeout language b@Blob{..} = do
+  result <- liftIO . TS.withParser language $ \ parser -> do
     let timeoutMicros = fromIntegral $ toMicroseconds parseTimeout
     TS.ts_parser_set_timeout_micros parser timeoutMicros
     TS.ts_parser_halt_on_error parser (CBool 1)
-    TS.ts_parser_set_language parser language
-  result <- if compatible then
-    liftIO $ runParserToAST parser blobSource
-  else
-    Nothing <$ trace "tree-sitter: incompatible versions"
+    compatible <- TS.ts_parser_set_language parser language
+    if compatible then
+      runParserToAST parser blobSource
+    else
+      pure Nothing
   case result of
     Nothing  -> Nothing  <$ trace ("tree-sitter: parsing failed " <> blobPath b)
     Just ast -> Just ast <$ trace ("tree-sitter: parsing succeeded " <> blobPath b)
@@ -92,12 +90,3 @@ nodeRange TS.Node{..} = Range (fromIntegral nodeStartByte) (fromIntegral nodeEnd
 nodeSpan :: TS.Node -> Span
 nodeSpan TS.Node{..} = nodeStartPoint `seq` nodeEndPoint `seq` Span (pointPos nodeStartPoint) (pointPos nodeEndPoint)
   where pointPos TS.TSPoint{..} = pointRow `seq` pointColumn `seq` Pos (1 + fromIntegral pointRow) (1 + fromIntegral pointColumn)
-
-
-withParser :: (Carrier sig m, Member Resource sig, MonadIO m) => Ptr TS.Language -> (Ptr TS.Parser -> m a) -> m a
-withParser language action = bracket
-  (liftIO   TS.ts_parser_new)
-  (liftIO . TS.ts_parser_delete)
-  $ \ parser -> do
-    _ <- liftIO (TS.ts_parser_set_language parser language)
-    action parser

From 3f4c89d09bf2ae74240c29cebcff3c1712d4fa33 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:47:33 -0400
Subject: [PATCH 150/228] Return errors from runParseToAST.

---
 src/Parsing/TreeSitter.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index f25de1a23..f63c879dc 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -27,7 +27,7 @@ import qualified TreeSitter.Node as TS
 import qualified TreeSitter.Parser as TS
 import qualified TreeSitter.Tree as TS
 
-runParserToAST :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Maybe (AST [] grammar))
+runParserToAST :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Either String (AST [] grammar))
 runParserToAST parser blobSource = unsafeUseAsCStringLen (Source.bytes blobSource) $ \ (source, len) ->
   alloca (\ rootPtr ->
     let acquire =
@@ -39,11 +39,11 @@ runParserToAST parser blobSource = unsafeUseAsCStringLen (Source.bytes blobSourc
           | otherwise = TS.ts_tree_delete t
 
         go treePtr = if treePtr == nullPtr then
-          pure Nothing
+          pure (Left "tree-sitter: null root node")
         else do
           TS.ts_tree_root_node_p treePtr rootPtr
           ptr <- peek rootPtr
-          Just <$> anaM toAST ptr
+          Right <$> anaM toAST ptr
     in Exc.bracket acquire release go)
 
 -- | Parse 'Source' with the given 'TS.Language' and return its AST.
@@ -67,10 +67,10 @@ parseToAST parseTimeout language b@Blob{..} = do
     if compatible then
       runParserToAST parser blobSource
     else
-      pure Nothing
+      pure (Left "tree-sitter: incompatible versions")
   case result of
-    Nothing  -> Nothing  <$ trace ("tree-sitter: parsing failed " <> blobPath b)
-    Just ast -> Just ast <$ trace ("tree-sitter: parsing succeeded " <> blobPath b)
+    Left  err -> Nothing  <$ trace err <* trace ("tree-sitter: parsing failed " <> blobPath b)
+    Right ast -> Just ast <$ trace ("tree-sitter: parsing succeeded " <> blobPath b)
 
 toAST :: forall grammar . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node)
 toAST node@TS.Node{..} = do

From 81fca0f6bb824d96d6e3be6971934c57166e659e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:50:35 -0400
Subject: [PATCH 151/228] :fire: runParserToAST.

---
 src/Parsing/TreeSitter.hs | 33 +++++++++------------------------
 1 file changed, 9 insertions(+), 24 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index f63c879dc..ebc091851 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -4,11 +4,9 @@ module Parsing.TreeSitter
 , parseToAST
 ) where
 
-import Prologue hiding (bracket)
+import Prologue
 
 import           Control.Effect.Trace
-import qualified Control.Exception as Exc (bracket)
-import           Data.ByteString.Unsafe (unsafeUseAsCStringLen)
 import           Foreign
 import           Foreign.C.Types (CBool (..))
 import           Foreign.Marshal.Array (allocaArray)
@@ -18,7 +16,6 @@ import           Data.Blob
 import           Data.Duration
 import           Data.Term
 import           Source.Loc
-import           Source.Source (Source)
 import qualified Source.Source as Source
 import           Source.Span
 
@@ -27,25 +24,6 @@ import qualified TreeSitter.Node as TS
 import qualified TreeSitter.Parser as TS
 import qualified TreeSitter.Tree as TS
 
-runParserToAST :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Either String (AST [] grammar))
-runParserToAST parser blobSource = unsafeUseAsCStringLen (Source.bytes blobSource) $ \ (source, len) ->
-  alloca (\ rootPtr ->
-    let acquire =
-          -- Change this to TS.ts_parser_loop_until_cancelled if you want to test out cancellation
-          TS.ts_parser_parse_string parser nullPtr source len
-
-        release t
-          | t == nullPtr = pure ()
-          | otherwise = TS.ts_tree_delete t
-
-        go treePtr = if treePtr == nullPtr then
-          pure (Left "tree-sitter: null root node")
-        else do
-          TS.ts_tree_root_node_p treePtr rootPtr
-          ptr <- peek rootPtr
-          Right <$> anaM toAST ptr
-    in Exc.bracket acquire release go)
-
 -- | Parse 'Source' with the given 'TS.Language' and return its AST.
 -- Returns Nothing if the operation timed out.
 parseToAST :: ( Bounded grammar
@@ -65,7 +43,14 @@ parseToAST parseTimeout language b@Blob{..} = do
     TS.ts_parser_halt_on_error parser (CBool 1)
     compatible <- TS.ts_parser_set_language parser language
     if compatible then
-      runParserToAST parser blobSource
+      TS.withParseTree parser (Source.bytes blobSource) $ \ treePtr ->
+        TS.withRootNode treePtr $ \ rootPtr ->
+          if treePtr == nullPtr then
+            pure (Left "tree-sitter: null root node")
+          else do
+            TS.ts_tree_root_node_p treePtr rootPtr
+            ptr <- peek rootPtr
+            Right <$> anaM toAST ptr
     else
       pure (Left "tree-sitter: incompatible versions")
   case result of

From 7c40ca0753deadc38506a1faf65e3ccef09bf7b8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:51:10 -0400
Subject: [PATCH 152/228] Correct the docs for parseToAST.

---
 src/Parsing/TreeSitter.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index ebc091851..8bf4a546f 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -24,8 +24,8 @@ import qualified TreeSitter.Node as TS
 import qualified TreeSitter.Parser as TS
 import qualified TreeSitter.Tree as TS
 
--- | Parse 'Source' with the given 'TS.Language' and return its AST.
--- Returns Nothing if the operation timed out.
+-- | Parse a 'Blob' with the given 'TS.Language' and return its AST.
+-- Returns 'Nothing' if the operation timed out.
 parseToAST :: ( Bounded grammar
               , Carrier sig m
               , Enum grammar

From 661805e6da755e7311b11f95c084d286311b44d3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:54:20 -0400
Subject: [PATCH 153/228] withRootNode already copies into the pointer.

---
 src/Parsing/TreeSitter.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 8bf4a546f..ed6e4b8c2 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -48,7 +48,6 @@ parseToAST parseTimeout language b@Blob{..} = do
           if treePtr == nullPtr then
             pure (Left "tree-sitter: null root node")
           else do
-            TS.ts_tree_root_node_p treePtr rootPtr
             ptr <- peek rootPtr
             Right <$> anaM toAST ptr
     else

From d4eefbf04ba7bf9dcfdbd62166147f634c4b6218 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:57:15 -0400
Subject: [PATCH 154/228] Factor the action-agnostic portion of parseToAST into
 a runParse function.

---
 src/Parsing/TreeSitter.hs | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index ed6e4b8c2..ce34e2ef7 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -36,7 +36,19 @@ parseToAST :: ( Bounded grammar
            -> Ptr TS.Language
            -> Blob
            -> m (Maybe (AST [] grammar))
-parseToAST parseTimeout language b@Blob{..} = do
+parseToAST parseTimeout language blob = runParse parseTimeout language blob $ \ rootPtr -> peek rootPtr >>= anaM toAST
+
+runParse
+  :: ( Carrier sig m
+     , Member Trace sig
+     , MonadIO m
+     )
+  => Duration
+  -> Ptr TS.Language
+  -> Blob
+  -> (Ptr TS.Node -> IO a)
+  -> m (Maybe a)
+runParse parseTimeout language b@Blob{..} action = do
   result <- liftIO . TS.withParser language $ \ parser -> do
     let timeoutMicros = fromIntegral $ toMicroseconds parseTimeout
     TS.ts_parser_set_timeout_micros parser timeoutMicros
@@ -47,9 +59,8 @@ parseToAST parseTimeout language b@Blob{..} = do
         TS.withRootNode treePtr $ \ rootPtr ->
           if treePtr == nullPtr then
             pure (Left "tree-sitter: null root node")
-          else do
-            ptr <- peek rootPtr
-            Right <$> anaM toAST ptr
+          else
+            Right <$> action rootPtr
     else
       pure (Left "tree-sitter: incompatible versions")
   case result of

From 07ddc7699e3f14792c827859ab221f6b44d840b4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 12:58:40 -0400
Subject: [PATCH 155/228] Kleisli composition.

---
 src/Parsing/TreeSitter.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index ce34e2ef7..61934e901 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -36,7 +36,7 @@ parseToAST :: ( Bounded grammar
            -> Ptr TS.Language
            -> Blob
            -> m (Maybe (AST [] grammar))
-parseToAST parseTimeout language blob = runParse parseTimeout language blob $ \ rootPtr -> peek rootPtr >>= anaM toAST
+parseToAST parseTimeout language blob = runParse parseTimeout language blob (anaM toAST <=< peek)
 
 runParse
   :: ( Carrier sig m

From a74490cc15b2c9cf7398e3efa9bf2a6c261f2cc3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 13:03:40 -0400
Subject: [PATCH 156/228] Factor the conditional leftward.

---
 src/Parsing/TreeSitter.hs | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 61934e901..c52fb9de7 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -55,12 +55,11 @@ runParse parseTimeout language b@Blob{..} action = do
     TS.ts_parser_halt_on_error parser (CBool 1)
     compatible <- TS.ts_parser_set_language parser language
     if compatible then
-      TS.withParseTree parser (Source.bytes blobSource) $ \ treePtr ->
-        TS.withRootNode treePtr $ \ rootPtr ->
-          if treePtr == nullPtr then
-            pure (Left "tree-sitter: null root node")
-          else
-            Right <$> action rootPtr
+      TS.withParseTree parser (Source.bytes blobSource) $ \ treePtr -> do
+        if treePtr == nullPtr then
+          pure (Left "tree-sitter: null root node")
+        else
+          TS.withRootNode treePtr (fmap Right . action)
     else
       pure (Left "tree-sitter: incompatible versions")
   case result of

From 8210639d357695b8a1d6453b8595f3436d080fe5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 13:23:49 -0400
Subject: [PATCH 157/228] Allow the action to report failures.

---
 src/Parsing/TreeSitter.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index c52fb9de7..d3c1875fd 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -36,7 +36,7 @@ parseToAST :: ( Bounded grammar
            -> Ptr TS.Language
            -> Blob
            -> m (Maybe (AST [] grammar))
-parseToAST parseTimeout language blob = runParse parseTimeout language blob (anaM toAST <=< peek)
+parseToAST parseTimeout language blob = runParse parseTimeout language blob (fmap Right . anaM toAST <=< peek)
 
 runParse
   :: ( Carrier sig m
@@ -46,7 +46,7 @@ runParse
   => Duration
   -> Ptr TS.Language
   -> Blob
-  -> (Ptr TS.Node -> IO a)
+  -> (Ptr TS.Node -> IO (Either String a))
   -> m (Maybe a)
 runParse parseTimeout language b@Blob{..} action = do
   result <- liftIO . TS.withParser language $ \ parser -> do
@@ -59,7 +59,7 @@ runParse parseTimeout language b@Blob{..} action = do
         if treePtr == nullPtr then
           pure (Left "tree-sitter: null root node")
         else
-          TS.withRootNode treePtr (fmap Right . action)
+          TS.withRootNode treePtr action
     else
       pure (Left "tree-sitter: incompatible versions")
   case result of

From 957f8abdd4f1f07eae8b38c3e71b19f9026feba1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 13:24:24 -0400
Subject: [PATCH 158/228] Add a helper to parse to precise ASTs.

---
 src/Parsing/TreeSitter.hs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index d3c1875fd..89251f47a 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -2,10 +2,14 @@
 module Parsing.TreeSitter
 ( Duration(..)
 , parseToAST
+, parseToPreciseAST
 ) where
 
 import Prologue
 
+import           Control.Effect.Fail
+import           Control.Effect.Lift
+import           Control.Effect.Reader
 import           Control.Effect.Trace
 import           Foreign
 import           Foreign.C.Types (CBool (..))
@@ -19,10 +23,12 @@ import           Source.Loc
 import qualified Source.Source as Source
 import           Source.Span
 
+import qualified TreeSitter.Cursor as TS
 import qualified TreeSitter.Language as TS
 import qualified TreeSitter.Node as TS
 import qualified TreeSitter.Parser as TS
 import qualified TreeSitter.Tree as TS
+import qualified TreeSitter.Unmarshal as TS
 
 -- | Parse a 'Blob' with the given 'TS.Language' and return its AST.
 -- Returns 'Nothing' if the operation timed out.
@@ -38,6 +44,20 @@ parseToAST :: ( Bounded grammar
            -> m (Maybe (AST [] grammar))
 parseToAST parseTimeout language blob = runParse parseTimeout language blob (fmap Right . anaM toAST <=< peek)
 
+parseToPreciseAST
+  :: ( Carrier sig m
+     , Member Trace sig
+     , MonadIO m
+     , TS.Unmarshal t
+     )
+  => Duration
+  -> Ptr TS.Language
+  -> Blob
+  -> m (Maybe t)
+parseToPreciseAST parseTimeout language blob = runParse parseTimeout language blob $ \ rootPtr ->
+  TS.withCursor (castPtr rootPtr) $ \ cursor ->
+    runM (runFail (runReader cursor (runReader (Source.bytes (blobSource blob)) (TS.peekNode >>= TS.unmarshalNodes . maybeToList))))
+
 runParse
   :: ( Carrier sig m
      , Member Trace sig

From 94f6f8e29f954e92445dca8b0d98349d2fec2713 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 13:27:19 -0400
Subject: [PATCH 159/228] Define an UnmarshalParser constructor.

---
 src/Parsing/Parser.hs | 3 +++
 src/Semantic/Task.hs  | 6 ++++++
 2 files changed, 9 insertions(+)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index ef5735673..cea240dbc 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -57,6 +57,7 @@ import           TreeSitter.Python
 import           TreeSitter.Ruby
 import           TreeSitter.TSX
 import           TreeSitter.TypeScript
+import           TreeSitter.Unmarshal
 
 
 type family ApplyAll' (typeclasses :: [(* -> *) -> Constraint]) (fs :: [* -> *]) :: Constraint where
@@ -100,6 +101,8 @@ someAnalysisParser _ l          = error $ "Analysis not supported for: " <> show
 data Parser term where
   -- | A parser producing 'AST' using a 'TS.Language'.
   ASTParser :: (Bounded grammar, Enum grammar, Show grammar) => Ptr TS.Language -> Parser (AST [] grammar)
+  -- | A parser 'Unmarshal'ing to a precise AST type using a 'TS.Language'.
+  UnmarshalParser :: Unmarshal t => Ptr TS.Language -> Parser t
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type.
   AssignmentParser :: (Enum grammar, Ix grammar, Show grammar, TS.Symbol grammar, Syntax.Error :< fs, Eq1 ast, Apply Foldable fs, Apply Functor fs, Foldable ast, Functor ast)
                    => Parser (Term ast (Node grammar))           -- ^ A parser producing AST.
diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index 124d5c1c0..929793a95 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -269,6 +269,12 @@ runParser blob@Blob{..} parser = case parser of
       parseToAST (configTreeSitterParseTimeout config) language blob
         >>= maybeM (throwError (SomeException ParserTimedOut))
 
+  UnmarshalParser language ->
+    time "parse.tree_sitter_ast_parse" languageTag $ do
+      config <- asks config
+      parseToPreciseAST (configTreeSitterParseTimeout config) language blob
+        >>= maybeM (throwError (SomeException ParserTimedOut))
+
   AssignmentParser    parser assignment -> runAssignment Assignment.assign    parser assignment
   DeterministicParser parser assignment -> runAssignment Deterministic.assign parser assignment
 

From e5ef1e67efafdc51d0f54acaed37bc1eccb2518f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 13:40:22 -0400
Subject: [PATCH 160/228] Fix a couple of errors in the tests.

---
 test/Examples.hs    | 3 ++-
 test/SpecHelpers.hs | 2 +-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/test/Examples.hs b/test/Examples.hs
index 50b476559..13a74fb52 100644
--- a/test/Examples.hs
+++ b/test/Examples.hs
@@ -17,6 +17,7 @@ import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy.Char8 as BLC
 import qualified Data.ByteString.Streaming.Char8 as ByteStream
 import           Data.Either
+import           Data.Language (PerLanguageModes(..))
 import           Data.Set (Set)
 import           Data.Traversable
 import           Data.Typeable
@@ -121,4 +122,4 @@ knownFailuresForPath tsDir (Just path)
 
 
 parseFilePath :: (Member (Error SomeException) sig, Member Distribute sig, Member Task sig, Member Files sig, Carrier sig m, MonadIO m) => Path.RelFile -> m Bool
-parseFilePath path = readBlob (fileForRelPath path) >>= parseTermBuilder @[] TermShow . pure >>= const (pure True)
+parseFilePath path = readBlob (fileForRelPath path) >>= runReader (PerLanguageModes Nothing) . parseTermBuilder @[] TermShow . pure >>= const (pure True)
diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs
index 00ac5958a..a86135d26 100644
--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@@ -95,7 +95,7 @@ diffFilePaths session paths
 parseFilePath :: TaskSession -> Path.RelFile -> IO (Either SomeException ByteString)
 parseFilePath session path = do
   blob <- readBlobFromFile (fileForRelPath path)
-  res <- runTask session $ parseTermBuilder TermSExpression (toList blob)
+  res <- runTask session . runReader (PerLanguageModes Nothing) $ parseTermBuilder TermSExpression (toList blob)
   pure (runBuilder <$> res)
 
 -- | Read two files to a BlobPair.

From ead0253c73d29f5f3720f7fca18683ba0b3867d2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 13:49:45 -0400
Subject: [PATCH 161/228] Define orphan Unmarshal instances for Loc, Span, and
 Range.

---
 src/Parsing/Parser.hs | 23 ++++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index cea240dbc..c38f3ecf9 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -47,16 +47,20 @@ import qualified Language.Python.Assignment as Python
 import qualified Language.Ruby.Assignment as Ruby
 import qualified Language.TSX.Assignment as TSX
 import qualified Language.TypeScript.Assignment as TypeScript
+import           Prelude hiding (fail)
 import           Prologue
+import           Source.Range
+import           Source.Span
 import           TreeSitter.Go
 import           TreeSitter.Haskell
 import           TreeSitter.JSON
 import qualified TreeSitter.Language as TS (Language, Symbol)
 import           TreeSitter.PHP
 import           TreeSitter.Python
-import           TreeSitter.Ruby
+import           TreeSitter.Ruby (tree_sitter_ruby)
 import           TreeSitter.TSX
 import           TreeSitter.TypeScript
+import qualified TreeSitter.Node as TS
 import           TreeSitter.Unmarshal
 
 
@@ -196,3 +200,20 @@ someASTParser PHP        = Just (SomeASTParser (ASTParser tree_sitter_php :: Par
 someASTParser Java       = Nothing
 someASTParser Markdown   = Nothing
 someASTParser Unknown    = Nothing
+
+
+instance Unmarshal Loc where
+  unmarshalNodes nodes = Loc <$> unmarshalNodes nodes <*> unmarshalNodes nodes
+
+instance Unmarshal Range where
+  unmarshalNodes _ = peekNode >>= maybeM (fail "Range expects a current node.") >>= \ node -> do
+    let start = fromIntegral (TS.nodeStartByte node)
+        end   = fromIntegral (TS.nodeEndByte node)
+    pure (Range start end)
+
+instance Unmarshal Span where
+  unmarshalNodes _ = peekNode >>= maybeM (fail "Span expects a current node.") >>= \ node -> do
+    let start = pointToPos (TS.nodeStartPoint node)
+        end   = pointToPos (TS.nodeEndPoint node)
+    pure (Span start end)
+    where pointToPos (TS.TSPoint line column) = Pos (fromIntegral line) (fromIntegral column)

From f4d89746d1dd7f189e15e3d79c768505c6c8c1d8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 13:50:20 -0400
Subject: [PATCH 162/228] Define a precise Python parser.

---
 src/Parsing/Parser.hs | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index c38f3ecf9..ba911509c 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -24,6 +24,8 @@ module Parsing.Parser
 , phpParser
 , phpASTParser
 , haskellParser
+  -- Precise parsers
+, precisePythonParser
 ) where
 
 import           Assigning.Assignment
@@ -57,6 +59,7 @@ import           TreeSitter.JSON
 import qualified TreeSitter.Language as TS (Language, Symbol)
 import           TreeSitter.PHP
 import           TreeSitter.Python
+import qualified TreeSitter.Python.AST as Py
 import           TreeSitter.Ruby (tree_sitter_ruby)
 import           TreeSitter.TSX
 import           TreeSitter.TypeScript
@@ -170,6 +173,10 @@ markdownParser :: Parser Markdown.Term
 markdownParser = AssignmentParser MarkdownParser Markdown.assignment
 
 
+precisePythonParser :: Parser (Py.Module Loc)
+precisePythonParser = UnmarshalParser tree_sitter_python
+
+
 data SomeTerm typeclasses ann where
   SomeTerm :: ApplyAll typeclasses syntax => Term syntax ann -> SomeTerm typeclasses ann
 

From a17a53fb1973d8ebb39549e470beff745997b124 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 13:50:58 -0400
Subject: [PATCH 163/228] Turn off orphan instance warnings in Parsing.Parser.

---
 src/Parsing/Parser.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index ba911509c..eacae45d8 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 module Parsing.Parser
 ( Parser(..)
 , SomeTerm(..)

From 3c564eb7a5876fa5d953b81fb73b4bd3050fa9c3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 13:51:33 -0400
Subject: [PATCH 164/228] Add a FIXME.

---
 src/Parsing/Parser.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index eacae45d8..715eb4608 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -210,6 +210,8 @@ someASTParser Markdown   = Nothing
 someASTParser Unknown    = Nothing
 
 
+-- FIXME: delete these instances once haskell-tree-sitter depends on semantic-source.
+
 instance Unmarshal Loc where
   unmarshalNodes nodes = Loc <$> unmarshalNodes nodes <*> unmarshalNodes nodes
 

From 8ca3d7b277cc0ae375ac2b6f84f396bf9c1ea0c7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 26 Sep 2019 14:04:46 -0400
Subject: [PATCH 165/228] Bring the language modes into scope.

---
 src/Semantic/Api/Terms.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Semantic/Api/Terms.hs b/src/Semantic/Api/Terms.hs
index 5a3500375..a73ca275d 100644
--- a/src/Semantic/Api/Terms.hs
+++ b/src/Semantic/Api/Terms.hs
@@ -115,7 +115,7 @@ type TermConstraints =
   ]
 
 doParse :: (ParseEffects sig m) => Blob -> m (SomeTerm TermConstraints Loc)
-doParse blob = case blobLanguage blob of
+doParse blob = ask @PerLanguageModes >>= \ _ -> case blobLanguage blob of
   Go         -> SomeTerm <$> parse goParser blob
   Haskell    -> SomeTerm <$> parse haskellParser blob
   JavaScript -> SomeTerm <$> parse tsxParser blob

From 374dae0229f60ebbee7c38526092388058e8f850 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 09:57:12 -0400
Subject: [PATCH 166/228] :fire: a redundant language extension.

---
 src/Analysis/Abstract/Caching/FlowInsensitive.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Analysis/Abstract/Caching/FlowInsensitive.hs b/src/Analysis/Abstract/Caching/FlowInsensitive.hs
index c5670e6bc..0c10a265a 100644
--- a/src/Analysis/Abstract/Caching/FlowInsensitive.hs
+++ b/src/Analysis/Abstract/Caching/FlowInsensitive.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, TypeOperators #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeOperators #-}
 module Analysis.Abstract.Caching.FlowInsensitive
 ( cachingTerms
 , convergingModules

From d0f0925c379583ad928d2b30d6cbf8e5c29462a0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:00:14 -0400
Subject: [PATCH 167/228] :fire: a redundant import.

---
 test/Data/Functor/Listable.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/test/Data/Functor/Listable.hs b/test/Data/Functor/Listable.hs
index af2177cde..11869be10 100644
--- a/test/Data/Functor/Listable.hs
+++ b/test/Data/Functor/Listable.hs
@@ -24,7 +24,6 @@ import Data.Functor.Both
 import qualified Data.Language as Language
 import Data.List.NonEmpty
 import Data.Patch
-import Data.Semigroup.App
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
 import qualified Data.Syntax.Declaration as Declaration

From 71e796b1b936bed94a3816b0befc757d1edaac97 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:00:32 -0400
Subject: [PATCH 168/228] This field is not in Maybe.

---
 test/Examples.hs    | 2 +-
 test/SpecHelpers.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/test/Examples.hs b/test/Examples.hs
index 13a74fb52..505f642ec 100644
--- a/test/Examples.hs
+++ b/test/Examples.hs
@@ -122,4 +122,4 @@ knownFailuresForPath tsDir (Just path)
 
 
 parseFilePath :: (Member (Error SomeException) sig, Member Distribute sig, Member Task sig, Member Files sig, Carrier sig m, MonadIO m) => Path.RelFile -> m Bool
-parseFilePath path = readBlob (fileForRelPath path) >>= runReader (PerLanguageModes Nothing) . parseTermBuilder @[] TermShow . pure >>= const (pure True)
+parseFilePath path = readBlob (fileForRelPath path) >>= runReader (PerLanguageModes ALaCarte) . parseTermBuilder @[] TermShow . pure >>= const (pure True)
diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs
index a86135d26..7b0dcc2a1 100644
--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@@ -95,7 +95,7 @@ diffFilePaths session paths
 parseFilePath :: TaskSession -> Path.RelFile -> IO (Either SomeException ByteString)
 parseFilePath session path = do
   blob <- readBlobFromFile (fileForRelPath path)
-  res <- runTask session . runReader (PerLanguageModes Nothing) $ parseTermBuilder TermSExpression (toList blob)
+  res <- runTask session . runReader (PerLanguageModes ALaCarte) $ parseTermBuilder TermSExpression (toList blob)
   pure (runBuilder <$> res)
 
 -- | Read two files to a BlobPair.

From c0be280f34446d3babd70b4e706e3103b8db29b0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:00:40 -0400
Subject: [PATCH 169/228] Import runReader.

---
 test/Examples.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/test/Examples.hs b/test/Examples.hs
index 505f642ec..d76362d6c 100644
--- a/test/Examples.hs
+++ b/test/Examples.hs
@@ -3,6 +3,7 @@
 module Main (main) where
 
 import           Control.Effect
+import           Control.Effect.Reader
 import           Control.Exception (displayException)
 import qualified Control.Foldl as Foldl
 import           Data.Function ((&))

From 3058646b44343178c3c095963a4c7e6eb595862e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:36:56 -0400
Subject: [PATCH 170/228] Update for * -> * Unmarshal.

---
 src/Parsing/Parser.hs     | 24 +-----------------------
 src/Parsing/TreeSitter.hs |  4 ++--
 2 files changed, 3 insertions(+), 25 deletions(-)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index 715eb4608..5abf9a5c4 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -52,8 +52,6 @@ import qualified Language.TSX.Assignment as TSX
 import qualified Language.TypeScript.Assignment as TypeScript
 import           Prelude hiding (fail)
 import           Prologue
-import           Source.Range
-import           Source.Span
 import           TreeSitter.Go
 import           TreeSitter.Haskell
 import           TreeSitter.JSON
@@ -64,7 +62,6 @@ import qualified TreeSitter.Python.AST as Py
 import           TreeSitter.Ruby (tree_sitter_ruby)
 import           TreeSitter.TSX
 import           TreeSitter.TypeScript
-import qualified TreeSitter.Node as TS
 import           TreeSitter.Unmarshal
 
 
@@ -110,7 +107,7 @@ data Parser term where
   -- | A parser producing 'AST' using a 'TS.Language'.
   ASTParser :: (Bounded grammar, Enum grammar, Show grammar) => Ptr TS.Language -> Parser (AST [] grammar)
   -- | A parser 'Unmarshal'ing to a precise AST type using a 'TS.Language'.
-  UnmarshalParser :: Unmarshal t => Ptr TS.Language -> Parser t
+  UnmarshalParser :: Unmarshal t => Ptr TS.Language -> Parser (t Loc)
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type.
   AssignmentParser :: (Enum grammar, Ix grammar, Show grammar, TS.Symbol grammar, Syntax.Error :< fs, Eq1 ast, Apply Foldable fs, Apply Functor fs, Foldable ast, Functor ast)
                    => Parser (Term ast (Node grammar))           -- ^ A parser producing AST.
@@ -208,22 +205,3 @@ someASTParser PHP        = Just (SomeASTParser (ASTParser tree_sitter_php :: Par
 someASTParser Java       = Nothing
 someASTParser Markdown   = Nothing
 someASTParser Unknown    = Nothing
-
-
--- FIXME: delete these instances once haskell-tree-sitter depends on semantic-source.
-
-instance Unmarshal Loc where
-  unmarshalNodes nodes = Loc <$> unmarshalNodes nodes <*> unmarshalNodes nodes
-
-instance Unmarshal Range where
-  unmarshalNodes _ = peekNode >>= maybeM (fail "Range expects a current node.") >>= \ node -> do
-    let start = fromIntegral (TS.nodeStartByte node)
-        end   = fromIntegral (TS.nodeEndByte node)
-    pure (Range start end)
-
-instance Unmarshal Span where
-  unmarshalNodes _ = peekNode >>= maybeM (fail "Span expects a current node.") >>= \ node -> do
-    let start = pointToPos (TS.nodeStartPoint node)
-        end   = pointToPos (TS.nodeEndPoint node)
-    pure (Span start end)
-    where pointToPos (TS.TSPoint line column) = Pos (fromIntegral line) (fromIntegral column)
diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 89251f47a..2769241c0 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -53,10 +53,10 @@ parseToPreciseAST
   => Duration
   -> Ptr TS.Language
   -> Blob
-  -> m (Maybe t)
+  -> m (Maybe (t Loc))
 parseToPreciseAST parseTimeout language blob = runParse parseTimeout language blob $ \ rootPtr ->
   TS.withCursor (castPtr rootPtr) $ \ cursor ->
-    runM (runFail (runReader cursor (runReader (Source.bytes (blobSource blob)) (TS.peekNode >>= TS.unmarshalNodes . maybeToList))))
+    runM (runFail (runReader cursor (runReader (Source.bytes (blobSource blob)) (TS.peekNode >>= TS.unmarshalNode))))
 
 runParse
   :: ( Carrier sig m

From 6538f4d8852f43fdb48091408a6847f787e29b01 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:40:37 -0400
Subject: [PATCH 171/228] Revert "Bring the language modes into scope."

This reverts commit 8ca3d7b277cc0ae375ac2b6f84f396bf9c1ea0c7.
---
 src/Semantic/Api/Terms.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Semantic/Api/Terms.hs b/src/Semantic/Api/Terms.hs
index a73ca275d..5a3500375 100644
--- a/src/Semantic/Api/Terms.hs
+++ b/src/Semantic/Api/Terms.hs
@@ -115,7 +115,7 @@ type TermConstraints =
   ]
 
 doParse :: (ParseEffects sig m) => Blob -> m (SomeTerm TermConstraints Loc)
-doParse blob = ask @PerLanguageModes >>= \ _ -> case blobLanguage blob of
+doParse blob = case blobLanguage blob of
   Go         -> SomeTerm <$> parse goParser blob
   Haskell    -> SomeTerm <$> parse haskellParser blob
   JavaScript -> SomeTerm <$> parse tsxParser blob

From ed7d152169acd6f93636b6fc98fff74ada0ef0aa Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:41:22 -0400
Subject: [PATCH 172/228] Use the shared blobLanguage computation.

---
 src/Semantic/Api/Symbols.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs
index 93ba48509..7d08e6e3e 100644
--- a/src/Semantic/Api/Symbols.hs
+++ b/src/Semantic/Api/Symbols.hs
@@ -65,7 +65,7 @@ parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distribut
       where
         blobLanguage' = blobLanguage blob
         blobPath' = pack $ blobPath blob
-        errorFile e = File blobPath' (bridging # blobLanguage blob) mempty (V.fromList [ParseError (T.pack e)]) blobOid
+        errorFile e = File blobPath' (bridging # blobLanguage') mempty (V.fromList [ParseError (T.pack e)]) blobOid
 
         symbolsToSummarize :: [Text]
         symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"]

From e84da318a3dff2aecd710e472e5521a201313544 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:43:11 -0400
Subject: [PATCH 173/228] :fire: ApplyAll'.

---
 src/Parsing/Parser.hs | 19 +++++++------------
 1 file changed, 7 insertions(+), 12 deletions(-)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index 5abf9a5c4..4ebc60864 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -9,7 +9,6 @@ module Parsing.Parser
 , someASTParser
 , someAnalysisParser
 , ApplyAll
-, ApplyAll'
 -- À la carte parsers
 , goParser
 , goASTParser
@@ -65,13 +64,9 @@ import           TreeSitter.TypeScript
 import           TreeSitter.Unmarshal
 
 
-type family ApplyAll' (typeclasses :: [(* -> *) -> Constraint]) (fs :: [* -> *]) :: Constraint where
-  ApplyAll' (typeclass ': typeclasses) fs = (Apply typeclass fs, ApplyAll' typeclasses fs)
-  ApplyAll' '[] fs = ()
-
 -- | A parser, suitable for program analysis, for some specific language, producing 'Term's whose syntax satisfies a list of typeclass constraints.
 data SomeAnalysisParser typeclasses ann where
-  SomeAnalysisParser :: ( ApplyAll' typeclasses fs
+  SomeAnalysisParser :: ( ApplyAll typeclasses (Sum fs)
                         , Apply (VertexDeclaration' (Sum fs)) fs
                         , Element Syntax.Identifier fs
                         , HasPrelude lang
@@ -81,12 +76,12 @@ data SomeAnalysisParser typeclasses ann where
                      -> SomeAnalysisParser typeclasses ann
 
 -- | A parser for some specific language, producing 'Term's whose syntax satisfies a list of typeclass constraints.
-someAnalysisParser :: ( ApplyAll' typeclasses Go.Syntax
-                      , ApplyAll' typeclasses PHP.Syntax
-                      , ApplyAll' typeclasses Python.Syntax
-                      , ApplyAll' typeclasses Ruby.Syntax
-                      , ApplyAll' typeclasses TypeScript.Syntax
-                      , ApplyAll' typeclasses Haskell.Syntax
+someAnalysisParser :: ( ApplyAll typeclasses (Sum Go.Syntax)
+                      , ApplyAll typeclasses (Sum PHP.Syntax)
+                      , ApplyAll typeclasses (Sum Python.Syntax)
+                      , ApplyAll typeclasses (Sum Ruby.Syntax)
+                      , ApplyAll typeclasses (Sum TypeScript.Syntax)
+                      , ApplyAll typeclasses (Sum Haskell.Syntax)
                       )
                    => proxy typeclasses                       -- ^ A proxy for the list of typeclasses required, e.g. @(Proxy :: Proxy '[Show1])@.
                    -> Language                                -- ^ The 'Language' to select.

From 0c3e754eeaad879c8e7b60594f9e27182533d655 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:43:31 -0400
Subject: [PATCH 174/228] Alignment.

---
 src/Parsing/Parser.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index 4ebc60864..b7ecf36cc 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -83,8 +83,8 @@ someAnalysisParser :: ( ApplyAll typeclasses (Sum Go.Syntax)
                       , ApplyAll typeclasses (Sum TypeScript.Syntax)
                       , ApplyAll typeclasses (Sum Haskell.Syntax)
                       )
-                   => proxy typeclasses                       -- ^ A proxy for the list of typeclasses required, e.g. @(Proxy :: Proxy '[Show1])@.
-                   -> Language                                -- ^ The 'Language' to select.
+                   => proxy typeclasses                  -- ^ A proxy for the list of typeclasses required, e.g. @(Proxy :: Proxy '[Show1])@.
+                   -> Language                           -- ^ The 'Language' to select.
                    -> SomeAnalysisParser typeclasses Loc -- ^ A 'SomeAnalysisParser' abstracting the syntax type to be produced.
 someAnalysisParser _ Go         = SomeAnalysisParser goParser         (Proxy :: Proxy 'Go)
 someAnalysisParser _ Haskell    = SomeAnalysisParser haskellParser    (Proxy :: Proxy 'Haskell)

From 6a40b9a6cda1200fe03e863d6445844362fca8ab Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:45:12 -0400
Subject: [PATCH 175/228] :fire: a redundant Element constraint.

---
 src/Parsing/Parser.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index b7ecf36cc..0a3b9cdbd 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -68,7 +68,6 @@ import           TreeSitter.Unmarshal
 data SomeAnalysisParser typeclasses ann where
   SomeAnalysisParser :: ( ApplyAll typeclasses (Sum fs)
                         , Apply (VertexDeclaration' (Sum fs)) fs
-                        , Element Syntax.Identifier fs
                         , HasPrelude lang
                         )
                      => Parser (Term (Sum fs) ann)

From 3fafa4f556c009e264611b52d456f12458b2b602 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:45:59 -0400
Subject: [PATCH 176/228] Tidy up with type applications.

---
 src/Parsing/Parser.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index 0a3b9cdbd..04ff7de66 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -85,14 +85,14 @@ someAnalysisParser :: ( ApplyAll typeclasses (Sum Go.Syntax)
                    => proxy typeclasses                  -- ^ A proxy for the list of typeclasses required, e.g. @(Proxy :: Proxy '[Show1])@.
                    -> Language                           -- ^ The 'Language' to select.
                    -> SomeAnalysisParser typeclasses Loc -- ^ A 'SomeAnalysisParser' abstracting the syntax type to be produced.
-someAnalysisParser _ Go         = SomeAnalysisParser goParser         (Proxy :: Proxy 'Go)
-someAnalysisParser _ Haskell    = SomeAnalysisParser haskellParser    (Proxy :: Proxy 'Haskell)
-someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser (Proxy :: Proxy 'JavaScript)
-someAnalysisParser _ PHP        = SomeAnalysisParser phpParser        (Proxy :: Proxy 'PHP)
-someAnalysisParser _ Python     = SomeAnalysisParser pythonParser     (Proxy :: Proxy 'Python)
-someAnalysisParser _ Ruby       = SomeAnalysisParser rubyParser       (Proxy :: Proxy 'Ruby)
-someAnalysisParser _ TypeScript = SomeAnalysisParser typescriptParser (Proxy :: Proxy 'TypeScript)
-someAnalysisParser _ TSX        = SomeAnalysisParser typescriptParser (Proxy :: Proxy 'TSX)
+someAnalysisParser _ Go         = SomeAnalysisParser goParser         (Proxy @'Go)
+someAnalysisParser _ Haskell    = SomeAnalysisParser haskellParser    (Proxy @'Haskell)
+someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser (Proxy @'JavaScript)
+someAnalysisParser _ PHP        = SomeAnalysisParser phpParser        (Proxy @'PHP)
+someAnalysisParser _ Python     = SomeAnalysisParser pythonParser     (Proxy @'Python)
+someAnalysisParser _ Ruby       = SomeAnalysisParser rubyParser       (Proxy @'Ruby)
+someAnalysisParser _ TypeScript = SomeAnalysisParser typescriptParser (Proxy @'TypeScript)
+someAnalysisParser _ TSX        = SomeAnalysisParser typescriptParser (Proxy @'TSX)
 someAnalysisParser _ l          = error $ "Analysis not supported for: " <> show l
 
 

From 30a47a25958404e9a6af6118a48786e61bec48d9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:48:39 -0400
Subject: [PATCH 177/228] :memo: Language.Python.

---
 semantic-tags/src/Language/Python.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-tags/src/Language/Python.hs b/semantic-tags/src/Language/Python.hs
index ed619cdae..fd2cb92eb 100644
--- a/semantic-tags/src/Language/Python.hs
+++ b/semantic-tags/src/Language/Python.hs
@@ -1,3 +1,4 @@
+-- | Semantic functionality for Python programs.
 module Language.Python
 ( Term(..)
 ) where

From 9b704006b4d651f0ee2b4c198fad681a298cea6d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:49:20 -0400
Subject: [PATCH 178/228] :fire: an obsolete pragma.

---
 src/Parsing/Parser.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index 04ff7de66..ef6791204 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
 module Parsing.Parser
 ( Parser(..)
 , SomeTerm(..)

From 4f85f5148fc7ce874e2e40a8c174460b0a5856ae Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:52:43 -0400
Subject: [PATCH 179/228] Define an Unmarshal instance for Py.Term.

---
 semantic-tags/src/Language/Python.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-tags/src/Language/Python.hs b/semantic-tags/src/Language/Python.hs
index fd2cb92eb..66c5803a1 100644
--- a/semantic-tags/src/Language/Python.hs
+++ b/semantic-tags/src/Language/Python.hs
@@ -6,8 +6,12 @@ module Language.Python
 import qualified Language.Python.Tags as PyTags
 import qualified Tags.Tagging.Precise as Tags
 import qualified TreeSitter.Python.AST as Py
+import qualified TreeSitter.Unmarshal as TS
 
 newtype Term a = Term { getTerm :: Py.Module a }
 
+instance TS.Unmarshal Term where
+  unmarshalNode node = Term <$> TS.unmarshalNode node
+
 instance Tags.ToTags Term where
   tags src = Tags.runTagging src . PyTags.tags . getTerm

From cdb0488fdeb6e42ac3e1d91adc6344cf1f03d03d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:53:16 -0400
Subject: [PATCH 180/228] Depend on semantic-tags.

---
 semantic.cabal | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic.cabal b/semantic.cabal
index 83aa6404c..018b43adf 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -302,6 +302,7 @@ library
                      , pretty-show ^>= 1.9.5
                      , profunctors ^>= 5.3
                      , reducers ^>= 3.12.3
+                     , semantic-tags ^>= 0
                      , semigroupoids ^>= 5.3.2
                      , split ^>= 0.2.3.3
                      , stm-chans ^>= 3.0.0.4

From cf940ff59504a39079fe8ad09e2d044c6ccd5477 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:53:26 -0400
Subject: [PATCH 181/228] precisePythonParser produces a Py.Term.

---
 src/Parsing/Parser.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs
index ef6791204..c287bdb78 100644
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@@ -44,6 +44,7 @@ import qualified Language.Haskell.Assignment as Haskell
 import qualified Language.JSON.Assignment as JSON
 import qualified Language.Markdown.Assignment as Markdown
 import qualified Language.PHP.Assignment as PHP
+import qualified Language.Python as Py
 import qualified Language.Python.Assignment as Python
 import qualified Language.Ruby.Assignment as Ruby
 import qualified Language.TSX.Assignment as TSX
@@ -56,7 +57,6 @@ import           TreeSitter.JSON
 import qualified TreeSitter.Language as TS (Language, Symbol)
 import           TreeSitter.PHP
 import           TreeSitter.Python
-import qualified TreeSitter.Python.AST as Py
 import           TreeSitter.Ruby (tree_sitter_ruby)
 import           TreeSitter.TSX
 import           TreeSitter.TypeScript
@@ -164,7 +164,7 @@ markdownParser :: Parser Markdown.Term
 markdownParser = AssignmentParser MarkdownParser Markdown.assignment
 
 
-precisePythonParser :: Parser (Py.Module Loc)
+precisePythonParser :: Parser (Py.Term Loc)
 precisePythonParser = UnmarshalParser tree_sitter_python
 
 

From 4a1b8e80c0781ffbb765b6deb34d231186162750 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 10:59:55 -0400
Subject: [PATCH 182/228] Reformat slightly.

---
 src/Semantic/Api/Symbols.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs
index 7d08e6e3e..54a0a4e32 100644
--- a/src/Semantic/Api/Symbols.hs
+++ b/src/Semantic/Api/Symbols.hs
@@ -77,8 +77,7 @@ parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distribut
         tagsToFile tags = File blobPath' (bridging # blobLanguage') (V.fromList (fmap tagToSymbol tags)) mempty blobOid
 
         tagToSymbol :: Tag -> Symbol
-        tagToSymbol Tag{..}
-          = Symbol
+        tagToSymbol Tag{..} = Symbol
           { symbol = name
           , kind = kind
           , line = fromMaybe mempty line

From 661e58279452dfb17b7a4aa382e7e9f443360468 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 11:00:48 -0400
Subject: [PATCH 183/228] Pull symbolsToSummarize & tagToSymbol out to the top
 level.

---
 src/Semantic/Api/Symbols.hs | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs
index 54a0a4e32..ee7baaf4a 100644
--- a/src/Semantic/Api/Symbols.hs
+++ b/src/Semantic/Api/Symbols.hs
@@ -67,20 +67,20 @@ parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distribut
         blobPath' = pack $ blobPath blob
         errorFile e = File blobPath' (bridging # blobLanguage') mempty (V.fromList [ParseError (T.pack e)]) blobOid
 
-        symbolsToSummarize :: [Text]
-        symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"]
-
         renderToSymbols :: (IsTaggable f, Applicative m) => Term f Loc -> m File
         renderToSymbols term = pure $ tagsToFile (runTagging blob symbolsToSummarize term)
 
         tagsToFile :: [Tag] -> File
         tagsToFile tags = File blobPath' (bridging # blobLanguage') (V.fromList (fmap tagToSymbol tags)) mempty blobOid
 
-        tagToSymbol :: Tag -> Symbol
-        tagToSymbol Tag{..} = Symbol
-          { symbol = name
-          , kind = kind
-          , line = fromMaybe mempty line
-          , span = converting #? span
-          , docs = fmap Docstring docs
-          }
+symbolsToSummarize :: [Text]
+symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"]
+
+tagToSymbol :: Tag -> Symbol
+tagToSymbol Tag{..} = Symbol
+  { symbol = name
+  , kind = kind
+  , line = fromMaybe mempty line
+  , span = converting #? span
+  , docs = fmap Docstring docs
+  }

From 7406910b4a822767d5e3718cd496666e2e51a21e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 11:15:26 -0400
Subject: [PATCH 184/228] :fire: the ToJSON instance for Tag.

---
 src/Data/Tag.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/Data/Tag.hs b/src/Data/Tag.hs
index 83e390a5a..c22fd77a4 100644
--- a/src/Data/Tag.hs
+++ b/src/Data/Tag.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE DeriveAnyClass #-}
-
 module Data.Tag
   ( Tag (..)
   ) where
@@ -7,7 +5,6 @@ module Data.Tag
 import Prelude hiding (span)
 import Prologue
 
-import Data.Aeson
 import Control.Lens.Lens
 
 import Source.Span
@@ -21,7 +18,7 @@ data Tag = Tag
   , context :: [Text]
   , line :: Maybe Text
   , docs :: Maybe Text
-  } deriving (Eq, Show, Generic, ToJSON)
+  } deriving (Eq, Show, Generic)
 
 instance HasSpan Tag where
   span_ = lens span (\t s -> t { span = s })

From ed85a4483f1eacfe1eabc556b9e22ad8d444255b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 11:16:14 -0400
Subject: [PATCH 185/228] :fire: the HasSpan instance for Tag.

---
 src/Data/Tag.hs | 6 ------
 1 file changed, 6 deletions(-)

diff --git a/src/Data/Tag.hs b/src/Data/Tag.hs
index c22fd77a4..dee47f6c3 100644
--- a/src/Data/Tag.hs
+++ b/src/Data/Tag.hs
@@ -5,8 +5,6 @@ module Data.Tag
 import Prelude hiding (span)
 import Prologue
 
-import Control.Lens.Lens
-
 import Source.Span
 
 -- | These selectors aren't prefixed with @tag@ for reasons of JSON
@@ -19,7 +17,3 @@ data Tag = Tag
   , line :: Maybe Text
   , docs :: Maybe Text
   } deriving (Eq, Show, Generic)
-
-instance HasSpan Tag where
-  span_ = lens span (\t s -> t { span = s })
-  {-# INLINE span_ #-}

From 53f3e5e9cc29eff111fe2b5132005bdb87e0c67a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 11:17:41 -0400
Subject: [PATCH 186/228] :fire: the context field from Data.Tag.Tag.

---
 src/Data/Tag.hs     | 1 -
 src/Tags/Tagging.hs | 8 ++++----
 2 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/src/Data/Tag.hs b/src/Data/Tag.hs
index dee47f6c3..ce2aa1462 100644
--- a/src/Data/Tag.hs
+++ b/src/Data/Tag.hs
@@ -13,7 +13,6 @@ data Tag = Tag
   { name :: Text
   , kind :: Text
   , span :: Span
-  , context :: [Text]
   , line :: Maybe Text
   , docs :: Maybe Text
   } deriving (Eq, Show, Generic)
diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs
index a0a5e602e..f617566fe 100644
--- a/src/Tags/Tagging.hs
+++ b/src/Tags/Tagging.hs
@@ -45,10 +45,10 @@ contextualizing Blob{..} symbolsToSummarize = Streaming.mapMaybeM $ \case
   Enter x r -> Nothing <$ enterScope (x, r)
   Exit  x r -> Nothing <$ exitScope (x, r)
   Iden iden span docsLiteralRange -> get @[ContextToken] >>= pure . \case
-    ((x, r):("Context", cr):xs) | x `elem` symbolsToSummarize
-      -> Just $ Tag iden x span (fmap fst xs) (firstLine (slice r)) (slice cr)
-    ((x, r):xs) | x `elem` symbolsToSummarize
-      -> Just $ Tag iden x span (fmap fst xs) (firstLine (slice r)) (slice docsLiteralRange)
+    ((x, r):("Context", cr):_) | x `elem` symbolsToSummarize
+      -> Just $ Tag iden x span (firstLine (slice r)) (slice cr)
+    ((x, r):_) | x `elem` symbolsToSummarize
+      -> Just $ Tag iden x span (firstLine (slice r)) (slice docsLiteralRange)
     _ -> Nothing
   where
     slice = fmap (stripEnd . Source.toText . Source.slice blobSource)

From 376ea3e165e92499eb572de68dd7bcea85e37235 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 11:28:14 -0400
Subject: [PATCH 187/228] Tokens always have Ranges.

---
 src/Tags/Taggable.hs | 36 ++++++++++++++++++------------------
 src/Tags/Tagging.hs  |  4 ++--
 2 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/src/Tags/Taggable.hs b/src/Tags/Taggable.hs
index 96e4e876d..8010186ce 100644
--- a/src/Tags/Taggable.hs
+++ b/src/Tags/Taggable.hs
@@ -48,14 +48,14 @@ import qualified Language.TypeScript.Syntax as TypeScript
 
  -- TODO: Move to src/Data
 data Token
-  = Enter { tokenName :: Text, tokenSnippetRange :: Maybe Range }
-  | Exit  { tokenName :: Text, tokenSnippetRange :: Maybe Range}
+  = Enter { tokenName :: Text, tokenSnippetRange :: Range }
+  | Exit  { tokenName :: Text, tokenSnippetRange :: Range}
   | Iden  { identifierName :: Text, tokenSpan :: Span, docsLiteralRange :: Maybe Range }
   deriving (Eq, Show)
 
 type Tagger = Stream (Of Token)
 
-enter, exit :: Monad m => String -> Maybe Range -> Tagger m ()
+enter, exit :: Monad m => String -> Range -> Tagger m ()
 enter c = yield . Enter (pack c)
 exit c = yield . Exit (pack c)
 
@@ -69,7 +69,7 @@ class Taggable constr where
     )
     => Language -> constr (Term syntax Loc) -> Maybe Range
 
-  snippet :: Foldable syntax => Loc -> constr (Term syntax Loc) -> Maybe Range
+  snippet :: Foldable syntax => Loc -> constr (Term syntax Loc) -> Range
 
   symbolName :: Declarations1 syntax => constr (Term syntax Loc) -> Maybe Name
 
@@ -83,8 +83,8 @@ class TaggableBy (strategy :: Strategy) constr where
     => Language -> constr (Term syntax Loc) -> Maybe Range
   docsLiteral' _ _ = Nothing
 
-  snippet' :: (Foldable syntax) => Loc -> constr (Term syntax Loc) -> Maybe Range
-  snippet' _ _ = Nothing
+  snippet' :: (Foldable syntax) => Loc -> constr (Term syntax Loc) -> Range
+  snippet' ann _ = byteRange ann
 
   symbolName' :: Declarations1 syntax => constr (Term syntax Loc) -> Maybe Name
   symbolName' _ = Nothing
@@ -157,7 +157,7 @@ instance Taggable a => TaggableBy 'Custom (TermF a Loc) where
   symbolName' t = symbolName (termFOut t)
 
 instance TaggableBy 'Custom Syntax.Context where
-  snippet' ann (Syntax.Context _ (Term (In subj _))) = Just (subtractLoc ann subj)
+  snippet' ann (Syntax.Context _ (Term (In subj _))) = subtractLoc ann subj
 
 instance TaggableBy 'Custom Declaration.Function where
   docsLiteral' Python (Declaration.Function _ _ _ (Term (In _ bodyF)))
@@ -165,7 +165,7 @@ instance TaggableBy 'Custom Declaration.Function where
     , isTextElement exprF = Just (byteRange exprAnn)
     | otherwise           = Nothing
   docsLiteral' _ _         = Nothing
-  snippet' ann (Declaration.Function _ _ _ (Term (In body _))) = Just $ subtractLoc ann body
+  snippet' ann (Declaration.Function _ _ _ (Term (In body _))) = subtractLoc ann body
   symbolName' = declaredName . Declaration.functionName
 
 instance TaggableBy 'Custom Declaration.Method where
@@ -174,7 +174,7 @@ instance TaggableBy 'Custom Declaration.Method where
     , isTextElement exprF = Just (byteRange exprAnn)
     | otherwise           = Nothing
   docsLiteral' _ _         = Nothing
-  snippet' ann (Declaration.Method _ _ _ _ (Term (In body _)) _) = Just $ subtractLoc ann body
+  snippet' ann (Declaration.Method _ _ _ _ (Term (In body _)) _) = subtractLoc ann body
   symbolName' = declaredName . Declaration.methodName
 
 instance TaggableBy 'Custom Declaration.Class where
@@ -183,28 +183,28 @@ instance TaggableBy 'Custom Declaration.Class where
     , isTextElement exprF = Just (byteRange exprAnn)
     | otherwise           = Nothing
   docsLiteral' _ _         = Nothing
-  snippet' ann (Declaration.Class _ _ _ (Term (In body _))) = Just $ subtractLoc ann body
+  snippet' ann (Declaration.Class _ _ _ (Term (In body _))) = subtractLoc ann body
   symbolName' = declaredName . Declaration.classIdentifier
 
 instance TaggableBy 'Custom Ruby.Class where
-  snippet' ann (Ruby.Class _ _ (Term (In body _))) = Just $ subtractLoc ann body
+  snippet' ann (Ruby.Class _ _ (Term (In body _))) = subtractLoc ann body
   symbolName' = declaredName . Ruby.classIdentifier
 
 instance TaggableBy 'Custom Ruby.Module where
-  snippet' ann (Ruby.Module _ (Term (In body _):_)) = Just $ subtractLoc ann body
-  snippet' ann (Ruby.Module _ _)                    = Just $ byteRange ann
+  snippet' ann (Ruby.Module _ (Term (In body _):_)) = subtractLoc ann body
+  snippet' ann (Ruby.Module _ _)                    = byteRange ann
   symbolName' = declaredName . Ruby.moduleIdentifier
 
 instance TaggableBy 'Custom TypeScript.Module where
-  snippet' ann (TypeScript.Module _ (Term (In body _):_)) = Just $ subtractLoc ann body
-  snippet' ann (TypeScript.Module _ _                   ) = Just $ byteRange ann
+  snippet' ann (TypeScript.Module _ (Term (In body _):_)) = subtractLoc ann body
+  snippet' ann (TypeScript.Module _ _                   ) = byteRange ann
   symbolName' = declaredName . TypeScript.moduleIdentifier
 
 instance TaggableBy 'Custom Expression.Call where
-  snippet' ann (Expression.Call _ _ _ (Term (In body _))) = Just $ subtractLoc ann body
+  snippet' ann (Expression.Call _ _ _ (Term (In body _))) = subtractLoc ann body
   symbolName' = declaredName . Expression.callFunction
 
 instance TaggableBy 'Custom Ruby.Send where
-  snippet' ann (Ruby.Send _ _ _ (Just (Term (In body _)))) = Just $ subtractLoc ann body
-  snippet' ann _                                           = Just $ byteRange ann
+  snippet' ann (Ruby.Send _ _ _ (Just (Term (In body _)))) = subtractLoc ann body
+  snippet' ann _                                           = byteRange ann
   symbolName' Ruby.Send{..} = declaredName =<< sendSelector
diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs
index f617566fe..878a2d320 100644
--- a/src/Tags/Tagging.hs
+++ b/src/Tags/Tagging.hs
@@ -42,8 +42,8 @@ contextualizing :: ( Member (State [ContextToken]) sig
                 -> Stream (Of Token) m a
                 -> Stream (Of Tag) m a
 contextualizing Blob{..} symbolsToSummarize = Streaming.mapMaybeM $ \case
-  Enter x r -> Nothing <$ enterScope (x, r)
-  Exit  x r -> Nothing <$ exitScope (x, r)
+  Enter x r -> Nothing <$ enterScope (x, Just r)
+  Exit  x r -> Nothing <$ exitScope (x, Just r)
   Iden iden span docsLiteralRange -> get @[ContextToken] >>= pure . \case
     ((x, r):("Context", cr):_) | x `elem` symbolsToSummarize
       -> Just $ Tag iden x span (firstLine (slice r)) (slice cr)

From bbb583de55ad4eac3198dcb4e7aeb0330311b963 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 11:30:33 -0400
Subject: [PATCH 188/228] ContextTokens always have Ranges.

---
 src/Tags/Tagging.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs
index 878a2d320..f25723aaa 100644
--- a/src/Tags/Tagging.hs
+++ b/src/Tags/Tagging.hs
@@ -32,7 +32,7 @@ runTagging blob symbolsToSummarize
   . contextualizing blob symbolsToSummarize
   . tagging blob
 
-type ContextToken = (Text, Maybe Range)
+type ContextToken = (Text, Range)
 
 contextualizing :: ( Member (State [ContextToken]) sig
                    , Carrier sig m
@@ -42,13 +42,13 @@ contextualizing :: ( Member (State [ContextToken]) sig
                 -> Stream (Of Token) m a
                 -> Stream (Of Tag) m a
 contextualizing Blob{..} symbolsToSummarize = Streaming.mapMaybeM $ \case
-  Enter x r -> Nothing <$ enterScope (x, Just r)
-  Exit  x r -> Nothing <$ exitScope (x, Just r)
+  Enter x r -> Nothing <$ enterScope (x, r)
+  Exit  x r -> Nothing <$ exitScope (x, r)
   Iden iden span docsLiteralRange -> get @[ContextToken] >>= pure . \case
     ((x, r):("Context", cr):_) | x `elem` symbolsToSummarize
-      -> Just $ Tag iden x span (firstLine (slice r)) (slice cr)
+      -> Just $ Tag iden x span (firstLine (slice (Just r))) (slice (Just cr))
     ((x, r):_) | x `elem` symbolsToSummarize
-      -> Just $ Tag iden x span (firstLine (slice r)) (slice docsLiteralRange)
+      -> Just $ Tag iden x span (firstLine (slice (Just r))) (slice docsLiteralRange)
     _ -> Nothing
   where
     slice = fmap (stripEnd . Source.toText . Source.slice blobSource)

From 65eed49eccee30b1e5a5226b9b24dda4ab975d83 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 11:33:13 -0400
Subject: [PATCH 189/228] slice/firstLine are total.

---
 src/Tags/Tagging.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs
index f25723aaa..91e669e99 100644
--- a/src/Tags/Tagging.hs
+++ b/src/Tags/Tagging.hs
@@ -46,13 +46,13 @@ contextualizing Blob{..} symbolsToSummarize = Streaming.mapMaybeM $ \case
   Exit  x r -> Nothing <$ exitScope (x, r)
   Iden iden span docsLiteralRange -> get @[ContextToken] >>= pure . \case
     ((x, r):("Context", cr):_) | x `elem` symbolsToSummarize
-      -> Just $ Tag iden x span (firstLine (slice (Just r))) (slice (Just cr))
+      -> Just $ Tag iden x span (Just (firstLine (slice r))) (Just (slice cr))
     ((x, r):_) | x `elem` symbolsToSummarize
-      -> Just $ Tag iden x span (firstLine (slice (Just r))) (slice docsLiteralRange)
+      -> Just $ Tag iden x span (Just (firstLine (slice r))) (slice <$> docsLiteralRange)
     _ -> Nothing
   where
-    slice = fmap (stripEnd . Source.toText . Source.slice blobSource)
-    firstLine = fmap (T.take 180 . fst . breakOn "\n")
+    slice = stripEnd . Source.toText . Source.slice blobSource
+    firstLine = T.take 180 . fst . breakOn "\n"
 
 enterScope, exitScope :: ( Member (State [ContextToken]) sig
                          , Carrier sig m

From 3659912e411ac7f9e0dd0c7c79b2ba5bd5b29599 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 11:34:08 -0400
Subject: [PATCH 190/228] Tags always have a line.

---
 src/Data/Tag.hs             | 2 +-
 src/Semantic/Api/Symbols.hs | 5 ++---
 src/Tags/Tagging.hs         | 4 ++--
 3 files changed, 5 insertions(+), 6 deletions(-)

diff --git a/src/Data/Tag.hs b/src/Data/Tag.hs
index ce2aa1462..6e2fdcbce 100644
--- a/src/Data/Tag.hs
+++ b/src/Data/Tag.hs
@@ -13,6 +13,6 @@ data Tag = Tag
   { name :: Text
   , kind :: Text
   , span :: Span
-  , line :: Maybe Text
+  , line :: Text
   , docs :: Maybe Text
   } deriving (Eq, Show, Generic)
diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs
index ee7baaf4a..f6b53ed3c 100644
--- a/src/Semantic/Api/Symbols.hs
+++ b/src/Semantic/Api/Symbols.hs
@@ -10,7 +10,6 @@ import           Control.Exception
 import           Control.Lens
 import           Data.Blob hiding (File (..))
 import           Data.ByteString.Builder
-import           Data.Maybe
 import           Data.Term
 import qualified Data.Text as T
 import qualified Data.Vector as V
@@ -50,7 +49,7 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap
           = Legacy.Symbol
           { symbolName = name
           , symbolKind = kind
-          , symbolLine = fromMaybe mempty line
+          , symbolLine = line
           , symbolSpan = converting #? span
           }
 
@@ -80,7 +79,7 @@ tagToSymbol :: Tag -> Symbol
 tagToSymbol Tag{..} = Symbol
   { symbol = name
   , kind = kind
-  , line = fromMaybe mempty line
+  , line = line
   , span = converting #? span
   , docs = fmap Docstring docs
   }
diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs
index 91e669e99..68cbf98c6 100644
--- a/src/Tags/Tagging.hs
+++ b/src/Tags/Tagging.hs
@@ -46,9 +46,9 @@ contextualizing Blob{..} symbolsToSummarize = Streaming.mapMaybeM $ \case
   Exit  x r -> Nothing <$ exitScope (x, r)
   Iden iden span docsLiteralRange -> get @[ContextToken] >>= pure . \case
     ((x, r):("Context", cr):_) | x `elem` symbolsToSummarize
-      -> Just $ Tag iden x span (Just (firstLine (slice r))) (Just (slice cr))
+      -> Just $ Tag iden x span (firstLine (slice r)) (Just (slice cr))
     ((x, r):_) | x `elem` symbolsToSummarize
-      -> Just $ Tag iden x span (Just (firstLine (slice r))) (slice <$> docsLiteralRange)
+      -> Just $ Tag iden x span (firstLine (slice r)) (slice <$> docsLiteralRange)
     _ -> Nothing
   where
     slice = stripEnd . Source.toText . Source.slice blobSource

From 958c66a2759e309721a472d3fdbc73d2446cfa2f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 11:49:16 -0400
Subject: [PATCH 191/228] Use Tags.Tag.

---
 src/Semantic/Api/Symbols.hs |  4 ++--
 src/Tags/Tagging.hs         | 28 ++++++++++++++++++++--------
 2 files changed, 22 insertions(+), 10 deletions(-)

diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs
index f6b53ed3c..5cdbb3fa0 100644
--- a/src/Semantic/Api/Symbols.hs
+++ b/src/Semantic/Api/Symbols.hs
@@ -48,7 +48,7 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap
         tagToSymbol Tag{..}
           = Legacy.Symbol
           { symbolName = name
-          , symbolKind = kind
+          , symbolKind = pack (show kind)
           , symbolLine = line
           , symbolSpan = converting #? span
           }
@@ -78,7 +78,7 @@ symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"]
 tagToSymbol :: Tag -> Symbol
 tagToSymbol Tag{..} = Symbol
   { symbol = name
-  , kind = kind
+  , kind = pack (show kind)
   , line = line
   , span = converting #? span
   , docs = fmap Docstring docs
diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs
index 68cbf98c6..8fca7a299 100644
--- a/src/Tags/Tagging.hs
+++ b/src/Tags/Tagging.hs
@@ -2,6 +2,7 @@
 module Tags.Tagging
 ( runTagging
 , Tag(..)
+, Kind(..)
 )
 where
 
@@ -14,10 +15,10 @@ import           Streaming
 import qualified Streaming.Prelude as Streaming
 
 import           Data.Blob
-import           Data.Tag
 import           Data.Term
 import           Source.Loc
 import qualified Source.Source as Source
+import           Tags.Tag
 import           Tags.Taggable
 
 runTagging :: (IsTaggable syntax)
@@ -29,8 +30,19 @@ runTagging blob symbolsToSummarize
   = Eff.run
   . evalState @[ContextToken] []
   . Streaming.toList_
-  . contextualizing blob symbolsToSummarize
+  . contextualizing blob toKind
   . tagging blob
+  where
+    toKind x = do
+      guard (x `elem` symbolsToSummarize)
+      case x of
+        "Function" -> Just Function
+        "Method"   -> Just Method
+        "Class"    -> Just Class
+        "Module"   -> Just Module
+        "Call"     -> Just Call
+        "Send"     -> Just Call
+        _          -> Nothing
 
 type ContextToken = (Text, Range)
 
@@ -38,17 +50,17 @@ contextualizing :: ( Member (State [ContextToken]) sig
                    , Carrier sig m
                    )
                 => Blob
-                -> [Text]
+                -> (Text -> Maybe Kind)
                 -> Stream (Of Token) m a
                 -> Stream (Of Tag) m a
-contextualizing Blob{..} symbolsToSummarize = Streaming.mapMaybeM $ \case
+contextualizing Blob{..} toKind = Streaming.mapMaybeM $ \case
   Enter x r -> Nothing <$ enterScope (x, r)
   Exit  x r -> Nothing <$ exitScope (x, r)
   Iden iden span docsLiteralRange -> get @[ContextToken] >>= pure . \case
-    ((x, r):("Context", cr):_) | x `elem` symbolsToSummarize
-      -> Just $ Tag iden x span (firstLine (slice r)) (Just (slice cr))
-    ((x, r):_) | x `elem` symbolsToSummarize
-      -> Just $ Tag iden x span (firstLine (slice r)) (slice <$> docsLiteralRange)
+    ((x, r):("Context", cr):_) | Just kind <- toKind x
+      -> Just $ Tag iden kind span (firstLine (slice r)) (Just (slice cr))
+    ((x, r):_) | Just kind <- toKind x
+      -> Just $ Tag iden kind span (firstLine (slice r)) (slice <$> docsLiteralRange)
     _ -> Nothing
   where
     slice = stripEnd . Source.toText . Source.slice blobSource

From e25d5e1d7dc76f89864e79a0874662b2addb419e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 11:53:31 -0400
Subject: [PATCH 192/228] Perform renderToSymbols out of the monad.

---
 src/Semantic/Api/Symbols.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs
index 5cdbb3fa0..000048415 100644
--- a/src/Semantic/Api/Symbols.hs
+++ b/src/Semantic/Api/Symbols.hs
@@ -60,14 +60,14 @@ parseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t
 parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs go
   where
     go :: ParseEffects sig m => Blob -> m File
-    go blob@Blob{..} = (doParse blob >>= withSomeTerm renderToSymbols) `catchError` (\(SomeException e) -> pure $ errorFile (show e))
+    go blob@Blob{..} = (withSomeTerm renderToSymbols <$> doParse blob) `catchError` (\(SomeException e) -> pure $ errorFile (show e))
       where
         blobLanguage' = blobLanguage blob
         blobPath' = pack $ blobPath blob
         errorFile e = File blobPath' (bridging # blobLanguage') mempty (V.fromList [ParseError (T.pack e)]) blobOid
 
-        renderToSymbols :: (IsTaggable f, Applicative m) => Term f Loc -> m File
-        renderToSymbols term = pure $ tagsToFile (runTagging blob symbolsToSummarize term)
+        renderToSymbols :: IsTaggable f => Term f Loc -> File
+        renderToSymbols term = tagsToFile (runTagging blob symbolsToSummarize term)
 
         tagsToFile :: [Tag] -> File
         tagsToFile tags = File blobPath' (bridging # blobLanguage') (V.fromList (fmap tagToSymbol tags)) mempty blobOid

From b99366fc377fd99abeda87c3027f110d7b4bc557 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 11:56:45 -0400
Subject: [PATCH 193/228] Tag using the precise AST when requested.

---
 src/Semantic/Api/Symbols.hs | 20 +++++++++++++++++---
 1 file changed, 17 insertions(+), 3 deletions(-)

diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs
index 000048415..829e05ff3 100644
--- a/src/Semantic/Api/Symbols.hs
+++ b/src/Semantic/Api/Symbols.hs
@@ -6,14 +6,17 @@ module Semantic.Api.Symbols
   ) where
 
 import           Control.Effect.Error
+import           Control.Effect.Reader
 import           Control.Exception
 import           Control.Lens
 import           Data.Blob hiding (File (..))
 import           Data.ByteString.Builder
+import           Data.Language
 import           Data.Term
 import qualified Data.Text as T
 import qualified Data.Vector as V
 import           Data.Text (pack)
+import qualified Language.Python as Py
 import           Parsing.Parser
 import           Prologue
 import           Semantic.Api.Bridge
@@ -25,6 +28,7 @@ import           Serializing.Format
 import           Source.Loc
 import           Tags.Taggable
 import           Tags.Tagging
+import qualified Tags.Tagging.Precise as Precise
 
 legacyParseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t Blob -> m Legacy.ParseTreeSymbolResponse
 legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap go blobs
@@ -57,11 +61,18 @@ parseSymbolsBuilder :: (Member Distribute sig, ParseEffects sig m, Traversable t
 parseSymbolsBuilder format blobs = parseSymbols blobs >>= serialize format
 
 parseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t Blob -> m ParseTreeSymbolResponse
-parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs go
+parseSymbols blobs = do
+  modes <- ask
+  ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs (go modes)
   where
-    go :: ParseEffects sig m => Blob -> m File
-    go blob@Blob{..} = (withSomeTerm renderToSymbols <$> doParse blob) `catchError` (\(SomeException e) -> pure $ errorFile (show e))
+    go :: ParseEffects sig m => PerLanguageModes -> Blob -> m File
+    go modes blob@Blob{..}
+      | Precise <- pythonMode modes
+      , Python  <- blobLanguage'
+      =             catching $ renderPreciseToSymbols       <$> parse precisePythonParser blob
+      | otherwise = catching $ withSomeTerm renderToSymbols <$> doParse                   blob
       where
+        catching m = m `catchError` (\(SomeException e) -> pure $ errorFile (show e))
         blobLanguage' = blobLanguage blob
         blobPath' = pack $ blobPath blob
         errorFile e = File blobPath' (bridging # blobLanguage') mempty (V.fromList [ParseError (T.pack e)]) blobOid
@@ -69,6 +80,9 @@ parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distribut
         renderToSymbols :: IsTaggable f => Term f Loc -> File
         renderToSymbols term = tagsToFile (runTagging blob symbolsToSummarize term)
 
+        renderPreciseToSymbols :: Py.Term Loc -> File
+        renderPreciseToSymbols term = tagsToFile (Precise.tags blobSource term)
+
         tagsToFile :: [Tag] -> File
         tagsToFile tags = File blobPath' (bridging # blobLanguage') (V.fromList (fmap tagToSymbol tags)) mempty blobOid
 

From cf1320586dfd6af4103d4e0b65cb82567481570b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 12:04:24 -0400
Subject: [PATCH 194/228] :fire: Data.Tag.

---
 semantic.cabal  |  1 -
 src/Data/Tag.hs | 18 ------------------
 2 files changed, 19 deletions(-)
 delete mode 100644 src/Data/Tag.hs

diff --git a/semantic.cabal b/semantic.cabal
index 018b43adf..3d155d339 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -179,7 +179,6 @@ library
                      , Data.Syntax.Literal
                      , Data.Syntax.Statement
                      , Data.Syntax.Type
-                     , Data.Tag
                      , Data.Term
                      -- Diffing algorithms & interpretation thereof
                      , Diffing.Algorithm
diff --git a/src/Data/Tag.hs b/src/Data/Tag.hs
deleted file mode 100644
index 6e2fdcbce..000000000
--- a/src/Data/Tag.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-module Data.Tag
-  ( Tag (..)
-  ) where
-
-import Prelude hiding (span)
-import Prologue
-
-import Source.Span
-
--- | These selectors aren't prefixed with @tag@ for reasons of JSON
--- backwards compatibility.
-data Tag = Tag
-  { name :: Text
-  , kind :: Text
-  , span :: Span
-  , line :: Text
-  , docs :: Maybe Text
-  } deriving (Eq, Show, Generic)

From 65060868bc24c6ba3ff7fbbe4b802522d11fd3be Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 27 Sep 2019 13:18:30 -0400
Subject: [PATCH 195/228] Make benchmarks operate and switch to `gauge`.

I find myself wanting to benchmark some I/O code, so I decided to look
at our benchmark suite, to find that it had bitrotted somewhat. This
patch brings it back up to working status, switches to `gauge` (which
is more accurate than `criteron` and incurs fewer dependencies), and
sprinkles some typed paths on there.
---
 bench/evaluation/Main.hs | 89 ++++++++++++++++++++++++++++------------
 semantic.cabal           |  6 ++-
 src/Semantic/Util.hs     |  1 +
 3 files changed, 67 insertions(+), 29 deletions(-)

diff --git a/bench/evaluation/Main.hs b/bench/evaluation/Main.hs
index 2eb122822..405cfe423 100644
--- a/bench/evaluation/Main.hs
+++ b/bench/evaluation/Main.hs
@@ -1,50 +1,85 @@
-{-# LANGUAGE DataKinds, FlexibleContexts, TypeFamilies, TypeApplications #-}
+{-# LANGUAGE DataKinds, FlexibleContexts, PackageImports, PartialTypeSignatures, TypeApplications, TypeFamilies #-}
 
 module Main where
 
+import           Algebra.Graph
 import           Control.Monad
-import           Criterion.Main
+import           Data.Abstract.Evaluatable
+import           Data.Abstract.FreeVariables
+import           Data.Blob
+import           Data.Blob.IO (readBlobFromFile')
+import           Data.Bifunctor
+import           Data.Functor.Classes
+import           "semantic" Data.Graph (Graph (..), topologicalSort)
+import           Data.Graph.ControlFlowVertex
 import qualified Data.Language as Language
+import           Data.Project
 import           Data.Proxy
+import           Data.Term
+import           Gauge.Main
 import           Parsing.Parser
 import           Semantic.Config (defaultOptions)
-import           Semantic.Task (withOptions)
-import           Semantic.Util hiding (evalRubyProject, evalPythonProject, evaluateProject)
+import           Semantic.Graph
+import           Semantic.Task (SomeException, TaskSession (..), runTask, withOptions)
+import           Semantic.Util hiding (evalPythonProject, evalRubyProject, evaluateProject)
+import           Source.Loc
+import qualified System.Path as Path
+import           System.Path ((</>))
 
 -- Duplicating this stuff from Util to shut off the logging
+
+callGraphProject' :: ( Language.SLanguage lang
+                     , Ord1 syntax
+                     , Declarations1 syntax
+                     , Evaluatable syntax
+                     , FreeVariables1 syntax
+                     , AccessControls1 syntax
+                     , HasPrelude lang
+                     , Functor syntax
+                     , VertexDeclarationWithStrategy (VertexDeclarationStrategy syntax) syntax syntax
+                     )
+                  => TaskSession
+                  -> Proxy lang
+                  -> Parser (Term syntax Loc)
+                  -> Path.RelFile
+                  -> IO (Either String (Data.Graph.Graph ControlFlowVertex))
+callGraphProject' session proxy parser path = fmap (first show) . runTask session $ do
+  blob <- readBlobFromFile' (fileForRelPath path)
+  package <- fmap snd <$> parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] (Language.reflect proxy) [])
+  modules <- topologicalSort <$> runImportGraphToModules proxy package
+  runCallGraph proxy False modules package
+
+callGraphProject proxy parser paths = withOptions defaultOptions $ \ config logger statter ->
+  callGraphProject' (TaskSession config "" False logger statter) proxy parser paths
+
 evalRubyProject       = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Ruby)       rubyParser
 evalPythonProject     = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Python)     pythonParser
 
-evaluateProject proxy parser paths = withOptions defaultOptions $ \ config logger statter ->
-  evaluateProject' (TaskConfig config logger statter) proxy parser paths
+evaluateProject proxy parser path = withOptions defaultOptions $ \ config logger statter ->
+  evaluateProject' (TaskSession config "" False logger statter) proxy parser [Path.toString path]
 
--- We use `fmap show` to ensure that all the parts of the result of evaluation are
--- evaluated themselves. While an NFData instance is the most morally correct way
--- to do this, I'm reluctant to add NFData instances to every single datatype in the
--- project—coercing the result into a string will suffice, though it throws off the
--- memory allocation results a bit.
-pyEval :: FilePath -> Benchmarkable
-pyEval p = nfIO . evalPythonProject $ ["bench/bench-fixtures/python/" <> p]
+pyEval :: Path.RelFile -> Benchmarkable
+pyEval p = nfIO $ evalPythonProject (Path.relDir "bench/bench-fixtures/python" </> p)
 
-rbEval :: FilePath -> Benchmarkable
-rbEval p = nfIO . evalRubyProject $ ["bench/bench-fixtures/ruby/" <> p]
+rbEval :: Path.RelFile -> Benchmarkable
+rbEval p = nfIO $ evalRubyProject (Path.relDir "bench/bench-fixtures/python" </> p)
 
-pyCall :: FilePath -> Benchmarkable
-pyCall p = nfIO $ callGraphProject pythonParser (Proxy @'Language.Python) defaultOptions ["bench/bench-fixtures/python/" <> p]
+pyCall :: Path.RelFile -> Benchmarkable
+pyCall p = nfIO $ callGraphProject (Proxy @'Language.Python) pythonParser (Path.relDir "bench/bench-fixtures/python/" </> p)
 
-rbCall :: FilePath -> Benchmarkable
-rbCall p = nfIO $ callGraphProject rubyParser (Proxy @'Language.Ruby) defaultOptions ["bench/bench-fixtures/ruby/" <> p]
+rbCall :: Path.RelFile -> Benchmarkable
+rbCall p = nfIO $ callGraphProject (Proxy @'Language.Ruby) rubyParser $ (Path.relDir "bench/bench-fixtures/ruby" </> p)
 
 main :: IO ()
 main = defaultMain
-  [ bgroup "python" [ bench "assignment" $ pyEval "simple-assignment.py"
-                    , bench "function def" $ pyEval "function-definition.py"
-                    , bench "if + function calls" $ pyEval "if-statement-functions.py"
-                    , bench "call graph" $ pyCall "if-statement-functions.py"
+  [ bgroup "python" [ bench "assignment" . pyEval $ Path.relFile "simple-assignment.py"
+                    , bench "function def" . pyEval $ Path.relFile "function-definition.py"
+                    , bench "if + function calls" . pyCall . Path.relFile $ "if-statement-functions.py"
+                    , bench "call graph" $ pyCall . Path.relFile $ "if-statement-functions.py"
                     ]
-  , bgroup "ruby" [ bench "assignment" $ rbEval "simple-assignment.rb"
-                  , bench "function def" $ rbEval "function-definition.rb"
-                  , bench "if + function calls" $ rbEval "if-statement-functions.rb"
-                  , bench "call graph" $ rbCall "if-statement-functions.rb"
+  , bgroup "ruby" [ bench "assignment" . rbEval $ Path.relFile "simple-assignment.rb"
+                  , bench "function def" . rbEval . Path.relFile $ "function-definition.rb"
+                  , bench "if + function calls" . rbCall $ Path.relFile "if-statement-functions.rb"
+                  , bench "call graph" $ rbCall $ Path.relFile "if-statement-functions.rb"
                   ]
   ]
diff --git a/semantic.cabal b/semantic.cabal
index 83aa6404c..2ade84e33 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -408,14 +408,16 @@ test-suite parse-examples
                      , tasty-hunit
 
 benchmark evaluation
-  import:              haskell, executable-flags
+  import:              haskell, dependencies, executable-flags
   hs-source-dirs:      bench/evaluation
   type:                exitcode-stdio-1.0
   main-is:             Main.hs
   ghc-options:         -static
   build-depends:       base
-                     , criterion ^>= 1.5
+                     , algebraic-graphs
+                     , gauge ^>= 0.2.5
                      , semantic
+                     , semantic-source
 
 source-repository head
   type:     git
diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index bd569d3fc..b5de97011 100644
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@@ -8,6 +8,7 @@ module Semantic.Util
   , evalRubyProject
   , evalTypeScriptProject
   , evaluateProject'
+  , justEvaluating
   , mergeErrors
   , reassociate
   , parseFile

From bd73cd0e1d1b9bcad69bd42aa1ac30769f0d4c50 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 14:02:49 -0400
Subject: [PATCH 196/228] Bump to the latest tree-sitter* packages.

---
 semantic-python/semantic-python.cabal       |  5 +++--
 semantic-python/src/Language/Python/Core.hs | 12 ++++++------
 semantic-tags/semantic-tags.cabal           |  4 ++--
 semantic.cabal                              | 20 ++++++++++----------
 4 files changed, 21 insertions(+), 20 deletions(-)

diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal
index 83d9bf52c..a5cf77a90 100644
--- a/semantic-python/semantic-python.cabal
+++ b/semantic-python/semantic-python.cabal
@@ -23,9 +23,10 @@ common haskell
   build-depends:       base ^>=4.12
                      , fused-effects ^>= 0.5
                      , semantic-core ^>= 0.0
+                     , semantic-source ^>= 0.0
                      , text ^>= 1.2.3
-                     , tree-sitter == 0.3.0.0
-                     , tree-sitter-python == 0.4.0.0
+                     , tree-sitter ^>= 0.4
+                     , tree-sitter-python ^>= 0.5
 
   ghc-options:
     -Weverything
diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index b259be847..3f7185993 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -25,9 +25,9 @@ import           Data.String (IsString)
 import           Data.Text (Text)
 import           GHC.Generics
 import           GHC.Records
+import           Source.Span (Span)
+import qualified Source.Span as Source
 import qualified TreeSitter.Python.AST as Py
-import           TreeSitter.Span (Span)
-import qualified TreeSitter.Span as TreeSitter
 
 newtype SourcePath = SourcePath { rawPath :: Text }
   deriving stock (Eq, Show)
@@ -90,7 +90,7 @@ locate :: ( HasField "ann" syntax Span
           ) => syntax -> t a -> m (t a)
 locate syn item = do
   fp <- asks @SourcePath rawPath
-  let locFromTSSpan (TreeSitter.Span (TreeSitter.Pos a b) (TreeSitter.Pos c d))
+  let locFromTSSpan (Source.Span (Source.Pos a b) (Source.Pos c d))
         = Data.Loc.Loc fp (Data.Loc.Span (Data.Loc.Pos a b) (Data.Loc.Pos c d))
 
   pure (Core.annAt (locFromTSSpan (getField @"ann" syn)) item)
@@ -103,7 +103,7 @@ newtype CompileSum py = CompileSum py
 instance (Generic py, GCompileSum (Rep py)) => Compile (CompileSum py) where
   compileCC (CompileSum a) cc = gcompileCCSum (from a) cc
 
-deriving via CompileSum (Either l r) instance (Compile l, Compile r) => Compile (Either l r)
+deriving via CompileSum ((l :+: r) Span) instance (Compile (l Span), Compile (r Span)) => Compile ((l :+: r) Span)
 
 instance Compile (Py.AssertStatement Span)
 instance Compile (Py.Attribute Span)
@@ -198,8 +198,8 @@ instance Compile (Py.Identifier Span) where
 instance Compile (Py.IfStatement Span) where
   compileCC it@Py.IfStatement{ condition, consequence, alternative} cc =
     locate it =<< (if' <$> compile condition <*> compileCC consequence cc <*> foldr clause cc alternative)
-    where clause (Right Py.ElseClause{ body }) _ = compileCC body cc
-          clause (Left  Py.ElifClause{ condition, consequence }) rest  =
+    where clause (R1 Py.ElseClause{ body }) _ = compileCC body cc
+          clause (L1 Py.ElifClause{ condition, consequence }) rest  =
             if' <$> compile condition <*> compileCC consequence cc <*> rest
 
 
diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 17a225b2d..3731d929f 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -32,8 +32,8 @@ library
     , fused-effects      ^>= 0.5
     , semantic-source    ^>= 0.0
     , text               ^>= 1.2.3.1
-    , tree-sitter         == 0.3.0.0
-    , tree-sitter-python  == 0.4.0.0
+    , tree-sitter        ^>= 0.4
+    , tree-sitter-python ^>= 0.5
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:
diff --git a/semantic.cabal b/semantic.cabal
index 3d155d339..97f1e46e0 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -56,7 +56,7 @@ common dependencies
                      , fused-effects ^>= 0.5.0.0
                      , fused-effects-exceptions ^>= 0.2.0.0
                      , hashable ^>= 1.2.7.0
-                     , tree-sitter == 0.3.0.0
+                     , tree-sitter ^>= 0.4
                      , mtl ^>= 2.2.2
                      , network ^>= 2.8.0.0
                      , pathtype ^>= 0.8.1
@@ -310,15 +310,15 @@ library
                      , unliftio-core ^>= 0.1.2.0
                      , unordered-containers ^>= 0.2.9.0
                      , vector ^>= 0.12.0.2
-                     , tree-sitter-go == 0.2.0.0
-                     , tree-sitter-haskell == 0.2.0.0
-                     , tree-sitter-json == 0.2.0.0
-                     , tree-sitter-php == 0.2.0.0
-                     , tree-sitter-python == 0.4.0.0
-                     , tree-sitter-ruby == 0.2.0.0
-                     , tree-sitter-typescript == 0.2.1.0
-                     , tree-sitter-tsx == 0.2.1.0
-                     , tree-sitter-java == 0.2.0.0
+                     , tree-sitter-go ^>= 0.2
+                     , tree-sitter-haskell ^>= 0.2
+                     , tree-sitter-json ^>= 0.2
+                     , tree-sitter-php ^>= 0.2
+                     , tree-sitter-python ^>= 0.5
+                     , tree-sitter-ruby ^>= 0.2
+                     , tree-sitter-typescript ^>= 0.2.1
+                     , tree-sitter-tsx ^>= 0.2.1
+                     , tree-sitter-java ^>= 0.2
   if flag(release)
     cpp-options:       -DCOMPUTE_GIT_SHA
 

From e1226efbbdb565a2845995a669c514bdde5ce898 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 15:14:32 -0400
Subject: [PATCH 197/228] Mod unmarshalled tags to one-index them.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 94bea224b..e9d0c1d47 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -12,7 +12,9 @@ import Control.Effect.Reader
 import Control.Effect.Writer
 import Data.Monoid (Endo(..))
 import GHC.Generics
-import Source.Loc
+import Prelude hiding (span)
+import Source.Loc (Loc)
+import Source.Span
 import Source.Source
 import Tags.Tag
 
@@ -23,7 +25,9 @@ class ToTags t where
 
 
 yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
-yield = tell . Endo . (:)
+yield = tell . Endo . (:) . modSpan toOneIndexed where
+  modSpan f t@Tag{ span = s } = t { span = f s }
+  toOneIndexed (Span (Pos l1 c1) (Pos l2 c2)) = Span (Pos (l1 + 1) (c1 + 1)) (Pos (l2 + 1) (c2 + 1))
 
 runTagging :: Source -> ReaderC Source (WriterC Tags PureC) () -> [Tag]
 runTagging source

From 379b9d4f75363cea14d73e80770d7bc8d389f8d8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 15:15:37 -0400
Subject: [PATCH 198/228] Fix the tests.

---
 semantic-python/test/Test.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs
index 540f37a5b..af691d9f7 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -29,12 +29,12 @@ import           Data.String (fromString)
 import           GHC.Stack
 import qualified Language.Python.Core as Py
 import           Prelude hiding (fail)
+import qualified Source.Span as Source (Span)
 import           Streaming
 import qualified Streaming.Prelude as Stream
 import qualified Streaming.Process
 import           System.Directory
 import           System.Exit
-import qualified TreeSitter.Span as TS (Span)
 import qualified TreeSitter.Python as TSP
 import qualified TreeSitter.Python.AST as TSP
 import qualified TreeSitter.Unmarshal as TS
@@ -100,7 +100,7 @@ fixtureTestTreeForFile fp = HUnit.testCaseSteps (Path.toString fp) $ \step -> wi
                    . runFail
                    . runReader (fromString @Py.SourcePath . Path.toString $ fp)
                    . runReader @Py.Bindings mempty
-                   . Py.compile @(TSP.Module TS.Span) @_ @(Term (Ann :+: Core))
+                   . Py.compile @(TSP.Module Source.Span) @_ @(Term (Ann :+: Core))
                    <$> result
 
   for_ directives $ \directive -> do

From 9b0187d53d0ca416fe316f2ff653f84b0a525667 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 17:32:38 -0400
Subject: [PATCH 199/228] Fix a missing import of a symbol.

---
 test/Examples.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/Examples.hs b/test/Examples.hs
index d76362d6c..0c49c581d 100644
--- a/test/Examples.hs
+++ b/test/Examples.hs
@@ -18,7 +18,7 @@ import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy.Char8 as BLC
 import qualified Data.ByteString.Streaming.Char8 as ByteStream
 import           Data.Either
-import           Data.Language (PerLanguageModes(..))
+import           Data.Language (LanguageMode(..), PerLanguageModes(..))
 import           Data.Set (Set)
 import           Data.Traversable
 import           Data.Typeable

From daefc921ebb814c60098f7096388f2257326fe0a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 17:33:07 -0400
Subject: [PATCH 200/228] =?UTF-8?q?Don=E2=80=99t=20export=20the=20Precise?=
 =?UTF-8?q?=20constructor.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/SpecHelpers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs
index 7b0dcc2a1..d1310b847 100644
--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@@ -42,7 +42,7 @@ import Data.Project as X
 import Data.Proxy as X
 import Data.Foldable (toList)
 import Data.Functor.Listable as X
-import Data.Language as X
+import Data.Language as X hiding (Precise)
 import Data.List.NonEmpty as X (NonEmpty(..))
 import Data.Semilattice.Lower as X
 import Source.Source as X (Source)

From b1611e13e87afc19c291575694b22ec7aeccdf0d Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 27 Sep 2019 17:35:51 -0400
Subject: [PATCH 201/228] Initial stab at folding over multiple assignments.

---
 semantic-python/src/Language/Python/Core.hs   | 44 ++++++++++++++-----
 .../test/fixtures/2-04-multiple-assign.py     |  2 +
 2 files changed, 36 insertions(+), 10 deletions(-)
 create mode 100644 semantic-python/test/fixtures/2-04-multiple-assign.py

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index b259be847..3864f8423 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE ConstraintKinds, DataKinds, DefaultSignatures, DeriveAnyClass, DeriveGeneric, DerivingStrategies,
              DerivingVia, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
-             NamedFieldPuns, OverloadedLists, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving,
-             TypeApplications, TypeOperators, UndecidableInstances #-}
+             LambdaCase, NamedFieldPuns, OverloadedLists, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving,
+             TypeApplications, TypeOperators, UndecidableInstances, ViewPatterns #-}
 
 module Language.Python.Core
 ( compile
@@ -17,12 +17,15 @@ import           Control.Monad.Fail
 import           Data.Coerce
 import           Data.Core as Core
 import           Data.Foldable
+import           Data.List (mapAccumL, mapAccumR)
+import           Data.List.NonEmpty(NonEmpty (..))
 import qualified Data.Loc
 import           Data.Name as Name
 import           Data.Stack (Stack)
 import qualified Data.Stack as Stack
 import           Data.String (IsString)
 import           Data.Text (Text)
+import           Debug.Trace (traceShowId, traceShowM)
 import           GHC.Generics
 import           GHC.Records
 import qualified TreeSitter.Python.AST as Py
@@ -108,18 +111,39 @@ deriving via CompileSum (Either l r) instance (Compile l, Compile r) => Compile
 instance Compile (Py.AssertStatement Span)
 instance Compile (Py.Attribute Span)
 
-instance Compile (Py.Assignment Span) where
-  compileCC it@Py.Assignment
-    { Py.left = Py.ExpressionList
-      { Py.extraChildren =
+type RHS a = Either (Py.Assignment a) (Either (Py.AugmentedAssignment a) (Either (Py.ExpressionList a) (Py.Yield a)))
+type Desugared a = Either (Py.ExpressionList a) (Py.Yield a)
+
+expressionListToSingleName :: Py.ExpressionList a -> Maybe Text
+expressionListToSingleName Py.ExpressionList { Py.extraChildren =
         [ Py.PrimaryExpressionExpression (Py.IdentifierPrimaryExpression (Py.Identifier { Py.bytes = name }))
         ]
-      }
+      } = Just name
+expressionListToSingleName _ = Nothing
+
+desugar :: Show a => RHS a -> Maybe ([Name], Desugared a)
+desugar = \case
+  Left it@Py.Assignment { left = lhs
+                        , right
+                        } -> do
+    Just name <- pure $ expressionListToSingleName lhs
+    (names, item) <- right >>= desugar
+    let current = name
+    pure (current:names, item)
+  Right (Left _aug) -> error "augmented assignment case not done"
+  Right (Right any) -> Just ([], any)
+  e -> error ("Bug: died with " <> show e <> " in desugar")
+
+instance Compile (Py.Assignment Span) where
+  compileCC it@Py.Assignment
+    { Py.left = (expressionListToSingleName -> Just name)
     , Py.right = Just rhs
     } cc = do
-    value  <- compile rhs
-    let assigning n = (Name.named' name :<- value) >>>= n
-    locate it =<< assigning <$> local (def name) cc
+    Just (names, val) <- pure (desugar rhs)
+    item <- compile val
+    let builder cont n rem = fmap ((Name.named' n :<- rem) >>>=) (local (def n) (cont (pure n)))
+    foldl' builder (const cc) (name:names) item >>= locate it
+
   compileCC other _ = fail ("Unhandled assignment case: " <> show other)
 
 instance Compile (Py.AugmentedAssignment Span)
diff --git a/semantic-python/test/fixtures/2-04-multiple-assign.py b/semantic-python/test/fixtures/2-04-multiple-assign.py
new file mode 100644
index 000000000..0581fd874
--- /dev/null
+++ b/semantic-python/test/fixtures/2-04-multiple-assign.py
@@ -0,0 +1,2 @@
+# CHECK-TREE: { z <- #true; y <- z; x <- y; #record { z : z, y : y, x : x }}
+x = y = z = True

From 825726d37e36b06e31a960f57d2c44e2a2e42edd Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 27 Sep 2019 17:36:08 -0400
Subject: [PATCH 202/228] Add a lot of comments and some clarifying patterns.

---
 semantic-python/src/Language/Python/Core.hs | 60 +++++++++++++--------
 1 file changed, 39 insertions(+), 21 deletions(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 3864f8423..0c7a288e7 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE ConstraintKinds, DataKinds, DefaultSignatures, DeriveAnyClass, DeriveGeneric, DerivingStrategies,
              DerivingVia, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
-             LambdaCase, NamedFieldPuns, OverloadedLists, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving,
-             TypeApplications, TypeOperators, UndecidableInstances, ViewPatterns #-}
+             LambdaCase, NamedFieldPuns, OverloadedLists, OverloadedStrings, PatternSynonyms, ScopedTypeVariables,
+             StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances, ViewPatterns #-}
 
 module Language.Python.Core
 ( compile
@@ -14,11 +14,12 @@ import Prelude hiding (fail)
 import           Control.Effect hiding ((:+:))
 import           Control.Effect.Reader
 import           Control.Monad.Fail
+import           Data.Bifunctor
 import           Data.Coerce
 import           Data.Core as Core
 import           Data.Foldable
 import           Data.List (mapAccumL, mapAccumR)
-import           Data.List.NonEmpty(NonEmpty (..))
+import           Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Loc
 import           Data.Name as Name
 import           Data.Stack (Stack)
@@ -32,6 +33,7 @@ import qualified TreeSitter.Python.AST as Py
 import           TreeSitter.Span (Span)
 import qualified TreeSitter.Span as TreeSitter
 
+-- Access to the current filename as Text to stick into location annotations.
 newtype SourcePath = SourcePath { rawPath :: Text }
   deriving stock (Eq, Show)
   deriving newtype IsString
@@ -46,6 +48,17 @@ newtype Bindings = Bindings { unBindings :: Stack Name }
 def :: Name -> Bindings -> Bindings
 def n = coerce (Stack.:> n)
 
+-- Useful pattern synonym for extracting a single identifier from
+-- a Python ExpressionList. Easier than pattern-matching every time.
+-- TODO: when this is finished, we won't need this pattern, as we'll
+-- handle ExpressionLists the smart way every time.
+pattern OneExpression :: Name -> Py.ExpressionList a
+pattern OneExpression name <- Py.ExpressionList
+  { Py.extraChildren =
+    [ Py.PrimaryExpressionExpression (Py.IdentifierPrimaryExpression (Py.Identifier { bytes = name }))
+    ]
+  }
+
 -- We leave the representation of Core syntax abstract so that it's not
 -- possible for us to 'cheat' by pattern-matching on or eliminating a
 -- compiled term.
@@ -111,32 +124,35 @@ deriving via CompileSum (Either l r) instance (Compile l, Compile r) => Compile
 instance Compile (Py.AssertStatement Span)
 instance Compile (Py.Attribute Span)
 
-type RHS a = Either (Py.Assignment a) (Either (Py.AugmentedAssignment a) (Either (Py.ExpressionList a) (Py.Yield a)))
-type Desugared a = Either (Py.ExpressionList a) (Py.Yield a)
+-- Assignment compilation. Assignments are an uneasy hybrid of expressions
+-- (since they appear to have values, i.e. `a = b = c`) and statements (because
+-- they introduce bindings. For that reason, they deserve special attention.
+--
+-- The correct desugaring for the expression above looks like, given a continuation @cc@:
+-- @
+--  (b :<- c) >>>= (a :<- b) >>>= cont
+-- @
+-- The tree structure that we get out of tree-sitter is not particulary conducive to expressing
+-- this naturally, so we engage in a small desugaring step so that we can turn a list [a, b, c]
+-- into a sequenced Core expression using >>>= and a left fold. (It's a left fold that has
+-- information—specifically the LHS to assign—flowing through it rightward.)
 
-expressionListToSingleName :: Py.ExpressionList a -> Maybe Text
-expressionListToSingleName Py.ExpressionList { Py.extraChildren =
-        [ Py.PrimaryExpressionExpression (Py.IdentifierPrimaryExpression (Py.Identifier { Py.bytes = name }))
-        ]
-      } = Just name
-expressionListToSingleName _ = Nothing
+-- RHS represents the right-hand-side of an assignment that we get out of tree-sitter.
+-- Desugared is the "terminal" node in a sequence of assignments, i.e. given a = b = c,
+-- c will be the terminal node. It is never an assignment.
+type RHS a = Either (Py.Assignment a) (Either (Py.AugmentedAssignment a) (Desugared a))
+type Desugared a = Either (Py.ExpressionList a) (Py.Yield a)
 
 desugar :: Show a => RHS a -> Maybe ([Name], Desugared a)
 desugar = \case
-  Left it@Py.Assignment { left = lhs
-                        , right
-                        } -> do
-    Just name <- pure $ expressionListToSingleName lhs
-    (names, item) <- right >>= desugar
-    let current = name
-    pure (current:names, item)
-  Right (Left _aug) -> error "augmented assignment case not done"
+  Left it@Py.Assignment { left = OneExpression name, right} ->
+    let located = name
+    in fmap (first (located:)) (right >>= desugar)
   Right (Right any) -> Just ([], any)
-  e -> error ("Bug: died with " <> show e <> " in desugar")
 
 instance Compile (Py.Assignment Span) where
   compileCC it@Py.Assignment
-    { Py.left = (expressionListToSingleName -> Just name)
+    { Py.left = OneExpression name
     , Py.right = Just rhs
     } cc = do
     Just (names, val) <- pure (desugar rhs)
@@ -146,6 +162,8 @@ instance Compile (Py.Assignment Span) where
 
   compileCC other _ = fail ("Unhandled assignment case: " <> show other)
 
+-- End assignment compilation
+
 instance Compile (Py.AugmentedAssignment Span)
 instance Compile (Py.Await Span)
 instance Compile (Py.BinaryOperator Span)

From 54bc5c7505c8154b8d1908667f24e0f47cd5df4f Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 27 Sep 2019 17:38:50 -0400
Subject: [PATCH 203/228] Move desugar into a monad.

---
 semantic-python/src/Language/Python/Core.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 0c7a288e7..da1be2c87 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -143,19 +143,20 @@ instance Compile (Py.Attribute Span)
 type RHS a = Either (Py.Assignment a) (Either (Py.AugmentedAssignment a) (Desugared a))
 type Desugared a = Either (Py.ExpressionList a) (Py.Yield a)
 
-desugar :: Show a => RHS a -> Maybe ([Name], Desugared a)
+desugar :: (Member (Reader SourcePath) sig, Carrier sig m, MonadFail m)
+        => Show a => RHS a -> m ([Name], Desugared a)
 desugar = \case
-  Left it@Py.Assignment { left = OneExpression name, right} ->
-    let located = name
-    in fmap (first (located:)) (right >>= desugar)
-  Right (Right any) -> Just ([], any)
+  Left it@Py.Assignment { left = OneExpression name, right = Just rhs} ->
+    let located = name in fmap (first (located:)) (desugar rhs)
+  Right (Right any) -> pure ([], any)
+  other -> fail ("desugar: couldn't desugar RHS " <> show other)
 
 instance Compile (Py.Assignment Span) where
   compileCC it@Py.Assignment
     { Py.left = OneExpression name
     , Py.right = Just rhs
     } cc = do
-    Just (names, val) <- pure (desugar rhs)
+    (names, val) <- desugar rhs
     item <- compile val
     let builder cont n rem = fmap ((Name.named' n :<- rem) >>>=) (local (def n) (cont (pure n)))
     foldl' builder (const cc) (name:names) item >>= locate it

From 794265d3a9fe0d9fbdd4830e1fe31a06247d2891 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 27 Sep 2019 17:56:19 -0400
Subject: [PATCH 204/228] Even more comments.

---
 semantic-python/src/Language/Python/Core.hs | 29 +++++++++++++++++----
 1 file changed, 24 insertions(+), 5 deletions(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index da1be2c87..eaadff660 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -84,6 +84,8 @@ class Compile py where
   default compileCC :: (MonadFail m, Show py) => py -> m (t Name) -> m (t Name)
   compileCC a _ = defaultCompile a
 
+
+
 -- | TODO: This is not right, it should be a reference to a Preluded
 -- NoneType instance, but it will do for now.
 none :: (Member Core sig, Carrier sig t) => t Name
@@ -143,23 +145,40 @@ instance Compile (Py.Attribute Span)
 type RHS a = Either (Py.Assignment a) (Either (Py.AugmentedAssignment a) (Desugared a))
 type Desugared a = Either (Py.ExpressionList a) (Py.Yield a)
 
-desugar :: (Member (Reader SourcePath) sig, Carrier sig m, MonadFail m)
-        => Show a => RHS a -> m ([Name], Desugared a)
+-- Desugaring an RHS involves walking as deeply as possible into an
+-- assignment, storing the names we encounter as we go and eventually
+-- returning a terminal expression.
+desugar :: (Show a, Member (Reader SourcePath) sig, Carrier sig m, MonadFail m)
+        => RHS a -> m ([Name], Desugared a)
 desugar = \case
   Left it@Py.Assignment { left = OneExpression name, right = Just rhs} ->
     let located = name in fmap (first (located:)) (desugar rhs)
   Right (Right any) -> pure ([], any)
   other -> fail ("desugar: couldn't desugar RHS " <> show other)
 
+-- This is a fold function that is invoked from a left fold but that
+-- returns a function (the 'difference' pattern) so that we can pass
+-- information about what RHS we need down the chain: unlike most fold
+-- functions, it has four parameters, not three (since our fold
+-- returns a function). There's some pun to be made on "collapsing
+-- sugar", like "icing" or "sugar water" but I'll leave that as an
+-- exercise to the reader.
+collapseDesugared :: (CoreSyntax syn t, Member (Reader Bindings) sig, Carrier sig m)
+                  => (t Name -> m (t Name)) -- A meta-continuation: it takes a name and returns a continuation
+                  -> Name                   -- The current LHS to which to assign
+                  -> t Name                 -- The current RHS to which to assign, yielded from an outer continuation
+                  -> m (t Name)             -- The properly-sequenced resolut
+collapseDesugared cont n rem =
+  let assigning = fmap ((Name.named' n :<- rem) >>>=)
+  in assigning (local (def n) (cont (pure n))) -- gotta call local here to record this assignment
+
 instance Compile (Py.Assignment Span) where
   compileCC it@Py.Assignment
     { Py.left = OneExpression name
     , Py.right = Just rhs
     } cc = do
     (names, val) <- desugar rhs
-    item <- compile val
-    let builder cont n rem = fmap ((Name.named' n :<- rem) >>>=) (local (def n) (cont (pure n)))
-    foldl' builder (const cc) (name:names) item >>= locate it
+    compile val >>= foldl' collapseDesugared (const cc) (name:names) >>= locate it
 
   compileCC other _ = fail ("Unhandled assignment case: " <> show other)
 

From 7d90dbd56a13274b9758ce52bbe3ad763f5cbb06 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 18:03:20 -0400
Subject: [PATCH 205/228] Fix the Tags spec.

---
 test/Tags/Spec.hs | 50 +++++++++++++++++++++++------------------------
 1 file changed, 25 insertions(+), 25 deletions(-)

diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs
index ff3c11029..0b7c2c94d 100644
--- a/test/Tags/Spec.hs
+++ b/test/Tags/Spec.hs
@@ -11,89 +11,89 @@ spec = do
     it "produces tags for functions with docs" $ do
       (blob, tree) <- parseTestFile goParser (Path.relFile "test/fixtures/go/tags/simple_functions.go")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "TestFromBits" "Function" (Span (Pos 6 1) (Pos 8 2)) ["Statements"] (Just "func TestFromBits(t *testing.T) {") (Just "// TestFromBits ...")
-        , Tag "Hi" "Function" (Span (Pos 10 1) (Pos 11 2)) ["Statements"] (Just "func Hi()") Nothing ]
+        [ Tag "TestFromBits" Function (Span (Pos 6 1) (Pos 8 2)) ["Statements"] (Just "func TestFromBits(t *testing.T) {") (Just "// TestFromBits ...")
+        , Tag "Hi" Function (Span (Pos 10 1) (Pos 11 2)) "func Hi()" Nothing ]
 
     it "produces tags for methods" $ do
       (blob, tree) <- parseTestFile goParser (Path.relFile "test/fixtures/go/tags/method.go")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "CheckAuth" "Method" (Span (Pos 3 1) (Pos 3 100)) ["Statements"] (Just "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error)") Nothing]
+        [ Tag "CheckAuth" Method (Span (Pos 3 1) (Pos 3 100)) "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error)" Nothing]
 
     it "produces tags for calls" $ do
       (blob, tree) <- parseTestFile goParser (Path.relFile "test/fixtures/go/tags/simple_functions.go")
       runTagging blob ["Call"] tree `shouldBe`
-        [ Tag "Hi" "Call" (Span (Pos 7 2) (Pos 7 6)) ["Function", "Context", "Statements"] (Just "Hi()") Nothing]
+        [ Tag "Hi" Call (Span (Pos 7 2) (Pos 7 6)) "Hi()" Nothing]
 
   describe "javascript and typescript" $ do
     it "produces tags for functions with docs" $ do
       (blob, tree) <- parseTestFile typescriptParser (Path.relFile "test/fixtures/javascript/tags/simple_function_with_docs.js")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "myFunction" "Function" (Span (Pos 2 1) (Pos 4 2)) ["Statements"] (Just "function myFunction()") (Just "// This is myFunction") ]
+        [ Tag "myFunction" Function (Span (Pos 2 1) (Pos 4 2)) "function myFunction()" (Just "// This is myFunction") ]
 
     it "produces tags for classes" $ do
       (blob, tree) <- parseTestFile typescriptParser (Path.relFile "test/fixtures/typescript/tags/class.ts")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "FooBar" "Class" (Span (Pos 1 1) (Pos 1 16)) ["Statements"] (Just "class FooBar") Nothing ]
+        [ Tag "FooBar" Class (Span (Pos 1 1) (Pos 1 16)) "class FooBar") Nothing ]
 
     it "produces tags for modules" $ do
       (blob, tree) <- parseTestFile typescriptParser (Path.relFile "test/fixtures/typescript/tags/module.ts")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "APromise" "Module" (Span (Pos 1 1) (Pos 1 20)) ["Statements"] (Just "module APromise { }") Nothing ]
+        [ Tag "APromise" Module (Span (Pos 1 1) (Pos 1 20)) "module APromise { }" Nothing ]
 
   describe "python" $ do
     it "produces tags for functions" $ do
       (blob, tree) <- parseTestFile pythonParser (Path.relFile "test/fixtures/python/tags/simple_functions.py")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 5 17)) ["Statements"] (Just "def Foo(x):") Nothing
-        , Tag "Bar" "Function" (Span (Pos 7 1) (Pos 11 13)) ["Statements"] (Just "def Bar():") Nothing
-        , Tag "local" "Function" (Span (Pos 8 5) (Pos 9 17)) ["Statements", "Function", "Statements"] (Just "def local():") Nothing
+        [ Tag "Foo" Function (Span (Pos 1 1) (Pos 5 17)) "def Foo(x):" Nothing
+        , Tag "Bar" Function (Span (Pos 7 1) (Pos 11 13)) "def Bar():" Nothing
+        , Tag "local" Function (Span (Pos 8 5) (Pos 9 17)) "def local():" Nothing
         ]
 
     it "produces tags for functions with docs" $ do
       (blob, tree) <- parseTestFile pythonParser (Path.relFile "test/fixtures/python/tags/simple_function_with_docs.py")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 3 13)) ["Statements"] (Just "def Foo(x):") (Just "\"\"\"This is the foo function\"\"\"") ]
+        [ Tag "Foo" Function (Span (Pos 1 1) (Pos 3 13)) "def Foo(x):" (Just "\"\"\"This is the foo function\"\"\"" ]
 
     it "produces tags for classes" $ do
       (blob, tree) <- parseTestFile pythonParser (Path.relFile "test/fixtures/python/tags/class.py")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "Foo" "Class" (Span (Pos 1 1) (Pos 5 17)) ["Statements"] (Just "class Foo:") (Just "\"\"\"The Foo class\"\"\"")
-        , Tag "f" "Function" (Span (Pos 3 5) (Pos 5 17)) ["Statements", "Class", "Statements"] (Just "def f(self):") (Just "\"\"\"The f method\"\"\"")
+        [ Tag "Foo" Class (Span (Pos 1 1) (Pos 5 17)) "class Foo:" (Just "\"\"\"The Foo class\"\"\"")
+        , Tag "f" Function (Span (Pos 3 5) (Pos 5 17)) "def f(self):" (Just "\"\"\"The f method\"\"\"")
         ]
 
     it "produces tags for multi-line functions" $ do
       (blob, tree) <- parseTestFile pythonParser (Path.relFile "test/fixtures/python/tags/multiline.py")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 3 13)) ["Statements"] (Just "def Foo(x,") Nothing ]
+        [ Tag "Foo" Function (Span (Pos 1 1) (Pos 3 13)) "def Foo(x," Nothing ]
 
   describe "ruby" $ do
     it "produces tags for methods" $ do
       (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/simple_method.rb")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "foo" "Method" (Span (Pos 1 1) (Pos 4 4)) ["Statements"] (Just "def foo") Nothing ]
+        [ Tag "foo" Method (Span (Pos 1 1) (Pos 4 4)) "def foo" Nothing ]
 
     it "produces tags for sends" $ do
       (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/simple_method.rb")
       runTagging blob ["Send"] tree `shouldBe`
-        [ Tag "puts" "Send" (Span (Pos 2 3) (Pos 2 12)) ["Statements", "Method", "Statements"] (Just "puts \"hi\"") Nothing
-        , Tag "bar" "Send" (Span (Pos 3 3) (Pos 3 8)) ["Statements", "Method", "Statements"] (Just "a.bar") Nothing
-        , Tag "a" "Send" (Span (Pos 3 3) (Pos 3 4)) ["Send", "Statements", "Method", "Statements"] (Just "a") Nothing
+        [ Tag "puts" Send (Span (Pos 2 3) (Pos 2 12)) "puts \"hi\"" Nothing
+        , Tag "bar" Send (Span (Pos 3 3) (Pos 3 8)) "a.bar" Nothing
+        , Tag "a" Send (Span (Pos 3 3) (Pos 3 4)) "a" Nothing
         ]
 
     it "produces tags for methods with docs" $ do
       (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/simple_method_with_docs.rb")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "foo" "Method" (Span (Pos 2 1) (Pos 3 4)) ["Statements"] (Just "def foo") (Just "# Public: foo") ]
+        [ Tag "foo" Method (Span (Pos 2 1) (Pos 3 4)) "def foo" (Just "# Public: foo") ]
 
     it "produces tags for methods and classes with docs" $ do
       (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/class_module.rb")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "Foo" "Module" (Span (Pos 2 1 ) (Pos 12 4)) ["Statements"] (Just "module Foo") (Just "# Public: Foo")
-        , Tag "Bar" "Class"  (Span (Pos 5 3 ) (Pos 11 6)) ["Module", "Context", "Statements"] (Just "class Bar") (Just "# Public: Bar")
-        , Tag "baz" "Method" (Span (Pos 8 5 ) (Pos 10 8)) ["Class", "Context", "Module", "Context", "Statements"] (Just "def baz(a)") (Just "# Public: baz")
-        , Tag "C" "Class" (Span (Pos 14 1) (Pos 20 4)) ["Statements"] (Just "class A::B::C") Nothing
-        , Tag "foo" "Method" (Span (Pos 15 3) (Pos 17 6)) ["Statements", "Class", "Statements"] (Just "def foo") Nothing
-        , Tag "foo" "Method" (Span (Pos 18 3) (Pos 19 6)) ["Statements", "Class", "Statements"] (Just "def self.foo") Nothing
+        [ Tag "Foo" Module (Span (Pos 2 1 ) (Pos 12 4)) "module Foo" (Just "# Public: Foo")
+        , Tag "Bar" Class  (Span (Pos 5 3 ) (Pos 11 6)) "class Bar" (Just "# Public: Bar")
+        , Tag "baz" Method (Span (Pos 8 5 ) (Pos 10 8)) "def baz(a)" (Just "# Public: baz")
+        , Tag "C" Class (Span (Pos 14 1) (Pos 20 4)) "class A::B::C" Nothing
+        , Tag "foo" Method (Span (Pos 15 3) (Pos 17 6)) "def foo" Nothing
+        , Tag "foo" Method (Span (Pos 18 3) (Pos 19 6)) "def self.foo" Nothing
         ]
 
 symbolsToSummarize :: [Text]

From a51151afb574a7d612d58d26b20f138ad049af60 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 27 Sep 2019 18:11:36 -0400
Subject: [PATCH 206/228] Make sure chained assignments don't lose their
 location info.

---
 semantic-python/src/Language/Python/Core.hs | 47 ++++++++++++---------
 1 file changed, 28 insertions(+), 19 deletions(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index eaadff660..f5fb5cda9 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -18,15 +18,13 @@ import           Data.Bifunctor
 import           Data.Coerce
 import           Data.Core as Core
 import           Data.Foldable
-import           Data.List (mapAccumL, mapAccumR)
-import           Data.List.NonEmpty (NonEmpty (..))
+import           Data.Loc (Loc)
 import qualified Data.Loc
 import           Data.Name as Name
 import           Data.Stack (Stack)
 import qualified Data.Stack as Stack
 import           Data.String (IsString)
 import           Data.Text (Text)
-import           Debug.Trace (traceShowId, traceShowM)
 import           GHC.Generics
 import           GHC.Records
 import qualified TreeSitter.Python.AST as Py
@@ -101,17 +99,18 @@ compile :: ( Compile py
         => py -> m (t Name)
 compile t = compileCC t (pure none)
 
+locFromTSSpan :: SourcePath -> TreeSitter.Span -> Loc
+locFromTSSpan fp (TreeSitter.Span (TreeSitter.Pos a b) (TreeSitter.Pos c d))
+  = Data.Loc.Loc (rawPath fp) (Data.Loc.Span (Data.Loc.Pos a b) (Data.Loc.Pos c d))
+
 locate :: ( HasField "ann" syntax Span
           , CoreSyntax syn t
           , Member (Reader SourcePath) sig
           , Carrier sig m
           ) => syntax -> t a -> m (t a)
 locate syn item = do
-  fp <- asks @SourcePath rawPath
-  let locFromTSSpan (TreeSitter.Span (TreeSitter.Pos a b) (TreeSitter.Pos c d))
-        = Data.Loc.Loc fp (Data.Loc.Span (Data.Loc.Pos a b) (Data.Loc.Pos c d))
-
-  pure (Core.annAt (locFromTSSpan (getField @"ann" syn)) item)
+  fp <- ask @SourcePath
+  pure (Core.annAt (locFromTSSpan fp (getField @"ann" syn)) item)
 
 defaultCompile :: (MonadFail m, Show py) => py -> m (t Name)
 defaultCompile t = fail $ "compilation unimplemented for " <> show t
@@ -145,14 +144,21 @@ instance Compile (Py.Attribute Span)
 type RHS a = Either (Py.Assignment a) (Either (Py.AugmentedAssignment a) (Desugared a))
 type Desugared a = Either (Py.ExpressionList a) (Py.Yield a)
 
+-- We have to pair locations and names, and tuple syntax is harder to
+-- read in this case than a happy little constructor.
+data Located a = Located Loc a
+
 -- Desugaring an RHS involves walking as deeply as possible into an
 -- assignment, storing the names we encounter as we go and eventually
--- returning a terminal expression.
-desugar :: (Show a, Member (Reader SourcePath) sig, Carrier sig m, MonadFail m)
-        => RHS a -> m ([Name], Desugared a)
+-- returning a terminal expression. We have to keep track of which
+desugar :: (Member (Reader SourcePath) sig, Carrier sig m, MonadFail m)
+        => RHS Span
+        -> m ([Located Name], Desugared Span)
 desugar = \case
-  Left it@Py.Assignment { left = OneExpression name, right = Just rhs} ->
-    let located = name in fmap (first (located:)) (desugar rhs)
+  Left Py.Assignment { left = OneExpression name, right = Just rhs, ann} -> do
+    loc <- locFromTSSpan <$> ask <*> pure ann
+    let cons = (Located loc name :)
+    fmap (first cons) (desugar rhs)
   Right (Right any) -> pure ([], any)
   other -> fail ("desugar: couldn't desugar RHS " <> show other)
 
@@ -165,20 +171,23 @@ desugar = \case
 -- exercise to the reader.
 collapseDesugared :: (CoreSyntax syn t, Member (Reader Bindings) sig, Carrier sig m)
                   => (t Name -> m (t Name)) -- A meta-continuation: it takes a name and returns a continuation
-                  -> Name                   -- The current LHS to which to assign
+                  -> Located Name           -- The current LHS to which to assign
                   -> t Name                 -- The current RHS to which to assign, yielded from an outer continuation
                   -> m (t Name)             -- The properly-sequenced resolut
-collapseDesugared cont n rem =
-  let assigning = fmap ((Name.named' n :<- rem) >>>=)
+collapseDesugared cont (Located loc n) rem =
+  let assigning = fmap (Core.annAt loc) . fmap ((Name.named' n :<- rem) >>>=)
   in assigning (local (def n) (cont (pure n))) -- gotta call local here to record this assignment
 
 instance Compile (Py.Assignment Span) where
   compileCC it@Py.Assignment
-    { Py.left = OneExpression name
-    , Py.right = Just rhs
+    { left = OneExpression name
+    , right = Just rhs
+    , ann
     } cc = do
+    p <- ask @SourcePath
     (names, val) <- desugar rhs
-    compile val >>= foldl' collapseDesugared (const cc) (name:names) >>= locate it
+    let allNames = Located (locFromTSSpan p ann) name : names
+    compile val >>= foldl' collapseDesugared (const cc) allNames >>= locate it
 
   compileCC other _ = fail ("Unhandled assignment case: " <> show other)
 

From 36112e27852677cebc0134248d60416036293c05 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 18:14:50 -0400
Subject: [PATCH 207/228] Typo.

---
 test/Tags/Spec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs
index 0b7c2c94d..e74ed1365 100644
--- a/test/Tags/Spec.hs
+++ b/test/Tags/Spec.hs
@@ -33,7 +33,7 @@ spec = do
     it "produces tags for classes" $ do
       (blob, tree) <- parseTestFile typescriptParser (Path.relFile "test/fixtures/typescript/tags/class.ts")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "FooBar" Class (Span (Pos 1 1) (Pos 1 16)) "class FooBar") Nothing ]
+        [ Tag "FooBar" Class (Span (Pos 1 1) (Pos 1 16)) "class FooBar" Nothing ]
 
     it "produces tags for modules" $ do
       (blob, tree) <- parseTestFile typescriptParser (Path.relFile "test/fixtures/typescript/tags/module.ts")

From 8e6a1395c05edd8cf5922fad59b2fae358305f4d Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 27 Sep 2019 18:16:42 -0400
Subject: [PATCH 208/228] w h i t e s p a c e

---
 semantic-python/src/Language/Python/Core.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index f5fb5cda9..f04a2835e 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -82,8 +82,6 @@ class Compile py where
   default compileCC :: (MonadFail m, Show py) => py -> m (t Name) -> m (t Name)
   compileCC a _ = defaultCompile a
 
-
-
 -- | TODO: This is not right, it should be a reference to a Preluded
 -- NoneType instance, but it will do for now.
 none :: (Member Core sig, Carrier sig t) => t Name

From de2c762d2ce40667b00afe16b254851a4d9885e2 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 27 Sep 2019 18:18:00 -0400
Subject: [PATCH 209/228] Typo in comment.

---
 semantic-python/src/Language/Python/Core.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index f04a2835e..bba35995e 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -127,7 +127,7 @@ instance Compile (Py.Attribute Span)
 -- (since they appear to have values, i.e. `a = b = c`) and statements (because
 -- they introduce bindings. For that reason, they deserve special attention.
 --
--- The correct desugaring for the expression above looks like, given a continuation @cc@:
+-- The correct desugaring for the expression above looks like, given a continuation @cont@:
 -- @
 --  (b :<- c) >>>= (a :<- b) >>>= cont
 -- @

From 3947c50a2089e506db707bf4f982f6455fda7dff Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 18:55:26 -0400
Subject: [PATCH 210/228] Another typo.

---
 test/Tags/Spec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs
index e74ed1365..6457e2203 100644
--- a/test/Tags/Spec.hs
+++ b/test/Tags/Spec.hs
@@ -52,7 +52,7 @@ spec = do
     it "produces tags for functions with docs" $ do
       (blob, tree) <- parseTestFile pythonParser (Path.relFile "test/fixtures/python/tags/simple_function_with_docs.py")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "Foo" Function (Span (Pos 1 1) (Pos 3 13)) "def Foo(x):" (Just "\"\"\"This is the foo function\"\"\"" ]
+        [ Tag "Foo" Function (Span (Pos 1 1) (Pos 3 13)) "def Foo(x):" (Just "\"\"\"This is the foo function\"\"\"") ]
 
     it "produces tags for classes" $ do
       (blob, tree) <- parseTestFile pythonParser (Path.relFile "test/fixtures/python/tags/class.py")

From e7dfd235488dd5d36bd735a287277ad5bd932ebd Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 19:53:22 -0400
Subject: [PATCH 211/228] Qualify the references to Module.

---
 test/Tags/Spec.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs
index 6457e2203..6cc5c9da0 100644
--- a/test/Tags/Spec.hs
+++ b/test/Tags/Spec.hs
@@ -2,7 +2,7 @@ module Tags.Spec (spec) where
 
 import Data.Text (Text)
 import SpecHelpers
-import Tags.Tagging
+import Tags.Tagging as Tags
 import qualified System.Path as Path
 
 spec :: Spec
@@ -38,7 +38,7 @@ spec = do
     it "produces tags for modules" $ do
       (blob, tree) <- parseTestFile typescriptParser (Path.relFile "test/fixtures/typescript/tags/module.ts")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "APromise" Module (Span (Pos 1 1) (Pos 1 20)) "module APromise { }" Nothing ]
+        [ Tag "APromise" Tags.Module (Span (Pos 1 1) (Pos 1 20)) "module APromise { }" Nothing ]
 
   describe "python" $ do
     it "produces tags for functions" $ do
@@ -88,7 +88,7 @@ spec = do
     it "produces tags for methods and classes with docs" $ do
       (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/class_module.rb")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "Foo" Module (Span (Pos 2 1 ) (Pos 12 4)) "module Foo" (Just "# Public: Foo")
+        [ Tag "Foo" Tags.Module (Span (Pos 2 1 ) (Pos 12 4)) "module Foo" (Just "# Public: Foo")
         , Tag "Bar" Class  (Span (Pos 5 3 ) (Pos 11 6)) "class Bar" (Just "# Public: Bar")
         , Tag "baz" Method (Span (Pos 8 5 ) (Pos 10 8)) "def baz(a)" (Just "# Public: baz")
         , Tag "C" Class (Span (Pos 14 1) (Pos 20 4)) "class A::B::C" Nothing

From 23eb8ea78c67c9e6592f7fa0c026776a47160a0e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 20:00:12 -0400
Subject: [PATCH 212/228] Call, not Send.

---
 test/Tags/Spec.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs
index 6cc5c9da0..a3e6fe297 100644
--- a/test/Tags/Spec.hs
+++ b/test/Tags/Spec.hs
@@ -75,9 +75,9 @@ spec = do
     it "produces tags for sends" $ do
       (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/simple_method.rb")
       runTagging blob ["Send"] tree `shouldBe`
-        [ Tag "puts" Send (Span (Pos 2 3) (Pos 2 12)) "puts \"hi\"" Nothing
-        , Tag "bar" Send (Span (Pos 3 3) (Pos 3 8)) "a.bar" Nothing
-        , Tag "a" Send (Span (Pos 3 3) (Pos 3 4)) "a" Nothing
+        [ Tag "puts" Call (Span (Pos 2 3) (Pos 2 12)) "puts \"hi\"" Nothing
+        , Tag "bar" Call (Span (Pos 3 3) (Pos 3 8)) "a.bar" Nothing
+        , Tag "a" Call (Span (Pos 3 3) (Pos 3 4)) "a" Nothing
         ]
 
     it "produces tags for methods with docs" $ do

From 7c44ebaa077b14d4e510847fa1976c493e15ea83 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 27 Sep 2019 20:45:14 -0400
Subject: [PATCH 213/228] Missed one.

---
 test/Tags/Spec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs
index a3e6fe297..bd79c877e 100644
--- a/test/Tags/Spec.hs
+++ b/test/Tags/Spec.hs
@@ -11,7 +11,7 @@ spec = do
     it "produces tags for functions with docs" $ do
       (blob, tree) <- parseTestFile goParser (Path.relFile "test/fixtures/go/tags/simple_functions.go")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "TestFromBits" Function (Span (Pos 6 1) (Pos 8 2)) ["Statements"] (Just "func TestFromBits(t *testing.T) {") (Just "// TestFromBits ...")
+        [ Tag "TestFromBits" Function (Span (Pos 6 1) (Pos 8 2)) "func TestFromBits(t *testing.T) {" (Just "// TestFromBits ...")
         , Tag "Hi" Function (Span (Pos 10 1) (Pos 11 2)) "func Hi()" Nothing ]
 
     it "produces tags for methods" $ do

From af429a5933907e5ca37f816b50c904d132c7dc63 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Sat, 28 Sep 2019 09:44:55 -0400
Subject: [PATCH 214/228] Consolidate fmaps.

---
 semantic-python/src/Language/Python/Core.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index bba35995e..8470b97f9 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -173,7 +173,7 @@ collapseDesugared :: (CoreSyntax syn t, Member (Reader Bindings) sig, Carrier si
                   -> t Name                 -- The current RHS to which to assign, yielded from an outer continuation
                   -> m (t Name)             -- The properly-sequenced resolut
 collapseDesugared cont (Located loc n) rem =
-  let assigning = fmap (Core.annAt loc) . fmap ((Name.named' n :<- rem) >>>=)
+  let assigning = fmap (Core.annAt loc . ((Name.named' n :<- rem) >>>=))
   in assigning (local (def n) (cont (pure n))) -- gotta call local here to record this assignment
 
 instance Compile (Py.Assignment Span) where

From 79dcbfd1cafe529b5a1770b3a877b5bc0f708011 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Sun, 29 Sep 2019 13:44:14 -0400
Subject: [PATCH 215/228] Add test for Semantic.Git.lsTree.

I have a proposed speedup for lsTree, but since this resides on a
critical path for downstream systems, I want to make sure that I don't
break this while I'm at it.

I really should rewrite this test to use tasty-hspec, but it'd be a
long slog, and I have better things to do.
---
 test/Semantic/IO/Spec.hs | 53 ++++++++++++++++++----------------------
 1 file changed, 24 insertions(+), 29 deletions(-)

diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs
index 767c0da9f..5adccbb34 100644
--- a/test/Semantic/IO/Spec.hs
+++ b/test/Semantic/IO/Spec.hs
@@ -16,23 +16,35 @@ import Shelly (shelly, silently, cd, run_)
 import qualified System.Path as Path
 import System.Path ((</>))
 
+
+makeGitRepo :: FilePath -> IO ()
+makeGitRepo dir = shelly . silently $ do
+  cd (fromString dir)
+  let git = run_ "git"
+  git ["init"]
+  run_ "touch" ["foo.py", "bar.rb"]
+  git ["add", "foo.py", "bar.rb"]
+  git ["config", "user.name", "'Test'"]
+  git ["config", "user.email", "'test@test.test'"]
+  git ["commit", "-am", "'test commit'"]
+
 spec :: Spec
 spec = do
+  describe "lsTree" $ do
+    hasGit <- runIO $ isJust <$> findExecutable "git"
+    when hasGit . it "should read all tree entries from a repo" $ do
+      items <- liftIO . withSystemTempDirectory "semantic-temp-git-repo" $ \dir -> do
+        makeGitRepo dir
+        Git.lsTree dir (Git.OID "HEAD")
+
+      length items `shouldBe` 2
+
   describe "readBlobsFromGitRepo" $ do
     hasGit <- runIO $ isJust <$> findExecutable "git"
     when hasGit . it "should read from a git directory" $ do
       -- This temporary directory will be cleaned after use.
       blobs <- liftIO . withSystemTempDirectory "semantic-temp-git-repo" $ \dir -> do
-        shelly $ silently $ do
-          cd (fromString dir)
-          let git = run_ "git"
-          git ["init"]
-          run_ "touch" ["foo.py", "bar.rb"]
-          git ["add", "foo.py", "bar.rb"]
-          git ["config", "user.name", "'Test'"]
-          git ["config", "user.email", "'test@test.test'"]
-          git ["commit", "-am", "'test commit'"]
-
+        makeGitRepo dir
         readBlobsFromGitRepoPath (Path.absDir dir </> Path.relDir ".git") (Git.OID "HEAD") [] []
       let files = sortOn fileLanguage (blobFile <$> blobs)
       files `shouldBe` [ File "foo.py" Python
@@ -43,16 +55,7 @@ spec = do
       -- This temporary directory will be cleaned after use.
       blobs <- liftIO . withSystemTempDirectory "semantic-temp-git-repo" $ \dir -> do
         let pdir = Path.absDir dir
-        shelly $ silently $ do
-          cd (fromString dir)
-          let git = run_ "git"
-          git ["init"]
-          run_ "touch" ["foo.py", "bar.rb"]
-          git ["add", "foo.py", "bar.rb"]
-          git ["config", "user.name", "'Test'"]
-          git ["config", "user.email", "'test@test.test'"]
-          git ["commit", "-am", "'test commit'"]
-
+        makeGitRepo dir
         readBlobsFromGitRepoPath (pdir </> Path.relDir ".git") (Git.OID "HEAD") [] [Path.relFile "foo.py"]
       let files = sortOn fileLanguage (blobFile <$> blobs)
       files `shouldBe` [ File "foo.py" Python ]
@@ -60,15 +63,7 @@ spec = do
     when hasGit . it "should read from a git directory with --exclude" $ do
       -- This temporary directory will be cleaned after use.
       blobs <- liftIO . withSystemTempDirectory "semantic-temp-git-repo" $ \dir -> do
-        shelly $ silently $ do
-          cd (fromString dir)
-          let git = run_ "git"
-          git ["init"]
-          run_ "touch" ["foo.py", "bar.rb"]
-          git ["add", "foo.py", "bar.rb"]
-          git ["config", "user.name", "'Test'"]
-          git ["config", "user.email", "'test@test.test'"]
-          git ["commit", "-am", "'test commit'"]
+        makeGitRepo dir
 
         readBlobsFromGitRepoPath (Path.absDir dir </> Path.relDir ".git") (Git.OID "HEAD") [Path.relFile "foo.py"] []
       let files = sortOn fileLanguage (blobFile <$> blobs)

From a686344145657d1ad2c8b48a89f6d94e4a3cd90a Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Sun, 29 Sep 2019 16:57:11 -0400
Subject: [PATCH 216/228] Add failing unit tests.

---
 test/Semantic/IO/Spec.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs
index 5adccbb34..ee1ecf219 100644
--- a/test/Semantic/IO/Spec.hs
+++ b/test/Semantic/IO/Spec.hs
@@ -22,8 +22,8 @@ makeGitRepo dir = shelly . silently $ do
   cd (fromString dir)
   let git = run_ "git"
   git ["init"]
-  run_ "touch" ["foo.py", "bar.rb"]
-  git ["add", "foo.py", "bar.rb"]
+  run_ "touch" ["日本語.py", "bar.rb"]
+  git ["add", "日本語.py", "bar.rb"]
   git ["config", "user.name", "'Test'"]
   git ["config", "user.email", "'test@test.test'"]
   git ["commit", "-am", "'test commit'"]
@@ -47,7 +47,7 @@ spec = do
         makeGitRepo dir
         readBlobsFromGitRepoPath (Path.absDir dir </> Path.relDir ".git") (Git.OID "HEAD") [] []
       let files = sortOn fileLanguage (blobFile <$> blobs)
-      files `shouldBe` [ File "foo.py" Python
+      files `shouldBe` [ File "日本語.py" Python
                        , File "bar.rb" Ruby
                        ]
 
@@ -56,16 +56,16 @@ spec = do
       blobs <- liftIO . withSystemTempDirectory "semantic-temp-git-repo" $ \dir -> do
         let pdir = Path.absDir dir
         makeGitRepo dir
-        readBlobsFromGitRepoPath (pdir </> Path.relDir ".git") (Git.OID "HEAD") [] [Path.relFile "foo.py"]
+        readBlobsFromGitRepoPath (pdir </> Path.relDir ".git") (Git.OID "HEAD") [] [Path.relFile "日本語.py"]
       let files = sortOn fileLanguage (blobFile <$> blobs)
-      files `shouldBe` [ File "foo.py" Python ]
+      files `shouldBe` [ File "日本語.py" Python ]
 
     when hasGit . it "should read from a git directory with --exclude" $ do
       -- This temporary directory will be cleaned after use.
       blobs <- liftIO . withSystemTempDirectory "semantic-temp-git-repo" $ \dir -> do
         makeGitRepo dir
 
-        readBlobsFromGitRepoPath (Path.absDir dir </> Path.relDir ".git") (Git.OID "HEAD") [Path.relFile "foo.py"] []
+        readBlobsFromGitRepoPath (Path.absDir dir </> Path.relDir ".git") (Git.OID "HEAD") [Path.relFile "日本語.py"] []
       let files = sortOn fileLanguage (blobFile <$> blobs)
       files `shouldBe` [ File "bar.rb" Ruby ]
 

From d7b76d3be4f9c9f0b4b2b0a19fbc30a0e30b2be4 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Sun, 29 Sep 2019 18:57:35 -0400
Subject: [PATCH 217/228] Don't set the handles to binary mode.

---
 src/Semantic/Git.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Semantic/Git.hs b/src/Semantic/Git.hs
index 903023c52..954365184 100644
--- a/src/Semantic/Git.hs
+++ b/src/Semantic/Git.hs
@@ -22,7 +22,6 @@ import Data.Char
 import Data.Either            (fromRight)
 import Data.Text              as Text
 import Shelly                 hiding (FilePath)
-import System.IO              (hSetBinaryMode)
 
 -- | git clone --bare
 clone :: Text -> FilePath -> IO ()
@@ -39,7 +38,7 @@ lsTree :: FilePath -> OID -> IO [TreeEntry]
 lsTree gitDir (OID sha) = sh $ parseEntries <$> run "git" ["-C", pack gitDir, "ls-tree", "-rz", sha]
 
 sh :: MonadIO m => Sh a -> m a
-sh = shelly . silently . onCommandHandles (initOutputHandles (`hSetBinaryMode` True))
+sh = shelly . silently
 
 -- | Parses an list of entries separated by \NUL, and on failure return []
 parseEntries :: Text -> [TreeEntry]

From bd7feb1378bed042bcece2d11aa2dca30b423a6a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 30 Sep 2019 12:06:25 -0400
Subject: [PATCH 218/228] Run a reader around the parseTermBuilder calls.

---
 test/Semantic/Spec.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/test/Semantic/Spec.hs b/test/Semantic/Spec.hs
index a73c7233e..e2e4252e2 100644
--- a/test/Semantic/Spec.hs
+++ b/test/Semantic/Spec.hs
@@ -1,5 +1,6 @@
 module Semantic.Spec (spec) where
 
+import Control.Effect.Reader
 import Control.Exception (fromException)
 import SpecHelpers
 
@@ -15,17 +16,17 @@ spec :: Spec
 spec = do
   describe "parseBlob" $ do
     it "returns error if given an unknown language (json)" $ do
-      output <- fmap runBuilder . runTaskOrDie $ parseTermBuilder TermJSONTree [ setBlobLanguage Unknown methodsBlob ]
+      output <- fmap runBuilder . runTaskOrDie . runReader (PerLanguageModes ALaCarte) $ parseTermBuilder TermJSONTree [ setBlobLanguage Unknown methodsBlob ]
       output `shouldBe` "{\"trees\":[{\"path\":\"methods.rb\",\"error\":\"NoLanguageForBlob \\\"methods.rb\\\"\",\"language\":\"Unknown\"}]}\n"
 
     it "throws if given an unknown language for sexpression output" $ do
-      res <- runTaskWithOptions defaultOptions (parseTermBuilder TermSExpression [setBlobLanguage Unknown methodsBlob])
+      res <- runTaskWithOptions defaultOptions (runReader (PerLanguageModes ALaCarte) (parseTermBuilder TermSExpression [setBlobLanguage Unknown methodsBlob]))
       case res of
         Left exc    -> fromException exc `shouldBe` Just (NoLanguageForBlob "methods.rb")
         Right _bad  -> fail "Expected parseTermBuilder to fail for an unknown language"
 
     it "renders with the specified renderer" $ do
-      output <- fmap runBuilder . runTaskOrDie $ parseTermBuilder TermSExpression [methodsBlob]
+      output <- fmap runBuilder . runTaskOrDie . runReader (PerLanguageModes ALaCarte) $ parseTermBuilder TermSExpression [methodsBlob]
       output `shouldBe` "(Statements\n  (Method\n    (Empty)\n    (Identifier)\n    (Statements)))\n"
 
   describe "git ls-tree parsing" $ do

From b2eee4985e94a0fdd445e193333ff4a18464e4a1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 30 Sep 2019 12:10:59 -0400
Subject: [PATCH 219/228] Run the reader around the parse fixtures.

---
 test/Semantic/CLI/Spec.hs | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs
index 1c9f09c25..d910348b7 100644
--- a/test/Semantic/CLI/Spec.hs
+++ b/test/Semantic/CLI/Spec.hs
@@ -1,5 +1,6 @@
 module Semantic.CLI.Spec (testTree) where
 
+import           Control.Effect.Reader
 import           Data.ByteString.Builder
 import           Semantic.Api hiding (Blob, BlobPair, File)
 import           Semantic.Task
@@ -50,17 +51,18 @@ testForParseFixture (format, runParse, files, expected) =
 
 parseFixtures :: [(String, [Blob] -> TaskEff Builder, [File], Path.RelFile)]
 parseFixtures =
-  [ ("s-expression", parseTermBuilder TermSExpression, path, Path.relFile "test/fixtures/ruby/corpus/and-or.parseA.txt")
-  , ("json", parseTermBuilder TermJSONTree, path, prefix </> Path.file "parse-tree.json")
-  , ("json", parseTermBuilder TermJSONTree, path', prefix </> Path.file "parse-trees.json")
-  , ("json", parseTermBuilder TermJSONTree, [], prefix </> Path.file "parse-tree-empty.json")
-  , ("symbols", parseSymbolsBuilder Serializing.Format.JSON, path'', prefix </> Path.file "parse-tree.symbols.json")
-  , ("protobuf symbols", parseSymbolsBuilder Serializing.Format.Proto, path'', prefix </> Path.file "parse-tree.symbols.protobuf.bin")
+  [ ("s-expression", run . parseTermBuilder TermSExpression, path, Path.relFile "test/fixtures/ruby/corpus/and-or.parseA.txt")
+  , ("json", run . parseTermBuilder TermJSONTree, path, prefix </> Path.file "parse-tree.json")
+  , ("json", run . parseTermBuilder TermJSONTree, path', prefix </> Path.file "parse-trees.json")
+  , ("json", run . parseTermBuilder TermJSONTree, [], prefix </> Path.file "parse-tree-empty.json")
+  , ("symbols", run . parseSymbolsBuilder Serializing.Format.JSON, path'', prefix </> Path.file "parse-tree.symbols.json")
+  , ("protobuf symbols", run . parseSymbolsBuilder Serializing.Format.Proto, path'', prefix </> Path.file "parse-tree.symbols.protobuf.bin")
   ]
   where path = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby]
         path' = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby, File "test/fixtures/ruby/corpus/and-or.B.rb" Ruby]
         path'' = [File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby]
         prefix = Path.relDir "test/fixtures/cli"
+        run = runReader (PerLanguageModes ALaCarte)
 
 diffFixtures :: [(String, [BlobPair] -> TaskEff Builder, [Both File], Path.RelFile)]
 diffFixtures =

From f7c4658ee699025695114afc336d5a7dc3f7fb7f Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 30 Sep 2019 12:18:06 -0400
Subject: [PATCH 220/228] Use a Stack so we can do a right fold over the
 assignments.

---
 semantic-python/src/Language/Python/Core.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 8470b97f9..444a1fca7 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -151,13 +151,13 @@ data Located a = Located Loc a
 -- returning a terminal expression. We have to keep track of which
 desugar :: (Member (Reader SourcePath) sig, Carrier sig m, MonadFail m)
         => RHS Span
-        -> m ([Located Name], Desugared Span)
+        -> m ((Stack (Located Name)), Desugared Span)
 desugar = \case
   Left Py.Assignment { left = OneExpression name, right = Just rhs, ann} -> do
     loc <- locFromTSSpan <$> ask <*> pure ann
-    let cons = (Located loc name :)
+    let cons = (Stack.:> Located loc name)
     fmap (first cons) (desugar rhs)
-  Right (Right any) -> pure ([], any)
+  Right (Right any) -> pure (Stack.Nil, any)
   other -> fail ("desugar: couldn't desugar RHS " <> show other)
 
 -- This is a fold function that is invoked from a left fold but that
@@ -168,11 +168,11 @@ desugar = \case
 -- sugar", like "icing" or "sugar water" but I'll leave that as an
 -- exercise to the reader.
 collapseDesugared :: (CoreSyntax syn t, Member (Reader Bindings) sig, Carrier sig m)
-                  => (t Name -> m (t Name)) -- A meta-continuation: it takes a name and returns a continuation
-                  -> Located Name           -- The current LHS to which to assign
+                  => Located Name           -- The current LHS to which to assign
+                  -> (t Name -> m (t Name)) -- A meta-continuation: it takes a name and returns a continuation
                   -> t Name                 -- The current RHS to which to assign, yielded from an outer continuation
                   -> m (t Name)             -- The properly-sequenced resolut
-collapseDesugared cont (Located loc n) rem =
+collapseDesugared (Located loc n) cont rem =
   let assigning = fmap (Core.annAt loc . ((Name.named' n :<- rem) >>>=))
   in assigning (local (def n) (cont (pure n))) -- gotta call local here to record this assignment
 
@@ -184,8 +184,8 @@ instance Compile (Py.Assignment Span) where
     } cc = do
     p <- ask @SourcePath
     (names, val) <- desugar rhs
-    let allNames = Located (locFromTSSpan p ann) name : names
-    compile val >>= foldl' collapseDesugared (const cc) allNames >>= locate it
+    let allNames = names Stack.:> Located (locFromTSSpan p ann) name
+    compile val >>= foldr collapseDesugared (const cc) allNames >>= locate it
 
   compileCC other _ = fail ("Unhandled assignment case: " <> show other)
 

From 696d2fc786f2ad4983c01b4230ca0b6797b071f1 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 30 Sep 2019 12:32:28 -0400
Subject: [PATCH 221/228] Make desugar tail-recur (and we don't need a Stack).

---
 semantic-python/src/Language/Python/Core.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 444a1fca7..a2aea2528 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -150,14 +150,15 @@ data Located a = Located Loc a
 -- assignment, storing the names we encounter as we go and eventually
 -- returning a terminal expression. We have to keep track of which
 desugar :: (Member (Reader SourcePath) sig, Carrier sig m, MonadFail m)
-        => RHS Span
-        -> m ((Stack (Located Name)), Desugared Span)
-desugar = \case
+        => [Located Name]
+        -> RHS Span
+        -> m ([Located Name], Desugared Span)
+desugar acc = \case
   Left Py.Assignment { left = OneExpression name, right = Just rhs, ann} -> do
     loc <- locFromTSSpan <$> ask <*> pure ann
-    let cons = (Stack.:> Located loc name)
-    fmap (first cons) (desugar rhs)
-  Right (Right any) -> pure (Stack.Nil, any)
+    let cons = (Located loc name :)
+    desugar (cons acc) rhs
+  Right (Right any) -> pure (acc, any)
   other -> fail ("desugar: couldn't desugar RHS " <> show other)
 
 -- This is a fold function that is invoked from a left fold but that
@@ -183,9 +184,8 @@ instance Compile (Py.Assignment Span) where
     , ann
     } cc = do
     p <- ask @SourcePath
-    (names, val) <- desugar rhs
-    let allNames = names Stack.:> Located (locFromTSSpan p ann) name
-    compile val >>= foldr collapseDesugared (const cc) allNames >>= locate it
+    (names, val) <- desugar [Located (locFromTSSpan p ann) name] rhs
+    compile val >>= foldr collapseDesugared (const cc) names >>= locate it
 
   compileCC other _ = fail ("Unhandled assignment case: " <> show other)
 

From b3b1c8d016cb0101674d95b588cb5f4a961f4eb5 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 30 Sep 2019 12:35:38 -0400
Subject: [PATCH 222/228] Typo in comment.

---
 semantic-python/src/Language/Python/Core.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index a2aea2528..99cf32f9b 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -46,12 +46,12 @@ newtype Bindings = Bindings { unBindings :: Stack Name }
 def :: Name -> Bindings -> Bindings
 def n = coerce (Stack.:> n)
 
--- Useful pattern synonym for extracting a single identifier from
+-- | Useful pattern synonym for extracting a single identifier from
 -- a Python ExpressionList. Easier than pattern-matching every time.
 -- TODO: when this is finished, we won't need this pattern, as we'll
 -- handle ExpressionLists the smart way every time.
-pattern OneExpression :: Name -> Py.ExpressionList a
-pattern OneExpression name <- Py.ExpressionList
+pattern SingleIdentifier :: Name -> Py.ExpressionList a
+pattern SingleIdentifier name <- Py.ExpressionList
   { Py.extraChildren =
     [ Py.PrimaryExpressionExpression (Py.IdentifierPrimaryExpression (Py.Identifier { bytes = name }))
     ]
@@ -125,7 +125,7 @@ instance Compile (Py.Attribute Span)
 
 -- Assignment compilation. Assignments are an uneasy hybrid of expressions
 -- (since they appear to have values, i.e. `a = b = c`) and statements (because
--- they introduce bindings. For that reason, they deserve special attention.
+-- they introduce bindings). For that reason, they deserve special attention.
 --
 -- The correct desugaring for the expression above looks like, given a continuation @cont@:
 -- @
@@ -154,7 +154,7 @@ desugar :: (Member (Reader SourcePath) sig, Carrier sig m, MonadFail m)
         -> RHS Span
         -> m ([Located Name], Desugared Span)
 desugar acc = \case
-  Left Py.Assignment { left = OneExpression name, right = Just rhs, ann} -> do
+  Left Py.Assignment { left = SingleIdentifier name, right = Just rhs, ann} -> do
     loc <- locFromTSSpan <$> ask <*> pure ann
     let cons = (Located loc name :)
     desugar (cons acc) rhs
@@ -179,7 +179,7 @@ collapseDesugared (Located loc n) cont rem =
 
 instance Compile (Py.Assignment Span) where
   compileCC it@Py.Assignment
-    { left = OneExpression name
+    { left = SingleIdentifier name
     , right = Just rhs
     , ann
     } cc = do

From 0671bffef3f3215e25dfe510aa962fe348a3876d Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 30 Sep 2019 12:36:53 -0400
Subject: [PATCH 223/228] More Haddocks.

---
 semantic-python/src/Language/Python/Core.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 99cf32f9b..fcaae7477 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -31,14 +31,14 @@ import qualified TreeSitter.Python.AST as Py
 import           TreeSitter.Span (Span)
 import qualified TreeSitter.Span as TreeSitter
 
--- Access to the current filename as Text to stick into location annotations.
+-- | Access to the current filename as Text to stick into location annotations.
 newtype SourcePath = SourcePath { rawPath :: Text }
   deriving stock (Eq, Show)
   deriving newtype IsString
 
--- Keeps track of the current scope's bindings (so that we can, when
--- compiling a class or module, return the list of bound variables
--- as a Core record so that all immediate definitions are exposed)
+-- | Keeps track of the current scope's bindings (so that we can, when
+-- compiling a class or module, return the list of bound variables as
+-- a Core record so that all immediate definitions are exposed)
 newtype Bindings = Bindings { unBindings :: Stack Name }
   deriving stock (Eq, Show)
   deriving newtype (Semigroup, Monoid)

From b58e10313d2915d543611a9dcf634a827b86f53a Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 30 Sep 2019 12:39:45 -0400
Subject: [PATCH 224/228] Use the technical term.

---
 semantic-python/src/Language/Python/Core.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index fcaae7477..e7e48ab0d 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -161,7 +161,7 @@ desugar acc = \case
   Right (Right any) -> pure (acc, any)
   other -> fail ("desugar: couldn't desugar RHS " <> show other)
 
--- This is a fold function that is invoked from a left fold but that
+-- This is an algebra that is invoked from a left fold but that
 -- returns a function (the 'difference' pattern) so that we can pass
 -- information about what RHS we need down the chain: unlike most fold
 -- functions, it has four parameters, not three (since our fold

From 9d889e9ca853f1dee960d4fa7429c7f045e9bee3 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 30 Sep 2019 13:08:09 -0400
Subject: [PATCH 225/228] Add a test for catFile such that we ensure UTF-8
 output isn't mangled.

---
 test/Semantic/IO/Spec.hs | 50 +++++++++++++++++++++++++---------------
 1 file changed, 32 insertions(+), 18 deletions(-)

diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs
index ee1ecf219..35ccc66c5 100644
--- a/test/Semantic/IO/Spec.hs
+++ b/test/Semantic/IO/Spec.hs
@@ -1,20 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Semantic.IO.Spec (spec) where
 
 import Prelude hiding (readFile)
 
-import Control.Monad.IO.Class
-import Data.List
-import System.Directory
-import System.IO.Temp
-import Data.String
+import           Control.Monad.IO.Class
+import           Data.List
+import           Data.String
+import qualified Data.Text as Text
+import           System.Directory
+import           System.IO.Temp
 
-import Data.Blob
-import Data.Handle
-import SpecHelpers hiding (readFile)
+import           Data.Blob
+import           Data.Handle
 import qualified Semantic.Git as Git
-import Shelly (shelly, silently, cd, run_)
+import           Shelly (cd, run_, shelly, silently, touchfile, writefile)
+import           SpecHelpers hiding (readFile)
+import           System.Path ((</>))
 import qualified System.Path as Path
-import System.Path ((</>))
 
 
 makeGitRepo :: FilePath -> IO ()
@@ -22,14 +25,25 @@ makeGitRepo dir = shelly . silently $ do
   cd (fromString dir)
   let git = run_ "git"
   git ["init"]
-  run_ "touch" ["日本語.py", "bar.rb"]
-  git ["add", "日本語.py", "bar.rb"]
+  touchfile "bar.py"
+  writefile "日本語.rb" "# coding: utf-8\n日本語 = 'hello'"
+  git ["add", "日本語.rb", "bar.py"]
   git ["config", "user.name", "'Test'"]
   git ["config", "user.email", "'test@test.test'"]
   git ["commit", "-am", "'test commit'"]
 
 spec :: Spec
 spec = do
+  describe "catFile" $ do
+    hasGit <- runIO $ isJust <$> findExecutable "git"
+    when hasGit . it "should not corrupt the output of files with UTF-8 identifiers" $ do
+      result <- liftIO . withSystemTempDirectory "semantic-temp-git-repo" $ \dir -> do
+        makeGitRepo dir
+        trees <- Git.lsTree (dir <> "/.git") (Git.OID "HEAD")
+        Just it <- pure $ find (\p -> "日本語" `isInfixOf` Git.treeEntryPath p) trees
+        Git.catFile (dir <> "/.git") (Git.treeEntryOid it)
+      ("日本語" `Text.isInfixOf` result) `shouldBe` True
+
   describe "lsTree" $ do
     hasGit <- runIO $ isJust <$> findExecutable "git"
     when hasGit . it "should read all tree entries from a repo" $ do
@@ -47,8 +61,8 @@ spec = do
         makeGitRepo dir
         readBlobsFromGitRepoPath (Path.absDir dir </> Path.relDir ".git") (Git.OID "HEAD") [] []
       let files = sortOn fileLanguage (blobFile <$> blobs)
-      files `shouldBe` [ File "日本語.py" Python
-                       , File "bar.rb" Ruby
+      files `shouldBe` [ File "bar.py" Python
+                       , File "日本語.rb" Ruby
                        ]
 
     when hasGit . it "should read from a git directory with --only" $ do
@@ -56,18 +70,18 @@ spec = do
       blobs <- liftIO . withSystemTempDirectory "semantic-temp-git-repo" $ \dir -> do
         let pdir = Path.absDir dir
         makeGitRepo dir
-        readBlobsFromGitRepoPath (pdir </> Path.relDir ".git") (Git.OID "HEAD") [] [Path.relFile "日本語.py"]
+        readBlobsFromGitRepoPath (pdir </> Path.relDir ".git") (Git.OID "HEAD") [] [Path.relFile "日本語.rb"]
       let files = sortOn fileLanguage (blobFile <$> blobs)
-      files `shouldBe` [ File "日本語.py" Python ]
+      files `shouldBe` [ File "日本語.rb" Ruby ]
 
     when hasGit . it "should read from a git directory with --exclude" $ do
       -- This temporary directory will be cleaned after use.
       blobs <- liftIO . withSystemTempDirectory "semantic-temp-git-repo" $ \dir -> do
         makeGitRepo dir
 
-        readBlobsFromGitRepoPath (Path.absDir dir </> Path.relDir ".git") (Git.OID "HEAD") [Path.relFile "日本語.py"] []
+        readBlobsFromGitRepoPath (Path.absDir dir </> Path.relDir ".git") (Git.OID "HEAD") [Path.relFile "日本語.rb"] []
       let files = sortOn fileLanguage (blobFile <$> blobs)
-      files `shouldBe` [ File "bar.rb" Ruby ]
+      files `shouldBe` [ File "bar.py" Python ]
 
   describe "readFile" $ do
     it "returns a blob for extant files" $ do

From 7b13638ae33d2f53c57e133752a782ec5cfcaf77 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 30 Sep 2019 13:18:39 -0400
Subject: [PATCH 226/228] Add a test for tagging files containing multibyte
 characters.

---
 test/Tags/Spec.hs                              | 5 +++++
 test/fixtures/ruby/tags/unicode_identifiers.rb | 4 ++++
 2 files changed, 9 insertions(+)
 create mode 100644 test/fixtures/ruby/tags/unicode_identifiers.rb

diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs
index ff3c11029..06debdb37 100644
--- a/test/Tags/Spec.hs
+++ b/test/Tags/Spec.hs
@@ -85,6 +85,11 @@ spec = do
       runTagging blob symbolsToSummarize tree `shouldBe`
         [ Tag "foo" "Method" (Span (Pos 2 1) (Pos 3 4)) ["Statements"] (Just "def foo") (Just "# Public: foo") ]
 
+    it "correctly tags files containing multibyte UTF-8 characters" $ do
+      (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/unicode_identifiers.rb")
+      runTagging blob symbolsToSummarize tree `shouldBe`
+        [ Tag "日本語" "Method" (Span (Pos 2 1) (Pos 4 4)) ["Statements"] (Just "def 日本語") (Just "# coding: utf-8")]
+
     it "produces tags for methods and classes with docs" $ do
       (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/class_module.rb")
       runTagging blob symbolsToSummarize tree `shouldBe`
diff --git a/test/fixtures/ruby/tags/unicode_identifiers.rb b/test/fixtures/ruby/tags/unicode_identifiers.rb
new file mode 100644
index 000000000..50a42b0a0
--- /dev/null
+++ b/test/fixtures/ruby/tags/unicode_identifiers.rb
@@ -0,0 +1,4 @@
+# coding: utf-8
+def 日本語
+  "hello"
+end

From fb1e99e6a7bc856dff6f458b820fd95f46f81eb1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 30 Sep 2019 14:03:46 -0400
Subject: [PATCH 227/228] :memo: the Send/Call thing.

---
 src/Tags/Tagging.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs
index 8fca7a299..71127736a 100644
--- a/src/Tags/Tagging.hs
+++ b/src/Tags/Tagging.hs
@@ -41,7 +41,7 @@ runTagging blob symbolsToSummarize
         "Class"    -> Just Class
         "Module"   -> Just Module
         "Call"     -> Just Call
-        "Send"     -> Just Call
+        "Send"     -> Just Call -- Ruby’s Send is considered to be a kind of 'Call'
         _          -> Nothing
 
 type ContextToken = (Text, Range)

From 37579d80a9907acbcc02255a9c40f0861c3c625c Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 30 Sep 2019 16:00:44 -0400
Subject: [PATCH 228/228] Fix unit tests.

---
 test/Tags/Spec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs
index dbc90cc9d..90c235805 100644
--- a/test/Tags/Spec.hs
+++ b/test/Tags/Spec.hs
@@ -88,7 +88,7 @@ spec = do
     it "correctly tags files containing multibyte UTF-8 characters" $ do
       (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/unicode_identifiers.rb")
       runTagging blob symbolsToSummarize tree `shouldBe`
-        [ Tag "日本語" "Method" (Span (Pos 2 1) (Pos 4 4)) ["Statements"] (Just "def 日本語") (Just "# coding: utf-8")]
+        [ Tag "日本語" Method (Span (Pos 2 1) (Pos 4 4)) "def 日本語" (Just "# coding: utf-8")]
 
     it "produces tags for methods and classes with docs" $ do
       (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/class_module.rb")