Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

添加 x 解压程序;添加 Makefile

  • Loading branch information...
commit 1947b260e04a7d0655d8017d56bf9830fd97b7af 1 parent 2b406a2
@lilydjwg authored
View
1  .gitignore
@@ -13,3 +13,4 @@ sendmail/sendmail
locatewrapper/l
locatewrapper/lre
locatewrapper/mylocate
+x/x
View
8 List/List.hs
@@ -0,0 +1,8 @@
+module List.List (
+ lookupWith,
+) where
+
+lookupWith :: (a -> Bool) -> [(a, b)] -> Maybe b
+lookupWith _ [] = Nothing
+lookupWith p ((x, y):xs) | p x = Just y
+ | otherwise = lookupWith p xs
View
15 Makefile
@@ -0,0 +1,15 @@
+CC=ghc
+CFLAGS=-ilib -O2
+LDFLAGS=
+
+.PHONY: all clean
+
+%: %.hs
+ $(CC) $(CFLAGS) $<
+ strip $@
+
+all: locatewrapper/mylocate fcitx-switch-quote/fcitx-switch-quote \
+ routespeed/routespeed x/x
+
+clean:
+ -rm */*.o */*.hi
View
33 lib/Control/Function.hs
@@ -0,0 +1,33 @@
+module Control.Function (
+ applyEither,
+ applyMaybe,
+ applyUntil,
+ applyUntilM,
+) where
+
+import Data.Maybe (isJust)
+
+-- |Applies a list of functions until one returns a Right value and returns it,
+-- or returns a Left value if no Right
+applyEither :: [(a -> Either a a)] -> a -> Either a a
+applyEither = applyUntil isRight
+
+-- |Applies a list of functions until a Just value is got
+applyMaybe :: [(a -> Maybe b)] -> a -> Maybe b
+applyMaybe = applyUntil isJust
+
+-- |applies until p becomes True
+applyUntil :: (b -> Bool) -> [(a -> b)] -> a -> b
+applyUntil _ (f:[]) a = f a
+applyUntil p (f:fs) a = if p r then r else applyUntil p fs a
+ where r = f a
+
+applyUntilM :: Monad m => (b -> Bool) -> [(a -> m b)] -> a -> m b
+applyUntilM _ (f:[]) a = f a
+applyUntilM p (f:fs) a = do
+ r <- f a
+ if p r then return r else applyUntilM p fs a
+
+isRight :: Either a b -> Bool
+isRight (Left _) = False
+isRight (Right _) = True
View
13 locatewrapper/mylocate.hs
@@ -15,6 +15,7 @@ import System.Process (
StdStream(..),
)
+import Control.Function (applyEither)
import Text.String (dropPrefix)
main = do
@@ -40,16 +41,10 @@ transform :: String -> String
transform = unlines . map transformLine . lines
transformLine :: String -> String
-transformLine s = case apply funcs s of
- Left r -> '~' : r
- Right r -> r
+transformLine s = case applyEither funcs s of
+ Left r -> r
+ Right r -> '~' : r
where funcs = map dropPrefix prefixesToHome
-apply :: [(a -> Either a a)] -> a -> Either a a
-apply (f:fs) d = case f d of
- Left s -> apply fs s
- Right s -> Left s
-apply [] d = Right d
-
prefixesToHome :: [String]
prefixesToHome = ["/home/.ecryptfs/lilydjwg/public", "/home/lilydjwg"]
View
85 x/x.hs
@@ -0,0 +1,85 @@
+import Control.Applicative ((<$>))
+import Control.Monad (mapM_)
+import Data.List (isSuffixOf, isInfixOf)
+import Data.Maybe (isJust, fromJust)
+import System.Cmd (rawSystem)
+import System.Directory (
+ createDirectoryIfMissing,
+ renameDirectory,
+ getDirectoryContents,
+ setCurrentDirectory,
+ removeDirectory,
+ )
+import System.Environment (getArgs)
+import System.Exit (exitWith, ExitCode(ExitFailure))
+import System.FilePath ((</>))
+import System.Process (readProcess)
+
+import Control.Function (applyUntilM)
+
+main = getArgs >>= mapM_ extract
+
+extract :: FilePath -> IO ()
+extract f = do
+ let d = stripSuffix f
+ createDirectoryIfMissing False d
+ setCurrentDirectory d
+ exit <- extract' $ ".." </> f
+ files <- getDirectoryContents "."
+ if length files == 3
+ then moveUpwardsAndDelete d $ last files
+ else return ()
+ case exit of
+ ExitFailure _ -> exitWith exit
+ otherwise -> return ()
+
+extract' :: FilePath -> IO ExitCode
+extract' f = do
+ cmd <- getCmdForFile f
+ if isJust cmd
+ then let cmd':args = fromJust cmd in rawSystem cmd' (args ++ [f])
+ else exitWith $ ExitFailure $ negate 1
+
+moveUpwardsAndDelete :: FilePath -> FilePath -> IO ()
+moveUpwardsAndDelete d f = do
+ print "deleting"
+ print (d, f)
+ setCurrentDirectory ".."
+ del' <- if d == f
+ then do let d' = d ++ tmpSuffix
+ f' = d' ++ "/" ++ f
+ print (d, d')
+ renameDirectory d d'
+ print (f', f)
+ renameDirectory f' f
+ return d'
+ else return d
+ removeDirectory del'
+
+tmpSuffix = "._._."
+
+stripSuffix :: FilePath -> String
+stripSuffix = stripTar . reverse . tail . dropWhile (/='.') . reverse
+ where stripTar p = if ".tar" `isSuffixOf` p
+ then take (length p - 4) p
+ else p
+
+getCmdForFile :: FilePath -> IO (Maybe [String])
+getCmdForFile = applyUntilM isJust [checkTar, checkRar, checkZip, check7z]
+
+checkTar, checkRar, checkZip, check7z :: FilePath -> IO (Maybe [String])
+checkTar f | any (`isSuffixOf` f) [".tar.gz", ".tar.xz", ".tar.bz2",
+ ".tgz", ".txz", ".tbz"]
+ = return $ Just ["tar", "xvf"]
+ | otherwise = return Nothing
+
+checkRar f | ".rar" `isSuffixOf` f = do
+ t <- readProcess "file" [f] ""
+ return $ Just $ if "Win32" `isInfixOf` t then ["7z", "x"] else ["rar", "x"]
+ | otherwise = return Nothing
+
+checkZip = return . suffix ".zip" ["gbkunzip"]
+check7z = return . suffix ".7z" ["7z", "x"]
+
+suffix :: String -> [String] -> FilePath -> Maybe [String]
+suffix suf cmd f = if suf `isSuffixOf` f then Just cmd else Nothing
Please sign in to comment.
Something went wrong with that request. Please try again.