stutter (empty) → 0.1.0.0
raw patch · 8 files changed
+719/−0 lines, 8 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, conduit, conduit-combinators, conduit-extra, mtl, optparse-applicative, resourcet, snipcheck, stutter, tasty, tasty-ant-xml, tasty-hunit, text
Files
- LICENSE +19/−0
- README.md +158/−0
- Setup.hs +2/−0
- exe/Stutter.hs +112/−0
- src/Stutter/Parser.hs +181/−0
- src/Stutter/Producer.hs +92/−0
- stutter.cabal +63/−0
- test/Main.hs +92/−0
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2017 Nicolas Mattia++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,158 @@+# Stutter++Stutter is a string utterer.++> utterer: someone who expresses in language; someone who talks (especially+> someone who delivers a public speech or someone especially garrulous)+> (www.vocabulary.com)++Stutter takes a string definition and crafts as many different strings as it+can. See the [examples](#examples) section below for inspiration.++# Building++You need the Haskell build tool+[stack](https://docs.haskellstack.org/en/stable/README/). Just run:++``` shell+$ stack build+```++# Installing+++You currently need the Haskell build tool+[stack](https://docs.haskellstack.org/en/stable/README/). Just run:++``` shell+$ stack install+```++# Contributing++There are several ways you can contribute:++* Complain: Just [open an issue](https://github.com/nmattia/stutter/issues/new)+ and let me know what could be improved.+* Share a use-case: You found a cool case? Great! [open an+ issue](https://github.com/nmattia/stutter/issues/new) or (even better) a PR+ with your issue added to the [examples](#examples) below.+* Support: Share `stutter` with your friends, you never know who might need it.+* Implement: All PRs are welcome.++# Examples++Stutter can be used as a very simple `echo` clone:++``` shell+$ stutter 'Hello, World!'+Hello, World!+```++But stutter also knows how to enumerate:+++``` shell+$ stutter 'foo|bar|baz'+foo+bar+baz+```++You can easily specify which parts you want to enumerate, and which parts+should always be there:++``` shell+$ stutter 'My name is (what\?|who\?|Slim Shady)'+My name is what?+My name is who?+My name is Slim Shady+```++Stutter can also enumerate file contents:+++``` shell+$ stutter 'foo|bar|baz' > test.txt+$ stutter '(@test.txt) -- stutter was here'+foo -- stutter was here+bar -- stutter was here+baz -- stutter was here+```++And read from `stdin`:++``` shell+$ cat test.txt | stutter 'Check this out, paste: @-'+Check this out, paste: foo+Check this out, paste: bar+Check this out, paste: baz+```++Stutter also likes ranges:++``` shell+$ stutter '[0-9a-f]'+0+1+2+3+4+5+6+7+8+9+a+b+c+d+e+f+```++Of course, it can all be used together:+``` shell+$ stutter 'My name is (@test.txt) [a-c] (who\?|what\?|Slim Shady)'+My name is foo a who?+My name is foo a what?+My name is foo a Slim Shady+My name is foo b who?+My name is foo b what?+...+My name is baz c who?+My name is baz c what?+My name is baz c Slim Shady+```++Stutter can teach you binary:++``` shell+$ stutter '(0b(0|1){#|5})|I know binary!'+0b00000+0b00001+0b00010+0b00011+0b00100+0b00101+...+0b11010+0b11011+0b11100+0b11101+0b11110+0b11111+I know binary!+```++Stutter can repeat a char:++``` shell+$ stutter 'a{42}'+a+a+a+...+$ stutter 'a{42}' | wc -l+42+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ exe/Stutter.hs view
@@ -0,0 +1,112 @@+import Control.Applicative+import Control.Monad.IO.Class (liftIO)+import Data.Attoparsec.Text (parseOnly, endOfInput)+import Data.Conduit+import Data.Monoid+import Data.List++import qualified Data.Conduit.Combinators as CL+import qualified Data.Text as T+import qualified Options.Applicative as Opts++import Stutter.Parser (parseGroup)+import Stutter.Producer (ProducerGroup_, cardinality, prepareStdin, produceGroup)++data Options = Options+ { showCardinality :: Bool+ , showIntermediate :: Bool+ , allowSloppyParse :: Bool+ , disableNewLines :: Bool+ , producerGroupExpr :: String+ }++type ProducerGroup = ProducerGroup_ ()++parseCardinality :: Opts.Parser Bool+parseCardinality =+ Opts.switch+ ( Opts.long "size"+ <> Opts.long "length"+ <> Opts.short 'l'+ <> Opts.help "Just show output size"+ )++debug :: Opts.Parser Bool+debug =+ Opts.switch+ ( Opts.long "debug"+ <> Opts.short 'd'+ <> Opts.help "Just print parser output (mostly for debug purposes)"+ )++allowSloppy :: Opts.Parser Bool+allowSloppy =+ Opts.switch+ ( Opts.long "sloppy"+ <> Opts.short 's'+ <> Opts.help "Allow parser to parse partially"+ )++noLn :: Opts.Parser Bool+noLn =+ Opts.switch+ ( Opts.long "no-newlines"+ <> Opts.short 'n'+ <> Opts.help "Do not print newlines between outputs"+ )++parseProducerGroup :: Opts.Parser String+parseProducerGroup =+ Opts.strArgument+ ( Opts.metavar "EXPR" )++parseOpts :: Opts.Parser Options+parseOpts =+ Options+ <$> parseCardinality+ <*> debug+ <*> allowSloppy+ <*> noLn+ <*> parseProducerGroup++withProducerGroup :: Options -> String -> (ProducerGroup -> IO a) -> IO a+withProducerGroup opts str f =+ case parseOnly parser $ T.pack str of+ Left err -> error $ intercalate " "+ [ "Could not parse producer group:", str+ , "Reason: ", err+ ]+ Right g -> f g+ where+ -- If "sloppy" mode is enabled, allow partial parse. Otherwise, request end+ -- of input.+ parser =+ if allowSloppyParse opts+ then parseGroup+ else parseGroup <* endOfInput++main :: IO ()+main = do+ a <- Opts.execParser opts+ if showIntermediate a+ then withProducerGroup a (producerGroupExpr a) $ \g -> do+ print g+ else (+ if showCardinality a+ then withProducerGroup a (producerGroupExpr a) $ \g -> do+ case cardinality g of+ Nothing -> putStrLn "?"+ Just x -> print x+ else withProducerGroup a (producerGroupExpr a) $ \g -> do+ g' <- prepareStdin g+ let print' =+ if disableNewLines a+ then putStr+ else putStrLn+ runConduitRes+ $ produceGroup g'+ .| CL.mapM_ (liftIO . print' . T.unpack)+ )+ where+ opts = Opts.info (parseOpts <**> Opts.helper)+ ( Opts.header "stutter - a string generator" )
+ src/Stutter/Parser.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TupleSections #-}++module Stutter.Parser where++import Control.Applicative+import Control.Monad+import Text.Read (readMaybe)+import Data.Attoparsec.Text ((<?>))++import qualified Data.Attoparsec.Text as Atto+import qualified Data.Text as T++import Stutter.Producer hiding (ProducerGroup)++type ProducerGroup = ProducerGroup_ ()++-------------------------------------------------------------------------------+-- Text+-------------------------------------------------------------------------------++parseText :: Atto.Parser T.Text+parseText = (<?> "text") $+ T.pack <$> Atto.many1 parseSimpleChar++parseSimpleChar :: Atto.Parser Char+parseSimpleChar = (<?> "simple char or escaped char") $+ -- A non-special char+ Atto.satisfy (`notElem` specialChars) <|>+ -- An escaped special char+ Atto.char '\\' *> Atto.anyChar++specialChars :: [Char]+specialChars =+ [+ -- Used for sum+ '|'+ -- Used for product+ , '#'+ -- Used for zip+ , '$'+ -- Used for Kleene plus+ , '+'+ -- Used for Kleene start+ , '*'+ -- Used for optional+ , '?'+ -- Used to delimit ranges+ , '[', ']'+ -- Used to scope groups+ , '(', ')'+ -- Used to replicate groups+ , '{', '}'+ -- Used for escaping+ , '\\'+ -- Used for files+ , '@'+ ]++parseGroup :: Atto.Parser ProducerGroup+parseGroup = (<?> "producer group") $+ (parseUnit' <**> parseSquasher' <*> parseGroup) <|>+ (PProduct <$> parseUnit' <*> parseGroup) <|>+ parseUnit'+ where+ parseUnit' = parseReplicatedUnit <|> parseUnit+ -- Default binary function to product (@#@)+ parseSquasher' = parseSquasher <|> pure PProduct++parseReplicatedUnit :: Atto.Parser ProducerGroup+parseReplicatedUnit = (<?> "replicated unary producer") $+ -- This the logic for the replication shouldn't be in the parser+ parseUnit <**> parseReplicator++type Squasher = ProducerGroup -> ProducerGroup -> ProducerGroup+type Replicator = ProducerGroup -> ProducerGroup++parseReplicator :: Atto.Parser Replicator+parseReplicator =+ parseKleenePlus <|>+ parseKleeneStar <|>+ parseOptional <|>+ parseFoldApp++parseKleenePlus :: Atto.Parser Replicator+parseKleenePlus =+ Atto.char '+' *> pure (PRepeat)++parseKleeneStar :: Atto.Parser Replicator+parseKleeneStar =+ Atto.char '*' *> pure (PSum (PText T.empty) . PRepeat)++parseOptional :: Atto.Parser Replicator+parseOptional =+ Atto.char '?' *> pure (PSum (PText T.empty) )++parseFoldApp :: Atto.Parser Replicator+parseFoldApp =+ bracketed '{' '}'+ ( flip (,)+ <$> parseSquasher+ <* Atto.char '|'+ <*> parseInt+ <|> (,PSum) <$> parseInt+ )+ <**>+ (pure (\(n, f) -> foldr1 f . replicate n))+ where+ parseInt :: Atto.Parser Int+ parseInt = (readMaybe <$> Atto.many1 Atto.digit) >>= \case+ Nothing -> mzero+ Just x -> return x++parseSquasher :: Atto.Parser Squasher+parseSquasher = Atto.anyChar >>= \case+ '|' -> return PSum+ '$' -> return PZip+ '#' -> return PProduct+ _ -> mzero++parseUnit :: Atto.Parser ProducerGroup+parseUnit = (<?> "unary producer") $+ PRanges <$> parseRanges <|>+ parseHandle <|>+ PText <$> parseText <|>+ bracketed '(' ')' parseGroup++bracketed :: Char -> Char -> Atto.Parser a -> Atto.Parser a+bracketed cl cr p = Atto.char cl *> p <* Atto.char cr++-- | Parse a Handle-like reference, preceded by an @\@@ sign. A single dash+-- (@-@) is interpreted as @stdin@, any other string is used as a file path.+parseHandle :: Atto.Parser ProducerGroup+parseHandle = (<?> "handle reference") $+ (flip fmap) parseFile $ \case+ "-" -> PStdin ()+ fp -> PFile fp++-------------------------------------------------------------------------------+-- File+-------------------------------------------------------------------------------++parseFile :: Atto.Parser FilePath+parseFile = (<?> "file reference") $+ T.unpack <$> (Atto.char '@' *> parseText)++-------------------------------------------------------------------------------+-- Ranges+-------------------------------------------------------------------------------++-- | Parse several ranges+--+-- Example:+-- @[a-zA-Z0-6]@+parseRanges :: Atto.Parser [Range]+parseRanges = (<?> "ranges") $+ Atto.char '[' *>+ Atto.many1 parseRange <*+ Atto.char ']'++-- | Parse a range of the form 'a-z' (int or char)+parseRange :: Atto.Parser Range+parseRange = (<?> "range") $+ parseIntRange <|> parseCharRange++-- | Parse a range in the format "<start>-<end>", consuming exactly 3+-- characters+parseIntRange :: Atto.Parser Range+parseIntRange = (<?> "int range") $+ IntRange <$> ((,) <$> parseInt <* Atto.char '-' <*> parseInt)+ where+ parseInt :: Atto.Parser Int+ parseInt = (readMaybe . (:[]) <$> Atto.anyChar) >>= \case+ Nothing -> mzero+ Just x -> return x++-- | Parse a range in the format "<start>-<end>", consuming exactly 3+-- characters+parseCharRange :: Atto.Parser Range+parseCharRange = (<?> "char range") $+ CharRange <$> ((,) <$> Atto.anyChar <* Atto.char '-' <*> Atto.anyChar)
+ src/Stutter/Producer.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}++module Stutter.Producer where++import Control.Monad.IO.Class+import Control.Monad.State+import Control.Monad.Trans.Resource (MonadResource)+import Data.Conduit+import Data.Conduit.Internal (zipSources)+import Data.Monoid+import System.IO (stdin)++import qualified Data.ByteString.Lazy as BL+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.Combinators as CL+import qualified Data.Text as T++data Range+ = IntRange (Int, Int)+ | CharRange (Char, Char)+ deriving (Eq, Show)++data ProducerGroup_ a+ = PSum (ProducerGroup_ a) (ProducerGroup_ a)+ | PProduct (ProducerGroup_ a) (ProducerGroup_ a)+ | PZip (ProducerGroup_ a) (ProducerGroup_ a)+ | PRepeat (ProducerGroup_ a)+ | PRanges [Range]+ | PFile FilePath+ | PStdin a+ | PText T.Text+ deriving (Eq, Show, Functor, Foldable, Traversable)++type ProducerGroup = ProducerGroup_ BL.ByteString++prepareStdin :: ProducerGroup_ () -> IO (ProducerGroup_ BL.ByteString)+prepareStdin p = evalStateT (traverse f p) Nothing+ where+ f () = get >>= \case+ Just bs -> return bs+ Nothing -> do+ bs <- liftIO $ BL.hGetContents stdin+ modify (const $ Just bs)+ return bs++cardinality :: ProducerGroup_ a -> Maybe Int+cardinality (PSum p p') = (+) <$> cardinality p <*> cardinality p'+cardinality (PProduct p p') = (*) <$> cardinality p <*> cardinality p'+cardinality (PZip p p') = min <$> cardinality p <*> cardinality p'+cardinality (PRepeat _) = Nothing+cardinality (PRanges rs) = pure $ sum $ map rangeCardinality rs+ where+ rangeCardinality (IntRange (a,z)) = length [a..z]+ rangeCardinality (CharRange (a,z)) = length [a..z]+cardinality PFile{} = Nothing+cardinality PStdin{} = Nothing+cardinality PText{} = pure 1++produceRanges :: (Monad m) => [Range] -> Producer m T.Text+produceRanges = CL.yieldMany+ . concat+ . map rangeToList+ where+ rangeToList (IntRange (a,z)) = tshow <$> [a..z]+ rangeToList (CharRange (a,z)) = T.pack . (:[]) <$> [a..z]+ tshow = T.pack . show++produceGroup+ :: (MonadIO m, MonadResource m)+ => ProducerGroup+ -> Source m T.Text+produceGroup (PRanges rs) = produceRanges rs+produceGroup (PText t) = yield t+produceGroup (PProduct g g') = produceGroup g+ .| awaitForever ( \t -> (forever $ yield ())+ .| produceGroup g'+ .| awaitForever (\t' -> yield (t <> t')))+produceGroup (PSum g g') = produceGroup g >> produceGroup g'+produceGroup (PZip g g') = zipSources (produceGroup g) (produceGroup g')+ .| CL.map (\(a,b) -> a <> b)+produceGroup (PRepeat g) = forever $ produceGroup g+produceGroup (PFile f) = CB.sourceFile f+ .| CB.lines+ .| CL.decodeUtf8+produceGroup (PStdin bs) = CB.sourceLbs bs+ .| CB.lines+ .| CL.decodeUtf8
+ stutter.cabal view
@@ -0,0 +1,63 @@+name: stutter+version: 0.1.0.0+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+copyright: (c) 2017 Nicolas Mattia+maintainer: nicolas@nmattia.com+homepage: https://github.com/nmattia/stutter#readme+synopsis: (Stutter Text|String)-Utterer+description:+ CLI regex-like string generator+category: Tools+author: Nicolas Mattia+extra-source-files:+ README.md++library+ exposed-modules:+ Stutter.Parser+ Stutter.Producer+ build-depends:+ base >=4.9.1.0 && <4.10,+ attoparsec >=0.13.1.0 && <0.14,+ bytestring >=0.10.8.1 && <0.11,+ conduit >=1.2.9 && <1.3,+ conduit-combinators >=1.1.0 && <1.2,+ conduit-extra >=1.1.15 && <1.2,+ mtl >=2.2.1 && <2.3,+ resourcet >=1.1.9 && <1.2,+ text >=1.2.2.1 && <1.3+ default-language: Haskell2010+ hs-source-dirs: src/+ ghc-options: -Wall++executable stutter+ main-is: Stutter.hs+ build-depends:+ base >=4.9.1.0 && <4.10,+ attoparsec >=0.13.1.0 && <0.14,+ conduit >=1.2.9 && <1.3,+ conduit-combinators >=1.1.0 && <1.2,+ optparse-applicative >=0.13.1.0 && <0.14,+ stutter >=0.1.0.0 && <0.2,+ text >=1.2.2.1 && <1.3+ default-language: Haskell2010+ hs-source-dirs: exe/+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall++test-suite stutter-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-depends:+ base >=4.9.1.0 && <4.10,+ attoparsec >=0.13.1.0 && <0.14,+ snipcheck >=0.1.0.0 && <0.2,+ stutter >=0.1.0.0 && <0.2,+ tasty >=0.11.1 && <0.12,+ tasty-ant-xml >=1.0.4 && <1.1,+ tasty-hunit >=0.9.2 && <0.10+ default-language: Haskell2010+ hs-source-dirs: test/+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
+ test/Main.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Test.Tasty (TestTree, defaultMainWithIngredients, defaultIngredients)+import Test.Tasty.HUnit ((@=?))+import Test.Tasty.Runners.AntXML (antXMLRunner)+import Snipcheck (checkMarkdownFile)++import qualified Data.Attoparsec.Text as Atto+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.HUnit as Tasty++import Stutter.Producer (Range(..), ProducerGroup_ (..))++import qualified Stutter.Parser as Stutter++main :: IO ()+main =+ defaultMainWithIngredients (antXMLRunner:defaultIngredients) $+ Tasty.testGroup "All tests"+ [ parserTests+ , useCases+ ]++parserTests :: TestTree+parserTests =+ Tasty.testGroup "parser"+ [ Tasty.testCase "parses a char range" $+ (Right $ CharRange ('a', 'z')) @=?+ (Atto.parseOnly Stutter.parseRange "a-z")+ , Tasty.testCase "parses an int range" $+ (Right $ IntRange (0, 3)) @=?+ (Atto.parseOnly Stutter.parseRange "0-3")+ , Tasty.testCase "parses 1-range group" $+ (Right [IntRange (0, 3)]) @=?+ (Atto.parseOnly Stutter.parseRanges "[0-3]")+ , Tasty.testCase "parses 2-range group" $+ (Right [IntRange (0, 3), CharRange ('A', 'Z')]) @=?+ (Atto.parseOnly Stutter.parseRanges "[0-3A-Z]")+ , Tasty.testCase "parses a text" $+ (Right "abcd") @=? (Atto.parseOnly Stutter.parseText "abcd")+ , Tasty.testGroup "parses a text with escaped chars "+ [ Tasty.testCase "escaped brackets" $+ (Right "abcd[") @=? (Atto.parseOnly Stutter.parseText "abcd\\[")+ , Tasty.testCase "escaped backslash" $+ (Right "abcd\\") @=? (Atto.parseOnly Stutter.parseText "abcd\\\\")+ ]+ , Tasty.testCase "parses a sum" $+ (Right $ PSum (PText "foo") (PText "bar")) @=?+ (Atto.parseOnly Stutter.parseGroup "foo|bar")+ , Tasty.testCase "parses a multi-sum" $+ (Right+ (PSum (PText "foo")+ (PSum (PText "bar")+ (PText "baz")))) @=?+ (Atto.parseOnly Stutter.parseGroup "foo|(bar|baz)")+ , Tasty.testCase "parses a multi-sum bis" $+ (Right+ (PSum (PSum (PText "foo")+ (PText "bar"))+ (PText "baz"))) @=?+ (Atto.parseOnly Stutter.parseGroup "(foo|bar)|baz")+ , Tasty.testCase "parses a multi-sum (right associative)" $+ (Right+ (PSum (PText "foo")+ (PSum (PText "bar")+ (PText "baz")))) @=?+ (Atto.parseOnly Stutter.parseGroup "foo|bar|baz")+ , Tasty.testCase "parses a multi-product (right associative)" $+ (Right+ (PProduct (PText "foo")+ (PProduct (PText "bar")+ (PText "baz")))) @=?+ (Atto.parseOnly Stutter.parseGroup "foo#bar#baz")+ , Tasty.testCase "parses an implicit product" $+ (Right+ (PProduct (PText "foo")+ (PText "bar"))) @=?+ (Atto.parseOnly Stutter.parseGroup "(foo)(bar)")+ , Tasty.testCase "parses file" $+ (Right (PFile "test.txt")) @=?+ (Atto.parseOnly Stutter.parseGroup "@test.txt")+ , Tasty.testCase "parses stdin ref" $+ (Right $ PStdin ()) @=?+ (Atto.parseOnly Stutter.parseGroup "@-")+ ]++useCases :: TestTree+useCases =+ Tasty.testCase "use cases" $+ checkMarkdownFile "README.md"