diff --git a/src/Turtle.hs b/src/Turtle.hs --- a/src/Turtle.hs +++ b/src/Turtle.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- | See "Turtle.Tutorial" to learn how to use this library or "Turtle.Prelude" -- for a quick-start guide. -- @@ -81,6 +83,7 @@ , Handle , ExitCode(..) , IsString(..) + , (&) ) where import Turtle.Format @@ -141,3 +144,15 @@ import System.IO (Handle) import System.Exit (ExitCode(..)) import Prelude hiding (FilePath) + +#if MIN_VERSION_base(4,8,0) +import Data.Function ((&)) +#else +infixl 1 & + +-- | '&' is a reverse application operator. This provides notational +-- convenience. Its precedence is one higher than that of the forward +-- application operator '$', which allows '&' to be nested in '$'. +(&) :: a -> (a -> b) -> b +x & f = f x +#endif diff --git a/src/Turtle/Format.hs b/src/Turtle/Format.hs --- a/src/Turtle/Format.hs +++ b/src/Turtle/Format.hs @@ -180,6 +180,15 @@ s :: Format r (Text -> r) s = makeFormat id +{-| `Format` a `Filesystem.Path.CurrentOS.FilePath` into `Text` + +>>> import Filesystem.Path.CurrentOS(()) +>>> format fp ("usr" "lib") +"usr/lib" +-} +fp :: Format r (FilePath -> r) +fp = makeFormat (\fpath -> either id id (toText fpath)) + {-| Convert a `Show`able value to `Text` Short-hand for @(format w)@ @@ -187,11 +196,5 @@ >>> repr (1,2) "(1,2)" -} - -{-| `Format` a `Filesystem.Path.CurrentOS` into `Text` --} -fp :: Format r (FilePath -> r) -fp = makeFormat (\fpath -> either id id (toText fpath)) - repr :: Show a => a -> Text repr = format w diff --git a/src/Turtle/Pattern.hs b/src/Turtle/Pattern.hs --- a/src/Turtle/Pattern.hs +++ b/src/Turtle/Pattern.hs @@ -55,6 +55,7 @@ , char , notChar , text + , asciiCI , oneOf , noneOf , space @@ -100,6 +101,7 @@ import Control.Applicative import Control.Monad +import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State import Data.Char import Data.List (foldl') @@ -116,45 +118,10 @@ mempty = pure mempty mappend = liftA2 mappend -instance Num a => Num (Pattern a) where - fromInteger n = pure (fromInteger n) - - (+) = liftA2 (+) - (*) = liftA2 (*) - (-) = liftA2 (-) - - abs = fmap abs - signum = fmap signum - negate = fmap negate - -instance Fractional a => Fractional (Pattern a) where - fromRational n = pure (fromRational n) - - recip = fmap recip - - (/) = liftA2 (/) - -instance Floating a => Floating (Pattern a) where - pi = pure pi - - exp = fmap exp - sqrt = fmap sqrt - log = fmap log - sin = fmap sin - tan = fmap tan - cos = fmap cos - asin = fmap sin - atan = fmap atan - acos = fmap acos - sinh = fmap sinh - tanh = fmap tanh - cosh = fmap cosh - asinh = fmap asinh - atanh = fmap atanh - acosh = fmap acosh - - (**) = liftA2 (**) - logBase = liftA2 logBase +instance Monoid a => Num (Pattern a) where + fromInteger n = Pattern (lift (replicate (fromInteger n) mempty)) + (+) = (<|>) + (*) = (<>) instance (a ~ Text) => IsString (Pattern a) where fromString str = text (Text.pack str) @@ -247,6 +214,25 @@ put after return before) +{-| Match a specific string in a case-insensitive way + + This only handles ASCII strings + +>>> match (asciiCI "abc") "ABC" +["ABC"] +-} +asciiCI :: Text -> Pattern Text +asciiCI before' = Pattern (do + txt <- get + let (before, after) = Text.splitAt (Text.length before') txt + guard (lowerChars before == lowerChars before') + put after + return before ) + where + lowerChars = Text.map lowerChar + lowerChar c | 'A' <= c && c <= 'Z' = chr (ord c + ord 'a' - ord 'A') + | otherwise = c + {-| Match any one of the given characters >>> match (oneOf "1a") "1" @@ -490,9 +476,9 @@ {-| Parse 1 or more occurrences of the given character ->>> match (plus anyChar) "123" +>>> match (plus digit) "123" ["123"] ->>> match (plus anyChar) "" +>>> match (plus digit) "" [] See also: `chars1` diff --git a/src/Turtle/Prelude.hs b/src/Turtle/Prelude.hs --- a/src/Turtle/Prelude.hs +++ b/src/Turtle/Prelude.hs @@ -130,6 +130,8 @@ , sleep , exit , die + , (.&&.) + , (.||.) -- * Managed , readonly @@ -150,6 +152,7 @@ , stderr , output , append + , strict , ls , lstree , cat @@ -165,7 +168,7 @@ import Control.Concurrent.Async (Async, withAsync, wait) import Control.Concurrent (threadDelay) import Control.Exception (bracket, throwIO) -import Control.Foldl (FoldM(..)) +import Control.Foldl (FoldM(..), list) import Control.Monad (msum) import Control.Monad.Managed (Managed, managed) #ifdef mingw32_HOST_OS @@ -418,7 +421,7 @@ -} deslash :: String -> String deslash [] = [] -deslash (c:cs) = c:go cs +deslash (c0:cs0) = c0:go cs0 where go [] = [] go ['\\'] = [] @@ -533,14 +536,37 @@ An exit code of @0@ indicates success -} -exit :: Int -> IO () -exit 0 = exitWith ExitSuccess -exit n = exitWith (ExitFailure n) +exit :: ExitCode -> IO a +exit = exitWith -- | Throw an exception using the provided `Text` message die :: Text -> IO a die txt = throwIO (userError (unpack txt)) +infixr 2 .&&., .||. + +{-| Analogous to `&&` in Bash + + Runs the second command only if the first one returns `ExitSuccess` +-} +(.&&.) :: IO ExitCode -> IO ExitCode -> IO ExitCode +cmd1 .&&. cmd2 = do + r <- cmd1 + case r of + ExitSuccess -> cmd2 + _ -> return r + +{-| Analogous to `||` in Bash + + Run the second command only if the first one returns `ExitFailure` +-} +(.||.) :: IO ExitCode -> IO ExitCode -> IO ExitCode +cmd1 .||. cmd2 = do + r <- cmd1 + case r of + ExitFailure _ -> cmd2 + _ -> return r + {-| Create a temporary directory underneath the given directory Deletes the temporary directory when done @@ -629,17 +655,21 @@ txt <- s liftIO (Text.hPutStrLn handle txt) ) +-- | Read in a stream's contents strictly +strict :: Shell Text -> IO Text +strict s = fmap Text.unlines (fold s list) + -- | Acquire a `Managed` read-only `Handle` from a `FilePath` readonly :: FilePath -> Managed Handle -readonly file = managed (Filesystem.withFile file IO.ReadMode) +readonly file = managed (Filesystem.withTextFile file IO.ReadMode) -- | Acquire a `Managed` write-only `Handle` from a `FilePath` writeonly :: FilePath -> Managed Handle -writeonly file = managed (Filesystem.withFile file IO.WriteMode) +writeonly file = managed (Filesystem.withTextFile file IO.WriteMode) -- | Acquire a `Managed` append-only `Handle` from a `FilePath` appendonly :: FilePath -> Managed Handle -appendonly file = managed (Filesystem.withFile file IO.AppendMode) +appendonly file = managed (Filesystem.withTextFile file IO.AppendMode) -- | Combine the output of multiple `Shell`s, in order cat :: [Shell a] -> Shell a diff --git a/src/Turtle/Shell.hs b/src/Turtle/Shell.hs --- a/src/Turtle/Shell.hs +++ b/src/Turtle/Shell.hs @@ -74,7 +74,7 @@ import Control.Monad.Managed (Managed, with) import Control.Foldl (Fold(..), FoldM(..)) import qualified Control.Foldl as Foldl -import Data.Monoid (Monoid(..)) +import Data.Monoid (Monoid(..), (<>)) import Data.String (IsString(..)) -- | A @(Shell a)@ is a protected stream of @a@'s with side effects @@ -140,45 +140,11 @@ mempty = pure mempty mappend = liftA2 mappend -instance Num a => Num (Shell a) where - fromInteger n = pure (fromInteger n) - - (+) = liftA2 (+) - (*) = liftA2 (*) - (-) = liftA2 (-) - - abs = fmap abs - signum = fmap signum - negate = fmap negate - -instance Fractional a => Fractional (Shell a) where - fromRational n = pure (fromRational n) - - recip = fmap recip - - (/) = liftA2 (/) - -instance Floating a => Floating (Shell a) where - pi = pure pi - - exp = fmap exp - sqrt = fmap sqrt - log = fmap log - sin = fmap sin - tan = fmap tan - cos = fmap cos - asin = fmap sin - atan = fmap atan - acos = fmap acos - sinh = fmap sinh - tanh = fmap tanh - cosh = fmap cosh - asinh = fmap asinh - atanh = fmap atanh - acosh = fmap acosh +instance Monoid a => Num (Shell a) where + fromInteger n = select (replicate (fromInteger n) mempty) - (**) = liftA2 (**) - logBase = liftA2 logBase + (+) = (<|>) + (*) = (<>) instance IsString a => IsString (Shell a) where fromString str = pure (fromString str) diff --git a/turtle.cabal b/turtle.cabal --- a/turtle.cabal +++ b/turtle.cabal @@ -1,5 +1,5 @@ Name: turtle -Version: 1.0.2 +Version: 1.1.0 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3