diff options
Diffstat (limited to 'haddock-api/test')
| -rw-r--r-- | haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs | 49 |
1 files changed, 18 insertions, 31 deletions
diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs index ff18cb40..1273a45a 100644 --- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -5,8 +5,7 @@ import Test.Hspec import Test.QuickCheck import GHC ( runGhc, getSessionDynFlags ) -import DynFlags ( CompilerInfo, DynFlags ) -import SysTools.Info ( getCompilerInfo' ) +import DynFlags ( DynFlags ) import Control.Monad.IO.Class import Data.String ( fromString ) @@ -17,13 +16,12 @@ import Haddock (getGhcDirs) import Haddock.Backends.Hyperlinker.Parser import Haddock.Backends.Hyperlinker.Types -withDynFlags :: ((DynFlags, CompilerInfo) -> IO ()) -> IO () +withDynFlags :: (DynFlags -> IO ()) -> IO () withDynFlags cont = do libDir <- fmap snd (getGhcDirs []) runGhc (Just libDir) $ do dflags <- getSessionDynFlags - cinfo <- liftIO $ getCompilerInfo' dflags - liftIO $ cont (dflags, cinfo) + liftIO $ cont dflags main :: IO () @@ -60,60 +58,54 @@ instance Arbitrary NoGhcRewrite where parseSpec :: Spec parseSpec = around withDynFlags $ do - it "is total" $ \(dflags, cinfo) -> - property $ \src -> length (parse cinfo dflags "" (fromString src)) `shouldSatisfy` (>= 0) + it "is total" $ \dflags -> + property $ \src -> length (parse dflags "" (fromString src)) `shouldSatisfy` (>= 0) - it "retains file layout" $ \(dflags, cinfo) -> + it "retains file layout" $ \dflags -> property $ \(NoGhcRewrite src) -> let orig = fromString src - lexed = BS.concat (map tkValue (parse cinfo dflags "" orig)) + lexed = BS.concat (map tkValue (parse dflags "" orig)) in lexed == orig context "when parsing single-line comments" $ do - it "should ignore content until the end of line" $ \(dflags, cinfo) -> + it "should ignore content until the end of line" $ \dflags -> shouldParseTo "-- some very simple comment\nidentifier" [TkComment, TkSpace, TkIdentifier] - cinfo dflags - it "should allow endline escaping" $ \(dflags, cinfo) -> + it "should allow endline escaping" $ \dflags -> shouldParseTo "#define first line\\\nsecond line\\\nand another one" [TkCpp] - cinfo dflags context "when parsing multi-line comments" $ do - it "should support nested comments" $ \(dflags, cinfo) -> + it "should support nested comments" $ \dflags -> shouldParseTo "{- comment {- nested -} still comment -} {- next comment -}" [TkComment, TkSpace, TkComment] - cinfo dflags - it "should distinguish compiler pragma" $ \(dflags, cinfo) -> + it "should distinguish compiler pragma" $ \dflags -> shouldParseTo "{- comment -}{-# LANGUAGE GADTs #-}{- comment -}" [TkComment, TkPragma, TkComment] - cinfo dflags - it "should recognize preprocessor directives" $ \(dflags, cinfo) -> do + it "should recognize preprocessor directives" $ \dflags -> do shouldParseTo "\n#define foo bar" [TkCpp] - cinfo dflags shouldParseTo "x # y" [TkIdentifier, TkSpace, TkOperator, TkSpace,TkIdentifier] - cinfo dflags - it "should distinguish basic language constructs" $ \(dflags, cinfo) -> do + it "should distinguish basic language constructs" $ \dflags -> do shouldParseTo "(* 2) <$> (\"abc\", foo)" @@ -121,7 +113,6 @@ parseSpec = around withDynFlags $ do , TkSpace, TkOperator, TkSpace , TkSpecial, TkString, TkSpecial, TkSpace, TkIdentifier, TkSpecial ] - cinfo dflags shouldParseTo @@ -131,7 +122,6 @@ parseSpec = around withDynFlags $ do , TkIdentifier, TkSpace, TkKeyword, TkSpace , TkIdentifier, TkSpace, TkOperator, TkSpace, TkIdentifier ] - cinfo dflags shouldParseTo @@ -142,10 +132,9 @@ parseSpec = around withDynFlags $ do , TkSpace, TkKeyword, TkSpace , TkIdentifier, TkSpace, TkGlyph, TkSpace, TkIdentifier ] - cinfo dflags - it "should parse do-notation syntax" $ \(dflags, cinfo) -> do + it "should parse do-notation syntax" $ \dflags -> do shouldParseTo "do { foo <- getLine; putStrLn foo }" [ TkKeyword, TkSpace, TkSpecial, TkSpace @@ -153,7 +142,6 @@ parseSpec = around withDynFlags $ do , TkIdentifier, TkSpecial, TkSpace , TkIdentifier, TkSpace, TkIdentifier, TkSpace, TkSpecial ] - cinfo dflags shouldParseTo @@ -166,10 +154,9 @@ parseSpec = around withDynFlags $ do , TkSpace, TkGlyph, TkSpace, TkIdentifier, TkSpace , TkIdentifier, TkSpace, TkIdentifier, TkSpace ] - cinfo dflags where - shouldParseTo :: ByteString -> [TokenType] -> CompilerInfo -> DynFlags -> Expectation - shouldParseTo str tokens cinfo dflags = [ tkType tok - | tok <- parse cinfo dflags "" str - , not (BS.null (tkValue tok)) ] `shouldBe` tokens + shouldParseTo :: ByteString -> [TokenType] -> DynFlags -> Expectation + shouldParseTo str tokens dflags = [ tkType tok + | tok <- parse dflags "" str + , not (BS.null (tkValue tok)) ] `shouldBe` tokens |