diff --git a/executable/AutoRequire/Main.hs b/executable/AutoRequire/Main.hs new file mode 100644 --- /dev/null +++ b/executable/AutoRequire/Main.hs @@ -0,0 +1,8 @@ +-- It is generally a good idea to keep all your business logic in your library +-- and only use it in the executable. Doing so allows others to use what you +-- wrote in their libraries. +import qualified Require +import Universum + +main :: IO () +main = Require.autorequireMain diff --git a/executable/Main.hs b/executable/Main.hs deleted file mode 100644 --- a/executable/Main.hs +++ /dev/null @@ -1,14 +0,0 @@ --- It is generally a good idea to keep all your business logic in your library --- and only use it in the executable. Doing so allows others to use what you --- wrote in their libraries. -import Universum - -import System.Environment as System - -import qualified Require - -main :: IO () -main = do - (_:inFile:outFile:_) <- System.getArgs - content <- readFile inFile - writeFile outFile $ Require.transform (Require.FileName $ toText inFile) content diff --git a/executable/Require/Main.hs b/executable/Require/Main.hs new file mode 100644 --- /dev/null +++ b/executable/Require/Main.hs @@ -0,0 +1,8 @@ +-- It is generally a good idea to keep all your business logic in your library +-- and only use it in the executable. Doing so allows others to use what you +-- wrote in their libraries. +import qualified Require +import Universum + +main :: IO () +main = Require.requireMain diff --git a/library/Require.hs b/library/Require.hs --- a/library/Require.hs +++ b/library/Require.hs @@ -5,36 +5,106 @@ import qualified Text.Megaparsec as Megaparsec import qualified Text.Megaparsec.Char as Megaparsec import qualified Data.Text as Text +import Options.Generic +import System.Directory -newtype FileName = FileName Text +newtype FileName = FileName { unFileName :: Text } newtype LineNumber = LineNumber Int type Parser = Megaparsec.Parsec Void Text - data RequireInfo = RequireInfo { riFullModuleName :: Text , riModuleAlias :: Text , riImportedTypes :: Maybe [Text] } deriving Show +data CommandArguments = + CommandArguments Text Text Text + deriving Generic -transform :: FileName -> Text -> Text -transform filename input = +instance ParseRecord CommandArguments + +findRequires :: IO (Maybe Text) +findRequires = do + currentDir <- getCurrentDirectory + files <- getDirectoryContents currentDir + let textFiles = fmap toText files + return $ head <$> (nonEmpty $ filter (Text.isSuffixOf "Requires") textFiles) + +requireMain :: IO () +requireMain = do + CommandArguments _ inputFile outputFile <- getRecord "Require Haskell preprocessor" :: IO CommandArguments + 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) + (Require.transform + False + (Require.FileName inputFile) + file + content) + +autorequireMain :: IO () +autorequireMain = do + CommandArguments _ inputFile outputFile <- getRecord "Require Haskell preprocessor" :: IO CommandArguments + 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) + (Require.transform + True + (Require.FileName inputFile) + file + content) + +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 = (length $ filter (\t -> "autorequire" `Text.isPrefixOf` t) $ lines input) == 0 + + +transform' :: Bool -> FileName -> Text -> Text -> Text +transform' shouldPrepend filename prepended input = Text.lines input & zip [1..] - <&> (\(ln, text) -> maybe (text <> "\n") (renderImport filename (LineNumber ln)) $ Megaparsec.parseMaybe requireParser text ) + >>= prependAfterModuleLine + & filter (\(_, t) -> not $ "autorequire" `Text.isPrefixOf` t) + <&> (\(ln, text) -> maybe (lineTag filename (LineNumber ln) <> text <> "\n") (renderImport filename (LineNumber ln)) $ Megaparsec.parseMaybe requireParser text ) & Text.concat + where + enumeratedPrepend ln + | shouldPrepend = zip (repeat ln) (Text.lines prepended) + | otherwise = [] + prependAfterModuleLine (ln, text) + | "where" `Text.isInfixOf` text = (ln, text) : enumeratedPrepend (ln) + | otherwise = [(ln, text)] +lineTag :: FileName -> LineNumber -> Text +lineTag (FileName fn) (LineNumber ln) = + "{-# LINE " + <> show ln + <> " \"" + <> fn + <> "\" #-}\n" + renderImport :: FileName -> LineNumber -> RequireInfo -> Text -renderImport (FileName fn) (LineNumber ln) RequireInfo {..} = - lineTag <> typesImport <> lineTag <> qualifiedImport +renderImport filename linenumber RequireInfo {..} = + case (Text.isInfixOf riFullModuleName (unFileName filename)) of + True -> "" + False -> lineTag filename linenumber <> typesImport <> lineTag filename linenumber <> 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" @@ -65,4 +135,3 @@ , 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.2.1' +version: '0.3.1' github: "theam/require" license: Apache-2.0 author: "The Agile Monkeys" @@ -24,6 +24,7 @@ - OverloadedStrings - TypeApplications - RecordWildCards + - DeriveGeneric dependencies: - base >= 4.9 && < 5 @@ -31,16 +32,28 @@ - bytestring >= 0.10 && < 0.11 - text >= 1.2.3.0 && < 2 - megaparsec >= 6.5.0 && < 7 + - directory + - inliterate + - optparse-generic library: source-dirs: library executables: requirepp: - source-dirs: executable + source-dirs: executable/Require/ main: Main.hs dependencies: - require + ghc-options: + - -rtsopts + - -threaded + - -with-rtsopts=-N + autorequirepp: + source-dirs: executable/AutoRequire/ + main: Main.hs + dependencies: + - require ghc-options: - -rtsopts - -threaded diff --git a/require.cabal b/require.cabal --- a/require.cabal +++ b/require.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 173608385fd718f309239b82a52ceb4e1804001699a05dfbf5bdbc83e8dd2d78 +-- hash: 04501d0a9991a4564adc521f703043e19993b7d2bb93c4c40e24b688248959ab name: require -version: 0.2.1 +version: 0.3.1 synopsis: Scrap your qualified import clutter description: See category: Other @@ -36,28 +36,54 @@ Paths_require hs-source-dirs: library - default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards + default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards DeriveGeneric ghc-options: -Wall build-depends: base >=4.9 && <5 , bytestring >=0.10 && <0.11 + , directory + , inliterate , megaparsec >=6.5.0 && <7 + , optparse-generic , text >=1.2.3.0 && <2 , universum >=1.2.0 && <2 default-language: Haskell2010 +executable autorequirepp + main-is: Main.hs + other-modules: + Paths_require + hs-source-dirs: + executable/AutoRequire/ + default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards DeriveGeneric + ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N + build-depends: + base >=4.9 && <5 + , bytestring >=0.10 && <0.11 + , directory + , inliterate + , megaparsec >=6.5.0 && <7 + , optparse-generic + , require + , text >=1.2.3.0 && <2 + , universum >=1.2.0 && <2 + default-language: Haskell2010 + executable requirepp main-is: Main.hs other-modules: Paths_require hs-source-dirs: - executable - default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards + executable/Require/ + default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards DeriveGeneric ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: base >=4.9 && <5 , bytestring >=0.10 && <0.11 + , directory + , inliterate , megaparsec >=6.5.0 && <7 + , optparse-generic , require , text >=1.2.3.0 && <2 , universum >=1.2.0 && <2 @@ -67,15 +93,19 @@ type: exitcode-stdio-1.0 main-is: Main.hs other-modules: + Preprocessed Paths_require hs-source-dirs: test-suite - default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards + default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards DeriveGeneric ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: base >=4.9 && <5 , bytestring >=0.10 && <0.11 + , directory + , inliterate , megaparsec >=6.5.0 && <7 + , optparse-generic , require , tasty , tasty-hspec @@ -90,13 +120,16 @@ Paths_require hs-source-dirs: benchmark - default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards + default-extensions: NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards DeriveGeneric ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: base >=4.9 && <5 , bytestring >=0.10 && <0.11 , criterion + , directory + , inliterate , megaparsec >=6.5.0 && <7 + , optparse-generic , 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 @@ -6,6 +6,9 @@ import qualified Require + +import Preprocessed + main :: IO () main = do test <- testSpec "require" spec @@ -17,23 +20,25 @@ 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 (Require.FileName "Foo.hs") input + 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 (Require.FileName "Foo.hs") input + 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 (Require.FileName "Foo.hs") input - actual `shouldStartWith` expectedModule + 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 @@ -42,7 +47,7 @@ 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 + let actual = toString $ Require.transform False (Require.FileName "Foo.hs") "" input actual `shouldContain` expectedTypeImport actual `shouldContain` expectedQualifiedImport @@ -50,7 +55,7 @@ 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 + let actual = toString $ Require.transform False (Require.FileName "Foo.hs") "" input actual `shouldContain` expectedTypeImport actual `shouldContain` expectedQualifiedImport @@ -58,7 +63,9 @@ 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 + let actual = toString $ Require.transform False (Require.FileName "Foo.hs") "" input actual `shouldContain` expectedTypeImport actual `shouldContain` expectedQualifiedImport + it "Autorequires properly" $ do + foo "asd." `shouldBe` "asd" diff --git a/test-suite/Preprocessed.hs b/test-suite/Preprocessed.hs new file mode 100644 --- /dev/null +++ b/test-suite/Preprocessed.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -F -pgmF autorequirepp #-} +module Preprocessed where + +import Prelude + +foo :: Text -> Text +foo = Text.takeWhile (/= '.') +