Skip to content

Instantly share code, notes, and snippets.

@IronGremlin
Last active September 29, 2017 22:03
Show Gist options
  • Save IronGremlin/33c06ed8f5d7a3ecb1d14e16fff837a7 to your computer and use it in GitHub Desktop.
Save IronGremlin/33c06ed8f5d7a3ecb1d14e16fff837a7 to your computer and use it in GitHub Desktop.
steve_clean.hs
{-
steve_clean () {
toplost=$(for i in $(ls /fileserver/lost+found/); do echo "$(ls /fileserver/lost+found/$i | wc -l) : ${i}"; done | sort -h -r )
rmain=$(echo -E "$toplost" | wc -l)
for i in $(echo -E "$toplost" | cut -d':' -f2 | sed 's/ //'); do
echk=$(ls -la $i | wc -l)
if [[ $echk == 3 ]] ; then
echo "Empty path, removing $i"
rm -rf $i;
((rmain--));
continue
fi
mchk=$(ls $i | grep -E "gradle|import_includes|manifest.ini|Makefile|AndroidManifest|expected.txt|classes-full-debug.jar|.java")
if [[ $? == 0 ]] ; then
echo "Build files, removing $i" ;
rm -rf $i;
((rmain--));
continue
fi
schk=$(ls $i | grep -E "#[0-9]*")
slen=$(echo -E "$schk" | wc -l)
if [[ $? == 0 ]] ; then
echo "Requires deep check, skipping $i : $slen entries" ;
((rmain--));
continue
fi
ls -la $i;
echo "$rmain remaining"
echo "Remove: $i [yes/rename/no]" ;
read cont;
if [[ "$cont" == "y" ]] ; then
rm -rf $i ;
((rmain--));
elif [[ "$cont" == "r" ]] ; then
echo "New path name:" ;
read npath ;
mv $i /fileserver/found/$npath ;
((rmain--))
fi ;
done
}
-}
module Main where
import System.Directory
import Data.List (isInfixOf)
import Data.Char (isDigit)
import Control.Monad (filterM, void)
import Control.Exception (IOException,catch)
import Data.Monoid ((<>))
lostdir :: FilePath
lostdir = "/fileserver/lost+found/"
{-
This is a type declaration using 'record' syntax.
It declares a directory tree, containing it's absolute path under field 'absPath', any files under 'files', and all folders under 'folders'
Because collections of folders are a recursive structure, you'll note that the folders are, themselves, of type DTree.
It's pretty common for Haskell types to be recursive this way.
-}
data DTree =
DTree { absPath :: FilePath
, files :: [FilePath]
, folders :: [DTree] } deriving (Eq,Show)
{-
We could also have declared this type this way:
data DTree = DTree FilePath [FilePath] [DTree]
and then defined selection functions to get at it's fields:
absPath :: DTree -> FilePath
absPath (DTree n _ _) = n
But that'd be a pain in the ass, and also, generic names for stuff like 'files' and 'folders' could conflict with other declarations.
-}
-- OK, there is a fuckload going on at once here.
-- Because we're doing IO in order to make our DTree, we -must- return an 'IO DTree'
-- When doing IO, we wrap the result of things in an IO type 'container', and we have to do some non-standard shit to get at the value
-- inside of the IO container.
-- So there are some unfamiliar operators and shit here. But, basically, just assume '<-' means assignment,
-- '>>=' means 'do this next' and '<$>' means 'apply right value to left function'
-- also, functions that end in 'M', like filterM and mapM, are basically the 'monad' versions of map / filter.
-- They're doing some type hijynx for us, but essentially they act exactly like their regular versions.
deepTree :: FilePath -> IO DTree
deepTree rPath = do
entries <- listDirectory rPath >>= return . map (rPath<>)
folders' <- filterM doesDirectoryExist entries >>= return . map (<>"/")
files' <- filterM doesFileExist entries
(DTree rPath files') <$> (mapM deepTree folders')
-- OK, we're out of IO hell.
-- These two functions recurse down our DTree object to get us lists of stuff.
-- The bit between the parens is called a 'pattern match' - It's doing some destructuring assignment for us, and binding the dtree fields to variables.
-- We could just as easily used a let binding instead:
-- gatherFolders tree = let asbP = absPath tree ...
-- But that'd get annoying.
gatherFolders :: DTree -> [FilePath]
gatherFolders (DTree absP _ flds) = concat $ [absP] : map gatherFolders flds
-- ok, this is kind of silly, but we need to make a list of lists of absolute paths
-- That has to work this way, because when we 'map' the folders, each gathering of folders can return more folders.
-- Lists in haskell can't have more than one type, so [1,[1,2],3] is illegal, because [1,2] isn't a number, it's a list of numbers
-- So instead we make this absolute path into a single item list, and then it becomes a list of lists.
-- Then, we promise to go gather the other lists of paths by mapping ouselves over the remaining folders
-- And finally, because at the end we just want a flat list, we use concat to flatten it.
gatherFiles :: DTree -> [FilePath]
gatherFiles (DTree _ fps flds) = concat $ fps : map gatherFiles flds
-- Note, files is already of type [FilePath], so we don't need to pull our singleton list trick here.
michaelsMess = ["gradle","import_includes","manifest.ini","Makefile","AndroidManifest","expected.txt","classes-full-debug.jar",".java"]
checkMichael :: FilePath -> Bool
checkMichael p = any (`isInfixOf` p) michaelsMess
tossFile :: FilePath -> IO ()
tossFile file =
catch (removeFile file) (genErrHandler ("Failed to remove: " <> file <> "\n"))
-- catch works more or less like it does in most other languages,
-- except instead of being a special reserved word, it's just a regular ass function.
-- It's first arg is a call to perform an IO action (in this case, delete a file), and it's second is what to do if the first one fucks up.
-- 'genErrHandler' is a function I declare down below
-- It basically just prints a line to console with the error that was thrown, and the message.
-- We're concatenating strings here with <>, a function from data.monoid that operats as a generic appender.
tossFolder :: FilePath -> IO ()
tossFolder folder =
catch (removeDirectory folder) (genErrHandler ("Failed to remove: " <> folder <> "\n"))
isEmpty :: DTree -> Bool
isEmpty dir = null $ gatherFiles dir -- null is a function that returns 'True' for empty lists, and 'False' otherwise.
killEmpty :: DTree -> IO Bool -- Ok, the reason we return a bool here is kind of silly, I'll explain it later.
killEmpty n = if isEmpty n -- if there were no files, recursively, down this DTree...
then do
putStrLn ("Empty path, removing:" <> absPath n) -- Print that you're about to delete some shit
tossFolder (absPath n) -- delete some shit
return False -- return False
else return True -- Or, if it wasn't empty, return True.
isDeepCheck :: FilePath -> Bool
isDeepCheck p =
let (f:s:_) = p -- OK, this is some dense as syntax. But, basically, we're de-structuring the argument, p, and assigning f and s
in (f == '#' && isDigit s) -- as the first and second characters, resepectively. So, is the 1st '#', and the second a number?
handlePath :: Bool -> FilePath -> IO Bool -- We returning IO Bool again ... Same reason as last time, I'll explain it below.
handlePath isFile path = do
handle path
where -- 'where' is a special keyword that lets us define local functions. Everything beneath here and indented to the right is part of one or more local functions
remove = if isFile then tossFile else tossFolder -- OK, so, this just lets us switch to use the proper rename/delete functions
renamePath = if isFile then renameFile else renameDirectory
handle :: FilePath -> IO Bool
handle f -- This is guard syntax. We line the 'pipe' up with the first letter of the first arg...
| checkMichael f = mRemove f -- and the syntax is, if the condition 'checkMichael f' is true , execute 'mRemove f'
| isDeepCheck f = deepCheck f -- It's evaluated top to bottom, so if it was checkMichael, deepcheck doesn't get called
| otherwise = defaultItem f -- otherwise is just a synonym for true, so 'defaultItem f' is our default case.
mRemove n = do -- Now we define each of the functions we dispatched to above.
putStrLn ("Build files, removing "<>n)
remove n
return False
deepCheck n = do
fiCt <- length . gatherFiles <$> (deepTree n) -- Get all the files and folders from the current path, recursively,
flCt <- length . gatherFolders <$> (deepTree n) -- and get their lengths.
putStrLn ("Requires deep check, skipping "<>n<> ": "<> show (fiCt + flCt)<>" entries")
return False
defaultItem n = do
putStrLn ("Remove: "<>n<>" [yes/rename/no]")
choice <- getChar
case choice of
'y' -> do
remove n
return False
'r' -> do
putStrLn ("New path name for "<>n)
newPath <- getLine
catch (renamePath n newPath) (genErrHandler "Failed to rename path.\n")
return False
_ -> return False -- Underscore means 'for every other case' - IE, if the user didn't hit y or r, skip and return false
recurseTree :: DTree -> IO () -- Ok, here's our meat.
recurseTree (DTree rpath files' folders') = do
void $ mapM (handlePath True ) files' -- void means 'throw away' - so this can be read as, map 'handlePath True' for all files in this folder, but ignore the final return value.
remainingFolders <- (filterM killEmpty folders') >>= filterM (handlePath False . absPath) -- And here we get to the reason for returning IO Bools
mapM_ recurseTree remainingFolders -- now, mapM_ (the underscore means disregard the result and just return '()' ) this same function to all the sub trees.
{-
OK - The reason for filterM and returning IO Bool -
We're filtering to drop shit out of our trees, like a work list.
We're using IO Bools so that, in addition to saying whether or not we're keeping something in the work list,
we can also do IO shit at the same time, like print things to console, or delete/rename files.
IO is magic (monads are all magic actually, but we're focused on IO right now) - Most functions make you return a single value.
IO lets you return a chain of operations that -terminates- in a single value, which lets us do a bunch of shit before we return true/false
to decide if we're going to filter out a file.
IO () is basically a way to represent "bupkiss", like, we did nothing.
Make no mistake - () is not the same thing as null. It's an actual value, and we have to return it or not -
So if you have a function that returns an IO (), you can't end it with 'return True' - that'd be IO Bool.
Vice versa is true too - You can do any number of IO x things, but the one you end on is the return result of the operation.
-}
genErrHandler :: String -> IOException -> IO () -- here is our generic error handler
genErrHandler msg error = putStrLn $ msg <> show error
main = (deepTree lostdir) >>= recurseTree -- And this ties it all together.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment