Refactor to have a flags in a record

Author: ndmitchell

src/HSE/All.hs

@@ -5,7 +5,7 @@ module HSE.All(
     module HSE.Bracket, module HSE.Match,
     module HSE.Generics,
     module HSE.NameMatch,
-    parseFile, parseString, fromParseResult
+    ParseFlags(..), parseFlags, parseFile, parseString, fromParseResult
     ) where
 
 import Language.Haskell.Exts hiding (parse, parseFile, paren, fromParseResult)
@@ -23,22 +23,31 @@ import Data.List
 import Language.Preprocessor.Cpphs
 
 
+data ParseFlags = ParseFlags
+    {cpphs :: Maybe CpphsOptions
+    ,implies :: Bool
+    }
+
+parseFlags :: ParseFlags
+parseFlags = ParseFlags Nothing False
+
+
 -- | Parse a Haskell module
-parseString :: Maybe CpphsOptions -> Bool -> FilePath -> String -> ParseResult Module
-parseString cpphs implies file = parseFileContentsWithMode mode . maybe id (`runCpphs` file) cpphs
+parseString :: ParseFlags -> FilePath -> String -> ParseResult Module
+parseString flags file = parseFileContentsWithMode mode . maybe id (`runCpphs` file) (cpphs flags)
     where
         mode = defaultParseMode
             {parseFilename = file
             ,extensions = extension
-            ,fixities = concat [infix_ (-1) ["==>"] | implies] ++ baseFixities
+            ,fixities = concat [infix_ (-1) ["==>"] | implies flags] ++ baseFixities
             }
 
 
 -- | On failure returns an empty module and prints to the console
-parseFile :: Maybe CpphsOptions -> Bool -> FilePath -> IO (ParseResult Module)
-parseFile cpphs implies file = do
+parseFile :: ParseFlags -> FilePath -> IO (ParseResult Module)
+parseFile flags file = do
     src <- readFile file
-    return $ parseString cpphs implies file src
+    return $ parseString flags file src
 
 
 -- | TODO: Use the fromParseResult in HSE once it gives source location

src/Main.hs

@@ -16,6 +16,7 @@ import Test
 import Util
 import Parallel
 import Hint.All
+import HSE.All
 
 
 main = do
@@ -24,7 +25,7 @@ main = do
         settings <- readSettings cmdHintFiles
         let extra = [Classify Ignore x ("","") | x <- cmdIgnore]
         let apply :: FilePath -> IO [Idea]
-            apply = fmap (fmap $ classify $ settings ++ extra) . applyHint (Just cmdCpphs) (allHints settings)
+            apply = fmap (fmap $ classify $ settings ++ extra) . applyHint parseFlags{cpphs=Just cmdCpphs} (allHints settings)
         ideas <- liftM concat $ parallel [listM' =<< apply x | x <- cmdFiles]
         showItem <- if cmdColor then showANSI else return show
         mapM_ putStrLn [showItem i | i <- ideas, cmdShowAll || rank i /= Ignore]

src/Settings.hs

@@ -25,7 +25,7 @@ readSettings xs = do
 -- currently it doesn't
 readHints :: FilePath -> IO [Module]
 readHints file = do
-    y <- fromParseResult `fmap` parseFile Nothing True file
+    y <- fromParseResult `fmap` parseFile parseFlags{implies=True} file
     ys <- concatMapM (f . fromNamed . importModule) $ moduleImports y
     return $ y:ys
     where

src/Test.hs

@@ -69,7 +69,7 @@ parseTestFile :: FilePath -> IO [(NameMatch, Test)]
 parseTestFile file = do
     src <- readFile file
     return [(nm, createTest eqn)
-           | code <- f $ lines src, let modu = fromParseResult $ parseString Nothing False file code
+           | code <- f $ lines src, let modu = fromParseResult $ parseString parseFlags file code
            , let nm = nameMatch $ moduleImports modu
            , eqn <- concatMap getEquations $ moduleDecls modu]
     where

src/Type.hs

@@ -7,7 +7,6 @@ import Data.Char
 import Data.List
 import Data.Maybe
 import Data.Ord
-import Language.Preprocessor.Cpphs
 import Language.Haskell.HsColour.TTY
 import Language.Haskell.HsColour.Colourise
 
@@ -83,10 +82,10 @@ type ModuHint = NameMatch -> Module -> [Idea]
 data Hint = DeclHint {declHint :: DeclHint} | ModuHint {moduHint :: ModuHint}
 
 
-applyHint :: Maybe CpphsOptions -> [Hint] -> FilePath -> IO [Idea]
-applyHint cpphs h file = do
+applyHint :: ParseFlags -> [Hint] -> FilePath -> IO [Idea]
+applyHint flags h file = do
     src <- readFile file
-    case parseString cpphs False file src of
+    case parseString flags file src of
         ParseFailed sl msg -> do
             let ticks = ["  ","  ","> ","  ","  "]
             let bad = zipWith (++) ticks $ take 5 $ drop (srcLine sl - 3) $ lines src ++ [""]