glob-imports 0.0.1.0 → 0.0.2.0
raw patch · 4 files changed
+164/−115 lines, 4 files
Files
- ChangeLog.md +7/−1
- app/Main.hs +66/−13
- glob-imports.cabal +2/−2
- src/GlobImports/Exe.hs +89/−99
ChangeLog.md view
@@ -2,6 +2,12 @@ ## Unreleased changes -## 0.1.0.0+## 0.0.2.0++- [#4](https://github.com/parsonsmatt/glob-imports/pull/4)+ - You may now pass `--search-dir`, `--pattern`, and `--excluded-prefixes` to+ configure and customize where the program searches for imports to glob.++## 0.0.1.0 - Initial Release
app/Main.hs view
@@ -1,20 +1,73 @@ module Main where import GlobImports.Exe+import Options.Applicative import System.IO (readFile')-import System.Environment (getArgs) -main :: IO ()-main = do- args <- getArgs- case args of- src : fileInput : dest : _ -> do- contents <- readFile' fileInput- spliceImports (Source src) (SourceContents contents) (Destination dest)- _ ->- fail . mconcat $- [ "glob-imports: expected to be called with three arguments as an -F -pgmF preprocessor. got:"- , show args- ]+data Args = Args+ { argsOriginalFile :: FilePath+ , argsSourceFile :: FilePath+ , argsDest :: FilePath+ , argsSearchDir :: Maybe FilePath+ , argsPattern :: String+ , argsExcludedPrefixes :: String+ , argsDebug :: Bool+ }+ deriving (Show) +parseArgs :: IO Args+parseArgs =+ execParser $+ info+ ( Args+ <$> originalFileParser+ <*> sourceFileParser+ <*> destFileParser+ <*> searchDirParser+ <*> patternParser+ <*> excludedPrefixesParser+ <*> debugParser+ )+ mempty+ where+ originalFileParser = argument str (metavar "ORIGINAL_FILE")+ sourceFileParser = argument str (metavar "SOURCE_FILE")+ destFileParser = argument str (metavar "DEST_FILE")+ searchDirParser =+ optional . (option str) $+ long "search-dir"+ <> metavar "SEARCH_DIR"+ <> help "Directory to search for files in"+ patternParser =+ option str $+ long "pattern"+ <> metavar "PATTERN"+ <> help "Pattern on which to match file paths"+ <> value "**/*.hs"+ excludedPrefixesParser =+ option str $+ long "exclude-prefixes"+ <> metavar "PREFIXES"+ <> help "File path prefixes to exclude"+ <> value ""+ debugParser =+ switch $+ long "debug"+ <> help "Whether to print debug output" +main :: IO ()+main = do+ args <- parseArgs+ contents <- readFile' $ argsSourceFile args+ spliceImports+ (Source $ argsSourceFile args)+ (SourceContents $ contents)+ (Destination $ argsDest args)+ (argsSearchDir args)+ (argsPattern args)+ (splitOn ',' (argsExcludedPrefixes args))+ (argsDebug args)+ where+ splitOn _ [] = []+ splitOn sep xs =+ takeWhile (/= sep) xs : splitOn sep (drop 1 $ dropWhile (/= sep) xs)
glob-imports.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.4.+-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack name: glob-imports-version: 0.0.1.0+version: 0.0.2.0 synopsis: Import modules for metaprogramming description: This package provides an executable for importing modules in a directory and splicing those in. Please see the README on GitHub at <https://github.com/parsonsmatt/glob-imports#readme> category: Metaprogramming
src/GlobImports/Exe.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | This preprocessor splices in imports to the file you define it in. Haskell -- source files are discovered according to a glob relative to the file the code -- is defined in. This utility is useful when metaprogramming with a group of@@ -21,7 +23,7 @@ -- @ -- -- src/PersistentModels/All.hs ----- {-# OPTIONS_GHC -F -pgmF persistent-discover #-}+-- {\-# OPTIONS_GHC -F -pgmF persistent-discover #-\} -- @ -- -- Then it will translate to:@@ -45,12 +47,12 @@ -- @ -- -- src/PersistentModels/All.hs ----- {-# OPTIONS_GHC -F -pgmF glob-imports #-}+-- {\-# OPTIONS_GHC -F -pgmF glob-imports #-\} -- -- module PersistentModels.All where -- -- import Database.Persist.Sql--- {- GLOB_IMPORTS_SPLICE -}+-- {\- GLOB_IMPORTS_SPLICE -\} -- -- allEntityDefs :: [EntityDef] -- allEntityDefs = $(discoverEntities)@@ -78,36 +80,39 @@ -- @since 0.1.0.0 module GlobImports.Exe where -import System.FilePath-import Control.Monad (guard, filterM)-import Control.Monad.State-import Data.String-import Data.DList (DList(..))-import qualified Data.DList as DList-import Data.Foldable (for_)-import System.Directory-import Data.List-import Data.Char import Control.Applicative+import Control.Exception (SomeException, catch)+import Control.Monad (guard, when)+import qualified Data.ByteString.Lazy as LBS+import Data.Char+import Data.List+import Data.List.Split (splitOn) import Data.Maybe+import qualified Data.Text as Text+import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import System.FilePath+import System.Process.Typed -- | The source file location. This is the first argument passed to the -- preprocessor.-newtype Source = Source { unSource :: FilePath }+newtype Source = Source {unSource :: FilePath} -- | The source file contents. This is the 'String' contained in the file of the -- second argument passed to the preprocessor.-newtype SourceContents = SourceContents { unSourceContents :: String }+newtype SourceContents = SourceContents {unSourceContents :: String} -- | The destination file path to write the final source to. This is the third -- argument passed to the preprocessor.-newtype Destination = Destination { unDestination :: FilePath }+newtype Destination = Destination {unDestination :: FilePath} data AllModelsFile = AllModelsFile { amfModuleBase :: Module , amfModuleImports :: [Module] } +printDebug :: Bool -> String -> IO ()+printDebug enabled str = when enabled $ putStrLn ("[DEBUG] " ++ str)+ -- | -- -- @since 0.1.0.0@@ -115,43 +120,76 @@ :: Source -> SourceContents -> Destination+ -> Maybe FilePath+ -> String+ -> [String]+ -> Bool -> IO ()-spliceImports (Source src) (SourceContents srcContents) (Destination dest) = do- let (dir, file) = splitFileName src- files <- filter (/= file) <$> getFilesRecursive dir+spliceImports (Source src) (SourceContents srcContents) (Destination dest) msearchDir pat prefixes debug = do let+ (sourceDir, _file) = splitFileName src+ searchDir = fromMaybe sourceDir msearchDir+ excludePrefixFilter target = not $ any (`isPrefixOf` target) prefixes++ printDebug debug $ "searching directory: " ++ searchDir+ printDebug debug $ "searching with pattern: " ++ pat+ printDebug debug $ "excluding file name: " ++ src+ eitherFiles <- fmap (filter (essentiallyDistinct src)) <$> getFiles searchDir pat+ files <- case eitherFiles of+ Left e -> error e+ Right f -> pure f+ let+ filteredFiles = filter excludePrefixFilter files+ printDebug debug $ "including files:\n" ++ intercalate "\n| " filteredFiles+ let input = AllModelsFile { amfModuleBase = fromJust $ pathToModule src , amfModuleImports =- mapMaybe pathToModule (fmap (dir </>) files)+ mapMaybe pathToModule (fmap (searchDir </>) filteredFiles) } output = renderFile input srcContents writeFile dest output+ where+ essentiallyDistinct :: FilePath -> FilePath -> Bool+ essentiallyDistinct l r = simplifyPath l /= simplifyPath r+ simplifyPath :: String -> String+ simplifyPath = (intercalate "/") . (filter (/= mempty)) . (splitOn "/") -- | Returns a list of relative paths to all files in the given directory.-getFilesRecursive+getFiles :: FilePath+ -- ^ The glob pattern to filter with.+ -> String -- ^ The directory to search.- -> IO [FilePath]-getFilesRecursive baseDir = sort <$> go []- where- go :: FilePath -> IO [FilePath]- go dir = do- c <- map (dir </>) . filter (`notElem` [".", ".."]) <$> getDirectoryContents (baseDir </> dir)- dirs <- filterM (doesDirectoryExist . (baseDir </>)) c >>= mapM go- files <- filterM (doesFileExist . (baseDir </>)) c- return (files ++ concat dirs)+ -> IO (Either String [FilePath])+getFiles baseDir pat = do+ (exitCode, out, err) <- (readProcess $ proc "find" [baseDir, "-wholename", pat]) `catch` handler+ pure $ case exitCode of+ ExitSuccess -> Right . lines . Text.unpack . decodeUtf8 . LBS.toStrict $ out+ ExitFailure _ -> Left . Text.unpack . decodeUtf8 . LBS.toStrict $ err+ where+ handler :: SomeException -> IO (ExitCode, LBS.ByteString, LBS.ByteString)+ handler e = do+ pure $ ( ExitFailure 1+ , ""+ , mconcat [ "unable to invoke `find`. Please make sure that `find` is executable and in PATH.\n"+ , "("+ , LBS.fromStrict . encodeUtf8 . Text.pack $ show e+ , ")\n"+ ]+ ) renderFile :: AllModelsFile -> String -> String renderFile amf originalContents =- concatMap unlines+ concatMap+ unlines [ modulePrior , newImportLines , newModuleRest@@ -163,13 +201,14 @@ (modulePrior, moduleRest) = case break ("GLOB_IMPORTS_SPLICE" `isInfixOf`) originalLines of (_, []) ->- error $ unlines- [ "While processing the module, I was unable to find a comment with GLOB_IMPORTS_SPLICE."- , "I need this to know where to splice imports into the file. Please add a comment like "- , "this to the source file in the import section: "- , ""- , "-- GLOB_IMPORTS_SPLICE"- ]+ error $+ unlines+ [ "While processing the module, I was unable to find a comment with GLOB_IMPORTS_SPLICE."+ , "I need this to know where to splice imports into the file. Please add a comment like "+ , "this to the source file in the import section: "+ , ""+ , "-- GLOB_IMPORTS_SPLICE"+ ] (prior, (_globImportLine : rest)) -> (prior, rest) @@ -191,65 +230,15 @@ [ "_importedModules :: [String]" , "_importedModules =" , mkFirstModuleLine firstModule- ] <> map mkRestModuleLine restModules- <> [ " ]"]+ ]+ <> map mkRestModuleLine restModules+ <> [" ]"] in reverse (concat [remainingModule, newLines, lastImportLine]) newImportLines = map (\mod' -> "import qualified " <> moduleName mod') (amfModuleImports amf) --------- render do--- let--- modName =--- moduleName $ amfModuleBase amf--- renderLine do--- "{-# LINE 1 "--- fromString $ show modName--- " #-}"--- "{-# LANGUAGE TemplateHaskell #-}"--- ""--- renderLine do--- "module "--- fromString $ modName--- " where"--- ""--- for_ (amfModuleImports amf) \mod' ->--- renderLine do--- "import "--- fromString $ moduleName mod'--- " ()"--- ""--- "import Database.Persist.TH (discoverEntities)"--- "import Database.Persist.Types (EntityDef)"--- ""--- "-- | All of the entity definitions, as discovered by the @glob-imports@ utility."--- "allEntityDefs :: [EntityDef]"--- "allEntityDefs = $(discoverEntities)"------ -- -- | Derive module name from specified path.--- -- pathToModule :: FilePath -> Module--- -- pathToModule f =--- -- Module--- -- { moduleName =--- -- intercalate "." $ mapMaybe go $ splitDirectories f--- -- , modulePath =--- -- f--- -- }--- -- where--- -- go :: String -> Maybe String--- -- go (c:cs) =--- -- Just (toUpper c : cs)--- -- fileName = last $ splitDirectories f--- -- m:ms = takeWhile (/='.') fileName---- | data Module = Module { moduleName :: String , modulePath :: FilePath@@ -277,7 +266,7 @@ isLowerFirst :: String -> Bool isLowerFirst [] = True-isLowerFirst (c:_) = isLower c+isLowerFirst (c : _) = isLower c pathToModule :: FilePath@@ -286,18 +275,19 @@ case mkModulePieces file of [] -> empty- x : xs -> do+ x : xs -> do guard $ all isValidModuleName (x : xs)- pure Module- { moduleName = intercalate "." (x:xs)- , modulePath = file- }+ pure+ Module+ { moduleName = intercalate "." (x : xs)+ , modulePath = file+ } -- | Returns True if the given string is a valid task module name. -- See `Cabal.Distribution.ModuleName` (http://git.io/bj34) isValidModuleName :: String -> Bool isValidModuleName [] = False-isValidModuleName (c:cs) = isUpper c && all isValidModuleChar cs+isValidModuleName (c : cs) = isUpper c && all isValidModuleChar cs -- | Returns True if the given Char is a valid taks module character. isValidModuleChar :: Char -> Bool@@ -307,6 +297,6 @@ casify :: String -> String casify str = intercalate "_" $ groupBy (\a b -> isUpper a && isLower b) str -stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+stripSuffix :: (Eq a) => [a] -> [a] -> Maybe [a] stripSuffix suffix str = reverse <$> stripPrefix (reverse suffix) (reverse str)