turtle 1.2.1 → 1.2.2
raw patch · 12 files changed
+4538/−4314 lines, 12 filesdep +stmdep ~optparse-applicativesetup-changed
Dependencies added: stm
Dependency ranges changed: optparse-applicative
Files
- LICENSE +24/−24
- Setup.hs +2/−2
- bench/Main.hs +40/−40
- src/Turtle.hs +161/−161
- src/Turtle/Format.hs +195/−195
- src/Turtle/Options.hs +208/−208
- src/Turtle/Pattern.hs +728/−675
- src/Turtle/Prelude.hs +1283/−1126
- src/Turtle/Shell.hs +174/−173
- src/Turtle/Tutorial.hs +1616/−1604
- test/Main.hs +6/−6
- turtle.cabal +101/−100
LICENSE view
@@ -1,24 +1,24 @@-Copyright (c) 2015 Gabriel Gonzalez-All rights reserved.--Redistribution and use in source and binary forms, with or without modification,-are permitted provided that the following conditions are met:- * Redistributions of source code must retain the above copyright notice,- this list of conditions and the following disclaimer.- * Redistributions in binary form must reproduce the above copyright notice,- this list of conditions and the following disclaimer in the documentation- and/or other materials provided with the distribution.- * Neither the name of Gabriel Gonzalez nor the names of other contributors- may be used to endorse or promote products derived from this software- without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON-ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+Copyright (c) 2015 Gabriel Gonzalez +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + * Neither the name of Gabriel Gonzalez nor the names of other contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple +main = defaultMain
bench/Main.hs view
@@ -1,40 +1,40 @@-{-# LANGUAGE OverloadedStrings #-}-module Main where--import qualified Data.Text as Text-import Criterion.Main-import Turtle--boundedNaive :: Int -> Int -> Pattern a -> Pattern [a]-boundedNaive m n p = do- x <- choice (map pure [m..n])- count x p--main :: IO ()-main = defaultMain- [ bgroup "Pattern"- [ let cats = Text.replicate 1000 "cat"- furniture = Text.replicate 5 " "- in bgroup "Cat Lady's House"- [ bench "Basic"- $ nf (match (many "cat")) cats- , bench "Letters"- $ nf (match (many (mconcat ["c", "a", "t"]))) cats- , bench "Spaces"- $ nf (match (many "cat" <* spaces)) (cats <> furniture)- , bench "Prefix"- $ nf (match (prefix (many "cat"))) (cats <> furniture)- ]- , let hearts n = Text.replicate n "heart"- in bgroup "Love Knows No Bounds"- [ bench "500-700:650 Naive"- $ nf (match (boundedNaive 500 700 "heart")) (hearts 650)- , bench "500-700:650"- $ nf (match (bounded 500 700 "heart")) (hearts 650)- , bench "5000-7000:6500 Naive"- $ nf (match (boundedNaive 5000 7000 "heart")) (hearts 6500)- , bench "5000-7000:6500"- $ nf (match (bounded 5000 7000 "heart")) (hearts 6500)- ]- ]- ]+{-# LANGUAGE OverloadedStrings #-} +module Main where + +import qualified Data.Text as Text +import Criterion.Main +import Turtle + +boundedNaive :: Int -> Int -> Pattern a -> Pattern [a] +boundedNaive m n p = do + x <- choice (map pure [m..n]) + count x p + +main :: IO () +main = defaultMain + [ bgroup "Pattern" + [ let cats = Text.replicate 1000 "cat" + furniture = Text.replicate 5 " " + in bgroup "Cat Lady's House" + [ bench "Basic" + $ nf (match (many "cat")) cats + , bench "Letters" + $ nf (match (many (mconcat ["c", "a", "t"]))) cats + , bench "Spaces" + $ nf (match (many "cat" <* spaces)) (cats <> furniture) + , bench "Prefix" + $ nf (match (prefix (many "cat"))) (cats <> furniture) + ] + , let hearts n = Text.replicate n "heart" + in bgroup "Love Knows No Bounds" + [ bench "500-700:650 Naive" + $ nf (match (boundedNaive 500 700 "heart")) (hearts 650) + , bench "500-700:650" + $ nf (match (bounded 500 700 "heart")) (hearts 650) + , bench "5000-7000:6500 Naive" + $ nf (match (boundedNaive 5000 7000 "heart")) (hearts 6500) + , bench "5000-7000:6500" + $ nf (match (bounded 5000 7000 "heart")) (hearts 6500) + ] + ] + ]
src/Turtle.hs view
@@ -1,161 +1,161 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}---- | See "Turtle.Tutorial" to learn how to use this library or "Turtle.Prelude"--- for a quick-start guide.------ Here is the recommended way to import this library:------ > {-# LANGUAGE OverloadedStrings #-}--- >--- > import Turtle--- > import Prelude hiding (FilePath)------ This module re-exports the rest of the library and also re-exports useful--- modules from @base@:------ "Turtle.Format" provides type-safe string formatting------ "Turtle.Pattern" provides `Pattern`s, which are like more powerful regular--- expressions------ "Turtle.Shell" provides a `Shell` abstraction for building streaming,--- exception-safe pipelines------ "Turtle.Prelude" provides a library of Unix-like utilities to get you--- started with basic shell-like programming within Haskell------ "Control.Applicative" provides two classes:------ * `Applicative`, which works with `Fold`, `Pattern`, `Managed`, and `Shell`------ * `Alternative`, which works with `Pattern` and `Shell`------ "Control.Monad" provides two classes:------ * `Monad`, which works with `Pattern`, `Managed` and `Shell`------ * `MonadPlus`, which works with `Pattern` and `Shell`------ "Control.Monad.IO.Class" provides one class:------ * `MonadIO`, which works with `Managed` and `Shell`------ "Data.Monoid" provides one class:------ * `Monoid`, which works with `Fold`, `Pattern`, `Managed`, and `Shell`------ "Control.Monad.Managed.Safe" provides `Managed` resources------ "Filesystem.Path.CurrentOS" provides `FilePath`-manipulation utilities------ Additionally, you might also want to import the following modules qualified:------ * "Options.Applicative" from @optparse-applicative@ for command-line option--- parsing------ * "Control.Foldl" (for predefined folds)------ * "Control.Foldl.Text" (for `Text`-specific folds)------ * "Data.Text" (for `Text`-manipulation utilities)------ * "Data.Text.IO" (for reading and writing `Text`)------ * "Filesystem.Path.CurrentOS" (for the remaining `FilePath` utilities)--module Turtle (- -- * Modules- module Turtle.Format- , module Turtle.Pattern- , module Turtle.Options- , module Turtle.Shell- , module Turtle.Prelude- , module Control.Applicative- , module Control.Monad- , module Control.Monad.IO.Class- , module Data.Monoid- , module Control.Monad.Managed.Safe- , module Filesystem.Path.CurrentOS- , Fold(..)- , FoldM(..)- , Text- , UTCTime- , NominalDiffTime- , Handle- , ExitCode(..)- , IsString(..)- , (&)- ) where--import Turtle.Format-import Turtle.Pattern-import Turtle.Options-import Turtle.Shell-import Turtle.Prelude-import Control.Applicative- ( Applicative(..)- , Alternative(..)- , (<$>)- , liftA2- , optional- )-import Control.Monad- ( MonadPlus(..)- , forever- , void- , (>=>)- , (<=<)- , join- , msum- , mfilter- , replicateM_- , guard- , when- , unless- )-import Control.Monad.IO.Class (MonadIO(..))-import Data.Monoid (Monoid(..), (<>))-import Data.String (IsString(..))-import Filesystem.Path.CurrentOS- ( FilePath- , root- , directory- , parent- , filename- , dirname- , basename- , absolute- , relative- , (</>)- , commonPrefix- , stripPrefix- , collapse- , splitDirectories- , extension- , hasExtension- , (<.>)- , dropExtension- , splitExtension- , toText- , fromText- )-import Control.Monad.Managed.Safe (Managed, managed, runManaged)-import Control.Foldl (Fold(..), FoldM(..))-import Data.Text (Text)-import Data.Time (NominalDiffTime, UTCTime)-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+{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} + +-- | See "Turtle.Tutorial" to learn how to use this library or "Turtle.Prelude" +-- for a quick-start guide. +-- +-- Here is the recommended way to import this library: +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > import Prelude hiding (FilePath) +-- +-- This module re-exports the rest of the library and also re-exports useful +-- modules from @base@: +-- +-- "Turtle.Format" provides type-safe string formatting +-- +-- "Turtle.Pattern" provides `Pattern`s, which are like more powerful regular +-- expressions +-- +-- "Turtle.Shell" provides a `Shell` abstraction for building streaming, +-- exception-safe pipelines +-- +-- "Turtle.Prelude" provides a library of Unix-like utilities to get you +-- started with basic shell-like programming within Haskell +-- +-- "Control.Applicative" provides two classes: +-- +-- * `Applicative`, which works with `Fold`, `Pattern`, `Managed`, and `Shell` +-- +-- * `Alternative`, which works with `Pattern` and `Shell` +-- +-- "Control.Monad" provides two classes: +-- +-- * `Monad`, which works with `Pattern`, `Managed` and `Shell` +-- +-- * `MonadPlus`, which works with `Pattern` and `Shell` +-- +-- "Control.Monad.IO.Class" provides one class: +-- +-- * `MonadIO`, which works with `Managed` and `Shell` +-- +-- "Data.Monoid" provides one class: +-- +-- * `Monoid`, which works with `Fold`, `Pattern`, `Managed`, and `Shell` +-- +-- "Control.Monad.Managed.Safe" provides `Managed` resources +-- +-- "Filesystem.Path.CurrentOS" provides `FilePath`-manipulation utilities +-- +-- Additionally, you might also want to import the following modules qualified: +-- +-- * "Options.Applicative" from @optparse-applicative@ for command-line option +-- parsing +-- +-- * "Control.Foldl" (for predefined folds) +-- +-- * "Control.Foldl.Text" (for `Text`-specific folds) +-- +-- * "Data.Text" (for `Text`-manipulation utilities) +-- +-- * "Data.Text.IO" (for reading and writing `Text`) +-- +-- * "Filesystem.Path.CurrentOS" (for the remaining `FilePath` utilities) + +module Turtle ( + -- * Modules + module Turtle.Format + , module Turtle.Pattern + , module Turtle.Options + , module Turtle.Shell + , module Turtle.Prelude + , module Control.Applicative + , module Control.Monad + , module Control.Monad.IO.Class + , module Data.Monoid + , module Control.Monad.Managed + , module Filesystem.Path.CurrentOS + , Fold(..) + , FoldM(..) + , Text + , UTCTime + , NominalDiffTime + , Handle + , ExitCode(..) + , IsString(..) + , (&) + ) where + +import Turtle.Format +import Turtle.Pattern +import Turtle.Options +import Turtle.Shell +import Turtle.Prelude +import Control.Applicative + ( Applicative(..) + , Alternative(..) + , (<$>) + , liftA2 + , optional + ) +import Control.Monad + ( MonadPlus(..) + , forever + , void + , (>=>) + , (<=<) + , join + , msum + , mfilter + , replicateM_ + , guard + , when + , unless + ) +import Control.Monad.IO.Class (MonadIO(..)) +import Data.Monoid (Monoid(..), (<>)) +import Data.String (IsString(..)) +import Filesystem.Path.CurrentOS + ( FilePath + , root + , directory + , parent + , filename + , dirname + , basename + , absolute + , relative + , (</>) + , commonPrefix + , stripPrefix + , collapse + , splitDirectories + , extension + , hasExtension + , (<.>) + , dropExtension + , splitExtension + , toText + , fromText + ) +import Control.Monad.Managed (Managed, managed, runManaged, with) +import Control.Foldl (Fold(..), FoldM(..)) +import Data.Text (Text) +import Data.Time (NominalDiffTime, UTCTime) +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
src/Turtle/Format.hs view
@@ -1,195 +1,195 @@-{-# LANGUAGE OverloadedStrings #-}--{-| Minimalist implementation of type-safe formatted strings, borrowing heavily- from the implementation of the @formatting@ package.-- Example use of this module:-->>> :set -XOverloadedStrings->>> import Turtle.Format->>> format ("This is a "%s%" string that takes "%d%" arguments") "format" 2-"This is a format string that takes 2 arguments"-- A `Format` string that takes no arguments has this type:--> "I take 0 arguments" :: Format r r->-> format "I take 0 arguments" :: Text-->>> format "I take 0 arguments"-"I take 0 arguments"-- A `Format` string that takes one argument has this type:--> "I take "%d%" arguments" :: Format r (Int -> r)->-> format ("I take "%d%" argument") :: Int -> Text-->>> format ("I take "%d%" argument") 1-"I take 1 argument"-- A `Format` string that takes two arguments has this type:--> "I "%s%" "%d%" arguments" :: Format r (Text -> Int -> r)->-> format ("I "%s%" "%d%" arguments") :: Text -> Int -> Text-->>> format ("I "%s%" "%d%" arguments") "take" 2-"I take 2 arguments"--}--{-# LANGUAGE TypeFamilies #-}--module Turtle.Format (- -- * Format- Format- , (%)- , format- , makeFormat-- -- * Parameters- , w- , d- , u- , o- , x- , f- , e- , g- , s- , fp-- -- * Utilities- , repr- ) where--import Control.Category (Category(..))-import Data.Monoid ((<>))-import Data.String (IsString(..))-import Data.Text (Text, pack)-import Data.Word (Word)-import Filesystem.Path.CurrentOS (FilePath, toText)-import Numeric (showEFloat, showFFloat, showGFloat, showHex, showOct)-import Prelude hiding ((.), id, FilePath)---- | A `Format` string-newtype Format a b = Format { (>>-) :: (Text -> a) -> b }--instance Category Format where- id = Format (\return_ -> return_ "")-- fmt1 . fmt2 = Format (\return_ ->- fmt1 >>- \str1 ->- fmt2 >>- \str2 ->- return_ (str1 <> str2) )---- | Concatenate two `Format` strings-(%) :: Format b c -> Format a b -> Format a c-(%) = (.)--instance (a ~ b) => IsString (Format a b) where- fromString str = Format (\return_ -> return_ (pack str))--{-| Convert a `Format` string to a print function that takes zero or more typed- arguments and returns a `Text` string--}-format :: Format Text r -> r-format fmt = fmt >>- id---- | Create your own format specifier-makeFormat :: (a -> Text) -> Format r (a -> r)-makeFormat k = Format (\return_ -> \a -> return_ (k a))--{-| `Format` any `Show`able value-->>> format w True-"True"--}-w :: Show a => Format r (a -> r)-w = makeFormat (pack . show)--{-| `Format` an `Int` value as a signed decimal-->>> format d 25-"25"->>> format d (-25)-"-25"--}-d :: Format r (Int -> r)-d = w--{-| `Format` a `Word` value as an unsigned decimal-->>> format u 25-"25"--}-u :: Format r (Word -> r)-u = w--{-| `Format` a `Word` value as an unsigned octal number-->>> format o 25-"31"--}-o :: Format r (Word -> r)-o = makeFormat (\n -> pack (showOct n ""))--{-| `Format` a `Word` value as an unsigned hexadecimal number (without a- leading \"0x\")-->>> format x 25-"19"--}-x :: Format r (Word -> r)-x = makeFormat (\n -> pack (showHex n ""))--{-| `Format` a `Double` using decimal notation with 6 digits of precision-->>> format f 25.1-"25.100000"--}-f :: Format r (Double -> r)-f = makeFormat (\n -> pack (showFFloat (Just 6) n ""))--{-| `Format` a `Double` using scientific notation with 6 digits of precision-->>> format e 25.1-"2.510000e1"--}-e :: Format r (Double -> r)-e = makeFormat (\n -> pack (showEFloat (Just 6) n ""))--{-| `Format` a `Double` using decimal notation for small exponents and- scientific notation for large exponents-->>> format g 25.1-"25.100000"->>> format g 123456789-"1.234568e8"->>> format g 0.00000000001-"1.000000e-11"--}-g :: Format r (Double -> r)-g = makeFormat (\n -> pack (showGFloat (Just 6) n ""))--{-| `Format` that inserts `Text`-->>> format s "ABC"-"ABC"--}-s :: Format r (Text -> r)-s = makeFormat id---- | `Format` a `Filesystem.Path.CurrentOS.FilePath` into `Text`-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)@-->>> repr (1,2)-"(1,2)"--}-repr :: Show a => a -> Text-repr = format w+{-# LANGUAGE OverloadedStrings #-} + +{-| Minimalist implementation of type-safe formatted strings, borrowing heavily + from the implementation of the @formatting@ package. + + Example use of this module: + +>>> :set -XOverloadedStrings +>>> import Turtle.Format +>>> format ("This is a "%s%" string that takes "%d%" arguments") "format" 2 +"This is a format string that takes 2 arguments" + + A `Format` string that takes no arguments has this type: + +> "I take 0 arguments" :: Format r r +> +> format "I take 0 arguments" :: Text + +>>> format "I take 0 arguments" +"I take 0 arguments" + + A `Format` string that takes one argument has this type: + +> "I take "%d%" arguments" :: Format r (Int -> r) +> +> format ("I take "%d%" argument") :: Int -> Text + +>>> format ("I take "%d%" argument") 1 +"I take 1 argument" + + A `Format` string that takes two arguments has this type: + +> "I "%s%" "%d%" arguments" :: Format r (Text -> Int -> r) +> +> format ("I "%s%" "%d%" arguments") :: Text -> Int -> Text + +>>> format ("I "%s%" "%d%" arguments") "take" 2 +"I take 2 arguments" +-} + +{-# LANGUAGE TypeFamilies #-} + +module Turtle.Format ( + -- * Format + Format + , (%) + , format + , makeFormat + + -- * Parameters + , w + , d + , u + , o + , x + , f + , e + , g + , s + , fp + + -- * Utilities + , repr + ) where + +import Control.Category (Category(..)) +import Data.Monoid ((<>)) +import Data.String (IsString(..)) +import Data.Text (Text, pack) +import Data.Word +import Filesystem.Path.CurrentOS (FilePath, toText) +import Numeric (showEFloat, showFFloat, showGFloat, showHex, showOct) +import Prelude hiding ((.), id, FilePath) + +-- | A `Format` string +newtype Format a b = Format { (>>-) :: (Text -> a) -> b } + +instance Category Format where + id = Format (\return_ -> return_ "") + + fmt1 . fmt2 = Format (\return_ -> + fmt1 >>- \str1 -> + fmt2 >>- \str2 -> + return_ (str1 <> str2) ) + +-- | Concatenate two `Format` strings +(%) :: Format b c -> Format a b -> Format a c +(%) = (.) + +instance (a ~ b) => IsString (Format a b) where + fromString str = Format (\return_ -> return_ (pack str)) + +{-| Convert a `Format` string to a print function that takes zero or more typed + arguments and returns a `Text` string +-} +format :: Format Text r -> r +format fmt = fmt >>- id + +-- | Create your own format specifier +makeFormat :: (a -> Text) -> Format r (a -> r) +makeFormat k = Format (\return_ -> \a -> return_ (k a)) + +{-| `Format` any `Show`able value + +>>> format w True +"True" +-} +w :: Show a => Format r (a -> r) +w = makeFormat (pack . show) + +{-| `Format` an `Int` value as a signed decimal + +>>> format d 25 +"25" +>>> format d (-25) +"-25" +-} +d :: Format r (Int -> r) +d = w + +{-| `Format` a `Word` value as an unsigned decimal + +>>> format u 25 +"25" +-} +u :: Format r (Word -> r) +u = w + +{-| `Format` a `Word` value as an unsigned octal number + +>>> format o 25 +"31" +-} +o :: Format r (Word -> r) +o = makeFormat (\n -> pack (showOct n "")) + +{-| `Format` a `Word` value as an unsigned hexadecimal number (without a + leading \"0x\") + +>>> format x 25 +"19" +-} +x :: Format r (Word -> r) +x = makeFormat (\n -> pack (showHex n "")) + +{-| `Format` a `Double` using decimal notation with 6 digits of precision + +>>> format f 25.1 +"25.100000" +-} +f :: Format r (Double -> r) +f = makeFormat (\n -> pack (showFFloat (Just 6) n "")) + +{-| `Format` a `Double` using scientific notation with 6 digits of precision + +>>> format e 25.1 +"2.510000e1" +-} +e :: Format r (Double -> r) +e = makeFormat (\n -> pack (showEFloat (Just 6) n "")) + +{-| `Format` a `Double` using decimal notation for small exponents and + scientific notation for large exponents + +>>> format g 25.1 +"25.100000" +>>> format g 123456789 +"1.234568e8" +>>> format g 0.00000000001 +"1.000000e-11" +-} +g :: Format r (Double -> r) +g = makeFormat (\n -> pack (showGFloat (Just 6) n "")) + +{-| `Format` that inserts `Text` + +>>> format s "ABC" +"ABC" +-} +s :: Format r (Text -> r) +s = makeFormat id + +-- | `Format` a `Filesystem.Path.CurrentOS.FilePath` into `Text` +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)@ + +>>> repr (1,2) +"(1,2)" +-} +repr :: Show a => a -> Text +repr = format w
src/Turtle/Options.hs view
@@ -1,208 +1,208 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- | Example usage of this module:------ > -- options.hs--- >--- > {-# LANGUAGE OverloadedStrings #-}--- >--- > import Turtle--- >--- > parser :: Parser (Text, Int)--- > parser = (,) <$> optText "name" 'n' "Your first name"--- > <*> optInt "age" 'a' "Your current age"--- >--- > main = do--- > (name, age) <- options "Greeting script" parser--- > echo (format ("Hello there, "%s) name)--- > echo (format ("You are "%d%" years old") age)------ > $ ./options --name John --age 42--- > Hello there, John--- > You are 42 years old------ > $ ./options --help--- > Greeting script--- >--- > Usage: options (-n|--name NAME) (-a|--age AGE)--- >--- > Available options:--- > -h,--help Show this help text--- > --name NAME Your first name--- > --age AGE Your current age--module Turtle.Options- ( -- * Types- Parser- , ArgName- , ShortName- , Description- , HelpMessage-- -- * Flag-based option parsers- , switch- , optText- , optInt- , optInteger- , optDouble- , optPath- , optRead- , opt-- -- * Positional argument parsers- , argText- , argInt- , argInteger- , argDouble- , argPath- , argRead- , arg-- -- * Consume parsers- , options-- ) where--import Data.Monoid-import Data.Foldable-import Data.String (IsString)-import Text.Read (readMaybe)-import Data.Text (Text)-import qualified Data.Text as Text-import Data.Optional-import Control.Applicative-import Control.Monad.IO.Class-import Filesystem.Path.CurrentOS (FilePath, fromText)-import Options.Applicative (Parser)-import qualified Options.Applicative as Opts-import qualified Options.Applicative.Types as Opts-import Prelude hiding (FilePath)---- | Parse the given options from the command line-options :: MonadIO io => Description -> Parser a -> io a-options desc parser = liftIO- $ Opts.execParser- $ Opts.info (Opts.helper <*> parser)- (Opts.header (Text.unpack (getDescription desc)))--{-| The name of a command-line argument-- This is used to infer the long name and metavariable for the command line- flag. For example, an `ArgName` of @\"name\"@ will create a @--name@ flag- with a @NAME@ metavariable--}-newtype ArgName = ArgName { getArgName :: Text }- deriving (IsString)---- | The short one-character abbreviation for a flag (i.e. @-n@)-type ShortName = Char--{-| A brief description of what your program does-- This description will appear in the header of the @--help@ output--}-newtype Description = Description { getDescription :: Text }- deriving (IsString)--{-| A helpful message explaining what a flag does-- This will appear in the @--help@ output--}-newtype HelpMessage = HelpMessage { getHelpMessage :: Text }- deriving (IsString)--{-| This parser returns `True` if the given flag is set and `False` if the- flag is absent--}-switch- :: ArgName- -> ShortName- -> Optional HelpMessage- -> Parser Bool-switch argName c helpMessage- = Opts.switch- $ (Opts.long . Text.unpack . getArgName) argName- <> Opts.short c- <> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage--{- | Build a flag-based option parser for any type by providing a `Text`-parsing- function--}-opt :: (Text -> Maybe a)- -> ArgName- -> ShortName- -> Optional HelpMessage- -> Parser a-opt argParse argName c helpMessage- = Opts.option (argParseToReadM argParse)- $ Opts.metavar (Text.unpack (Text.toUpper (getArgName argName)))- <> Opts.long (Text.unpack (getArgName argName))- <> Opts.short c- <> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage---- | Parse any type that implements `Read`-optRead :: Read a => ArgName -> ShortName -> Optional HelpMessage -> Parser a-optRead = opt (readMaybe . Text.unpack)---- | Parse an `Int` as a flag-based option-optInt :: ArgName -> ShortName -> Optional HelpMessage -> Parser Int-optInt = optRead---- | Parse an `Integer` as a flag-based option-optInteger :: ArgName -> ShortName -> Optional HelpMessage -> Parser Integer-optInteger = optRead---- | Parse a `Double` as a flag-based option-optDouble :: ArgName -> ShortName -> Optional HelpMessage -> Parser Double-optDouble = optRead---- | Parse a `Text` value as a flag-based option-optText :: ArgName -> ShortName -> Optional HelpMessage -> Parser Text-optText = opt Just---- | Parse a `FilePath` value as a flag-based option-optPath :: ArgName -> ShortName -> Optional HelpMessage -> Parser FilePath-optPath argName short msg = fmap fromText (optText argName short msg)--{- | Build a positional argument parser for any type by providing a- `Text`-parsing function--}-arg :: (Text -> Maybe a)- -> ArgName- -> Optional HelpMessage- -> Parser a-arg argParse argName helpMessage- = Opts.argument (argParseToReadM argParse)- $ Opts.metavar (Text.unpack (Text.toUpper (getArgName argName)))- <> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage---- | Parse any type that implements `Read` as a positional argument-argRead :: Read a => ArgName -> Optional HelpMessage -> Parser a-argRead = arg (readMaybe . Text.unpack)---- | Parse an `Int` as a positional argument-argInt :: ArgName -> Optional HelpMessage -> Parser Int-argInt = argRead---- | Parse an `Integer` as a positional argument-argInteger :: ArgName -> Optional HelpMessage -> Parser Integer-argInteger = argRead---- | Parse a `Double` as a positional argument-argDouble :: ArgName -> Optional HelpMessage -> Parser Double-argDouble = argRead---- | Parse a `Text` as a positional argument-argText :: ArgName -> Optional HelpMessage -> Parser Text-argText = arg Just---- | Parse a `FilePath` as a positional argument-argPath :: ArgName -> Optional HelpMessage -> Parser FilePath-argPath argName msg = fmap fromText (argText argName msg)--argParseToReadM :: (Text -> Maybe a) -> Opts.ReadM a-argParseToReadM f = do- s <- Opts.readerAsk- case f (Text.pack s) of- Just a -> return a- Nothing -> Opts.readerAbort Opts.ShowHelpText+{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | Example usage of this module: +-- +-- > -- options.hs +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > +-- > parser :: Parser (Text, Int) +-- > parser = (,) <$> optText "name" 'n' "Your first name" +-- > <*> optInt "age" 'a' "Your current age" +-- > +-- > main = do +-- > (name, age) <- options "Greeting script" parser +-- > echo (format ("Hello there, "%s) name) +-- > echo (format ("You are "%d%" years old") age) +-- +-- > $ ./options --name John --age 42 +-- > Hello there, John +-- > You are 42 years old +-- +-- > $ ./options --help +-- > Greeting script +-- > +-- > Usage: options (-n|--name NAME) (-a|--age AGE) +-- > +-- > Available options: +-- > -h,--help Show this help text +-- > --name NAME Your first name +-- > --age AGE Your current age + +module Turtle.Options + ( -- * Types + Parser + , ArgName + , ShortName + , Description + , HelpMessage + + -- * Flag-based option parsers + , switch + , optText + , optInt + , optInteger + , optDouble + , optPath + , optRead + , opt + + -- * Positional argument parsers + , argText + , argInt + , argInteger + , argDouble + , argPath + , argRead + , arg + + -- * Consume parsers + , options + + ) where + +import Data.Monoid +import Data.Foldable +import Data.String (IsString) +import Text.Read (readMaybe) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Optional +import Control.Applicative +import Control.Monad.IO.Class +import Filesystem.Path.CurrentOS (FilePath, fromText) +import Options.Applicative (Parser) +import qualified Options.Applicative as Opts +import qualified Options.Applicative.Types as Opts +import Prelude hiding (FilePath) + +-- | Parse the given options from the command line +options :: MonadIO io => Description -> Parser a -> io a +options desc parser = liftIO + $ Opts.execParser + $ Opts.info (Opts.helper <*> parser) + (Opts.header (Text.unpack (getDescription desc))) + +{-| The name of a command-line argument + + This is used to infer the long name and metavariable for the command line + flag. For example, an `ArgName` of @\"name\"@ will create a @--name@ flag + with a @NAME@ metavariable +-} +newtype ArgName = ArgName { getArgName :: Text } + deriving (IsString) + +-- | The short one-character abbreviation for a flag (i.e. @-n@) +type ShortName = Char + +{-| A brief description of what your program does + + This description will appear in the header of the @--help@ output +-} +newtype Description = Description { getDescription :: Text } + deriving (IsString) + +{-| A helpful message explaining what a flag does + + This will appear in the @--help@ output +-} +newtype HelpMessage = HelpMessage { getHelpMessage :: Text } + deriving (IsString) + +{-| This parser returns `True` if the given flag is set and `False` if the + flag is absent +-} +switch + :: ArgName + -> ShortName + -> Optional HelpMessage + -> Parser Bool +switch argName c helpMessage + = Opts.switch + $ (Opts.long . Text.unpack . getArgName) argName + <> Opts.short c + <> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage + +{- | Build a flag-based option parser for any type by providing a `Text`-parsing + function +-} +opt :: (Text -> Maybe a) + -> ArgName + -> ShortName + -> Optional HelpMessage + -> Parser a +opt argParse argName c helpMessage + = Opts.option (argParseToReadM argParse) + $ Opts.metavar (Text.unpack (Text.toUpper (getArgName argName))) + <> Opts.long (Text.unpack (getArgName argName)) + <> Opts.short c + <> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage + +-- | Parse any type that implements `Read` +optRead :: Read a => ArgName -> ShortName -> Optional HelpMessage -> Parser a +optRead = opt (readMaybe . Text.unpack) + +-- | Parse an `Int` as a flag-based option +optInt :: ArgName -> ShortName -> Optional HelpMessage -> Parser Int +optInt = optRead + +-- | Parse an `Integer` as a flag-based option +optInteger :: ArgName -> ShortName -> Optional HelpMessage -> Parser Integer +optInteger = optRead + +-- | Parse a `Double` as a flag-based option +optDouble :: ArgName -> ShortName -> Optional HelpMessage -> Parser Double +optDouble = optRead + +-- | Parse a `Text` value as a flag-based option +optText :: ArgName -> ShortName -> Optional HelpMessage -> Parser Text +optText = opt Just + +-- | Parse a `FilePath` value as a flag-based option +optPath :: ArgName -> ShortName -> Optional HelpMessage -> Parser FilePath +optPath argName short msg = fmap fromText (optText argName short msg) + +{- | Build a positional argument parser for any type by providing a + `Text`-parsing function +-} +arg :: (Text -> Maybe a) + -> ArgName + -> Optional HelpMessage + -> Parser a +arg argParse argName helpMessage + = Opts.argument (argParseToReadM argParse) + $ Opts.metavar (Text.unpack (Text.toUpper (getArgName argName))) + <> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage + +-- | Parse any type that implements `Read` as a positional argument +argRead :: Read a => ArgName -> Optional HelpMessage -> Parser a +argRead = arg (readMaybe . Text.unpack) + +-- | Parse an `Int` as a positional argument +argInt :: ArgName -> Optional HelpMessage -> Parser Int +argInt = argRead + +-- | Parse an `Integer` as a positional argument +argInteger :: ArgName -> Optional HelpMessage -> Parser Integer +argInteger = argRead + +-- | Parse a `Double` as a positional argument +argDouble :: ArgName -> Optional HelpMessage -> Parser Double +argDouble = argRead + +-- | Parse a `Text` as a positional argument +argText :: ArgName -> Optional HelpMessage -> Parser Text +argText = arg Just + +-- | Parse a `FilePath` as a positional argument +argPath :: ArgName -> Optional HelpMessage -> Parser FilePath +argPath argName msg = fmap fromText (argText argName msg) + +argParseToReadM :: (Text -> Maybe a) -> Opts.ReadM a +argParseToReadM f = do + s <- Opts.readerAsk + case f (Text.pack s) of + Just a -> return a + Nothing -> Opts.readerAbort Opts.ShowHelpText
src/Turtle/Pattern.hs view
@@ -1,675 +1,728 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-missing-methods #-}--{-| Use this module to either:-- * match `Text` with light-weight backtracking patterns, or:-- * parse structured values from `Text`.-- Example usage:-->>> :set -XOverloadedStrings->>> match ("can" <|> "cat") "cat"-["cat"]->>> match ("can" <|> "cat") "dog"-[]->>> match (decimal `sepBy` ",") "1,2,3"-[[1,2,3]]-- This pattern has unlimited backtracking, and will return as many solutions- as possible:-->>> match (prefix (star anyChar)) "123"-["123","12","1",""]-- Use @do@ notation to structure more complex patterns:-->>> :{-let bit = ("0" *> pure False) <|> ("1" *> pure True) :: Pattern Bool;- portableBitMap = do- { "P1"- ; width <- spaces1 *> decimal- ; height <- spaces1 *> decimal- ; count width (count height (spaces1 *> bit))- };-in match (prefix portableBitMap) "P1\n2 2\n0 0\n1 0\n"-:}-[[[False,False],[True,False]]]---}--module Turtle.Pattern (- -- * Pattern- Pattern- , match-- -- * Primitive patterns- , anyChar- , eof-- -- * Character patterns- , dot- , satisfy- , char- , notChar- , text- , asciiCI- , oneOf- , noneOf- , space- , spaces- , spaces1- , tab- , newline- , crlf- , upper- , lower- , alphaNum- , letter- , digit- , hexDigit- , octDigit-- -- * Numbers- , decimal- , signed-- -- * Combinators- , prefix- , suffix- , has- , invert- , once- , star- , plus- , selfless- , choice- , count- , upperBounded- , bounded- , option- , between- , skip- , within- , fixed- , sepBy- , sepBy1-- -- * High-efficiency primitives- , chars- , chars1- ) where--import Control.Applicative-import Control.Monad-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State-import Data.Char-import Data.List (foldl')-import Data.Monoid (Monoid(..), (<>))-import Data.String (IsString(..))-import Data.Text (Text)-import qualified Data.Text as Text---- | A fully backtracking pattern that parses an @\'a\'@ from some `Text`-newtype Pattern a = Pattern { runPattern :: StateT Text [] a }- deriving (Functor, Applicative, Monad, Alternative, MonadPlus)--instance Monoid a => Monoid (Pattern a) where- mempty = pure mempty- mappend = liftA2 mappend---- | Pattern forms a semiring, this is the closest approximation-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)--{-| Match a `Pattern` against a `Text` input, returning all possible solutions-- The `Pattern` must match the entire `Text`--}-match :: Pattern a -> Text -> [a]-match p = evalStateT (runPattern (p <* eof))--{-| Match any character-->>> match anyChar "1"-"1"->>> match anyChar ""-""--}-anyChar :: Pattern Char-anyChar = Pattern (do- Just (c, cs) <- fmap Text.uncons get- put cs- return c )--{-| Matches the end of input-->>> match eof "1"-[]->>> match eof ""-[()]--}-eof :: Pattern ()-eof = Pattern (do- True <- fmap Text.null get- return () )---- | Synonym for `anyChar`-dot :: Pattern Char-dot = anyChar--{-| Match any character that satisfies the given predicate-->>> match (satisfy (== '1')) "1"-"1"->>> match (satisfy (== '2')) "1"-""--}-satisfy :: (Char -> Bool) -> Pattern Char-satisfy predicate = do- c <- anyChar- guard (predicate c)- return c--{-| Match a specific character-->>> match (char '1') "1"-"1"->>> match (char '2') "1"-""--}-char :: Char -> Pattern Char-char c = satisfy (== c)--{-| Match any character except the given one-->>> match (notChar '2') "1"-"1"->>> match (notChar '1') "1"-""--}-notChar :: Char -> Pattern Char-notChar c = satisfy (/= c)--{-| Match a specific string-->>> match (text "123") "123"-["123"]-- You can also omit the `text` function if you enable the @OverloadedStrings@- extension:-->>> match "123" "123"-["123"]--}-text :: Text -> Pattern Text-text before' = Pattern (do- txt <- get- let (before, after) = Text.splitAt (Text.length before') txt- guard (before == before')- 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"-"1"->>> match (oneOf "2a") "1"-""--}-oneOf :: [Char] -> Pattern Char-oneOf cs = satisfy (`elem` cs)--{-| Match anything other than the given characters-->>> match (noneOf "2a") "1"-"1"->>> match (noneOf "1a") "1"-""--}-noneOf :: [Char] -> Pattern Char-noneOf cs = satisfy (`notElem` cs)--{-| Match a whitespace character-->>> match space " "-" "->>> match space "1"-""--}-space :: Pattern Char-space = satisfy isSpace--{-| Match zero or more whitespace characters-->>> match spaces " "-[" "]->>> match spaces ""-[""]--}-spaces :: Pattern Text-spaces = star space--{-| Match one or more whitespace characters-->>> match spaces1 " "-[" "]->>> match spaces1 ""-[]--}-spaces1 :: Pattern Text-spaces1 = plus space--{-| Match the tab character (@\'\t\'@)-->>> match tab "\t"-"\t"->>> match tab " "-""--}-tab :: Pattern Char-tab = char '\t'--{-| Match the newline character (@\'\n\'@)-->>> match newline "\n"-"\n"->>> match newline " "-""--}-newline :: Pattern Char-newline = char '\n'--{-| Matches a carriage return (@\'\r\'@) followed by a newline (@\'\n\'@)-->>> match crlf "\r\n"-["\r\n"]->>> match crlf "\n\r"-[]--}-crlf :: Pattern Text-crlf = text "\r\n"--{-| Match an uppercase letter-->>> match upper "A"-"A"->>> match upper "a"-""--}-upper :: Pattern Char-upper = satisfy isUpper--{-| Match a lowercase letter-->>> match lower "a"-"a"->>> match lower "A"-""--}-lower :: Pattern Char-lower = satisfy isLower--{-| Match a letter or digit-->>> match alphaNum "1"-"1"->>> match alphaNum "a"-"a"->>> match alphaNum "A"-"A"->>> match alphaNum "."-""--}-alphaNum :: Pattern Char-alphaNum = satisfy isAlphaNum--{-| Match a letter-->>> match letter "A"-"A"->>> match letter "a"-"a"->>> match letter "1"-""--}-letter :: Pattern Char-letter = satisfy isLetter--{-| Match a digit-->>> match digit "1"-"1"->>> match digit "a"-""--}-digit :: Pattern Char-digit = satisfy isDigit--{-| Match a hexadecimal digit-->>> match hexDigit "1"-"1"->>> match hexDigit "A"-"A"->>> match hexDigit "a"-"a"->>> match hexDigit "g"-""--}-hexDigit :: Pattern Char-hexDigit = satisfy isHexDigit--{-| Match an octal digit-->>> match octDigit "1"-"1"->>> match octDigit "9"-""--}-octDigit :: Pattern Char-octDigit = satisfy isOctDigit--{-| Match an unsigned decimal number-->>> match decimal "123"-[123]->>> match decimal "-123"-[]--}-decimal :: Num n => Pattern n-decimal = do- ds <- some digit- return (foldl' step 0 ds)- where- step n d = n * 10 + fromIntegral (ord d - ord '0')--{-| Transform a numeric parser to accept an optional leading @\'+\'@ or @\'-\'@- sign-->>> match (signed decimal) "+123"-[123]->>> match (signed decimal) "-123"-[-123]->>> match (signed decimal) "123"-[123]--}-signed :: Num a => Pattern a -> Pattern a-signed p = do- sign <- (char '+' *> pure id) <|> (char '-' *> pure negate) <|> (pure id)- fmap sign p--{-| @(`invert` p)@ succeeds if @p@ fails and fails if @p@ succeeds-->>> match (invert "A") "A"-[]->>> match (invert "A") "B"-[()]--}-invert :: Pattern a -> Pattern ()-invert p = Pattern (StateT (\str -> case runStateT (runPattern p) str of- [] -> [((), "")]- _ -> [] ))--{-| Match a `Char`, but return `Text`-->>> match (once (char '1')) "1"-["1"]->>> match (once (char '1')) ""-[]--}-once :: Pattern Char -> Pattern Text-once p = fmap Text.singleton p--{-| Use this to match the prefix of a string-->>> match "A" "ABC"-[]->>> match (prefix "A") "ABC"-["A"]--}-prefix :: Pattern a -> Pattern a-prefix p = p <* chars--{-| Use this to match the suffix of a string-->>> match "C" "ABC"-[]->>> match (suffix "C") "ABC"-["C"]--}-suffix :: Pattern a -> Pattern a-suffix p = chars *> p--{-| Use this to match the interior of a string-->>> match "B" "ABC"-[]->>> match (has "B") "ABC"-["B"]--}-has :: Pattern a -> Pattern a-has p = chars *> p <* chars--{-| Parse 0 or more occurrences of the given character-->>> match (star anyChar) "123"-["123"]->>> match (star anyChar) ""-[""]-- See also: `chars`--}-star :: Pattern Char -> Pattern Text-star p = fmap Text.pack (many p)--{-| Parse 1 or more occurrences of the given character-->>> match (plus digit) "123"-["123"]->>> match (plus digit) ""-[]-- See also: `chars1`--}-plus :: Pattern Char -> Pattern Text-plus p = fmap Text.pack (some p)--{-| Patterns that match multiple times are greedy by default, meaning that they- try to match as many times as possible. The `selfless` combinator makes a- pattern match as few times as possible-- This only changes the order in which solutions are returned, by prioritizing- less greedy solutions-->>> match (prefix (selfless (some anyChar))) "123"-["1","12","123"]->>> match (prefix (some anyChar) ) "123"-["123","12","1"]--}-selfless :: Pattern a -> Pattern a-selfless p = Pattern (StateT (\s -> reverse (runStateT (runPattern p) s)))--{-| Apply the patterns in the list in order, until one of them succeeds-->>> match (choice ["cat", "dog", "egg"]) "egg"-["egg"]->>> match (choice ["cat", "dog", "egg"]) "cat"-["cat"]->>> match (choice ["cat", "dog", "egg"]) "fan"-[]--}-choice :: [Pattern a] -> Pattern a-choice = msum--{-| Apply the given pattern a fixed number of times, collecting the results-->>> match (count 3 anyChar) "123"-["123"]->>> match (count 4 anyChar) "123"-[]--}-count :: Int -> Pattern a -> Pattern [a]-count = replicateM--{-| Apply the given pattern 0 or more times, up to a given bound,- collecting the results-->>> match (upperBounded 5 dot) "123"-["123"]->>> match (upperBounded 2 dot) "123"-[]->>> match ((,) <$> upperBounded 2 dot <*> chars) "123"-[("12","3"),("1","23")]--}--upperBounded :: Int -> Pattern a -> Pattern [a]-upperBounded n p- | n <= 0 = mempty- | n == 1 = fmap pure p- | otherwise = (:) <$> p <*> option (upperBounded (n - 1) p)--{-| Apply the given pattern a number of times restricted by given- lower and upper bounds, collecting the results-->>> match (bounded 2 5 "cat") "catcatcat"-[["cat","cat","cat"]]->>> match (bounded 2 5 "cat") "cat"-[]->>> match (bounded 2 5 "cat") "catcatcatcatcatcat"-[]--`bounded` could be implemented naively as follows:--> bounded m n p = do-> x <- choice (map pure [m..n])-> count x p---}--bounded :: Int -> Int -> Pattern a -> Pattern [a]-bounded m n p- | m == n = count m p- | m < n = (++) <$> count m p <*> option (upperBounded (n - m) p)- | otherwise = mzero--{-| Transform a parser to a succeed with an empty value instead of failing-- See also: `optional`-->>> match (option "1" <> "2") "12"-["12"]->>> match (option "1" <> "2") "2"-["2"]--}-option :: Monoid a => Pattern a -> Pattern a-option p = p <|> mempty--{-| @(between open close p)@ matches @\'p\'@ in between @\'open\'@ and- @\'close\'@-->>> match (between (char '(') (char ')') (star anyChar)) "(123)"-["123"]->>> match (between (char '(') (char ')') (star anyChar)) "(123"-[]--}-between :: Pattern a -> Pattern b -> Pattern c -> Pattern c-between open close p = open *> p <* close--{-| Discard the pattern's result-->>> match (skip anyChar) "1"-[()]->>> match (skip anyChar) ""-[]--}-skip :: Pattern a -> Pattern ()-skip = void--{-| Restrict the pattern to consume no more than the given number of characters-->>> match (within 2 decimal) "12"-[12]->>> match (within 2 decimal) "1"-[1]->>> match (within 2 decimal) "123"-[]--}-within :: Int -> Pattern a -> Pattern a-within n p = Pattern (do- txt <- get- let (before, after) = Text.splitAt n txt- put before- a <- runPattern p- modify (<> after)- return a )--{-| Require the pattern to consume exactly the given number of characters-->>> match (fixed 2 decimal) "12"-[12]->>> match (fixed 2 decimal) "1"-[]--}-fixed :: Int -> Pattern a -> Pattern a-fixed n p = do- txt <- Pattern get- guard (Text.length txt >= n)- within n (p <* eof)--{-| @p `sepBy` sep@ matches zero or more occurrences of @p@ separated by @sep@-->>> match (decimal `sepBy` char ',') "1,2,3"-[[1,2,3]]->>> match (decimal `sepBy` char ',') ""-[[]]--}-sepBy :: Pattern a -> Pattern b -> Pattern [a]-p `sepBy` sep = (p `sepBy1` sep) <|> pure []--{-| @p `sepBy1` sep@ matches one or more occurrences of @p@ separated by @sep@-->>> match (decimal `sepBy1` ",") "1,2,3"-[[1,2,3]]->>> match (decimal `sepBy1` ",") ""-[]--}-sepBy1 :: Pattern a -> Pattern b -> Pattern [a]-p `sepBy1` sep = (:) <$> p <*> many (sep *> p) ---- | Like @star dot@ or @star anyChar@, except more efficient-chars :: Pattern Text-chars = Pattern (StateT (\txt ->- reverse (zip (Text.inits txt) (Text.tails txt)) ))---- | Like @plus dot@ or @plus anyChar@, except more efficient-chars1 :: Pattern Text-chars1 = Text.cons <$> dot <*> chars+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-missing-methods #-} + +{-| Use this module to either: + + * match `Text` with light-weight backtracking patterns, or: + + * parse structured values from `Text`. + + Example usage: + +>>> :set -XOverloadedStrings +>>> match ("can" <|> "cat") "cat" +["cat"] +>>> match ("can" <|> "cat") "dog" +[] +>>> match (decimal `sepBy` ",") "1,2,3" +[[1,2,3]] + + This pattern has unlimited backtracking, and will return as many solutions + as possible: + +>>> match (prefix (star anyChar)) "123" +["123","12","1",""] + + Use @do@ notation to structure more complex patterns: + +>>> :{ +let bit = ("0" *> pure False) <|> ("1" *> pure True) :: Pattern Bool; + portableBitMap = do + { "P1" + ; width <- spaces1 *> decimal + ; height <- spaces1 *> decimal + ; count width (count height (spaces1 *> bit)) + }; +in match (prefix portableBitMap) "P1\n2 2\n0 0\n1 0\n" +:} +[[[False,False],[True,False]]] + +-} + +module Turtle.Pattern ( + -- * Pattern + Pattern + , match + + -- * Primitive patterns + , anyChar + , eof + + -- * Character patterns + , dot + , satisfy + , char + , notChar + , text + , asciiCI + , oneOf + , noneOf + , space + , spaces + , spaces1 + , tab + , newline + , crlf + , upper + , lower + , alphaNum + , letter + , digit + , hexDigit + , octDigit + + -- * Numbers + , decimal + , signed + + -- * Combinators + , prefix + , suffix + , has + , begins + , ends + , contains + , invert + , once + , star + , plus + , selfless + , choice + , count + , lowerBounded + , upperBounded + , bounded + , option + , between + , skip + , within + , fixed + , sepBy + , sepBy1 + + -- * High-efficiency primitives + , chars + , chars1 + ) where + +import Control.Applicative +import Control.Monad +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.State +import Data.Char +import Data.List (foldl') +import Data.Monoid +import Data.String (IsString(..)) +import Data.Text (Text) +import qualified Data.Text as Text +import Prelude -- Fix redundant import warnings + +-- | A fully backtracking pattern that parses an @\'a\'@ from some `Text` +newtype Pattern a = Pattern { runPattern :: StateT Text [] a } + deriving (Functor, Applicative, Monad, Alternative, MonadPlus) + +instance Monoid a => Monoid (Pattern a) where + mempty = pure mempty + mappend = liftA2 mappend + +-- | Pattern forms a semiring, this is the closest approximation +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) + +{-| Match a `Pattern` against a `Text` input, returning all possible solutions + + The `Pattern` must match the entire `Text` +-} +match :: Pattern a -> Text -> [a] +match p = evalStateT (runPattern (p <* eof)) + +{-| Match any character + +>>> match anyChar "1" +"1" +>>> match anyChar "" +"" +-} +anyChar :: Pattern Char +anyChar = Pattern (do + Just (c, cs) <- fmap Text.uncons get + put cs + return c ) + +{-| Matches the end of input + +>>> match eof "1" +[] +>>> match eof "" +[()] +-} +eof :: Pattern () +eof = Pattern (do + True <- fmap Text.null get + return () ) + +-- | Synonym for `anyChar` +dot :: Pattern Char +dot = anyChar + +{-| Match any character that satisfies the given predicate + +>>> match (satisfy (== '1')) "1" +"1" +>>> match (satisfy (== '2')) "1" +"" +-} +satisfy :: (Char -> Bool) -> Pattern Char +satisfy predicate = do + c <- anyChar + guard (predicate c) + return c + +{-| Match a specific character + +>>> match (char '1') "1" +"1" +>>> match (char '2') "1" +"" +-} +char :: Char -> Pattern Char +char c = satisfy (== c) + +{-| Match any character except the given one + +>>> match (notChar '2') "1" +"1" +>>> match (notChar '1') "1" +"" +-} +notChar :: Char -> Pattern Char +notChar c = satisfy (/= c) + +{-| Match a specific string + +>>> match (text "123") "123" +["123"] + + You can also omit the `text` function if you enable the @OverloadedStrings@ + extension: + +>>> match "123" "123" +["123"] +-} +text :: Text -> Pattern Text +text before' = Pattern (do + txt <- get + let (before, after) = Text.splitAt (Text.length before') txt + guard (before == before') + 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" +"1" +>>> match (oneOf "2a") "1" +"" +-} +oneOf :: [Char] -> Pattern Char +oneOf cs = satisfy (`elem` cs) + +{-| Match anything other than the given characters + +>>> match (noneOf "2a") "1" +"1" +>>> match (noneOf "1a") "1" +"" +-} +noneOf :: [Char] -> Pattern Char +noneOf cs = satisfy (`notElem` cs) + +{-| Match a whitespace character + +>>> match space " " +" " +>>> match space "1" +"" +-} +space :: Pattern Char +space = satisfy isSpace + +{-| Match zero or more whitespace characters + +>>> match spaces " " +[" "] +>>> match spaces "" +[""] +-} +spaces :: Pattern Text +spaces = star space + +{-| Match one or more whitespace characters + +>>> match spaces1 " " +[" "] +>>> match spaces1 "" +[] +-} +spaces1 :: Pattern Text +spaces1 = plus space + +{-| Match the tab character (@\'\t\'@) + +>>> match tab "\t" +"\t" +>>> match tab " " +"" +-} +tab :: Pattern Char +tab = char '\t' + +{-| Match the newline character (@\'\n\'@) + +>>> match newline "\n" +"\n" +>>> match newline " " +"" +-} +newline :: Pattern Char +newline = char '\n' + +{-| Matches a carriage return (@\'\r\'@) followed by a newline (@\'\n\'@) + +>>> match crlf "\r\n" +["\r\n"] +>>> match crlf "\n\r" +[] +-} +crlf :: Pattern Text +crlf = text "\r\n" + +{-| Match an uppercase letter + +>>> match upper "A" +"A" +>>> match upper "a" +"" +-} +upper :: Pattern Char +upper = satisfy isUpper + +{-| Match a lowercase letter + +>>> match lower "a" +"a" +>>> match lower "A" +"" +-} +lower :: Pattern Char +lower = satisfy isLower + +{-| Match a letter or digit + +>>> match alphaNum "1" +"1" +>>> match alphaNum "a" +"a" +>>> match alphaNum "A" +"A" +>>> match alphaNum "." +"" +-} +alphaNum :: Pattern Char +alphaNum = satisfy isAlphaNum + +{-| Match a letter + +>>> match letter "A" +"A" +>>> match letter "a" +"a" +>>> match letter "1" +"" +-} +letter :: Pattern Char +letter = satisfy isLetter + +{-| Match a digit + +>>> match digit "1" +"1" +>>> match digit "a" +"" +-} +digit :: Pattern Char +digit = satisfy isDigit + +{-| Match a hexadecimal digit + +>>> match hexDigit "1" +"1" +>>> match hexDigit "A" +"A" +>>> match hexDigit "a" +"a" +>>> match hexDigit "g" +"" +-} +hexDigit :: Pattern Char +hexDigit = satisfy isHexDigit + +{-| Match an octal digit + +>>> match octDigit "1" +"1" +>>> match octDigit "9" +"" +-} +octDigit :: Pattern Char +octDigit = satisfy isOctDigit + +{-| Match an unsigned decimal number + +>>> match decimal "123" +[123] +>>> match decimal "-123" +[] +-} +decimal :: Num n => Pattern n +decimal = do + ds <- some digit + return (foldl' step 0 ds) + where + step n d = n * 10 + fromIntegral (ord d - ord '0') + +{-| Transform a numeric parser to accept an optional leading @\'+\'@ or @\'-\'@ + sign + +>>> match (signed decimal) "+123" +[123] +>>> match (signed decimal) "-123" +[-123] +>>> match (signed decimal) "123" +[123] +-} +signed :: Num a => Pattern a -> Pattern a +signed p = do + sign <- (char '+' *> pure id) <|> (char '-' *> pure negate) <|> (pure id) + fmap sign p + +{-| @(`invert` p)@ succeeds if @p@ fails and fails if @p@ succeeds + +>>> match (invert "A") "A" +[] +>>> match (invert "A") "B" +[()] +-} +invert :: Pattern a -> Pattern () +invert p = Pattern (StateT (\str -> case runStateT (runPattern p) str of + [] -> [((), "")] + _ -> [] )) + +{-| Match a `Char`, but return `Text` + +>>> match (once (char '1')) "1" +["1"] +>>> match (once (char '1')) "" +[] +-} +once :: Pattern Char -> Pattern Text +once p = fmap Text.singleton p + +{-| Use this to match the prefix of a string + +>>> match "A" "ABC" +[] +>>> match (prefix "A") "ABC" +["A"] +-} +prefix :: Pattern a -> Pattern a +prefix p = p <* chars + +{-| Use this to match the suffix of a string + +>>> match "C" "ABC" +[] +>>> match (suffix "C") "ABC" +["C"] +-} +suffix :: Pattern a -> Pattern a +suffix p = chars *> p + +{-| Use this to match the interior of a string + +>>> match "B" "ABC" +[] +>>> match (has "B") "ABC" +["B"] +-} +has :: Pattern a -> Pattern a +has p = chars *> p <* chars + +{-| Match the entire string if it begins with the given pattern + + This returns the entire string, not just the matched prefix + +>>> match (begins "A" ) "ABC" +["ABC"] +>>> match (begins ("A" *> pure "1")) "ABC" +["1BC"] +-} +begins :: Pattern Text -> Pattern Text +begins pattern = pattern <> chars + +{-| Match the entire string if it ends with the given pattern + + This returns the entire string, not just the matched prefix + +>>> match (ends "C" ) "ABC" +["ABC"] +>>> match (ends ("C" *> pure "1")) "ABC" +["AB1"] +-} +ends :: Pattern Text -> Pattern Text +ends pattern = chars <> pattern + +{-| Match the entire string if it contains the given pattern + + This returns the entire string, not just the interior pattern + +>>> match (contains "B" ) "ABC" +["ABC"] +>>> match (contains ("B" *> pure "1")) "ABC" +["A1C"] +-} +contains :: Pattern Text -> Pattern Text +contains pattern = chars <> pattern <> chars + +{-| Parse 0 or more occurrences of the given character + +>>> match (star anyChar) "123" +["123"] +>>> match (star anyChar) "" +[""] + + See also: `chars` +-} +star :: Pattern Char -> Pattern Text +star p = fmap Text.pack (many p) + +{-| Parse 1 or more occurrences of the given character + +>>> match (plus digit) "123" +["123"] +>>> match (plus digit) "" +[] + + See also: `chars1` +-} +plus :: Pattern Char -> Pattern Text +plus p = fmap Text.pack (some p) + +{-| Patterns that match multiple times are greedy by default, meaning that they + try to match as many times as possible. The `selfless` combinator makes a + pattern match as few times as possible + + This only changes the order in which solutions are returned, by prioritizing + less greedy solutions + +>>> match (prefix (selfless (some anyChar))) "123" +["1","12","123"] +>>> match (prefix (some anyChar) ) "123" +["123","12","1"] +-} +selfless :: Pattern a -> Pattern a +selfless p = Pattern (StateT (\s -> reverse (runStateT (runPattern p) s))) + +{-| Apply the patterns in the list in order, until one of them succeeds + +>>> match (choice ["cat", "dog", "egg"]) "egg" +["egg"] +>>> match (choice ["cat", "dog", "egg"]) "cat" +["cat"] +>>> match (choice ["cat", "dog", "egg"]) "fan" +[] +-} +choice :: [Pattern a] -> Pattern a +choice = msum + +{-| Apply the given pattern a fixed number of times, collecting the results + +>>> match (count 3 anyChar) "123" +["123"] +>>> match (count 4 anyChar) "123" +[] +-} +count :: Int -> Pattern a -> Pattern [a] +count = replicateM + +{-| Apply the given pattern at least the given number of times, collecting the + results + +>>> match (lowerBounded 5 dot) "123" +[] +>>> match (lowerBounded 2 dot) "123" +["123"] +-} +lowerBounded :: Int -> Pattern a -> Pattern [a] +lowerBounded n p = do + ps1 <- count n p + ps2 <- many p + return (ps1 ++ ps2) + +{-| Apply the given pattern 0 or more times, up to a given bound, + collecting the results + +>>> match (upperBounded 5 dot) "123" +["123"] +>>> match (upperBounded 2 dot) "123" +[] +>>> match ((,) <$> upperBounded 2 dot <*> chars) "123" +[("12","3"),("1","23")] +-} +upperBounded :: Int -> Pattern a -> Pattern [a] +upperBounded n p + | n <= 0 = mempty + | n == 1 = fmap pure p + | otherwise = (:) <$> p <*> option (upperBounded (n - 1) p) + +{-| Apply the given pattern a number of times restricted by given + lower and upper bounds, collecting the results + +>>> match (bounded 2 5 "cat") "catcatcat" +[["cat","cat","cat"]] +>>> match (bounded 2 5 "cat") "cat" +[] +>>> match (bounded 2 5 "cat") "catcatcatcatcatcat" +[] + +`bounded` could be implemented naively as follows: + +> bounded m n p = do +> x <- choice (map pure [m..n]) +> count x p + +-} +bounded :: Int -> Int -> Pattern a -> Pattern [a] +bounded m n p + | m == n = count m p + | m < n = (++) <$> count m p <*> option (upperBounded (n - m) p) + | otherwise = mzero + +{-| Transform a parser to a succeed with an empty value instead of failing + + See also: `optional` + +>>> match (option "1" <> "2") "12" +["12"] +>>> match (option "1" <> "2") "2" +["2"] +-} +option :: Monoid a => Pattern a -> Pattern a +option p = p <|> mempty + +{-| @(between open close p)@ matches @\'p\'@ in between @\'open\'@ and + @\'close\'@ + +>>> match (between (char '(') (char ')') (star anyChar)) "(123)" +["123"] +>>> match (between (char '(') (char ')') (star anyChar)) "(123" +[] +-} +between :: Pattern a -> Pattern b -> Pattern c -> Pattern c +between open close p = open *> p <* close + +{-| Discard the pattern's result + +>>> match (skip anyChar) "1" +[()] +>>> match (skip anyChar) "" +[] +-} +skip :: Pattern a -> Pattern () +skip = void + +{-| Restrict the pattern to consume no more than the given number of characters + +>>> match (within 2 decimal) "12" +[12] +>>> match (within 2 decimal) "1" +[1] +>>> match (within 2 decimal) "123" +[] +-} +within :: Int -> Pattern a -> Pattern a +within n p = Pattern (do + txt <- get + let (before, after) = Text.splitAt n txt + put before + a <- runPattern p + modify (<> after) + return a ) + +{-| Require the pattern to consume exactly the given number of characters + +>>> match (fixed 2 decimal) "12" +[12] +>>> match (fixed 2 decimal) "1" +[] +-} +fixed :: Int -> Pattern a -> Pattern a +fixed n p = do + txt <- Pattern get + guard (Text.length txt >= n) + within n (p <* eof) + +{-| @p `sepBy` sep@ matches zero or more occurrences of @p@ separated by @sep@ + +>>> match (decimal `sepBy` char ',') "1,2,3" +[[1,2,3]] +>>> match (decimal `sepBy` char ',') "" +[[]] +-} +sepBy :: Pattern a -> Pattern b -> Pattern [a] +p `sepBy` sep = (p `sepBy1` sep) <|> pure [] + +{-| @p `sepBy1` sep@ matches one or more occurrences of @p@ separated by @sep@ + +>>> match (decimal `sepBy1` ",") "1,2,3" +[[1,2,3]] +>>> match (decimal `sepBy1` ",") "" +[] +-} +sepBy1 :: Pattern a -> Pattern b -> Pattern [a] +p `sepBy1` sep = (:) <$> p <*> many (sep *> p) + +-- | Like @star dot@ or @star anyChar@, except more efficient +chars :: Pattern Text +chars = Pattern (StateT (\txt -> + reverse (zip (Text.inits txt) (Text.tails txt)) )) + +-- | Like @plus dot@ or @plus anyChar@, except more efficient +chars1 :: Pattern Text +chars1 = Text.cons <$> dot <*> chars
src/Turtle/Prelude.hs view
@@ -1,1126 +1,1283 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- | This module provides a large suite of utilities that resemble Unix--- utilities.------ Many of these commands are just existing Haskell commands renamed to match--- their Unix counterparts:------ >>> :set -XOverloadedStrings--- >>> cd "/tmp"--- >>> pwd--- FilePath "/tmp"------ Some commands are `Shell`s that emit streams of values. `view` prints all--- values in a `Shell` stream:------ >>> view (ls "/usr")--- FilePath "/usr/lib"--- FilePath "/usr/src"--- FilePath "/usr/sbin"--- FilePath "/usr/include"--- FilePath "/usr/share"--- FilePath "/usr/games"--- FilePath "/usr/local"--- FilePath "/usr/bin"--- >>> view (find (suffix "Browser.py") "/usr/lib")--- FilePath "/usr/lib/python3.4/idlelib/ClassBrowser.py"--- FilePath "/usr/lib/python3.4/idlelib/RemoteObjectBrowser.py"--- FilePath "/usr/lib/python3.4/idlelib/PathBrowser.py"--- FilePath "/usr/lib/python3.4/idlelib/ObjectBrowser.py"------ Use `fold` to reduce the output of a `Shell` stream:------ >>> import qualified Control.Foldl as Fold--- >>> fold (ls "/usr") Fold.length--- 8--- >>> fold (find (suffix "Browser.py") "/usr/lib") Fold.head--- Just (FilePath "/usr/lib/python3.4/idlelib/ClassBrowser.py")------ Create files using `output`:------ >>> output "foo.txt" ("123" <|> "456" <|> "ABC")--- >>> realpath "foo.txt"--- FilePath "/tmp/foo.txt"------ Read in files using `input`:------ >>> stdout (input "foo.txt")--- 123--- 456--- ABC------ Commands like `grep`, `sed` and `find` accept arbitrary `Pattern`s------ >>> stdout (grep ("123" <|> "ABC") (input "foo.txt"))--- 123--- ABC--- >>> let exclaim = fmap (<> "!") (plus digit)--- >>> stdout (sed exclaim (input "foo.txt"))--- 123!--- 456!--- ABC------ Note that `grep` and `find` differ from their Unix counterparts by requiring--- that the `Pattern` matches the entire line or file name by default. However,--- you can optionally match the prefix, suffix, or interior of a line:------ >>> stdout (grep (has "2") (input "foo.txt"))--- 123--- >>> stdout (grep (prefix "1") (input "foo.txt"))--- 123--- >>> stdout (grep (suffix "3") (input "foo.txt"))--- 123------ You can also build up more sophisticated `Shell` programs using `sh` in--- conjunction with @do@ notation:------ >{-# LANGUAGE OverloadedStrings #-}--- >--- >import Turtle--- >--- >main = sh example--- >--- >example = do--- > -- Read in file names from "files1.txt" and "files2.txt"--- > file <- fmap fromText (input "files1.txt" <|> input "files2.txt")--- >--- > -- Stream each file to standard output only if the file exists--- > True <- liftIO (testfile file)--- > line <- input file--- > liftIO (echo line)------ See "Turtle.Tutorial" for an extended tutorial explaining how to use this--- library in greater detail.--module Turtle.Prelude (- -- * IO- proc- , shell- , procStrict- , shellStrict- , echo- , err- , readline- , arguments-#if MIN_VERSION_base(4,7,0)- , export- , unset-#endif-#if MIN_VERSION_base(4,6,0)- , need-#endif- , env- , cd- , pwd- , home- , realpath- , mv- , mkdir- , mktree- , cp- , rm- , rmdir- , rmtree- , testfile- , testdir- , date- , datefile- , touch- , time- , hostname- , sleep- , exit- , die- , (.&&.)- , (.||.)-- -- * Managed- , readonly- , writeonly- , appendonly- , mktemp- , mktempdir- , fork- , wait-- -- * Shell- , inproc- , inshell- , stdin- , input- , inhandle- , stdout- , output- , outhandle- , append- , stderr- , strict- , ls- , lstree- , cat- , grep- , sed- , find- , yes- , limit- , limitWhile- , cache-- -- * Folds- , countChars- , countWords- , countLines-- -- * Permissions- , Permissions- , chmod- , getmod- , setmod- , readable, nonreadable- , writable, nonwritable- , executable, nonexecutable- , searchable, nonsearchable- , ooo,roo,owo,oox,oos,rwo,rox,ros,owx,rwx,rws-- -- * File size- , du- , Size- , bytes- , kilobytes- , megabytes- , gigabytes- , terabytes- , kibibytes- , mebibytes- , gibibytes- , tebibytes- ) where--import Control.Applicative (Alternative(..), (<*), (*>))-import Control.Concurrent.Async (Async, withAsync, wait, concurrently)-import Control.Concurrent.MVar (newMVar, modifyMVar_)-import Control.Concurrent (threadDelay)-import Control.Exception (bracket, throwIO)-import Control.Foldl (Fold, FoldM(..), genericLength, handles, list, premap)-import qualified Control.Foldl.Text-import Control.Monad (liftM, msum, when, unless)-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Managed (Managed, managed)-#ifdef mingw32_HOST_OS-import Data.Bits ((.&.))-#endif-import Data.IORef (newIORef, readIORef, writeIORef)-import Data.Text (Text, pack, unpack)-import Data.Time (NominalDiffTime, UTCTime, getCurrentTime)-import Data.Traversable (traverse)-import qualified Data.Text as Text-import qualified Data.Text.IO as Text-import qualified Filesystem-import Filesystem.Path.CurrentOS (FilePath, (</>))-import qualified Filesystem.Path.CurrentOS as Filesystem-import Network.HostName (getHostName)-import System.Clock (Clock(..), TimeSpec(..), getTime)-import System.Environment (- getArgs,-#if MIN_VERSION_base(4,7,0)- setEnv,- unsetEnv,-#endif-#if MIN_VERSION_base(4,6,0)- lookupEnv,-#endif- getEnvironment )-import System.Directory (Permissions)-import qualified System.Directory as Directory-import System.Exit (ExitCode(..), exitWith)-import System.IO (Handle, hClose)-import qualified System.IO as IO-import System.IO.Temp (withTempDirectory, withTempFile)-import qualified System.Process as Process-#ifdef mingw32_HOST_OS-import qualified System.Win32 as Win32-#else-import System.Posix (openDirStream, readDirStream, closeDirStream, touchFile)-#endif-import Prelude hiding (FilePath)--import Turtle.Pattern (Pattern, anyChar, match)-import Turtle.Shell-import Turtle.Format (format, w, (%))--{-| Run a command using @execvp@, retrieving the exit code-- The command inherits @stdout@ and @stderr@ for the current process--}-proc- :: MonadIO io- => Text- -- ^ Command- -> [Text]- -- ^ Arguments- -> Shell Text- -- ^ Lines of standard input- -> io ExitCode- -- ^ Exit code-proc cmd args = system (Process.proc (unpack cmd) (map unpack args))--{-| Run a command line using the shell, retrieving the exit code-- This command is more powerful than `proc`, but highly vulnerable to code- injection if you template the command line with untrusted input-- The command inherits @stdout@ and @stderr@ for the current process--}-shell- :: MonadIO io- => Text- -- ^ Command line- -> Shell Text- -- ^ Lines of standard input- -> io ExitCode- -- ^ Exit code-shell cmdLine = system (Process.shell (unpack cmdLine))--{-| Run a command using @execvp@, retrieving the exit code and stdout as a- non-lazy blob of Text-- The command inherits @stderr@ for the current process--}-procStrict- :: MonadIO io- => Text- -- ^ Command- -> [Text]- -- ^ Arguments- -> Shell Text- -- ^ Lines of standard input- -> io (ExitCode, Text)- -- ^ Exit code and stdout-procStrict cmd args =- systemStrict (Process.proc (Text.unpack cmd) (map Text.unpack args))--{-| Run a command line using the shell, retrieving the exit code and stdout as a- non-lazy blob of Text-- This command is more powerful than `proc`, but highly vulnerable to code- injection if you template the command line with untrusted input-- The command inherits @stderr@ for the current process--}-shellStrict- :: MonadIO io- => Text- -- ^ Command line- -> Shell Text- -- ^ Lines of standard input- -> io (ExitCode, Text)- -- ^ Exit code and stdout-shellStrict cmdLine = systemStrict (Process.shell (Text.unpack cmdLine))--system- :: MonadIO io- => Process.CreateProcess- -- ^ Command- -> Shell Text- -- ^ Lines of standard input- -> io ExitCode- -- ^ Exit code-system p s = liftIO (do- let p' = p- { Process.std_in = Process.CreatePipe- , Process.std_out = Process.Inherit- , Process.std_err = Process.Inherit- }-- let open = do- (Just hIn, Nothing, Nothing, ph) <- Process.createProcess p'- return (hIn, ph)-- -- Prevent double close- mvar <- newMVar False- let close handle = do- modifyMVar_ mvar (\finalized -> do- unless finalized (hClose handle)- return True )-- bracket open (\(hIn, _) -> close hIn) (\(hIn, ph) -> do- let feedIn = do- sh (do- txt <- s- liftIO (Text.hPutStrLn hIn txt) )- close hIn- withAsync feedIn (\a -> liftIO (Process.waitForProcess ph) <* wait a) ) )--systemStrict- :: MonadIO io- => Process.CreateProcess- -- ^ Command- -> Shell Text- -- ^ Lines of standard input- -> io (ExitCode, Text)- -- ^ Exit code and stdout-systemStrict p s = liftIO (do- let p' = p- { Process.std_in = Process.CreatePipe- , Process.std_out = Process.CreatePipe- , Process.std_err = Process.Inherit- }-- let open = do- (Just hIn, Just hOut, Nothing, ph) <- liftIO (Process.createProcess p')- return (hIn, hOut, ph)-- -- Prevent double close- mvar <- newMVar False- let close handle = do- modifyMVar_ mvar (\finalized -> do- unless finalized (hClose handle)- return True )-- bracket open (\(hIn, _, _) -> close hIn) (\(hIn, hOut, ph) -> do- let feedIn = do- sh (do- txt <- s- liftIO (Text.hPutStrLn hIn txt) )- close hIn-- concurrently- (withAsync feedIn (\a -> liftIO (Process.waitForProcess ph) <* wait a))- (Text.hGetContents hOut) ) )--{-| Run a command using @execvp@, streaming @stdout@ as lines of `Text`-- The command inherits @stderr@ for the current process--}-inproc- :: Text- -- ^ Command- -> [Text]- -- ^ Arguments- -> Shell Text- -- ^ Lines of standard input- -> Shell Text- -- ^ Lines of standard output-inproc cmd args = stream (Process.proc (unpack cmd) (map unpack args))--{-| Run a command line using the shell, streaming @stdout@ as lines of `Text`-- This command is more powerful than `inproc`, but highly vulnerable to code- injection if you template the command line with untrusted input-- The command inherits @stderr@ for the current process--}-inshell- :: Text- -- ^ Command line- -> Shell Text- -- ^ Lines of standard input- -> Shell Text- -- ^ Lines of standard output-inshell cmd = stream (Process.shell (unpack cmd))--stream- :: Process.CreateProcess- -- ^ Command- -> Shell Text- -- ^ Lines of standard input- -> Shell Text- -- ^ Lines of standard output-stream p s = do- let p' = p- { Process.std_in = Process.CreatePipe- , Process.std_out = Process.CreatePipe- , Process.std_err = Process.Inherit- }-- let open = do- (Just hIn, Just hOut, Nothing, ph) <- liftIO (Process.createProcess p')- return (hIn, hOut, ph)-- -- Prevent double close- mvar <- liftIO (newMVar False)- let close handle = do- modifyMVar_ mvar (\finalized -> do- unless finalized (hClose handle)- return True )-- (hIn, hOut, ph) <- using (managed (bracket open (\(hIn, _, _) -> close hIn)))- let feedIn = do- sh (do- txt <- s- liftIO (Text.hPutStrLn hIn txt) )- close hIn-- a <- using (fork feedIn)- inhandle hOut <|> (liftIO (Process.waitForProcess ph *> wait a) *> empty)---- | Print to @stdout@-echo :: MonadIO io => Text -> io ()-echo txt = liftIO (Text.putStrLn txt)---- | Print to @stderr@-err :: MonadIO io => Text -> io ()-err txt = liftIO (Text.hPutStrLn IO.stderr txt)--{-| Read in a line from @stdin@-- Returns `Nothing` if at end of input--}-readline :: MonadIO io => io (Maybe Text)-readline = liftIO (do- eof <- IO.isEOF- if eof- then return Nothing- else fmap (Just . pack) getLine )---- | Get command line arguments in a list-arguments :: MonadIO io => io [Text]-arguments = liftIO (fmap (map pack) getArgs)--#if MIN_VERSION_base(4,7,0)--- | Set or modify an environment variable-export :: MonadIO io => Text -> Text -> io ()-export key val = liftIO (setEnv (unpack key) (unpack val))---- | Delete an environment variable-unset :: MonadIO io => Text -> io ()-unset key = liftIO (unsetEnv (unpack key))-#endif--#if MIN_VERSION_base(4,6,0)--- | Look up an environment variable-need :: MonadIO io => Text -> io (Maybe Text)-need key = liftIO (fmap (fmap pack) (lookupEnv (unpack key)))-#endif---- | Retrieve all environment variables-env :: MonadIO io => io [(Text, Text)]-env = liftIO (fmap (fmap toTexts) getEnvironment)- where- toTexts (key, val) = (pack key, pack val)---- | Change the current directory-cd :: MonadIO io => FilePath -> io ()-cd path = liftIO (Filesystem.setWorkingDirectory path)---- | Get the current directory-pwd :: MonadIO io => io FilePath-pwd = liftIO Filesystem.getWorkingDirectory---- | Get the home directory-home :: MonadIO io => io FilePath-home = liftIO Filesystem.getHomeDirectory---- | Canonicalize a path-realpath :: MonadIO io => FilePath -> io FilePath-realpath path = liftIO (Filesystem.canonicalizePath path)--#ifdef mingw32_HOST_OS-fILE_ATTRIBUTE_REPARSE_POINT :: Win32.FileAttributeOrFlag-fILE_ATTRIBUTE_REPARSE_POINT = 1024--reparsePoint :: Win32.FileAttributeOrFlag -> Bool-reparsePoint attr = fILE_ATTRIBUTE_REPARSE_POINT .&. attr /= 0-#endif--{-| Stream all immediate children of the given directory, excluding @\".\"@ and- @\"..\"@--}-ls :: FilePath -> Shell FilePath-ls path = Shell (\(FoldM step begin done) -> do- x0 <- begin- let path' = Filesystem.encodeString path- canRead <- fmap- Directory.readable- (Directory.getPermissions (deslash path'))-#ifdef mingw32_HOST_OS- reparse <- fmap reparsePoint (Win32.getFileAttributes path')- if (canRead && not reparse)- then bracket- (Win32.findFirstFile (Filesystem.encodeString (path </> "*")))- (\(h, _) -> Win32.findClose h)- (\(h, fdat) -> do- let loop x = do- file' <- Win32.getFindDataFileName fdat- let file = Filesystem.decodeString file'- x' <- if (file' /= "." && file' /= "..")- then step x (path </> file)- else return x- more <- Win32.findNextFile h fdat- if more then loop $! x' else done x'- loop $! x0 )- else done x0 )-#else- if canRead- then bracket (openDirStream path') closeDirStream (\dirp -> do- let loop x = do- file' <- readDirStream dirp- case file' of- "" -> done x- _ -> do- let file = Filesystem.decodeString file'- x' <- if (file' /= "." && file' /= "..")- then step x (path </> file)- else return x- loop $! x'- loop $! x0 )- else done x0 )-#endif--{-| This is used to remove the trailing slash from a path, because- `getPermissions` will fail if a path ends with a trailing slash--}-deslash :: String -> String-deslash [] = []-deslash (c0:cs0) = c0:go cs0- where- go [] = []- go ['\\'] = []- go (c:cs) = c:go cs---- | Stream all recursive descendents of the given directory-lstree :: FilePath -> Shell FilePath-lstree path = do- child <- ls path- isDir <- liftIO (testdir child)- if isDir- then return child <|> lstree child- else return child---- | Move a file or directory-mv :: MonadIO io => FilePath -> FilePath -> io ()-mv oldPath newPath = liftIO (Filesystem.rename oldPath newPath)--{-| Create a directory-- Fails if the directory is present--}-mkdir :: MonadIO io => FilePath -> io ()-mkdir path = liftIO (Filesystem.createDirectory False path)--{-| Create a directory tree (equivalent to @mkdir -p@)-- Does not fail if the directory is present--}-mktree :: MonadIO io => FilePath -> io ()-mktree path = liftIO (Filesystem.createTree path)---- | Copy a file-cp :: MonadIO io => FilePath -> FilePath -> io ()-cp oldPath newPath = liftIO (Filesystem.copyFile oldPath newPath)---- | Remove a file-rm :: MonadIO io => FilePath -> io ()-rm path = liftIO (Filesystem.removeFile path)---- | Remove a directory-rmdir :: MonadIO io => FilePath -> io ()-rmdir path = liftIO (Filesystem.removeDirectory path)--{-| Remove a directory tree (equivalent to @rm -r@)-- Use at your own risk--}-rmtree :: MonadIO io => FilePath -> io ()-rmtree path = liftIO (Filesystem.removeTree path)---- | Check if a file exists-testfile :: MonadIO io => FilePath -> io Bool-testfile path = liftIO (Filesystem.isFile path)---- | Check if a directory exists-testdir :: MonadIO io => FilePath -> io Bool-testdir path = liftIO (Filesystem.isDirectory path)--{-| Touch a file, updating the access and modification times to the current time-- Creates an empty file if it does not exist--}-touch :: MonadIO io => FilePath -> io ()-touch file = do- exists <- testfile file- liftIO (if exists-#ifdef mingw32_HOST_OS- then do- handle <- Win32.createFile- (Filesystem.encodeString file)- Win32.gENERIC_WRITE- Win32.fILE_SHARE_NONE- Nothing- Win32.oPEN_EXISTING- Win32.fILE_ATTRIBUTE_NORMAL- Nothing- (creationTime, _, _) <- Win32.getFileTime handle- systemTime <- Win32.getSystemTimeAsFileTime- Win32.setFileTime handle creationTime systemTime systemTime-#else- then touchFile (Filesystem.encodeString file)-#endif- else output file empty )--{-| Update a file or directory's user permissions--> chmod rwo "foo.txt" -- chmod u=rw foo.txt-> chmod executable "foo.txt" -- chmod u+x foo.txt-> chmod nonwritable "foo.txt" -- chmod u-x foo.txt--}-chmod- :: MonadIO io- => (Permissions -> Permissions)- -- ^ Permissions update function- -> FilePath- -- ^ Path- -> io Permissions- -- ^ Updated permissions-chmod modifyPermissions path = liftIO (do- let path' = deslash (Filesystem.encodeString path)- permissions <- Directory.getPermissions path'- let permissions' = modifyPermissions permissions- changed = permissions /= permissions'- when changed (Directory.setPermissions path' permissions')- return permissions' )---- | Get a file or directory's user permissions-getmod :: MonadIO io => FilePath -> io Permissions-getmod path = liftIO (do- let path' = deslash (Filesystem.encodeString path)- Directory.getPermissions path' )---- | Set a file or directory's user permissions-setmod :: MonadIO io => Permissions -> FilePath -> io ()-setmod permissions path = liftIO (do- let path' = deslash (Filesystem.encodeString path)- Directory.setPermissions path' permissions )---- | @+r@-readable :: Permissions -> Permissions-readable = Directory.setOwnerReadable True---- | @-r@-nonreadable :: Permissions -> Permissions-nonreadable = Directory.setOwnerReadable False---- | @+w@-writable :: Permissions -> Permissions-writable = Directory.setOwnerWritable True---- | @-w@-nonwritable :: Permissions -> Permissions-nonwritable = Directory.setOwnerWritable False---- | @+x@-executable :: Permissions -> Permissions-executable = Directory.setOwnerExecutable True---- | @-x@-nonexecutable :: Permissions -> Permissions-nonexecutable = Directory.setOwnerExecutable False---- | @+s@-searchable :: Permissions -> Permissions-searchable = Directory.setOwnerSearchable True---- | @-s@-nonsearchable :: Permissions -> Permissions-nonsearchable = Directory.setOwnerSearchable False---- | @-r -w -x@-ooo :: Permissions -> Permissions-ooo = const Directory.emptyPermissions---- | @+r -w -x@-roo :: Permissions -> Permissions-roo = readable . ooo---- | @-r +w -x@-owo :: Permissions -> Permissions-owo = writable . ooo---- | @-r -w +x@-oox :: Permissions -> Permissions-oox = executable . ooo---- | @-r -w +s@-oos :: Permissions -> Permissions-oos = searchable . ooo---- | @+r +w -x@-rwo :: Permissions -> Permissions-rwo = readable . writable . ooo---- | @+r -w +x@-rox :: Permissions -> Permissions-rox = readable . executable . ooo---- | @+r -w +s@-ros :: Permissions -> Permissions-ros = readable . searchable . ooo---- | @-r +w +x@-owx :: Permissions -> Permissions-owx = writable . executable . ooo---- | @+r +w +x@-rwx :: Permissions -> Permissions-rwx = readable . writable . executable . ooo--rws :: Permissions -> Permissions-rws = readable . writable . searchable . ooo--{-| Time how long a command takes in monotonic wall clock time-- Returns the duration alongside the return value--}-time :: MonadIO io => io a -> io (a, NominalDiffTime)-time io = do- TimeSpec seconds1 nanoseconds1 <- liftIO (getTime Monotonic)- a <- io- TimeSpec seconds2 nanoseconds2 <- liftIO (getTime Monotonic)- let t = fromIntegral ( seconds2 - seconds1)- + fromIntegral (nanoseconds2 - nanoseconds1) / 10^(9::Int)- return (a, fromRational t)---- | Get the system's host name-hostname :: MonadIO io => io Text-hostname = liftIO (fmap Text.pack getHostName)--{-| Sleep for the given duration-- A numeric literal argument is interpreted as seconds. In other words,- @(sleep 2.0)@ will sleep for two seconds.--}-sleep :: MonadIO io => NominalDiffTime -> io ()-sleep n = liftIO (threadDelay (truncate (n * 10^(6::Int))))--{-| Exit with the given exit code-- An exit code of @0@ indicates success--}-exit :: MonadIO io => ExitCode -> io a-exit code = liftIO (exitWith code)---- | Throw an exception using the provided `Text` message-die :: MonadIO io => Text -> io a-die txt = liftIO (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--}-mktempdir- :: FilePath- -- ^ Parent directory- -> Text- -- ^ Directory name template- -> Managed FilePath-mktempdir parent prefix = do- let parent' = Filesystem.encodeString parent- let prefix' = unpack prefix- dir' <- managed (withTempDirectory parent' prefix')- return (Filesystem.decodeString dir')--{-| Create a temporary file underneath the given directory-- Deletes the temporary file when done--}-mktemp- :: FilePath- -- ^ Parent directory- -> Text- -- ^ File name template- -> Managed (FilePath, Handle)-mktemp parent prefix = do- let parent' = Filesystem.encodeString parent- let prefix' = unpack prefix- (file', handle) <- managed (\k ->- withTempFile parent' prefix' (\file' handle -> k (file', handle)) )- let file = Filesystem.decodeString file'- return (file, handle)---- | Fork a thread, acquiring an `Async` value-fork :: IO a -> Managed (Async a)-fork io = managed (withAsync io)---- | Read lines of `Text` from standard input-stdin :: Shell Text-stdin = inhandle IO.stdin---- | Read lines of `Text` from a file-input :: FilePath -> Shell Text-input file = do- handle <- using (readonly file)- inhandle handle---- | Read lines of `Text` from a `Handle`-inhandle :: Handle -> Shell Text-inhandle handle = Shell (\(FoldM step begin done) -> do- x0 <- begin- let loop x = do- eof <- IO.hIsEOF handle- if eof- then done x- else do- txt <- Text.hGetLine handle- x' <- step x txt- loop $! x'- loop $! x0 )---- | Stream lines of `Text` to standard output-stdout :: MonadIO io => Shell Text -> io ()-stdout s = sh (do- txt <- s- liftIO (echo txt) )---- | Stream lines of `Text` to a file-output :: MonadIO io => FilePath -> Shell Text -> io ()-output file s = sh (do- handle <- using (writeonly file)- txt <- s- liftIO (Text.hPutStrLn handle txt) )---- | Stream lines of `Text` to a `Handle`-outhandle :: MonadIO io => Handle -> Shell Text -> io ()-outhandle handle s = sh (do- txt <- s- liftIO (Text.hPutStrLn handle txt) )---- | Stream lines of `Text` to append to a file-append :: MonadIO io => FilePath -> Shell Text -> io ()-append file s = sh (do- handle <- using (appendonly file)- txt <- s- liftIO (Text.hPutStrLn handle txt) )---- | Stream lines of `Text` to standard error-stderr :: MonadIO io => Shell Text -> io ()-stderr s = sh (do- txt <- s- liftIO (err txt) )---- | Read in a stream's contents strictly-strict :: MonadIO io => Shell Text -> io Text-strict s = liftM Text.unlines (fold s list)---- | Acquire a `Managed` read-only `Handle` from a `FilePath`-readonly :: FilePath -> Managed Handle-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.withTextFile file IO.WriteMode)---- | Acquire a `Managed` append-only `Handle` from a `FilePath`-appendonly :: FilePath -> Managed Handle-appendonly file = managed (Filesystem.withTextFile file IO.AppendMode)---- | Combine the output of multiple `Shell`s, in order-cat :: [Shell a] -> Shell a-cat = msum---- | Keep all lines that match the given `Pattern`-grep :: Pattern a -> Shell Text -> Shell Text-grep pattern s = do- txt <- s- _:_ <- return (match pattern txt)- return txt--{-| Replace all occurrences of a `Pattern` with its `Text` result-- Warning: Do not use a `Pattern` that matches the empty string, since it will- match an infinite number of times--}-sed :: Pattern Text -> Shell Text -> Shell Text-sed pattern s = do- let pattern' = fmap Text.concat- (many (pattern <|> fmap Text.singleton anyChar))- txt <- s- txt':_ <- return (match pattern' txt)- return txt'---- | Search a directory recursively for all files matching the given `Pattern`-find :: Pattern a -> FilePath -> Shell FilePath-find pattern dir = do- path <- lstree dir- Right txt <- return (Filesystem.toText path)- _:_ <- return (match pattern txt)- return path---- | A Stream of @\"y\"@s-yes :: Shell Text-yes = Shell (\(FoldM step begin _) -> do- x0 <- begin- let loop x = do- x' <- step x "y"- loop $! x'- loop $! x0 )---- | Limit a `Shell` to a fixed number of values-limit :: Int -> Shell a -> Shell a-limit n s = Shell (\(FoldM step begin done) -> do- ref <- newIORef 0 -- I feel so dirty- let step' x a = do- n' <- readIORef ref- writeIORef ref (n' + 1)- if n' < n then step x a else return x- foldIO s (FoldM step' begin done) )--{-| Limit a `Shell` to values that satisfy the predicate-- This terminates the stream on the first value that does not satisfy the- predicate--}-limitWhile :: (a -> Bool) -> Shell a -> Shell a-limitWhile predicate s = Shell (\(FoldM step begin done) -> do- ref <- newIORef True- let step' x a = do- b <- readIORef ref- let b' = b && predicate a- writeIORef ref b'- if b' then step x a else return x- foldIO s (FoldM step' begin done) )--{-| Cache a `Shell`'s output so that repeated runs of the script will reuse the- result of previous runs. You must supply a `FilePath` where the cached- result will be stored.-- The stored result is only reused if the `Shell` successfully ran to- completion without any exceptions. Note: on some platforms Ctrl-C will- flush standard input and signal end of file before killing the program,- which may trick the program into \"successfully\" completing.--}-cache :: (Read a, Show a) => FilePath -> Shell a -> Shell a-cache file s = do- let cached = do- txt <- input file- case reads (Text.unpack txt) of- [(ma, "")] -> return ma- _ ->- die (format ("cache: Invalid data stored in "%w) file)- exists <- testfile file- mas <- fold (if exists then cached else empty) list- case [ () | Nothing <- mas ] of- _:_ -> select [ a | Just a <- mas ]- _ -> do- handle <- using (writeonly file)- let justs = do- a <- s- liftIO (Text.hPutStrLn handle (Text.pack (show (Just a))))- return a- let nothing = do- let n = Nothing :: Maybe ()- liftIO (Text.hPutStrLn handle (Text.pack (show n)))- empty- justs <|> nothing---- | Get the current time-date :: MonadIO io => io UTCTime-date = liftIO getCurrentTime---- | Get the time a file was last modified-datefile :: MonadIO io => FilePath -> io UTCTime-datefile path = liftIO (Filesystem.getModified path)---- | Get the size of a file or a directory-du :: MonadIO io => FilePath -> io Size-du path = liftIO (fmap Size (Filesystem.getSize path))--{-| An abstract file size-- Specify the units you want by using an accessor like `kilobytes`-- The `Num` instance for `Size` interprets numeric literals as bytes--}-newtype Size = Size { _bytes :: Integer } deriving (Num)--instance Show Size where- show = show . _bytes---- | Extract a size in bytes-bytes :: Integral n => Size -> n-bytes = fromInteger . _bytes---- | @1 kilobyte = 1000 bytes@-kilobytes :: Integral n => Size -> n-kilobytes = (`div` 1000) . bytes---- | @1 megabyte = 1000 kilobytes@-megabytes :: Integral n => Size -> n-megabytes = (`div` 1000) . kilobytes---- | @1 gigabyte = 1000 megabytes@-gigabytes :: Integral n => Size -> n-gigabytes = (`div` 1000) . megabytes---- | @1 terabyte = 1000 gigabytes@-terabytes :: Integral n => Size -> n-terabytes = (`div` 1000) . gigabytes---- | @1 kibibyte = 1024 bytes@-kibibytes :: Integral n => Size -> n-kibibytes = (`div` 1024) . bytes---- | @1 mebibyte = 1024 kibibytes@-mebibytes :: Integral n => Size -> n-mebibytes = (`div` 1024) . kibibytes---- | @1 gibibyte = 1024 mebibytes@-gibibytes :: Integral n => Size -> n-gibibytes = (`div` 1024) . mebibytes---- | @1 tebibyte = 1024 gibibytes@-tebibytes :: Integral n => Size -> n-tebibytes = (`div` 1024) . gibibytes--{-| Count the number of characters in the stream (like @wc -c@)-- This uses the convention that the elements of the stream are implicitly- ended by newlines that are one character wide--}-countChars :: Integral n => Fold Text n-countChars = Control.Foldl.Text.length + charsPerNewline * countLines--charsPerNewline :: Num a => a-#ifdef mingw32_HOST_OS-charsPerNewline = 2-#else-charsPerNewline = 1-#endif---- | Count the number of words in the stream (like @wc -w@)-countWords :: Integral n => Fold Text n-countWords = premap Text.words (handles traverse genericLength)--{-| Count the number of lines in the stream (like @wc -l@)-- This uses the convention that each element of the stream represents one- line--}-countLines :: Integral n => Fold Text n-countLines = genericLength+{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | This module provides a large suite of utilities that resemble Unix +-- utilities. +-- +-- Many of these commands are just existing Haskell commands renamed to match +-- their Unix counterparts: +-- +-- >>> :set -XOverloadedStrings +-- >>> cd "/tmp" +-- >>> pwd +-- FilePath "/tmp" +-- +-- Some commands are `Shell`s that emit streams of values. `view` prints all +-- values in a `Shell` stream: +-- +-- >>> view (ls "/usr") +-- FilePath "/usr/lib" +-- FilePath "/usr/src" +-- FilePath "/usr/sbin" +-- FilePath "/usr/include" +-- FilePath "/usr/share" +-- FilePath "/usr/games" +-- FilePath "/usr/local" +-- FilePath "/usr/bin" +-- >>> view (find (suffix "Browser.py") "/usr/lib") +-- FilePath "/usr/lib/python3.4/idlelib/ClassBrowser.py" +-- FilePath "/usr/lib/python3.4/idlelib/RemoteObjectBrowser.py" +-- FilePath "/usr/lib/python3.4/idlelib/PathBrowser.py" +-- FilePath "/usr/lib/python3.4/idlelib/ObjectBrowser.py" +-- +-- Use `fold` to reduce the output of a `Shell` stream: +-- +-- >>> import qualified Control.Foldl as Fold +-- >>> fold (ls "/usr") Fold.length +-- 8 +-- >>> fold (find (suffix "Browser.py") "/usr/lib") Fold.head +-- Just (FilePath "/usr/lib/python3.4/idlelib/ClassBrowser.py") +-- +-- Create files using `output`: +-- +-- >>> output "foo.txt" ("123" <|> "456" <|> "ABC") +-- >>> realpath "foo.txt" +-- FilePath "/tmp/foo.txt" +-- +-- Read in files using `input`: +-- +-- >>> stdout (input "foo.txt") +-- 123 +-- 456 +-- ABC +-- +-- Format strings in a type safe way using `format`: +-- +-- >>> dir <- pwd +-- >>> format ("I am in the "%fp%" directory") dir +-- "I am in the /tmp directory" +-- +-- Commands like `grep`, `sed` and `find` accept arbitrary `Pattern`s +-- +-- >>> stdout (grep ("123" <|> "ABC") (input "foo.txt")) +-- 123 +-- ABC +-- >>> let exclaim = fmap (<> "!") (plus digit) +-- >>> stdout (sed exclaim (input "foo.txt")) +-- 123! +-- 456! +-- ABC +-- +-- Note that `grep` and `find` differ from their Unix counterparts by requiring +-- that the `Pattern` matches the entire line or file name by default. However, +-- you can optionally match the prefix, suffix, or interior of a line: +-- +-- >>> stdout (grep (has "2") (input "foo.txt")) +-- 123 +-- >>> stdout (grep (prefix "1") (input "foo.txt")) +-- 123 +-- >>> stdout (grep (suffix "3") (input "foo.txt")) +-- 123 +-- +-- You can also build up more sophisticated `Shell` programs using `sh` in +-- conjunction with @do@ notation: +-- +-- >{-# LANGUAGE OverloadedStrings #-} +-- > +-- >import Turtle +-- > +-- >main = sh example +-- > +-- >example = do +-- > -- Read in file names from "files1.txt" and "files2.txt" +-- > file <- fmap fromText (input "files1.txt" <|> input "files2.txt") +-- > +-- > -- Stream each file to standard output only if the file exists +-- > True <- liftIO (testfile file) +-- > line <- input file +-- > liftIO (echo line) +-- +-- See "Turtle.Tutorial" for an extended tutorial explaining how to use this +-- library in greater detail. + +module Turtle.Prelude ( + -- * IO + proc + , shell + , procStrict + , shellStrict + , echo + , err + , readline + , arguments +#if MIN_VERSION_base(4,7,0) + , export + , unset +#endif +#if MIN_VERSION_base(4,6,0) + , need +#endif + , env + , cd + , pwd + , home + , realpath + , mv + , mkdir + , mktree + , cp + , rm + , rmdir + , rmtree + , testfile + , testdir + , date + , datefile + , touch + , time + , hostname + , sleep + , exit + , die + , (.&&.) + , (.||.) + + -- * Managed + , readonly + , writeonly + , appendonly + , mktemp + , mktempfile + , mktempdir + , fork + , wait + + -- * Shell + , inproc + , inshell + , stdin + , input + , inhandle + , stdout + , output + , outhandle + , append + , stderr + , strict + , ls + , lsif + , lstree + , cat + , grep + , sed + , find + , yes + , nl + , paste + , endless + , limit + , limitWhile + , cache + + -- * Folds + , countChars + , countWords + , countLines + + -- * Text + , cut + + -- * Permissions + , Permissions + , chmod + , getmod + , setmod + , readable, nonreadable + , writable, nonwritable + , executable, nonexecutable + , searchable, nonsearchable + , ooo,roo,owo,oox,oos,rwo,rox,ros,owx,rwx,rws + + -- * File size + , du + , Size + , bytes + , kilobytes + , megabytes + , gigabytes + , terabytes + , kibibytes + , mebibytes + , gibibytes + , tebibytes + ) where + +import Control.Applicative +import Control.Concurrent (threadDelay) +import Control.Concurrent.Async (Async, withAsync, wait, concurrently) +import Control.Concurrent.MVar (newMVar, modifyMVar_) +import qualified Control.Concurrent.STM as STM +import Control.Exception (bracket, throwIO) +import Control.Foldl (Fold, FoldM(..), genericLength, handles, list, premap) +import qualified Control.Foldl.Text +import Control.Monad (liftM, msum, when, unless) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Managed (Managed, managed) +#ifdef mingw32_HOST_OS +import Data.Bits ((.&.)) +#endif +import Data.IORef (newIORef, readIORef, writeIORef) +import Data.Text (Text, pack, unpack) +import Data.Time (NominalDiffTime, UTCTime, getCurrentTime) +import Data.Traversable +import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import qualified Filesystem +import Filesystem.Path.CurrentOS (FilePath, (</>)) +import qualified Filesystem.Path.CurrentOS as Filesystem +import Network.HostName (getHostName) +import System.Clock (Clock(..), TimeSpec(..), getTime) +import System.Environment ( + getArgs, +#if MIN_VERSION_base(4,7,0) + setEnv, + unsetEnv, +#endif +#if MIN_VERSION_base(4,6,0) + lookupEnv, +#endif + getEnvironment ) +import System.Directory (Permissions) +import qualified System.Directory as Directory +import System.Exit (ExitCode(..), exitWith) +import System.IO (Handle, hClose) +import qualified System.IO as IO +import System.IO.Temp (withTempDirectory, withTempFile) +import qualified System.Process as Process +#ifdef mingw32_HOST_OS +import qualified System.Win32 as Win32 +#else +import System.Posix (openDirStream, readDirStream, closeDirStream, touchFile) +#endif +import Prelude hiding (FilePath) + +import Turtle.Pattern (Pattern, anyChar, chars, match, selfless, sepBy) +import Turtle.Shell +import Turtle.Format (format, w, (%)) + +{-| Run a command using @execvp@, retrieving the exit code + + The command inherits @stdout@ and @stderr@ for the current process +-} +proc + :: MonadIO io + => Text + -- ^ Command + -> [Text] + -- ^ Arguments + -> Shell Text + -- ^ Lines of standard input + -> io ExitCode + -- ^ Exit code +proc cmd args = system (Process.proc (unpack cmd) (map unpack args)) + +{-| Run a command line using the shell, retrieving the exit code + + This command is more powerful than `proc`, but highly vulnerable to code + injection if you template the command line with untrusted input + + The command inherits @stdout@ and @stderr@ for the current process +-} +shell + :: MonadIO io + => Text + -- ^ Command line + -> Shell Text + -- ^ Lines of standard input + -> io ExitCode + -- ^ Exit code +shell cmdLine = system (Process.shell (unpack cmdLine)) + +{-| Run a command using @execvp@, retrieving the exit code and stdout as a + non-lazy blob of Text + + The command inherits @stderr@ for the current process +-} +procStrict + :: MonadIO io + => Text + -- ^ Command + -> [Text] + -- ^ Arguments + -> Shell Text + -- ^ Lines of standard input + -> io (ExitCode, Text) + -- ^ Exit code and stdout +procStrict cmd args = + systemStrict (Process.proc (Text.unpack cmd) (map Text.unpack args)) + +{-| Run a command line using the shell, retrieving the exit code and stdout as a + non-lazy blob of Text + + This command is more powerful than `proc`, but highly vulnerable to code + injection if you template the command line with untrusted input + + The command inherits @stderr@ for the current process +-} +shellStrict + :: MonadIO io + => Text + -- ^ Command line + -> Shell Text + -- ^ Lines of standard input + -> io (ExitCode, Text) + -- ^ Exit code and stdout +shellStrict cmdLine = systemStrict (Process.shell (Text.unpack cmdLine)) + +system + :: MonadIO io + => Process.CreateProcess + -- ^ Command + -> Shell Text + -- ^ Lines of standard input + -> io ExitCode + -- ^ Exit code +system p s = liftIO (do + let p' = p + { Process.std_in = Process.CreatePipe + , Process.std_out = Process.Inherit + , Process.std_err = Process.Inherit + } + + let open = do + (Just hIn, Nothing, Nothing, ph) <- Process.createProcess p' + return (hIn, ph) + + -- Prevent double close + mvar <- newMVar False + let close handle = do + modifyMVar_ mvar (\finalized -> do + unless finalized (hClose handle) + return True ) + + bracket open (\(hIn, ph) -> close hIn >> Process.terminateProcess ph) (\(hIn, ph) -> do + let feedIn = do + sh (do + txt <- s + liftIO (Text.hPutStrLn hIn txt) ) + close hIn + withAsync feedIn (\a -> liftIO (Process.waitForProcess ph) <* wait a) ) ) + +systemStrict + :: MonadIO io + => Process.CreateProcess + -- ^ Command + -> Shell Text + -- ^ Lines of standard input + -> io (ExitCode, Text) + -- ^ Exit code and stdout +systemStrict p s = liftIO (do + let p' = p + { Process.std_in = Process.CreatePipe + , Process.std_out = Process.CreatePipe + , Process.std_err = Process.Inherit + } + + let open = do + (Just hIn, Just hOut, Nothing, ph) <- liftIO (Process.createProcess p') + return (hIn, hOut, ph) + + -- Prevent double close + mvar <- newMVar False + let close handle = do + modifyMVar_ mvar (\finalized -> do + unless finalized (hClose handle) + return True ) + + bracket open (\(hIn, _, ph) -> close hIn >> Process.terminateProcess ph) (\(hIn, hOut, ph) -> do + let feedIn = do + sh (do + txt <- s + liftIO (Text.hPutStrLn hIn txt) ) + close hIn + + concurrently + (withAsync feedIn (\a -> liftIO (Process.waitForProcess ph) <* wait a)) + (Text.hGetContents hOut) ) ) + +{-| Run a command using @execvp@, streaming @stdout@ as lines of `Text` + + The command inherits @stderr@ for the current process +-} +inproc + :: Text + -- ^ Command + -> [Text] + -- ^ Arguments + -> Shell Text + -- ^ Lines of standard input + -> Shell Text + -- ^ Lines of standard output +inproc cmd args = stream (Process.proc (unpack cmd) (map unpack args)) + +{-| Run a command line using the shell, streaming @stdout@ as lines of `Text` + + This command is more powerful than `inproc`, but highly vulnerable to code + injection if you template the command line with untrusted input + + The command inherits @stderr@ for the current process +-} +inshell + :: Text + -- ^ Command line + -> Shell Text + -- ^ Lines of standard input + -> Shell Text + -- ^ Lines of standard output +inshell cmd = stream (Process.shell (unpack cmd)) + +stream + :: Process.CreateProcess + -- ^ Command + -> Shell Text + -- ^ Lines of standard input + -> Shell Text + -- ^ Lines of standard output +stream p s = do + let p' = p + { Process.std_in = Process.CreatePipe + , Process.std_out = Process.CreatePipe + , Process.std_err = Process.Inherit + } + + let open = do + (Just hIn, Just hOut, Nothing, ph) <- liftIO (Process.createProcess p') + return (hIn, hOut, ph) + + -- Prevent double close + mvar <- liftIO (newMVar False) + let close handle = do + modifyMVar_ mvar (\finalized -> do + unless finalized (hClose handle) + return True ) + + (hIn, hOut, ph) <- using (managed (bracket open (\(hIn, _, ph) -> close hIn >> Process.terminateProcess ph))) + let feedIn = do + sh (do + txt <- s + liftIO (Text.hPutStrLn hIn txt) ) + close hIn + + a <- using (fork feedIn) + inhandle hOut <|> (liftIO (Process.waitForProcess ph *> wait a) *> empty) + +-- | Print to @stdout@ +echo :: MonadIO io => Text -> io () +echo txt = liftIO (Text.putStrLn txt) + +-- | Print to @stderr@ +err :: MonadIO io => Text -> io () +err txt = liftIO (Text.hPutStrLn IO.stderr txt) + +{-| Read in a line from @stdin@ + + Returns `Nothing` if at end of input +-} +readline :: MonadIO io => io (Maybe Text) +readline = liftIO (do + eof <- IO.isEOF + if eof + then return Nothing + else fmap (Just . pack) getLine ) + +-- | Get command line arguments in a list +arguments :: MonadIO io => io [Text] +arguments = liftIO (fmap (map pack) getArgs) + +#if MIN_VERSION_base(4,7,0) +-- | Set or modify an environment variable +export :: MonadIO io => Text -> Text -> io () +export key val = liftIO (setEnv (unpack key) (unpack val)) + +-- | Delete an environment variable +unset :: MonadIO io => Text -> io () +unset key = liftIO (unsetEnv (unpack key)) +#endif + +#if MIN_VERSION_base(4,6,0) +-- | Look up an environment variable +need :: MonadIO io => Text -> io (Maybe Text) +need key = liftIO (fmap (fmap pack) (lookupEnv (unpack key))) +#endif + +-- | Retrieve all environment variables +env :: MonadIO io => io [(Text, Text)] +env = liftIO (fmap (fmap toTexts) getEnvironment) + where + toTexts (key, val) = (pack key, pack val) + +-- | Change the current directory +cd :: MonadIO io => FilePath -> io () +cd path = liftIO (Filesystem.setWorkingDirectory path) + +-- | Get the current directory +pwd :: MonadIO io => io FilePath +pwd = liftIO Filesystem.getWorkingDirectory + +-- | Get the home directory +home :: MonadIO io => io FilePath +home = liftIO Filesystem.getHomeDirectory + +-- | Canonicalize a path +realpath :: MonadIO io => FilePath -> io FilePath +realpath path = liftIO (Filesystem.canonicalizePath path) + +#ifdef mingw32_HOST_OS +fILE_ATTRIBUTE_REPARSE_POINT :: Win32.FileAttributeOrFlag +fILE_ATTRIBUTE_REPARSE_POINT = 1024 + +reparsePoint :: Win32.FileAttributeOrFlag -> Bool +reparsePoint attr = fILE_ATTRIBUTE_REPARSE_POINT .&. attr /= 0 +#endif + +{-| Stream all immediate children of the given directory, excluding @\".\"@ and + @\"..\"@ +-} +ls :: FilePath -> Shell FilePath +ls path = Shell (\(FoldM step begin done) -> do + x0 <- begin + let path' = Filesystem.encodeString path + canRead <- fmap + Directory.readable + (Directory.getPermissions (deslash path')) +#ifdef mingw32_HOST_OS + reparse <- fmap reparsePoint (Win32.getFileAttributes path') + if (canRead && not reparse) + then bracket + (Win32.findFirstFile (Filesystem.encodeString (path </> "*"))) + (\(h, _) -> Win32.findClose h) + (\(h, fdat) -> do + let loop x = do + file' <- Win32.getFindDataFileName fdat + let file = Filesystem.decodeString file' + x' <- if (file' /= "." && file' /= "..") + then step x (path </> file) + else return x + more <- Win32.findNextFile h fdat + if more then loop $! x' else done x' + loop $! x0 ) + else done x0 ) +#else + if canRead + then bracket (openDirStream path') closeDirStream (\dirp -> do + let loop x = do + file' <- readDirStream dirp + case file' of + "" -> done x + _ -> do + let file = Filesystem.decodeString file' + x' <- if (file' /= "." && file' /= "..") + then step x (path </> file) + else return x + loop $! x' + loop $! x0 ) + else done x0 ) +#endif + +{-| This is used to remove the trailing slash from a path, because + `getPermissions` will fail if a path ends with a trailing slash +-} +deslash :: String -> String +deslash [] = [] +deslash (c0:cs0) = c0:go cs0 + where + go [] = [] + go ['\\'] = [] + go (c:cs) = c:go cs + +-- | Stream all recursive descendents of the given directory +lstree :: FilePath -> Shell FilePath +lstree path = do + child <- ls path + isDir <- liftIO (testdir child) + if isDir + then return child <|> lstree child + else return child + +{-| Stream all recursive descendents of the given directory + + This skips any directories that fail the supplied predicate + +> lstree = lsif (\_ -> return True) +-} +lsif :: (FilePath -> IO Bool) -> FilePath -> Shell FilePath +lsif predicate path = do + child <- ls path + isDir <- liftIO (testdir child) + if isDir + then do + continue <- liftIO (predicate child) + if continue + then return child <|> lsif predicate child + else return child + else return child + +-- | Move a file or directory +mv :: MonadIO io => FilePath -> FilePath -> io () +mv oldPath newPath = liftIO (Filesystem.rename oldPath newPath) + +{-| Create a directory + + Fails if the directory is present +-} +mkdir :: MonadIO io => FilePath -> io () +mkdir path = liftIO (Filesystem.createDirectory False path) + +{-| Create a directory tree (equivalent to @mkdir -p@) + + Does not fail if the directory is present +-} +mktree :: MonadIO io => FilePath -> io () +mktree path = liftIO (Filesystem.createTree path) + +-- | Copy a file +cp :: MonadIO io => FilePath -> FilePath -> io () +cp oldPath newPath = liftIO (Filesystem.copyFile oldPath newPath) + +-- | Remove a file +rm :: MonadIO io => FilePath -> io () +rm path = liftIO (Filesystem.removeFile path) + +-- | Remove a directory +rmdir :: MonadIO io => FilePath -> io () +rmdir path = liftIO (Filesystem.removeDirectory path) + +{-| Remove a directory tree (equivalent to @rm -r@) + + Use at your own risk +-} +rmtree :: MonadIO io => FilePath -> io () +rmtree path = liftIO (Filesystem.removeTree path) + +-- | Check if a file exists +testfile :: MonadIO io => FilePath -> io Bool +testfile path = liftIO (Filesystem.isFile path) + +-- | Check if a directory exists +testdir :: MonadIO io => FilePath -> io Bool +testdir path = liftIO (Filesystem.isDirectory path) + +{-| Touch a file, updating the access and modification times to the current time + + Creates an empty file if it does not exist +-} +touch :: MonadIO io => FilePath -> io () +touch file = do + exists <- testfile file + liftIO (if exists +#ifdef mingw32_HOST_OS + then do + handle <- Win32.createFile + (Filesystem.encodeString file) + Win32.gENERIC_WRITE + Win32.fILE_SHARE_NONE + Nothing + Win32.oPEN_EXISTING + Win32.fILE_ATTRIBUTE_NORMAL + Nothing + (creationTime, _, _) <- Win32.getFileTime handle + systemTime <- Win32.getSystemTimeAsFileTime + Win32.setFileTime handle creationTime systemTime systemTime +#else + then touchFile (Filesystem.encodeString file) +#endif + else output file empty ) + +{-| Update a file or directory's user permissions + +> chmod rwo "foo.txt" -- chmod u=rw foo.txt +> chmod executable "foo.txt" -- chmod u+x foo.txt +> chmod nonwritable "foo.txt" -- chmod u-x foo.txt +-} +chmod + :: MonadIO io + => (Permissions -> Permissions) + -- ^ Permissions update function + -> FilePath + -- ^ Path + -> io Permissions + -- ^ Updated permissions +chmod modifyPermissions path = liftIO (do + let path' = deslash (Filesystem.encodeString path) + permissions <- Directory.getPermissions path' + let permissions' = modifyPermissions permissions + changed = permissions /= permissions' + when changed (Directory.setPermissions path' permissions') + return permissions' ) + +-- | Get a file or directory's user permissions +getmod :: MonadIO io => FilePath -> io Permissions +getmod path = liftIO (do + let path' = deslash (Filesystem.encodeString path) + Directory.getPermissions path' ) + +-- | Set a file or directory's user permissions +setmod :: MonadIO io => Permissions -> FilePath -> io () +setmod permissions path = liftIO (do + let path' = deslash (Filesystem.encodeString path) + Directory.setPermissions path' permissions ) + +-- | @+r@ +readable :: Permissions -> Permissions +readable = Directory.setOwnerReadable True + +-- | @-r@ +nonreadable :: Permissions -> Permissions +nonreadable = Directory.setOwnerReadable False + +-- | @+w@ +writable :: Permissions -> Permissions +writable = Directory.setOwnerWritable True + +-- | @-w@ +nonwritable :: Permissions -> Permissions +nonwritable = Directory.setOwnerWritable False + +-- | @+x@ +executable :: Permissions -> Permissions +executable = Directory.setOwnerExecutable True + +-- | @-x@ +nonexecutable :: Permissions -> Permissions +nonexecutable = Directory.setOwnerExecutable False + +-- | @+s@ +searchable :: Permissions -> Permissions +searchable = Directory.setOwnerSearchable True + +-- | @-s@ +nonsearchable :: Permissions -> Permissions +nonsearchable = Directory.setOwnerSearchable False + +-- | @-r -w -x@ +ooo :: Permissions -> Permissions +ooo = const Directory.emptyPermissions + +-- | @+r -w -x@ +roo :: Permissions -> Permissions +roo = readable . ooo + +-- | @-r +w -x@ +owo :: Permissions -> Permissions +owo = writable . ooo + +-- | @-r -w +x@ +oox :: Permissions -> Permissions +oox = executable . ooo + +-- | @-r -w +s@ +oos :: Permissions -> Permissions +oos = searchable . ooo + +-- | @+r +w -x@ +rwo :: Permissions -> Permissions +rwo = readable . writable . ooo + +-- | @+r -w +x@ +rox :: Permissions -> Permissions +rox = readable . executable . ooo + +-- | @+r -w +s@ +ros :: Permissions -> Permissions +ros = readable . searchable . ooo + +-- | @-r +w +x@ +owx :: Permissions -> Permissions +owx = writable . executable . ooo + +-- | @+r +w +x@ +rwx :: Permissions -> Permissions +rwx = readable . writable . executable . ooo + +-- | @+r +w +s@ +rws :: Permissions -> Permissions +rws = readable . writable . searchable . ooo + +{-| Time how long a command takes in monotonic wall clock time + + Returns the duration alongside the return value +-} +time :: MonadIO io => io a -> io (a, NominalDiffTime) +time io = do + TimeSpec seconds1 nanoseconds1 <- liftIO (getTime Monotonic) + a <- io + TimeSpec seconds2 nanoseconds2 <- liftIO (getTime Monotonic) + let t = fromIntegral ( seconds2 - seconds1) + + fromIntegral (nanoseconds2 - nanoseconds1) / 10^(9::Int) + return (a, fromRational t) + +-- | Get the system's host name +hostname :: MonadIO io => io Text +hostname = liftIO (fmap Text.pack getHostName) + +{-| Sleep for the given duration + + A numeric literal argument is interpreted as seconds. In other words, + @(sleep 2.0)@ will sleep for two seconds. +-} +sleep :: MonadIO io => NominalDiffTime -> io () +sleep n = liftIO (threadDelay (truncate (n * 10^(6::Int)))) + +{-| Exit with the given exit code + + An exit code of @0@ indicates success +-} +exit :: MonadIO io => ExitCode -> io a +exit code = liftIO (exitWith code) + +-- | Throw an exception using the provided `Text` message +die :: MonadIO io => Text -> io a +die txt = liftIO (throwIO (userError (unpack txt))) + +infixr 2 .&&., .||. + +{-| Analogous to `&&` in Bash + + Runs the second command only if the first one returns `ExitSuccess` +-} +(.&&.) :: Monad m => m ExitCode -> m ExitCode -> m 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` +-} +(.||.) :: Monad m => m ExitCode -> m ExitCode -> m 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 +-} +mktempdir + :: FilePath + -- ^ Parent directory + -> Text + -- ^ Directory name template + -> Managed FilePath +mktempdir parent prefix = do + let parent' = Filesystem.encodeString parent + let prefix' = unpack prefix + dir' <- managed (withTempDirectory parent' prefix') + return (Filesystem.decodeString dir') + +{-| Create a temporary file underneath the given directory + + Deletes the temporary file when done + + Note that this provides the `Handle` of the file in order to avoid a + potential race condition from the file being moved or deleted before you + have a chance to open the file. The `mktempfile` function provides a + simpler API if you don't need to worry about that possibility. +-} +mktemp + :: FilePath + -- ^ Parent directory + -> Text + -- ^ File name template + -> Managed (FilePath, Handle) +mktemp parent prefix = do + let parent' = Filesystem.encodeString parent + let prefix' = unpack prefix + (file', handle) <- managed (\k -> + withTempFile parent' prefix' (\file' handle -> k (file', handle)) ) + return (Filesystem.decodeString file', handle) + +{-| Create a temporary file underneath the given directory + + Deletes the temporary file when done +-} +mktempfile + :: FilePath + -- ^ Parent directory + -> Text + -- ^ File name template + -> Managed FilePath +mktempfile parent prefix = do + let parent' = Filesystem.encodeString parent + let prefix' = unpack prefix + (file', handle) <- managed (\k -> + withTempFile parent' prefix' (\file' handle -> k (file', handle)) ) + liftIO (hClose handle) + return (Filesystem.decodeString file') + +-- | Fork a thread, acquiring an `Async` value +fork :: IO a -> Managed (Async a) +fork io = managed (withAsync io) + +-- | Read lines of `Text` from standard input +stdin :: Shell Text +stdin = inhandle IO.stdin + +-- | Read lines of `Text` from a file +input :: FilePath -> Shell Text +input file = do + handle <- using (readonly file) + inhandle handle + +-- | Read lines of `Text` from a `Handle` +inhandle :: Handle -> Shell Text +inhandle handle = Shell (\(FoldM step begin done) -> do + x0 <- begin + let loop x = do + eof <- IO.hIsEOF handle + if eof + then done x + else do + txt <- Text.hGetLine handle + x' <- step x txt + loop $! x' + loop $! x0 ) + +-- | Stream lines of `Text` to standard output +stdout :: MonadIO io => Shell Text -> io () +stdout s = sh (do + txt <- s + liftIO (echo txt) ) + +-- | Stream lines of `Text` to a file +output :: MonadIO io => FilePath -> Shell Text -> io () +output file s = sh (do + handle <- using (writeonly file) + txt <- s + liftIO (Text.hPutStrLn handle txt) ) + +-- | Stream lines of `Text` to a `Handle` +outhandle :: MonadIO io => Handle -> Shell Text -> io () +outhandle handle s = sh (do + txt <- s + liftIO (Text.hPutStrLn handle txt) ) + +-- | Stream lines of `Text` to append to a file +append :: MonadIO io => FilePath -> Shell Text -> io () +append file s = sh (do + handle <- using (appendonly file) + txt <- s + liftIO (Text.hPutStrLn handle txt) ) + +-- | Stream lines of `Text` to standard error +stderr :: MonadIO io => Shell Text -> io () +stderr s = sh (do + txt <- s + liftIO (err txt) ) + +-- | Read in a stream's contents strictly +strict :: MonadIO io => Shell Text -> io Text +strict s = liftM Text.unlines (fold s list) + +-- | Acquire a `Managed` read-only `Handle` from a `FilePath` +readonly :: FilePath -> Managed Handle +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.withTextFile file IO.WriteMode) + +-- | Acquire a `Managed` append-only `Handle` from a `FilePath` +appendonly :: FilePath -> Managed Handle +appendonly file = managed (Filesystem.withTextFile file IO.AppendMode) + +-- | Combine the output of multiple `Shell`s, in order +cat :: [Shell a] -> Shell a +cat = msum + +-- | Keep all lines that match the given `Pattern` +grep :: Pattern a -> Shell Text -> Shell Text +grep pattern s = do + txt <- s + _:_ <- return (match pattern txt) + return txt + +{-| Replace all occurrences of a `Pattern` with its `Text` result + + `sed` performs substitution on a line-by-line basis, meaning that + substitutions may not span multiple lines. Additionally, substitutions may + occur multiple times within the same line, like the behavior of + @s/.../.../g@. + + Warning: Do not use a `Pattern` that matches the empty string, since it will + match an infinite number of times. `sed` tries to detect such `Pattern`s + and `die` with an error message if they occur, but this detection is + necessarily incomplete. +-} +sed :: Pattern Text -> Shell Text -> Shell Text +sed pattern s = do + when (matchesEmpty pattern) (die message) + let pattern' = fmap Text.concat + (many (pattern <|> fmap Text.singleton anyChar)) + txt <- s + txt':_ <- return (match pattern' txt) + return txt' + where + message = "sed: the given pattern matches the empty string" + matchesEmpty = not . null . flip match "" + +-- | Search a directory recursively for all files matching the given `Pattern` +find :: Pattern a -> FilePath -> Shell FilePath +find pattern dir = do + path <- lstree dir + Right txt <- return (Filesystem.toText path) + _:_ <- return (match pattern txt) + return path + +-- | A Stream of @\"y\"@s +yes :: Shell Text +yes = fmap (\_ -> "y") endless + +-- | Number each element of a `Shell` (starting at 0) +nl :: Num n => Shell a -> Shell (n, a) +nl s = Shell _foldIO' + where + _foldIO' (FoldM step begin done) = _foldIO s (FoldM step' begin' done') + where + step' (x, n) a = do + x' <- step x (n, a) + let n' = n + 1 + n' `seq` return (x', n') + begin' = do + x0 <- begin + return (x0, 0) + done' (x, _) = done x + +data ZipState a b = Empty | HasA a | HasAB a b | Done + +{-| Merge two `Shell`s together, element-wise + + If one `Shell` is longer than the other, the excess elements are + truncated +-} +paste :: Shell a -> Shell b -> Shell (a, b) +paste sA sB = Shell _foldIOAB + where + _foldIOAB (FoldM stepAB beginAB doneAB) = do + x0 <- beginAB + + tvar <- STM.atomically (STM.newTVar Empty) + + let begin = return () + + let stepA () a = STM.atomically (do + x <- STM.readTVar tvar + case x of + Empty -> STM.writeTVar tvar (HasA a) + Done -> return () + _ -> STM.retry ) + let doneA () = STM.atomically (do + x <- STM.readTVar tvar + case x of + Empty -> STM.writeTVar tvar Done + Done -> return () + _ -> STM.retry ) + let foldA = FoldM stepA begin doneA + + let stepB () b = STM.atomically (do + x <- STM.readTVar tvar + case x of + HasA a -> STM.writeTVar tvar (HasAB a b) + Done -> return () + _ -> STM.retry ) + let doneB () = STM.atomically (do + x <- STM.readTVar tvar + case x of + HasA _ -> STM.writeTVar tvar Done + Done -> return () + _ -> STM.retry ) + let foldB = FoldM stepB begin doneB + + withAsync (foldIO sA foldA) (\asyncA -> do + withAsync (foldIO sB foldB) (\asyncB -> do + let loop x = do + y <- STM.atomically (do + z <- STM.readTVar tvar + case z of + HasAB a b -> do + STM.writeTVar tvar Empty + return (Just (a, b)) + Done -> return Nothing + _ -> STM.retry ) + case y of + Nothing -> return x + Just ab -> do + x' <- stepAB x ab + loop $! x' + x' <- loop $! x0 + wait asyncA + wait asyncB + doneAB x' ) ) + +-- | A `Shell` that endlessly emits @()@ +endless :: Shell () +endless = Shell (\(FoldM step begin _) -> do + x0 <- begin + let loop x = do + x' <- step x () + loop $! x' + loop $! x0 ) + +-- | Limit a `Shell` to a fixed number of values +limit :: Int -> Shell a -> Shell a +limit n s = Shell (\(FoldM step begin done) -> do + ref <- newIORef 0 -- I feel so dirty + let step' x a = do + n' <- readIORef ref + writeIORef ref (n' + 1) + if n' < n then step x a else return x + foldIO s (FoldM step' begin done) ) + +{-| Limit a `Shell` to values that satisfy the predicate + + This terminates the stream on the first value that does not satisfy the + predicate +-} +limitWhile :: (a -> Bool) -> Shell a -> Shell a +limitWhile predicate s = Shell (\(FoldM step begin done) -> do + ref <- newIORef True + let step' x a = do + b <- readIORef ref + let b' = b && predicate a + writeIORef ref b' + if b' then step x a else return x + foldIO s (FoldM step' begin done) ) + +{-| Cache a `Shell`'s output so that repeated runs of the script will reuse the + result of previous runs. You must supply a `FilePath` where the cached + result will be stored. + + The stored result is only reused if the `Shell` successfully ran to + completion without any exceptions. Note: on some platforms Ctrl-C will + flush standard input and signal end of file before killing the program, + which may trick the program into \"successfully\" completing. +-} +cache :: (Read a, Show a) => FilePath -> Shell a -> Shell a +cache file s = do + let cached = do + txt <- input file + case reads (Text.unpack txt) of + [(ma, "")] -> return ma + _ -> + die (format ("cache: Invalid data stored in "%w) file) + exists <- testfile file + mas <- fold (if exists then cached else empty) list + case [ () | Nothing <- mas ] of + _:_ -> select [ a | Just a <- mas ] + _ -> do + handle <- using (writeonly file) + let justs = do + a <- s + liftIO (Text.hPutStrLn handle (Text.pack (show (Just a)))) + return a + let nothing = do + let n = Nothing :: Maybe () + liftIO (Text.hPutStrLn handle (Text.pack (show n))) + empty + justs <|> nothing + +-- | Split a line into chunks delimited by the given `Pattern` +cut :: Pattern a -> Text -> [Text] +cut pattern txt = head (match (selfless chars `sepBy` pattern) txt) +-- This `head` should be safe ... in theory + +-- | Get the current time +date :: MonadIO io => io UTCTime +date = liftIO getCurrentTime + +-- | Get the time a file was last modified +datefile :: MonadIO io => FilePath -> io UTCTime +datefile path = liftIO (Filesystem.getModified path) + +-- | Get the size of a file or a directory +du :: MonadIO io => FilePath -> io Size +du path = liftIO (fmap Size (Filesystem.getSize path)) + +{-| An abstract file size + + Specify the units you want by using an accessor like `kilobytes` + + The `Num` instance for `Size` interprets numeric literals as bytes +-} +newtype Size = Size { _bytes :: Integer } deriving (Num) + +instance Show Size where + show = show . _bytes + +-- | Extract a size in bytes +bytes :: Integral n => Size -> n +bytes = fromInteger . _bytes + +-- | @1 kilobyte = 1000 bytes@ +kilobytes :: Integral n => Size -> n +kilobytes = (`div` 1000) . bytes + +-- | @1 megabyte = 1000 kilobytes@ +megabytes :: Integral n => Size -> n +megabytes = (`div` 1000) . kilobytes + +-- | @1 gigabyte = 1000 megabytes@ +gigabytes :: Integral n => Size -> n +gigabytes = (`div` 1000) . megabytes + +-- | @1 terabyte = 1000 gigabytes@ +terabytes :: Integral n => Size -> n +terabytes = (`div` 1000) . gigabytes + +-- | @1 kibibyte = 1024 bytes@ +kibibytes :: Integral n => Size -> n +kibibytes = (`div` 1024) . bytes + +-- | @1 mebibyte = 1024 kibibytes@ +mebibytes :: Integral n => Size -> n +mebibytes = (`div` 1024) . kibibytes + +-- | @1 gibibyte = 1024 mebibytes@ +gibibytes :: Integral n => Size -> n +gibibytes = (`div` 1024) . mebibytes + +-- | @1 tebibyte = 1024 gibibytes@ +tebibytes :: Integral n => Size -> n +tebibytes = (`div` 1024) . gibibytes + +{-| Count the number of characters in the stream (like @wc -c@) + + This uses the convention that the elements of the stream are implicitly + ended by newlines that are one character wide +-} +countChars :: Integral n => Fold Text n +countChars = Control.Foldl.Text.length + charsPerNewline * countLines + +charsPerNewline :: Num a => a +#ifdef mingw32_HOST_OS +charsPerNewline = 2 +#else +charsPerNewline = 1 +#endif + +-- | Count the number of words in the stream (like @wc -w@) +countWords :: Integral n => Fold Text n +countWords = premap Text.words (handles traverse genericLength) + +{-| Count the number of lines in the stream (like @wc -l@) + + This uses the convention that each element of the stream represents one + line +-} +countLines :: Integral n => Fold Text n +countLines = genericLength
src/Turtle/Shell.hs view
@@ -1,173 +1,174 @@-{-# LANGUAGE RankNTypes #-}-{-# OPTIONS_GHC -fno-warn-missing-methods #-}--{-| You can think of `Shell` as @[]@ + `IO` + `Managed`. In fact, you can embed- all three of them within a `Shell`:--> select :: [a] -> Shell a-> liftIO :: IO a -> Shell a-> using :: Managed a -> Shell a-- Those three embeddings obey these laws:--> do { x <- select m; select (f x) } = select (do { x <- m; f x })-> do { x <- liftIO m; liftIO (f x) } = liftIO (do { x <- m; f x })-> do { x <- with m; using (f x) } = using (do { x <- m; f x })->-> select (return x) = return x-> liftIO (return x) = return x-> using (return x) = return x-- ... and `select` obeys these additional laws:--> select xs <|> select ys = select (xs <|> ys)-> select empty = empty-- You typically won't build `Shell`s using the `Shell` constructor. Instead,- use these functions to generate primitive `Shell`s:-- * `empty`, to create a `Shell` that outputs nothing-- * `return`, to create a `Shell` that outputs a single value-- * `select`, to range over a list of values within a `Shell`-- * `liftIO`, to embed an `IO` action within a `Shell`-- * `using`, to acquire a `Managed` resource within a `Shell`- - Then use these classes to combine those primitive `Shell`s into larger- `Shell`s:-- * `Alternative`, to concatenate `Shell` outputs using (`<|>`)-- * `Monad`, to build `Shell` comprehensions using @do@ notation-- If you still insist on building your own `Shell` from scratch, then the- `Shell` you build must satisfy this law:--> -- For every shell `s`:-> _foldIO s (FoldM step begin done) = do-> x <- begin-> x' <- _foldIO s (FoldM step (return x) return)-> done x'-- ... which is a fancy way of saying that your `Shell` must call @\'begin\'@- exactly once when it begins and call @\'done\'@ exactly once when it ends.--}--module Turtle.Shell (- -- * Shell- Shell(..)- , foldIO- , fold- , sh- , view-- -- * Embeddings- , select- , liftIO- , using- ) where--import Control.Applicative (Applicative(..), Alternative(..), liftA2)-import Control.Monad (MonadPlus(..), ap)-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Managed (Managed, with)-import Control.Foldl (Fold(..), FoldM(..))-import qualified Control.Foldl as Foldl-import Data.Monoid (Monoid(..), (<>))-import Data.String (IsString(..))---- | A @(Shell a)@ is a protected stream of @a@'s with side effects-newtype Shell a = Shell { _foldIO :: forall r . FoldM IO a r -> IO r }---- | Use a @`FoldM` `IO`@ to reduce the stream of @a@'s produced by a `Shell`-foldIO :: MonadIO io => Shell a -> FoldM IO a r -> io r-foldIO s f = liftIO (_foldIO s f)---- | Use a `Fold` to reduce the stream of @a@'s produced by a `Shell`-fold :: MonadIO io => Shell a -> Fold a b -> io b-fold s f = foldIO s (Foldl.generalize f)---- | Run a `Shell` to completion, discarding any unused values-sh :: MonadIO io => Shell a -> io ()-sh s = fold s (pure ())---- | Run a `Shell` to completion, `print`ing any unused values-view :: (MonadIO io, Show a) => Shell a -> io ()-view s = sh (do- x <- s- liftIO (print x) )--instance Functor Shell where- fmap f s = Shell (\(FoldM step begin done) ->- let step' x a = step x (f a)- in _foldIO s (FoldM step' begin done) )--instance Applicative Shell where- pure = return- (<*>) = ap--instance Monad Shell where- return a = Shell (\(FoldM step begin done) -> do- x <- begin- x' <- step x a- done x' )-- m >>= f = Shell (\(FoldM step0 begin0 done0) -> do- let step1 x a = _foldIO (f a) (FoldM step0 (return x) return)- _foldIO m (FoldM step1 begin0 done0) )-- fail _ = mzero--instance Alternative Shell where- empty = Shell (\(FoldM _ begin done) -> do- x <- begin- done x )-- s1 <|> s2 = Shell (\(FoldM step begin done) -> do- x <- _foldIO s1 (FoldM step begin return)- _foldIO s2 (FoldM step (return x) done) )--instance MonadPlus Shell where- mzero = empty-- mplus = (<|>)--instance MonadIO Shell where- liftIO io = Shell (\(FoldM step begin done) -> do- x <- begin- a <- io- x' <- step x a- done x' )--instance Monoid a => Monoid (Shell a) where- mempty = pure mempty- mappend = liftA2 mappend---- | Shell forms a semiring, this is the closest approximation-instance Monoid a => Num (Shell a) where- fromInteger n = select (replicate (fromInteger n) mempty)-- (+) = (<|>)- (*) = (<>)--instance IsString a => IsString (Shell a) where- fromString str = pure (fromString str)---- | Convert a list to a `Shell` that emits each element of the list-select :: [a] -> Shell a-select as = Shell (\(FoldM step begin done) -> do- x0 <- begin- let step' a k x = do- x' <- step x a- k $! x'- foldr step' done as $! x0 )---- | Acquire a `Managed` resource within a `Shell` in an exception-safe way-using :: Managed a -> Shell a-using resource = Shell (\(FoldM step begin done) -> do- x <- begin- x' <- with resource (step x)- done x' )+{-# LANGUAGE RankNTypes #-} +{-# OPTIONS_GHC -fno-warn-missing-methods #-} + +{-| You can think of `Shell` as @[]@ + `IO` + `Managed`. In fact, you can embed + all three of them within a `Shell`: + +> select :: [a] -> Shell a +> liftIO :: IO a -> Shell a +> using :: Managed a -> Shell a + + Those three embeddings obey these laws: + +> do { x <- select m; select (f x) } = select (do { x <- m; f x }) +> do { x <- liftIO m; liftIO (f x) } = liftIO (do { x <- m; f x }) +> do { x <- with m; using (f x) } = using (do { x <- m; f x }) +> +> select (return x) = return x +> liftIO (return x) = return x +> using (return x) = return x + + ... and `select` obeys these additional laws: + +> select xs <|> select ys = select (xs <|> ys) +> select empty = empty + + You typically won't build `Shell`s using the `Shell` constructor. Instead, + use these functions to generate primitive `Shell`s: + + * `empty`, to create a `Shell` that outputs nothing + + * `return`, to create a `Shell` that outputs a single value + + * `select`, to range over a list of values within a `Shell` + + * `liftIO`, to embed an `IO` action within a `Shell` + + * `using`, to acquire a `Managed` resource within a `Shell` + + Then use these classes to combine those primitive `Shell`s into larger + `Shell`s: + + * `Alternative`, to concatenate `Shell` outputs using (`<|>`) + + * `Monad`, to build `Shell` comprehensions using @do@ notation + + If you still insist on building your own `Shell` from scratch, then the + `Shell` you build must satisfy this law: + +> -- For every shell `s`: +> _foldIO s (FoldM step begin done) = do +> x <- begin +> x' <- _foldIO s (FoldM step (return x) return) +> done x' + + ... which is a fancy way of saying that your `Shell` must call @\'begin\'@ + exactly once when it begins and call @\'done\'@ exactly once when it ends. +-} + +module Turtle.Shell ( + -- * Shell + Shell(..) + , foldIO + , fold + , sh + , view + + -- * Embeddings + , select + , liftIO + , using + ) where + +import Control.Applicative +import Control.Monad (MonadPlus(..), ap) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Managed (Managed, with) +import Control.Foldl (Fold(..), FoldM(..)) +import qualified Control.Foldl as Foldl +import Data.Monoid +import Data.String (IsString(..)) +import Prelude -- Fix redundant import warnings + +-- | A @(Shell a)@ is a protected stream of @a@'s with side effects +newtype Shell a = Shell { _foldIO :: forall r . FoldM IO a r -> IO r } + +-- | Use a @`FoldM` `IO`@ to reduce the stream of @a@'s produced by a `Shell` +foldIO :: MonadIO io => Shell a -> FoldM IO a r -> io r +foldIO s f = liftIO (_foldIO s f) + +-- | Use a `Fold` to reduce the stream of @a@'s produced by a `Shell` +fold :: MonadIO io => Shell a -> Fold a b -> io b +fold s f = foldIO s (Foldl.generalize f) + +-- | Run a `Shell` to completion, discarding any unused values +sh :: MonadIO io => Shell a -> io () +sh s = fold s (pure ()) + +-- | Run a `Shell` to completion, `print`ing any unused values +view :: (MonadIO io, Show a) => Shell a -> io () +view s = sh (do + x <- s + liftIO (print x) ) + +instance Functor Shell where + fmap f s = Shell (\(FoldM step begin done) -> + let step' x a = step x (f a) + in _foldIO s (FoldM step' begin done) ) + +instance Applicative Shell where + pure = return + (<*>) = ap + +instance Monad Shell where + return a = Shell (\(FoldM step begin done) -> do + x <- begin + x' <- step x a + done x' ) + + m >>= f = Shell (\(FoldM step0 begin0 done0) -> do + let step1 x a = _foldIO (f a) (FoldM step0 (return x) return) + _foldIO m (FoldM step1 begin0 done0) ) + + fail _ = mzero + +instance Alternative Shell where + empty = Shell (\(FoldM _ begin done) -> do + x <- begin + done x ) + + s1 <|> s2 = Shell (\(FoldM step begin done) -> do + x <- _foldIO s1 (FoldM step begin return) + _foldIO s2 (FoldM step (return x) done) ) + +instance MonadPlus Shell where + mzero = empty + + mplus = (<|>) + +instance MonadIO Shell where + liftIO io = Shell (\(FoldM step begin done) -> do + x <- begin + a <- io + x' <- step x a + done x' ) + +instance Monoid a => Monoid (Shell a) where + mempty = pure mempty + mappend = liftA2 mappend + +-- | Shell forms a semiring, this is the closest approximation +instance Monoid a => Num (Shell a) where + fromInteger n = select (replicate (fromInteger n) mempty) + + (+) = (<|>) + (*) = (<>) + +instance IsString a => IsString (Shell a) where + fromString str = pure (fromString str) + +-- | Convert a list to a `Shell` that emits each element of the list +select :: [a] -> Shell a +select as = Shell (\(FoldM step begin done) -> do + x0 <- begin + let step' a k x = do + x' <- step x a + k $! x' + foldr step' done as $! x0 ) + +-- | Acquire a `Managed` resource within a `Shell` in an exception-safe way +using :: Managed a -> Shell a +using resource = Shell (\(FoldM step begin done) -> do + x <- begin + x' <- with resource (step x) + done x' )
src/Turtle/Tutorial.hs view
@@ -1,1604 +1,1616 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--{-| Use @turtle@ if you want to write light-weight and maintainable shell- scripts.-- @turtle@ embeds shell scripting directly within Haskell for three main- reasons:-- * Haskell code is easy to refactor and maintain because the language is- statically typed-- * Haskell is syntactically lightweight, thanks to global type inference-- * Haskell programs can be type-checked and interpreted very rapidly (< 1- second)-- These features make Haskell ideal for scripting, particularly for replacing- large and unwieldy Bash scripts.-- This tutorial introduces how to use the @turtle@ library to write Haskell- scripts. This assumes no prior knowledge of Haskell, but does assume prior- knowledge of Bash or a similar shell scripting language.-- If you are already proficient with Haskell, then you can get quickly up to- speed by reading the Quick Start guide at the top of "Turtle.Prelude".-- The easiest way to follow along with the examples is to download the- `stack` package management tool by following the instructions here:-- <https://github.com/commercialhaskell/stack>-- ... and then run:--> $ stack install turtle---}--module Turtle.Tutorial (- -- * Introduction- -- $introduction-- -- * Comparison- -- $compare-- -- * Subroutines- -- $do-- -- * Types- -- $types-- -- * Shell- -- $shell-- -- * Type signatures- -- $signatures-- -- * System- -- $system-- -- * String formatting- -- $format-- -- * Streams- -- $streams-- -- * Loops- -- $loops-- -- * Folds- -- $folds-- -- * Input and output- -- $io-- -- * External commands- -- $external-- -- * Patterns- -- $patterns-- -- * Exception Safety- -- $exceptions-- -- * MonadIO- -- $monadio-- -- * Command line options- -- $cmdline-- -- * Conclusion- -- $conclusion- ) where--import Turtle---- $introduction--- Let's translate some simple Bash scripts to Haskell and work our way up to--- more complex scripts. Here is an example \"Hello, world!\" script written--- in both languages:------ @--- #!\/usr\/bin\/env stack--- \-\- stack \-\-install-ghc runghc \-\-package turtle--- \ --- -- #!\/bin\/bash--- {-\# LANGUAGE OverloadedStrings \#-} ----- ----- import "Turtle" ----- ----- main = `echo` \"Hello, world!\" -- echo Hello, world!--- @------ In Haskell you can use @--@ to comment out the rest of a line. The above--- example uses comments to show the equivalent Bash script side-by-side with--- the Haskell script.------ You can execute the above code by saving it to the file @example.hs@. If you--- are copying and pasting the code, then remove the leading 1-space indent.--- After you save the file, make the script executable and run the script:------ > $ chmod u+x example.hs --- > $ ./example.hs--- > Hello, world!------ If you delete the first two lines of the program, you can also compile the--- above code to generate a native executable which will have a much faster--- startup time and improved performance:------ > $ # `-O2` turns on all optimizations--- > $ # `-threaded` helps with piping shell output in and out of Haskell--- > $ stack ghc -- -O2 -threaded example.hs--- > $ ./example--- > Hello, world!------ You can even run Haskell code interactively using @ghci@, which is an--- interactive REPL for Haskell. You can either use @ghci@ by itself:------ > $ stack ghci--- > <ghci links in some libraries>--- > Prelude> :set -XOverloadedStrings--- > Prelude> import Turtle--- > Prelude Turtle> echo "Hello, world!"--- > <ghci links in some libraries>--- > Hello, world!--- > Prelude Turtle> :quit--- > $------ From now on I'll omit @ghci@'s linker output in tutorial examples. You can--- also silence this linker output by passing @--ghc-options -v0@ to--- @stack ghci@.---- $compare--- You'll already notice a few differences between the Haskell code and Bash--- code.------ First, the Haskell code requires two additional lines of overhead to import--- the @turtle@ library and enable overloading of string literals. This--- overhead is mostly unavoidable.------ Second, the Haskell `echo` explicitly quotes its string argument whereas the--- Bash @echo@ does not. In Bash every token is a string by default and you--- distinguish variables by prepending a dollar sign to them. In Haskell--- the situation is reversed: every token is a variable by default and you--- distinguish strings by quoting them. The following example highlights the--- difference:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- >--- > -- #!/bin/bash--- > {-# LANGUAGE OverloadedStrings #-} ----- > ----- > import Turtle ----- > ----- > str = "Hello!" --STR=Hello!--- > ----- > main = echo str --echo $STR------ Third, you have to explicitly assign a subroutine to @main@ to specify which--- subroutine to run when your program begins. This is because Haskell lets you--- define things out of order. For example, we could have written our original--- program this way instead:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > {-# LANGUAGE OverloadedStrings #-}--- > --- > import Turtle--- > --- > main = echo str--- > --- > str = "Hello, world!"------ Notice how the above program defines @str@ after @main@, which is valid.--- Haskell does not care in what order you define top-level values or functions--- (using the @=@ sign). However, the top level of a Haskell program only--- permits definitions. If you were to insert a statement at the top-level:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > {-# LANGUAGE OverloadedStrings #-}--- > --- > import Turtle--- > --- > echo "Hello, world!"------ ... then you would get this error when you tried to run your program:------ > example.hs:7:1: Parse error: naked expression at top level---- $do--- You can use @do@ notation to create a subroutine that runs more than one--- command:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- >--- > -- #!/bin/bash--- > {-# LANGUAGE OverloadedStrings #-} ----- > ----- > import Turtle ----- > ----- > main = do ----- > echo "Line 1" -- echo Line 1--- > echo "Line 2" -- echo Line 2--- --- > $ ./example.hs--- > Line 1--- > Line 2------ @do@ blocks can use either use the indentation level to control their--- duration or they can use curly braces and semicolons. To see the full rules--- for @do@ syntax, read: <http://en.wikibooks.org/wiki/Haskell/Indentation>.------ Some commands can return a value, and you can store the result of a command--- using the @<-@ symbol. For example, the following program prints the--- creation time of the current working directory by storing two intermediate--- results:------ @--- #!\/usr\/bin\/env stack--- \-\- stack \-\-install-ghc runghc \-\-package turtle--- \ --- -- #!\/bin\/bash--- import Turtle ----- ----- main = do ----- dir <- `pwd` -- DIR=$(pwd)--- time <- `datefile` dir -- TIME=$(date -r $DIR)--- `print` time -- echo $TIME--- @------ > $ ./example.hs--- > 2015-01-24 03:40:31 UTC------ The main difference between @=@ and @<-@ is that:------ * The @<-@ symbol is overloaded and its meaning is context-dependent; in this--- context it just means \"store the current result\"------ * The @=@ symbol is not overloaded and always means that the two sides of the--- equality are interchangeable------ @do@ notation lets you combine smaller subroutines into larger subroutines.--- For example, we could refactor the above code to split the first two commands--- into their own smaller subroutine and then invoke that smaller subroutine--- within a larger subroutine:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- >--- > -- #!/bin/bash--- > import Turtle ----- > ----- > datePwd = do -- datePwd() {--- > dir <- pwd -- DIR=$(pwd)--- > result <- datefile dir -- RESULT=$(date -r $DIR)--- > return result -- echo $RESULT--- > -- }--- > main = do ----- > time <- datePwd -- TIME=$(datePwd)--- > print time -- echo $TIME------ The refactored program still returns the exact same result:------ > $ ./example.hs--- > 2015-01-24 03:40:31 UTC------ We can also simplify the code a little bit because @do@ notation implicitly--- returns the value of the last command within a subroutine. We can use this--- trick to simplify both the Haskell and Bash code:------ > datePwd = do -- datePwd() {--- > dir <- pwd -- DIR=$(pwd)--- > datefile dir -- date -r $DIR--- > -- }------ However, keep in mind that the `return` statement is something of a misnomer--- since it does not break or exit from the surrounding subroutine. All it--- does is create a trivial subroutine that has no side effects and returns its--- argument as its result. If you `return` an expression, you're just giving--- it a new name:------ > do x <- return expr -- X=EXPR--- > command x -- command $X--- > --- > -- Same as:--- > command expr -- command EXPR------ In fact, the first line is equivalent to @let x = expr@, which more closely--- mirrors the equivalent Bash syntax:------ > do let x = expr -- X=EXPR--- > command x -- command $X--- > --- > -- Same as:--- > command expr -- command EXPR------ Also, for a subroutine with a single command, you can omit the @do@:------ > main = do echo "Hello, world!"--- > --- > -- Same as:--- > main = echo "Hello, world!"---- $types------ Notice how the above Haskell example used `print` instead of `echo`. Run the--- following script to find out what happens if we choose `echo` instead:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > import Turtle--- > --- > main = do--- > dir <- pwd--- > time <- datefile dir--- > echo time------ If we run that we get a type error:------ > $ ./example.hs--- > --- > example.hs:8:10:--- > Couldn't match expected type `Text' with actual type `UTCTime'--- > In the first argument of `echo', namely `time'--- > In a stmt of a 'do' block: echo time--- > In the expression:--- > do { dir <- pwd;--- > time <- datefile dir;--- > echo time }------ The error points to the last line of our program: @(example.hs:8:10)@ means--- line 8, column 10 of our program. If you study the error message closely--- you'll see that the `echo` function expects a `Text` value, but we passed it--- @\'time\'@, which was a `UTCTime` value. Although the error is at the end of--- our script, Haskell catches this error before even running the script. When--- we \"interpret\" a Haskell script the Haskell compiler actually compiles the--- script without any optimizations to generate a temporary executable and then--- runs the executable, much like Perl does for Perl scripts.------ You might wonder: \"where are the types?\" None of the above programs had--- any type signatures or type annotations, yet the compiler still detected type--- errors correctly. This is because Haskell uses \"global type inference\" to--- detect errors, meaning that the compiler can infer the types of expressions--- within the program without any assistance from the programmer.------ You can even ask the compiler what the type of an expression is using @ghci@.--- Let's open up the REPL and import this library so that we can study the types--- and deduce why our program failed:------ > $ stack ghci--- > Prelude> import Turtle--- > Prelude Turtle>------ You can interrogate the REPL for an expression's type using the @:type@--- command:------ @--- Prelude Turtle> :type pwd--- pwd :: `MonadIO` io => io Turtle.`Turtle.FilePath`--- @------ For right now, ignore all occurrences of `MonadIO` and just read the type--- as:------ @--- Prelude Turtle> :type pwd--- pwd :: `IO` Turtle.`Turtle.FilePath`--- @------ We will cover `MonadIO` later on.------ Whenever you see something of the form @(x :: t)@, that means that @\'x\'@--- is a value of type @\'t\'@. The REPL says that `pwd` is a subroutine ('IO')--- that returns a `Turtle.FilePath`. The "Turtle" prefix before--- `Turtle.FilePath` is just the module name since the `Turtle.FilePath`--- exported by the @turtle@ library conflicts with the default `FilePath`--- exported by Haskell's @Prelude@. The compiler uses the fully qualified name,--- @"Turtle".`FilePath`@, to avoid ambiguity.------ We can similarly ask for the type of `datefile`:------ @--- Prelude Turtle> :type datefile--- datefile :: Turtle.`Turtle.FilePath` -> `IO` `UTCTime`--- @------ `datefile` is a function whose argument must be a `Turtle.FilePath` and whose--- result is a subroutine (`IO`) that returns a `UTCTime`. Notice how the--- input argument of `datefile` (which is a `Turtle.FilePath`) is the same type--- as the return value of `pwd` (also a `Turtle.FilePath`).------ Now let's study type of `echo` to see why we get the type error:------ @--- Prelude Turtle> :type echo--- echo :: `Text` -> `IO` ()--- @------ The above type says that `echo` is a function whose argument is a value of--- type `Text` and whose result is a subroutine (`IO`) with an empty return--- value (denoted @\'()\'@).------ Now we can understand the type error: `echo` expects a `Text` argument but--- `datefile` returns a `UTCTime`, which is not the same thing. Unlike Bash,--- not everything is `Text` in Haskell and the compiler will not cast or coerce--- types for you.------ The reason `print` worked is because `print` has a more general type than--- `echo`:------ @--- Prelude Turtle> :type print--- print :: `Show` a => a -> `IO` ()--- @------ This type signature says that `print` can display any value of type @\'a\'@--- so long as @\'a\'@ implements the `Show` interface. In this case `UTCTime`--- does implement the `Show` interface, so everything works out when we use--- `print`.------ This library provides a helper function that lets you convert any type that--- implements `Show` into a `Text` value:--- --- @--- \-\- This behaves like Python's \`repr\` function--- `repr` :: `Show` a => a -> `Text`--- @------ You could therefore implement `print` in terms of `echo` and `repr`:------ > print x = echo (repr x)---- $shell------ You can use @ghci@ for more than just inferring types. @ghci@ is a--- general-purpose Haskell shell for your system when you extend it with--- @turtle@:------ @--- $ stack ghci--- Prelude> :set -XOverloadedStrings--- Prelude> import Turtle--- Prelude Turtle> `cd` \"/tmp\"--- Prelude Turtle> `pwd`--- FilePath \"/tmp\"--- Prelude Turtle> `mkdir` \"test\"--- Prelude Turtle> `cd` \"test\"--- Prelude Turtle> `touch` \"file\"--- Prelude Turtle> `testfile` \"file\"--- True--- Prelude Turtle> `rm` \"file\"--- Prelude Turtle> `testfile` \"file\"--- False--- @------ You can also optionally configure @ghci@ to run the first two commands every--- time you launch @ghci@. Just create a @.ghci@ within your current directory--- with these two lines:------ > :set -XOverloadedStrings--- > import Turtle------ The following @ghci@ examples will all assume that you run these two commands--- at the beginning of every session, either manually or automatically. You can--- even enable those two commands permanently by adding the above @.ghci@ file--- to your home directory.------ Within @ghci@ you can run a subroutine and @ghci@ will `print` the--- subroutine's value if it is not empty:------ @--- Prelude Turtle> `shell` \"true\" empty--- ExitSuccess--- Prelude Turtle> `shell` \"false\" empty--- ExitFailure 1--- @------ You can also type in a pure expression and @ghci@ will evaluate that--- expression:------ @--- Prelude Turtle> 2 + 2--- 4--- Prelude Turtle> \"123\" `<>` \"456\" -- (\<\>) concatenates strings--- \"123456\"--- @------ This works because @ghci@ automatically wraps anything that's not a--- subroutine with `print`. It's as if we had written:------ > Prelude Turtle> print (2 + 2)--- > 4--- > Prelude Turtle> print ("123" <> "456")--- > "123456"---- $signatures------ Haskell performs global type inference, meaning that the compiler never--- requires any type signatures. When you add type signatures, they are purely--- for the benefit of the programmer and behave like machine-checked--- documentation.------ Let's illustrate this by adding types to our original script:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > import Turtle--- > --- > datePwd :: IO UTCTime -- Type signature--- > datePwd = do--- > dir <- pwd--- > datefile dir--- > --- > main :: IO () -- Type signature--- > main = do--- > time <- datePwd--- > print time------ The first type signature says that @datePwd@ is a subroutine that returns a--- `UTCTime`:------ > -- +----- A subroutine ...--- > -- |--- > -- | +-- ... that returns `UTCTime`--- > -- | |--- > -- v v--- > datePwd :: IO UTCTime------ The second type signature says that @main@ is a subroutine that returns an--- empty value:------ > -- +----- A subroutine ...--- > -- |--- > -- | +-- ... that returns an empty value (i.e. `()`)--- > -- | |--- > -- v v--- > main :: IO ()------ Not every top-level value has to be a subroutine, though. For example, you--- can define unadorned `Text` values at the top-level, as we saw previously:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > {-# LANGUAGE OverloadedStrings #-}--- > --- > import Turtle--- > --- > str :: Text--- > str = "Hello!"--- > --- > main :: IO ()--- > main = echo str------ These type annotations do not assist the compiler. Instead, the compiler--- independently infers the type and then checks whether it matches the--- documented type. If there is a mismatch the compiler will raise a type--- error.------ Let's test this out by providing an incorrect type for @\'str\'@:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > {-# LANGUAGE OverloadedStrings #-}--- > --- > import Turtle--- > --- > str :: Int--- > str = "Hello!"--- > --- > main :: IO ()--- > main = echo str------ If you run that script, you will get two error messages:------ > $ ./example.hs--- > --- > example.hs:8:7:--- > No instance for (IsString Int)--- > arising from the literal `"Hello, world!"'--- > Possible fix: add an instance declaration for (IsString Int)--- > In the expression: "Hello, world!"--- > In an equation for `str': str = "Hello, world!"--- > --- > example.hs:11:13:--- > Couldn't match expected type `Text' with actual type `Int'--- > In the first argument of `echo', namely `str'--- > In the expression: echo str--- > In an equation for `main': main = echo str------ The first error message relates to the @OverloadedStrings@ extensions. When--- we enable @OverloadedStrings@ the compiler overloads string literals,--- interpreting them as any type that implements the `IsString` interface. The--- error message says that `Int` does not implement the `IsString` interface so--- the compiler cannot interpret a string literal as an `Int`. On the other--- hand the `Text` and `Turtle.FilePath` types do implement `IsString`, which--- is why we can interpret string literals as `Text` or `Turtle.FilePath`--- values.------ The second error message says that `echo` expects a `Text` value, but we--- declared @str@ to be an `Int`, so the compiler aborts compilation, requiring--- us to either fix or delete our type signature.------ Notice that there is nothing wrong with the program other than the type--- signature we added. If we were to delete the type signature the program--- would compile and run correctly. The sole purpose of this type signature is--- for us to communicate our expectations to the compiler so that the compiler--- can alert us if the code does not match our expectations.------ Let's also try reversing the type error, providing a number where we expect--- a string:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > {-# LANGUAGE OverloadedStrings #-}--- > --- > import Turtle--- > --- > str :: Text--- > str = 4--- > --- > main :: IO ()--- > main = echo str------ This gives a different error:------ > $ ./example.hs--- > --- > example.hs:8:7:--- > No instance for (Num Text)--- > arising from the literal `4'--- > Possible fix: add an instance declaration for (Num Text)--- > In the expression: 4--- > In an equation for `str': str = 4------ Haskell also automatically overloads numeric literals, too. The compiler--- interprets integer literals as any type that implements the `Num` interface.--- The `Text` type does not implement the `Num` interface, so we cannot--- interpret integer literals as `Text` strings.---- $system------ You can invoke arbitrary shell commands using the `shell` command. For--- example, we can write a program that creates an empty directory and then--- uses a `shell` command to archive the directory:------ @--- #!\/usr\/bin\/env stack--- \-\- stack \-\-install-ghc runghc \-\-package turtle--- \ --- -- #!\/bin\/bash--- {-\# LANGUAGE OverloadedStrings \#-} ----- ----- import Turtle ----- ----- main = do ----- mkdir \"test\" -- mkdir test--- `shell` \"tar czf test.tar.gz test\" empty -- tar czf test.tar.gz test--- @------ If you run this program, it will generate the @test.tar.gz@ archive:------ > $ ./example.hs--- > ExitSuccess--- > $ echo $?--- > 0--- > $ ls test.tar.gz--- > test.tar.gz------ Like @ghci@, the @runhaskell@ command running our script prints any non-empty--- result of the @main@ subroutine (`ExitSuccess` in this case).------ The easiest way to learn a new command like `shell` is to view its--- documentation. Click on the word `shell`, which will take you to--- documentation that looks like this:------ @--- `shell`--- :: Text -- Command line--- -> Shell Text -- Standard input (as lines of \`Text\`)--- -> IO `ExitCode` -- Exit code of the shell command--- @------ The first argument is a `Text` representation of the command to run. The--- second argument lets you feed input to the command, and you can provide--- `empty` for now to feed no input.------ The final result is an `ExitCode`, which you can use to detect whether the--- command completed successfully. For example, we could print a more--- descriptive error message if an external command fails:------ @--- #!\/usr\/bin\/env stack--- \-\- stack \-\-install-ghc runghc \-\-package turtle--- --- {-\# LANGUAGE OverloadedStrings \#-}--- --- import Turtle------ main = do--- let cmd = \"false\"--- x <- shell cmd empty--- case x of--- ExitSuccess -> return ()--- ExitFailure n -> `die` (cmd \<\> \" failed with exit code: \" \<\> repr n)--- @------ This prints an error message since the @false@ command always fails:------ > $ ./example.hs--- > example.hs: user error (false failed with exit code: 1)------ You should also check out the `proc` command, which is less powerful but--- safer since it decreases the likelihood of code injection or malformed--- commands:------ @--- `proc`--- :: Text -- Program--- :: [Text] -- Arguments--- -> Shell Text -- Standard input (as lines of \`Text\`)--- -> IO ExitCode -- Exit code of the shell command--- @------ Most of the commands in this library do not actually invoke an external--- shell or program. Instead, they indirectly wrap other Haskell libraries that--- bind to C code.---- $format------ This library provides type-safe string formatting utilities, too. For--- example, instead of writing this:------ > cmd <> " failed with exit code: " <> repr n------ ... you could format the string using @printf@ style instead:------ > format (s%" failed with exit code: "%d) cmd n------ What's neat is that the compiler will automatically infer the number of--- arguments and their types from the `Format` string:------ > $ stack ghci--- > Prelude Turtle> :type format (s%" failed with exit code: "%d)--- > format (s%" failed with exit code: "%d) :: Text -> Int -> Text------ The compiler deduces that the above `Format` string requires one argument of--- type `Text` to satisfy the `s` at the beginning of the format string and--- another argument of type `Int` to satisfy the `d` at the end of the format--- string.------ If you are interested in this feature, check out the "Turtle.Format" module--- for more details.---- $streams--- The @turtle@ library provides support for streaming computations, just like--- Bash. The primitive @turtle@ streams are little more verbose than their--- Bash counterparts, but @turtle@ streams can be built and combined in more--- ways.------ The key type for streams is the `Shell` type, which represents a stream of--- values. For example, the `ls` function has a streaming result:------ @--- Prelude Turtle> :type `ls`--- `ls` :: Turtle.FilePath -> `Shell` Turtle.FilePath--- @------ That type says that `ls` takes a single `Turtle.FilePath` as its argument--- (the directory to list) and the result is a `Shell` stream of--- `Turtle.FilePath`s (the immediate children of that directory).------ You can't run a `Shell` stream directly within @ghci@. You will get a type--- error like this if you try:------ > Prelude Turtle> ls "/tmp"--- > --- > <interactive>:2:1:--- > No instance for (Show (Shell Turtle.FilePath))--- > arising from a use of `print'--- > Possible fix:--- > add an instance declaration for (Show (Shell Turtle.FilePath))--- > In a stmt of an interactive GHCi command: print it------ Instead, you must consume the stream as it is generated and the simplest way--- to consume a `Shell` stream is `view`:------ @--- `view` :: Show a => Shell a -> IO ()--- @------ `view` takes any `Shell` stream of values and `print`s them to standard--- output:------ > Prelude Turtle> view (ls "/tmp")--- > FilePath "/tmp/.X11-unix"--- > FilePath "/tmp/.X0-lock"--- > FilePath "/tmp/pulse-PKdhtXMmr18n"--- > FilePath "/tmp/pulse-xHYcZ3zmN3Fv"--- > FilePath "/tmp/tracker-gabriel"--- > FilePath "/tmp/pulse-PYi1hSlWgNj2"--- > FilePath "/tmp/orbit-gabriel"--- > FilePath "/tmp/ssh-vREYGbWGpiCa"--- > FilePath "/tmp/.ICE-unix------ You can build your own `Shell` streams using a few primitive operations,------ The first primitive is `empty`, which represents an empty stream of values:------ @--- Prelude Turtle> view `empty` -- Outputs nothing--- Prelude Turtle>--- @------ Another way to say that is:------ @--- view `empty` = return ()--- @------ The type of empty is:------ @--- `empty` :: Shell a--- @--- --- The lower-case @\'a\'@ is \"polymorphic\", meaning that it will type check as--- any type. That means that you can produce an `empty` stream of any type of--- value.------ The next simplest function is `return`, which lets you take any value and--- transform it into a singleton `Shell` that emits just that one value:------ @--- Prelude Turtle> view (`return` 1)--- 1--- @------ Another way to say that is:------ @--- view (`return` x) = print x--- @------ The type of `return` is:------ @--- `return` :: a -> Shell a--- @------ Notice that this is the same `return` function we saw before. This is--- because `return` is overloaded and works with both `IO` and `Shell`.------ You can also take any subroutine ('IO') and transform it into a singleton--- `Shell`:------ @--- Prelude Turtle> view (`liftIO` readline)--- ABC\<Enter\>--- Just \"ABC\"--- @------ Another way to say that is:------ @--- view (`liftIO` io) = do x <- io--- print x--- @------ The type of `liftIO` is:------ @--- `liftIO` :: IO a -> Shell a--- @------ Once you have those primitive `Shell` streams you can begin to combine them--- into larger `Shell` streams. For example, you can concatenate two `Shell`--- streams using (`<|>`):------ @--- view (return 1 `<|>` return 2)--- 1--- 2--- @------ Another way to say that is:------ @--- view (xs `<|>` ys) = do view xs--- view ys--- @------ The type of (`<|>`) is:------ @--- (`<|>`) :: Shell a -> Shell a -> Shell a--- @------ In other words, you can concatenate two `Shell` streams of the same element--- type to get a new `Shell` stream, also of the same element type.------ Let's try using (`<|>`) on two real streams:------ > Prelude Turtle> view (ls "/tmp" <|> ls "/usr")--- > FilePath "/tmp/.X11-unix"--- > FilePath "/tmp/.X0-lock"--- > FilePath "/tmp/pulse-PKdhtXMmr18n"--- > FilePath "/tmp/pulse-xHYcZ3zmN3Fv"--- > FilePath "/tmp/tracker-gabriel"--- > FilePath "/tmp/pulse-PYi1hSlWgNj2"--- > FilePath "/tmp/orbit-gabriel"--- > FilePath "/tmp/ssh-vREYGbWGpiCa"--- > FilePath "/tmp/.ICE-unix"--- > FilePath "/usr/lib"--- > FilePath "/usr/src"--- > FilePath "/usr/sbin"--- > FilePath "/usr/include"--- > FilePath "/usr/share"--- > FilePath "/usr/games"--- > FilePath "/usr/local"--- > FilePath "/usr/bin"------ Finally, note that `Shell` implements the `IsString` interface, so a string--- literal will type-check as a `Shell` that emits a single `Text` value:------ > Prelude Turtle> view "123"--- > "123"--- > Prelude Turtle> view (return "123") -- Same thing--- > "123"--- > Prelude Turtle> view ("123" <|> "456")--- > "123"--- > "456"--- > Prelude Turtle> view (return "123" <|> return "456") -- Same thing--- > "123"--- > "456"---- $loops------ This library also provides the `select` function for conveniently emitting a--- list of values:------ @--- Prelude Turtle> view (`select` [1, 2, 3])--- 1--- 2--- 3--- @------ We can use `select` to implement loops within a `Shell`:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > -- #!/bin/bash--- > {-# LANGUAGE OverloadedStrings #-} ----- > ----- > import Turtle ----- > ----- > example = do ----- > x <- select [1, 2] -- for x in 1 2; do--- > y <- select [3, 4] -- for y in 3 4; do--- > liftIO (print (x, y)) -- echo \(${x},${y}\);--- > -- done;--- > main = sh example -- done------ That will `print` every permutation of @\'x\'@ and @\'y\'@:------ > $ ./example--- > (1,3)--- > (1,4)--- > (2,3)--- > (2,4)------ This uses the `sh` utility instead of `view`. The only difference is that--- `sh` doesn't print any values (since `print` is doing that already):------ @--- `sh` :: Shell a -> IO ()--- @------ This trick isn't limited to `select`. You can loop over the output of any--- `Shell` by just binding its result. For example, this is how `view` loops--- over its argument:------ > view :: Show a => Shell a -> IO ()--- > view s = sh (do--- > x <- s -- `x` ranges over every output of `s`--- > liftIO (print x) )------ You can also loop over a stream in a one-liner, still using @do@ notation.--- Just insert semi-colons between statements:------ > Prelude Turtle> -- for file in /tmp/*; do echo $file; done--- > Prelude Turtle> sh (do file <- ls "/tmp"; liftIO (print file))--- > FilePath "/tmp/.X11-unix"--- > FilePath "/tmp/.X0-lock"--- > FilePath "/tmp/pulse-PKdhtXMmr18n"--- > FilePath "/tmp/pulse-xHYcZ3zmN3Fv"--- > FilePath "/tmp/tracker-gabriel"--- > FilePath "/tmp/pulse-PYi1hSlWgNj2"--- > FilePath "/tmp/orbit-gabriel"--- > FilePath "/tmp/ssh-vREYGbWGpiCa"--- > FilePath "/tmp/.ICE-unix"---- $folds------ There are other ways you can consume a `Shell` stream. For example, you can--- `fold` the stream using predefined `Fold`s from "Control.Foldl":------ @--- Prelude Turtle> import qualified "Control.Foldl" as Fold--- Prelude Turtle Fold> `fold` (ls \"/tmp\") Fold.length--- 9--- @------ @--- Prelude Turtle Fold> `fold` (ls \"/tmp\") Fold.head--- Just (FilePath \"\/tmp\/.X11-unix\")--- @------ @--- Prelude Turtle Fold> `fold` (ls \"\/tmp\") Fold.list--- [FilePath \"\/tmp\/.X11-unix\",FilePath \"\/tmp\/.X0-lock\",FilePath \"\/tmp\/pulse-PKd--- htXMmr18n\",FilePath \"\/tmp\/pulse-xHYcZ3zmN3Fv\",FilePath \"\/tmp\/tracker-gabriel--- \",FilePath \"\/tmp\/pulse-PYi1hSlWgNj2\",FilePath \"\/tmp\/orbit-gabriel\",FilePath --- \"\/tmp\/ssh-vREYGbWGpiCa\",FilePath \"\/tmp\/.ICE-unix\"]--- @------ You can also compute multiple things in a single pass over the stream:------ > Prelude Turtle> fold (select [1..10]) ((,) <$> Fold.minimum <*> Fold.maximum)--- > (Just 1,Just 10)------ If you are interested in this feature, check out the documentation in--- "Control.Foldl".---- $io------ @turtle@ comes with built-in support for the standard text streams.------ For example, you can write to standard output using the `stdout` utility:------ @--- `stdout` :: Shell Text -> IO ()--- `stdout` s = sh (do--- txt <- s--- liftIO (echo txt) )--- @------ `stdout` outputs each `Text` value on its own line:------ > Prelude Turtle> stdout "Line 1"--- > Line 1--- > Prelude Turtle> stdout ("Line 1" <|> "Line 2")--- > Line 1--- > Line 2------ Another useful stream is `stdin`, which emits one line of `Text` per line of--- standard input:------ @--- `stdin` :: Shell Text--- @------ Let's combine `stdin` and `stdout` to forward all input from standard input--- to standard output:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > -- #!/bin/bash--- > {-# LANGUAGE OverloadedStrings #-} ----- > ----- > import Turtle ----- > ----- > main = stdout stdin -- cat------ If you run that it will continue to echo lines until you signal end of input--- using @Ctrl-D@:------ > $ ./example.hs--- > ABC<Enter>--- > ABC--- > Test<Enter>--- > Test--- > 42<Enter>--- > 42--- > <Ctrl-D>--- > $------ You can also read and write to files using the `input` and `output`--- utilities:------ @--- Prelude Turtle> `output` \"file.txt\" (\"Test\" \<|\> \"ABC\" \<|\> \"42\")--- Prelude Turtle> stdout (`input` \"file.txt\")--- Test--- ABC--- 42--- @---- $external------ You can embed external shell commands as streams within your Haskell program.------ For example, suppose that we want to use the system's built in @ls@ command.--- We can just run:------ > Prelude Turtle> stdout (inshell "ls" empty)--- > .X11-unix--- > .X0-lock--- > pulse-PKdhtXMmr18n--- > pulse-xHYcZ3zmN3Fv--- > tracker-gabriel--- > pulse-PYi1hSlWgNj2--- > orbit-gabriel--- > ssh-vREYGbWGpiCa--- > .ICE-unix------ This works because type of `inshell` is:------ @--- `inshell`--- :: Text -- Command line--- -> Shell Text -- Standard input to feed to program--- -> Shell Text -- Standard output produced by program--- @------ This means you can use `inshell` to embed arbitrary external utilities as--- first class streams within your Haskell program:------ > Turtle Prelude> stdout (inshell "awk '{ print $1 }'" "123 456")--- > 123------ You should also check out the `inproc` command, which is less powerful but--- safer since it decreases the likelihood of code injection or malformed--- commands:------ @--- `inproc`--- :: Text -- Program--- -> [Text] -- Arguments--- -> Shell Text -- Standard input to feed to program--- -> Shell Text -- Standard output produced by program--- @------ Using `inproc`, you would write:------ > Turtle Prelude> stdout (inproc "awk" ["{ print $1 }"] "123 456")--- > 123---- $patterns------ You can transform streams using Unix-like utilities. For example, you can--- filter a stream using `grep`.------ @--- Prelude Turtle> stdout (input \"file.txt\")--- Test--- ABC--- 42--- Prelude Turtle> stdout (`grep` \"ABC\" (input \"file.txt\"))--- ABC--- @------ Let's look at the type of `grep`:------ @--- `grep` :: Pattern a -> Shell Text -> Shell Text--- @------ The first argument of `grep` is actually a `Pattern`, which implements--- `IsString`. When we pass a string literal we just create a `Pattern` that--- matches the given literal.------ `Pattern`s generalize regular expressions and you can use this table to--- roughly translate several regular expression idioms to `Pattern`s:------ @--- Regex Pattern--- ========= =========--- \"string\" \"string\"--- . `dot`--- e1 e2 e1 `<>` e2--- e1 | e2 e1 `<|>` e2--- e* `star` e--- e+ `plus` e--- e*? `selfless` (`star` e)--- e+? `selfless` (`plus` e)--- e{n} `count` n e--- e{m,n} `bounded` m n e--- e{0,n} `upperBounded` n e--- e? `optional` e--- [xyz] `oneOf` \"xyz\"--- [^xyz] `noneOf` \"xyz\"--- @------ Here are some examples:------ > Prelude Turtle> -- grep '^[[:digit:]]\+$' file.txt--- > Prelude Turtle> stdout (grep (plus digit) (input "file.txt"))--- > 42--- > Prelude Turtle> -- grep '^[[:digit:]]\+\|Test$' file.txt--- > Prelude Turtle> stdout (grep (plus digit <|> "Test") (input "file.txt"))--- > Test--- > 42------ Note that @turtle@'s `grep` subtly differs from the traditional @grep@--- command. The `Pattern` you provide must match the entire line. If you--- want to match the interior of a line, you can use the `has` utility:------ @--- Prelude Turtle> -- grep B file.txt--- Prelude Turtle> stdout (grep (`has` \"B\") (input \"file.txt\"))--- ABC--- @------ You can also use `prefix` or `suffix` to match the beginning or end of a--- string, respectively:------ @--- Prelude Turtle> -- grep '^A' file.txt--- Prelude Turtle> stdout (grep (`prefix` \"A\") (input \"file.txt\"))--- ABC--- Prelude Turtle> -- grep 'C$' file.txt--- Prelude Turtle> stdout (grep (`suffix` \"C\") (input \"file.txt\"))--- ABC--- @------ `sed` also uses `Pattern`s, too, and is more flexible than Unix @sed@:------ @--- Prelude Turtle> -- sed 's/C/D/g' file.txt--- Prelude Turtle> stdout (`sed` (\"C\" `*>` return \"D\") (input \"file.txt\"))--- Test--- ABD--- 42--- Prelude Turtle> -- sed 's\/[[:digit:]]\/!\/g' file.txt--- Prelude Turtle> stdout (`sed` (digit `*>` return \"!\") (input \"file.txt\"))--- Test--- ABC--- !!--- Prelude Turtle> import qualified Data.Text as Text--- Prelude Turtle> -- rev file.txt--- Prelude Turtle> stdout (`sed` (`fmap` Text.reverse (plus dot)) (input \"file.txt\"))--- tseT--- CBA--- 24--- Prelude Turtle>--- @------ You can also use `Pattern`s by themselves to parse arbitrary text into more--- structured values:------ @--- Prelude Turtle> let pair = do x <- `decimal`; \" \"; y <- `decimal`; return (x, y)--- Prelude Turtle> :type pair--- pair :: `Pattern` (Integer, Integer)--- Prelude Turtle> `match` pair \"123 456\"--- [(123,456)]--- Prelude Turtle> data Pet = Cat | Dog deriving (Show)--- Prelude Turtle> let pet = (\"cat\" *> return Cat) \<|\> (\"dog\" *> return Dog) :: `Pattern` Pet--- Prelude Turtle> `match` pet \"dog\"--- [Dog]--- Prelude Turtle> `match` (pet \``sepBy`\` \",\") \"cat,dog,cat\"--- [[Cat,Dog,Cat]]--- @------ See the "Turtle.Pattern" module for more details if you are interested in--- writing more complex `Pattern`s.---- $exceptions------ Sometimes you may want to acquire resources and ensure they get released--- correctly if there are any exceptions. You can use `Managed` resources to--- acquire things safely within a `Shell`.------ You can think of a `Managed` resource as some resource that needs to be--- acquired and then released afterwards. Example: you want to create a--- temporary file and then guarantee it's deleted afterwards, even if the--- program fails with an exception.------ "Turtle.Prelude" provides two `Managed` utilities for creating temporary--- directories or files:------ @--- `mktempdir`--- :: FilePath -- Parent directory--- -> Text -- Directory name template--- -> `Managed` FilePath -- Temporary directory--- @------ @--- `mktemp`--- :: FilePath -- Parent directory--- -> Text -- File name template--- -> `Managed` (FilePath, Handle) -- Temporary file--- @------ You can acquire a `Managed` resource within a `Shell` with `using`:------ @--- `using` :: Managed a -> Shell a--- @------ ... and here is an example of creating a temporary directory and file within--- a `Shell`:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > {-# LANGUAGE OverloadedStrings #-}--- > --- > import Turtle--- > --- > main = sh (do--- > dir <- using (mktempdir "/tmp" "turtle")--- > (file, _) <- using (mktemp dir "turtle")--- > liftIO (print file) )------ When you run the above script it will print out the name of the temporary--- directory and file:------ > $ ./example.hs--- > FilePath "/tmp/turtle15976/turtle15976"------ ... and you can verify that they were deleted afterwards:------ > Turtle Prelude> view (find (has "turtle") "/tmp")--- > Turtle Prelude> -- No results------ As an exercise, try inserting an exception and verifying that the temporary:--- file and directory are still cleaned up correctly:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > {-# LANGUAGE OverloadedStrings #-}--- > --- > import Turtle--- > --- > main = sh (do--- > dir <- using (mktempdir "/tmp" "turtle")--- > (file, _) <- using (mktemp dir "turtle")--- > liftIO (print file)--- > liftIO (die "Urk!") )------ To learn more about `Managed` resources, read the documentation in--- "Control.Monad.Managed".---- $monadio------ If you are sick of having type `liftIO` everywhere, you can omit it. This--- is because all subroutines in @turtle@ are overloaded using the `MonadIO`--- type class, like our original `pwd` command where we first encountered the--- the `MonadIO` type:------ @--- Prelude Turtle> :type pwd--- pwd :: `MonadIO` io => io Turtle.`Turtle.FilePath`--- @------ This means you can this command is overloaded to run in any context that--- implements the `MonadIO` interface, including:------ * `IO` (obviously)------ * `Shell`------ * `Managed`------ You can tell if a type constructor like `Shell` implements `MonadIO` by--- clicking the link to the type constructor and looking for the instance list.--- There you will see a list of instances like:------ > Monad Shell--- > Functor Shell--- > MonadPlus Shell--- > Applicative Shell--- > Alternative Shell--- > MonadIO Shell--- > ...--- --- These instances represent the overloaded functions associated with `Shell`--- and we can see from the list that `Shell` implements `MonadIO` so we can--- use `pwd` (or any other subroutine in this library) within a `Shell`.------ However, not all subroutines in the Haskell ecosystem are overloaded in this--- way (such as `print`), so you will still occasionally need to wrap--- subroutines in `liftIO`.---- $cmdline------ The "Turtle.Options" module lets you easily parse command line arguments,--- using either flags or positional arguments.------ For example, if you want to write a @cp@-like script that takes two--- positional arguments for the source and destination file, you can write:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- >--- > -- cp.hs--- >--- > {-# LANGUAGE OverloadedStrings #-}--- >--- > import Turtle--- > import Prelude hiding (FilePath)--- >--- > parser :: Parser (FilePath, FilePath)--- > parser = (,) <$> argPath "src" "The source file"--- > <*> argPath "dest" "The destination file"--- >--- > main = do--- > (src, dest) <- options "A simple `cp` script" parser--- > cp src dest------ If you run the script without any arguments, you will get an auto-generated--- usage output:------ > $ ./cp.hs--- > Usage: cp.hs SRC DEST------ ... and you can get a more descriptive output if you supply the @--help@--- flag:------ > $ ./cp.hs --help--- > A simple `cp` utility--- > --- > Usage: cp.hs SRC DEST--- > --- > Available options:--- > -h,--help Show this help text--- > SRC The source file--- > DEST The destination file------ ... and the script works as expected if you provide both arguments:------ > echo "Test" > file1.txt--- > $ ./cp.hs file1.txt file2.txt--- > cat file2.txt--- > Test------ This works because `argPath` produces a `Parser`:------ > argPath :: ArgName -> Optional HelpMessage -> Parser FilePath------ ... and multiple `Parser`s can be combined into a single `Parser` using--- operations from the `Applicative` type class since the `Parser` type--- implements the `Applicative` interface:------ > instance Applicative Parser------ You can also make any argument optional using the `optional` utility--- provided by `Control.Applicative`:------ @--- `optional` :: `Alternative` f => f a -> f (Maybe a)--- @------ For example, we can change our program to make the destination argument--- optional, defaulting to `stdout` if the user does not provide a destination:--------- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > {-# LANGUAGE OverloadedStrings #-}--- > --- > import Turtle--- > import Prelude hiding (FilePath)--- > --- > parser :: Parser (FilePath, Maybe FilePath)--- > parser = (,) <$> argPath "src" "The source file"--- > <*> optional (argPath "dest" "The destination file")--- > --- > main = do--- > (src, mDest) <- options "A simple `cp` utility" parser--- > case mDest of--- > Nothing -> input src & stdout--- > Just dest -> cp src dest------ Now the auto-generated usage information correctly indicates that the second--- argument is optional:------ > $ ./cp.hs--- > Usage: cp.hs SRC [DEST]--- > $ ./cp.hs --help--- > A simple `cp` utility--- > --- > Usage: cp.hs SRC [DEST]--- > --- > Available options:--- > -h,--help Show this help text--- > SRC The source file--- > DEST The destination file------ ... and if we omit the argument the result goes to standard output:------ > $ ./cp.hs file1.txt--- > Test------ We can use the `optional` utility because the `Parser` type also implements--- the `Alternative` interface:------ > instance Alternative Parser------ We can also specify arguments on the command lines using flags instead of--- specifying them positionally. Let's change our example to specify the--- input and output using the @--src@ and @--dest@ flags, using @-s@ and @-d@--- as short-hands for the flags:------ > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle--- > --- > {-# LANGUAGE OverloadedStrings #-}--- > --- > import Turtle--- > import Prelude hiding (FilePath)--- > --- > parser :: Parser (FilePath, FilePath)--- > parser = (,) <$> optPath "src" 's' "The source file"--- > <*> optPath "dest" 'd' "The destination file"--- > --- > main = do--- > (src, dest) <- options "A simple `cp` utility" parser--- > cp src dest------ This now lets us specify the arguments in terms of flags:------ > $ ./cp--- > Usage: cp.hs (-s|--src SRC) (-d|--dest DEST)--- > $ ./cp --help--- > A simple `cp` utility--- > --- > Usage: cp.hs (-s|--src SRC) (-d|--dest DEST)--- > --- > Available options:--- > -h,--help Show this help text--- > -s,--src SRC The source file--- > -d,--dest DEST The destination file--- > $ ./cp --src file1.txt --dest file3.txt--- > $ cat file3.txt--- > Test------ See the "Turtle.Options" module for more details and utilities related to--- parsing command line options. This module is built on top of the--- @optparse-applicative@ library, which provides even more extensive--- functionality.---- $conclusion------ By this point you should be able to write basic shell scripts in Haskell. If--- you would like to learn more advanced tricks, take the time to read the--- documentation in these modules:------ * "Turtle.Prelude"------ * "Turtle.Format"------ * "Turtle.Pattern"------ * "Turtle.Shell"------ * "Control.Foldl"------ * "Control.Monad.Managed"------ If you have more questions or need help learning the library, ask a question--- on Stack Overflow under the @haskell-turtle@ tag. For bugs or feature--- requests, create an issue on Github at--- <https://github.com/Gabriel439/Haskell-Turtle-Library/issues>------ This library provides an extended suite of Unix-like utilities, but would--- still benefit from adding more utilities for better parity with the Unix--- ecosystem. Pull requests to add new utilities are highly welcome!+{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +{-| Use @turtle@ if you want to write light-weight and maintainable shell + scripts. + + @turtle@ embeds shell scripting directly within Haskell for three main + reasons: + + * Haskell code is easy to refactor and maintain because the language is + statically typed + + * Haskell is syntactically lightweight, thanks to global type inference + + * Haskell programs can be type-checked and interpreted very rapidly (< 1 + second) + + These features make Haskell ideal for scripting, particularly for replacing + large and unwieldy Bash scripts. + + This tutorial introduces how to use the @turtle@ library to write Haskell + scripts. This assumes no prior knowledge of Haskell, but does assume prior + knowledge of Bash or a similar shell scripting language. + + If you are already proficient with Haskell, then you can get quickly up to + speed by reading the Quick Start guide at the top of "Turtle.Prelude". + + The easiest way to follow along with the examples is to download the + `stack` package management tool by following the instructions here: + + <https://github.com/commercialhaskell/stack> + + ... and then run: + +> $ stack install turtle + + The first two lines of each script below contain boilerplate instructions + so that `stack` will load and run the script. This helps ensure that a + script will run on any computer that has a `stack` executable, as `stack` + can install a Haskell compiler if one is not already present. + If you are curious about how these two lines work, they are described here: + + <https://github.com/commercialhaskell/stack/blob/master/doc/GUIDE.md#ghcrunghc> + +-} + +module Turtle.Tutorial ( + -- * Introduction + -- $introduction + + -- * Comparison + -- $compare + + -- * Subroutines + -- $do + + -- * Types + -- $types + + -- * Shell + -- $shell + + -- * Type signatures + -- $signatures + + -- * System + -- $system + + -- * String formatting + -- $format + + -- * Streams + -- $streams + + -- * Loops + -- $loops + + -- * Folds + -- $folds + + -- * Input and output + -- $io + + -- * External commands + -- $external + + -- * Patterns + -- $patterns + + -- * Exception Safety + -- $exceptions + + -- * MonadIO + -- $monadio + + -- * Command line options + -- $cmdline + + -- * Conclusion + -- $conclusion + ) where + +import Turtle + +-- $introduction +-- Let's translate some simple Bash scripts to Haskell and work our way up to +-- more complex scripts. Here is an example \"Hello, world!\" script written +-- in both languages: +-- +-- @ +-- #!\/usr\/bin\/env stack +-- \-\- stack \-\-install-ghc runghc \-\-package turtle +-- \ +-- -- #!\/bin\/bash +-- {-\# LANGUAGE OverloadedStrings \#-} -- +-- -- +-- import "Turtle" -- +-- -- +-- main = `echo` \"Hello, world!\" -- echo Hello, world! +-- @ +-- +-- In Haskell you can use @--@ to comment out the rest of a line. The above +-- example uses comments to show the equivalent Bash script side-by-side with +-- the Haskell script. +-- +-- You can execute the above code by saving it to the file @example.hs@. If you +-- are copying and pasting the code, then remove the leading 1-space indent. +-- After you save the file, make the script executable and run the script: +-- +-- > $ chmod u+x example.hs +-- > $ ./example.hs +-- > Hello, world! +-- +-- If you delete the first two lines of the program, you can also compile the +-- above code to generate a native executable which will have a much faster +-- startup time and improved performance: +-- +-- > $ # `-O2` turns on all optimizations +-- > $ # `-threaded` helps with piping shell output in and out of Haskell +-- > $ stack ghc -- -O2 -threaded example.hs +-- > $ ./example +-- > Hello, world! +-- +-- You can even run Haskell code interactively using @ghci@, which is an +-- interactive REPL for Haskell. You can either use @ghci@ by itself: +-- +-- > $ stack ghci +-- > <ghci links in some libraries> +-- > Prelude> :set -XOverloadedStrings +-- > Prelude> import Turtle +-- > Prelude Turtle> echo "Hello, world!" +-- > <ghci links in some libraries> +-- > Hello, world! +-- > Prelude Turtle> :quit +-- > $ +-- +-- From now on I'll omit @ghci@'s linker output in tutorial examples. You can +-- also silence this linker output by passing @--ghc-options -v0@ to +-- @stack ghci@. + +-- $compare +-- You'll already notice a few differences between the Haskell code and Bash +-- code. +-- +-- First, the Haskell code requires two additional lines of overhead to import +-- the @turtle@ library and enable overloading of string literals. This +-- overhead is mostly unavoidable. +-- +-- Second, the Haskell `echo` explicitly quotes its string argument whereas the +-- Bash @echo@ does not. In Bash every token is a string by default and you +-- distinguish variables by prepending a dollar sign to them. In Haskell +-- the situation is reversed: every token is a variable by default and you +-- distinguish strings by quoting them. The following example highlights the +-- difference: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > -- #!/bin/bash +-- > {-# LANGUAGE OverloadedStrings #-} -- +-- > -- +-- > import Turtle -- +-- > -- +-- > str = "Hello!" --STR=Hello! +-- > -- +-- > main = echo str --echo $STR +-- +-- Third, you have to explicitly assign a subroutine to @main@ to specify which +-- subroutine to run when your program begins. This is because Haskell lets you +-- define things out of order. For example, we could have written our original +-- program this way instead: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > +-- > main = echo str +-- > +-- > str = "Hello, world!" +-- +-- Notice how the above program defines @str@ after @main@, which is valid. +-- Haskell does not care in what order you define top-level values or functions +-- (using the @=@ sign). However, the top level of a Haskell program only +-- permits definitions. If you were to insert a statement at the top-level: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > +-- > echo "Hello, world!" +-- +-- ... then you would get this error when you tried to run your program: +-- +-- > example.hs:7:1: Parse error: naked expression at top level + +-- $do +-- You can use @do@ notation to create a subroutine that runs more than one +-- command: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > -- #!/bin/bash +-- > {-# LANGUAGE OverloadedStrings #-} -- +-- > -- +-- > import Turtle -- +-- > -- +-- > main = do -- +-- > echo "Line 1" -- echo Line 1 +-- > echo "Line 2" -- echo Line 2 +-- +-- > $ ./example.hs +-- > Line 1 +-- > Line 2 +-- +-- @do@ blocks can use either use the indentation level to control their +-- duration or they can use curly braces and semicolons. To see the full rules +-- for @do@ syntax, read: <http://en.wikibooks.org/wiki/Haskell/Indentation>. +-- +-- Some commands can return a value, and you can store the result of a command +-- using the @<-@ symbol. For example, the following program prints the +-- creation time of the current working directory by storing two intermediate +-- results: +-- +-- @ +-- #!\/usr\/bin\/env stack +-- \-\- stack \-\-install-ghc runghc \-\-package turtle +-- \ +-- -- #!\/bin\/bash +-- import Turtle -- +-- -- +-- main = do -- +-- dir <- `pwd` -- DIR=$(pwd) +-- time <- `datefile` dir -- TIME=$(date -r $DIR) +-- `print` time -- echo $TIME +-- @ +-- +-- > $ ./example.hs +-- > 2015-01-24 03:40:31 UTC +-- +-- The main difference between @=@ and @<-@ is that: +-- +-- * The @<-@ symbol is overloaded and its meaning is context-dependent; in this +-- context it just means \"store the current result\" +-- +-- * The @=@ symbol is not overloaded and always means that the two sides of the +-- equality are interchangeable +-- +-- @do@ notation lets you combine smaller subroutines into larger subroutines. +-- For example, we could refactor the above code to split the first two commands +-- into their own smaller subroutine and then invoke that smaller subroutine +-- within a larger subroutine: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > -- #!/bin/bash +-- > import Turtle -- +-- > -- +-- > datePwd = do -- datePwd() { +-- > dir <- pwd -- DIR=$(pwd) +-- > result <- datefile dir -- RESULT=$(date -r $DIR) +-- > return result -- echo $RESULT +-- > -- } +-- > main = do -- +-- > time <- datePwd -- TIME=$(datePwd) +-- > print time -- echo $TIME +-- +-- The refactored program still returns the exact same result: +-- +-- > $ ./example.hs +-- > 2015-01-24 03:40:31 UTC +-- +-- We can also simplify the code a little bit because @do@ notation implicitly +-- returns the value of the last command within a subroutine. We can use this +-- trick to simplify both the Haskell and Bash code: +-- +-- > datePwd = do -- datePwd() { +-- > dir <- pwd -- DIR=$(pwd) +-- > datefile dir -- date -r $DIR +-- > -- } +-- +-- However, keep in mind that the `return` statement is something of a misnomer +-- since it does not break or exit from the surrounding subroutine. All it +-- does is create a trivial subroutine that has no side effects and returns its +-- argument as its result. If you `return` an expression, you're just giving +-- it a new name: +-- +-- > do x <- return expr -- X=EXPR +-- > command x -- command $X +-- > +-- > -- Same as: +-- > command expr -- command EXPR +-- +-- In fact, the first line is equivalent to @let x = expr@, which more closely +-- mirrors the equivalent Bash syntax: +-- +-- > do let x = expr -- X=EXPR +-- > command x -- command $X +-- > +-- > -- Same as: +-- > command expr -- command EXPR +-- +-- Also, for a subroutine with a single command, you can omit the @do@: +-- +-- > main = do echo "Hello, world!" +-- > +-- > -- Same as: +-- > main = echo "Hello, world!" + +-- $types +-- +-- Notice how the above Haskell example used `print` instead of `echo`. Run the +-- following script to find out what happens if we choose `echo` instead: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > import Turtle +-- > +-- > main = do +-- > dir <- pwd +-- > time <- datefile dir +-- > echo time +-- +-- If we run that we get a type error: +-- +-- > $ ./example.hs +-- > +-- > example.hs:8:10: +-- > Couldn't match expected type `Text' with actual type `UTCTime' +-- > In the first argument of `echo', namely `time' +-- > In a stmt of a 'do' block: echo time +-- > In the expression: +-- > do { dir <- pwd; +-- > time <- datefile dir; +-- > echo time } +-- +-- The error points to the last line of our program: @(example.hs:8:10)@ means +-- line 8, column 10 of our program. If you study the error message closely +-- you'll see that the `echo` function expects a `Text` value, but we passed it +-- @\'time\'@, which was a `UTCTime` value. Although the error is at the end of +-- our script, Haskell catches this error before even running the script. When +-- we \"interpret\" a Haskell script the Haskell compiler actually compiles the +-- script without any optimizations to generate a temporary executable and then +-- runs the executable, much like Perl does for Perl scripts. +-- +-- You might wonder: \"where are the types?\" None of the above programs had +-- any type signatures or type annotations, yet the compiler still detected type +-- errors correctly. This is because Haskell uses \"global type inference\" to +-- detect errors, meaning that the compiler can infer the types of expressions +-- within the program without any assistance from the programmer. +-- +-- You can even ask the compiler what the type of an expression is using @ghci@. +-- Let's open up the REPL and import this library so that we can study the types +-- and deduce why our program failed: +-- +-- > $ stack ghci +-- > Prelude> import Turtle +-- > Prelude Turtle> +-- +-- You can interrogate the REPL for an expression's type using the @:type@ +-- command: +-- +-- @ +-- Prelude Turtle> :type pwd +-- pwd :: `MonadIO` io => io Turtle.`Turtle.FilePath` +-- @ +-- +-- For right now, ignore all occurrences of `MonadIO` and just read the type +-- as: +-- +-- @ +-- Prelude Turtle> :type pwd +-- pwd :: `IO` Turtle.`Turtle.FilePath` +-- @ +-- +-- We will cover `MonadIO` later on. +-- +-- Whenever you see something of the form @(x :: t)@, that means that @\'x\'@ +-- is a value of type @\'t\'@. The REPL says that `pwd` is a subroutine ('IO') +-- that returns a `Turtle.FilePath`. The "Turtle" prefix before +-- `Turtle.FilePath` is just the module name since the `Turtle.FilePath` +-- exported by the @turtle@ library conflicts with the default `FilePath` +-- exported by Haskell's @Prelude@. The compiler uses the fully qualified name, +-- @"Turtle".`FilePath`@, to avoid ambiguity. +-- +-- We can similarly ask for the type of `datefile`: +-- +-- @ +-- Prelude Turtle> :type datefile +-- datefile :: Turtle.`Turtle.FilePath` -> `IO` `UTCTime` +-- @ +-- +-- `datefile` is a function whose argument must be a `Turtle.FilePath` and whose +-- result is a subroutine (`IO`) that returns a `UTCTime`. Notice how the +-- input argument of `datefile` (which is a `Turtle.FilePath`) is the same type +-- as the return value of `pwd` (also a `Turtle.FilePath`). +-- +-- Now let's study type of `echo` to see why we get the type error: +-- +-- @ +-- Prelude Turtle> :type echo +-- echo :: `Text` -> `IO` () +-- @ +-- +-- The above type says that `echo` is a function whose argument is a value of +-- type `Text` and whose result is a subroutine (`IO`) with an empty return +-- value (denoted @\'()\'@). +-- +-- Now we can understand the type error: `echo` expects a `Text` argument but +-- `datefile` returns a `UTCTime`, which is not the same thing. Unlike Bash, +-- not everything is `Text` in Haskell and the compiler will not cast or coerce +-- types for you. +-- +-- The reason `print` worked is because `print` has a more general type than +-- `echo`: +-- +-- @ +-- Prelude Turtle> :type print +-- print :: `Show` a => a -> `IO` () +-- @ +-- +-- This type signature says that `print` can display any value of type @\'a\'@ +-- so long as @\'a\'@ implements the `Show` interface. In this case `UTCTime` +-- does implement the `Show` interface, so everything works out when we use +-- `print`. +-- +-- This library provides a helper function that lets you convert any type that +-- implements `Show` into a `Text` value: +-- +-- @ +-- \-\- This behaves like Python's \`repr\` function +-- `repr` :: `Show` a => a -> `Text` +-- @ +-- +-- You could therefore implement `print` in terms of `echo` and `repr`: +-- +-- > print x = echo (repr x) + +-- $shell +-- +-- You can use @ghci@ for more than just inferring types. @ghci@ is a +-- general-purpose Haskell shell for your system when you extend it with +-- @turtle@: +-- +-- @ +-- $ stack ghci +-- Prelude> :set -XOverloadedStrings +-- Prelude> import Turtle +-- Prelude Turtle> `cd` \"/tmp\" +-- Prelude Turtle> `pwd` +-- FilePath \"/tmp\" +-- Prelude Turtle> `mkdir` \"test\" +-- Prelude Turtle> `cd` \"test\" +-- Prelude Turtle> `touch` \"file\" +-- Prelude Turtle> `testfile` \"file\" +-- True +-- Prelude Turtle> `rm` \"file\" +-- Prelude Turtle> `testfile` \"file\" +-- False +-- @ +-- +-- You can also optionally configure @ghci@ to run the first two commands every +-- time you launch @ghci@. Just create a @.ghci@ within your current directory +-- with these two lines: +-- +-- > :set -XOverloadedStrings +-- > import Turtle +-- +-- The following @ghci@ examples will all assume that you run these two commands +-- at the beginning of every session, either manually or automatically. You can +-- even enable those two commands permanently by adding the above @.ghci@ file +-- to your home directory. +-- +-- Within @ghci@ you can run a subroutine and @ghci@ will `print` the +-- subroutine's value if it is not empty: +-- +-- @ +-- Prelude Turtle> `shell` \"true\" empty +-- ExitSuccess +-- Prelude Turtle> `shell` \"false\" empty +-- ExitFailure 1 +-- @ +-- +-- You can also type in a pure expression and @ghci@ will evaluate that +-- expression: +-- +-- @ +-- Prelude Turtle> 2 + 2 +-- 4 +-- Prelude Turtle> \"123\" `<>` \"456\" -- (\<\>) concatenates strings +-- \"123456\" +-- @ +-- +-- This works because @ghci@ automatically wraps anything that's not a +-- subroutine with `print`. It's as if we had written: +-- +-- > Prelude Turtle> print (2 + 2) +-- > 4 +-- > Prelude Turtle> print ("123" <> "456") +-- > "123456" + +-- $signatures +-- +-- Haskell performs global type inference, meaning that the compiler never +-- requires any type signatures. When you add type signatures, they are purely +-- for the benefit of the programmer and behave like machine-checked +-- documentation. +-- +-- Let's illustrate this by adding types to our original script: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > import Turtle +-- > +-- > datePwd :: IO UTCTime -- Type signature +-- > datePwd = do +-- > dir <- pwd +-- > datefile dir +-- > +-- > main :: IO () -- Type signature +-- > main = do +-- > time <- datePwd +-- > print time +-- +-- The first type signature says that @datePwd@ is a subroutine that returns a +-- `UTCTime`: +-- +-- > -- +----- A subroutine ... +-- > -- | +-- > -- | +-- ... that returns `UTCTime` +-- > -- | | +-- > -- v v +-- > datePwd :: IO UTCTime +-- +-- The second type signature says that @main@ is a subroutine that returns an +-- empty value: +-- +-- > -- +----- A subroutine ... +-- > -- | +-- > -- | +-- ... that returns an empty value (i.e. `()`) +-- > -- | | +-- > -- v v +-- > main :: IO () +-- +-- Not every top-level value has to be a subroutine, though. For example, you +-- can define unadorned `Text` values at the top-level, as we saw previously: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > +-- > str :: Text +-- > str = "Hello!" +-- > +-- > main :: IO () +-- > main = echo str +-- +-- These type annotations do not assist the compiler. Instead, the compiler +-- independently infers the type and then checks whether it matches the +-- documented type. If there is a mismatch the compiler will raise a type +-- error. +-- +-- Let's test this out by providing an incorrect type for @\'str\'@: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > +-- > str :: Int +-- > str = "Hello!" +-- > +-- > main :: IO () +-- > main = echo str +-- +-- If you run that script, you will get two error messages: +-- +-- > $ ./example.hs +-- > +-- > example.hs:8:7: +-- > No instance for (IsString Int) +-- > arising from the literal `"Hello, world!"' +-- > Possible fix: add an instance declaration for (IsString Int) +-- > In the expression: "Hello, world!" +-- > In an equation for `str': str = "Hello, world!" +-- > +-- > example.hs:11:13: +-- > Couldn't match expected type `Text' with actual type `Int' +-- > In the first argument of `echo', namely `str' +-- > In the expression: echo str +-- > In an equation for `main': main = echo str +-- +-- The first error message relates to the @OverloadedStrings@ extensions. When +-- we enable @OverloadedStrings@ the compiler overloads string literals, +-- interpreting them as any type that implements the `IsString` interface. The +-- error message says that `Int` does not implement the `IsString` interface so +-- the compiler cannot interpret a string literal as an `Int`. On the other +-- hand the `Text` and `Turtle.FilePath` types do implement `IsString`, which +-- is why we can interpret string literals as `Text` or `Turtle.FilePath` +-- values. +-- +-- The second error message says that `echo` expects a `Text` value, but we +-- declared @str@ to be an `Int`, so the compiler aborts compilation, requiring +-- us to either fix or delete our type signature. +-- +-- Notice that there is nothing wrong with the program other than the type +-- signature we added. If we were to delete the type signature the program +-- would compile and run correctly. The sole purpose of this type signature is +-- for us to communicate our expectations to the compiler so that the compiler +-- can alert us if the code does not match our expectations. +-- +-- Let's also try reversing the type error, providing a number where we expect +-- a string: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > +-- > str :: Text +-- > str = 4 +-- > +-- > main :: IO () +-- > main = echo str +-- +-- This gives a different error: +-- +-- > $ ./example.hs +-- > +-- > example.hs:8:7: +-- > No instance for (Num Text) +-- > arising from the literal `4' +-- > Possible fix: add an instance declaration for (Num Text) +-- > In the expression: 4 +-- > In an equation for `str': str = 4 +-- +-- Haskell also automatically overloads numeric literals, too. The compiler +-- interprets integer literals as any type that implements the `Num` interface. +-- The `Text` type does not implement the `Num` interface, so we cannot +-- interpret integer literals as `Text` strings. + +-- $system +-- +-- You can invoke arbitrary shell commands using the `shell` command. For +-- example, we can write a program that creates an empty directory and then +-- uses a `shell` command to archive the directory: +-- +-- @ +-- #!\/usr\/bin\/env stack +-- \-\- stack \-\-install-ghc runghc \-\-package turtle +-- \ +-- -- #!\/bin\/bash +-- {-\# LANGUAGE OverloadedStrings \#-} -- +-- -- +-- import Turtle -- +-- -- +-- main = do -- +-- mkdir \"test\" -- mkdir test +-- `shell` \"tar czf test.tar.gz test\" empty -- tar czf test.tar.gz test +-- @ +-- +-- If you run this program, it will generate the @test.tar.gz@ archive: +-- +-- > $ ./example.hs +-- > ExitSuccess +-- > $ echo $? +-- > 0 +-- > $ ls test.tar.gz +-- > test.tar.gz +-- +-- Like @ghci@, the @runhaskell@ command running our script prints any non-empty +-- result of the @main@ subroutine (`ExitSuccess` in this case). +-- +-- The easiest way to learn a new command like `shell` is to view its +-- documentation. Click on the word `shell`, which will take you to +-- documentation that looks like this: +-- +-- @ +-- `shell` +-- :: Text -- Command line +-- -> Shell Text -- Standard input (as lines of \`Text\`) +-- -> IO `ExitCode` -- Exit code of the shell command +-- @ +-- +-- The first argument is a `Text` representation of the command to run. The +-- second argument lets you feed input to the command, and you can provide +-- `empty` for now to feed no input. +-- +-- The final result is an `ExitCode`, which you can use to detect whether the +-- command completed successfully. For example, we could print a more +-- descriptive error message if an external command fails: +-- +-- @ +-- #!\/usr\/bin\/env stack +-- \-\- stack \-\-install-ghc runghc \-\-package turtle +-- +-- {-\# LANGUAGE OverloadedStrings \#-} +-- +-- import Turtle +-- +-- main = do +-- let cmd = \"false\" +-- x <- shell cmd empty +-- case x of +-- ExitSuccess -> return () +-- ExitFailure n -> `die` (cmd \<\> \" failed with exit code: \" \<\> repr n) +-- @ +-- +-- This prints an error message since the @false@ command always fails: +-- +-- > $ ./example.hs +-- > example.hs: user error (false failed with exit code: 1) +-- +-- You should also check out the `proc` command, which is less powerful but +-- safer since it decreases the likelihood of code injection or malformed +-- commands: +-- +-- @ +-- `proc` +-- :: Text -- Program +-- :: [Text] -- Arguments +-- -> Shell Text -- Standard input (as lines of \`Text\`) +-- -> IO ExitCode -- Exit code of the shell command +-- @ +-- +-- Most of the commands in this library do not actually invoke an external +-- shell or program. Instead, they indirectly wrap other Haskell libraries that +-- bind to C code. + +-- $format +-- +-- This library provides type-safe string formatting utilities, too. For +-- example, instead of writing this: +-- +-- > cmd <> " failed with exit code: " <> repr n +-- +-- ... you could format the string using @printf@ style instead: +-- +-- > format (s%" failed with exit code: "%d) cmd n +-- +-- What's neat is that the compiler will automatically infer the number of +-- arguments and their types from the `Format` string: +-- +-- > $ stack ghci +-- > Prelude Turtle> :type format (s%" failed with exit code: "%d) +-- > format (s%" failed with exit code: "%d) :: Text -> Int -> Text +-- +-- The compiler deduces that the above `Format` string requires one argument of +-- type `Text` to satisfy the `s` at the beginning of the format string and +-- another argument of type `Int` to satisfy the `d` at the end of the format +-- string. +-- +-- Note that this is also the idiomatic way to convert a `FilePath` to `Text`: +-- +-- > format fp :: FilePath -> Text +-- +-- If you are interested in this feature, check out the "Turtle.Format" module +-- for more details. + +-- $streams +-- The @turtle@ library provides support for streaming computations, just like +-- Bash. The primitive @turtle@ streams are little more verbose than their +-- Bash counterparts, but @turtle@ streams can be built and combined in more +-- ways. +-- +-- The key type for streams is the `Shell` type, which represents a stream of +-- values. For example, the `ls` function has a streaming result: +-- +-- @ +-- Prelude Turtle> :type `ls` +-- `ls` :: Turtle.FilePath -> `Shell` Turtle.FilePath +-- @ +-- +-- That type says that `ls` takes a single `Turtle.FilePath` as its argument +-- (the directory to list) and the result is a `Shell` stream of +-- `Turtle.FilePath`s (the immediate children of that directory). +-- +-- You can't run a `Shell` stream directly within @ghci@. You will get a type +-- error like this if you try: +-- +-- > Prelude Turtle> ls "/tmp" +-- > +-- > <interactive>:2:1: +-- > No instance for (Show (Shell Turtle.FilePath)) +-- > arising from a use of `print' +-- > Possible fix: +-- > add an instance declaration for (Show (Shell Turtle.FilePath)) +-- > In a stmt of an interactive GHCi command: print it +-- +-- Instead, you must consume the stream as it is generated and the simplest way +-- to consume a `Shell` stream is `view`: +-- +-- @ +-- `view` :: Show a => Shell a -> IO () +-- @ +-- +-- `view` takes any `Shell` stream of values and `print`s them to standard +-- output: +-- +-- > Prelude Turtle> view (ls "/tmp") +-- > FilePath "/tmp/.X11-unix" +-- > FilePath "/tmp/.X0-lock" +-- > FilePath "/tmp/pulse-PKdhtXMmr18n" +-- > FilePath "/tmp/pulse-xHYcZ3zmN3Fv" +-- > FilePath "/tmp/tracker-gabriel" +-- > FilePath "/tmp/pulse-PYi1hSlWgNj2" +-- > FilePath "/tmp/orbit-gabriel" +-- > FilePath "/tmp/ssh-vREYGbWGpiCa" +-- > FilePath "/tmp/.ICE-unix +-- +-- You can build your own `Shell` streams using a few primitive operations, +-- +-- The first primitive is `empty`, which represents an empty stream of values: +-- +-- @ +-- Prelude Turtle> view `empty` -- Outputs nothing +-- Prelude Turtle> +-- @ +-- +-- Another way to say that is: +-- +-- @ +-- view `empty` = return () +-- @ +-- +-- The type of empty is: +-- +-- @ +-- `empty` :: Shell a +-- @ +-- +-- The lower-case @\'a\'@ is \"polymorphic\", meaning that it will type check as +-- any type. That means that you can produce an `empty` stream of any type of +-- value. +-- +-- The next simplest function is `return`, which lets you take any value and +-- transform it into a singleton `Shell` that emits just that one value: +-- +-- @ +-- Prelude Turtle> view (`return` 1) +-- 1 +-- @ +-- +-- Another way to say that is: +-- +-- @ +-- view (`return` x) = print x +-- @ +-- +-- The type of `return` is: +-- +-- @ +-- `return` :: a -> Shell a +-- @ +-- +-- Notice that this is the same `return` function we saw before. This is +-- because `return` is overloaded and works with both `IO` and `Shell`. +-- +-- You can also take any subroutine ('IO') and transform it into a singleton +-- `Shell`: +-- +-- @ +-- Prelude Turtle> view (`liftIO` readline) +-- ABC\<Enter\> +-- Just \"ABC\" +-- @ +-- +-- Another way to say that is: +-- +-- @ +-- view (`liftIO` io) = do x <- io +-- print x +-- @ +-- +-- The type of `liftIO` is: +-- +-- @ +-- `liftIO` :: IO a -> Shell a +-- @ +-- +-- Once you have those primitive `Shell` streams you can begin to combine them +-- into larger `Shell` streams. For example, you can concatenate two `Shell` +-- streams using (`<|>`): +-- +-- @ +-- view (return 1 `<|>` return 2) +-- 1 +-- 2 +-- @ +-- +-- Another way to say that is: +-- +-- @ +-- view (xs `<|>` ys) = do view xs +-- view ys +-- @ +-- +-- The type of (`<|>`) is: +-- +-- @ +-- (`<|>`) :: Shell a -> Shell a -> Shell a +-- @ +-- +-- In other words, you can concatenate two `Shell` streams of the same element +-- type to get a new `Shell` stream, also of the same element type. +-- +-- Let's try using (`<|>`) on two real streams: +-- +-- > Prelude Turtle> view (ls "/tmp" <|> ls "/usr") +-- > FilePath "/tmp/.X11-unix" +-- > FilePath "/tmp/.X0-lock" +-- > FilePath "/tmp/pulse-PKdhtXMmr18n" +-- > FilePath "/tmp/pulse-xHYcZ3zmN3Fv" +-- > FilePath "/tmp/tracker-gabriel" +-- > FilePath "/tmp/pulse-PYi1hSlWgNj2" +-- > FilePath "/tmp/orbit-gabriel" +-- > FilePath "/tmp/ssh-vREYGbWGpiCa" +-- > FilePath "/tmp/.ICE-unix" +-- > FilePath "/usr/lib" +-- > FilePath "/usr/src" +-- > FilePath "/usr/sbin" +-- > FilePath "/usr/include" +-- > FilePath "/usr/share" +-- > FilePath "/usr/games" +-- > FilePath "/usr/local" +-- > FilePath "/usr/bin" +-- +-- Finally, note that `Shell` implements the `IsString` interface, so a string +-- literal will type-check as a `Shell` that emits a single `Text` value: +-- +-- > Prelude Turtle> view "123" +-- > "123" +-- > Prelude Turtle> view (return "123") -- Same thing +-- > "123" +-- > Prelude Turtle> view ("123" <|> "456") +-- > "123" +-- > "456" +-- > Prelude Turtle> view (return "123" <|> return "456") -- Same thing +-- > "123" +-- > "456" + +-- $loops +-- +-- This library also provides the `select` function for conveniently emitting a +-- list of values: +-- +-- @ +-- Prelude Turtle> view (`select` [1, 2, 3]) +-- 1 +-- 2 +-- 3 +-- @ +-- +-- We can use `select` to implement loops within a `Shell`: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > -- #!/bin/bash +-- > {-# LANGUAGE OverloadedStrings #-} -- +-- > -- +-- > import Turtle -- +-- > -- +-- > example = do -- +-- > x <- select [1, 2] -- for x in 1 2; do +-- > y <- select [3, 4] -- for y in 3 4; do +-- > liftIO (print (x, y)) -- echo \(${x},${y}\); +-- > -- done; +-- > main = sh example -- done +-- +-- That will `print` every permutation of @\'x\'@ and @\'y\'@: +-- +-- > $ ./example +-- > (1,3) +-- > (1,4) +-- > (2,3) +-- > (2,4) +-- +-- This uses the `sh` utility instead of `view`. The only difference is that +-- `sh` doesn't print any values (since `print` is doing that already): +-- +-- @ +-- `sh` :: Shell a -> IO () +-- @ +-- +-- This trick isn't limited to `select`. You can loop over the output of any +-- `Shell` by just binding its result. For example, this is how `view` loops +-- over its argument: +-- +-- > view :: Show a => Shell a -> IO () +-- > view s = sh (do +-- > x <- s -- `x` ranges over every output of `s` +-- > liftIO (print x) ) +-- +-- You can also loop over a stream in a one-liner, still using @do@ notation. +-- Just insert semi-colons between statements: +-- +-- > Prelude Turtle> -- for file in /tmp/*; do echo $file; done +-- > Prelude Turtle> sh (do file <- ls "/tmp"; liftIO (print file)) +-- > FilePath "/tmp/.X11-unix" +-- > FilePath "/tmp/.X0-lock" +-- > FilePath "/tmp/pulse-PKdhtXMmr18n" +-- > FilePath "/tmp/pulse-xHYcZ3zmN3Fv" +-- > FilePath "/tmp/tracker-gabriel" +-- > FilePath "/tmp/pulse-PYi1hSlWgNj2" +-- > FilePath "/tmp/orbit-gabriel" +-- > FilePath "/tmp/ssh-vREYGbWGpiCa" +-- > FilePath "/tmp/.ICE-unix" + +-- $folds +-- +-- There are other ways you can consume a `Shell` stream. For example, you can +-- `fold` the stream using predefined `Fold`s from "Control.Foldl": +-- +-- @ +-- Prelude Turtle> import qualified "Control.Foldl" as Fold +-- Prelude Turtle Fold> `fold` (ls \"/tmp\") Fold.length +-- 9 +-- @ +-- +-- @ +-- Prelude Turtle Fold> `fold` (ls \"/tmp\") Fold.head +-- Just (FilePath \"\/tmp\/.X11-unix\") +-- @ +-- +-- @ +-- Prelude Turtle Fold> `fold` (ls \"\/tmp\") Fold.list +-- [FilePath \"\/tmp\/.X11-unix\",FilePath \"\/tmp\/.X0-lock\",FilePath \"\/tmp\/pulse-PKd +-- htXMmr18n\",FilePath \"\/tmp\/pulse-xHYcZ3zmN3Fv\",FilePath \"\/tmp\/tracker-gabriel +-- \",FilePath \"\/tmp\/pulse-PYi1hSlWgNj2\",FilePath \"\/tmp\/orbit-gabriel\",FilePath +-- \"\/tmp\/ssh-vREYGbWGpiCa\",FilePath \"\/tmp\/.ICE-unix\"] +-- @ +-- +-- You can also compute multiple things in a single pass over the stream: +-- +-- > Prelude Turtle> fold (select [1..10]) ((,) <$> Fold.minimum <*> Fold.maximum) +-- > (Just 1,Just 10) +-- +-- If you are interested in this feature, check out the documentation in +-- "Control.Foldl". + +-- $io +-- +-- @turtle@ comes with built-in support for the standard text streams. +-- +-- For example, you can write to standard output using the `stdout` utility: +-- +-- @ +-- `stdout` :: Shell Text -> IO () +-- `stdout` s = sh (do +-- txt <- s +-- liftIO (echo txt) ) +-- @ +-- +-- `stdout` outputs each `Text` value on its own line: +-- +-- > Prelude Turtle> stdout "Line 1" +-- > Line 1 +-- > Prelude Turtle> stdout ("Line 1" <|> "Line 2") +-- > Line 1 +-- > Line 2 +-- +-- Another useful stream is `stdin`, which emits one line of `Text` per line of +-- standard input: +-- +-- @ +-- `stdin` :: Shell Text +-- @ +-- +-- Let's combine `stdin` and `stdout` to forward all input from standard input +-- to standard output: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > -- #!/bin/bash +-- > {-# LANGUAGE OverloadedStrings #-} -- +-- > -- +-- > import Turtle -- +-- > -- +-- > main = stdout stdin -- cat +-- +-- If you run that it will continue to echo lines until you signal end of input +-- using @Ctrl-D@: +-- +-- > $ ./example.hs +-- > ABC<Enter> +-- > ABC +-- > Test<Enter> +-- > Test +-- > 42<Enter> +-- > 42 +-- > <Ctrl-D> +-- > $ +-- +-- You can also read and write to files using the `input` and `output` +-- utilities: +-- +-- @ +-- Prelude Turtle> `output` \"file.txt\" (\"Test\" \<|\> \"ABC\" \<|\> \"42\") +-- Prelude Turtle> stdout (`input` \"file.txt\") +-- Test +-- ABC +-- 42 +-- @ + +-- $external +-- +-- You can embed external shell commands as streams within your Haskell program. +-- +-- For example, suppose that we want to use the system's built in @ls@ command. +-- We can just run: +-- +-- > Prelude Turtle> stdout (inshell "ls" empty) +-- > .X11-unix +-- > .X0-lock +-- > pulse-PKdhtXMmr18n +-- > pulse-xHYcZ3zmN3Fv +-- > tracker-gabriel +-- > pulse-PYi1hSlWgNj2 +-- > orbit-gabriel +-- > ssh-vREYGbWGpiCa +-- > .ICE-unix +-- +-- This works because type of `inshell` is: +-- +-- @ +-- `inshell` +-- :: Text -- Command line +-- -> Shell Text -- Standard input to feed to program +-- -> Shell Text -- Standard output produced by program +-- @ +-- +-- This means you can use `inshell` to embed arbitrary external utilities as +-- first class streams within your Haskell program: +-- +-- > Turtle Prelude> stdout (inshell "awk '{ print $1 }'" "123 456") +-- > 123 +-- +-- You should also check out the `inproc` command, which is less powerful but +-- safer since it decreases the likelihood of code injection or malformed +-- commands: +-- +-- @ +-- `inproc` +-- :: Text -- Program +-- -> [Text] -- Arguments +-- -> Shell Text -- Standard input to feed to program +-- -> Shell Text -- Standard output produced by program +-- @ +-- +-- Using `inproc`, you would write: +-- +-- > Turtle Prelude> stdout (inproc "awk" ["{ print $1 }"] "123 456") +-- > 123 + +-- $patterns +-- +-- You can transform streams using Unix-like utilities. For example, you can +-- filter a stream using `grep`. +-- +-- @ +-- Prelude Turtle> stdout (input \"file.txt\") +-- Test +-- ABC +-- 42 +-- Prelude Turtle> stdout (`grep` \"ABC\" (input \"file.txt\")) +-- ABC +-- @ +-- +-- Let's look at the type of `grep`: +-- +-- @ +-- `grep` :: Pattern a -> Shell Text -> Shell Text +-- @ +-- +-- The first argument of `grep` is actually a `Pattern`, which implements +-- `IsString`. When we pass a string literal we just create a `Pattern` that +-- matches the given literal. +-- +-- `Pattern`s generalize regular expressions and you can use this table to +-- roughly translate several regular expression idioms to `Pattern`s: +-- +-- @ +-- Regex Pattern +-- ========= ========= +-- \"string\" \"string\" +-- . `dot` +-- e1 e2 e1 `<>` e2 +-- e1 | e2 e1 `<|>` e2 +-- e* `star` e +-- e+ `plus` e +-- e*? `selfless` (`star` e) +-- e+? `selfless` (`plus` e) +-- e{n} `count` n e +-- e{m,n} `bounded` m n e +-- e{0,n} `upperBounded` n e +-- e? `optional` e +-- [xyz] `oneOf` \"xyz\" +-- [^xyz] `noneOf` \"xyz\" +-- @ +-- +-- Here are some examples: +-- +-- > Prelude Turtle> -- grep '^[[:digit:]]\+$' file.txt +-- > Prelude Turtle> stdout (grep (plus digit) (input "file.txt")) +-- > 42 +-- > Prelude Turtle> -- grep '^[[:digit:]]\+\|Test$' file.txt +-- > Prelude Turtle> stdout (grep (plus digit <|> "Test") (input "file.txt")) +-- > Test +-- > 42 +-- +-- Note that @turtle@'s `grep` subtly differs from the traditional @grep@ +-- command. The `Pattern` you provide must match the entire line. If you +-- want to match the interior of a line, you can use the `has` utility: +-- +-- @ +-- Prelude Turtle> -- grep B file.txt +-- Prelude Turtle> stdout (grep (`has` \"B\") (input \"file.txt\")) +-- ABC +-- @ +-- +-- You can also use `prefix` or `suffix` to match the beginning or end of a +-- string, respectively: +-- +-- @ +-- Prelude Turtle> -- grep '^A' file.txt +-- Prelude Turtle> stdout (grep (`prefix` \"A\") (input \"file.txt\")) +-- ABC +-- Prelude Turtle> -- grep 'C$' file.txt +-- Prelude Turtle> stdout (grep (`suffix` \"C\") (input \"file.txt\")) +-- ABC +-- @ +-- +-- `sed` also uses `Pattern`s, too, and is more flexible than Unix @sed@: +-- +-- @ +-- Prelude Turtle> -- sed 's/C/D/g' file.txt +-- Prelude Turtle> stdout (`sed` (\"C\" `*>` return \"D\") (input \"file.txt\")) +-- Test +-- ABD +-- 42 +-- Prelude Turtle> -- sed 's\/[[:digit:]]\/!\/g' file.txt +-- Prelude Turtle> stdout (`sed` (digit `*>` return \"!\") (input \"file.txt\")) +-- Test +-- ABC +-- !! +-- Prelude Turtle> import qualified Data.Text as Text +-- Prelude Turtle> -- rev file.txt +-- Prelude Turtle> stdout (`sed` (`fmap` Text.reverse (plus dot)) (input \"file.txt\")) +-- tseT +-- CBA +-- 24 +-- Prelude Turtle> +-- @ +-- +-- You can also use `Pattern`s by themselves to parse arbitrary text into more +-- structured values: +-- +-- @ +-- Prelude Turtle> let pair = do x <- `decimal`; \" \"; y <- `decimal`; return (x, y) +-- Prelude Turtle> :type pair +-- pair :: `Pattern` (Integer, Integer) +-- Prelude Turtle> `match` pair \"123 456\" +-- [(123,456)] +-- Prelude Turtle> data Pet = Cat | Dog deriving (Show) +-- Prelude Turtle> let pet = (\"cat\" *> return Cat) \<|\> (\"dog\" *> return Dog) :: `Pattern` Pet +-- Prelude Turtle> `match` pet \"dog\" +-- [Dog] +-- Prelude Turtle> `match` (pet \``sepBy`\` \",\") \"cat,dog,cat\" +-- [[Cat,Dog,Cat]] +-- @ +-- +-- See the "Turtle.Pattern" module for more details if you are interested in +-- writing more complex `Pattern`s. + +-- $exceptions +-- +-- Sometimes you may want to acquire resources and ensure they get released +-- correctly if there are any exceptions. You can use `Managed` resources to +-- acquire things safely within a `Shell`. +-- +-- You can think of a `Managed` resource as some resource that needs to be +-- acquired and then released afterwards. Example: you want to create a +-- temporary file and then guarantee it's deleted afterwards, even if the +-- program fails with an exception. +-- +-- "Turtle.Prelude" provides two `Managed` utilities for creating temporary +-- directories or files: +-- +-- @ +-- `mktempdir` +-- :: FilePath -- Parent directory +-- -> Text -- Directory name template +-- -> `Managed` FilePath -- Temporary directory +-- @ +-- +-- @ +-- `mktemp` +-- :: FilePath -- Parent directory +-- -> Text -- File name template +-- -> `Managed` (FilePath, Handle) -- Temporary file +-- @ +-- +-- You can acquire a `Managed` resource within a `Shell` with `using`: +-- +-- @ +-- `using` :: Managed a -> Shell a +-- @ +-- +-- ... and here is an example of creating a temporary directory and file within +-- a `Shell`: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > +-- > main = sh (do +-- > dir <- using (mktempdir "/tmp" "turtle") +-- > (file, _) <- using (mktemp dir "turtle") +-- > liftIO (print file) ) +-- +-- When you run the above script it will print out the name of the temporary +-- directory and file: +-- +-- > $ ./example.hs +-- > FilePath "/tmp/turtle15976/turtle15976" +-- +-- ... and you can verify that they were deleted afterwards: +-- +-- > Turtle Prelude> view (find (has "turtle") "/tmp") +-- > Turtle Prelude> -- No results +-- +-- As an exercise, try inserting an exception and verifying that the temporary: +-- file and directory are still cleaned up correctly: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > +-- > main = sh (do +-- > dir <- using (mktempdir "/tmp" "turtle") +-- > (file, _) <- using (mktemp dir "turtle") +-- > liftIO (print file) +-- > liftIO (die "Urk!") ) +-- +-- To learn more about `Managed` resources, read the documentation in +-- "Control.Monad.Managed". + +-- $monadio +-- +-- If you are sick of having type `liftIO` everywhere, you can omit it. This +-- is because all subroutines in @turtle@ are overloaded using the `MonadIO` +-- type class, like our original `pwd` command where we first encountered the +-- the `MonadIO` type: +-- +-- @ +-- Prelude Turtle> :type pwd +-- pwd :: `MonadIO` io => io Turtle.`Turtle.FilePath` +-- @ +-- +-- This means you can this command is overloaded to run in any context that +-- implements the `MonadIO` interface, including: +-- +-- * `IO` (obviously) +-- +-- * `Shell` +-- +-- * `Managed` +-- +-- You can tell if a type constructor like `Shell` implements `MonadIO` by +-- clicking the link to the type constructor and looking for the instance list. +-- There you will see a list of instances like: +-- +-- > Monad Shell +-- > Functor Shell +-- > MonadPlus Shell +-- > Applicative Shell +-- > Alternative Shell +-- > MonadIO Shell +-- > ... +-- +-- These instances represent the overloaded functions associated with `Shell` +-- and we can see from the list that `Shell` implements `MonadIO` so we can +-- use `pwd` (or any other subroutine in this library) within a `Shell`. +-- +-- However, not all subroutines in the Haskell ecosystem are overloaded in this +-- way (such as `print`), so you will still occasionally need to wrap +-- subroutines in `liftIO`. + +-- $cmdline +-- +-- The "Turtle.Options" module lets you easily parse command line arguments, +-- using either flags or positional arguments. +-- +-- For example, if you want to write a @cp@-like script that takes two +-- positional arguments for the source and destination file, you can write: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > -- cp.hs +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > import Prelude hiding (FilePath) +-- > +-- > parser :: Parser (FilePath, FilePath) +-- > parser = (,) <$> argPath "src" "The source file" +-- > <*> argPath "dest" "The destination file" +-- > +-- > main = do +-- > (src, dest) <- options "A simple `cp` script" parser +-- > cp src dest +-- +-- If you run the script without any arguments, you will get an auto-generated +-- usage output: +-- +-- > $ ./cp.hs +-- > Usage: cp.hs SRC DEST +-- +-- ... and you can get a more descriptive output if you supply the @--help@ +-- flag: +-- +-- > $ ./cp.hs --help +-- > A simple `cp` utility +-- > +-- > Usage: cp.hs SRC DEST +-- > +-- > Available options: +-- > -h,--help Show this help text +-- > SRC The source file +-- > DEST The destination file +-- +-- ... and the script works as expected if you provide both arguments: +-- +-- > echo "Test" > file1.txt +-- > $ ./cp.hs file1.txt file2.txt +-- > cat file2.txt +-- > Test +-- +-- This works because `argPath` produces a `Parser`: +-- +-- > argPath :: ArgName -> Optional HelpMessage -> Parser FilePath +-- +-- ... and multiple `Parser`s can be combined into a single `Parser` using +-- operations from the `Applicative` type class since the `Parser` type +-- implements the `Applicative` interface: +-- +-- > instance Applicative Parser +-- +-- You can also make any argument optional using the `optional` utility +-- provided by `Control.Applicative`: +-- +-- @ +-- `optional` :: `Alternative` f => f a -> f (Maybe a) +-- @ +-- +-- For example, we can change our program to make the destination argument +-- optional, defaulting to `stdout` if the user does not provide a destination: +-- +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > import Prelude hiding (FilePath) +-- > +-- > parser :: Parser (FilePath, Maybe FilePath) +-- > parser = (,) <$> argPath "src" "The source file" +-- > <*> optional (argPath "dest" "The destination file") +-- > +-- > main = do +-- > (src, mDest) <- options "A simple `cp` utility" parser +-- > case mDest of +-- > Nothing -> input src & stdout +-- > Just dest -> cp src dest +-- +-- Now the auto-generated usage information correctly indicates that the second +-- argument is optional: +-- +-- > $ ./cp.hs +-- > Usage: cp.hs SRC [DEST] +-- > $ ./cp.hs --help +-- > A simple `cp` utility +-- > +-- > Usage: cp.hs SRC [DEST] +-- > +-- > Available options: +-- > -h,--help Show this help text +-- > SRC The source file +-- > DEST The destination file +-- +-- ... and if we omit the argument the result goes to standard output: +-- +-- > $ ./cp.hs file1.txt +-- > Test +-- +-- We can use the `optional` utility because the `Parser` type also implements +-- the `Alternative` interface: +-- +-- > instance Alternative Parser +-- +-- We can also specify arguments on the command lines using flags instead of +-- specifying them positionally. Let's change our example to specify the +-- input and output using the @--src@ and @--dest@ flags, using @-s@ and @-d@ +-- as short-hands for the flags: +-- +-- > #!/usr/bin/env stack +-- > -- stack --install-ghc runghc --package turtle +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Turtle +-- > import Prelude hiding (FilePath) +-- > +-- > parser :: Parser (FilePath, FilePath) +-- > parser = (,) <$> optPath "src" 's' "The source file" +-- > <*> optPath "dest" 'd' "The destination file" +-- > +-- > main = do +-- > (src, dest) <- options "A simple `cp` utility" parser +-- > cp src dest +-- +-- This now lets us specify the arguments in terms of flags: +-- +-- > $ ./cp +-- > Usage: cp.hs (-s|--src SRC) (-d|--dest DEST) +-- > $ ./cp --help +-- > A simple `cp` utility +-- > +-- > Usage: cp.hs (-s|--src SRC) (-d|--dest DEST) +-- > +-- > Available options: +-- > -h,--help Show this help text +-- > -s,--src SRC The source file +-- > -d,--dest DEST The destination file +-- > $ ./cp --src file1.txt --dest file3.txt +-- > $ cat file3.txt +-- > Test +-- +-- See the "Turtle.Options" module for more details and utilities related to +-- parsing command line options. This module is built on top of the +-- @optparse-applicative@ library, which provides even more extensive +-- functionality. + +-- $conclusion +-- +-- By this point you should be able to write basic shell scripts in Haskell. If +-- you would like to learn more advanced tricks, take the time to read the +-- documentation in these modules: +-- +-- * "Turtle.Prelude" +-- +-- * "Turtle.Format" +-- +-- * "Turtle.Pattern" +-- +-- * "Turtle.Shell" +-- +-- * "Control.Foldl" +-- +-- * "Control.Monad.Managed" +-- +-- If you have more questions or need help learning the library, ask a question +-- on Stack Overflow under the @haskell-turtle@ tag. For bugs or feature +-- requests, create an issue on Github at +-- <https://github.com/Gabriel439/Haskell-Turtle-Library/issues> +-- +-- This library provides an extended suite of Unix-like utilities, but would +-- still benefit from adding more utilities for better parity with the Unix +-- ecosystem. Pull requests to add new utilities are highly welcome!
test/Main.hs view
@@ -1,6 +1,6 @@-module Main where--import Test.DocTest--main :: IO ()-main = doctest ["src/Turtle/Pattern.hs", "src/Turtle/Format.hs"]+module Main where + +import Test.DocTest + +main :: IO () +main = doctest ["src/Turtle/Pattern.hs", "src/Turtle/Format.hs"]
turtle.cabal view
@@ -1,100 +1,101 @@-Name: turtle-Version: 1.2.1-Cabal-Version: >=1.10-Build-Type: Simple-License: BSD3-License-File: LICENSE-Copyright: 2015 Gabriel Gonzalez-Author: Gabriel Gonzalez-Maintainer: Gabriel439@gmail.com-Bug-Reports: https://github.com/Gabriel439/Haskell-Turtle-Library/issues-Synopsis: Shell programming, Haskell-style-Description: @turtle@ is a reimplementation of the Unix command line environment- in Haskell so that you can use Haskell as both a shell and a scripting- language.- .- Features include:- .- * Batteries included: Command an extended suite of predefined utilities- .- * Interoperability: You can still run external shell commands- .- * Portability: Works on Windows, OS X, and Linux- .- * Exception safety: Safely acquire and release resources - .- * Streaming: Transform or fold command output in constant space- .- * Patterns: Use typed regular expressions that can parse structured values- .- * Formatting: Type-safe @printf@-style text formatting- .- * Modern: Supports @text@ and @system-filepath@- .- Read "Turtle.Tutorial" for a detailed tutorial or "Turtle.Prelude" for a- quick-start guide- .- @turtle@ is designed to be beginner-friendly, but as a result lacks certain- features, like tracing commands. If you feel comfortable using @turtle@- then you should also check out the @Shelly@ library which provides similar- functionality.-Category: System-Source-Repository head- Type: git- Location: https://github.com/Gabriel439/Haskell-Turtle-Library--Library- HS-Source-Dirs: src- Build-Depends:- base >= 4.5 && < 5 ,- async >= 2.0.0.0 && < 2.1,- clock >= 0.4.1.2 && < 0.6,- directory >= 1.0.7 && < 1.3,- foldl >= 1.1 && < 1.2,- hostname < 1.1,- managed < 1.1,- process >= 1.0.1.1 && < 1.3,- system-filepath >= 0.3.1 && < 0.5,- system-fileio >= 0.2.1 && < 0.4,- temporary < 1.3,- text < 1.3,- time < 1.6,- transformers >= 0.2.0.0 && < 0.5,- optparse-applicative >= 0.11 && < 0.12,- optional-args >= 1.0 && < 2.0- if os(windows)- Build-Depends: Win32 >= 2.2.0.1 && < 2.4- else- Build-Depends: unix >= 2.5.1.0 && < 2.8- Exposed-Modules:- Turtle,- Turtle.Format,- Turtle.Pattern,- Turtle.Shell,- Turtle.Options,- Turtle.Prelude,- Turtle.Tutorial- GHC-Options: -O2 -Wall- Default-Language: Haskell2010--test-suite tests- Type: exitcode-stdio-1.0- HS-Source-Dirs: test- Main-Is: Main.hs- GHC-Options: -O2 -Wall- Default-Language: Haskell2010- Build-Depends:- base >= 4 && < 5 ,- doctest >= 0.9.12 && < 0.11--benchmark bench- Type: exitcode-stdio-1.0- HS-Source-Dirs: bench- Main-Is: Main.hs- GHC-Options: -O2 -Wall -threaded- Default-Language: Haskell2010- Build-Depends:- base >= 4 && < 5 ,- criterion >= 1.1.0.0 && < 2 ,- text < 1.3,- turtle+Name: turtle +Version: 1.2.2 +Cabal-Version: >=1.10 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Copyright: 2015 Gabriel Gonzalez +Author: Gabriel Gonzalez +Maintainer: Gabriel439@gmail.com +Bug-Reports: https://github.com/Gabriel439/Haskell-Turtle-Library/issues +Synopsis: Shell programming, Haskell-style +Description: @turtle@ is a reimplementation of the Unix command line environment + in Haskell so that you can use Haskell as both a shell and a scripting + language. + . + Features include: + . + * Batteries included: Command an extended suite of predefined utilities + . + * Interoperability: You can still run external shell commands + . + * Portability: Works on Windows, OS X, and Linux + . + * Exception safety: Safely acquire and release resources + . + * Streaming: Transform or fold command output in constant space + . + * Patterns: Use typed regular expressions that can parse structured values + . + * Formatting: Type-safe @printf@-style text formatting + . + * Modern: Supports @text@ and @system-filepath@ + . + Read "Turtle.Tutorial" for a detailed tutorial or "Turtle.Prelude" for a + quick-start guide + . + @turtle@ is designed to be beginner-friendly, but as a result lacks certain + features, like tracing commands. If you feel comfortable using @turtle@ + then you should also check out the @Shelly@ library which provides similar + functionality. +Category: System +Source-Repository head + Type: git + Location: https://github.com/Gabriel439/Haskell-Turtle-Library + +Library + HS-Source-Dirs: src + Build-Depends: + base >= 4.5 && < 5 , + async >= 2.0.0.0 && < 2.1, + clock >= 0.4.1.2 && < 0.6, + directory >= 1.0.7 && < 1.3, + foldl >= 1.1 && < 1.2, + hostname < 1.1, + managed < 1.1, + process >= 1.0.1.1 && < 1.3, + system-filepath >= 0.3.1 && < 0.5, + system-fileio >= 0.2.1 && < 0.4, + stm < 2.5, + temporary < 1.3, + text < 1.3, + time < 1.6, + transformers >= 0.2.0.0 && < 0.5, + optparse-applicative >= 0.11 && < 0.13, + optional-args >= 1.0 && < 2.0 + if os(windows) + Build-Depends: Win32 >= 2.2.0.1 && < 2.4 + else + Build-Depends: unix >= 2.5.1.0 && < 2.8 + Exposed-Modules: + Turtle, + Turtle.Format, + Turtle.Pattern, + Turtle.Shell, + Turtle.Options, + Turtle.Prelude, + Turtle.Tutorial + GHC-Options: -O2 -Wall + Default-Language: Haskell2010 + +test-suite tests + Type: exitcode-stdio-1.0 + HS-Source-Dirs: test + Main-Is: Main.hs + GHC-Options: -O2 -Wall + Default-Language: Haskell2010 + Build-Depends: + base >= 4 && < 5 , + doctest >= 0.9.12 && < 0.11 + +benchmark bench + Type: exitcode-stdio-1.0 + HS-Source-Dirs: bench + Main-Is: Main.hs + GHC-Options: -O2 -Wall -threaded + Default-Language: Haskell2010 + Build-Depends: + base >= 4 && < 5 , + criterion >= 1.1.0.0 && < 2 , + text < 1.3, + turtle