diff --git a/hls-pragmas-plugin.cabal b/hls-pragmas-plugin.cabal --- a/hls-pragmas-plugin.cabal +++ b/hls-pragmas-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-pragmas-plugin -version: 1.0.0.1 +version: 1.0.1.0 synopsis: Pragmas plugin for Haskell Language Server description: Please see the README on GitHub at @@ -47,3 +47,4 @@ , hls-test-utils >=1.0 && <1.2 , lens , lsp-types + , text diff --git a/src/Ide/Plugin/Pragmas.hs b/src/Ide/Plugin/Pragmas.hs --- a/src/Ide/Plugin/Pragmas.hs +++ b/src/Ide/Plugin/Pragmas.hs @@ -14,6 +14,7 @@ import Control.Lens hiding (List) import Control.Monad (join) import Control.Monad.IO.Class (MonadIO (liftIO)) +import Data.Char (isSpace) import qualified Data.HashMap.Strict as H import Data.List import Data.List.Extra (nubOrdOn) @@ -51,7 +52,7 @@ pm <- liftIO $ fmap join $ runAction "Pragmas.GetParsedModule" state $ getParsedModule `traverse` mFile mbContents <- liftIO $ fmap (snd =<<) $ runAction "Pragmas.GetFileContents" state $ getFileContents `traverse` mFile let dflags = ms_hspp_opts . pm_mod_summary <$> pm - insertRange = maybe (Range (Position 0 0) (Position 0 0)) endOfModuleHeader mbContents + insertRange = maybe (Range (Position 0 0) (Position 0 0)) findNextPragmaPosition mbContents pedits = nubOrdOn snd . concat $ suggest dflags <$> diags return $ Right $ List $ pragmaEditToAction uri insertRange <$> pedits @@ -80,10 +81,16 @@ suggestDisableWarning :: Diagnostic -> [PragmaEdit] suggestDisableWarning Diagnostic {_code} - | Just (J.InR (T.stripPrefix "-W" -> Just w)) <- _code = + | Just (J.InR (T.stripPrefix "-W" -> Just w)) <- _code + , w `notElem` warningBlacklist = pure ("Disable \"" <> w <> "\" warnings", OptGHC w) | otherwise = [] +-- Don't suggest disabling type errors as a solution to all type errors +warningBlacklist :: [T.Text] +-- warningBlacklist = [] +warningBlacklist = ["deferred-type-errors"] + -- --------------------------------------------------------------------- -- | Offer to add a missing Language Pragma to the top of a file. @@ -143,6 +150,9 @@ -- --------------------------------------------------------------------- +flags :: [T.Text] +flags = map (T.pack . stripLeading '-') $ flagsForCompletion False + completion :: PluginMethodHandler IdeState 'J.TextDocumentCompletion completion _ide _ complParams = do let (J.TextDocumentIdentifier uri) = complParams ^. J.textDocument @@ -153,12 +163,22 @@ result <$> VFS.getCompletionPrefix position cnts where result (Just pfix) - | "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix + | "{-# language" `T.isPrefixOf` T.toLower (VFS.fullLine pfix) = J.List $ map buildCompletion (Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas) + | "{-# options_ghc" `T.isPrefixOf` T.toLower (VFS.fullLine pfix) + = J.List $ map mkExtCompl + (Fuzzy.simpleFilter (VFS.prefixText pfix) flags) + -- if there already is a closing bracket - complete without one + | isPragmaPrefix (VFS.fullLine pfix) && "}" `T.isSuffixOf` VFS.fullLine pfix + = J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas Nothing) + -- if there is no closing bracket - complete with one + | isPragmaPrefix (VFS.fullLine pfix) + = J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas (Just "}")) | otherwise = J.List [] result Nothing = J.List [] + isPragmaPrefix line = "{-#" `T.isPrefixOf` line buildCompletion p = J.CompletionItem { _label = p, @@ -180,14 +200,71 @@ _xdata = Nothing } _ -> return $ J.List [] +----------------------------------------------------------------------- +validPragmas :: Maybe T.Text -> [(T.Text, T.Text, T.Text)] +validPragmas mSuffix = + [ ("LANGUAGE ${1:extension} #-" <> suffix , "LANGUAGE", "{-# LANGUAGE #-}") + , ("OPTIONS_GHC -${1:option} #-" <> suffix , "OPTIONS_GHC", "{-# OPTIONS_GHC #-}") + , ("INLINE ${1:function} #-" <> suffix , "INLINE", "{-# INLINE #-}") + , ("NOINLINE ${1:function} #-" <> suffix , "NOINLINE", "{-# NOINLINE #-}") + , ("INLINABLE ${1:function} #-"<> suffix , "INLINABLE", "{-# INLINABLE #-}") + , ("WARNING ${1:message} #-" <> suffix , "WARNING", "{-# WARNING #-}") + , ("DEPRECATED ${1:message} #-" <> suffix , "DEPRECATED", "{-# DEPRECATED #-}") + , ("ANN ${1:annotation} #-" <> suffix , "ANN", "{-# ANN #-}") + , ("RULES #-" <> suffix , "RULES", "{-# RULES #-}") + , ("SPECIALIZE ${1:function} #-" <> suffix , "SPECIALIZE", "{-# SPECIALIZE #-}") + , ("SPECIALIZE INLINE ${1:function} #-"<> suffix , "SPECIALIZE INLINE", "{-# SPECIALIZE INLINE #-}") + ] + where suffix = case mSuffix of + (Just s) -> s + Nothing -> "" --- --------------------------------------------------------------------- --- | Find first line after (last pragma / last shebang / beginning of file). --- Useful for inserting pragmas. -endOfModuleHeader :: T.Text -> Range -endOfModuleHeader contents = Range loc loc - where - loc = Position line 0 - line = maybe 0 succ (lastLineWithPrefix "{-#" <|> lastLineWithPrefix "#!") - lastLineWithPrefix pre = listToMaybe $ reverse $ findIndices (T.isPrefixOf pre) $ T.lines contents +mkPragmaCompl :: T.Text -> T.Text -> T.Text -> J.CompletionItem +mkPragmaCompl insertText label detail = + J.CompletionItem label (Just J.CiKeyword) Nothing (Just detail) + Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just J.Snippet) + Nothing Nothing Nothing Nothing Nothing Nothing + +-- | Find first line after the last file header pragma +-- Defaults to line 0 if the file contains no shebang(s), OPTIONS_GHC pragma(s), or LANGUAGE pragma(s) +-- Otherwise it will be one after the count of line numbers, checking in order: Shebangs -> OPTIONS_GHC -> LANGUAGE +-- Taking the max of these to account for the possibility of interchanging order of these three Pragma types +findNextPragmaPosition :: T.Text -> Range +findNextPragmaPosition contents = Range loc loc + where + loc = Position line 0 + line = afterLangPragma . afterOptsGhc $ afterShebang + afterLangPragma = afterPragma "LANGUAGE" contents' + afterOptsGhc = afterPragma "OPTIONS_GHC" contents' + afterShebang = lastLineWithPrefix (T.isPrefixOf "#!") contents' 0 + contents' = T.lines contents + +afterPragma :: T.Text -> [T.Text] -> Int -> Int +afterPragma name contents lineNum = lastLineWithPrefix (checkPragma name) contents lineNum + +lastLineWithPrefix :: (T.Text -> Bool) -> [T.Text] -> Int -> Int +lastLineWithPrefix p contents lineNum = max lineNum next + where + next = maybe lineNum succ $ listToMaybe . reverse $ findIndices p contents + +checkPragma :: T.Text -> T.Text -> Bool +checkPragma name = check + where + check l = isPragma l && getName l == name + getName l = T.take (T.length name) $ T.dropWhile isSpace $ T.drop 3 l + isPragma = T.isPrefixOf "{-#" + + +stripLeading :: Char -> String -> String +stripLeading _ [] = [] +stripLeading c (s:ss) + | s == c = ss + | otherwise = s:ss + + +mkExtCompl :: T.Text -> J.CompletionItem +mkExtCompl label = + J.CompletionItem label (Just J.CiKeyword) Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -4,6 +4,7 @@ ) where import Control.Lens ((^.)) +import qualified Data.Text as T import qualified Ide.Plugin.Pragmas as Pragmas import qualified Language.LSP.Types.Lens as L import System.FilePath @@ -19,150 +20,95 @@ tests = testGroup "pragmas" [ codeActionTests + , codeActionTests' , completionTests ] codeActionTests :: TestTree codeActionTests = testGroup "code actions" - [ goldenWithPragmas "adds TypeSynonymInstances pragma" "NeedsPragmas" $ \doc -> do - _ <- waitForDiagnosticsFromSource doc "typecheck" - cas <- map fromAction <$> getAllCodeActions doc - liftIO $ "Add \"TypeSynonymInstances\"" `elem` map (^. L.title) cas @? "Contains TypeSynonymInstances code action" - liftIO $ "Add \"FlexibleInstances\"" `elem` map (^. L.title) cas @? "Contains FlexibleInstances code action" - executeCodeAction $ head cas + [ codeActionTest "adds LANGUAGE with no other pragmas at start ignoring later INLINE pragma" "AddPragmaIgnoreInline" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds LANGUAGE after shebang preceded by other LANGUAGE and GHC_OPTIONS" "AddPragmaAfterShebangPrecededByLangAndOptsGhc" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds LANGUAGE after shebang with other Language preceding shebang" "AddPragmaAfterShebangPrecededByLangAndOptsGhc" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds LANGUAGE before Doc comments after interchanging pragmas" "BeforeDocInterchanging" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")] + , codeActionTest "Add language after altering OPTIONS_GHC and Language" "AddLanguagePragmaAfterInterchaningOptsGhcAndLangs" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "Add language after pragmas with non standard space between prefix and name" "AddPragmaWithNonStandardSpacingInPrecedingPragmas" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds LANGUAGE after OptGHC at start ignoring later INLINE pragma" "AddPragmaAfterOptsGhcIgnoreInline" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds LANGUAGE ignore later Ann pragma" "AddPragmaIgnoreLaterAnnPragma" [("Add \"BangPatterns\"", "Contains BangPatterns code action")] + , codeActionTest "adds LANGUAGE after interchanging pragmas ignoring later Ann pragma" "AddLanguageAfterInterchaningIgnoringLaterAnn" [("Add \"BangPatterns\"", "Contains BangPatterns code action")] + , codeActionTest "adds LANGUAGE after OptGHC preceded by another language pragma" "AddLanguageAfterLanguageThenOptsGhc" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")] + , codeActionTest "adds LANGUAGE pragma after shebang and last language pragma" "AfterShebangAndPragma" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")] + , codeActionTest "adds above module keyword on first line" "ModuleOnFirstLine" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds LANGUAGE pragma after GHC_OPTIONS" "AfterGhcOptions" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds LANGUAGE pragma after shebang and GHC_OPTIONS" "AfterShebangAndOpts" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds LANGUAGE pragma after shebang, GHC_OPTIONS and language pragma" "AfterShebangAndOptionsAndPragma" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds LANGUAGE pragma after all others ignoring later INLINE pragma" "AfterShebangAndOptionsAndPragmasIgnoreInline" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds LANGUAGE pragma after all others ignoring multiple later INLINE pragma" "AfterAllWithMultipleInlines" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds LANGUAGE pragma correctly ignoring later INLINE pragma" "AddLanguagePragma" [("Add \"TupleSections\"", "Contains TupleSections code action")] + , codeActionTest "adds TypeApplications pragma" "TypeApplications" [("Add \"TypeApplications\"", "Contains TypeApplications code action")] + , codeActionTest "after shebang" "AfterShebang" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")] + , codeActionTest "append to existing pragmas" "AppendToExisting" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")] + , codeActionTest "before doc comments" "BeforeDocComment" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")] + , codeActionTest "before doc comments" "MissingSignatures" [("Disable \"missing-signatures\" warnings", "Contains missing-signatures code action")] + , codeActionTest "before doc comments" "UnusedImports" [("Disable \"unused-imports\" warnings", "Contains unused-imports code action")] + , codeActionTest "adds TypeSynonymInstances pragma" "NeedsPragmas" [("Add \"TypeSynonymInstances\"", "Contains TypeSynonymInstances code action"), ("Add \"FlexibleInstances\"", "Contains FlexibleInstances code action")] + ] - , goldenWithPragmas "adds TypeApplications pragma" "TypeApplications" $ \doc -> do - _ <- waitForDiagnosticsFrom doc - cas <- map fromAction <$> getAllCodeActions doc - liftIO $ "Add \"TypeApplications\"" `elem` map (^. L.title) cas @? "Contains TypeApplications code action" - executeCodeAction $ head cas +codeActionTest :: String -> FilePath -> [(T.Text, String)] -> TestTree +codeActionTest testComment fp actions = + goldenWithPragmas testComment fp $ \doc -> do + _ <- waitForDiagnosticsFrom doc + cas <- map fromAction <$> getAllCodeActions doc + mapM_ (\(action, contains) -> go action contains cas) actions + executeCodeAction $ head cas + where + go action contains cas = liftIO $ action `elem` map (^. L.title) cas @? contains - , goldenWithPragmas "no duplication" "NamedFieldPuns" $ \doc -> do +codeActionTests' :: TestTree +codeActionTests' = + testGroup "additional code actions" + [ goldenWithPragmas "no duplication" "NamedFieldPuns" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getCodeActions doc (Range (Position 8 9) (Position 8 9)) liftIO $ length cas == 1 @? "Expected one code action, but got: " <> show cas let ca = head cas liftIO $ (ca ^. L.title == "Add \"NamedFieldPuns\"") @? "NamedFieldPuns code action" executeCodeAction ca - - , goldenWithPragmas "after shebang" "AfterShebang" $ \doc -> do - _ <- waitForDiagnosticsFrom doc - cas <- map fromAction <$> getAllCodeActions doc - liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action" - executeCodeAction $ head cas - - , goldenWithPragmas "append to existing pragmas" "AppendToExisting" $ \doc -> do - _ <- waitForDiagnosticsFrom doc - cas <- map fromAction <$> getAllCodeActions doc - liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action" - executeCodeAction $ head cas - - , goldenWithPragmas "before doc comments" "BeforeDocComment" $ \doc -> do - _ <- waitForDiagnosticsFrom doc - cas <- map fromAction <$> getAllCodeActions doc - liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action" - executeCodeAction $ head cas - - , goldenWithPragmas "before doc comments" "MissingSignatures" $ \doc -> do - _ <- waitForDiagnosticsFrom doc - cas <- map fromAction <$> getAllCodeActions doc - liftIO $ "Disable \"missing-signatures\" warnings" `elem` map (^. L.title) cas @? "Contains missing-signatures code action" - executeCodeAction $ head cas - - , goldenWithPragmas "before doc comments" "UnusedImports" $ \doc -> do + , goldenWithPragmas "doesn't suggest disabling type errors" "DeferredTypeErrors" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getAllCodeActions doc - liftIO $ "Disable \"unused-imports\" warnings" `elem` map (^. L.title) cas @? "Contains unused-imports code action" - executeCodeAction $ head cas + liftIO $ "Disable \"deferred-type-errors\" warnings" `notElem` map (^. L.title) cas @? "Doesn't contain deferred-type-errors code action" + liftIO $ length cas == 0 @? "Expected no code actions, but got: " <> show cas ] completionTests :: TestTree completionTests = - testGroup "completions" - [ testCase "completes pragmas" $ runSessionWithServer pragmasPlugin testDataDir $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- waitForDiagnostics - let te = TextEdit (Range (Position 0 4) (Position 0 34)) "" - _ <- applyEdit doc te - compls <- getCompletions doc (Position 0 4) - let item = head $ filter ((== "LANGUAGE") . (^. L.label)) compls - liftIO $ do - item ^. L.label @?= "LANGUAGE" - item ^. L.kind @?= Just CiKeyword - item ^. L.insertTextFormat @?= Just Snippet - item ^. L.insertText @?= Just "LANGUAGE ${1:extension} #-}" - - , testCase "completes pragmas no close" $ runSessionWithServer pragmasPlugin testDataDir $ do - doc <- openDoc "Completion.hs" "haskell" - let te = TextEdit (Range (Position 0 4) (Position 0 24)) "" - _ <- applyEdit doc te - compls <- getCompletions doc (Position 0 4) - let item = head $ filter ((== "LANGUAGE") . (^. L.label)) compls - liftIO $ do - item ^. L.label @?= "LANGUAGE" - item ^. L.kind @?= Just CiKeyword - item ^. L.insertTextFormat @?= Just Snippet - item ^. L.insertText @?= Just "LANGUAGE ${1:extension}" - - , testCase "completes options pragma" $ runSessionWithServer pragmasPlugin testDataDir $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- waitForDiagnostics - let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS" - _ <- applyEdit doc te - compls <- getCompletions doc (Position 0 4) - let item = head $ filter ((== "OPTIONS_GHC") . (^. L.label)) compls - liftIO $ do - item ^. L.label @?= "OPTIONS_GHC" - item ^. L.kind @?= Just CiKeyword - item ^. L.insertTextFormat @?= Just Snippet - item ^. L.insertText @?= Just "OPTIONS_GHC -${1:option} #-}" - - , testCase "completes ghc options pragma values" $ runSessionWithServer pragmasPlugin testDataDir $ do - doc <- openDoc "Completion.hs" "haskell" - let te = TextEdit (Range (Position 0 0) (Position 0 0)) "{-# OPTIONS_GHC -Wno-red #-}\n" - _ <- applyEdit doc te - compls <- getCompletions doc (Position 0 24) - let item = head $ filter ((== "Wno-redundant-constraints") . (^. L.label)) compls - liftIO $ do - item ^. L.label @?= "Wno-redundant-constraints" - item ^. L.kind @?= Just CiKeyword - item ^. L.insertTextFormat @?= Nothing - item ^. L.insertText @?= Nothing - - , testCase "completes language extensions" $ runSessionWithServer pragmasPlugin testDataDir $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- waitForDiagnostics - let te = TextEdit (Range (Position 0 24) (Position 0 31)) "" - _ <- applyEdit doc te - compls <- getCompletions doc (Position 0 24) - let item = head $ filter ((== "OverloadedStrings") . (^. L.label)) compls - liftIO $ do - item ^. L.label @?= "OverloadedStrings" - item ^. L.kind @?= Just CiKeyword - - , testCase "completes the Strict language extension" $ runSessionWithServer pragmasPlugin testDataDir $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- waitForDiagnostics - let te = TextEdit (Range (Position 0 13) (Position 0 31)) "Str" - _ <- applyEdit doc te - compls <- getCompletions doc (Position 0 16) - let item = head $ filter ((== "Strict") . (^. L.label)) compls - liftIO $ do - item ^. L.label @?= "Strict" - item ^. L.kind @?= Just CiKeyword - - , testCase "completes No- language extensions" $ runSessionWithServer pragmasPlugin testDataDir $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- waitForDiagnostics - let te = TextEdit (Range (Position 0 13) (Position 0 31)) "NoOverload" - _ <- applyEdit doc te - compls <- getCompletions doc (Position 0 23) - let item = head $ filter ((== "NoOverloadedStrings") . (^. L.label)) compls - liftIO $ do - item ^. L.label @?= "NoOverloadedStrings" - item ^. L.kind @?= Just CiKeyword + testGroup "completions" [ + completionTest "completes pragmas" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #-}") (Just "{-# LANGUAGE #-}") [0, 4, 0, 34, 0, 4] + , completionTest "completes pragmas with existing closing bracket" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #-") (Just "{-# LANGUAGE #-}") [0, 4, 0, 33, 0, 4] + , completionTest "completes options pragma" "Completion.hs" "OPTIONS" "OPTIONS_GHC" (Just Snippet) (Just "OPTIONS_GHC -${1:option} #-}") (Just "{-# OPTIONS_GHC #-}") [0, 4, 0, 34, 0, 4] + , completionTest "completes ghc options pragma values" "Completion.hs" "{-# OPTIONS_GHC -Wno-red #-}\n" "Wno-redundant-constraints" Nothing Nothing Nothing [0, 0, 0, 0, 0, 24] + , completionTest "completes language extensions" "Completion.hs" "" "OverloadedStrings" Nothing Nothing Nothing [0, 24, 0, 31, 0, 24] + , completionTest "completes language extensions case insensitive" "Completion.hs" "lAnGuaGe Overloaded" "OverloadedStrings" Nothing Nothing Nothing [0, 4, 0, 34, 0, 24] + , completionTest "completes the Strict language extension" "Completion.hs" "Str" "Strict" Nothing Nothing Nothing [0, 13, 0, 31, 0, 16] + , completionTest "completes No- language extensions" "Completion.hs" "NoOverload" "NoOverloadedStrings" Nothing Nothing Nothing [0, 13, 0, 31, 0, 23] ] + +completionTest :: String -> String -> T.Text -> T.Text -> Maybe InsertTextFormat -> Maybe T.Text -> Maybe T.Text -> [Int] -> TestTree +completionTest testComment fileName te' label textFormat insertText detail [a, b, c, d, x, y] = + testCase testComment $ runSessionWithServer pragmasPlugin testDataDir $ do + doc <- openDoc fileName "haskell" + _ <- waitForDiagnostics + let te = TextEdit (Range (Position a b) (Position c d)) te' + _ <- applyEdit doc te + compls <- getCompletions doc (Position x y) + let item = head $ filter ((== label) . (^. L.label)) compls + liftIO $ do + item ^. L.label @?= label + item ^. L.kind @?= Just CiKeyword + item ^. L.insertTextFormat @?= textFormat + item ^. L.insertText @?= insertText + item ^. L.detail @?= detail goldenWithPragmas :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree goldenWithPragmas title path = goldenWithHaskellDoc pragmasPlugin title testDataDir path "expected" "hs" diff --git a/test/testdata/AddLanguageAfterInterchaningIgnoringLaterAnn.expected.hs b/test/testdata/AddLanguageAfterInterchaningIgnoringLaterAnn.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddLanguageAfterInterchaningIgnoringLaterAnn.expected.hs @@ -0,0 +1,18 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} +{-# LANGUAGE BangPatterns #-} + +data Metaprogram = Metaprogram + { mp_name :: !Text + , mp_known_by_auto :: !Bool + , mp_show_code_action :: !Bool + , mp_program :: !(TacticsM ()) + } + deriving stock Generic +{-# ANN Metaprogram "hello" #-} + +instance NFData Metaprogram where + rnf (!(Metaprogram !_ !_ !_ !_)) = () diff --git a/test/testdata/AddLanguageAfterInterchaningIgnoringLaterAnn.hs b/test/testdata/AddLanguageAfterInterchaningIgnoringLaterAnn.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddLanguageAfterInterchaningIgnoringLaterAnn.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} + +data Metaprogram = Metaprogram + { mp_name :: !Text + , mp_known_by_auto :: !Bool + , mp_show_code_action :: !Bool + , mp_program :: !(TacticsM ()) + } + deriving stock Generic +{-# ANN Metaprogram "hello" #-} + +instance NFData Metaprogram where + rnf (!(Metaprogram !_ !_ !_ !_)) = () diff --git a/test/testdata/AddLanguageAfterLanguageThenOptsGhc.expected.hs b/test/testdata/AddLanguageAfterLanguageThenOptsGhc.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddLanguageAfterLanguageThenOptsGhc.expected.hs @@ -0,0 +1,21 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} +{-# LANGUAGE NamedFieldPuns #-} +-- | Doc Comment +{- Block -} + +module BeforeDocComment where + +test :: Int -> Integer +test x = x * 2 + +data Record = Record + { a :: Int, + b :: Double, + c :: String + } + +f Record{a, b} = a diff --git a/test/testdata/AddLanguageAfterLanguageThenOptsGhc.hs b/test/testdata/AddLanguageAfterLanguageThenOptsGhc.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddLanguageAfterLanguageThenOptsGhc.hs @@ -0,0 +1,20 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} +-- | Doc Comment +{- Block -} + +module BeforeDocComment where + +test :: Int -> Integer +test x = x * 2 + +data Record = Record + { a :: Int, + b :: Double, + c :: String + } + +f Record{a, b} = a diff --git a/test/testdata/AddLanguagePragma.expected.hs b/test/testdata/AddLanguagePragma.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddLanguagePragma.expected.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +module NeedsLanguagePragma where + +tupleSection = (1,) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 diff --git a/test/testdata/AddLanguagePragma.hs b/test/testdata/AddLanguagePragma.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddLanguagePragma.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} + +module NeedsLanguagePragma where + +tupleSection = (1,) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 diff --git a/test/testdata/AddLanguagePragmaAfterInterchaningOptsGhcAndLangs.expected.hs b/test/testdata/AddLanguagePragmaAfterInterchaningOptsGhcAndLangs.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddLanguagePragmaAfterInterchaningOptsGhcAndLangs.expected.hs @@ -0,0 +1,21 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} +{-# LANGUAGE TupleSections #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 + +{-# INLINE subOne #-} +subOne :: Int -> Int +subOne x = x - 1 + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AddLanguagePragmaAfterInterchaningOptsGhcAndLangs.hs b/test/testdata/AddLanguagePragmaAfterInterchaningOptsGhcAndLangs.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddLanguagePragmaAfterInterchaningOptsGhcAndLangs.hs @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 + +{-# INLINE subOne #-} +subOne :: Int -> Int +subOne x = x - 1 + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AddOptsGhcAfterLanguage.expected.hs b/test/testdata/AddOptsGhcAfterLanguage.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddOptsGhcAfterLanguage.expected.hs @@ -0,0 +1,12 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} +-- | Doc Comment +{- Block -} + +module BeforeDocComment where + +test :: Int -> Integer +test x = x * 2 diff --git a/test/testdata/AddOptsGhcAfterLanguage.hs b/test/testdata/AddOptsGhcAfterLanguage.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddOptsGhcAfterLanguage.hs @@ -0,0 +1,11 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Doc Comment +{- Block -} + +module BeforeDocComment where + +test :: Int -> Integer +test x = x * 2 diff --git a/test/testdata/AddPragmaAfterOptsGhcIgnoreInline.expected.hs b/test/testdata/AddPragmaAfterOptsGhcIgnoreInline.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaAfterOptsGhcIgnoreInline.expected.hs @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE TupleSections #-} +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 diff --git a/test/testdata/AddPragmaAfterOptsGhcIgnoreInline.hs b/test/testdata/AddPragmaAfterOptsGhcIgnoreInline.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaAfterOptsGhcIgnoreInline.hs @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wall #-} +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 diff --git a/test/testdata/AddPragmaAfterShebangPrecededByLangAndOptsGhc.expected.hs b/test/testdata/AddPragmaAfterShebangPrecededByLangAndOptsGhc.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaAfterShebangPrecededByLangAndOptsGhc.expected.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# LANGUAGE TupleSections #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AddPragmaAfterShebangPrecededByLangAndOptsGhc.hs b/test/testdata/AddPragmaAfterShebangPrecededByLangAndOptsGhc.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaAfterShebangPrecededByLangAndOptsGhc.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AddPragmaAfterShebangPrecededByLanguage.expected.hs b/test/testdata/AddPragmaAfterShebangPrecededByLanguage.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaAfterShebangPrecededByLanguage.expected.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# LANGUAGE TupleSections #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AddPragmaAfterShebangPrecededByLanguage.hs b/test/testdata/AddPragmaAfterShebangPrecededByLanguage.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaAfterShebangPrecededByLanguage.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE OverloadedStrings #-} +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AddPragmaIgnoreInline.expected.hs b/test/testdata/AddPragmaIgnoreInline.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaIgnoreInline.expected.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TupleSections #-} +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 diff --git a/test/testdata/AddPragmaIgnoreInline.hs b/test/testdata/AddPragmaIgnoreInline.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaIgnoreInline.hs @@ -0,0 +1,10 @@ +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 diff --git a/test/testdata/AddPragmaIgnoreLaterAnnPragma.expected.hs b/test/testdata/AddPragmaIgnoreLaterAnnPragma.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaIgnoreLaterAnnPragma.expected.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE BangPatterns #-} +data Metaprogram = Metaprogram + { mp_name :: !Text + , mp_known_by_auto :: !Bool + , mp_show_code_action :: !Bool + , mp_program :: !(TacticsM ()) + } + deriving stock Generic +{-# ANN Metaprogram "hello" #-} + +instance NFData Metaprogram where + rnf (!(Metaprogram !_ !_ !_ !_)) = () diff --git a/test/testdata/AddPragmaIgnoreLaterAnnPragma.hs b/test/testdata/AddPragmaIgnoreLaterAnnPragma.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaIgnoreLaterAnnPragma.hs @@ -0,0 +1,11 @@ +data Metaprogram = Metaprogram + { mp_name :: !Text + , mp_known_by_auto :: !Bool + , mp_show_code_action :: !Bool + , mp_program :: !(TacticsM ()) + } + deriving stock Generic +{-# ANN Metaprogram "hello" #-} + +instance NFData Metaprogram where + rnf (!(Metaprogram !_ !_ !_ !_)) = () diff --git a/test/testdata/AddPragmaWithNonStandardSpacingInPrecedingPragmas.expected.hs b/test/testdata/AddPragmaWithNonStandardSpacingInPrecedingPragmas.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaWithNonStandardSpacingInPrecedingPragmas.expected.hs @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} +{-# LANGUAGE TupleSections #-} + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AddPragmaWithNonStandardSpacingInPrecedingPragmas.hs b/test/testdata/AddPragmaWithNonStandardSpacingInPrecedingPragmas.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AddPragmaWithNonStandardSpacingInPrecedingPragmas.hs @@ -0,0 +1,5 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AfterAllWithMultipleInlines.expected.hs b/test/testdata/AfterAllWithMultipleInlines.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterAllWithMultipleInlines.expected.hs @@ -0,0 +1,22 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 + +{-# INLINE subOne #-} +subOne :: Int -> Int +subOne x = x - 1 diff --git a/test/testdata/AfterAllWithMultipleInlines.hs b/test/testdata/AfterAllWithMultipleInlines.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterAllWithMultipleInlines.hs @@ -0,0 +1,21 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 + +{-# INLINE subOne #-} +subOne :: Int -> Int +subOne x = x - 1 diff --git a/test/testdata/AfterGhcOptions.expected.hs b/test/testdata/AfterGhcOptions.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterGhcOptions.expected.hs @@ -0,0 +1,18 @@ +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE TupleSections #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 + +{-# INLINE subOne #-} +subOne :: Int -> Int +subOne x = x - 1 diff --git a/test/testdata/AfterGhcOptions.hs b/test/testdata/AfterGhcOptions.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterGhcOptions.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 + +{-# INLINE subOne #-} +subOne :: Int -> Int +subOne x = x - 1 diff --git a/test/testdata/AfterShebangAndOptionsAndPragma.expected.hs b/test/testdata/AfterShebangAndOptionsAndPragma.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterShebangAndOptionsAndPragma.expected.hs @@ -0,0 +1,13 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AfterShebangAndOptionsAndPragma.hs b/test/testdata/AfterShebangAndOptionsAndPragma.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterShebangAndOptionsAndPragma.hs @@ -0,0 +1,12 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE OverloadedStrings #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AfterShebangAndOptionsAndPragmasIgnoreInline.expected.hs b/test/testdata/AfterShebangAndOptionsAndPragmasIgnoreInline.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterShebangAndOptionsAndPragmasIgnoreInline.expected.hs @@ -0,0 +1,18 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 diff --git a/test/testdata/AfterShebangAndOptionsAndPragmasIgnoreInline.hs b/test/testdata/AfterShebangAndOptionsAndPragmasIgnoreInline.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterShebangAndOptionsAndPragmasIgnoreInline.hs @@ -0,0 +1,17 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 + +{-# INLINE addOne #-} +addOne :: Int -> Int +addOne x = x + 1 diff --git a/test/testdata/AfterShebangAndOpts.expected.hs b/test/testdata/AfterShebangAndOpts.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterShebangAndOpts.expected.hs @@ -0,0 +1,12 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# LANGUAGE TupleSections #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AfterShebangAndOpts.hs b/test/testdata/AfterShebangAndOpts.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterShebangAndOpts.hs @@ -0,0 +1,11 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} + +data Something = Something { + foo :: !String, + bar :: !Int +} + +tupleSection = (1, ) <$> Just 2 diff --git a/test/testdata/AfterShebangAndPragma.expected.hs b/test/testdata/AfterShebangAndPragma.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterShebangAndPragma.expected.hs @@ -0,0 +1,16 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} +-- | Doc Comment +{- Block -} + +module BeforeDocComment where + +data Record = Record + { a :: Int, + b :: Double, + c :: String + } + +f Record{a, b} = a diff --git a/test/testdata/AfterShebangAndPragma.hs b/test/testdata/AfterShebangAndPragma.hs new file mode 100644 --- /dev/null +++ b/test/testdata/AfterShebangAndPragma.hs @@ -0,0 +1,15 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# LANGUAGE OverloadedStrings #-} +-- | Doc Comment +{- Block -} + +module BeforeDocComment where + +data Record = Record + { a :: Int, + b :: Double, + c :: String + } + +f Record{a, b} = a diff --git a/test/testdata/BeforeDocInterchanging.expected.hs b/test/testdata/BeforeDocInterchanging.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/BeforeDocInterchanging.expected.hs @@ -0,0 +1,18 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} +{-# LANGUAGE NamedFieldPuns #-} +-- | Doc Comment +{- Block -} + +module BeforeDocComment where + +data Record = Record + { a :: Int, + b :: Double, + c :: String + } + +f Record{a, b} = a diff --git a/test/testdata/BeforeDocInterchanging.hs b/test/testdata/BeforeDocInterchanging.hs new file mode 100644 --- /dev/null +++ b/test/testdata/BeforeDocInterchanging.hs @@ -0,0 +1,17 @@ +#! /usr/bin/env nix-shell +#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])" +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} +-- | Doc Comment +{- Block -} + +module BeforeDocComment where + +data Record = Record + { a :: Int, + b :: Double, + c :: String + } + +f Record{a, b} = a diff --git a/test/testdata/DeferredTypeErrors.expected.hs b/test/testdata/DeferredTypeErrors.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/DeferredTypeErrors.expected.hs @@ -0,0 +1,4 @@ +module DeferredTypeErrors where + +foo :: Int +foo = () diff --git a/test/testdata/DeferredTypeErrors.hs b/test/testdata/DeferredTypeErrors.hs new file mode 100644 --- /dev/null +++ b/test/testdata/DeferredTypeErrors.hs @@ -0,0 +1,4 @@ +module DeferredTypeErrors where + +foo :: Int +foo = () diff --git a/test/testdata/ModuleOnFirstLine.expected.hs b/test/testdata/ModuleOnFirstLine.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/ModuleOnFirstLine.expected.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TupleSections #-} +module Main where + +tupleSection = (1,) <$> Just 2 diff --git a/test/testdata/ModuleOnFirstLine.hs b/test/testdata/ModuleOnFirstLine.hs new file mode 100644 --- /dev/null +++ b/test/testdata/ModuleOnFirstLine.hs @@ -0,0 +1,3 @@ +module Main where + +tupleSection = (1,) <$> Just 2