diff --git a/library/Require.hs b/library/Require.hs --- a/library/Require.hs +++ b/library/Require.hs @@ -2,53 +2,67 @@ import Universum -import qualified Data.Text as Text +import qualified Text.Megaparsec as Megaparsec +import qualified Text.Megaparsec.Char as Megaparsec +import qualified Data.Text as Text -newtype FileName = FileName Text +newtype FileName = FileName Text +newtype LineNumber = LineNumber Int +type Parser = Megaparsec.Parsec Void Text + +data RequireInfo = RequireInfo + { riFullModuleName :: Text + , riModuleAlias :: Text + , riImportedTypes :: Maybe [Text] + } deriving Show + + transform :: FileName -> Text -> Text transform filename input = - let - foo = Text.lines input - <&> (Text.splitOn "require") - & zip [1..] - <&> (\(lineNumber, texts) -> convertIfNeeded filename lineNumber texts) - & Text.concat - in foo + Text.lines input + & zip [1..] + <&> (\(ln, text) -> maybe (text <> "\n") (renderImport filename (LineNumber ln)) $ Megaparsec.parseMaybe requireParser text ) + & Text.concat -convertIfNeeded :: FileName -> Int -> [Text] -> Text -convertIfNeeded (FileName fn) lineNumber texts = - case texts of - ["", moduleName] -> - let - moduleLast = Text.reverse moduleName - & Text.takeWhile (/= '.') - & Text.reverse +renderImport :: FileName -> LineNumber -> RequireInfo -> Text +renderImport (FileName fn) (LineNumber ln) RequireInfo {..} = + lineTag <> typesImport <> lineTag <> qualifiedImport + where + lineTag = "{-# LINE " + <> show ln + <> " \"" + <> fn + <> "\" #-}\n" + types = maybe (Text.takeWhileEnd (/= '.') riFullModuleName) (Text.intercalate ",") riImportedTypes + typesImport = "import " <> riFullModuleName <> " (" <> types <> ")\n" + qualifiedImport = "import qualified " <> riFullModuleName <> " as " <> riModuleAlias <> "\n" - qualifiedImport = lineTag - <> "import qualified" - <> moduleName - <> " as " - <> moduleLast - typeImport = lineTag - <> "import" - <> moduleName - <> " (" - <> moduleLast - <> ")" +requireParser :: Parser RequireInfo +requireParser = do + void $ Megaparsec.string "require" + void $ Megaparsec.space1 + module' <- Megaparsec.some (Megaparsec.alphaNumChar <|> Megaparsec.punctuationChar) + void $ Megaparsec.space - lineTag = "{-# LINE " - <> show lineNumber - <> " \"" - <> fn - <> "\" #-}\n" - in - typeImport - <> "\n" - <> qualifiedImport - <> "\n" + alias' <- Megaparsec.try $ Megaparsec.option Nothing $ do + void $ Megaparsec.string "as" + void $ Megaparsec.space1 + Just <$> Megaparsec.some (Megaparsec.alphaNumChar) - otherList -> - unlines otherList + void $ Megaparsec.space + + types' <- Megaparsec.option Nothing $ do + void $ Megaparsec.char '(' + t' <- Megaparsec.some (Megaparsec.alphaNumChar <|> Megaparsec.char ',' <|> Megaparsec.char ' ') + void $ Megaparsec.char ')' + return $ Just t' + + return RequireInfo + { riFullModuleName = toText $ module' + , riModuleAlias = maybe (Text.takeWhileEnd (/= '.') $ toText module') toText alias' + , riImportedTypes = fmap Text.strip <$> Text.splitOn "," <$> toText <$> types' + } + diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: require -version: '0.0.1' +version: '0.2.0' github: "theam/require" license: Apache-2.0 author: "The Agile Monkeys" @@ -23,12 +23,14 @@ - NoImplicitPrelude - OverloadedStrings - TypeApplications + - RecordWildCards dependencies: - - base >= 4.11 && < 5 + - base >= 4.9 && < 5 - universum >= 1.2.0 && < 2 - bytestring >= 0.10 && < 0.11 - text >= 1.2.3.0 && < 2 + - megaparsec >= 6.5.0 && < 7 library: source-dirs: library diff --git a/require.cabal b/require.cabal --- a/require.cabal +++ b/require.cabal @@ -1,11 +1,11 @@ --- This file has been generated from package.yaml by hpack version 0.27.0. +-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack -- --- hash: d44fb331420f1b19f369701590ab0a52898b99681925f4142991554e004bff7a +-- hash: 33332b8c960f813e87189b2741785fc878a0151fef0ad2a7dd80187a15af8a53 name: require -version: 0.0.1 +version: 0.2.0 synopsis: Scrap your qualified import clutter description: See category: Other @@ -18,7 +18,6 @@ license-file: LICENSE.md build-type: Simple cabal-version: >= 1.10 - extra-source-files: CHANGELOG.md LICENSE.md @@ -37,11 +36,12 @@ Paths_require hs-source-dirs: library - default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications + default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards ghc-options: -Wall build-depends: - base >=4.11 && <5 + base >=4.9 && <5 , bytestring >=0.10 && <0.11 + , megaparsec >=6.5.0 && <7 , text >=1.2.3.0 && <2 , universum >=1.2.0 && <2 default-language: Haskell2010 @@ -52,11 +52,12 @@ Paths_require hs-source-dirs: executable - default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications + default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: - base >=4.11 && <5 + base >=4.9 && <5 , bytestring >=0.10 && <0.11 + , megaparsec >=6.5.0 && <7 , require , text >=1.2.3.0 && <2 , universum >=1.2.0 && <2 @@ -69,11 +70,12 @@ Paths_require hs-source-dirs: test-suite - default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications + default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: - base >=4.11 && <5 + base >=4.9 && <5 , bytestring >=0.10 && <0.11 + , megaparsec >=6.5.0 && <7 , require , tasty , tasty-hspec @@ -88,12 +90,13 @@ Paths_require hs-source-dirs: benchmark - default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications + default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: - base >=4.11 && <5 + base >=4.9 && <5 , bytestring >=0.10 && <0.11 , criterion + , megaparsec >=6.5.0 && <7 , require , text >=1.2.3.0 && <2 , universum >=1.2.0 && <2 diff --git a/test-suite/Main.hs b/test-suite/Main.hs --- a/test-suite/Main.hs +++ b/test-suite/Main.hs @@ -37,3 +37,28 @@ 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 (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 (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 (Require.FileName "Foo.hs") input + actual `shouldContain` expectedTypeImport + actual `shouldContain` expectedQualifiedImport +