Skip to content

Instantly share code, notes, and snippets.

@sordina
Last active August 29, 2015 14:03
Show Gist options
  • Save sordina/ee7df21dccd0d0df67f4 to your computer and use it in GitHub Desktop.
Save sordina/ee7df21dccd0d0df67f4 to your computer and use it in GitHub Desktop.
Remove common prefixes
{-# LANGUAGE QuasiQuotes #-}
import Text.InterpolatedString.Perl6 -- For tests
import System.Environment (getArgs)
import Data.List.Split (splitOn)
import Data.List (intercalate)
-- IO:
main :: IO ()
main = getArgs >>= run
run :: [String] -> IO ()
run args | null args = runFun onSlash
| any ((== args) . return) ["-s", "--slashes" ] = runFun onSlash
| any ((== args) . return) ["-r", "--repeats" ] = runFun onRepeat
| any ((== args) . return) ["-v", "--vertical"] = runFun onVertical
| any (`elem` args) ["-h", "--help" ] = help
| otherwise = help
runFun :: ([String] -> [String]) -> IO ()
runFun f = getContents >>= putStr . unlines . f . lines
help :: IO ()
help = putStrLn "Usage: diffline [-s | --slashes (default) ] [-r | --repeats] [-v | --vertical] [-h | --help]"
-- Algorithm:
onRepeat :: [String] -> [String]
onRepeat = removeCommonPrefixes (const ' ')
onVertical :: [String] -> [String]
onVertical = map (intercalate "/") . removeCommonPrefixes (map (const ' ')) . map (splitOn "/")
onSlash :: [String] -> [String]
onSlash = map concat . removeCommonPrefixes (map (const ' ')) . map deslash
deslash :: String -> [String]
deslash l = take 1 items ++ map ('/' :) (drop 1 items) where items = splitOn "/" l
removeCommonPrefixes :: Eq a => (a -> a) -> [[a]] -> [[a]]
removeCommonPrefixes f l = zipWith (prefixPair f) ([] : l) l
prefixPair :: Eq a => (a -> a) -> [a] -> [a] -> [a]
prefixPair f a b = pre ++ post
where
eqs = zipWith (==) (map Just a ++ repeat Nothing) (map Just b)
x = zip eqs b
pre = map (f . snd) $ takeWhile fst x
post = map snd $ dropWhile fst x
-- TESTS:
prop_indempotent_repeat, prop_indempotent_slash, prop_indempotent_vertical :: [String] -> Bool
prop_indempotent_repeat ls = onRepeat ls == onRepeat (onRepeat ls)
prop_indempotent_slash ls = onSlash ls == onSlash (onSlash ls)
prop_indempotent_vertical ls = onVertical ls == onVertical (onVertical ls)
prop_slash, prop_repeat, prop_vertical :: Bool
prop_repeat = testOutputRepeat == onRepeat testInput
prop_slash = testOutputSlash == onSlash testInput
prop_vertical = testOutputVertical == onVertical testInput
testInput :: [String]
testInput = lines [qq|
temp
temp/-name
temp/-name/serf
temp/-name/serf/local.snapshot
temp/-node
temp/-node/serf
temp/-node/serf/local.snapshot
temp/.DS_Store
temp/a
temp/a.js
|]
testOutputRepeat :: [String]
testOutputRepeat = lines [qq|
temp
/-name
/serf
/local.snapshot
ode
/serf
/local.snapshot
.DS_Store
a
.js
|]
testOutputSlash :: [String]
testOutputSlash = lines [qq|
temp
/-name
/serf
/local.snapshot
/-node
/serf
/local.snapshot
/.DS_Store
/a
/a.js
|]
testOutputVertical :: [String]
testOutputVertical = lines [qq|
temp
/-name
/ /serf
/ / /local.snapshot
/-node
/ /serf
/ / /local.snapshot
/.DS_Store
/a
/a.js
|]
@silky
Copy link

silky commented Jul 14, 2014

doesn't mention --vertical in tests/help output :)

@sordina
Copy link
Author

sordina commented Jul 14, 2014

Updated :)

@silky
Copy link

silky commented Jul 14, 2014

not the tests!

@sordina
Copy link
Author

sordina commented Jul 15, 2014

Now? :)

@silky
Copy link

silky commented Jul 15, 2014

hooray!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment