glob-imports (empty) → 0.0.1.0
raw patch · 9 files changed
+725/−0 lines, 9 filesdep +basedep +directorydep +discover-instancessetup-changed
Dependencies added: base, directory, discover-instances, dlist, file-embed, filepath, glob-imports, hspec, hspec-discover, mtl, some-dict-of, template-haskell, text
Files
- ChangeLog.md +7/−0
- LICENSE +30/−0
- README.md +90/−0
- Setup.hs +2/−0
- app/Main.hs +20/−0
- glob-imports.cabal +140/−0
- src/GlobImports/Exe.hs +312/−0
- test/GlobImports/ExeSpec.hs +122/−0
- test/Spec.hs +2/−0
+ ChangeLog.md view
@@ -0,0 +1,7 @@+# Changelog for glob-imports++## Unreleased changes++## 0.1.0.0++- Initial Release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Matt Parsons (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Matt Parsons nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,90 @@+# glob-imports++++A Haskell source preprocessor which generalizes `persistent-discover` and+`hspec-discover`, allowing you to metaprogram with source files.++A big limitation of `TemplateHaskell` is that it cannot modify the import list+of a file. The only way to metaprogram with the imports is to use a source+preprocessor like this.++## As an executable++Let's say you've got a ton of `persistent` database models, all defined in a+module hierarchy like this:++```+src/+ Models/+ Foo.hs+ Bar.hs+ Baz.hs+ Blargh.hs+ What.hs+ OhNo.hs+```++If you're using `persistent` to automatically generate migrations, you'll want+to have all the `[EntityDef]` in scope from each module. You can do that by+importing each module that defines models and calling `$(discoverEntities)`,+introduced in `persistent-2.13`.++But you may forget to import a module.++This utility splices in a qualified import statement for *all* the modules defined in the+current directory and sub-directories, along with a list of imported modules. From this, you can use+[`discover-instances`](https://hackage.haskell.org/package/discover-instances)+or other `TemplateHaskell` code to work with these.++To use it, place the following command in a file, located in the same directory+that your Haskell modules are in:++```haskell+-- src/Models/All.hs++{-# OPTIONS_GHC -F -pgmF glob-imports #-}++module Models.All where++import Database.Persist.Sql+-- GLOB_IMPORTS_SPLICE++allEntities :: [EntityDef]+allEntities = $(discoverEntities)+```++The preprocessor will glob files in the current directory, and import all of+them qualified. The result would look like this:++```haskell+-- src/Models/All.hs++-- post-processed++module Models.All where++import Database.Persist.Sql+import qualified Models.Foo+import qualified Models.Bar+import qualified Models.Baz+import qualified Models.Blargh+import qualified Models.What+import qualified Models.OhNo++_importedModules :: [String]+_importedModules =+ [ "Models.Foo"+ , "Models.Bar"+ , "Models.Baz"+ , "Models.Blargh"+ , "Models.What"+ , "Models.OhNo"+ ]++allEntities :: [EntityDef]+allEntities = $(discoverEntities)+```++You'll need to add `glob-imports` to the `build-tool-depends` on your cabal file+for this to work.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,20 @@+module Main where++import GlobImports.Exe+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+ ]++
+ glob-imports.cabal view
@@ -0,0 +1,140 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.4.+--+-- see: https://github.com/sol/hpack++name: glob-imports+version: 0.0.1.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+homepage: https://github.com/parsonsmatt/glob-imports#readme+bug-reports: https://github.com/parsonsmatt/glob-imports/issues+author: Matt Parsons+maintainer: parsonsmatt@gmail.com+copyright: Matt Parsons+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/parsonsmatt/glob-imports++library+ exposed-modules:+ GlobImports.Exe+ other-modules:+ Paths_glob_imports+ hs-source-dirs:+ ./src+ default-extensions:+ BlockArguments+ DataKinds+ DerivingStrategies+ DerivingStrategies+ FlexibleInstances+ FlexibleInstances+ GADTs+ GeneralizedNewtypeDeriving+ MultiParamTypeClasses+ OverloadedStrings+ StandaloneDeriving+ TypeFamilies+ TypeFamilies+ TypeOperators+ ghc-options: -Wall+ build-depends:+ base >=4.12 && <5+ , directory+ , discover-instances+ , dlist+ , file-embed+ , filepath+ , mtl+ , some-dict-of+ , template-haskell >=2.16.0.0+ , text+ default-language: Haskell2010++executable glob-imports+ main-is: Main.hs+ other-modules:+ Paths_glob_imports+ hs-source-dirs:+ app+ default-extensions:+ BlockArguments+ DataKinds+ DerivingStrategies+ DerivingStrategies+ FlexibleInstances+ FlexibleInstances+ GADTs+ GeneralizedNewtypeDeriving+ MultiParamTypeClasses+ OverloadedStrings+ StandaloneDeriving+ TypeFamilies+ TypeFamilies+ TypeOperators+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.12 && <5+ , directory+ , discover-instances+ , dlist+ , file-embed+ , filepath+ , glob-imports+ , mtl+ , some-dict-of+ , template-haskell >=2.16.0.0+ , text+ default-language: Haskell2010++test-suite glob-imports-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ GlobImports.ExeSpec+ Paths_glob_imports+ hs-source-dirs:+ test+ default-extensions:+ BlockArguments+ DataKinds+ DerivingStrategies+ DerivingStrategies+ FlexibleInstances+ FlexibleInstances+ GADTs+ GeneralizedNewtypeDeriving+ MultiParamTypeClasses+ OverloadedStrings+ StandaloneDeriving+ TypeFamilies+ TypeFamilies+ TypeOperators+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ base >=4.12 && <5+ , directory+ , discover-instances+ , dlist+ , file-embed+ , filepath+ , glob-imports+ , hspec+ , hspec-discover+ , mtl+ , some-dict-of+ , template-haskell >=2.16.0.0+ , text+ default-language: Haskell2010
+ src/GlobImports/Exe.hs view
@@ -0,0 +1,312 @@+-- | 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+-- related files, where you want to use @TemplateHaskell@ or similar+--+-- By default, the glob is for all modules in the directory containing the+-- source file. Imports are qualified with the full module name to avoid+-- potential import conflicts. The pre-processor will splice in a top-level+-- value @_importedModules :: [String]@ which contains the fully qualified+-- names of the modules that were imported.+--+-- You may want to disable warnings for redundant imports, if you are only using+-- type class information. A future option to the library may only do empty+-- import lists, to only get access to type class instances.+--+-- As an example, consider the+-- <https://hackage.haskell.org/package/persistent-discover+-- @persistent-discover@> utility, which is inspired by @hspec-discover@. That+-- utility will perform the following transformation:+--+-- @+-- -- src/PersistentModels/All.hs+--+-- {-# OPTIONS_GHC -F -pgmF persistent-discover #-}+-- @+--+-- Then it will translate to:+--+-- @+-- -- src/PersistentModels/All.hs+--+-- module PersistentModels.All where+--+-- import PersistentModels.Foo ()+-- import PersistentModels.Bar ()+-- import PersistentModels.Baz ()+--+-- allEntityDefs :: [EntityDef]+-- allEntityDefs = $(discoverEntities)+-- @+--+-- With this package, we can generalize the overall pattern. The new source+-- module will look like this:+--+-- @+-- -- src/PersistentModels/All.hs+--+-- {-# OPTIONS_GHC -F -pgmF glob-imports #-}+--+-- module PersistentModels.All where+--+-- import Database.Persist.Sql+-- {- GLOB_IMPORTS_SPLICE -}+--+-- allEntityDefs :: [EntityDef]+-- allEntityDefs = $(discoverEntities)+-- @+--+-- This preprocessor will convert this into this form:+--+-- @+-- -- src/PersistentModels/All.hs+--+-- module PersistentModels.All where+--+-- import Database.Persist.Sql+-- import qualified PersistentModels.Foo+-- import qualified PersistentModels.Bar+-- import qualified PersistentModels.Baz+--+-- allEntityDefs :: [EntityDef]+-- allEntityDefs = $(discoverEntities)+-- @+--+-- Note how the only difference is that imports have been spliced in. This+-- allows you to more flexibly customize how the code works.+--+-- @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 Data.Maybe++-- | The source file location. This is the first argument passed to the+-- preprocessor.+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 }++-- | The destination file path to write the final source to. This is the third+-- argument passed to the preprocessor.+newtype Destination = Destination { unDestination :: FilePath }++data AllModelsFile = AllModelsFile+ { amfModuleBase :: Module+ , amfModuleImports :: [Module]+ }++-- |+--+-- @since 0.1.0.0+spliceImports+ :: Source+ -> SourceContents+ -> Destination+ -> IO ()+spliceImports (Source src) (SourceContents srcContents) (Destination dest) = do+ let (dir, file) = splitFileName src+ files <- filter (/= file) <$> getFilesRecursive dir+ let+ input =+ AllModelsFile+ { amfModuleBase =+ fromJust $ pathToModule src+ , amfModuleImports =+ mapMaybe pathToModule (fmap (dir </>) files)+ }+ output =+ renderFile input srcContents++ writeFile dest output++-- | Returns a list of relative paths to all files in the given directory.+getFilesRecursive+ :: FilePath+ -- ^ 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)++renderFile+ :: AllModelsFile+ -> String+ -> String+renderFile amf originalContents =+ concatMap unlines+ [ modulePrior+ , newImportLines+ , newModuleRest+ ]+ where+ originalLines =+ lines originalContents++ (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"+ ]+ (prior, (_globImportLine : rest)) ->+ (prior, rest)++ newModuleRest =+ let+ (remainingModule, lastImportLine) =+ break ("import" `isPrefixOf`) (reverse moduleRest)+ quoteModuleName mod' =+ "\"" <> moduleName mod' <> "\""+ mkFirstModuleLine mod' =+ " [ " <> quoteModuleName mod'+ mkRestModuleLine mod' =+ " , " <> quoteModuleName mod'+ newLines =+ reverse case amfModuleImports amf of+ [] ->+ []+ (firstModule : restModules) ->+ [ "_importedModules :: [String]"+ , "_importedModules ="+ , mkFirstModuleLine firstModule+ ] <> 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+ }+ deriving (Eq, Show)++mkModulePieces+ :: FilePath+ -> [String]+mkModulePieces fp = do+ let+ extension =+ takeExtension fp+ guard (extension == ".hs" || extension == ".lhs")+ reverse+ . takeWhile (not . isLowerFirst)+ . reverse+ . filter noDots+ . splitDirectories+ . dropExtension+ $ fp+ where+ noDots x =+ "." /= x && ".." /= x++isLowerFirst :: String -> Bool+isLowerFirst [] = True+isLowerFirst (c:_) = isLower c++pathToModule+ :: FilePath+ -> Maybe Module+pathToModule file = do+ case mkModulePieces file of+ [] ->+ empty+ x : xs -> do+ guard $ all isValidModuleName (x : xs)+ 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++-- | Returns True if the given Char is a valid taks module character.+isValidModuleChar :: Char -> Bool+isValidModuleChar c = isAlphaNum c || c == '_' || c == '\''++-- | Convert a String in camel case to snake case.+casify :: String -> String+casify str = intercalate "_" $ groupBy (\a b -> isUpper a && isLower b) str++stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+stripSuffix suffix str =+ reverse <$> stripPrefix (reverse suffix) (reverse str)
+ test/GlobImports/ExeSpec.hs view
@@ -0,0 +1,122 @@+module GlobImports.ExeSpec where++import Test.Hspec+import GlobImports.Exe+import System.FilePath++spec :: Spec+spec = do+ describe "renderFile" do+ let allModelsFile =+ AllModelsFile+ { amfModuleBase =+ Module+ { moduleName = "Foo.Bar"+ , modulePath = "src/Foo/Bar.hs"+ }+ , amfModuleImports =+ [ Module+ { moduleName = "Foo.Bar.Quux"+ , modulePath = "src/Foo/Bar/Quux.hs"+ }+ ]+ }+ it "errors without a GLOB_IMPORTS_SPLICE marker" do+ (pure $! length (renderFile allModelsFile (unlines+ [ "module Foo.Bar where"+ , ""+ , "import Blah"+ ])))+ `shouldThrow` anyErrorCall+ it "works with a GLOB_IMPORTS_SPLICE marker" do+ renderFile allModelsFile+ (unlines+ [ "module Foo.Bar where"+ , ""+ , "import Blah"+ , "-- GLOB_IMPORTS_SPLICE"+ ])+ `shouldBe`+ unlines+ [ "module Foo.Bar where"+ , ""+ , "import Blah"+ , "import qualified Foo.Bar.Quux"+ , "_importedModules :: [String]"+ , "_importedModules ="+ , " [ \"Foo.Bar.Quux\""+ , " ]"+ ]+ it "can handle imports after glob import splice" do+ renderFile allModelsFile+ (unlines+ [ "module Foo.Bar where"+ , ""+ , "import Blah"+ , "-- GLOB_IMPORTS_SPLICE"+ , "import Boo"+ , ""+ , "baz :: Int"+ , "baz = 3"+ ])+ `shouldBe`+ unlines+ [ "module Foo.Bar where"+ , ""+ , "import Blah"+ , "import qualified Foo.Bar.Quux"+ , "import Boo"+ , "_importedModules :: [String]"+ , "_importedModules ="+ , " [ \"Foo.Bar.Quux\""+ , " ]"+ , ""+ , "baz :: Int"+ , "baz = 3"+ ]++ describe "mkModulePieces" do+ let+ exPath =+ "src/Foo/Bar.hs"+ it "works" do+ mkModulePieces exPath+ `shouldBe`+ ["Foo", "Bar"]++ it "does not eat non-hs files" do+ let+ mdFile =+ "src/Foo/README.md"+ mkModulePieces mdFile+ `shouldBe`+ []++ describe "pathToModule" do+ let+ exPath =+ "./src/Foo/Bar.hs"+ (dir, file) =+ splitFileName exPath+ it "splits how i expect" $ do+ dir `shouldBe` "./src/Foo/"+ file `shouldBe` "Bar.hs"+ it "works" do+ pathToModule exPath+ `shouldBe`+ Just Module+ { moduleName =+ "Foo.Bar"+ , modulePath =+ exPath+ }+ it "pathToModule absolute path" do+ let absPath = "/Users/user/Code/project/src/Foo/Bar.hs"+ pathToModule absPath+ `shouldBe`+ Just Module+ { moduleName =+ "Foo.Bar"+ , modulePath =+ absPath+ }
+ test/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+