packages feed

fast-tags 1.1.0 → 1.1.1

raw patch · 5 files changed

+55/−14 lines, 5 files

Files

changelog.md view
@@ -1,3 +1,7 @@+1.1.1:++* fix 'format' output for vim+ 1.1:  * Decode UTF8 leniently, so non-UTF8 will no longer cause a crash.  Removed
fast-tags.cabal view
@@ -1,5 +1,5 @@ name: fast-tags-version: 1.1.0+version: 1.1.1 cabal-version: >= 1.8 build-type: Simple synopsis: Fast incremental vi and emacs tags.
src/FastTags.hs view
@@ -293,7 +293,7 @@     -- Safe because of null check above.     Just (c, cs) = T.uncons text     comments = ["{-", "-}"]-    symbols = ["--", "=>", "->", "::"]+    symbols = ["--", "=>", "->", "::", "⇒", "→", "∷"]  tokenizeLine :: Bool -> Text -> [TokenVal] tokenizeLine trackPrefixes text = Newline nspaces : go spaces line@@ -558,7 +558,7 @@ foreignTags :: [Token] -> [Tag] foreignTags decl = case decl of     Pos _ (Token _ "import") : decl'-        | name : _ <- dropBefore ((=="::") . tokenName . valOf) decl' ->+        | name : _ <- dropBefore ((\x -> x == "::" || x == "∷") . tokenName . valOf) decl' ->             [tokToTag name Pattern]     _ -> [] @@ -585,7 +585,7 @@     go toks@(Pos _ (Token _ "(") : _) = go $ stripBalancedParens toks     go (Pos pos (Token prefix name) : ts)         -- this function does not analyze type signatures-        | name == "::" = []+        | name == "::" || name == "∷" = []         | name == "!" || name == "~" || name == "@" = go ts         | name == "=" || name == "|" = case stripParens toks of             Pos pos (Token prefix name) : _@@ -614,10 +614,11 @@     funcTag = if constructors then Constructor else Function     go :: [Tag] -> [Token] -> ([Tag], [Token])     go tags (Pos _ (Token _ "(") : Pos pos (Token _ name)-            : Pos _ (Token prefix ")") : Pos _ (Token _ "::") : rest) =-        (reverse $ mkTag pos prefix name opTag : tags, rest)-    go tags (Pos pos (Token prefix name) : Pos _ (Token _ "::") : rest)-        | functionName constructors name =+            : Pos _ (Token prefix ")") : Pos _ (Token _ colon) : rest)+        | elem colon doubleColonTokens =+            (reverse $ mkTag pos prefix name opTag : tags, rest)+    go tags (Pos pos (Token prefix name) : Pos _ (Token _ colon) : rest)+        | elem colon doubleColonTokens && functionName constructors name =             (reverse $ mkTag pos prefix name funcTag : tags, rest)     go tags (Pos _ (Token _ "(") : Pos pos (Token _ name)             : Pos _ (Token prefix ")") : Pos _ (Token _ ",") : rest) =@@ -723,18 +724,26 @@ stripOptForall (Pos _ (Token _ "forall") : rest) = dropUntil "." rest stripOptForall xs                               = xs +doubleColonTokens :: [Text]+doubleColonTokens = ["::", "∷"]++impliesTokens :: [Text]+impliesTokens = ["=>", "⇒"]+ stripParensKindsTypeVars :: [Token] -> [Token] stripParensKindsTypeVars (Pos _ (Token _ "(") : xs)  =     stripParensKindsTypeVars xs-stripParensKindsTypeVars (Pos _ (Token _ "::") : xs) =-    stripParensKindsTypeVars $ tail $ dropWithStrippingBalanced (/= ")") xs stripParensKindsTypeVars (Pos _ (Token _ name) : xs)+    | elem name doubleColonTokens =+        stripParensKindsTypeVars $ tail $ dropWithStrippingBalanced (/= ")") xs     | isTypeVarStart name = stripParensKindsTypeVars xs stripParensKindsTypeVars xs = xs  stripOptContext :: [Token] -> [Token]-stripOptContext (stripBalancedParens -> (Pos _ (Token _ "=>") : xs)) = xs-stripOptContext (stripSingleClassContext -> Pos _ (Token _ "=>") : xs) = xs+stripOptContext (stripBalancedParens -> (Pos _ (Token _ implies) : xs))+  | elem implies impliesTokens = xs+stripOptContext (stripSingleClassContext -> Pos _ (Token _ implies) : xs)+  | elem implies impliesTokens = xs stripOptContext xs = xs  stripSingleClassContext :: [Token] -> [Token]@@ -802,7 +811,7 @@ instanceTags prevPos unstripped =     -- instances can offer nothing but some fresh data constructors since     -- the actual datatype is really declared in the class declaration-    concatMap (newtypeTags prevPos . unstrippedTokensOf)+    concatMap (newtypeTags prevPos . stripNewlines)         (filter isNewtypeDecl block)     ++ concatMap (dataConstructorTags prevPos)         (filter isDataDecl block)
src/Main.hs view
@@ -214,7 +214,7 @@ showTag (Pos (SrcPos fn lineno) (TagVal _ text typ)) = Text.concat     [ text, "\t"     , Text.pack fn, "\t"-    , Text.pack (show lineno), " ;\" "+    , Text.pack (show lineno), ";\"\t"     , Text.singleton (showType typ)     ]
tests/MainTest.hs view
@@ -38,6 +38,7 @@ testTokenize :: TestTree testTokenize = testGroup "tokenize"   [ "a::b->c"           ==> ["a", "::", "b", "->", "c"]+  , "a∷b→c"             ==> ["a", "∷", "b", "→", "c"]   , "x{-\n  bc#-}\n"    ==> ["x", "{-", "nl 2", "bc#", "-}"]   , "X.Y"               ==> ["X.Y"]   , "x9"                ==> ["x9"]@@ -187,6 +188,7 @@   -- Records.   , "data Foo a = Bar { field :: Field }" ==> ["Bar", "Foo", "field"]   , "data R = R { a::X, b::Y }"           ==> ["R", "R", "a", "b"]+  , "data R = R { a∷X, b∷Y }"             ==> ["R", "R", "a", "b"]   , "data R = R {\n\ta::X\n\t, b::Y\n\t}" ==> ["R", "R", "a", "b"]   , "data R = R {\n\ta,b::X\n\t}"         ==> ["R", "R", "a", "b"] @@ -267,10 +269,12 @@   , "newtype (Eq (v z)) => ((u :: (* -> *) -> *) `Foo` v) z = X"      ==> ["Foo", "X"]   , "data (Eq (v z)) => ((u :: (* -> *) -> *) `Foo` v) z = X"         ==> ["Foo", "X"]   , "type (Eq (v z)) => ((u :: (* -> *) -> *) `Foo` v) z = (u, v, z)" ==> ["Foo"]+  , "type (Eq (v z)) => ((u ∷ (* -> *) -> *) `Foo` v) z = (u, v, z)"  ==> ["Foo"]    , "newtype Eq (v z) => ((u :: (* -> *) -> *) `Foo` v) z = X"      ==> ["Foo", "X"]   , "data Eq (v z) => ((u :: (* -> *) -> *) `Foo` v) z = X"         ==> ["Foo", "X"]   , "type Eq (v z) => ((u :: (* -> *) -> *) `Foo` v) z = (u, v, z)" ==> ["Foo"]+  , "type Eq (v z) ⇒ ((u ∷ (* → *) → *) `Foo` v) z = (u, v, z)"     ==> ["Foo"]    , "data (:*:) u v z = X"                        ==> [":*:", "X"]   , "data (Eq (u v), Ord (z)) => (:*:) u v z = X" ==> [":*:", "X"]@@ -309,6 +313,9 @@   , "data Hadron a b = forall x y. Science { f :: [(Box x, Map x y)], h :: b }"     ==>     ["Hadron", "Science", "f", "h"]+  , "data Hadron a b = forall x y. Science { f ∷ [(Box x, Map x y)], h ∷ b }"+    ==>+    ["Hadron", "Science", "f", "h"]   , "data Hadron a b = forall x y z. Science\n\     \  { f :: x\n\     \  , g :: [(Box x, Map x y, z)] \@@ -349,6 +356,10 @@     \  A, B :: Int -> Int -> X\n"     ==>     ["A", "B", "X"]+  , "data X ∷ * → * → * where\n\+    \  A, B ∷ Int → Int → X\n"+    ==>+    ["A", "B", "X"]   , "data Vec ix where\n\     \  Nil   :: Int -> Foo Int\n\     \  (:::) :: Int -> Vec Int -> Vec Int\n\@@ -384,6 +395,7 @@   , "type family (a :: Nat) :<: (b :: Nat) :: Nat\n"      ==> [":<:"]   , "type family (a :: Nat) `Family` (b :: Nat) :: Nat\n" ==> ["Family"]   , "type family (m :: Nat) <=? (n :: Nat) :: Bool"       ==> ["<=?"]+  , "type family (m ∷ Nat) <=? (n ∷ Nat) ∷ Bool"          ==> ["<=?"]    , "data instance X a b = Y a | Z { unZ :: b }"                  ==> ["Y", "Z", "unZ"]   , "data instance (Eq a, Eq b) => X a b = Y a | Z { unZ :: b }"  ==> ["Y", "Z", "unZ"]@@ -396,6 +408,8 @@     ["G1", "G2"]   , "class C where\n\ttype X y :: *\n" ==> ["C", "X"]   , "class C where\n\tdata X y :: *\n" ==> ["C", "X"]+  , "class C where\n\ttype X y ∷ *\n"  ==> ["C", "X"]+  , "class C where\n\tdata X y ∷ *\n"  ==> ["C", "X"]   ]   where     (==>) = test process@@ -517,6 +531,9 @@ testClass :: TestTree testClass = testGroup "class"   [ "class (X x) => C a b where\n\tm :: a->b\n\tn :: c\n" ==> ["C", "m", "n"]+  , "class (X x) ⇒ C a b where\n\tm ∷ a→b\n\tn ∷ c\n" ==> ["C", "m", "n"]+  , "class (X x) => C a b | a -> b where\n\tm :: a->b\n\tn :: c\n" ==> ["C", "m", "n"]+  , "class (X x) ⇒ C a b | a → b where\n\tm ∷ a→b\n\tn ∷ c\n" ==> ["C", "m", "n"]   , "class A a where f :: X\n"                            ==> ["A", "f"]     -- indented inside where   , "class X where\n\ta, (+) :: X\n"            ==> ["+", "X", "a"]@@ -531,6 +548,7 @@   --   ==>   --   [":<:", "f"]   , "class (a :<<<: b) => a :<: b where\n    f :: a -> b"   ==> [":<:", "f"]+  , "class (a :<<<: b) ⇒ a :<: b where\n    f ∷ a → b"   ==> [":<:", "f"]   , "class (Eq a, Ord b) => a :<: b where\n    f :: a -> b" ==> [":<:", "f"]   , "class (Eq a, Ord b) => (a :: (* -> *) -> *) :<: b where\n    f :: a -> b"     ==>@@ -600,6 +618,16 @@     \  newtype Bar Quux a = QBar { frob :: a }"     ==>     ["QBar", "frob"]+  , "instance (Monoid w,MonadBaseControl b m) => MonadBaseControl b (JournalT w m) where\n\+    \   newtype StM (JournalT w m) a =\n\+    \       StMJournal { unStMJournal :: ComposeSt (JournalT w) m a }\n\+    \   liftBaseWith = defaultLiftBaseWith StMJournal\n\+    \   restoreM     = defaultRestoreM   unStMJournal\n\+    \   {-# INLINE liftBaseWith #-}\n\+    \   {-# INLINE restoreM #-}\n\+    \"+    ==>+    ["StMJournal", "unStMJournal"]   ]   where     (==>) = test process