Initial commit
This commit is contained in:
commit
67b12f49b1
8 changed files with 788 additions and 0 deletions
24
LICENSE
Normal file
24
LICENSE
Normal file
|
@ -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.
|
2
Setup.hs
Normal file
2
Setup.hs
Normal file
|
@ -0,0 +1,2 @@
|
|||
import Distribution.Simple
|
||||
main = defaultMain
|
21
src/Turtle.hs
Normal file
21
src/Turtle.hs
Normal file
|
@ -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)
|
541
src/Turtle/Parser.hs
Normal file
541
src/Turtle/Parser.hs
Normal file
|
@ -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)
|
123
src/Turtle/Shell.hs
Normal file
123
src/Turtle/Shell.hs
Normal file
|
@ -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)
|
20
src/Turtle/Util.hs
Normal file
20
src/Turtle/Util.hs
Normal file
|
@ -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
|
6
test/Main.hs
Normal file
6
test/Main.hs
Normal file
|
@ -0,0 +1,6 @@
|
|||
module Main where
|
||||
|
||||
import Test.DocTest
|
||||
|
||||
main :: IO ()
|
||||
main = doctest ["src/Turtle/Parser.hs"]
|
51
turtle.cabal
Normal file
51
turtle.cabal
Normal file
|
@ -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
|
Loading…
Reference in a new issue