From d44fc5b2b40e26e76d2fe7ac0a47bea84154cf67 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Sun, 28 Jun 2015 00:00:33 +0200 Subject: Setup HSpec framework for Haddock API package. --- .../test/Haddock/Backends/Hyperlinker/ParserSpec.hs | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs (limited to 'haddock-api/test/Haddock/Backends/Hyperlinker') diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs new file mode 100644 index 00000000..c85fa47e --- /dev/null +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -0,0 +1,17 @@ +module Haddock.Backends.Hyperlinker.ParserSpec (main, spec) where + + +import Test.Hspec + +import Haddock.Backends.Hyperlinker.Parser + + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "parse" parseSpec + +parseSpec :: Spec +parseSpec = return () -- cgit v1.2.3 From f3d1f3cbd6e99f5d477a78e05c13b65b9e8b3fae Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Sun, 28 Jun 2015 00:49:17 +0200 Subject: Add basic tests related to comment parsing. --- .../src/Haddock/Backends/Hyperlinker/Parser.hs | 2 +- .../Haddock/Backends/Hyperlinker/ParserSpec.hs | 37 +++++++++++++++++++++- 2 files changed, 37 insertions(+), 2 deletions(-) (limited to 'haddock-api/test/Haddock/Backends/Hyperlinker') diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index bab5ba0a..019075a1 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -38,7 +38,7 @@ data TokenType | TkCpp | TkPragma | TkUnknown - deriving (Eq) + deriving (Show, Eq) -- | Turn source code string into a stream of more descriptive tokens. -- diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs index c85fa47e..d5964224 100644 --- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -9,9 +9,44 @@ import Haddock.Backends.Hyperlinker.Parser main :: IO () main = hspec spec + spec :: Spec spec = do describe "parse" parseSpec + parseSpec :: Spec -parseSpec = return () +parseSpec = do + + context "when parsing single-line comments" $ do + + it "should ignore content until the end of line" $ + "-- some very simple comment\nidentifier" + `shouldParseTo` + [TkComment, TkSpace, TkIdentifier] + + it "should allow endline escaping" $ + "-- first line\\\nsecond line\\\nand another one" + `shouldParseTo` + [TkComment] + + context "when parsing multi-line comments" $ do + + it "should support nested comments" $ + "{- comment {- nested -} still comment -} {- next comment -}" + `shouldParseTo` + [TkComment, TkSpace, TkComment] + + it "should distinguish compiler pragma" $ + "{- comment -}{-# LANGUAGE GADTs #-}{- comment -}" + `shouldParseTo` + [TkComment, TkPragma, TkComment] + + it "should recognize preprocessor directives" $ do + "\n#define foo bar" `shouldParseTo` [TkSpace, TkCpp] + "x # y" `shouldParseTo` + [TkIdentifier, TkSpace, TkCpp, TkSpace,TkIdentifier] + + +shouldParseTo :: String -> [TokenType] -> Expectation +str `shouldParseTo` tokens = map tkType (parse str) `shouldBe` tokens -- cgit v1.2.3 From 86ccbbf208fad2b27d2d76d9a32a80b452274d2e Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Sun, 28 Jun 2015 12:41:08 +0200 Subject: Add tests related to parsing basic language constructs. --- .../test/Haddock/Backends/Hyperlinker/ParserSpec.hs | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) (limited to 'haddock-api/test/Haddock/Backends/Hyperlinker') diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs index d5964224..fa880a37 100644 --- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -47,6 +47,26 @@ parseSpec = do "x # y" `shouldParseTo` [TkIdentifier, TkSpace, TkCpp, TkSpace,TkIdentifier] + it "should distinguish basic language constructs" $ do + "(* 2) <$> (\"abc\", foo)" `shouldParseTo` + [ TkSpecial, TkOperator, TkSpace, TkNumber, TkSpecial + , TkSpace, TkOperator, TkSpace + , TkSpecial, TkString, TkSpecial, TkSpace, TkIdentifier, TkSpecial + ] + "let foo' = foo in foo' + foo'" `shouldParseTo` + [ TkKeyword, TkSpace, TkIdentifier + , TkSpace, TkGlyph, TkSpace + , TkIdentifier, TkSpace, TkKeyword, TkSpace + , TkIdentifier, TkSpace, TkOperator, TkSpace, TkIdentifier + ] + "square x = y^2 where y = x" `shouldParseTo` + [ TkIdentifier, TkSpace, TkIdentifier + , TkSpace, TkGlyph, TkSpace + , TkIdentifier, TkOperator, TkNumber + , TkSpace, TkKeyword, TkSpace + , TkIdentifier, TkSpace, TkGlyph, TkSpace, TkIdentifier + ] + shouldParseTo :: String -> [TokenType] -> Expectation str `shouldParseTo` tokens = map tkType (parse str) `shouldBe` tokens -- cgit v1.2.3 From 2426a64771339efb4a776799d9bf593d6b8d09a3 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Sun, 28 Jun 2015 15:54:30 +0200 Subject: Add simple tests for do-notation parsing. --- .../test/Haddock/Backends/Hyperlinker/ParserSpec.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'haddock-api/test/Haddock/Backends/Hyperlinker') diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs index fa880a37..5e69b446 100644 --- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -67,6 +67,24 @@ parseSpec = do , TkIdentifier, TkSpace, TkGlyph, TkSpace, TkIdentifier ] + it "should parse do-notation syntax" $ do + "do { foo <- getLine; putStrLn foo }" `shouldParseTo` + [ TkKeyword, TkSpace, TkSpecial, TkSpace + , TkIdentifier, TkSpace, TkGlyph, TkSpace + , TkIdentifier, TkSpecial, TkSpace + , TkIdentifier, TkSpace, TkIdentifier, TkSpace, TkSpecial + ] + + unlines + [ "do" + , " foo <- getLine" + , " putStrLn foo" + ] `shouldParseTo` + [ TkKeyword, TkSpace, TkIdentifier + , TkSpace, TkGlyph, TkSpace, TkIdentifier, TkSpace + , TkIdentifier, TkSpace, TkIdentifier, TkSpace + ] + shouldParseTo :: String -> [TokenType] -> Expectation str `shouldParseTo` tokens = map tkType (parse str) `shouldBe` tokens -- cgit v1.2.3 From 5ddb425bbdc29efdd314ffc18db6c8e6c3609d24 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Sun, 28 Jun 2015 23:58:24 +0200 Subject: Add very simple QuickCheck properties for source parser spec. --- haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'haddock-api/test/Haddock/Backends/Hyperlinker') diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs index 5e69b446..38cdbc87 100644 --- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -2,6 +2,7 @@ module Haddock.Backends.Hyperlinker.ParserSpec (main, spec) where import Test.Hspec +import Test.QuickCheck import Haddock.Backends.Hyperlinker.Parser @@ -18,6 +19,12 @@ spec = do parseSpec :: Spec parseSpec = do + it "is total" $ + property $ \src -> length (parse src) `shouldSatisfy` (>= 0) + + it "retains file layout" $ + property $ \src -> concatMap tkValue (parse src) == src + context "when parsing single-line comments" $ do it "should ignore content until the end of line" $ -- cgit v1.2.3 From 257e0456854a0835bb9901b6d73c17f6f8d0d841 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Thu, 2 Jul 2015 17:18:12 +0200 Subject: Fix broken tests for parsing and hyperlinking hash operators. --- .../Haddock/Backends/Hyperlinker/ParserSpec.hs | 2 +- hypsrc-test/ref/src/Operators.html | 122 +++++++++++++++++++++ 2 files changed, 123 insertions(+), 1 deletion(-) (limited to 'haddock-api/test/Haddock/Backends/Hyperlinker') diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs index 38cdbc87..a76bdcdc 100644 --- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -52,7 +52,7 @@ parseSpec = do it "should recognize preprocessor directives" $ do "\n#define foo bar" `shouldParseTo` [TkSpace, TkCpp] "x # y" `shouldParseTo` - [TkIdentifier, TkSpace, TkCpp, TkSpace,TkIdentifier] + [TkIdentifier, TkSpace, TkOperator, TkSpace,TkIdentifier] it "should distinguish basic language constructs" $ do "(* 2) <$> (\"abc\", foo)" `shouldParseTo` diff --git a/hypsrc-test/ref/src/Operators.html b/hypsrc-test/ref/src/Operators.html index 9ed24ab9..beefda58 100644 --- a/hypsrc-test/ref/src/Operators.html +++ b/hypsrc-test/ref/src/Operators.html @@ -648,6 +648,128 @@ >) + + +(#.#) :: a -> b -> (c -> (a, b)) +a #.# b = const $ (a, b) Date: Mon, 6 Jul 2015 18:07:20 +0200 Subject: Fix bug with module name being hyperlinked to `Prelude`. --- haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 7 ++++--- haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs | 1 + 2 files changed, 5 insertions(+), 3 deletions(-) (limited to 'haddock-api/test/Haddock/Backends/Hyperlinker') diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index 28fdc3f5..71b73663 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -146,7 +146,7 @@ decls (group, _, _, _) = concatMap ($ group) -- import lists. imports :: GHC.RenamedSource -> DetailsMap imports src@(_, imps, _, _) = - everything (<|>) ie src ++ map (imp . GHC.unLoc) imps + everything (<|>) ie src ++ mapMaybe (imp . GHC.unLoc) imps where ie term = case cast term of (Just (GHC.IEVar v)) -> pure $ var v @@ -156,9 +156,10 @@ imports src@(_, imps, _, _) = _ -> empty typ (GHC.L sspan name) = (sspan, RtkType name) var (GHC.L sspan name) = (sspan, RtkVar name) - imp idecl = + imp idecl | not . GHC.ideclImplicit $ idecl = let (GHC.L sspan name) = GHC.ideclName idecl - in (sspan, RtkModule name) + in Just (sspan, RtkModule name) + imp _ = Nothing -- | Check whether token stream span matches GHC source span. -- diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs index a76bdcdc..8cd2690e 100644 --- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -5,6 +5,7 @@ import Test.Hspec import Test.QuickCheck import Haddock.Backends.Hyperlinker.Parser +import Haddock.Backends.Hyperlinker.Types main :: IO () -- cgit v1.2.3