update QA to latest haskell-src-exts

This commit is contained in:
Vincent Hanquez 2017-02-24 16:05:12 +00:00
parent ef27301a8f
commit c45bb19aba

18
QA.hs
View File

@ -1,7 +1,8 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module Main where module Main where
import Language.Haskell.Exts import Language.Haskell.Exts hiding (ModuleName)
import qualified Language.Haskell.Exts as E
import Language.Haskell.Exts.Pretty import Language.Haskell.Exts.Pretty
import Data.List import Data.List
import Data.IORef import Data.IORef
@ -17,10 +18,16 @@ import Control.Exception
import System.Console.ANSI import System.Console.ANSI
newtype ModuleName = ModuleName String
deriving (Show,Eq)
allowedExtensions = allowedExtensions =
[ ScopedTypeVariables, BangPatterns, ForeignFunctionInterface, DeriveDataTypeable, ViewPatterns, GeneralizedNewtypeDeriving, ExistentialQuantification, EmptyDataDecls ] [ ScopedTypeVariables, BangPatterns, ForeignFunctionInterface, DeriveDataTypeable, ViewPatterns, GeneralizedNewtypeDeriving, ExistentialQuantification, EmptyDataDecls
, TypeFamilies, KindSignatures ]
perModuleAllowedExtensions = perModuleAllowedExtensions =
[ ("Crypto/Hash/Utils.hs", [MagicHash]) [ ("Crypto/Hash/Utils.hs", [MagicHash])
, ("Crypto/Hash/Algorithms.hs", [CPP])
, ("Crypto/Hash/SHAKE.hs", [UndecidableInstances,TypeOperators,ConstraintKinds,DataKinds,KindSignatures])
, ("Crypto/Internal/ByteArray.hs", [MagicHash, UnboxedTuples]) , ("Crypto/Internal/ByteArray.hs", [MagicHash, UnboxedTuples])
, ("Crypto/Internal/Memory.hs", [MagicHash, UnboxedTuples]) , ("Crypto/Internal/Memory.hs", [MagicHash, UnboxedTuples])
, ("Crypto/Internal/Compat.hs", [CPP]) , ("Crypto/Internal/Compat.hs", [CPP])
@ -50,6 +57,7 @@ disallowedModules =
, (ModuleName "Control.Applicative", ModuleName "Crypto.Internal.Imports") , (ModuleName "Control.Applicative", ModuleName "Crypto.Internal.Imports")
] ]
perModuleAllowedModules :: [(FilePath, [ModuleName])]
perModuleAllowedModules = perModuleAllowedModules =
[ ("Crypto/Internal/Imports.hs", [ ("Crypto/Internal/Imports.hs",
[ ModuleName "Control.Applicative" [ ModuleName "Control.Applicative"
@ -200,7 +208,7 @@ main = do
unless allowed' $ recordIssue st (Issue_Extension $ show ext) unless allowed' $ recordIssue st (Issue_Extension $ show ext)
-- check for disallowed modules -- check for disallowed modules
forM_ (map importModule $ getModulesImports mod) $ \impMod -> forM_ (map (flattenModuleName . importModule) $ getModulesImports mod) $ \impMod ->
case lookup impMod disallowedModules of case lookup impMod disallowedModules of
Nothing -> return () Nothing -> return ()
Just newMod | file == moduleToFile impMod -> return () Just newMod | file == moduleToFile impMod -> return ()
@ -242,7 +250,9 @@ recordIssue st s =
recordInfo st n f = return () recordInfo st n f = return ()
getModulesImports (Module _ _ _ _ _ imports _) = imports getModulesImports (Module _ _ _ imports _) = imports
flattenModuleName (E.ModuleName _ mn) = ModuleName mn
getEnabledExts = foldl doAcc [] getEnabledExts = foldl doAcc []
where doAcc acc (EnableExtension e) = e : acc where doAcc acc (EnableExtension e) = e : acc