Skip to content

Instantly share code, notes, and snippets.

@rudchenkos
Created April 20, 2018 06:16
Show Gist options
  • Save rudchenkos/25ad42cee97f9a80288046e6953de4ae to your computer and use it in GitHub Desktop.
Save rudchenkos/25ad42cee97f9a80288046e6953de4ae to your computer and use it in GitHub Desktop.
Microframework for file search
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
module Main where
import Data.Monoid
import System.Directory
import System.FilePath
import Control.Monad (filterM)
import System.Process (callProcess)
type Match = FilePath -> IO Bool
type Criteria = (Match, Match)
-- | By exact file name
name :: String -> Match
name exact = pure . (== exact) . takeFileName
isDir :: Match
isDir = doesDirectoryExist
-- | Match second predicate after the first one, if needed
infix 6 ?>>
(?>>) :: Match -> Match -> Match
(?>>) a b path = a path >>= \case
True -> b path -- Passed to the next check
False -> return False
instance {-# OVERLAPS #-} Monoid Match where
mempty = pure . const False
-- | Match one of the two alternatives
mappend a b path = a path >>= \case
True -> return True
False -> b path
-- Add a match rule
match :: Match -> Criteria
match predicate = (predicate, mempty)
-- Add an ignore rule
ignore :: Match -> Criteria
ignore predicate = (mempty, predicate)
-- Find files in `root`
find :: Criteria -> FilePath -> IO [FilePath]
find criteria@(match, ignore) root = do
entries <- map (root </>) <$> listDirectory root >>= filterM (\p -> ignore p >>= pure . not)
subdirs <- filterM doesDirectoryExist entries
results <- filterM match entries
concat . (results:) <$> mapM (find criteria) subdirs
devIgnores :: Criteria
devIgnores = ignore $ name ".stack-work" <> name "node_modules"
gitRepositories :: Criteria
gitRepositories = devIgnores <> match (name ".git" ?>> isDir)
main :: IO ()
main = getHomeDirectory >>= find gitRepositories . (</> "software") >>= mapM_ putStrLn
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment