Add a set of default language extensions for parsing

See the comment for a detailed explanation.
Fixes jaspervdj/stylish-haskell#117

2 files changed, 61 insertions, 8 deletions

diff --git a/lib/Language/Haskell/Stylish/Parse.hs b/lib/Language/Haskell/Stylish/Parse.hs
index 3118380..2b16b30 100644
--- a/lib/Language/Haskell/Stylish/Parse.hs
+++ b/lib/Language/Haskell/Stylish/Parse.hs
@@ -7,12 +7,29 @@ module Language.Haskell.Stylish.Parse
 --------------------------------------------------------------------------------
 import           Data.Maybe                      (fromMaybe, listToMaybe)
 import qualified Language.Haskell.Exts.Annotated as H
-import Data.List (isPrefixOf)
+import Data.List (isPrefixOf, nub)
 
 --------------------------------------------------------------------------------
 import           Language.Haskell.Stylish.Config
 import           Language.Haskell.Stylish.Step
 
+--------------------------------------------------------------------------------
+-- | Syntax-related language extensions are always enabled for parsing. Since we
+-- can't authoritatively know which extensions are enabled at compile-time, we
+-- should try not to throw errors when parsing any GHC-accepted code.
+defaultExtensions :: [H.Extension]
+defaultExtensions = map H.EnableExtension
+  [ H.GADTs
+  , H.HereDocuments
+  , H.KindSignatures
+  , H.MagicHash
+  , H.NewQualifiedOperators
+  , H.PatternGuards
+  , H.StandaloneDeriving
+  , H.UnicodeSyntax
+  , H.XmlSyntax
+  ]
+
 
 --------------------------------------------------------------------------------
 -- | Filter out lines which use CPP macros
@@ -50,7 +67,7 @@ parseModule extraExts mfp string = do
     let noPrefixes       = unShebang . dropBom $ string
         extraExts'       = map H.classifyExtension extraExts
         (lang, fileExts) = fromMaybe (Nothing, []) $ H.readExtensions noPrefixes
-        exts             = fileExts ++ extraExts'
+        exts             = nub $ fileExts ++ extraExts' ++ defaultExtensions
 
         -- Parsing options...
         fp       = fromMaybe "<unknown>" mfp
diff --git a/tests/Language/Haskell/Stylish/Parse/Tests.hs b/tests/Language/Haskell/Stylish/Parse/Tests.hs
index 87c0a51..1e6b992 100644
--- a/tests/Language/Haskell/Stylish/Parse/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Parse/Tests.hs
@@ -16,12 +16,16 @@ import           Language.Haskell.Stylish.Parse
 --------------------------------------------------------------------------------
 tests :: Test
 tests = testGroup "Language.Haskell.Stylish.Parse"
-    [ testCase "UTF-8 Byte Order Mark" testBom
-    , testCase "Extra extensions"      testExtraExtensions
-    , testCase "Multiline CPP"         testMultilineCpp
-    , testCase "Haskell2010 extension" testHaskell2010
-    , testCase "Shebang"               testShebang
-    , testCase "ShebangExt"            testShebangExt
+    [ testCase "UTF-8 Byte Order Mark"       testBom
+    , testCase "Extra extensions"            testExtraExtensions
+    , testCase "Multiline CPP"               testMultilineCpp
+    , testCase "Haskell2010 extension"       testHaskell2010
+    , testCase "Shebang"                     testShebang
+    , testCase "ShebangExt"                  testShebangExt
+    , testCase "GADTs extension"             testGADTs
+    , testCase "KindSignatures extension"    testKindSignatures
+    , testCase "StandalonDeriving extension" testKindSignatures
+    , testCase "UnicodeSyntax extension"     testUnicodeSyntax
     ]
 
 --------------------------------------------------------------------------------
@@ -77,6 +81,38 @@ testShebang = assert $ isRight $ parseModule [] Nothing $ unlines
     , "main = return ()"
     ]
 
+--------------------------------------------------------------------------------
+
+-- | These tests are for syntactic language extensions that should always be
+-- enabled for parsing, even when the pragma is absent.
+
+testGADTs :: Assertion
+testGADTs = assert $ isRight $ parseModule [] Nothing $ unlines
+  [ "module Main where"
+  , "data SafeList a b where"
+  , "  Nil :: SafeList a Empty"
+  , "  Cons:: a -> SafeList a b -> SafeList a NonEmpty"
+  ]
+
+testKindSignatures :: Assertion
+testKindSignatures = assert $ isRight $ parseModule [] Nothing $ unlines
+  [ "module Main where"
+  , "data D :: * -> * -> * where"
+  , "  D :: a -> b -> D a b"
+  ]
+
+testStandaloneDeriving :: Assertion
+testStandaloneDeriving = assert $ isRight $ parseModule [] Nothing $ unlines
+  [ "module Main where"
+  , "deriving instance Show MyType"
+  ]
+
+testUnicodeSyntax :: Assertion
+testUnicodeSyntax = assert $ isRight $ parseModule [] Nothing $ unlines
+  [ "module Main where"
+  , "monadic ∷ (Monad m) ⇒ m a → m a"
+  , "monadic = id"
+  ]
 
 --------------------------------------------------------------------------------
 isRight :: Either a b -> Bool