dump 0.2.6 → 0.2.7
raw patch · 9 files changed
+251/−142 lines, 9 filesdep +QuickCheckdep −textdep ~basedep ~interpolatedstring-perl6
Dependencies added: QuickCheck
Dependencies removed: text
Dependency ranges changed: base, interpolatedstring-perl6
Files
- FEATURES.md +3/−1
- README.md +31/−1
- dump.cabal +10/−13
- spec/Spec.hs +88/−42
- src/Debug/Dump.hs +66/−18
- src/Internal/Parse.hs +0/−40
- src/Internal/Parser.hs +36/−0
- src/Internal/Utils.hs +17/−0
- src/Utils.hs +0/−27
FEATURES.md view
@@ -48,5 +48,7 @@ # Miscellaneous -* Some Haddock documentation, probably more to come+* Refactored and conceptually clean code+* Some Haddock documentation. Perhaps more to come * Description in FEATURES.md+* Readme contains examples for print and QuickCheck. Perhaps more to come.
README.md view
@@ -27,6 +27,36 @@ ) ``` -Have a look at the [list of features](FEATURES.md).+# QuickCheck++If you have any intermediate computation within a QuickCheck property, it can+be useful to print a counterexample simply in case of failure++```haskell+{-# LANGUAGE QuasiQuotes #-}++import Debug.Dump+import Test.QuickCheck++($>) = flip ($); infixl 0 $>++prop :: Float -> Property+prop n = n == 1 / (1 / n)+ $> counterexample [d|n, 1/n, 1/(1/n)|]++main = quickCheck prop+```++Which, when executed, will print something like this:++```+*** Failed! Falsifiable (after 15 tests and 133 shrinks):+1.7051912e-38+(n) = 1.7051912e-38 (1/n) = 5.864445e37 (1/(1/n)) = 1.7051913e-38+```++Isn't it nice to see the intermediate computations as well?++See also: [list of features](FEATURES.md) *Concieved at [this StackOverflow question](http://stackoverflow.com/q/31349556/499478).*
dump.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: dump-version: 0.2.6+version: 0.2.7 synopsis: Dumps the names and values of expressions to ease debugging. @@ -15,7 +15,7 @@ license-file: LICENSE author: Milán Nagy maintainer: dumplibhs.psssst@dfgh.net-category: Development+category: Development, QuasiQuotes build-type: Simple extra-source-files: README.md, FEATURES.md, CHANGES.md cabal-version: >=1.10@@ -27,13 +27,11 @@ library exposed-modules: Debug.Dump- other-modules: Utils, Internal.Parse- -- other-extensions:+ other-modules: Internal.Utils, Internal.Parser build-depends: base >=4 && <5 , template-haskell , haskell-src-meta- , interpolatedstring-perl6- , text+ , interpolatedstring-perl6 == 1.0.* ghc-options: --ddump-splices --funbox-strict-fields@@ -43,17 +41,16 @@ test-suite spec type: exitcode-stdio-1.0- build-depends: base- , hspec-+ build-depends: base >=4 && <5 , template-haskell , haskell-src-meta- , interpolatedstring-perl6- , text+ , interpolatedstring-perl6 == 1.0.* + , hspec+ , QuickCheck+ ghc-options:+ --ddump-splices hs-source-dirs: spec, src main-is: Spec.hs default-language: Haskell2010 default-extensions: QuasiQuotes- ghc-options:- -- -ddump-splices
spec/Spec.hs view
@@ -1,12 +1,13 @@-{-# LANGUAGE QuasiQuotes #-}- import Test.Hspec+import Test.QuickCheck -import Debug.Dump-import Internal.Parse import Text.InterpolatedString.Perl6-import Utils+import Data.List (isPrefixOf) +import Debug.Dump+import Internal.Parser+import Internal.Utils+ main = spec spec = hspec $ do@@ -15,61 +16,106 @@ wrapInParens "a" `shouldBe` "(a)" wrapInParens "" `shouldBe` "()" - describe "parseExp" $ do+ describe "parseLeaf" $ do+ let p = parseLeaf (\xs->("",xs)) '"'+ it "knows to stop on regular quote" $ do+ p [q|a" |] `shouldBe` ([q|a"|], " ")++ it "knows not to terminate after escaped quote" $ do+ p [q|a\"" |] `shouldBe` ([q|a\""|], " ")++ it "does not trip up on escape characters" $ do+ p [q|a\\ |] `shouldBe` ([q|a\\ |], "")++ it "does not trip up on escape character at the end" $ do+ p [q|a\\|] `shouldBe` ([q|a\\|], "")++ describe "parseExpr" $ do+ let p = parseExpr .> fst it "handles flat" $ do- pExp "asd" `shouldBe` "asd"- pExp "asd,asd" `shouldBe` "asd"- pExp "asd,a,sd" `shouldBe` "asd"+ p "asd" `shouldBe` "asd"+ p "asd,asd" `shouldBe` "asd"+ p "asd,a,sd" `shouldBe` "asd" it "handles parens" $ do- pExp "(a,b)" `shouldBe` "(a,b)"- pExp "(a,b) (a,b)" `shouldBe` "(a,b) (a,b)"- pExp "(a,b), c" `shouldBe` "(a,b)"- pExp "((a), b), c" `shouldBe` "((a), b)"- pExp "((a,b),(a,b)), a" `shouldBe` "((a,b),(a,b))"+ p "(a,b)" `shouldBe` "(a,b)"+ p "(a,b) (a,b)" `shouldBe` "(a,b) (a,b)"+ p "(a,b), c" `shouldBe` "(a,b)"+ p "((a), b), c" `shouldBe` "((a), b)"+ p "((a,b),(a,b)), a" `shouldBe` "((a,b),(a,b))" it "handles char literals" $ do- pExp "','" `shouldBe` "','"- pExp "',', a" `shouldBe` "','"+ p "','" `shouldBe` "','"+ p "',', a" `shouldBe` "','" it "handles string literals" $ do- pExp [q|","|] `shouldBe` [q|","|]- pExp [q|",", a|] `shouldBe` [q|","|]+ p [q|","|] `shouldBe` [q|","|]+ p [q|",", a|] `shouldBe` [q|","|] it "handles list literals" $ do- pExp "[a,b]" `shouldBe` "[a,b]"+ p "[a,b]" `shouldBe` "[a,b]" it "treats string literals as leaves" $ do- pExp [q|"(", a|] `shouldBe` [q|"("|]+ p [q|"(", a|] `shouldBe` [q|"("|] it "support escaping in leaves" $ do- pExp [q|"\"", a|] `shouldBe` [q|"\""|]- pExp [q|"a" ++ "b", a|] `shouldBe` [q|"a" ++ "b"|]+ p [q|"\"", a|] `shouldBe` [q|"\""|]+ p [q|"a" ++ "b", a|] `shouldBe` [q|"a" ++ "b"|] it "misc" $ do- pExp [q|"((", a|] `shouldBe` [q|"(("|]- pExp [q|"()(", a|] `shouldBe` [q|"()("|]- pExp "(a, )" `shouldBe` "(a, )"- pExp "(, b)" `shouldBe` "(, b)"- -- pExp "([)], a" `shouldBe` "([)]"+ p [q|"((", a|] `shouldBe` [q|"(("|]+ p [q|"()(", a|] `shouldBe` [q|"()("|]+ p "(a, )" `shouldBe` "(a, )"+ p "(, b)" `shouldBe` "(, b)" - describe "parseExp" $ do- it "treats string literals as leaves" $ do- pLeaf '"' "a\", b" `shouldBe` "a"- pLeaf '"' "a\\\"\", b" `shouldBe` "a\\\""- pLeaf '"' "a\\" `shouldBe` "a\\"+ it "shouldn't modify the list" $ do+ p "[" `shouldBe` "["+ p "([)]" `shouldBe` "([)]"+ -- p "([)], a" `shouldBe` "([)]" - describe "separate" $ do+ it "shouldn't modify the list (QuickCheck)" $ property $ let+ prop :: String -> Property+ prop s = (parseExpr s $> fst) `isPrefixOf` s+ $> counterexample [d|show s, parseExpr s|]+ in prop++ describe "parseExp'" $ do it "should work" $ do- separate "a" `shouldBe` ["a"]- separate "a,b" `shouldBe` ["a", "b"]- separate "a, b" `shouldBe` ["a", " b"]- separate "(a)" `shouldBe` ["(a)"]- separate "(a, b)" `shouldBe` ["(a, b)"]- separate "(a, b), b" `shouldBe` ["(a, b)", " b"]- separate "','" `shouldBe` ["','"]- separate "a ',' b" `shouldBe` ["a ',' b"]- separate "(a, b \")\"), b" `shouldBe` ["(a, b \")\")", " b"]+ let p = parseExp'+ p [] "asd" `shouldBe` ("asd", "")+ p [] "a,b" `shouldBe` ("a", "b")+ p ")" "a,b" `shouldBe` ("a,b", "")+ p [] "(a,b)" `shouldBe` ("(a,b)", "")+ p [] "(a,b),c" `shouldBe` ("(a,b)", "c")+ p [] "[a,b],c" `shouldBe` ("[a,b]", "c")+ p "]]" "],b],c" `shouldBe` ("],b]", "c")+ p [] [q|"a,b",c|] `shouldBe` ([q|"a,b"|], "c")+ p [] [q|',',c|] `shouldBe` ([q|','|], "c")+ p [] [q|'"',c|] `shouldBe` ([q|'"'|], "c")+ -- p [] [q|'\',',|] `shouldBe` ([q|'\','|], "c")+ p [] [q|"\",",c|] `shouldBe` ([q|"\","|], "c")+ p [] [q|'\'',c|] `shouldBe` ([q|'\''|], "c")+ p [] [q|(\),c|] `shouldBe` ([q|(\)|], "c")++ -- TODO decide+ -- it "should? handle quotes int its own stack" $ do+ -- p ['"'] [q|a,b",c|] `shouldBe` ([q|a,b"|], "c")+ -- p ['"'] [q|(a",c|] `shouldBe` ([q|(a"|], "c")+ -- p ['\''] [q|,',c|] `shouldBe` ([q|,'|], "c")++ describe "splitOnCommas" $ do+ it "should work" $ do+ let s = splitOnCommas+ s "a" `shouldBe` ["a"]+ s "a,b" `shouldBe` ["a", "b"]+ s "a, b" `shouldBe` ["a", " b"]+ s "(a)" `shouldBe` ["(a)"]+ s "(a, b)" `shouldBe` ["(a, b)"]+ s "(a, b), b" `shouldBe` ["(a, b)", " b"]+ s "','" `shouldBe` ["','"]+ s "a ',' b" `shouldBe` ["a ',' b"]+ s "(a, b \")\"), b" `shouldBe` ["(a, b \")\")", " b"]+ s "(a, b \")\\\",\"), b" `shouldBe` ["(a, b \")\\\",\")", " b"] describe "Debug.Dump" $ do -- TODO decide if this is useful enough to warrant support
src/Debug/Dump.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# LANGUAGE DeriveFunctor #-} {-| @@ -9,11 +10,45 @@ import Debug.Dump (dd) @ +Example usage:++@+{-\# LANGUAGE QuasiQuotes \#-}++import Debug.Dump++main = print [d|a, a+1, map (+a) [1..3]|]+ where a = 2+@++which prints:++@+(a) = 2 (a+1) = 3 (map (+a) [1..3]) = [3,4,5]+@++by turnint this String++@+"a, a+1, map (+a) [1..3]"+@++into this expression++@+( "(a) = " ++ show (a) ++ "\t " +++ "(a+1) = " ++ show (a + 1) ++ "\t " +++ "(map (+a) [1..3]) = " ++ show (map (+ a) [1 .. 3])+)+@+ -} module Debug.Dump (d, dd, dump) where -import Utils+import Internal.Utils (($>), (.>))+import qualified Internal.Utils as Utils+import qualified Internal.Parser as Parser import Data.List import Debug.Trace import Language.Haskell.TH@@ -21,7 +56,6 @@ import Language.Haskell.Meta.Parse import Text.InterpolatedString.Perl6 - -- | This is the main `QuasiQuoter`. dump :: QuasiQuoter dump = QuasiQuoter {quoteExp = process}@@ -32,22 +66,36 @@ -- | Shorthand for `dump`. dd = dump ++newtype HsExp a = HsExp a deriving (Functor)+unHsExp (HsExp s) = s++instance Applicative HsExp where+ pure = HsExp+ (HsExp f) <*> (HsExp a) = HsExp $ f a+ process :: String -> Q Exp-process str = pairsOf str $> parse $> return- where- pairsOf :: String -> String- pairsOf str = join (map pairOf list) $> wrapInParens- where- join :: [String] -> String- join = intercalate ([q| ++ "\t " ++ |] :: String)- list :: [String]- list = separate str- pairOf :: String -> String- pairOf str = [qq|"($stripped) = " ++ show ($str)|]- where- stripped :: String- stripped = strip str- parse :: String -> Exp- parse = parseExp .> either error id+process = id+ .> splitOnCommas+ .> map nameAndValue+ .> joinAsColumns+ .> wrapInParens+ .> parseHsStrToQQExp+ .> return++splitOnCommas :: String -> [HsExp String]+splitOnCommas = Parser.splitOnCommas .> map HsExp++nameAndValue :: HsExp String -> HsExp String+nameAndValue = fmap $ \str-> [qq|"({Utils.strip str}) = " ++ show ($str)|]++joinAsColumns :: [HsExp String] -> HsExp String+joinAsColumns = sequenceA .> fmap (intercalate [q| ++ "\t " ++ |])++wrapInParens :: HsExp String -> HsExp String+wrapInParens = fmap Utils.wrapInParens++parseHsStrToQQExp :: HsExp String -> Exp+parseHsStrToQQExp = unHsExp .> parseExp .> either error id
− src/Internal/Parse.hs
@@ -1,40 +0,0 @@-module Internal.Parse where--import Debug.Trace--parseSimple :: String -> [String]-parseSimple "" = []-parseSimple str = match : parseSimple rest- where- match = pExp str- rest = drop (length match + 1) str--pExp :: String -> String-pExp = pUntil 0 ','--pUntil :: Int -> Char -> String -> String-pUntil _ _ "" = ""-pUntil i c (x : xs)- | x == c = ""- | x == '(' = x : matchAndRest ')'- | x == '[' = x : matchAndRest ']'- | x == '\'' = x : leaf '\''- | x == '"' = x : leaf '"'- | otherwise = x : pUntil i c xs- where- matchAndRest = factory $ pUntil $ i + 1- leaf = factory pLeaf- factory :: (Char -> String -> String) -> Char -> String- factory f cc = match ++ [cc] ++ pUntil i c rest- where- match = f cc xs- rest = drop (length match + 1) xs--pLeaf :: Char -> String -> String-pLeaf _ "" = ""-pLeaf cc (x:xs)- | x == cc = ""- | x == '\\' = x : case xs of- "" -> ""- (y:ys) -> y : pLeaf cc ys- | otherwise = x : pLeaf cc xs
+ src/Internal/Parser.hs view
@@ -0,0 +1,36 @@+module Internal.Parser where++type Parser = String -> (String, String)++splitOnCommas :: String -> [String]+splitOnCommas "" = []+splitOnCommas expr = m : splitOnCommas r+ where (m, r) = parseExpr expr++parseExpr :: Parser+parseExpr = parseExp' []++parseExp' :: [Char] -> Parser+parseExp' _ "" = ("", "")+parseExp' [] (',':xs) = ("", xs)+parseExp' (s:tack) (x:xs) | x == s = withMatch x $ parseExp' tack xs+parseExp' stack (x:xs) = withMatch x $ case x of+ '(' -> parseExp' (')':stack) xs+ '[' -> parseExp' (']':stack) xs+ '"' -> parseLeaf (parseExp' stack) '"' xs+ '\'' -> parseLeaf (parseExp' stack) '\'' xs+ _ -> parseExp' stack xs++parseLeaf :: Parser -> Char -> Parser+parseLeaf _ _ "\\" = ("\\", "")+parseLeaf _ _ "" = ("", "")+parseLeaf cont cc (x:xs) = withMatch x result+ where+ result+ | x == cc = cont xs+ | x == '\\' = withMatch y $ parseLeaf cont cc ys+ | otherwise = parseLeaf cont cc xs+ (y:ys) = xs++withMatch :: a -> ([a], [b]) -> ([a], [b])+withMatch x (m, r) = (x:m, r)
+ src/Internal/Utils.hs view
@@ -0,0 +1,17 @@+module Internal.Utils where++import qualified Data.Text as T+import Text.InterpolatedString.Perl6+import Debug.Trace+import Internal.Parser++(.>) = flip (.); infixl 9 .>+($>) = flip ($); infixl 0 $>++strip = T.unpack . T.strip . T.pack++wrapInParens :: String -> String+wrapInParens = wrapIn "(" ")"++wrapIn :: String -> String -> String -> String+wrapIn a c b = a ++ b ++ c
− src/Utils.hs
@@ -1,27 +0,0 @@-module Utils where--import qualified Data.Text as T-import Text.InterpolatedString.Perl6-import Debug.Trace-import Internal.Parse--(.>) = flip (.); infixl 9 .>-($>) = flip ($); infixl 0 $>--strip = T.unpack . T.strip . T.pack--wrapInParens :: String -> String-wrapInParens = wrapIn "(" ")"--wrapIn :: String -> String -> String -> String-wrapIn a c b = a ++ b ++ c--separate :: String -> [String]-separate = parseSimple--- separate = wordsWhen (== ',')--wordsWhen :: (Char -> Bool) -> String -> [String]-wordsWhen p s = case dropWhile p s of- "" -> []- s' -> w : wordsWhen p s''- where (w, s'') = break p s'