require 0.4.6 → 0.4.7
raw patch · 4 files changed
+374/−146 lines, 4 files
Files
- library/Require.hs +212/−87
- package.yaml +1/−1
- require.cabal +2/−2
- test-suite/Main.hs +159/−56
library/Require.hs view
@@ -1,5 +1,9 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiWayIf #-} module Require where +import qualified Data.Char as Char import qualified Data.Text as Text import Options.Generic import Relude@@ -9,13 +13,29 @@ newtype FileName = FileName {unFileName :: Text} +newtype ModuleName = ModuleName { unModuleName :: Text }+ deriving (Eq, Show)+ newtype LineNumber = LineNumber Int+ deriving (Enum) +data LineTag = LineTag !FileName !LineNumber++data FileInput = FileInput+ { fiFileName :: FileName,+ fiContent :: Text+ }+ type Parser = Megaparsec.Parsec Void Text +data RequireDirective+ = ModuleDirective ModuleName+ | RequireDirective RequireInfo+ | AutorequireDirective+ data RequireInfo = RequireInfo- { riFullModuleName :: Text,+ { riFullModuleName :: ModuleName, riModuleAlias :: Text, riImportedTypes :: Maybe [Text] }@@ -27,26 +47,58 @@ instance ParseRecord CommandArguments -findRequires :: IO (Maybe Text)++type LineTagPrepend = LineTag -> Text -> Text++data TransformState = TransformState+ { tstLineTagPrepend :: !LineTagPrepend+ , tstHostModule :: !(Maybe ModuleName)+ , tstAutorequired :: !Bool+ }+++initialLineTag :: FileInput -> LineTag+initialLineTag fi = LineTag (fiFileName fi) (LineNumber 1)++advanceLineTag :: LineTag -> LineTag+advanceLineTag (LineTag fn ln) = LineTag fn (succ ln)++renderLineTag :: LineTag -> Text+renderLineTag (LineTag (FileName fn) (LineNumber ln)) =+ "{-# LINE " <> show ln <> " \"" <> fn <> "\" #-}\n"+++prependLineTag :: LineTagPrepend+prependLineTag = (<>) . renderLineTag++ignoreLineTag :: LineTagPrepend+ignoreLineTag = const id+++findRequires :: IO (Maybe FileName) findRequires = do currentDir <- getCurrentDirectory files <- getDirectoryContents currentDir let textFiles = fmap toText files- return $ head <$> nonEmpty (filter (Text.isSuffixOf "Requires") textFiles)+ return $ FileName . head <$> nonEmpty (filter (Text.isSuffixOf "Requires") textFiles) +readFile' :: FileName -> IO FileInput+readFile' f = FileInput f <$> readFileText (toFilePath f)++toFilePath :: FileName -> FilePath+toFilePath = toString . unFileName++fileInputLines :: FileInput -> [(LineTag, Text)]+fileInputLines fi = zip lineTags contents+ where+ lineTags = iterate advanceLineTag (initialLineTag fi)+ contents = Text.lines (fiContent fi)++ requireMain :: IO () requireMain = do CommandArguments inputFile _ outputFile <- getRecord "Require Haskell preprocessor" :: IO CommandArguments- content <- readFile (toString inputFile)- writeFile- (toString outputFile)- ( toString $- Require.transform- False- (Require.FileName inputFile)- ""- (toText content)- )+ run False Nothing (FileName inputFile) (FileName outputFile) autorequireMain :: IO () autorequireMain = do@@ -54,83 +106,138 @@ requiresFile <- findRequires case requiresFile of Nothing -> die "There is no Requires file in the system"- Just x -> do- file <- readFile $ toString x- content <- readFile (toString inputFile)- writeFile- (toString outputFile)- ( toString $- Require.transform- True- (Require.FileName inputFile)- (toText file)- (toText content)- )+ Just _ -> run True requiresFile (FileName inputFile) (FileName outputFile) -transform :: Bool -> FileName -> Text -> Text -> Text-transform autorequireEnabled filename imports input- | autorequireEnabled = transform' True filename imports input- | noAutorequire = transform' False filename imports input- | otherwise = transform' True filename imports input- where- noAutorequire = not (any ("autorequire" `Text.isPrefixOf`) $ lines input)+run :: Bool -> Maybe FileName -> FileName -> FileName -> IO ()+run autorequire requiresFile inputFile outputFile = do+ input <- readFile' inputFile+ requires <- traverse readFile' requiresFile+ let transformed = Require.transform autorequire input requires+ writeFileText (toFilePath outputFile) transformed -transform' :: Bool -> FileName -> Text -> Text -> Text-transform' shouldPrepend filename prepended input =- Text.lines input- & filter (\t -> not $ "autorequire" `Text.isPrefixOf` t)- & zip [1 ..]- >>= prependAfterModuleLine- <&> (\(ln, text) -> maybe (text <> "\n") (renderImport filename (LineNumber ln)) $ Megaparsec.parseMaybe requireParser text)- & (lineTag filename (LineNumber 1) :)+transform :: Bool -> FileInput -> Maybe FileInput -> Text+transform autorequireEnabled input prepended =+ -- TODO:+ -- * if the mapM overhead is too much maybe use a streaming library+ -- * there is no need to concatenate the whole output in memory, a lazy text would be fine+ -- * maybe we should check if tstAutorequired is set after processing+ fileInputLines input+ & mapM (process (pure Nothing))+ & flip evalState initialState & Text.concat where- enumeratedPrepend ln- | shouldPrepend = zip (repeat ln) (Text.lines prepended)- | otherwise = []- prependAfterModuleLine (ln, text)- | ("module" `Text.isPrefixOf` text)- && ("where" `Text.isSuffixOf`) text =- (ln, text) : enumeratedPrepend ln- | ("instance" `Text.isPrefixOf` text)- && ("where" `Text.isSuffixOf`) text =- [(ln, text)]- | ("data" `Text.isPrefixOf` text)- && ("where" `Text.isSuffixOf`) text =- [(ln, text)]- | ("class" `Text.isPrefixOf` text)- && ("where" `Text.isSuffixOf`) text =- [(ln, text)]- | not ("instance" `Text.isPrefixOf` text)- && not ("class" `Text.isPrefixOf` text)- && not ("data" `Text.isPrefixOf` text)- && ("where" `Text.isPrefixOf`) text =- (ln, text) : enumeratedPrepend ln- | otherwise = [(ln, text)]+ initialState = TransformState+ { tstLineTagPrepend = prependLineTag+ , tstHostModule = Nothing+ , tstAutorequired = False+ } -lineTag :: FileName -> LineNumber -> Text-lineTag (FileName fn) (LineNumber ln) =- "{-# LINE "- <> show ln- <> " \""- <> fn- <> "\" #-}\n"+ process :: State TransformState (Maybe ModuleName) -> (LineTag, Text) -> State TransformState Text+ process getHostModule (tag, line) = do+ let useTagPrep text = do+ prep <- gets tstLineTagPrepend+ modify $ \s -> s { tstLineTagPrepend = ignoreLineTag }+ pure $ prep tag text -renderImport :: FileName -> LineNumber -> RequireInfo -> Text-renderImport filename linenumber RequireInfo {..} =- if Text.isInfixOf riFullModuleName (unFileName filename)- then ""- else typesImport <> lineTag filename linenumber <> qualifiedImport+ let lineWithAutorequire cond+ | autorequireEnabled && cond = do+ -- Call useTagPrep before processAutorequireContent because the+ -- latter one modifies tstLineTagPrepend which the former one uses.+ line' <- useTagPrep $ line <> "\n"+ auto <- processAutorequireContent+ pure $ line' <> auto+ | otherwise =+ useTagPrep $ line <> "\n"++ let hasWhere =+ -- TODO: This assumes that comments have whitespace before them and+ -- that `where` has whitespace before it. But+ -- module Foo (abc)where--something else+ -- is valid in Haskell.+ Text.words line+ & takeWhile (not . ("--" `Text.isPrefixOf`))+ & elem "where"++ case Megaparsec.parseMaybe requireDirectiveParser line of+ Nothing -> do+ hasModule <- gets $ isJust . tstHostModule+ lineWithAutorequire $ hasModule && hasWhere++ Just (ModuleDirective moduleName) -> do+ -- If there is already a module name, don't overwrite it.+ modify $ \s -> s { tstHostModule = tstHostModule s <|> Just moduleName }+ lineWithAutorequire hasWhere++ Just (RequireDirective ri) ->+ -- renderImport already prepends the line tag if necessary.+ renderImport getHostModule tag ri++ Just AutorequireDirective ->+ processAutorequireContent++ processAutorequireContent = do+ alreadyAutorequired <- gets tstAutorequired+ autorequireContent <-+ if | alreadyAutorequired -> pure ""+ | Nothing <- prepended -> pure ""+ | Just pr <- prepended -> do+ modify $ \s -> s+ { tstLineTagPrepend = prependLineTag+ , tstAutorequired = True+ }++ fileInputLines pr+ & mapM (process (gets tstHostModule))+ & fmap Text.concat++ modify $ \s -> s { tstLineTagPrepend = prependLineTag }+ pure autorequireContent+++renderImport :: MonadState TransformState m => m (Maybe ModuleName) -> LineTag -> RequireInfo -> m Text+renderImport getHostModule line RequireInfo {..} = do+ mhostModule <- getHostModule+ lineTagPrep <- gets tstLineTagPrepend+ let (res, prep) =+ if mhostModule == Just riFullModuleName+ then ("", prependLineTag)+ else (typesImport <> renderLineTag line <> qualifiedImport, ignoreLineTag)+ modify $ \s -> s { tstLineTagPrepend = prep }+ pure $ lineTagPrep line res where- types = maybe (Text.takeWhileEnd (/= '.') riFullModuleName) (Text.intercalate ",") riImportedTypes- typesImport = "import " <> riFullModuleName <> " (" <> types <> ")\n"- qualifiedImport = "import qualified " <> riFullModuleName <> " as " <> riModuleAlias <> "\n"+ types = maybe+ (Text.takeWhileEnd (/= '.') (unModuleName riFullModuleName))+ (Text.intercalate ",")+ riImportedTypes+ typesImport = Text.unwords+ [ "import"+ , unModuleName riFullModuleName+ , "(" <> types <> ")"+ ] <> "\n"+ qualifiedImport = Text.unwords+ [ "import qualified"+ , unModuleName riFullModuleName+ , "as"+ , riModuleAlias+ ] <> "\n" -requireParser :: Parser RequireInfo-requireParser = do++requireDirectiveParser :: Parser RequireDirective+requireDirectiveParser = do+ directive <- asum+ [ RequireDirective <$> requireInfoParser+ , AutorequireDirective <$ Megaparsec.string "autorequire"+ , moduleDirectiveParser+ ]+ Megaparsec.space+ skipLineComment+ pure directive++requireInfoParser :: Parser RequireInfo+requireInfoParser = do void $ Megaparsec.string "require" void Megaparsec.space1- module' <- Megaparsec.some (Megaparsec.alphaNumChar <|> Megaparsec.punctuationChar)+ module' <- moduleNameParser void Megaparsec.space alias' <- Megaparsec.try $ Megaparsec.option Nothing $ do void $ Megaparsec.string "as"@@ -142,14 +249,32 @@ t' <- Megaparsec.many (Megaparsec.alphaNumChar <|> Megaparsec.char ',' <|> Megaparsec.char ' ') void $ Megaparsec.char ')' return $ Just t'- void $ Megaparsec.option Nothing $ do- void Megaparsec.space- void $ Megaparsec.some (Megaparsec.char '-')- void $ Megaparsec.many (Megaparsec.alphaNumChar <|> Megaparsec.char ' ')- return Nothing+ return RequireInfo- { riFullModuleName = toText module',- riModuleAlias = maybe (Text.takeWhileEnd (/= '.') $ toText module') toText alias',+ { riFullModuleName = module',+ riModuleAlias = maybe (Text.takeWhileEnd (/= '.') $ unModuleName module') toText alias', riImportedTypes = (fmap Text.strip <$> Text.splitOn ",") . toText <$> types' }++moduleDirectiveParser :: Parser RequireDirective+moduleDirectiveParser = do+ void $ Megaparsec.string "module"+ void $ Megaparsec.space1+ module' <- moduleNameParser+ -- Ignore anything further from the line.+ void $ Megaparsec.takeWhileP Nothing (const True)+ pure $ ModuleDirective module'++moduleNameParser :: Parser ModuleName+moduleNameParser =+ -- This parser is a superset of what makes a valid module name in Haskell+ -- (e.g. we allow consecutive dots, lower-case first letters etc.)+ fmap ModuleName $ Megaparsec.takeWhile1P Nothing $ \c ->+ Char.isAlphaNum c || c == '.' || c == '_' || c == '\''++skipLineComment :: Parser ()+skipLineComment = void $ Megaparsec.optional $+ Megaparsec.string "--"+ *> (Megaparsec.space1 <|> void Megaparsec.alphaNumChar <|> Megaparsec.eof)+ *> Megaparsec.takeWhileP Nothing (const True)
package.yaml view
@@ -1,5 +1,5 @@ name: require-version: "0.4.6"+version: "0.4.7" github: "theam/require" license: Apache-2.0 author: "The Agile Monkeys"
require.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f6bc9c2371f0a167829d05ea4cb94a51e5d3ca3e2bc863a82685611213b5cb05+-- hash: 5b82e041d52ba14c40ad41c6813ec3c9e34e8521dd5ca8fcfb1303bb54a8063e name: require-version: 0.4.6+version: 0.4.7 synopsis: Scrap your qualified import clutter description: See <https://theam.github.io/require> category: Other
test-suite/Main.hs view
@@ -11,59 +11,162 @@ spec :: Spec spec = parallel $ do- it "transforms the 'require' keyword into a properly qualified import" $ do- let input = "require Data.Text"- let expected = "import qualified Data.Text as Text"- let actual = Require.transform False (Require.FileName "Foo.hs") "" input- expected `Text.isInfixOf` actual- it "imports the type based on the module" $ do- let input = "require Data.Text"- let expected = "import Data.Text (Text)"- let actual = Require.transform False (Require.FileName "Foo.hs") "" input- expected `Text.isInfixOf` actual- it "keeps the rest of the content intact" $ do- let input = "module Foo where\nrequire Data.Text\nfoo = 42"- let expectedStart = "{-# LINE 1"- let expectedModule = "module Foo where"- let expectedTypeImport = "import Data.Text (Text)"- let expectedQualifiedImport = "import qualified Data.Text as Text"- let expectedContent = "foo = 42\n"- let actual = toString $ Require.transform False (Require.FileName "Foo.hs") "" input- actual `shouldStartWith` expectedStart- actual `shouldContain` expectedModule- actual `shouldContain` expectedTypeImport- actual `shouldContain` expectedQualifiedImport- actual `shouldEndWith` expectedContent- it "aliases the modules properly" $ do- let input = "require Data.Text as Foo"- let expectedTypeImport = "import Data.Text (Text)"- let expectedQualifiedImport = "import qualified Data.Text as Foo"- let actual = toString $ Require.transform False (Require.FileName "Foo.hs") "" input- actual `shouldContain` expectedTypeImport- actual `shouldContain` expectedQualifiedImport- it "imports the types properly" $ do- let input = "require Data.Text (Foo)"- let expectedTypeImport = "import Data.Text (Foo)"- let expectedQualifiedImport = "import qualified Data.Text as Text"- let actual = toString $ Require.transform False (Require.FileName "Foo.hs") "" input- actual `shouldContain` expectedTypeImport- actual `shouldContain` expectedQualifiedImport- it "imports the types and aliases the modules properly" $ do- let input = "require Data.Text as Quux (Foo)"- let expectedTypeImport = "import Data.Text (Foo)"- let expectedQualifiedImport = "import qualified Data.Text as Quux"- let actual = toString $ Require.transform False (Require.FileName "Foo.hs") "" input- actual `shouldContain` expectedTypeImport- actual `shouldContain` expectedQualifiedImport- it "skips comments" $ do- let input = "require Data.Text -- test of comments"- let expected = "import Data.Text (Text)"- let actual = Require.transform False (Require.FileName "Foo.hs") "" input- expected `Text.isInfixOf` actual- it "allows empty parentheses" $ do- let input = "require Data.Text ()"- let expected1 = "import Data.Text ()"- let expected2 = "import qualified Data.Text as Text"- let actual = lines $ Require.transform False (Require.FileName "Foo.hs") "" input- actual `shouldSatisfy` elem expected1- actual `shouldSatisfy` elem expected2+ let emptyRequiresFile =+ Just $ Require.FileInput (Require.FileName "Requires") ""++ describe "the transformation" $ do+ it "transforms the 'require' keyword into a properly qualified import" $ do+ let input = "require Data.Text"+ let expected = "import qualified Data.Text as Text"+ let actual = Require.transform False+ (Require.FileInput (Require.FileName "Foo.hs") input)+ emptyRequiresFile+ expected `Text.isInfixOf` actual+ it "imports the type based on the module" $ do+ let input = "require Data.Text"+ let expected = "import Data.Text (Text)"+ let actual = Require.transform False+ (Require.FileInput (Require.FileName "Foo.hs") input)+ emptyRequiresFile+ expected `Text.isInfixOf` actual+ it "keeps the rest of the content intact" $ do+ let input = "module Foo where\nrequire Data.Text\nfoo = 42"+ let expectedStart = "{-# LINE 1"+ let expectedModule = "module Foo where"+ let expectedTypeImport = "import Data.Text (Text)"+ let expectedQualifiedImport = "import qualified Data.Text as Text"+ let expectedContent = "foo = 42\n"+ let actual = toString $ Require.transform False+ (Require.FileInput (Require.FileName "Foo.hs") input)+ emptyRequiresFile+ actual `shouldStartWith` expectedStart+ actual `shouldContain` expectedModule+ actual `shouldContain` expectedTypeImport+ actual `shouldContain` expectedQualifiedImport+ actual `shouldEndWith` expectedContent+ it "aliases the modules properly" $ do+ let input = "require Data.Text as Foo"+ let expectedTypeImport = "import Data.Text (Text)"+ let expectedQualifiedImport = "import qualified Data.Text as Foo"+ let actual = toString $ Require.transform False+ (Require.FileInput (Require.FileName "Foo.hs") input)+ emptyRequiresFile+ actual `shouldContain` expectedTypeImport+ actual `shouldContain` expectedQualifiedImport+ it "imports the types properly" $ do+ let input = "require Data.Text (Foo)"+ let expectedTypeImport = "import Data.Text (Foo)"+ let expectedQualifiedImport = "import qualified Data.Text as Text"+ let actual = toString $ Require.transform False+ (Require.FileInput (Require.FileName "Foo.hs") input)+ emptyRequiresFile+ actual `shouldContain` expectedTypeImport+ actual `shouldContain` expectedQualifiedImport+ it "imports the types and aliases the modules properly" $ do+ let input = "require Data.Text as Quux (Foo)"+ let expectedTypeImport = "import Data.Text (Foo)"+ let expectedQualifiedImport = "import qualified Data.Text as Quux"+ let actual = toString $ Require.transform False+ (Require.FileInput (Require.FileName "Foo.hs") input)+ emptyRequiresFile+ actual `shouldContain` expectedTypeImport+ actual `shouldContain` expectedQualifiedImport+ it "skips comments" $ do+ let input = "require Data.Text -- test of comments"+ let expected = "import Data.Text (Text)"+ let actual = Require.transform False+ (Require.FileInput (Require.FileName "Foo.hs") input)+ emptyRequiresFile+ expected `Text.isInfixOf` actual+ it "allows empty parentheses" $ do+ let input = "require Data.Text ()"+ let expected1 = "import Data.Text ()"+ let expected2 = "import qualified Data.Text as Text"+ let actual = lines $ Require.transform False+ (Require.FileInput (Require.FileName "Foo.hs") input)+ emptyRequiresFile+ actual `shouldSatisfy` elem expected1+ actual `shouldSatisfy` elem expected2++ describe "require-mode" $ do+ it "respects autorequire directives" $ do+ let fileInput = Text.unlines [ "module Main where", "autorequire", "import B" ]+ let requireInput = Text.unlines [ "import A" ]+ let actual = Text.lines $ Require.transform False+ (Require.FileInput (Require.FileName "src/Foo/Bar.hs") fileInput)+ (Just $ Require.FileInput (Require.FileName "Requires") requireInput)+ actual `shouldSatisfy` elem "module Main where"+ actual `shouldSatisfy` elem "import A"+ actual `shouldSatisfy` elem "import B"+ it "keeps requires where the module is a substring of the filename" $ do+ -- Test case for https://github.com/theam/require/issues/20+ let fileInput = Text.unlines [ "module FooTest where", "require Foo" ]+ let expected1 = "import Foo (Foo)"+ let expected2 = "import qualified Foo as Foo"+ let actual = lines $ Require.transform False+ (Require.FileInput (Require.FileName "FooTests.hs") fileInput)+ emptyRequiresFile+ actual `shouldSatisfy` elem expected1+ actual `shouldSatisfy` elem expected2++ describe "autorequire-mode" $ do+ describe "inclusion after module directive" $ do+ let checkInclusion n fileInput = do+ let requireInput = "import A"+ let actual = Text.lines $ Require.transform True+ (Require.FileInput (Require.FileName "src/Foo/Bar.hs") fileInput)+ (Just $ Require.FileInput (Require.FileName "Requires") requireInput)+ let elemN x = (n ==) . length . filter (x ==)+ actual `shouldSatisfy` elemN requireInput++ it "works for no export list" $ do+ checkInclusion 1 "module Main where"+ it "works for a one line export list" $ do+ checkInclusion 1 "module Main (Datatype(..), (*+), foo, Bar) where"+ it "works for a multi line export list" $ do+ checkInclusion 1 $ Text.unlines+ [ "module Main"+ , " ( -- * Foo"+ , " , Foo(..)"+ , " , (*+)"+ , " , -- ** Bar"+ , " foo, Bar"+ , " ) where"+ ]+ it "doesn't add after data/class/instance declarations" $ do+ checkInclusion 0 $ Text.unlines+ [ "class Foo a where"+ , "instance Foo x => Bar (Baz x) where"+ , "data Vec n a where"+ , " Nil :: Vec 0 a"+ , " Cons :: a -> Vec n a -> Vec (n + 1) a"+ ]+ it "doesn't add after data/class/instance declarations split to multiple lines" $ do+ checkInclusion 0 $ Text.unlines+ [ "class Foo a -- some explanation here"+ , " where"+ ]++ it "drops self-imports" $ do+ let fileInput = "module Foo.Bar where"+ let requireInput = "require Foo.Bar"+ let notExpected = "import Foo.Bar"+ let actual = Require.transform True+ (Require.FileInput (Require.FileName "src/Foo/Bar.hs") fileInput)+ (Just $ Require.FileInput (Require.FileName "Requires") requireInput)+ toString actual `shouldNotContain` notExpected+ it "adds LINE pragmas around the Requires contents" $ do+ let fileInput = Text.unlines [ "module Main where", "import B" ]+ let requireInput = Text.unlines [ "import A" ]+ let expected = Text.unlines+ [ "{-# LINE 1 \"Foo.hs\" #-}"+ , "module Main where"+ , "{-# LINE 1 \"Requires\" #-}"+ , "import A"+ , "{-# LINE 2 \"Foo.hs\" #-}"+ , "import B"+ ]+ let actual = Require.transform True+ (Require.FileInput (Require.FileName "Foo.hs") fileInput)+ (Just $ Require.FileInput (Require.FileName "Requires") requireInput)+ actual `shouldBe` expected