packages feed

vampire 0.1.1.0 → 0.1.2.0

raw patch · 9 files changed

+122/−75 lines, 9 filesdep +directorydep +process

Dependencies added: directory, process

Files

Debug/Vampire.hs view
@@ -1,5 +1,5 @@-module Debug.Vampire (structFor, toGraph, viewExpr, rewriteFile) where+module Debug.Vampire (structFor, valueFor, toGraph, viewExpr, rewriteFile, wrapExp) where -import Debug.Vampire.Visualize+import Debug.Vampire.Analyze import Debug.Vampire.Rewrite
+ Debug/Vampire/Analyze.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE ImplicitParams, RankNTypes #-}++module Debug.Vampire.Analyze (structFor, valueFor, toGraph, viewExpr) where++import Debug.Vampire.Data+import Debug.Vampire.Trace+import Control.DeepSeq+import Data.IORef+import Data.Graph.Inductive+import Data.GraphViz hiding (parse)++-- imports for copypasted func+import Data.DList (singleton, fromList, toList)+import Control.Arrow+import Control.Monad.RWS++instance Labellable () where+  toLabelValue = const (toLabelValue "")++structFor :: (Show a, NFData a) => ((?vCtx::IORef ExprStruct') => () -> a) -> IO ExprStruct+structFor d = do+  let struct' = (let ?vCtx = vNewExprStruct "toplevel" in d () `deepseq` ?vCtx)+  struct <- readIORef struct' >>= resolve+  return $ case children struct of+    full:_ -> full+    []     -> ExprStruct "" Nothing []++valueFor :: (Show a, NFData a) => ((?vCtx::IORef ExprStruct') => () -> a) -> a+valueFor d = let ?vCtx = vNewExprStruct "toplevel" in d ()++labelFor :: ExprStruct -> String+labelFor (ExprStruct expr (Just val) _) = expr ++ " = " ++ val+labelFor (ExprStruct expr Nothing _) = expr ++ " = Unevaluated"++-- copypasted from SO, credit: http://stackoverflow.com/a/14621912+toGraph :: ExprStruct -> Gr String ()+toGraph t = uncurry mkGraph . (toList *** toList) . snd $ evalRWS (go t) () [1..]+  where go e@(ExprStruct _ _ ns) = do+          i <- state $ head &&& tail+          es <- forM ns $ go >=> \j -> return (i, j, ())+          tell (singleton (i, labelFor e), fromList es)+          return i++viewExpr :: (Show a, NFData a) => ((?vCtx::IORef ExprStruct') => () -> a) -> IO ()+viewExpr = structFor >=> preview . toGraph+
Debug/Vampire/Data.hs view
@@ -4,13 +4,13 @@ import Data.Functor  data ExprStruct =-  ExprStruct {expr' :: String,-              value' :: Maybe String,-              children' :: [ExprStruct]} deriving Show-data ExprStruct' =-  ExprStruct' {expr :: String,+  ExprStruct {expr :: String,               value :: Maybe String,-              children :: [IORef ExprStruct']}+              children :: [ExprStruct]} deriving Show+data ExprStruct' =+  ExprStruct' {expr' :: String,+              value' :: Maybe String,+              children' :: [IORef ExprStruct']}  resolve :: ExprStruct' -> IO ExprStruct resolve (ExprStruct' expr value children) =
Debug/Vampire/Rewrite.hs view
@@ -1,4 +1,4 @@-module Debug.Vampire.Rewrite (rewriteFile) where+module Debug.Vampire.Rewrite (rewriteFile, wrapExp) where  import Language.Haskell.Exts import Data.Generics.Uniplate.Data (descend, descendBi)@@ -25,4 +25,12 @@       result = (let ?ctx = resultStruct in [splice expr in])   in (log ?ctx result resultStruct) `seq` result -}++wrapExp' :: String -> Exp -> Exp+wrapExp' wrapper exp = App (Var (UnQual (Ident wrapper))) (Paren (Lambda (SrcLoc {srcFilename = "<unknown>.hs", srcLine = 1, srcColumn = 11}) [PWildCard] exp))++wrapExp :: String -> String -> Maybe String+wrapExp wrapper code = case parseExp code of+  ParseOk exp -> Just $ prettyPrint $ wrapExp' wrapper exp+  _           -> Nothing
Debug/Vampire/Trace.hs view
@@ -9,14 +9,14 @@  vNewExprStruct :: String -> IORef ExprStruct' vNewExprStruct expr =-  unsafePerformIO $ newIORef ExprStruct' {expr = expr, value = Nothing, children = []}+  unsafePerformIO $ newIORef ExprStruct' {expr' = expr, value' = Nothing, children' = []}  {-# NOINLINE vNewExprStruct #-}  vLog :: Show a => IORef ExprStruct' -> a -> IORef ExprStruct' -> a vLog parent result current = unsafePerformIO $ do-  modifyIORef' current $ \s -> s {value = Just (show result)}-  modifyIORef' parent  $ \s@ExprStruct' {children = c} -> s {children = current:c}+  modifyIORef' current $ \s -> s {value' = Just (show result)}+  modifyIORef' parent  $ \s@ExprStruct' {children' = c} -> s {children' = current:c}   return result  {-# NOINLINE vLog #-}
− Debug/Vampire/Visualize.hs 
@@ -1,43 +0,0 @@-{-# LANGUAGE ImplicitParams, RankNTypes #-}--module Debug.Vampire.Visualize (structFor, toGraph, viewExpr) where--import Debug.Vampire.Data-import Debug.Vampire.Trace-import Control.DeepSeq-import Data.IORef-import Data.Graph.Inductive-import Data.GraphViz hiding (parse)---- imports for copypasted func-import Data.DList (singleton, fromList, toList)-import Control.Arrow-import Control.Monad.RWS--instance Labellable () where-  toLabelValue = const (toLabelValue "")--structFor :: (Show a, NFData a) => ((?vCtx::IORef ExprStruct') => () -> a) -> IO ExprStruct-structFor d = do-  let struct = (let ?vCtx = vNewExprStruct "toplevel" in d () `deepseq` ?vCtx)-  struct' <- readIORef struct >>= resolve-  return $ case children' struct' of-    full:_ -> full-    []     -> ExprStruct "" Nothing []--labelFor :: ExprStruct -> String-labelFor (ExprStruct expr (Just val) _) = expr ++ " = " ++ val-labelFor (ExprStruct expr Nothing _) = expr ++ " = Unevaluated"---- copypasted from SO, credit: http://stackoverflow.com/a/14621912-toGraph :: ExprStruct -> Gr String ()-toGraph t = uncurry mkGraph . (toList *** toList) . snd $ evalRWS (go t) () [1..]-  where go e@(ExprStruct _ _ ns) = do-          i <- state $ head &&& tail-          es <- forM ns $ go >=> \j -> return (i, j, ())-          tell (singleton (i, labelFor e), fromList es)-          return i--viewExpr :: (Show a, NFData a) => ((?vCtx::IORef ExprStruct') => () -> a) -> IO ()-viewExpr = structFor >=> preview . toGraph-
Main.hs view
@@ -4,7 +4,11 @@ import Options.Applicative import Control.Applicative import Control.Monad+import System.Directory+import System.IO+import System.Process import System.Exit+import Paths_vampire  readFrom "-"  = getContents readFrom file = readFile file@@ -18,6 +22,18 @@     Just newCode -> writeTo dest newCode     Nothing      -> putStrLn "could not parse input" >> exitFailure +doREPL :: String -> IO ()+doREPL mod = do+  script <- getDataFileName "vampire-repl"+  () <$ rawSystem "ghci" [mod, "-ghci-script", script]++doRewriteREPL :: String -> IO ()+doRewriteREPL src = do+  (dest, h) <- getTemporaryDirectory >>= flip openTempFile "Drained.hs"+  hClose h+  doRewrite src dest+  doREPL dest+ -- parsers!  rewrite =@@ -25,9 +41,21 @@     (argument str $ metavar "SOURCE")     (argument str $ metavar "DEST" <> value "-" <> showDefault) rewriteDesc = "Rewrite a Haskell source file to add Vampire tracing."+repl =+  fmap doREPL+    (argument str $ metavar "MODULE")+replDesc = "Open a GHCi with a few custom commands onto a rewritten module."+reREPL =+  fmap doRewriteREPL+    (argument str $ metavar "SOURCE")+reREPLDesc =+  "Rewrite a Haskell source file to add Vampire tracing, then " +++  "open a GHCi with a few custom commands onto the rewritten module."   vampire = subparser $-  (command "rewrite" $ info rewrite $ progDesc rewriteDesc)+  (command "rewrite" $ info rewrite $ progDesc rewriteDesc) <>+  (command "repl"    $ info repl    $ progDesc replDesc)    <>+  (command "rerepl"  $ info reREPL  $ progDesc reREPLDesc)  main = join $ execParser $   info (helper <*> vampire)
+ data/vampire-repl view
@@ -0,0 +1,4 @@+import Debug.Vampire+:def vview maybe (putStrLn "could not parse input" >> return "") return . wrapExp "viewExpr"+:def veval maybe (putStrLn "could not parse input" >> return "") return . wrapExp "valueFor"+
vampire.cabal view
@@ -1,22 +1,22 @@--- Initial vampire.cabal generated by cabal init.  For further +-- Initial vampire.cabal generated by cabal init.  For further -- documentation, see http://haskell.org/cabal/users-guide/  -- The name of the package. name:                vampire --- The package version.  See the Haskell package versioning policy (PVP) +-- The package version.  See the Haskell package versioning policy (PVP) -- for standards guiding when and how versions should be incremented. -- http://www.haskell.org/haskellwiki/Package_versioning_policy -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.1.0+version:             0.1.2.0  -- A short (one-line) description of the package. synopsis:            Analyze and visualize expression trees.  -- A longer description of the package.--- description:         +-- description:  -- URL for the project homepage or repository. homepage:            https://github.com/benzrf/vampire@@ -30,24 +30,27 @@ -- The package author(s). author:              benzrf --- An email address to which users can send suggestions, bug reports, and +-- An email address to which users can send suggestions, bug reports, and -- patches. maintainer:          benzrf@benzrf.com  -- A copyright notice.--- copyright:           +-- copyright:  category:            Development  build-type:          Simple --- Extra files to be distributed with the package, such as examples or a +-- Extra files to be distributed with the package, such as examples or a -- README.--- extra-source-files:  +-- extra-source-files:  -- Constraint on the version of Cabal needed to build this package. cabal-version:       >=1.10 +data-dir:            data+data-files:          vampire-repl+ library   exposed-modules:     Debug.Vampire@@ -56,7 +59,7 @@   other-modules:     Debug.Vampire.Data     Debug.Vampire.Rewrite-    Debug.Vampire.Visualize+    Debug.Vampire.Analyze    build-depends:     base >=4.6 && <4.7,@@ -66,21 +69,20 @@     fgl,     mtl,     dlist,-    graphviz,-    optparse-applicative+    graphviz    default-language:    Haskell2010  executable vampire   -- .hs or .lhs file containing the Main module.   main-is:             Main.hs-  +   -- Modules included in this executable, other than Main.-  -- other-modules:       -  +  -- other-modules:+   -- LANGUAGE extensions used by modules in this package.-  -- other-extensions:    -  +  -- other-extensions:+   -- Other library packages from which modules are imported.   build-depends:     base >=4.6 && <4.7,@@ -91,11 +93,13 @@     mtl,     dlist,     graphviz,+    directory,+    process,     optparse-applicative-  +   -- Directories containing source files.-  -- hs-source-dirs:      -  +  -- hs-source-dirs:+   -- Base language which the package is written in.   default-language:    Haskell2010