packages feed

nemesis 2013.6.13 → 2013.6.16

raw patch · 15 files changed

+123/−1611 lines, 15 filesdep +Globdep −data-defaultdep −filepathdep −old-timedep ~airPVP ok

version bump matches the API change (PVP)

Dependencies added: Glob

Dependencies removed: data-default, filepath, old-time, transformers

Dependency ranges changed: air

API changes (from Hackage documentation)

Files

Nemesis view
@@ -12,6 +12,7 @@     , "manifest"     , "main"     , "nemesis-tmp.*"+    , "dist"     ]
changelog.md view
@@ -1,3 +1,10 @@+2013.6.16+---------++* add Glob dependency+* remove binary version as it's not 'simple'++ 2009.10.7 ---------
nemesis.cabal view
@@ -1,25 +1,41 @@ Name:                 nemesis-Version:              2013.6.13+Version:              2013.6.16 Build-type:           Simple-Synopsis:             a Rake like task management tool-Description:          smart per project code snippets+Synopsis:             a task management tool for Haskell+Description:          Organize common shell tasks into a meaningful tree like structure with dependency tracking  License:              BSD3 License-file:         LICENSE Author:               Jinjing Wang Maintainer:           Jinjing Wang <nfjinjing@gmail.com> Build-Depends:        base-Cabal-version:        >= 1.2+Cabal-version:        >= 1.6 category:             Web homepage:             http://github.com/nfjinjing/nemesis-data-files:           readme.md, changelog.md, known-issues.md, Nemesis +data-files:           readme.md+                    , changelog.md+                    , known-issues.md+                    , Nemesis+                    , test/N1.hs+                    , test/N2.hs+                    , test/N3.hs+                    +source-repository head+  type: git+  location: https://github.com/nfjinjing/nemesis.git+ library   ghc-options: -Wall-  build-depends:      base >= 4 && < 100, old-time, time, mtl, process, containers, air >= 2011.6.19-                      , dlist-                      , filepath-                      , transformers+  build-depends:      base >= 4 && < 100+                    , time+                    , mtl+                    , process+                    , containers+                    , air+                    , dlist+                    , Glob+                    , directory                          hs-source-dirs: src/   exposed-modules:  @@ -29,20 +45,5 @@   other-modules:                       System.Nemesis.Util                       -                      System.FilePath.Glob-                      System.FilePath.Glob.Primitive-                      System.FilePath.Glob.Base-                      System.FilePath.Glob.Directory-                      System.FilePath.Glob.Match-                      System.FilePath.Glob.Simplify-                      System.FilePath.Glob.Utils-                      +    -Executable            nemesis-  build-depends:      base >= 4 && < 100, mtl, process, containers, data-default, directory, air >= 2011.6.19-                      -  hs-source-dirs:     src/-  main-is:            System/Nemesis/Runner.hs-  other-modules:      System.Nemesis.Util-                      System.Nemesis.DSL-
readme.md view
@@ -1,25 +1,27 @@-Nemesis: a rake like task management tool for haskell+Nemesis: a task management tool for Haskell =====================================================  Demo ----   -    nemesis = do+    import System.Nemesis.Env +    main = run $ do+       clean         [ "**/*.hi"         , "**/*.o"         , "manifest"         ]-        -      task "dist" - do++      task "dist" $ do         sh "cabal clean"         sh "cabal configure"         sh "cabal sdist"        task "i" (sh "ghci -isrc src/System/Nemesis.hs") -      task "manifest" - do+      task "manifest" $ do         sh "find . | grep 'hs$' > manifest"  Tutorial@@ -32,14 +34,17 @@  ### DSL -Put the following code into a file named `Nemesis`+Create a file named `Nemesis` -    nemesis = do+    import System.Nemesis.Env+    import Air.Env ((-))+    import Prelude hiding ((-))     -      -- desc is optional, it gives some description to the task that follows+    main = run - do+    +      -- desc is optional, it gives some description to the task+      -- task syntax: task "keyword: space seperated dependencies" io-action       desc "Hunter attack macro"--      -- syntax: task "keyword: dependencies" io-action       task "attack: pet-attack auto-attack" (putStrLn "attack macro done!")        desc "Pet attack"@@ -56,14 +61,14 @@  ### Run -run `nemesis`+`runghc Nemesis`      attack          Hunter attack macro     auto-attack     Auto attack     mark            Hunter's mark     pet-attack      Pet attack -run `nemesis attack`+`runghc Nemesis attack`      casting hunter's mark     pet attack@@ -73,73 +78,39 @@  ### Namespace -Suppose you have the following tasks+Create namespaces for tasks with the keyword `namespace`     -    nemesis = do+    import System.Nemesis.Env+    import Air.Env ((-))+    import Prelude hiding ((-))++    main = run - do            namespace "eat" - do          task "bread: salad" - putStrLn "eating bread"-        task "salad: /drink/coke" - putStrLn "nice salad"+        task "salad: /drink/coke" - putStrLn "eating salad"         namespace "drink" - do          task "coke" - putStrLn "drinking coke" -then+Namespaces are referenced as path components. -    nemesis bread =>-    .nemesis: bread does not exist!+`runghc Nemesis bread`++    Nemesis: bread does not exist!     -    nemesis eat/bread =>+`runghc Nemesis eat/bread`+     drinking coke-    nice salad+    eating salad     eating bread      + Hints ----- -* Please add `.nemesis` to `.gitignore` or equivalents.-* alias `nemesis` to something sweeter, e.g. `n`--Advance usage----------------### Use LANGUAGE pragma--Put a `-- Nem` line after the `Langauge` pragma--    {-# LANGUAGE QuasiQuotes #-}--    -- Nem--    nemesis = do-      task "i" (sh "ghci -isrc src/System/Nemesis.hs")--currently the separator `-- Nem` is hard coded--### Bypass preprocessing, i.e. run as EDSL--Define `main`, i.e. add `main = run nemesis` in the code. The preprocessor looks for the function `main`, if it's defined, preprocessing is skipped.--This turns `Nemesis` into an EDSL in Haskell, runnable by `runghc`.--For example:--    import System.Nemesis.Env-    import Air.Env ((-))-    import Prelude hiding ((-))--    main = run nemesis-    -    nemesis = do-      task "hello" - do-        sh "echo 'hello world'"-        --Try:--    runghc Nemesis hello-+* alias `runghc Nemesis` to something sweeter, e.g. `n`
− src/System/FilePath/Glob.hs 
@@ -1,74 +0,0 @@--- File created: 2008-10-10 13:37:42---- | A library for globbing: matching patterns against file paths akin to the--- POSIX @glob()@ function.------ Pattern syntax is documented by 'compile'. To toggle features at compile--- time, look into 'CompOptions'. To modify matching behaviour, look into--- 'MatchOptions'.------ Basic usage examples:------ Matching a 'String' pattern against a 'FilePath':------ @--- 'match' ('compile' pattern) filepath--- @------ Matching a 'String' pattern against all paths in the current working--- directory:------ @--- 'glob' pattern--- @------ Matching a 'String' pattern against all paths in a given directory (a--- 'FilePath'):------ @--- 'globDir1' ('compile' pattern) directorypath--- @------ Matching a list of 'String' patterns against all paths in a given directory,--- returning the matches for each pattern as well as the paths not matched by--- any of the patterns:------ @--- 'globDir' (map 'compile' patterns) directorypath--- @-module System.FilePath.Glob-   ( -- * Data type-     Pattern-     -- * Functions-     -- ** Compilation-   , compile, decompile, simplify-     -- *** Options-   , CompOptions(..)-   , compileWith, tryCompileWith-     -- **** Predefined option sets-   , compDefault, compPosix-     -- ** Matching-   , match-   , globDir, globDir1, glob-     -- *** Options-   , MatchOptions(..)-   , matchWith-   , globDirWith-     -- **** Predefined option sets-   , matchDefault, matchPosix-     -- ** Miscellaneous-   , commonDirectory-   ) where--import System.FilePath.Glob.Base      ( Pattern-                                      , CompOptions(..), MatchOptions(..)-                                      , compDefault, compPosix-                                      , matchDefault, matchPosix-                                      , compile, compileWith, tryCompileWith-                                      , decompile-                                      )-import System.FilePath.Glob.Directory ( globDir, globDirWith, globDir1, glob-                                      , commonDirectory-                                      )-import System.FilePath.Glob.Match     (match, matchWith)-import System.FilePath.Glob.Simplify  (simplify)
− src/System/FilePath/Glob/Base.hs 
@@ -1,629 +0,0 @@--- File created: 2008-10-10 13:29:26--{-# LANGUAGE CPP #-}--module System.FilePath.Glob.Base-   ( Token(..), Pattern(..)--   , CompOptions(..), MatchOptions(..)-   , compDefault, compPosix, matchDefault, matchPosix--   , decompile--   , compile-   , compileWith, tryCompileWith-   , tokenize -- for tests--   , optimize--   , liftP, tokToLower-   ) where--import Control.Arrow                     (first)-import Control.Monad.Trans.Class         (lift)-import Control.Monad.Trans.Error         (ErrorT, runErrorT, throwError)-import Control.Monad.Trans.Writer.Strict (Writer, runWriter, tell)-import Control.Exception                 (assert)-import Data.Char                         (isDigit, isAlpha, toLower)-import Data.List                         (find, sortBy)-import Data.Maybe                        (fromMaybe)-import Data.Monoid                       (Monoid, mappend, mempty, mconcat)-import System.FilePath                   ( pathSeparator, extSeparator-                                         , isExtSeparator, isPathSeparator-                                         )--import System.FilePath.Glob.Utils ( dropLeadingZeroes-                                  , isLeft, fromLeft-                                  , increasingSeq-                                  , addToRange, overlap-                                  )--#if __GLASGOW_HASKELL__-import Text.Read (readPrec, lexP, parens, prec, Lexeme(Ident))-#endif--data Token-   -- primitives-   = Literal !Char-   | ExtSeparator                              --  .-   | PathSeparator                             --  /-   | NonPathSeparator                          --  ?-   | CharRange !Bool [Either Char (Char,Char)] --  []-   | OpenRange (Maybe String) (Maybe String)   --  <>-   | AnyNonPathSeparator                       --  *-   | AnyDirectory                              --  **/--   -- after optimization only-   | LongLiteral !Int String-   deriving (Eq)---- Note: CharRanges aren't converted, because this is tricky in general.--- Consider for instance [@-[], which includes the range A-Z. This would need--- to become [@[a-z]: so essentially we'd need to either:------    1) Have a list of ranges of uppercase Unicode. Check if our range---       overlaps with any of them and if it does, take the non-overlapping---       part and combine it with the toLower of the overlapping part.------    2) Simply expand the entire range to a list and map toLower over it.------ In either case we'd need to re-optimize the CharRange—we can't assume that--- if the uppercase characters are consecutive, so are the lowercase.------ 1) might be feasible if someone bothered to get the latest data.------ 2) obviously isn't since you might have 'Right (minBound, maxBound)' in--- there somewhere.------ The current solution is to just check both the toUpper of the character and--- the toLower.-tokToLower :: Token -> Token-tokToLower (Literal     c)   = Literal       (toLower c)-tokToLower (LongLiteral n s) = LongLiteral n (map toLower s)-tokToLower tok               = tok---- |An abstract data type representing a compiled pattern.------ Note that the 'Eq' instance cannot tell you whether two patterns behave in--- the same way; only whether they compile to the same 'Pattern'. For instance,--- @'compile' \"x\"@ and @'compile' \"[x]\"@ may or may not compare equal,--- though a @'match'@ will behave the exact same way no matter which 'Pattern'--- is used.-newtype Pattern = Pattern { unPattern :: [Token] } deriving (Eq)--liftP :: ([Token] -> [Token]) -> Pattern -> Pattern-liftP f (Pattern pat) = Pattern (f pat)--instance Show Token where-   show (Literal c)-      | c `elem` "*?[<" || isExtSeparator c-                            = ['[',c,']']-      | otherwise           = assert (not $ isPathSeparator c) [c]-   show ExtSeparator        = [ extSeparator]-   show PathSeparator       = [pathSeparator]-   show NonPathSeparator    = "?"-   show AnyNonPathSeparator = "*"-   show AnyDirectory        = "**/"-   show (LongLiteral _ s)   = concatMap (show . Literal) s-   show (OpenRange a b)     =-      '<' : fromMaybe "" a ++ "-" ++-            fromMaybe "" b ++ ">"--   -- We have to be careful here with ^ and ! lest [a!b] become [!ab]. So we-   -- just put them at the end.-   ---   -- Also, [^x-] was sorted and should not become [^-x].-   show (CharRange b r)     =-      let f = either (:[]) (\(x,y) -> [x,'-',y])-          (caret,exclamation,fs) =-             foldr (\c (ca,ex,ss) ->-                case c of-                     Left '^' -> ("^",ex,ss)-                     Left '!' -> (ca,"!",ss)-                     _        -> (ca,  ex,(f c ++) . ss)-                   )-                   ("", "", id)-                   r-          (beg,rest) = let s' = fs []-                           (x,y) = splitAt 1 s'-                           in if not b && x == "-"-                                 then (y,x)-                                 else (s',"")-       in concat [ "["-                 , if b then "" else "^"-                 , beg, caret, exclamation, rest-                 , "]"-                 ]--instance Show Pattern where-   showsPrec d p = showParen (d > 10) $-      showString "compile " . showsPrec (d+1) (decompile p)--instance Read Pattern where-#if __GLASGOW_HASKELL__-   readPrec = parens . prec 10 $ do-      Ident "compile" <- lexP-      fmap compile readPrec-#else-   readsPrec d = readParen (d > 10) $ \r -> do-      ("compile",string) <- lex r-      (xs,rest) <- readsPrec (d+1) string-      [(compile xs, rest)]-#endif--instance Monoid Pattern where-   mempty                          = Pattern []-   mappend (Pattern a) (Pattern b) = optimize . Pattern $ (a ++ b)-   mconcat                         = optimize . Pattern . concatMap unPattern---- |Options which can be passed to the 'tryCompileWith' or 'compileWith'--- functions: with these you can selectively toggle certain features at compile--- time.------ Note that some of these options depend on each other: classes can never--- occur if ranges aren't allowed, for instance.---- We could presumably put locale information in here, too.-data CompOptions = CompOptions-    { characterClasses   :: Bool -- ^Allow character classes, @[[:...:]]@.-    , characterRanges    :: Bool -- ^Allow character ranges, @[...]@.-    , numberRanges       :: Bool -- ^Allow open ranges, @\<...>@.-    , wildcards          :: Bool -- ^Allow wildcards, @*@ and @?@.-    , recursiveWildcards :: Bool -- ^Allow recursive wildcards, @**/@.--    , pathSepInRanges    :: Bool-      -- ^Allow path separators in character ranges.-      ---      -- If true, @a[/]b@ never matches anything (since character ranges can't-      -- match path separators); if false and 'errorRecovery' is enabled,-      -- @a[/]b@ matches itself, i.e. a file named @]b@ in the subdirectory-      -- @a[@.--    , errorRecovery      :: Bool-      -- ^If the input is invalid, recover by turning any invalid part into-      -- literals. For instance, with 'characterRanges' enabled, @[abc@ is an-      -- error by default (unclosed character range); with 'errorRecovery', the-      -- @[@ is turned into a literal match, as though 'characterRanges' were-      -- disabled.-    } deriving (Show,Read,Eq)---- |The default set of compilation options: closest to the behaviour of the--- @zsh@ shell, with 'errorRecovery' enabled.------ All options are enabled.-compDefault :: CompOptions-compDefault = CompOptions-   { characterClasses   = True-   , characterRanges    = True-   , numberRanges       = True-   , wildcards          = True-   , recursiveWildcards = True-   , pathSepInRanges    = True-   , errorRecovery      = True-   }---- |Options for POSIX-compliance, as described in @man 7 glob@.------ 'numberRanges', 'recursiveWildcards', and 'pathSepInRanges' are disabled.-compPosix :: CompOptions-compPosix = CompOptions-   { characterClasses   = True-   , characterRanges    = True-   , numberRanges       = False-   , wildcards          = True-   , recursiveWildcards = False-   , pathSepInRanges    = False-   , errorRecovery      = True-   }---- |Options which can be passed to the 'matchWith' or 'globDirWith' functions:--- with these you can selectively toggle certain features at matching time.-data MatchOptions = MatchOptions-    { matchDotsImplicitly :: Bool-      -- ^Allow @*@, @?@, and @**/@ to match @.@ at the beginning of paths.--    , ignoreCase          :: Bool-      -- ^Case-independent matching.--    , ignoreDotSlash      :: Bool-      -- ^Treat @./@ as a no-op in both paths and patterns.-      ---      -- (Of course e.g. @../@ means something different and will not be-      -- ignored.)-    }---- |The default set of execution options: closest to the behaviour of the @zsh@--- shell.------ Currently identical to 'matchPosix'.-matchDefault :: MatchOptions-matchDefault = matchPosix---- |Options for POSIX-compliance, as described in @man 7 glob@.------ 'ignoreDotSlash' is enabled, the rest are disabled.-matchPosix :: MatchOptions-matchPosix = MatchOptions-   { matchDotsImplicitly = False-   , ignoreCase          = False-   , ignoreDotSlash      = True-   }---- |Decompiles a 'Pattern' object into its textual representation: essentially--- the inverse of 'compile'.------ Note, however, that due to internal optimization, @decompile . compile@ is--- not the identity function. Instead, @compile . decompile@ is.------ Be careful with 'CompOptions': 'decompile' always produces a 'String' which--- can be passed to 'compile' to get back the same 'Pattern'. @compileWith--- options . decompile@ is /not/ the identity function unless @options@ is--- 'compDefault'.-decompile :: Pattern -> String-decompile = concatMap show . unPattern----------------------------------------------- COMPILATION------------------------------------------------ |Compiles a glob pattern from its textual representation into a 'Pattern'--- object.------ For the most part, a character matches itself. Recognized operators are as--- follows:------ [@?@]      Matches any character except path separators.------ [@*@]      Matches any number of characters except path separators,---            including the empty string.------ [@[..\]@]  Matches any of the enclosed characters. Ranges of characters can---            be specified by separating the endpoints with a @\'-'@. @\'-'@ or---            @']'@ can be matched by including them as the first character(s)---            in the list. Never matches path separators: @[\/]@ matches---            nothing at all. Named character classes can also be matched:---            @[:x:]@ within @[]@ specifies the class named @x@, which matches---            certain predefined characters. See below for a full list.------ [@[^..\]@ or @[!..\]@] Like @[..]@, but matches any character /not/ listed.---                        Note that @[^-x]@ is not the inverse of @[-x]@, but---                        the range @[^-x]@.------ [@\<m-n>@] Matches any integer in the range m to n, inclusive. The range may---            be open-ended by leaving out either number: @\"\<->\"@, for---            instance, matches any integer.------ [@**/@]    Matches any number of characters, including path separators,---            excluding the empty string.------ Supported character classes:------ [@[:alnum:\]@]  Equivalent to @\"0-9A-Za-z\"@.------ [@[:alpha:\]@]  Equivalent to @\"A-Za-z\"@.------ [@[:blank:\]@]  Equivalent to @\"\\t \"@.------ [@[:cntrl:\]@]  Equivalent to @\"\\0-\\x1f\\x7f\"@.------ [@[:digit:\]@]  Equivalent to @\"0-9\"@.------ [@[:graph:\]@]  Equivalent to @\"!-~\"@.------ [@[:lower:\]@]  Equivalent to @\"a-z\"@.------ [@[:print:\]@]  Equivalent to @\" -~\"@.------ [@[:punct:\]@]  Equivalent to @\"!-\/:-\@[-`{-~\"@.------ [@[:space:\]@]  Equivalent to @\"\\t-\\r \"@.------ [@[:upper:\]@]  Equivalent to @\"A-Z\"@.------ [@[:xdigit:\]@] Equivalent to @\"0-9A-Fa-f\"@.------ Note that path separators (typically @\'/\'@) have to be matched explicitly--- or using the @**/@ pattern. In addition, extension separators (typically--- @\'.\'@) have to be matched explicitly at the beginning of the pattern or--- after any path separator.------ If a system supports multiple path separators, any one of them will match--- any of them. For instance, on Windows, @\'/\'@ will match itself as well as--- @\'\\\'@.------ Error recovery will be performed: erroneous operators will not be considered--- operators, but matched as literal strings. Such operators include:------ * An empty @[]@ or @[^]@ or @[!]@------ * A @[@ or @\<@ without a matching @]@ or @>@------ * A malformed @\<>@: e.g. nonnumeric characters or no hyphen------ So, e.g. @[]@ will match the string @\"[]\"@.-compile :: String -> Pattern-compile = compileWith compDefault---- |Like 'compile', but recognizes operators according to the given--- 'CompOptions' instead of the defaults.------ If an error occurs and 'errorRecovery' is disabled, 'error' will be called.-compileWith :: CompOptions -> String -> Pattern-compileWith opts = either error id . tryCompileWith opts---- |A safe version of 'compileWith'.------ If an error occurs and 'errorRecovery' is disabled, the error message will--- be returned in a 'Left'.-tryCompileWith :: CompOptions -> String -> Either String Pattern-tryCompileWith opts = fmap optimize . tokenize opts--tokenize :: CompOptions -> String -> Either String Pattern-tokenize opts = fmap Pattern . sequence . go- where-   err _ c cs | errorRecovery opts = Right (Literal c) : go cs-   err s _ _                       = [Left s]--   go :: String -> [Either String Token]-   go [] = []-   go ('?':cs) | wcs = Right NonPathSeparator : go cs-   go ('*':cs) | wcs =-      case cs of-           '*':p:xs | rwcs && isPathSeparator p-              -> Right AnyDirectory        : go xs-           _  -> Right AnyNonPathSeparator : go cs--   go ('[':cs) | crs = let (range,rest) = charRange opts cs-                        in case range of-                                Left s -> err s '[' cs-                                r      -> r : go rest--   go ('<':cs) | ors =-      let (range, rest) = break (=='>') cs-       in if null rest-             then err "compile :: unclosed <> in pattern" '<' cs-             else case openRange range of-                       Left s -> err s '<' cs-                       r      -> r : go (tail rest)-   go (c:cs)-      | isPathSeparator c = Right PathSeparator : go cs-      | isExtSeparator  c = Right  ExtSeparator : go cs-      | otherwise         = Right (Literal c)   : go cs--   wcs  = wildcards          opts-   rwcs = recursiveWildcards opts-   crs  = characterRanges    opts-   ors  = numberRanges       opts---- <a-b> where a > b can never match anything; this is not considered an error-openRange :: String -> Either String Token-openRange ['-']   = Right $ OpenRange Nothing Nothing-openRange ('-':s) =-   case span isDigit s of-        (b,"") -> Right $ OpenRange Nothing (openRangeNum b)-        _      -> Left $ "compile :: bad <>, expected number, got " ++ s-openRange s =-   case span isDigit s of-        (a,"-")    -> Right $ OpenRange (openRangeNum a) Nothing-        (a,'-':s') ->-           case span isDigit s' of-                (b,"") -> Right $ OpenRange (openRangeNum a) (openRangeNum b)-                _ -> Left $ "compile :: bad <>, expected number, got " ++ s'-        _ -> Left $ "compile :: bad <>, expected number followed by - in " ++ s--openRangeNum :: String -> Maybe String-openRangeNum = Just . dropLeadingZeroes--type CharRange = [Either Char (Char,Char)]--charRange :: CompOptions -> String -> (Either String Token, String)-charRange opts zs =-   case zs of-        y:ys | y `elem` "^!" ->-           case ys of-                -- [!-#] is not the inverse of [-#], it is the range ! through-                -- #-                '-':']':xs -> (Right (CharRange False [Left '-']), xs)-                '-'    :_  -> first (fmap (CharRange True )) (start zs)-                xs         -> first (fmap (CharRange False)) (start xs)-        _                  -> first (fmap (CharRange True )) (start zs)- where-   start :: String -> (Either String CharRange, String)-   start (']':xs) = run $ char ']' xs-   start ('-':xs) = run $ char '-' xs-   start xs       = run $ go xs--   run :: ErrorT String (Writer CharRange) String-       -> (Either String CharRange, String)-   run m = case runWriter.runErrorT $ m of-                (Left   err,  _) -> (Left err, [])-                (Right rest, cs) -> (Right cs, rest)--   go :: String -> ErrorT String (Writer CharRange) String-   go ('[':':':xs) | characterClasses opts = readClass xs-   go (    ']':xs) = return xs-   go (      c:xs) =-      if not (pathSepInRanges opts) && isPathSeparator c-         then throwError "compile :: path separator within []"-         else char c xs-   go []           = throwError "compile :: unclosed [] in pattern"--   char :: Char -> String -> ErrorT String (Writer CharRange) String-   char c ('-':x:xs) =-      if x == ']'-         then ltell [Left c, Left '-'] >> return xs-         else ltell [Right (c,x)]      >>     go xs--   char c xs = ltell [Left c] >> go xs--   readClass :: String -> ErrorT String (Writer CharRange) String-   readClass xs = let (name,end) = span isAlpha xs-                   in case end of-                           ':':']':rest -> charClass name            >> go rest-                           _            -> ltell [Left '[',Left ':'] >> go xs--   charClass :: String -> ErrorT String (Writer CharRange) ()-   charClass name =-      -- The POSIX classes-      ---      -- TODO: this is ASCII-only, not sure how this should be extended-      --       Unicode, or with a locale as input, or something else?-      case name of-           "alnum"  -> ltell [digit,upper,lower]-           "alpha"  -> ltell [upper,lower]-           "blank"  -> ltell blanks-           "cntrl"  -> ltell [Right ('\0','\x1f'), Left '\x7f']-           "digit"  -> ltell [digit]-           "graph"  -> ltell [Right ('!','~')]-           "lower"  -> ltell [lower]-           "print"  -> ltell [Right (' ','~')]-           "punct"  -> ltell punct-           "space"  -> ltell spaces-           "upper"  -> ltell [upper]-           "xdigit" -> ltell [digit, Right ('A','F'), Right ('a','f')]-           _        ->-              throwError ("compile :: unknown character class '" ++name++ "'")--   digit  = Right ('0','9')-   upper  = Right ('A','Z')-   lower  = Right ('a','z')-   punct  = map Right [('!','/'), (':','@'), ('[','`'), ('{','~')]-   blanks = [Left '\t',         Left ' ']-   spaces = [Right ('\t','\r'), Left ' ']--   ltell = lift . tell------------------------------------------------ OPTIMIZATION----------------------------------------------optimize :: Pattern -> Pattern-optimize = liftP (fin . go)- where-   fin [] = []--   -- Literals to LongLiteral-   -- Has to be done here: we can't backtrack in go, but some cases might-   -- result in consecutive Literals being generated.-   -- E.g. "a[b]".-   fin (x:y:xs) | isLiteral x && isLiteral y =-      let (ls,rest) = span isLiteral xs-       in fin $ LongLiteral (length ls + 2)-                            (foldr (\(Literal a) -> (a:)) [] (x:y:ls))-                : rest--   -- concatenate LongLiterals-   -- Has to be done here because LongLiterals are generated above.-   ---   -- So one could say that we have one pass (go) which flattens everything as-   -- much as it can and one pass (fin) which concatenates what it can.-   fin (LongLiteral l1 s1 : LongLiteral l2 s2 : xs) =-      fin $ LongLiteral (l1+l2) (s1++s2) : xs--   fin (LongLiteral l s : Literal c : xs) =-      fin $ LongLiteral (l+1) (s++[c]) : xs--   fin (LongLiteral 1 s : xs) = Literal (head s) : fin xs--   fin (Literal c : LongLiteral l s : xs) =-      fin $ LongLiteral (l+1) (c:s) : xs--   fin (x:xs) = x : fin xs--   go [] = []-   go (x@(CharRange _ _) : xs) =-      case optimizeCharRange x of-           x'@(CharRange _ _) -> x' : go xs-           x'                 -> go (x':xs)--   -- <a-a> -> a-   go (OpenRange (Just a) (Just b):xs)-      | a == b = LongLiteral (length a) a : go xs--   -- <a-b> -> [a-b]-   -- a and b are guaranteed non-null-   go (OpenRange (Just [a]) (Just [b]):xs)-      | b > a = go $ CharRange True [Right (a,b)] : xs--   go (x:xs) =-      case find ($ x) compressors of-           Just c  -> let (compressed,ys) = span c xs-                       in if null compressed-                             then x : go ys-                             else go (x : ys)-           Nothing -> x : go xs--   compressors = [isStar, isStarSlash, isAnyNumber]--   isLiteral   (Literal _)                 = True-   isLiteral   _                           = False-   isStar      AnyNonPathSeparator         = True-   isStar      _                           = False-   isStarSlash AnyDirectory                = True-   isStarSlash _                           = False-   isAnyNumber (OpenRange Nothing Nothing) = True-   isAnyNumber _                           = False--optimizeCharRange :: Token -> Token-optimizeCharRange (CharRange b_ rs) = fin b_ . go . sortCharRange $ rs- where-   -- [/] is interesting, it actually matches nothing at all-   -- [.] can be Literalized though, just don't make it into an ExtSeparator so-   --     that it doesn't match a leading dot-   fin True [Left  c] | not (isPathSeparator c) = Literal c-   fin True [Right r] | r == (minBound,maxBound) = NonPathSeparator-   fin b x = CharRange b x--   go [] = []--   go (x@(Left c) : xs) =-      case xs of-           [] -> [x]-           y@(Left d) : ys-              -- [aaaaa] -> [a]-              | c == d      -> go$ Left c : ys-              | d == succ c ->-                 let (ls,rest)        = span isLeft xs -- start from y-                     (catable,others) = increasingSeq (map fromLeft ls)-                     range            = (c, head catable)--                  in -- three (or more) Lefts make a Right-                     if null catable || null (tail catable)-                        then x : y : go ys-                        -- [abcd] -> [a-d]-                        else go$ Right range : map Left others ++ rest--              | otherwise -> x : go xs--           Right r : ys ->-              case addToRange r c of-                   -- [da-c] -> [a-d]-                   Just r' -> go$ Right r' : ys-                   Nothing -> x : go xs--   go (x@(Right r) : xs) =-      case xs of-           [] -> [x]-           Left c : ys ->-              case addToRange r c of-                   -- [a-cd] -> [a-d]-                   Just r' -> go$ Right r' : ys-                   Nothing -> x : go xs--           Right r' : ys ->-              case overlap r r' of-                   -- [a-cb-d] -> [a-d]-                   Just o  -> go$ Right o : ys-                   Nothing -> x : go xs-optimizeCharRange _ = error "Glob.optimizeCharRange :: internal error"--sortCharRange :: [Either Char (Char,Char)] -> [Either Char (Char,Char)]-sortCharRange = sortBy cmp- where-   cmp (Left   a)    (Left   b)    = compare a b-   cmp (Left   a)    (Right (b,_)) = compare a b-   cmp (Right (a,_)) (Left   b)    = compare a b-   cmp (Right (a,_)) (Right (b,_)) = compare a b
− src/System/FilePath/Glob/Directory.hs 
@@ -1,299 +0,0 @@--- File created: 2008-10-16 12:12:50--module System.FilePath.Glob.Directory-   ( globDir, globDirWith, globDir1, glob-   , commonDirectory-   ) where--import Control.Arrow    (first, second)-import Control.Monad    (forM)-import qualified Data.DList as DL-import Data.DList       (DList)-import Data.List        ((\\))-import System.Directory ( doesDirectoryExist, getDirectoryContents-                        , getCurrentDirectory-                        )-import System.FilePath  ( (</>), takeDrive, splitDrive-                        , extSeparator, isExtSeparator-                        , pathSeparator, isPathSeparator-                        )--import System.FilePath.Glob.Base  ( Pattern(..), Token(..)-                                  , MatchOptions, matchDefault-                                  , compile-                                  )-import System.FilePath.Glob.Match (matchWith)-import System.FilePath.Glob.Utils ( getRecursiveContents-                                  , nubOrd-                                  , pathParts-                                  , partitionDL-                                  )--import System.IO.Error (catchIOError)---- The Patterns in TypedPattern don't contain PathSeparator or AnyDirectory------ We store the number of PathSeparators that Dir and AnyDir were followed by--- so that "foo////*" can match "foo/bar" but return "foo////bar". It's the--- exact number for convenience: (</>) doesn't add a path separator if one is--- already there. This way, '\(Dir n _) -> replicate n pathSeparator </> "bar"'--- results in the correct amount of slashes.-data TypedPattern-   = Any Pattern        -- pattern-   | Dir Int Pattern    -- pattern/-   | AnyDir Int Pattern -- pattern**/-   deriving Show---- |Matches each given 'Pattern' against the contents of the given 'FilePath',--- recursively. The result pair\'s first component contains the matched paths,--- grouped for each given 'Pattern', and the second contains all paths which--- were not matched by any 'Pattern'. The results are not in any defined order.------ The given directory is prepended to all the matches: the returned paths are--- all valid from the point of view of the current working directory.------ If multiple 'Pattern's match a single 'FilePath', that path will be included--- in multiple groups.------ Two 'FilePath's which can be canonicalized to the same file (e.g. @\"foo\"@--- and @\"./foo\"@) may appear separately if explicit matching on paths--- beginning with @\".\"@ is done. Looking for @\".*/*\"@, for instance, will--- cause @\"./foo\"@ to return as a match but @\"foo\"@ to not be matched.------ This function is different from a simple 'filter' over all the contents of--- the directory: the matching is performed relative to the directory, so that--- for instance the following is true:------ > fmap (head.fst) (globDir [compile "*"] dir) == getDirectoryContents dir------ (With the exception that that glob won't match anything beginning with @.@.)------ If the given 'FilePath' is @[]@, 'getCurrentDirectory' will be used.------ If the given 'Pattern' starts with a drive (as defined by--- 'System.FilePath'), it is not relative to the given directory and the--- 'FilePath' parameter is completely ignored! Similarly, if the given--- 'Pattern' starts with a path separator, only the drive part of the--- 'FilePath' is used. On Posix systems these behaviours are equivalent:--- 'Pattern's starting with @\/@ work relative to @\/@. On Windows, 'Pattern's--- starting with @\/@ or @\\@ work relative only to the drive part of the--- 'FilePath' and 'Pattern's starting with absolute paths ignore the--- 'FilePath'.------ Note that in some cases results outside the given directory may be returned:--- for instance the @.*@ pattern matches the @..@ directory.------ Any results deeper than in the given directory are enumerated lazily, using--- 'unsafeInterleaveIO'.------ Directories without read permissions are returned as entries but their--- contents, of course, are not.-globDir :: [Pattern] -> FilePath -> IO ([[FilePath]], [FilePath])-globDir = globDirWith matchDefault---- |Like 'globDir', but applies the given 'MatchOptions' instead of the--- defaults when matching.-globDirWith :: MatchOptions -> [Pattern] -> FilePath-            -> IO ([[FilePath]], [FilePath])-globDirWith _ []   dir = do-   dir' <- if null dir then getCurrentDirectory else return dir-   c <- getRecursiveContents dir'-   return ([], DL.toList c)--globDirWith opts pats@(_:_) dir = do-   results <- mapM (\p -> globDir'0 opts p dir) pats--   let (matches, others) = unzip results-       allMatches        = DL.toList . DL.concat $ matches-       allOthers         = DL.toList . DL.concat $ others--   return ( map DL.toList matches-          , nubOrd allOthers \\ allMatches-          )---- |A convenience wrapper on top of 'globDir', for when you only have one--- 'Pattern' you care about. Returns only the matched paths.-globDir1 :: Pattern -> FilePath -> IO [FilePath]-globDir1 p = fmap (head . fst) . globDir [p]---- |The simplest IO function. Finds matches to the given pattern in the current--- working directory. Takes a 'String' instead of a 'Pattern' to avoid the need--- for a call to 'compile', simplifying usage further.------ Can also be seen as a convenience wrapper on top of 'globDir1', for when you--- want to work in the current directory or have a pattern referring to an--- absolute path.-glob :: String -> IO [FilePath]-glob = flip globDir1 "" . compile--globDir'0 :: MatchOptions -> Pattern -> FilePath-          -> IO (DList FilePath, DList FilePath)-globDir'0 opts pat dir = do-   let (pat', drive) = driveSplit pat-   dir' <- case drive of-                Just "" -> fmap takeDrive getCurrentDirectory-                Just d  -> return d-                Nothing -> if null dir then getCurrentDirectory else return dir-   globDir' opts (separate pat') dir'--globDir' :: MatchOptions -> [TypedPattern] -> FilePath-         -> IO (DList FilePath, DList FilePath)-globDir' opts pats@(_:_) dir = do-   entries <- getDirectoryContents dir `catchIOError` const (return [])--   results <- forM entries $ \e -> matchTypedAndGo opts pats e (dir </> e)--   let (matches, others) = unzip results--   return (DL.concat matches, DL.concat others)--globDir' _ [] dir =-   -- We can only get here from matchTypedAndGo getting a [Dir _]: it means the-   -- original pattern had a trailing PathSeparator. Reproduce it here.-   return (DL.singleton (dir ++ [pathSeparator]), DL.empty)--matchTypedAndGo :: MatchOptions-                -> [TypedPattern]-                -> FilePath -> FilePath-                -> IO (DList FilePath, DList FilePath)---- (Any p) is always the last element-matchTypedAndGo opts [Any p] path absPath =-   if matchWith opts p path-      then return (DL.singleton absPath, DL.empty)-      else doesDirectoryExist absPath >>= didn'tMatch path absPath--matchTypedAndGo opts (Dir n p:ps) path absPath = do-   isDir <- doesDirectoryExist absPath-   if isDir && matchWith opts p path-      then globDir' opts ps (absPath ++ replicate n pathSeparator)-      else didn'tMatch path absPath isDir--matchTypedAndGo opts (AnyDir n p:ps) path absPath = do-   if path `elem` [".",".."]-      then didn'tMatch path absPath True-      else do-         isDir <- doesDirectoryExist absPath-         let m = matchWith opts (unseparate ps)-             unconditionalMatch =-                null (unPattern p) && not (isExtSeparator $ head path)-             p' = Pattern (unPattern p ++ [AnyNonPathSeparator])--         case unconditionalMatch || matchWith opts p' path of-              True | isDir  -> do-                 contents <- getRecursiveContents-                                (absPath ++ replicate n pathSeparator)-                 return $-                    -- foo**/ should match foo/ and nothing below it-                    -- relies on head contents == absPath-                    if null ps-                       then (DL.singleton $ DL.head contents, DL.tail contents)-                       else partitionDL (any m . pathParts) contents--              True | m path -> return (DL.singleton absPath, DL.empty)-              _             -> didn'tMatch path absPath isDir--matchTypedAndGo _ _ _ _ = error "Glob.matchTypedAndGo :: internal error"---- To be called when a pattern didn't match a path: given the path and whether--- it was a directory, return all paths which didn't match (i.e. for a file,--- just the file, and for a directory, everything inside it).-didn'tMatch :: FilePath -> FilePath -> Bool-            -> IO (DList FilePath, DList FilePath)-didn'tMatch path absPath isDir = (fmap $ (,) DL.empty) $-   if isDir-      then if path `elem` [".",".."]-              then return DL.empty-              else getRecursiveContents absPath-      else return$ DL.singleton absPath--separate :: Pattern -> [TypedPattern]-separate = go DL.empty . unPattern- where-   go gr [] | null (DL.toList gr) = []-   go gr []                       = [Any (pat gr)]-   go gr (PathSeparator:ps)       = slash gr Dir ps-   go gr ( AnyDirectory:ps)       = slash gr AnyDir ps-   go gr (            p:ps)       = go (gr `DL.snoc` p) ps--   pat = Pattern . DL.toList--   slash gr f ps = let (n,ps') = first length . span isSlash $ ps-                    in f (n+1) (pat gr) : go DL.empty ps'--   isSlash PathSeparator = True-   isSlash _             = False--unseparate :: [TypedPattern] -> Pattern-unseparate = Pattern . foldr f []- where-   f (AnyDir n p) ts = u p ++ AnyDirectory  : replicate n PathSeparator ++ ts-   f (   Dir n p) ts = u p ++ PathSeparator : replicate n PathSeparator ++ ts-   f (Any      p) ts = u p ++ ts--   u = unPattern---- Note that we consider "/foo" to specify a drive on Windows, even though it's--- relative to the current drive.------ Returns the [TypedPattern] of the Pattern (with the drive dropped if--- appropriate) and, if the Pattern specified a drive, a Maybe representing the--- drive to use. If it's a Just "", use the drive of the current working--- directory.-driveSplit :: Pattern -> (Pattern, Maybe FilePath)-driveSplit = check . split . unPattern- where-   -- We can't just use something like commonDirectory because of Windows-   -- drives being possibly longer than one "directory", like "//?/foo/bar/".-   -- So just take as much as possible.-   split (LongLiteral _ l : xs) = first (l++) (split xs)-   split (    Literal   l : xs) = first (l:) (split xs)-   split (PathSeparator   : xs) = first (pathSeparator:) (split xs)-   split ( ExtSeparator   : xs) = first ( extSeparator:) (split xs)-   split xs                     = ([],xs)--   -- The isPathSeparator check is interesting in two ways:-   ---   -- 1. It's correct to return simply Just "" because there can't be more than-   --    one path separator if splitDrive gave a null drive: "//x" is a shared-   --    "drive" in Windows and starts with the root "drive" in Posix.-   ---   -- 2. The 'head' is safe because we have not (null d) && null drive.-   check (d,ps)-      | null d                      = (Pattern     ps, Nothing)-      | not (null drive)            = (dirify rest ps, Just drive)-      | isPathSeparator (head rest) = (Pattern     ps, Just "")-      | otherwise                   = (dirify d    ps, Nothing)-    where-      (drive, rest) = splitDrive d--   dirify path = Pattern . (comp path++)--   comp s = let (p,l) = foldr f ([],[]) s in if null l then p else ll l p-    where-      f c (p,l) | isExtSeparator  c = (ExtSeparator  : ll l p, [])-                | isPathSeparator c = (PathSeparator : ll l p, [])-                | otherwise         = (p, c:l)--      ll l p = if null l then p else LongLiteral (length l) l : p---- |Factors out the directory component of a 'Pattern'. Useful in conjunction--- with 'globDir'.------ Preserves the number of path separators: @commonDirectory (compile--- \"foo\/\/\/bar\")@ becomes @(\"foo\/\/\/\", compile \"bar\")@.-commonDirectory :: Pattern -> (FilePath, Pattern)-commonDirectory = second unseparate . splitP . separate- where-   splitP pt@(Dir n p:ps) =-      case fromConst DL.empty (unPattern p) of-           Just d  -> first ((d ++ replicate n pathSeparator) </>) (splitP ps)-           Nothing -> ("", pt)--   splitP pt = ("", pt)--   fromConst d []                   = Just (DL.toList d)-   fromConst d (Literal c      :xs) = fromConst (d `DL.snoc` c) xs-   fromConst d (ExtSeparator   :xs) = fromConst (d `DL.snoc` extSeparator) xs-   fromConst d (LongLiteral _ s:xs) = fromConst (d `DL.append`DL.fromList s) xs-   fromConst _ _                    = Nothing
− src/System/FilePath/Glob/Match.hs 
@@ -1,157 +0,0 @@--- File created: 2008-10-10 13:29:03--module System.FilePath.Glob.Match (match, matchWith) where--import Control.Exception (assert)-import Data.Char         (isDigit, toLower, toUpper)-import Data.Monoid       (mappend)-import System.FilePath   (isPathSeparator, isExtSeparator)--import System.FilePath.Glob.Base  ( Pattern(..), Token(..)-                                  , MatchOptions(..), matchDefault-                                  , tokToLower-                                  )-import System.FilePath.Glob.Utils (dropLeadingZeroes, inRange, pathParts)---- |Matches the given 'Pattern' against the given 'FilePath', returning 'True'--- if the pattern matches and 'False' otherwise.-match :: Pattern -> FilePath -> Bool-match = matchWith matchDefault---- |Like 'match', but applies the given 'MatchOptions' instead of the defaults.-matchWith :: MatchOptions -> Pattern -> FilePath -> Bool-matchWith opts p f = begMatch opts (lcPat $ unPattern p) (lcPath f)- where-   lcPath = if ignoreCase opts then map    toLower else id-   lcPat  = if ignoreCase opts then map tokToLower else id---- begMatch takes care of some things at the beginning of a pattern or after /:---    - . needs to be matched explicitly---    - ./foo is equivalent to foo (for any number of /)------ .*/foo still needs to match ./foo though, and it won't match plain foo;--- special case that one------ and .**/foo should /not/ match ../foo; more special casing------ (All of the above is modulo options, of course)-begMatch, match' :: MatchOptions -> [Token] -> FilePath -> Bool-begMatch _ (ExtSeparator:AnyDirectory:_) (x:y:_)-   | isExtSeparator x && isExtSeparator y = False--begMatch opts (ExtSeparator:PathSeparator:pat) s | ignoreDotSlash opts =-   begMatch opts (dropWhile isSlash pat) s- where-   isSlash PathSeparator = True-   isSlash _             = False--begMatch opts pat (x:y:s)-   | dotSlash && dotStarSlash        = match' opts pat' s-   | ignoreDotSlash opts && dotSlash = begMatch opts pat s- where-   dotSlash = isExtSeparator x && isPathSeparator y-   (dotStarSlash, pat') =-      case pat of-        ExtSeparator:AnyNonPathSeparator:PathSeparator:rest -> (True, rest)-        _                                                   -> (False, pat)--begMatch opts pat s =-   if not (null s) && isExtSeparator (head s) && not (matchDotsImplicitly opts)-      then case pat of-                ExtSeparator:pat' -> match' opts pat' (tail s)-                _                 -> False-      else match' opts pat s--match' _ []                        s  = null s-match' _ (AnyNonPathSeparator:s)   "" = null s-match' _ _                         "" = False-match' o (Literal l       :xs) (c:cs) =           l == c  && match' o xs cs-match' o ( ExtSeparator   :xs) (c:cs) = isExtSeparator c  && match' o xs cs-match' o (NonPathSeparator:xs) (c:cs) =-   not (isPathSeparator c) && match' o xs cs--match' o (PathSeparator   :xs) (c:cs) =-   isPathSeparator c && begMatch o xs (dropWhile isPathSeparator cs)--match' o (CharRange b rng :xs) (c:cs) =-   let rangeMatch r =-          either (== c) (`inRange` c) r ||-             -- See comment near Base.tokToLower for an explanation of why we-             -- do this-             if ignoreCase o-                then either (== toUpper c) (`inRange` toUpper c) r-                else False-    in not (isPathSeparator c) &&-       any rangeMatch rng == b &&-       match' o xs cs--match' o (OpenRange lo hi :xs) path =-   let-      (lzNum,cs) = span isDigit path-      num        = dropLeadingZeroes lzNum-      numChoices =-         tail . takeWhile (not.null.snd) . map (flip splitAt num) $ [0..]-    in if null lzNum-          then False -- no digits-          else-            -- So, given the path "123foo" what we've got is:-            --    cs         = "foo"-            --    num        = "123"-            --    numChoices = [("1","23"),("12","3")]-            ---            -- We want to try matching x against each of 123, 12, and 1.-            -- 12 and 1 are in numChoices already, but we need to add (num,"")-            -- manually.-            any (\(n,rest) -> inOpenRange lo hi n && match' o xs (rest ++ cs))-                ((num,"") : numChoices)--match' o again@(AnyNonPathSeparator:xs) path@(c:cs) =-   match' o xs path || (if isPathSeparator c then False else match' o again cs)--match' o again@(AnyDirectory:xs) path =-   let parts   = pathParts (dropWhile isPathSeparator path)-       matches = any (match' o xs) parts || any (match' o again) (tail parts)-    in if null xs && not (matchDotsImplicitly o)-          --  **/ shouldn't match foo/.bar, so check that remaining bits don't-          -- start with .-          then all (not.isExtSeparator.head) (init parts) && matches-          else matches--match' o (LongLiteral len s:xs) path =-   let (pre,cs) = splitAt len path-    in pre == s && match' o xs cs---- Does the actual open range matching: finds whether the third parameter--- is between the first two or not.------ It does this by keeping track of the Ordering so far (e.g. having--- looked at "12" and "34" the Ordering of the two would be LT: 12 < 34)--- and aborting if a String "runs out": a longer string is automatically--- greater.------ Assumes that the input strings contain only digits, and no leading zeroes.-inOpenRange :: Maybe String -> Maybe String -> String -> Bool-inOpenRange l_ h_ s_ = assert (all isDigit s_) $ go l_ h_ s_ EQ EQ- where-   go Nothing      Nothing   _     _ _  = True  -- no bounds-   go (Just [])    _         []    LT _ = False --  lesser than lower bound-   go _            (Just []) _     _ GT = False -- greater than upper bound-   go _            (Just []) (_:_) _ _  = False --  longer than upper bound-   go (Just (_:_)) _         []    _ _  = False -- shorter than lower bound-   go _            _         []    _ _  = True--   go (Just (l:ls)) (Just (h:hs)) (c:cs) ordl ordh =-      let ordl' = ordl `mappend` compare c l-          ordh' = ordh `mappend` compare c h-       in go (Just ls) (Just hs) cs ordl' ordh'--   go Nothing (Just (h:hs)) (c:cs) _ ordh =-      let ordh' = ordh `mappend` compare c h-       in go Nothing (Just hs) cs GT ordh'--   go (Just (l:ls)) Nothing (c:cs) ordl _ =-      let ordl' = ordl `mappend` compare c l-       in go (Just ls) Nothing cs ordl' LT--   -- lower bound is shorter: s is greater-   go (Just []) hi s _ ordh = go Nothing hi s GT ordh
− src/System/FilePath/Glob/Primitive.hs 
@@ -1,57 +0,0 @@--- File created: 2009-01-17---- |A number of primitives from which complete 'Pattern's may be constructed.------ Using this together with the functions provided by the 'Monoid' instance of--- 'Pattern' allows for direct manipulation of 'Pattern's beyond what can be--- done with just the 'compile' family of functions. And of course you don't--- have to go via 'String's if you use these.-module System.FilePath.Glob.Primitive-   ( literal-   , singleWildcard, wildcard, recursiveWildcard-   , charRange, numberRange-   ) where--import System.FilePath (isPathSeparator, isExtSeparator)--import System.FilePath.Glob.Base (Pattern(..), Token(..), optimize)---- |A 'Pattern' which matches the given 'String' literally.------ Handles any embedded path and extension separators.-literal :: String -> Pattern-literal = optimize . Pattern . map f- where-   f c | isPathSeparator c = PathSeparator-       | isExtSeparator c  = ExtSeparator-       | otherwise         = Literal c---- |Matches any single character except a path separator: corresponds to the--- @?@ operator.-singleWildcard :: Pattern-singleWildcard = Pattern [NonPathSeparator]---- |Matches any number of characters up to a path separator: corresponds to the--- @*@ operator.-wildcard :: Pattern-wildcard = Pattern [AnyNonPathSeparator]---- |Matches any number of characters including path separators: corresponds to--- the @**/@ operator.-recursiveWildcard :: Pattern-recursiveWildcard = Pattern [AnyDirectory]---- |Matches a single character if it is within the (inclusive) range in any--- 'Right' or if it is equal to the character in any 'Left'. Corresponds to the--- @[]@, @[^]@ and @[!]@ operators.------ If the given 'Bool' is 'False', the result of the match is inverted: the--- match succeeds if the character does /not/ match according to the above--- rules.-charRange :: Bool -> [Either Char (Char,Char)] -> Pattern-charRange b rs = optimize $ Pattern [CharRange b rs]---- |Matches a number in the given range, which may be open, half-open, or--- closed. Corresponds to the @\<\>@ operator.-numberRange :: Maybe Integer -> Maybe Integer -> Pattern-numberRange a b = Pattern [OpenRange (fmap show a) (fmap show b)]
− src/System/FilePath/Glob/Simplify.hs 
@@ -1,42 +0,0 @@--- File created: 2009-01-30 14:54:14--module System.FilePath.Glob.Simplify (simplify) where--import System.FilePath.Glob.Base (Pattern(..), Token(..), liftP)---- |Simplifies a 'Pattern' object: removes redundant @\"./\"@, for instance.--- The resulting 'Pattern' matches the exact same input as the original one,--- with some differences:------ * The output of 'globDir' will differ: for example, globbing for @\"./\*\"@---   gives @\"./foo\"@, but after simplification this'll be only @\"foo\"@.------ * Decompiling the simplified 'Pattern' will obviously not give the original.------ * The simplified 'Pattern' is a bit faster to match with and uses less---   memory, since some redundant data is removed.------ For the last of the above reasons, if you're performance-conscious and not--- using 'globDir', you should always 'simplify' after calling 'compile'.-simplify :: Pattern -> Pattern-simplify = liftP (go . pre)- where-   -- ./ at beginning -> nothing (any number of /'s)-   pre (ExtSeparator:PathSeparator:xs) = pre (dropWhile isSlash xs)-   pre                             xs  = xs--   go [] = []--   -- /./ -> /-   go (PathSeparator:ExtSeparator:xs@(PathSeparator:_)) = go xs--   go (x:xs) =-      if isSlash x-         then let (compressed,ys) = span isSlash xs-               in if null compressed-                     then x : go ys-                     else go (x : ys)-         else x : go xs--   isSlash PathSeparator = True-   isSlash _             = False
− src/System/FilePath/Glob/Utils.hs 
@@ -1,165 +0,0 @@-{-# LANGUAGE CPP #-}--- File created: 2008-10-10 13:40:35--module System.FilePath.Glob.Utils-   ( isLeft, fromLeft-   , increasingSeq-   , addToRange, inRange, overlap-   , dropLeadingZeroes-   , pathParts-   , nubOrd-   , partitionDL-   , getRecursiveContents-   ) where--import Control.Monad    (foldM)-import Data.List        ((\\))-import qualified Data.DList as DL-import Data.DList       (DList)-import qualified Data.Set as Set-import System.Directory (getDirectoryContents)-import System.FilePath  ((</>), isPathSeparator, dropDrive)-import System.IO.Unsafe (unsafeInterleaveIO)--#if mingw32_HOST_OS-import Data.Bits          ((.&.))-import System.Win32.Types (withTString)-import System.Win32.File  (c_GetFileAttributes, fILE_ATTRIBUTE_DIRECTORY)-#else-import Foreign.C.String      (withCString)-import Foreign.Marshal.Alloc (allocaBytes)-import System.FilePath-   (isDrive, dropTrailingPathSeparator, addTrailingPathSeparator)-import System.Posix.Internals (sizeof_stat, lstat, s_isdir, st_mode)-#endif---import System.IO.Error (catchIOError)--inRange :: Ord a => (a,a) -> a -> Bool-inRange (a,b) c = c >= a && c <= b---- returns Just (a range which covers both given ranges) or Nothing if they are--- disjoint.------ Assumes that the ranges are in the correct order, i.e. (fst x < snd x).-overlap :: Ord a => (a,a) -> (a,a) -> Maybe (a,a)-overlap (a,b) (c,d) =-   if b >= c-      then if b >= d-              then if a <= c-                      then Just (a,b)-                      else Just (c,b)-              else if a <= c-                      then Just (a,d)-                      else Just (c,d)-      else Nothing--addToRange :: (Ord a, Enum a) => (a,a) -> a -> Maybe (a,a)-addToRange (a,b) c-   | inRange (a,b) c = Just (a,b)-   | c == pred a     = Just (c,b)-   | c == succ b     = Just (a,c)-   | otherwise       = Nothing---- fst of result is in reverse order so that:------ If x = fst (increasingSeq (a:xs)), then--- x == reverse [a .. head x]-increasingSeq :: (Eq a, Enum a) => [a] -> ([a],[a])-increasingSeq []     = ([],[])-increasingSeq (x:xs) = go [x] xs- where-   go is       []     = (is,[])-   go is@(i:_) (y:ys) =-      if y == succ i-         then go (y:is) ys-         else (is, y:ys)-   go _ _ = error "Glob.increasingSeq :: internal error"--isLeft :: Either a b -> Bool-isLeft (Left _) = True-isLeft _        = False--fromLeft :: Either a b -> a-fromLeft (Left x) = x-fromLeft _        = error "fromLeft :: Right"--dropLeadingZeroes :: String -> String-dropLeadingZeroes s =-   let x = dropWhile (=='0') s-    in if null x then "0" else x---- foo/bar/baz -> [foo/bar/baz,bar/baz,baz]-pathParts :: FilePath -> [FilePath]-pathParts p = p : let d = dropDrive p-                   in if null d || d == p-                         then     f d-                         else d : f d- where-   f []  = []-   f (x:xs@(y:_)) | isPathSeparator x && isPathSeparator y = f xs-   f (x:xs) =-      if isPathSeparator x-         then xs : f xs-         else      f xs---- Significantly speedier than System.Directory.doesDirectoryExist.-doesDirectoryExist :: FilePath -> IO Bool-#if mingw32_HOST_OS--- This one allocates more memory since it has to do a UTF-16 conversion, but--- that can't really be helped: the below version is locale-dependent.-doesDirectoryExist = flip withTString $ \s -> do-   a <- c_GetFileAttributes s-   return (a /= 0xffffffff && a.&.fILE_ATTRIBUTE_DIRECTORY /= 0)-#else-doesDirectoryExist s =-   allocaBytes sizeof_stat $ \p ->-      withCString-         (if isDrive s-             then addTrailingPathSeparator s-             else dropTrailingPathSeparator s)-         $ \c -> do-            st <- lstat c p-            if st == 0-               then fmap s_isdir (st_mode p)-               else return False-#endif--getRecursiveContents :: FilePath -> IO (DList FilePath)-getRecursiveContents dir =-   flip catchIOError (\_ -> return $ DL.singleton dir) $ do--      raw <- getDirectoryContents dir--      let entries = map (dir </>) (raw \\ [".",".."])-      (dirs,files) <- partitionM doesDirectoryExist entries--      subs <- unsafeInterleaveIO . mapM getRecursiveContents $ dirs--      return$ DL.cons dir (DL.fromList files `DL.append` DL.concat subs)--partitionM :: (Monad m) => (a -> m Bool) -> [a] -> m ([a], [a])-partitionM p_ = foldM (f p_) ([],[])- where-   f p (ts,fs) x = p x >>= \b ->-      if b-         then return (x:ts, fs)-         else return (ts, x:fs)--partitionDL :: (a -> Bool) -> DList a -> (DList a, DList a)-partitionDL p_ = DL.foldr (f p_) (DL.empty,DL.empty)- where-   f p x (ts,fs) =-      if p x-         then (DL.cons x ts, fs)-         else (ts, DL.cons x fs)--nubOrd :: Ord a => [a] -> [a]-nubOrd = go Set.empty- where-   go _ [] = []-   go set (x:xs) =-      if Set.member x set-         then go set xs-         else x : go (Set.insert x set) xs
− src/System/Nemesis/Runner.hs 
@@ -1,101 +0,0 @@-import Control.Monad hiding (join)-import Data.List (find)-import Data.Time.Clock.POSIX-import Prelude ()-import System.Environment-import System.Cmd-import System.Directory-import System.Nemesis.Util-import System.Time-import System.Nemesis.DSL-import qualified Prelude as P-import Data.Maybe-import System.Exit--start, end :: String-start = start_nemesis + start_nemesis_dsl + init_air + init_prelude-  where -    start_nemesis     = "import System.Nemesis (run)\n"-    start_nemesis_dsl = "import System.Nemesis.DSL\n"-    init_air          = "import Air.Light ((-))\n"-    init_prelude      = "import Prelude hiding ((-))\n"-end = "\nmain = run nemesis\n"--main :: IO ()-main = do-  recompile <- should_recompile-  when recompile compile-  -  args <- getArgs-  exit_code <- system - "./.nemesis " + args.join " "-  -  exitWith exit_code-  -  where-    bin = ".nemesis"-    should_recompile = do-      bin_exists <- doesFileExist bin-      if not bin_exists-        then return True-        else do-          bin_stamp <- bin.getModificationTime-          src_stamp <- get_src_name >>= getModificationTime-          return - bin_stamp P.< src_stamp---get_src_name :: IO String-get_src_name = do-  dir <- ls "."-  return - dir.filter (belongs_to possible_source) .get_name-  where-    possible_source = ["Nemesis", "nemesis", "Nemesis.hs", "nemesis.hs"]-    get_name []     = error "Nemesis does not exist!"-    get_name xs     = xs.first--compile :: IO ()-compile = do-  src_name <- get_src_name-  let src_o  = src_base_name src_name + ".o"-      src_hi = src_base_name src_name + ".hi"-  src <- readFile src_name-  -  let maybe_patch_end   = yield_string_if_no_line_starts_with     main_src_prefix src end-      maybe_patch_start = yield_string_if_no_line_starts_with     main_src_prefix src start-      -      __nem_seperated_header = src.lines.takeWhile (lower > starts_with sep > not) .unlines-      __nem_seperated_footer = src.lines.dropWhile (lower > starts_with sep > not) .unlines--  if (maybe_patch_end.isNothing && maybe_patch_start.isNothing && src_name.ends_with ".hs")-    then do-      sh - "ghc --make -O1 " + src_name + " -o " + bin-      rm src_o-      rm src_hi-    else do-      if __nem_seperated_footer.null-        then output_tmp - maybe_patch_start.fromMaybe "" + __nem_seperated_header + maybe_patch_end.fromMaybe ""-        else output_tmp - __nem_seperated_header + maybe_patch_start.fromMaybe "" + "\n" + __nem_seperated_footer + maybe_patch_end.fromMaybe ""-        -      sh - "ghc --make -O1 " + tmp_name + " -o " + bin-      rm tmp_name-      rm tmp_o-      rm tmp_hi-  -  where--    main_src_prefix = "main ="-    -    sep             = "-- nem"-    output_tmp      = writeFile tmp_name-    tmp_name        = "nemesis-tmp.hs"-    tmp_o           = "nemesis-tmp.o"-    tmp_hi          = "nemesis-tmp.hi"-    bin             = ".nemesis"-    src_base_name s = if s.ends_with ".hs" -                        then s.reverse.drop 3.reverse-                        else s-                        -    yield_string_if_no_line_starts_with prefix str yield = case str.lines.find (starts_with prefix) of-                        Nothing -> Just yield-                        Just _ -> Nothing-    -
+ test/N1.hs view
@@ -0,0 +1,19 @@+import System.Nemesis.Env++main = run $ do++  clean+    [ "**/*.hi"+    , "**/*.o"+    , "manifest"+    ]+    +  task "dist" $ do+    sh "cabal clean"+    sh "cabal configure"+    sh "cabal sdist"++  task "i" (sh "ghci -isrc src/System/Nemesis.hs")++  task "manifest" $ do+    sh "find . | grep 'hs$' > manifest"
+ test/N2.hs view
@@ -0,0 +1,22 @@+import System.Nemesis.Env+import Air.Env ((-))+import Prelude hiding ((-))++main = run - do++  -- desc is optional, it gives some description to the task+  -- task syntax: task "keyword: space seperated dependencies" io-action+  desc "Hunter attack macro"+  task "attack: pet-attack auto-attack" (putStrLn "attack macro done!")++  desc "Pet attack"+  task "pet-attack: mark" - do+    sh "echo 'pet attack'"++  desc "Hunter's mark"+  task "mark" - do+    sh "echo \"casting hunter's mark\""++  desc "Auto attack"+  task "auto-attack" - do+    sh "echo 'auto shoot'"
+ test/N3.hs view
@@ -0,0 +1,15 @@+import System.Nemesis.Env+import Air.Env ((-))+import Prelude hiding ((-))++main = run - do++  namespace "eat" - do++    task "bread: salad" - putStrLn "eating bread"+    task "salad: /drink/coke" - putStrLn "eating salad"+++  namespace "drink" - do++    task "coke" - putStrLn "drinking coke"