diff --git a/src/Turtle.hs b/src/Turtle.hs index 49e31ac..f258e6f 100644 --- a/src/Turtle.hs +++ b/src/Turtle.hs @@ -1,21 +1,59 @@ +-- | This 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.Pattern" provides `Pattern`s, which are like more powerful regular +-- expressions +-- +-- "Turtle.Protected" provides `Protected` resources that are exception-safe +-- +-- "Turtle.Shell" provides a streaming `Shell` abstraction for building +-- exception-safe pipelines +-- +-- "Turtle.Prelude" provides many useful derived utilities to get you started +-- with basic shell-like programming within Haskell +-- +-- "Control.Applicative" provides two classes: +-- +-- * `Applicative`, which works with `Fold`, `Pattern`, `Protected`, and +-- `Shell` +-- +-- * `Alternative`, which works with `Pattern` and `Shell` +-- +-- "Control.Monad" provides two classes: +-- +-- * `Monad`, which works with `Pattern`, `Protected` and `Shell` +-- +-- * `MonadPlus`, which works with `Pattern` and `Shell` +-- +-- "Control.Monad.IO.Class" provides one class: +-- +-- * `MonadIO`, which works with `Protected` and `Shell` +-- +-- Additionally, you might also want to import "Control.Foldl" or +-- "Control.Foldl.Text" qualified. + module Turtle ( - -- * Shell - Shell(..) - , feed - , runShell - - -- * Utilities - , select - , cat - , grep - - -- * Classes - , Applicative(..) - , Alternative(..) - , MonadIO(..) + -- * Modules + module Turtle.Pattern + , module Turtle.Protected + , module Turtle.Shell + , module Turtle.Prelude + , module Control.Applicative + , module Control.Monad + , module Control.Monad.IO.Class ) where -import Control.Applicative (Applicative(..), Alternative(..)) -import Control.Monad.IO.Class (MonadIO(..)) -import Turtle.Shell (Shell(feedIO), feed, runShell) -import Turtle.Util (select, cat, grep) +import Turtle.Pattern +import Turtle.Protected +import Turtle.Shell +import Turtle.Prelude +import Control.Applicative +import Control.Monad +import Control.Monad.IO.Class diff --git a/src/Turtle/Pattern.hs b/src/Turtle/Pattern.hs index 87208a3..6293214 100644 --- a/src/Turtle/Pattern.hs +++ b/src/Turtle/Pattern.hs @@ -7,9 +7,9 @@ Example usage: >>> :set -XOverloadedStrings ->>> match (text "cat" <|> text "dog") "cat" +>>> match ("dog" <|> "cat") "cat" ["cat"] ->>> match (some (notChar ',') <* char ',') "cat,dog" +>>> match (plus (notChar ',') <* char ',') "cat,dog" ["cat"] >>> match (count 3 anyChar) "cat,dog" ["cat"] @@ -17,9 +17,9 @@ This pattern has unlimited backtracking, and will return as many solutions as possible: ->>> match (some anyChar) "123" +>>> match (plus anyChar) "123" ["123","12","1"] ->>> match (some anyChar <* eof) "123" +>>> match (plus anyChar <* eof) "123" ["123"] Use @do@ notation to structure more complex patterns: @@ -220,6 +220,12 @@ notChar c = satisfy (/= c) {-| Match a specific string >>> match (text "12") "123" +["12"] + + You can also omit the `text` function if you enable the @OverloadedStrings@ + extension: + +>>> match "12" "123" ["12"] -} @@ -452,11 +458,11 @@ selfless p = Pattern (StateT (\s -> reverse (runStateT (runPattern p) s))) {-| Parse 1 or more occurrences of the given character ->>> match (some anyChar) "123" +>>> match (plus anyChar) "123" ["123","12","1"] ->>> match (some anyChar <* eof) "123" +>>> match (plus anyChar <* eof) "123" ["123"] ->>> match (some anyChar) "" +>>> match (plus anyChar) "" [] -} plus :: Pattern Char -> Pattern Text diff --git a/src/Turtle/Util.hs b/src/Turtle/Prelude.hs similarity index 89% rename from src/Turtle/Util.hs rename to src/Turtle/Prelude.hs index 0cc6b76..bdf5479 100644 --- a/src/Turtle/Util.hs +++ b/src/Turtle/Prelude.hs @@ -1,4 +1,22 @@ -module Turtle.Util where +{-| These are derived utilities built on the primitives exposed by other + modules +-} + +module Turtle.Prelude ( + select + , cat + , grep + , sed + , form + + -- * Input and output + , handleIn + , stdIn + , fileIn + , handleOut + , stdOut + , fileOut + ) where import Control.Applicative (Alternative(..)) diff --git a/src/Turtle/Protected.hs b/src/Turtle/Protected.hs index 0bb6d44..a3c7719 100644 --- a/src/Turtle/Protected.hs +++ b/src/Turtle/Protected.hs @@ -1,6 +1,32 @@ +{-| This module handles exception-safety. + + You can build `Protected` resources using `protect`: + +> readHandle :: FilePath -> Protected Handle +> readHandle file = protect (do +> handle <- Filesystem.openFile file ReadMode +> return (handle, hClose handle) ) + + You can combine `Protected` resources using @do@ notation: + +> twoFiles :: Protected (Handle, Handle) +> twoFiles = do +> handle1 <- readHandle "file1.txt" +> handle2 <- readHandle "file2.txt" +> return (handle1, handle2) + + You can consume `Protected` resources within a `Shell` using `with`: + +> example = do +> (handle1, handle2) <- with twoFiles +> ... + +-} + module Turtle.Protected ( -- * Protected - Protected(..) + Protected + , protect , with -- * Utilities @@ -25,11 +51,12 @@ import Prelude hiding (FilePath) import Turtle.Shell --- | A `Protected` resource of type @a@ -data Protected a = Protected { acquire :: IO (a, IO ()) } +{-| A `Protected` resource of type @a@ +-} +data Protected a = Protect { acquire :: IO (a, IO ()) } instance Functor Protected where - fmap f r = Protected (do + fmap f r = Protect (do (a, release) <- acquire r return (f a, release) ) @@ -39,15 +66,15 @@ instance Applicative Protected where (<*>) = ap instance Monad Protected where - return a = Protected (return (a, return ())) + return a = Protect (return (a, return ())) - m >>= f = Protected (do + m >>= f = Protect (do (a, release1) <- acquire m (b, release2) <- acquire (f a) `onException` release1 return (b, release2 >> release1) ) instance MonadIO Protected where - liftIO io = Protected (do + liftIO io = Protect (do a <- io return (a, return ()) ) @@ -98,7 +125,26 @@ instance Floating a => Floating (Protected a) where instance IsString a => IsString (Protected a) where fromString str = pure (fromString str) --- | Acquire a `Protected` resource within a `Shell` +{-| Create `Protected` @\'a\'@ + + The outer `IO` action acquires the @\'a\'@ and the inner @IO@ action + releases the acquired resource: + +> example :: Protected A +> example = protect (do +> a <- acquireResource +> return (a, releaseResource a) +> +> acquireResource :: IO A +> releaseResource :: A -> IO () +-} +protect :: IO (a, IO ()) -> Protected a +protect = Protect + +{-| Acquire a `Protected` resource within a `Shell` in an exception-safe way + +> do { x <- with m; with (f x) } = with (do { x <- m; f x }) +-} with :: Protected a -> Shell a with resource = Shell (\(FoldM step begin done) -> do x <- begin @@ -107,12 +153,12 @@ with resource = Shell (\(FoldM step begin done) -> do -- | Acquire a `Protected` read-only `Handle` from a `FilePath` readHandle :: FilePath -> Protected Handle -readHandle file = Protected (do +readHandle file = protect (do handle <- Filesystem.openFile file ReadMode return (handle, hClose handle) ) -- | Acquire a `Protected` write-only `Handle` from a `FilePath` writeHandle :: FilePath -> Protected Handle -writeHandle file = Protected (do +writeHandle file = protect (do handle <- Filesystem.openFile file WriteMode return (handle, hClose handle) ) diff --git a/turtle.cabal b/turtle.cabal index ba247cb..8f66488 100644 --- a/turtle.cabal +++ b/turtle.cabal @@ -39,7 +39,7 @@ Library Turtle.Pattern, Turtle.Protected, Turtle.Shell, - Turtle.Util + Turtle.Prelude GHC-Options: -O2 -Wall Default-Language: Haskell2010