Initial commit

LICENSE

@@ -0,0 +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.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

src/Turtle.hs

@@ -0,0 +1,21 @@
+module Turtle (
+    -- * Shell
+      Shell
+    , fold
+    , runShell
+
+    -- * Utilities
+    , select
+    , cat
+    , grep
+
+    -- * Classes
+    , Applicative(..)
+    , Alternative(..)
+    , MonadIO(..)
+    ) where
+
+import Control.Applicative (Applicative(..), Alternative(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Turtle.Shell (Shell, fold, runShell)
+import Turtle.Util (select, cat, grep)

src/Turtle/Parser.hs

@@ -0,0 +1,541 @@
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies               #-}
+
+{-| The simplest possible parser implementation
+
+    Example usage:
+
+>>> :set -XOverloadedStrings
+>>> parse (text "cat" <|> text "dog") "cat"
+["cat"]
+>>> parse (some (notChar ',') <* char ',') "cat,dog"
+["cat"]
+>>> parse (count 3 anyChar) "cat,dog"
+["cat"]
+
+    This parser has unlimited backtracking, and will return as many solutions as
+    possible:
+
+>>> parse (some anyChar) "123"
+["123","12","1"]
+>>> parse (some anyChar <* eof) "123"
+["123"]
+
+    Use @do@ notation to structure more complex parsers:
+
+>>> :{
+let bit = (char '0' *> pure False) <|> (char '1' *> pure True);
+    portableBitMap = do
+        { text "P1"
+        ; width  <- spaces1 *> decimal
+        ; height <- spaces1 *> decimal
+        ; count width (count height (spaces1 *> bit))
+        };
+in  parse portableBitMap "P1\n2 2\n0 0\n1 0\n"
+:}
+[[[False,False],[True,False]]]
+
+-}
+
+module Turtle.Parser (
+    -- * Parser
+      Parser
+    , parse
+
+    -- * Primitive parsers
+    , anyChar
+    , eof
+
+    -- * Character parsers
+    , satisfy
+    , char
+    , notChar
+    , text
+    , oneOf
+    , noneOf
+    , space
+    , spaces
+    , spaces1
+    , tab
+    , newline
+    , crlf
+    , upper
+    , lower
+    , alphaNum
+    , letter
+    , digit
+    , hexDigit
+    , octDigit
+
+    -- * Numbers
+    , decimal
+    , signed
+
+    -- * Combinators
+    , star
+    , plus
+    , choice
+    , count
+    , between
+    , skip
+    , within
+    , fixed
+    , sepBy
+    , sepBy1
+
+    -- * Re-exports
+    , Text
+    ) where
+
+import Control.Applicative
+import Control.Monad
+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
+
+newtype Parser a = Parser { runParser :: StateT Text [] a }
+    deriving (Functor, Applicative, Monad, Alternative, MonadPlus)
+
+instance Monoid a => Monoid (Parser a) where
+    mempty  = pure mempty
+    mappend = liftA2 mappend
+
+instance Num a => Num (Parser a) where
+    fromInteger n = pure (fromInteger n)
+
+    (+) = liftA2 (+)
+    (*) = liftA2 (*)
+    (-) = liftA2 (-)
+
+    abs    = fmap abs
+    signum = fmap signum
+    negate = fmap negate
+
+instance Fractional a => Fractional (Parser a) where
+    fromRational n = pure (fromRational n)
+
+    recip = fmap recip
+
+    (/) = liftA2 (/)
+
+instance Floating a => Floating (Parser a) where
+    pi = pure pi
+
+    exp   = fmap exp
+    sqrt  = fmap sqrt
+    log   = fmap log
+    sin   = fmap sin
+    tan   = fmap tan
+    cos   = fmap cos
+    asin  = fmap sin
+    atan  = fmap atan
+    acos  = fmap acos
+    sinh  = fmap sinh
+    tanh  = fmap tanh
+    cosh  = fmap cosh
+    asinh = fmap asinh
+    atanh = fmap atanh
+    acosh = fmap acosh
+
+    (**)    = liftA2 (**)
+    logBase = liftA2 logBase
+
+instance (a ~ Text) => IsString (Parser a) where
+    fromString str = text (Text.pack str)
+
+-- | Supply a `Parser` with a `Text` input, returning all possible solutions
+parse :: Parser a -> Text -> [a]
+parse p = evalStateT (runParser p)
+
+{-| Match any character
+
+>>> parse anyChar "123"
+"1"
+>>> parse anyChar ""
+""
+
+-}
+anyChar :: Parser Char
+anyChar = Parser (do
+    Just (c, cs) <- fmap Text.uncons get
+    put cs
+    return c )
+
+{-| Matches the end of input
+
+>>> parse eof "123"
+[]
+>>> parse eof ""
+[()]
+
+-}
+eof :: Parser ()
+eof = Parser (do
+    True <- fmap Text.null get
+    return () )
+
+{-| Match any character that satisfies the given predicate
+
+>>> parse (satisfy (== '1')) "123"
+"1"
+>>> parse (satisfy (== '2')) "123"
+""
+
+-}
+satisfy :: (Char -> Bool) -> Parser Char
+satisfy predicate = do
+    c <- anyChar
+    guard (predicate c)
+    return c
+
+{-| Match a specific character
+
+>>> parse (char '1') "123"
+"1"
+>>> parse (char '2') "123"
+""
+
+-}
+char :: Char -> Parser Char
+char c = satisfy (== c)
+
+{-| Match any character except the given one
+
+>>> parse (notChar '2') "123"
+"1"
+>>> parse (notChar '1') "123"
+""
+
+-}
+notChar :: Char -> Parser Char
+notChar c = satisfy (/= c)
+
+{-| Match a specific string
+
+>>> parse (text "12") "123"
+["12"]
+
+-}
+text :: Text -> Parser Text
+text prefix' = Parser (do
+    txt <- get
+    let (prefix, suffix) = Text.splitAt (Text.length prefix') txt
+    guard (prefix == prefix')
+    put suffix
+    return prefix )
+
+{-| Match any one of the given characters
+
+>>> parse (oneOf "1a") "123"
+"1"
+>>> parse (oneOf "2a") "123"
+""
+
+-}
+oneOf :: [Char] -> Parser Char
+oneOf cs = satisfy (`elem` cs)
+
+{-| Match anything other than the given characters
+
+>>> parse (noneOf "2a") "123"
+"1"
+>>> parse (noneOf "1a") "123"
+""
+
+-}
+noneOf :: [Char] -> Parser Char
+noneOf cs = satisfy (`notElem` cs)
+
+{-| Match a whitespace character
+
+>>> parse space " a"
+" "
+>>> parse space "a "
+""
+
+-}
+space :: Parser Char
+space = satisfy isSpace
+
+{-| Match zero or more whitespace characters
+
+>>> parse spaces "  "
+["  "," ",""]
+>>> parse spaces "a "
+[""]
+
+-}
+spaces :: Parser Text
+spaces = star space
+
+{-| Match one or more whitespace characters
+
+>>> parse spaces1 "  "
+["  "," "]
+>>> parse spaces1 "a "
+[]
+
+-}
+spaces1 :: Parser Text
+spaces1 = plus space
+
+{-| Match the tab character (@\'\t\'@)
+
+>>> parse tab "\t"
+"\t"
+>>> parse tab " "
+""
+-}
+tab :: Parser Char
+tab = char '\t'
+
+{-| Match the newline character (@\'\n\'@)
+
+>>> parse newline "\n"
+"\n"
+>>> parse newline " "
+""
+-}
+newline :: Parser Char
+newline = char '\n'
+
+{-| Matches a carriage return (@\'\r\'@) followed by a newline (@\'\n\'@)
+
+>>> parse crlf "\r\n"
+["\r\n"]
+>>> parse crlf "\n\r"
+[]
+-}
+crlf :: Parser Text
+crlf = text "\r\n"
+
+{-| Match an uppercase letter
+
+>>> parse upper "ABC"
+"A"
+>>> parse upper "abc"
+""
+-}
+upper :: Parser Char
+upper = satisfy isUpper
+
+{-| Match a lowercase letter
+
+>>> parse lower "abc"
+"a"
+>>> parse lower "ABC"
+""
+-}
+lower :: Parser Char
+lower = satisfy isLower
+
+{-| Match a letter or digit
+
+>>> parse alphaNum "123"
+"1"
+>>> parse alphaNum "abc"
+"a"
+>>> parse alphaNum "ABC"
+"A"
+>>> parse alphaNum "..."
+""
+-}
+alphaNum :: Parser Char
+alphaNum = satisfy isAlphaNum
+
+{-| Match a letter
+
+>>> parse letter "ABC"
+"A"
+>>> parse letter "abc"
+"a"
+>>> parse letter "123"
+""
+-}
+letter :: Parser Char
+letter = satisfy isLetter
+
+{-| Match a digit
+
+>>> parse digit "123"
+"1"
+>>> parse digit "abc"
+""
+-}
+digit :: Parser Char
+digit = satisfy isDigit
+
+{-| Match a hexadecimal digit
+
+>>> parse hexDigit "123"
+"1"
+>>> parse hexDigit "ABC"
+"A"
+>>> parse hexDigit "abc"
+"a"
+>>> parse hexDigit "ghi"
+""
+-}
+hexDigit :: Parser Char
+hexDigit = satisfy isHexDigit
+
+{-| Match an octal digit
+
+>>> parse octDigit "123"
+"1"
+>>> parse octDigit "9"
+""
+-}
+octDigit :: Parser Char
+octDigit = satisfy isOctDigit
+
+{-| Match an unsigned decimal number
+
+>>> parse (decimal <* eof) "123"
+[123]
+>>> parse (decimal <* eof) "-123"
+[]
+-}
+decimal :: Num n => Parser n
+decimal = do
+    ds <- some digit
+    return (foldl' step 0 ds)
+  where
+    step n d = n * 10 + fromIntegral (ord d - ord '0')
+
+{-| Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign
+
+>>> parse (signed decimal <* eof) "+123"
+[123]
+>>> parse (signed decimal <* eof) "-123"
+[-123]
+>>> parse (signed decimal <* eof)  "123"
+[123]
+-}
+signed :: Num a => Parser a -> Parser a
+signed p = do
+    sign <- (char '+' *> pure id) <|> (char '-' *> pure negate) <|> (pure id)
+    fmap sign p
+
+{-| Parser 0 or more occurrecnes of the given character
+
+>>> parse (star anyChar) "123"
+["123","12","1",""]
+>>> parse (star anyChar <* eof) "123"
+["123"]
+>>> parse (star anyChar) ""
+[""]
+-}
+star :: Parser Char -> Parser Text
+star p = fmap Text.pack (many p)
+
+{-| Parse 1 or more occurrences of the given character
+
+>>> parse (some anyChar) "123"
+["123","12","1"]
+>>> parse (some anyChar <* eof) "123"
+["123"]
+>>> parse (some anyChar) ""
+[]
+-}
+plus :: Parser Char -> Parser Text
+plus p = fmap Text.pack (some p)
+
+{-| Apply the parsers in the list in order, until one of them succeeds
+
+>>> parse (choice [text "cat", text "dog", text "egg"]) "egg"
+["egg"]
+>>> parse (choice [text "cat", text "dog", text "egg"]) "cat"
+["cat"]
+>>> parse (choice [text "cat", text "dog", text "egg"]) "fan"
+[]
+-}
+choice :: [Parser a] -> Parser a
+choice = msum
+
+{-| Apply the given parser a fixed number of times, collecting the results
+
+>>> parse (count 2 anyChar) "123"
+["12"]
+>>> parse (count 4 anyChar) "123"
+[]
+-}
+count :: Int -> Parser a -> Parser [a]
+count = replicateM
+
+{-| @between open close p@ parses @p@ in between @open@ and @close@
+
+>>> parse (between (char '(') (char ')') (star anyChar)) "(123)"
+["123"]
+>>> parse (between (char '(') (char ')') (star anyChar)) "(123))"
+["123)","123"]
+>>> parse (between (char '(') (char ')') (star anyChar)) "(123"
+[]
+-}
+between :: Parser a -> Parser b -> Parser c -> Parser c
+between open close p = open *> p <* close
+
+{-| Discard the parser's result
+
+>>> parse (skip anyChar) "123"
+[()]
+>>> parse (skip anyChar) ""
+[]
+-}
+skip :: Parser a -> Parser ()
+skip = void
+
+{-| Restrict the parser to consume no more than the given number of characters
+
+>>> parse (within 2 decimal) "123"
+[12,1]
+>>> parse (within 2 decimal) "1a3"
+[1]
+-}
+within :: Int -> Parser a -> Parser a
+within n p = Parser (do
+    txt <- get
+    let (prefix, suffix) = Text.splitAt n txt
+    put prefix
+    a <- runParser p
+    modify (<> suffix)
+    return a )
+
+{-| Require the parser to consume exactly the given number of characters
+
+>>> parse (fixed 2 decimal) "123"
+[12]
+>>> parse (fixed 2 decimal) "1a3"
+[]
+-}
+fixed :: Int -> Parser a -> Parser a
+fixed n p = within n (p <* eof)
+
+{-| @p `sepBy` sep@ parses zero or more occurrences of @p@ separated by @sep@
+
+>>> parse (decimal `sepBy` char ',') "1,2,3"
+[[1,2,3],[1,2],[1],[]]
+>>> parse (decimal `sepBy` char ',' <* eof) "1,2,3"
+[[1,2,3]]
+>>> parse (decimal `sepBy` char ',') ""
+[[]]
+-}
+sepBy :: Parser a -> Parser b -> Parser [a]
+p `sepBy` sep = (p `sepBy1` sep) <|> pure []
+
+{-| @p `sepBy1` sep@ parses one or more occurrences of @p@ separated by @sep@
+
+>>> parse (decimal `sepBy1` char ',') "1,2,3"
+[[1,2,3],[1,2],[1]]
+>>> parse (decimal `sepBy1` char ',' <* eof) "1,2,3"
+[[1,2,3]]
+>>> parse (decimal `sepBy1` char ',') ""
+[]
+-}
+sepBy1 :: Parser a -> Parser b -> Parser [a]
+p `sepBy1` sep = (:) <$> p <*> many (sep *> p) 

src/Turtle/Shell.hs

@@ -0,0 +1,123 @@
+{-# LANGUAGE RankNTypes #-}
+
+{- All `Shell`s must satisfy this law:
+
+> foldM_ s step begin done = do
+>     x  <- step
+>     x' <- foldM_ s step (return x) return
+>     done x'
+
+-}
+
+module Turtle.Shell (
+      Shell(..)
+    , fold
+    , runShell
+    ) where
+
+import Control.Applicative (Applicative(..), Alternative(..), liftA2)
+import Control.Monad (MonadPlus(..), ap)
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Foldl (Fold)
+import qualified Control.Foldl as Foldl
+import Data.Monoid (Monoid(..))
+import Data.String (IsString(..))
+
+-- | A @(`Shell` a)@ is a stream of @a@'s
+newtype Shell a = Shell
+    { foldM_ :: forall r x . (x -> a -> IO x) -> IO x -> (x -> IO r) -> IO r }
+
+fold :: Fold a b -> Shell a -> IO b
+fold f s = Foldl.impurely (foldM_ s) (Foldl.generalize f)
+
+runShell :: Shell a -> IO ()
+runShell = fold (pure ())
+
+instance Functor Shell where
+    fmap f s = Shell (\step begin done ->
+        let step' x a = step x (f a)
+        in  foldM_ s step' begin done )
+
+instance Applicative Shell where
+    pure  = return
+    (<*>) = ap
+
+instance Monad Shell where
+    return a = Shell (\step begin done -> do
+       x  <- begin
+       x' <- step x a
+       done x' )
+
+    m >>= f = Shell (\step0 begin0 done0 -> do
+        let step1 x a = foldM_ (f a) step0 (return x) return
+        foldM_ m step1 begin0 done0 )
+
+    fail _ = mzero
+
+instance Alternative Shell where
+    empty = Shell (\_ begin done -> do
+        x <- begin
+        done x )
+
+    s1 <|> s2 = Shell (\step begin done -> do
+        x <- foldM_ s1 step begin return
+        foldM_ s2 step (return x) done )
+
+instance MonadPlus Shell where
+    mzero = empty
+
+    mplus = (<|>)
+
+instance MonadIO Shell where
+    liftIO io = Shell (\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
+
+instance Num a => Num (Shell a) where
+    fromInteger n = pure (fromInteger n)
+
+    (+) = liftA2 (+)
+    (*) = liftA2 (*)
+    (-) = liftA2 (-)
+
+    abs    = fmap abs
+    signum = fmap signum
+    negate = fmap negate
+
+instance Fractional a => Fractional (Shell a) where
+    fromRational n = pure (fromRational n)
+
+    recip = fmap recip
+
+    (/) = liftA2 (/)
+
+instance Floating a => Floating (Shell a) where
+    pi = pure pi
+
+    exp   = fmap exp
+    sqrt  = fmap sqrt
+    log   = fmap log
+    sin   = fmap sin
+    tan   = fmap tan
+    cos   = fmap cos
+    asin  = fmap sin
+    atan  = fmap atan
+    acos  = fmap acos
+    sinh  = fmap sinh
+    tanh  = fmap tanh
+    cosh  = fmap cosh
+    asinh = fmap asinh
+    atanh = fmap atanh
+    acosh = fmap acosh
+
+    (**)    = liftA2 (**)
+    logBase = liftA2 logBase
+
+instance IsString a => IsString (Shell a) where
+    fromString str = pure (fromString str)

src/Turtle/Util.hs

@@ -0,0 +1,20 @@
+module Turtle.Util where
+
+import Control.Applicative (Alternative(..))
+
+import Control.Monad (guard)
+import Turtle.Parser
+import Turtle.Shell
+
+select :: [a] -> Shell a
+select  []    = empty
+select (a:as) = return a <|> select as
+
+cat :: [Shell a] -> Shell a
+cat = foldr (<|>) empty
+
+grep :: Parser a -> Shell Text -> Shell Text
+grep p s = do
+    str <- s
+    guard (not (null (parse p str)))
+    return str

test/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Test.DocTest
+
+main :: IO ()
+main = doctest ["src/Turtle/Parser.hs"]

turtle.cabal

@@ -0,0 +1,51 @@
+Name: turtle
+Version: 1.0.0
+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: This package provides utilities for shell programming.
+    .
+    Features include:
+    .
+    * Support for @text@ and @system-filepath@
+    .
+    * Streaming
+    .
+    * Exception-safety (including asynchronous exceptions)
+    .
+    * Fully-backtracking parsing
+Category: Control, Pipes
+Source-Repository head
+    Type: git
+    Location: https://github.com/Gabriel439/Haskell-Pipes-Extras-Library
+
+Library
+    HS-Source-Dirs: src
+    Build-Depends:
+        base         >= 4       && < 5  ,
+        foldl                      < 1.1,
+        text                       < 1.3,
+        transformers >= 0.2.0.0 && < 0.5
+    Exposed-Modules:
+        Turtle,
+        Turtle.Parser,
+        Turtle.Shell,
+        Turtle.Util
+    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.10