{-# LANGUAGE NamedFieldPuns #-} module Calligraphy.Phases.Search ( searchFiles, pSearchConfig, SearchConfig, ) where import qualified Calligraphy.Compat.GHC as GHC import Calligraphy.Compat.Lib import Calligraphy.Prelude import Control.Applicative import Data.List.NonEmpty (NonEmpty (..), nonEmpty, toList) import Options.Applicative hiding (str) import System.Directory (doesDirectoryExist, doesFileExist, listDirectory, makeAbsolute) import System.FilePath (isExtensionOf, (</>)) searchFiles :: SearchConfig -> IO [GHC.HieFile] searchFiles :: SearchConfig -> IO [HieFile] searchFiles SearchConfig {Bool searchDotPaths :: SearchConfig -> Bool searchDotPaths :: Bool searchDotPaths, Maybe (NonEmpty String) searchRoots :: SearchConfig -> Maybe (NonEmpty String) searchRoots :: Maybe (NonEmpty String) searchRoots, Maybe (NonEmpty Pattern) includePatterns :: SearchConfig -> Maybe (NonEmpty Pattern) includePatterns :: Maybe (NonEmpty Pattern) includePatterns, Maybe (NonEmpty Pattern) excludePatterns :: SearchConfig -> Maybe (NonEmpty Pattern) excludePatterns :: Maybe (NonEmpty Pattern) excludePatterns} = do [HieFile] hieFiles <- [String] -> IO [HieFile] getHieFiles forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO [String] searchHieFilePaths forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ forall a b c. (a -> b -> c) -> b -> a -> c flip forall a. (a -> Bool) -> [a] -> [a] filter [HieFile] hieFiles forall a b. (a -> b) -> a -> b $ \HieFile file -> let matches :: Pattern -> Bool matches Pattern pat = Pattern -> String -> Bool matchPattern Pattern pat (ModuleName -> String GHC.moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c . forall unit. GenModule unit -> ModuleName GHC.moduleName forall b c a. (b -> c) -> (a -> b) -> a -> c . HieFile -> Module GHC.hie_module forall a b. (a -> b) -> a -> b $ HieFile file) Bool -> Bool -> Bool || Pattern -> String -> Bool matchPattern Pattern pat (HieFile -> String GHC.hie_hs_file HieFile file) in forall b a. b -> (a -> b) -> Maybe a -> b maybe Bool True (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any Pattern -> Bool matches) Maybe (NonEmpty Pattern) includePatterns Bool -> Bool -> Bool && forall b a. b -> (a -> b) -> Maybe a -> b maybe Bool True (Bool -> Bool not forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any Pattern -> Bool matches) Maybe (NonEmpty Pattern) excludePatterns where searchHieFilePaths :: IO [String] searchHieFilePaths = do [String] roots <- forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM String -> IO String makeAbsolute (forall b a. b -> (a -> b) -> Maybe a -> b maybe [String "./."] forall a. NonEmpty a -> [a] toList Maybe (NonEmpty String) searchRoots) forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap String -> IO [String] go [String] roots where go :: FilePath -> IO [FilePath] go :: String -> IO [String] go String path = do Bool isFile <- String -> IO Bool doesFileExist String path if Bool isFile Bool -> Bool -> Bool && String -> String -> Bool isExtensionOf String ".hie" String path then forall (f :: * -> *) a. Applicative f => a -> f a pure [String path] else do Bool isDir <- String -> IO Bool doesDirectoryExist String path if Bool isDir then do [String] contents <- (if Bool searchDotPaths then forall a. a -> a id else forall a. (a -> Bool) -> [a] -> [a] filter (Bool -> Bool not forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Eq a => [a] -> [a] -> Bool isPrefixOf String ".")) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> IO [String] listDirectory String path forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap (String -> IO [String] go forall b c a. (b -> c) -> (a -> b) -> a -> c . (String path String -> String -> String </>)) [String] contents else forall (f :: * -> *) a. Applicative f => a -> f a pure [] data SearchConfig = SearchConfig { SearchConfig -> Maybe (NonEmpty Pattern) includePatterns :: Maybe (NonEmpty Pattern), SearchConfig -> Maybe (NonEmpty Pattern) excludePatterns :: Maybe (NonEmpty Pattern), SearchConfig -> Bool searchDotPaths :: Bool, SearchConfig -> Maybe (NonEmpty String) searchRoots :: Maybe (NonEmpty FilePath) } newtype Pattern = Pattern String matchPattern :: Pattern -> String -> Bool matchPattern :: Pattern -> String -> Bool matchPattern (Pattern String matcher) = Bool -> String -> String -> Bool go Bool False String matcher where go :: Bool -> String -> String -> Bool go Bool _ (Char '*' : String ms) String cs = Bool -> String -> String -> Bool go Bool True String ms String cs go Bool False (Char m : String ms) (Char c : String cs) = Char m forall a. Eq a => a -> a -> Bool == Char c Bool -> Bool -> Bool && Bool -> String -> String -> Bool go Bool False String ms String cs go Bool True String ms (Char c : String cs) = Bool -> String -> String -> Bool go Bool True String ms String cs Bool -> Bool -> Bool || Bool -> String -> String -> Bool go Bool False String ms (Char c forall a. a -> [a] -> [a] : String cs) go Bool _ [] [] = Bool True go Bool _ String _ String _ = Bool False pSearchConfig :: Parser SearchConfig pSearchConfig :: Parser SearchConfig pSearchConfig = Maybe (NonEmpty Pattern) -> Maybe (NonEmpty Pattern) -> Bool -> Maybe (NonEmpty String) -> SearchConfig SearchConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. [a] -> Maybe (NonEmpty a) nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Alternative f => f a -> f [a] many) ( String -> Pattern Pattern forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall s. IsString s => Mod ArgumentFields s -> Parser s strArgument ( forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar String "MODULE" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. String -> Mod f a help String "Name or filepath of a module to include in the call graph. Can contain '*' wildcards. Defaults to '*'." ) ) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. [a] -> Maybe (NonEmpty a) nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Alternative f => f a -> f [a] many) ( String -> Pattern Pattern forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall s. IsString s => Mod OptionFields s -> Parser s strOption ( forall (f :: * -> *) a. HasName f => String -> Mod f a long String "exclude" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. HasName f => Char -> Mod f a short Char 'e' forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar String "MODULE" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. String -> Mod f a help String "Name or filepath of a module to exclude in the call graph. Can contain '*' wildcards." ) ) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Mod FlagFields Bool -> Parser Bool switch (forall (f :: * -> *) a. HasName f => String -> Mod f a long String "hidden" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. String -> Mod f a help String "Search paths with a leading period. Disabled by default.") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. [a] -> Maybe (NonEmpty a) nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Alternative f => f a -> f [a] many) ( forall s. IsString s => Mod OptionFields s -> Parser s strOption ( forall (f :: * -> *) a. HasName f => String -> Mod f a long String "input" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. HasName f => Char -> Mod f a short Char 'i' forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar String "PATH" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. String -> Mod f a help String "Filepaths to search for HIE files. If passed a file, it will be processed as is. If passed a directory, the directory will be searched recursively. Can be repeated. Defaults to './.'" ) )