]> git.wincent.com - docvim.git/blob - tests/tasty.hs
Add Vim help integration tests
[docvim.git] / tests / tasty.hs
1 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
2
3 module Main (main) where
4
5 import Control.DeepSeq
6 import Control.Exception hiding (assert)
7 import Data.ByteString.Lazy.Char8 (pack, unpack)
8 import Data.Char
9 import Data.List --(isPrefixOf, sort)
10 import Data.Monoid
11 import System.Directory
12 import System.Exit
13 import System.FilePath
14 import System.IO
15 import System.IO.Temp
16 import System.Process
17 import Test.Tasty
18 import Test.Tasty.Golden
19 import Test.Tasty.Golden.Advanced
20 import Test.Tasty.HUnit
21 import Text.Docvim.AST
22 import Text.Docvim.Util
23 import Text.Docvim.Visitor.Symbol
24 import qualified Data.ByteString as ByteString
25 import qualified Data.ByteString.Lazy as LazyByteString
26
27 -- | Crude check to see if parse worked.
28 parseSuccess :: Either a b -> Bool
29 parseSuccess (Left _) = False
30 parseSuccess _        = True
31
32 unitTests :: TestTree
33 unitTests = testGroup "Unit tests"
34   [ testCase "Compile empty unit" $ assert $ parseSuccess (compileUnits [""])
35   , testCase "Compile whitespace-only unit" $ assert $ parseSuccess (compileUnits ["  \n    "])
36
37   , testCase "Counting all nodes" $
38     7 @=? let
39         tree = Unit
40           [ FunctionDeclaration True
41                               "name"
42                               (ArgumentList [])
43                               []
44                               [UnletStatement True "foo"]
45           , DocBlock [ HeadingAnnotation "foo"
46                     , SubheadingAnnotation "bar"
47                     , SubheadingAnnotation "baz"
48                     ]
49           ]
50         counter _ = 1
51         nodeCount = getSum $ walk counter (Sum 0) tree
52       in nodeCount
53
54   , testCase "Gathering specific nodes" $
55     [SubheadingAnnotation "bar", SubheadingAnnotation "baz"] @=? let
56         tree = DocBlock [ HeadingAnnotation "foo"
57                         , SubheadingAnnotation "bar"
58                         , SubheadingAnnotation "baz"
59                         ]
60         accumulateSubheadings node@(SubheadingAnnotation _) = [node]
61         accumulateSubheadings _ = [] -- skip everything else
62         selection = walk accumulateSubheadings [] tree
63       in selection
64
65   , testCase "Extracting symbols" $
66     sort ["foo", "bar", "baz"] @=? let
67         tree = DocBlock [ LinkTargets ["foo"]
68                         , LinkTargets ["bar", "baz"]
69                         ]
70         symbols = sort $ getSymbols tree
71       in symbols
72
73   , testCase "Synthesizing symbols from the @plugin annotation" $
74     sort ["foo", "foo.txt", "bar"] @=? let
75         tree = DocBlock [ PluginAnnotation "foo" "some plugin"
76                         , LinkTargets ["bar"]
77                         ]
78         symbols = sort $ getSymbols tree
79       in symbols
80
81   , testCase "Synthesizing symbols from the headings" $
82     -- will need to pass in plugin name (prefix) to make this work
83     sort ["foo", "foo.txt", "foo-history", "foo-troubleshooting-tips", "bar"] @=? let
84         tree = DocBlock [ PluginAnnotation "foo" "some plugin"
85                         , HeadingAnnotation "History"
86                         , HeadingAnnotation "Troubleshooting tips"
87                         , LinkTargets ["bar"]
88                         ]
89         symbols = sort $ getSymbols tree
90       in symbols
91   ]
92
93 goldenTests :: String -> [FilePath] -> ([String] -> String) -> TestTree
94 goldenTests description sources transform = testGroup groupName $ do
95     file <- sources -- list monad
96     let
97       run = do
98         input <- readFile file
99         let output = normalize $ transform [input]
100         return $ pack output -- pack because tasty-golden wants a ByteString
101       name = takeBaseName file
102       golden = replaceExtension file ".golden"
103       diff ref new = [ "git"
104                     , "diff"
105                     , "--color"
106                     , "--diff-algorithm=histogram"
107                     , ref
108                     , new
109                     ]
110     return $ goldenVsStringDiff' name diff golden run
111   where
112     groupName = "Golden " ++ description ++ " tests"
113
114 integrationTests :: [FilePath] -> TestTree
115 integrationTests sources = testGroup "Integration tests" $
116     concat [m, v]
117   where
118     m = do
119       source <- sources -- list monad
120       let
121         markdown = do
122           inputs <- getFixtures $ source </> "input"
123           contents <- mapM readFile inputs
124           return $ pack $ normalize $ pm contents
125         name = takeBaseName source
126         golden = "tests/fixtures/integration" </> (takeBaseName source) </> "golden/markdown.golden"
127         diff ref new = [ "git"
128                       , "diff"
129                       , "--color"
130                       , "--diff-algorithm=histogram"
131                       , ref
132                       , new
133                       ]
134       return $ goldenVsStringDiff' (name ++ " (Markdown)") diff golden markdown
135     v = do
136       source <- sources -- list monad
137       let
138         help = do
139           inputs <- getFixtures $ source </> "input"
140           contents <- mapM readFile inputs
141           return $ pack $ normalize $ pv contents
142         name = takeBaseName source
143         golden = "tests/fixtures/integration" </> (takeBaseName source) </> "golden/plaintext.golden"
144         diff ref new = [ "git"
145                       , "diff"
146                       , "--color"
147                       , "--diff-algorithm=histogram"
148                       , ref
149                       , new
150                       ]
151       return $ goldenVsStringDiff' (name ++ " (Vim help)") diff golden help
152
153 -- | Normalize a string to always end with a newline, unless zero-length, to
154 -- match standard text editor behavior.
155 normalize :: String -> String
156 normalize s | s == ""   = ""
157             | otherwise = if last s == '\n' then s else s ++ "\n"
158
159 -- | This is based on `goldenVsStringDiff` function defined in:
160 -- https://github.com/feuerbach/tasty-golden/blob/470e7af018/Test/Tasty/Golden.hs#L150-L191
161 --
162 -- Differences:
163 --
164 --  - Omission of the verbose/ugly failure output message (this is the
165 --    motivating change here).
166 --  - Strip diff headers up to first "@@" (again, for brevity).
167 --  - Some revised names to make things a little clearer.
168 --  - Removed an `error` call which I am not worried about needing.
169 --
170 goldenVsStringDiff' :: TestName -> (FilePath -> FilePath -> [String]) -> FilePath -> IO LazyByteString.ByteString -> TestTree
171 goldenVsStringDiff' name diff golden run =
172   goldenTest
173     name
174     (ByteString.readFile golden)
175     (LazyByteString.toStrict <$> run)
176     cmp
177     update
178   where
179     template = takeFileName golden <.> "actual"
180     hunkHeader = map chr [0x1b, 0x5b, 0x33, 0x36, 0x6d] ++ "@@ "
181     strip out = unlines $ dropWhile (not . isPrefixOf hunkHeader) (lines $ unpack out)
182     cmp _ actBS = withSystemTempFile template $ \tmpFile tmpHandle -> do
183       ByteString.hPut tmpHandle actBS >> hFlush tmpHandle
184       let cmd = diff golden tmpFile
185       (_, Just sout, _, pid) <- createProcess (proc (head cmd) (tail cmd)) { std_out = CreatePipe }
186       out <- LazyByteString.hGetContents sout
187       evaluate . rnf $ out
188       r <- waitForProcess pid
189       return $ case r of
190         ExitSuccess -> Nothing
191         _ -> Just (strip out)
192     update = ByteString.writeFile golden
193
194 getFixtures :: FilePath -> IO [FilePath]
195 getFixtures = findByExtension [".vim"]
196
197 getIntegrationFixtures :: FilePath -> IO [FilePath]
198 getIntegrationFixtures path = do
199   names <- getDirectoryContents path
200   let filtered = filter (\name -> not $ "." `isPrefixOf` name) names
201   return $ map (\name -> path </> name) filtered
202
203 main :: IO ()
204 main = do
205   parserSources <- getFixtures "tests/fixtures/parser"
206   markdownSources <- getFixtures "tests/fixtures/markdown"
207   vimHelpSources <- getFixtures "tests/fixtures/vim"
208   integrationSources <- getIntegrationFixtures "tests/fixtures/integration"
209   defaultMain $ testGroup "Test suite"
210     [ unitTests
211     , goldenTests "parser" parserSources p
212     , goldenTests "Markdown printer" markdownSources pm
213     , goldenTests "Vim help printer" vimHelpSources pv
214     , integrationTests integrationSources
215     ]