require 0.4.7 → 0.4.8
raw patch · 8 files changed
+453/−298 lines, 8 files
Files
- library/Require.hs +14/−250
- library/Require/File.hs +58/−0
- library/Require/Parser.hs +87/−0
- library/Require/Transform.hs +145/−0
- library/Require/Types.hs +44/−0
- package.yaml +1/−1
- require.cabal +6/−2
- test-suite/Main.hs +98/−45
library/Require.hs view
@@ -1,104 +1,32 @@-{-# 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 import System.Directory-import qualified Text.Megaparsec as Megaparsec-import qualified Text.Megaparsec.Char as Megaparsec+import qualified Require.File as File+import Require.Transform+import Require.Types -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 :: ModuleName,- riModuleAlias :: Text,- riImportedTypes :: Maybe [Text]- }- deriving (Show)- data CommandArguments = CommandArguments Text Text Text deriving (Generic) instance ParseRecord CommandArguments --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 :: IO (Maybe File.Name) findRequires = do currentDir <- getCurrentDirectory files <- getDirectoryContents currentDir let textFiles = fmap toText files- 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)-+ return $ File.Name . head <$> nonEmpty (filter (Text.isSuffixOf "Requires") textFiles) requireMain :: IO () requireMain = do CommandArguments inputFile _ outputFile <- getRecord "Require Haskell preprocessor" :: IO CommandArguments- run False Nothing (FileName inputFile) (FileName outputFile)+ requiresFile <- findRequires+ run (AutorequireOnDirective requiresFile) (File.Name inputFile) (File.Name outputFile) autorequireMain :: IO () autorequireMain = do@@ -106,175 +34,11 @@ requiresFile <- findRequires case requiresFile of Nothing -> die "There is no Requires file in the system"- Just _ -> run True requiresFile (FileName inputFile) (FileName outputFile)--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 -> 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- initialState = TransformState- { tstLineTagPrepend = prependLineTag- , tstHostModule = Nothing- , tstAutorequired = False- }-- 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-- 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 (/= '.') (unModuleName riFullModuleName))- (Text.intercalate ",")- riImportedTypes- typesImport = Text.unwords- [ "import"- , unModuleName riFullModuleName- , "(" <> types <> ")"- ] <> "\n"- qualifiedImport = Text.unwords- [ "import qualified"- , unModuleName riFullModuleName- , "as"- , riModuleAlias- ] <> "\n"---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' <- moduleNameParser- void Megaparsec.space- alias' <- Megaparsec.try $ Megaparsec.option Nothing $ do- void $ Megaparsec.string "as"- void Megaparsec.space1- Just <$> Megaparsec.some Megaparsec.alphaNumChar- void Megaparsec.space- types' <- Megaparsec.option Nothing $ do- void $ Megaparsec.char '('- t' <- Megaparsec.many (Megaparsec.alphaNumChar <|> Megaparsec.char ',' <|> Megaparsec.char ' ')- void $ Megaparsec.char ')'- return $ Just t'-- return- RequireInfo- { 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 == '\''+ Just fn -> run (AutorequireEnabled fn) (File.Name inputFile) (File.Name outputFile) -skipLineComment :: Parser ()-skipLineComment = void $ Megaparsec.optional $- Megaparsec.string "--"- *> (Megaparsec.space1 <|> void Megaparsec.alphaNumChar <|> Megaparsec.eof)- *> Megaparsec.takeWhileP Nothing (const True)+run :: AutorequireMode File.Name -> File.Name -> File.Name -> IO ()+run autoMode inputFile outputFile = do+ input <- File.read inputFile+ autoInput <- traverse File.read autoMode+ let transformed = transform autoInput input+ File.write outputFile transformed
+ library/Require/File.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | This module contains functions for file handling. The names of the+-- functions and data types are chosen in a way to suggest a qualified import.+--+-- @+-- __import qualified__ Require.File __as__ File+-- @+module Require.File where++import Relude++-- | Wraps the name of a file as given by the user. Usually this corresponds to+-- the file's path.+newtype Name = Name Text++-- | Associates a file's contents with the path from which it was read.+data Input = Input+ { inputName :: Name,+ inputContent :: Text+ }++-- | A type-safe wrapper for line numbers.+newtype LineNumber = LineNumber Int+ deriving (Enum)++-- | Identifies a specific line in a file.+data LineTag = LineTag !Name !LineNumber++-- | Returns the 'LineTag' referencing the first line in a given 'FileInput'.+--+-- Note that the tag's line number is 1-based, which fits well with how GHC+-- understands @{-# LINE ... #-}@ pragmas.+initialLineTag :: Input -> LineTag+initialLineTag inp = LineTag (inputName inp) (LineNumber 1)++-- | Returns a line tag from the same file but referencing the next line.+advanceLineTag :: LineTag -> LineTag+advanceLineTag (LineTag fn ln) = LineTag fn (succ ln)++-- | @read name@ reads the contents of the file identified by @name@.+read :: Name -> IO Input+read f = Input f <$> readFileText (nameToPath f)++-- | @write name content@ writes @content@ to the file identified by @name@.+write :: Name -> Text -> IO ()+write = writeFileText . nameToPath++-- | Splits the input into lines and annotates each with a 'LineTag'.+inputLines :: Input -> [(LineTag, Text)]+inputLines fi = zip lineTags contents+ where+ lineTags = iterate advanceLineTag (initialLineTag fi)+ contents = lines (inputContent fi)++-- | Returns the 'FilePath' corresponding a given 'Name'.+nameToPath :: Name -> FilePath+nameToPath (Name fp) = toString fp
+ library/Require/Parser.hs view
@@ -0,0 +1,87 @@+module Require.Parser+ ( Parser+ , requireDirective+ , Megaparsec.parseMaybe+ ) where++import qualified Data.Char as Char+import qualified Data.Text as Text+import Relude+import Require.Types+import qualified Text.Megaparsec as Megaparsec+import qualified Text.Megaparsec.Char as Megaparsec++type Parser = Megaparsec.Parsec Void Text++requireDirective :: Parser RequireDirective+requireDirective = do+ directive <- asum+ [ RequireDirective <$> requireInfo+ , AutorequireDirective <$ Megaparsec.string "autorequire"+ , moduleDirective+ ]+ Megaparsec.space+ skipLineComment+ pure directive++requireInfo :: Parser RequireInfo+requireInfo = do+ void $ Megaparsec.string "require"+ void Megaparsec.space1+ module' <- moduleNameParser+ void Megaparsec.space+ alias' <- Megaparsec.try $ Megaparsec.option Nothing $ do+ void $ Megaparsec.string "as"+ void Megaparsec.space1+ Just <$> Megaparsec.some Megaparsec.alphaNumChar+ void Megaparsec.space+ types' <- Megaparsec.option Nothing $ do+ void $ Megaparsec.char '('+ t' <- Megaparsec.many (Megaparsec.alphaNumChar <|> Megaparsec.char ',' <|> Megaparsec.char ' ')+ void $ Megaparsec.char ')'+ return $ Just t'++ let defaultAlias = defaultModuleAlias module'+ return+ RequireInfo+ { riFullModuleName = module',+ riModuleAlias = maybe defaultAlias toText alias',+ riImportedTypes = maybe defaultAlias toText types'+ }++moduleDirective :: Parser RequireDirective+moduleDirective = 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'++-- | Parses a haskell module name.+--+-- 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.).+moduleNameParser :: Parser ModuleName+moduleNameParser =+ fmap ModuleName $ Megaparsec.takeWhile1P Nothing $ \c ->+ Char.isAlphaNum c || c == '.' || c == '_' || c == '\''++-- | Skips a haskell line comment.+--+-- This parser never fails.+skipLineComment :: Parser ()+skipLineComment = void $ Megaparsec.optional $+ Megaparsec.string "--"+ *> (Megaparsec.space1 <|> void Megaparsec.alphaNumChar <|> Megaparsec.eof)+ *> Megaparsec.takeWhileP Nothing (const True)++-- | Extracts the module alias to be used when none is specified. This+-- corresponds to the last segment of the module's hierarchical name.+--+-- >>> defaultModuleAlias (ModuleName "Data.Text.Lazy")+-- "Lazy"+-- >>> defaultModuleAlias (ModuleName "Main")+-- "Main"+defaultModuleAlias :: ModuleName -> Text+defaultModuleAlias = Text.takeWhileEnd (/= '.') . unModuleName
+ library/Require/Transform.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE FlexibleContexts #-}+module Require.Transform where++import qualified Data.Text as Text+import Relude+import qualified Require.File as File+import qualified Require.Parser as Parser+import Require.Types+++type LineTagPrepend = File.LineTag -> Text -> Text++data TransformState = TransformState+ { tstLineTagPrepend :: !LineTagPrepend+ , tstHostModule :: !(Maybe ModuleName)+ , tstAutorequire :: !(AutorequireMode File.Input)+ }+++renderLineTag :: File.LineTag -> Text+renderLineTag (File.LineTag (File.Name fn) (File.LineNumber ln)) =+ "{-# LINE " <> show ln <> " \"" <> fn <> "\" #-}\n"+++prependLineTag :: LineTagPrepend+prependLineTag = (<>) . renderLineTag++ignoreLineTag :: LineTagPrepend+ignoreLineTag = const id+++transform :: AutorequireMode File.Input -> File.Input -> Text+transform autorequire input =+ -- 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+ File.inputLines input+ & mapM (process (pure Nothing))+ & flip evalState initialState+ & mconcat+ where+ initialState = TransformState+ { tstLineTagPrepend = prependLineTag+ , tstHostModule = Nothing+ , tstAutorequire = autorequire+ }++process+ :: State TransformState (Maybe ModuleName)+ -> (File.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++ let lineWithAutorequire isDirective autoCondition = do+ autoMode <- gets tstAutorequire+ case autoMode of+ AutorequireEnabled autoContent+ | isDirective || autoCondition -> do+ line' <- if isDirective then pure "" else useTagPrep (line <> "\n")+ auto <- processAutorequireContent autoContent+ pure $ line' <> auto+ AutorequireOnDirective (Just autoContent)+ | isDirective -> do+ processAutorequireContent autoContent+ AutorequireOnDirective Nothing+ | isDirective ->+ -- TODO: Better error reporting.+ error "Found an `autorequire` directive but no `Requires` file was found."+ _ | isDirective -> pure ""+ | 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.+ words line+ & takeWhile (not . ("--" `Text.isPrefixOf`))+ & elem "where"++ case Parser.parseMaybe Parser.requireDirective line of+ Nothing -> do+ hasModule <- gets $ isJust . tstHostModule+ lineWithAutorequire False $ 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 False hasWhere++ Just (RequireDirective ri) ->+ -- renderImport already prepends the line tag if necessary.+ renderImport getHostModule tag ri++ Just AutorequireDirective ->+ lineWithAutorequire True False+++processAutorequireContent :: File.Input -> State TransformState Text+processAutorequireContent autorequireContent = do+ modify $ \s -> s+ { tstLineTagPrepend = prependLineTag+ , tstAutorequire = AutorequireDisabled+ }++ processed <- File.inputLines autorequireContent+ & mapM (process (gets tstHostModule))+ & fmap mconcat++ modify $ \s -> s { tstLineTagPrepend = prependLineTag }+ pure processed+++renderImport+ :: MonadState TransformState m+ => m (Maybe ModuleName)+ -> File.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+ typesImport = unwords+ [ "import"+ , unModuleName riFullModuleName+ , "(" <> riImportedTypes <> ")"+ ] <> "\n"+ qualifiedImport = unwords+ [ "import qualified"+ , unModuleName riFullModuleName+ , "as"+ , riModuleAlias+ ] <> "\n"
+ library/Require/Types.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveTraversable #-}+module Require.Types where++import Relude++-- | A type-safe wrapper around a fully qualified module name.+newtype ModuleName = ModuleName { unModuleName :: Text }+ deriving (Eq, Show)+++-- | Describes the different directives which require special processing during+-- the transformation step.+data RequireDirective+ = ModuleDirective ModuleName+ | RequireDirective RequireInfo+ | AutorequireDirective+++-- | Describes the contents of a parsed @require@ directive.+--+-- @+-- require /riFullModuleName/ as /riModuleAlias/ (/riImportedTypes/)+-- @+data RequireInfo+ = RequireInfo+ { riFullModuleName :: !ModuleName,+ riModuleAlias :: !Text,+ riImportedTypes :: !Text+ }+ deriving (Show)+++data AutorequireMode a+ = AutorequireEnabled a+ -- ^ Include the contents of the Requires file directly after the @module …+ -- where@ directive.++ | AutorequireOnDirective (Maybe a)+ -- ^ Include the contents of the Requires file when the user specifies the+ -- @autorequire@ directive.++ | AutorequireDisabled+ -- ^ Don't do any auto-requiring.+ deriving (Functor, Foldable, Traversable)
package.yaml view
@@ -1,5 +1,5 @@ name: require-version: "0.4.7"+version: "0.4.8" 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: 5b82e041d52ba14c40ad41c6813ec3c9e34e8521dd5ca8fcfb1303bb54a8063e+-- hash: ceeb2f9c5a160393a1fd86ca01c63c4d957d256ae92501abfd87e3d415f5c686 name: require-version: 0.4.7+version: 0.4.8 synopsis: Scrap your qualified import clutter description: See <https://theam.github.io/require> category: Other@@ -34,6 +34,10 @@ library exposed-modules: Require+ Require.File+ Require.Parser+ Require.Transform+ Require.Types other-modules: Paths_require hs-source-dirs:
test-suite/Main.hs view
@@ -1,6 +1,8 @@ import qualified Data.Text as Text import Relude-import qualified Require+import qualified Require.File as File+import qualified Require.Transform as Require+import Require.Types import qualified Test.Tasty import Test.Tasty.Hspec @@ -11,23 +13,20 @@ spec :: Spec spec = parallel $ do- 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+ let actual = Require.transform+ AutorequireDisabled+ (File.Input (File.Name "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.FileInput (Require.FileName "Foo.hs") input)- emptyRequiresFile+ let actual = Require.transform+ AutorequireDisabled+ (File.Input (File.Name "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"@@ -36,9 +35,9 @@ 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+ let actual = toString $ Require.transform+ AutorequireDisabled+ (File.Input (File.Name "Foo.hs") input) actual `shouldStartWith` expectedStart actual `shouldContain` expectedModule actual `shouldContain` expectedTypeImport@@ -48,43 +47,43 @@ 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+ let actual = toString $ Require.transform+ AutorequireDisabled+ (File.Input (File.Name "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.FileInput (Require.FileName "Foo.hs") input)- emptyRequiresFile+ let actual = toString $ Require.transform+ AutorequireDisabled+ (File.Input (File.Name "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.FileInput (Require.FileName "Foo.hs") input)- emptyRequiresFile+ let actual = toString $ Require.transform+ AutorequireDisabled+ (File.Input (File.Name "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.FileInput (Require.FileName "Foo.hs") input)- emptyRequiresFile+ let actual = Require.transform+ AutorequireDisabled+ (File.Input (File.Name "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.FileInput (Require.FileName "Foo.hs") input)- emptyRequiresFile+ let actual = lines $ Require.transform+ AutorequireDisabled+ (File.Input (File.Name "Foo.hs") input) actual `shouldSatisfy` elem expected1 actual `shouldSatisfy` elem expected2 @@ -92,20 +91,29 @@ 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)+ let actual = Text.lines $ Require.transform+ (AutorequireOnDirective $ Just $ File.Input (File.Name "Requires") requireInput)+ (File.Input (File.Name "src/Foo/Bar.hs") fileInput) actual `shouldSatisfy` elem "module Main where" actual `shouldSatisfy` elem "import A" actual `shouldSatisfy` elem "import B"+ actual `shouldSatisfy` elemN 0 "autorequire"+ it "ignores a second autorequire directive" $ do+ let fileInput = Text.unlines [ "autorequire", "autorequire" ]+ let requireInput = Text.unlines [ "import A" ]+ let actual = Text.lines $ Require.transform+ (AutorequireOnDirective $ Just $ File.Input (File.Name "Requires") requireInput)+ (File.Input (File.Name "src/Foo/Bar.hs") fileInput)+ actual `shouldSatisfy` elemN 1 "import A"+ actual `shouldSatisfy` elemN 0 "autorequire" 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+ let actual = lines $ Require.transform+ AutorequireDisabled+ (File.Input (File.Name "FooTests.hs") fileInput) actual `shouldSatisfy` elem expected1 actual `shouldSatisfy` elem expected2 @@ -113,11 +121,10 @@ 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+ let actual = Text.lines $ Require.transform+ (AutorequireEnabled $ File.Input (File.Name "Requires") requireInput)+ (File.Input (File.Name "src/Foo/Bar.hs") fileInput)+ actual `shouldSatisfy` elemN n requireInput it "works for no export list" $ do checkInclusion 1 "module Main where"@@ -147,13 +154,54 @@ , " where" ] + describe "triggered using the autorequire directive" $ do+ it "can be triggered before without a module directive" $ do+ let fileInput = unlines [ "autorequire", "main = return ()" ]+ let requireInput = unlines [ "import A" ]+ let expected = unlines+ [ "{-# LINE 1 \"Requires\" #-}"+ , "import A"+ , "{-# LINE 2 \"Foo.hs\" #-}"+ , "main = return ()"+ ]+ let actual = Require.transform+ (AutorequireEnabled $ File.Input (File.Name "Requires") requireInput)+ (File.Input (File.Name "Foo.hs") fileInput)+ actual `shouldBe` expected+ it "can't be retrigged after the module directive" $ do+ let fileInput = unlines [ "module Main where", "autorequire" ]+ let requireInput = unlines [ "import A" ]+ let expected = unlines+ [ "{-# LINE 1 \"Foo.hs\" #-}"+ , "module Main where"+ , "{-# LINE 1 \"Requires\" #-}"+ , "import A"+ ]+ let actual = Require.transform+ (AutorequireEnabled $ File.Input (File.Name "Requires") requireInput)+ (File.Input (File.Name "Foo.hs") fileInput)+ actual `shouldBe` expected+ it "doesn't retrigger automatically after the module directive" $ do+ let fileInput = unlines [ "autorequire", "module Main where" ]+ let requireInput = unlines [ "import A" ]+ let expected = unlines+ [ "{-# LINE 1 \"Requires\" #-}"+ , "import A"+ , "{-# LINE 2 \"Foo.hs\" #-}"+ , "module Main where"+ ]+ let actual = Require.transform+ (AutorequireEnabled $ File.Input (File.Name "Requires") requireInput)+ (File.Input (File.Name "Foo.hs") fileInput)+ actual `shouldBe` expected+ 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)+ let actual = Require.transform+ (AutorequireEnabled $ File.Input (File.Name "Requires") requireInput)+ (File.Input (File.Name "src/Foo/Bar.hs") fileInput) toString actual `shouldNotContain` notExpected it "adds LINE pragmas around the Requires contents" $ do let fileInput = Text.unlines [ "module Main where", "import B" ]@@ -166,7 +214,12 @@ , "{-# 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)+ let actual = Require.transform+ (AutorequireEnabled $ File.Input (File.Name "Requires") requireInput)+ (File.Input (File.Name "Foo.hs") fileInput) actual `shouldBe` expected+++-- | Checks if a given element is contained exactly @n@ times in the given list.+elemN :: Eq a => Int -> a -> [a] -> Bool+elemN n a = (n ==) . length . filter (a ==)