Using Control.Lens.Plated with python AST - haskell

I'm trying to learn to use plated to transform and search through the python AST generated by language-python (https://hackage.haskell.org/package/language-python-0.5.4/docs/Language-Python-Common-AST.html)
To briefly summarize the types:
Modules is a list of statements
A statement can contain further statements or expressions
An expression can contain further expressions, identities or operators
I created a hello world to get started with these two libraries. Here's my code that defines plate for a subset of the python AST types:
{-# LANGUAGE FlexibleInstances#-}
module Lib
( someFunc
) where
import Language.Python.Version3.Parser
import Language.Python.Common.Token
import Language.Python.Common.AST
import Language.Python.Common.SrcLocation
import Control.Lens.Plated
import Data.Data.Lens
import Language.Python.Common.Pretty
import Language.Python.Common.PrettyAST
instance Plated (Statement SrcSpan) where
plate = uniplate
instance Plated (Expr SrcSpan) where
plate = uniplate
instance Plated (Ident SrcSpan) where
plate = uniplate
instance Plated (Op SrcSpan) where
plate = uniplate
extract (Right (x, _)) = x
someFunc :: IO ()
someFunc = do
putStrLn $ show $ concatMap (map prettyText) $ universe $ extract $ parseStmt "2*(1+x)" "file.py"
putStrLn $ show $ map prettyText $ universe $ extract $ parseExpr "2*(1+x)" "file.py"
The output of this program is
["2 * (1 + x)"]
["2 * (1 + x)","2","(1 + x)","1 + x","1","x"]
The problem I'm seeing is that plated only sees the type consistent with the root node. If I start with a statement as my root node it doesn't look at expressions which are children of the statement. In the second case where I look at expressions it seems to descend and find child expressions. But, it's not showing me the operators or identity types that are children of expressions.
How do get plate to descend into a data structure with mixed types? Or am I using the wrong tool for this?

Related

Filter inner element from a tree via lens

I'm constantly admitting that I'm bad at lens, but isn't learning by examples is a good thing? I want to take HTML, parse it with taggy-lens and then remove all the script elements from inside. Here's my attempt:
#!/usr/bin/env stack
-- stack --resolver lts-7.1 --install-ghc runghc --package text --package lens --package taggy-lens --package string-class --package classy-prelude
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
import ClassyPrelude
import Control.Lens hiding (children, element)
import Data.String.Class (toText, fromText, toString)
import Data.Text (Text)
import Text.Taggy.Lens
import qualified Text.Taggy.Lens as Taggy
import qualified Text.Taggy.Renderer as Renderer
somehtmlSmall :: Text
somehtmlSmall =
"<!doctype html><html><body>\
\<div id=\"article\"><div>first</div><div>second</div><script>this should be removed</script><div>third</div></div>\
\</body></html>"
renderWithoutScriptTag :: Text
renderWithoutScriptTag =
let mArticle :: Maybe Taggy.Element
mArticle =
(fromText somehtmlSmall) ^? html .
allAttributed (ix "id" . only "article")
mArticleFiltered =
fmap
(\el ->
el ^.. to universe . traverse .
filtered (\n -> n ^. name /= "script"))
mArticle
in maybe "" (toText . concatMap Renderer.render) mArticleFiltered
main :: IO ()
main = print renderWithoutScriptTag
Mark this file as executable and just run it, and you'll see:
➜ tmp ./scraping-question.hs
"<div id=\"article\"><div>first</div><div>second</div><script>this should be removed</script><div>third</div></div><div>first</div><div>second</div><div>third</div>"
So, this didn't work. I would like to:
have a working solution
understand the working solution
Would be especially thankful, if you'd help me realize what's wrong with mine. Thanks!
The root of your problem is universe, which flattens the DOM tree into a list. If you look again at the output, you will see the filtering is working fine but the tree structure is lost -- and so you get the unmodified article element (with all children still within) followed by the children nodes minus the script element.
One Control.Lens.Plated combinator that can do what you want is transform, which transforms "every element in the tree, in a bottom-up manner":
transform :: Plated a => (a -> a) -> a -> a
In particular, you can use it to filter the children nodes recursively:
renderWithoutScriptTag :: Text
renderWithoutScriptTag =
let mArticle :: Maybe Taggy.Element
mArticle =
(fromText somehtmlSmall) ^? html .
allAttributed (ix "id" . only "article")
mArticleFiltered =
fmap
(transform (children %~ filter (\n ->
n ^? element . name /= Just "script")))
mArticle
in maybe "" (toText . Renderer.render) mArticleFiltered

Bar charts in Haskell-d3js

I decided to poke through the d3js library in Haskell but after it didn't install through Stackage.
$ stack install d3js
Run from outside a project, using implicit global project config
Using resolver: lts-5.2 from implicit global project's config file: /home/john/.stack/global-project/stack.yaml
While constructing the BuildPlan the following exceptions were encountered:
-- Failure when adding dependencies:
base: needed (>=4.6 && <4.7), 4.8.2.0 found (latest applicable is 4.6.0.1)
needed for package d3js-0.1.0.0
Instead I got the more interestin idea of looking through the source of d3js-haskell. If I could install the library this could be one of the simplest examples: a bar chart.
import Control.Monad
import qualified Data.Text as T
import D3JS
test :: Int -> IO ()
test n = T.writeFile "generated.js" $ reify (box "#div1" (300,300) >>= bars n 300 (Data1D [100,20,80,60,120]))
Even with this simple example I have a number of questions. How does reify work ? I had to look up the word in a dictionary:
to regard (something abstract) as a material or concrete thing
Did you know?
Reify is a word that attempts to provide a bridge between what is abstract and what is real. Fittingly, it derives from a word that is an ancestor to "real" - the Latin noun res, meaning "thing." Both "reify" and the related noun "reification" first appeared in English in the mid-19th century, though "reification" is a few years older and some dictionaries consider "reify" to be a back-formation of the noun. In general use, the words refer to the act of considering or presenting an abstract idea in real or material terms, or of judging something by a concrete example.
That having been said the reify function in the d3.js library turns Haskell entities representing d3.js objects into actual d3.js code. Do we have examples of a reifiable object? We can fine one:
reify (box "#div1" (300,300) >>= bars n 300 (Data1D [100,20,80,60,120]))
The object in parentheses is a reifiable object. A tour of the source code is both enlightening and discouraging:
-- |Instances of Reifiable can generate a JavaScript code fragment.
class Reifiable a where
reify :: a -> Text
This was taken from d3js/Type.hs Are there examples of reifiable objects? Let's look at d3js/reify.hs:
instance Reifiable Data1D where
reify (Data1D ps) = surround $ T.intercalate "," $ map show' ps
instance Reifiable Data2D where
reify (Data2D ps) = surround $ T.intercalate "," $ map (\(x,y) -> T.concat ["[",show' x,",",show' y,"]"]) ps
instance Reifiable (JSFunc params r) where
reify (JSFunc name params) = T.concat [name,"(",T.intercalate "," $ map reify params,")"]
instance Reifiable JSParam where
reify (ParamVar name) = name
reify (PText t) = T.concat ["\"",t,"\""]
reify (PDouble d) = show' d
reify (PInt d) = show' d
reify (PFunc (FuncTxt t)) = t
reify (PFunc (FuncExp f)) = T.concat["function(d,i){return ",reify f,";}"]
reify (PFunc' f) = reify f
reify (PArray vs) = T.concat ["[",T.intercalate "," $ map reify vs,"]"]
reify (PChainValue v) = reify v
These are examples of reifiable types but these don't tell us how charts are constructed in haskell-d3js?
-- | box parent (w,h) makes an SVG container in a parent element with dimension w x h.
box :: Selector -> (Double,Double) -> St (Var' Selection)
box parent (w,h) = do
assign
$ ((d3Root
>>> select parent
>>> func "append" [PText "svg"]
>>> width w
>>> height h
>>> style "background" "#eef") :: Chain () Selection)
bars :: Int -> Double -> Data1D -> Var' Selection -> St ()
bars n width ps (Var' elem) = do
let bar_w = width / (fromIntegral n)
v <- assign $ Val' (mkRectData bar_w ps)
execute $
(Val elem :: Chain () Selection)
>>> addRect v
>>> fill' "red"
These examples supposedly work. It looks like we are committed to red bars ( I haven't even seen the chart yet).
Let me end by some discouraging footnotes in the source code. This from chart.hs
-- This modules provides high-level functions for drawing common charts, such as bar charts and scatter plots.
-- Those functions also exemplify how to compose primitive functions to achieve complex drawing.
-- This module will be expanded in the near future.
Not sure exactly what your question is, but here is how to get the d3js demo to run:
Run these commands:
stack new demo
cd demo
cabal get d3js-0.1.0.0
Make sure the resolver: setting in stack.yaml is relatively new (e.g. >= 5.0)
In the stack.yaml file change the packages stanza to read:
packages:
- '.'
- d3js-0.1.0.0
In the file d3js-0.1.0.0/d3js.cabal modify the build-depends line to read:
build-depends: base >=4.6
(i.e. omit the upper bounds on base)
In demo.cabal make the library stanza look like:
library
hs-source-dirs: src
exposed-modules: Lib
build-depends: base >= 4.8 && < 5, d3js, text
default-language: Haskell2010
Use this for src/Lib.hs:
{-# LANGUAGE OverloadedStrings #-}
module Lib
where
import Control.Monad
import qualified Data.Text as T
import qualified Data.Text.IO as T
import D3JS
someFunc :: IO ()
someFunc = putStrLn "someFunc"
test :: Int -> IO ()
test n = T.writeFile "generated.js" $ reify (box "#div1" (300,300) >>= bars n 300 (Data1D [100,20,80,60,120]))
Run stack ghci and run something like test 13 function. Look at the output in generated.js.
The d3js package hasn't been updated for a while, and it imposes a too restrictive upper bound on the base package. It turns out that it will compile fine with the latest base so we're making the d3js source code part of our own project and tweaking it to get it to compile.

Running Q Exp in a GhcMonad [duplicate]

Is it possible to generate and run TemplateHaskell generated code at runtime?
Using C, at runtime, I can:
create the source code of a function,
call out to gcc to compile it to a .so (linux) (or use llvm, etc.),
load the .so and
call the function.
Is a similar thing possible with Template Haskell?
Yes, it's possible. The GHC API will compile Template Haskell. A proof-of-concept is available at https://github.com/JohnLato/meta-th, which, although not very sophisticated, shows one general technique that even provides a modicum of type safety. Template Haskell expressions are build using the Meta type, which can then be compiled and loaded into a usable function.
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wall #-}
module Data.Meta.Meta (
-- * Meta type
Meta (..)
-- * Functions
, metaCompile
) where
import Language.Haskell.TH
import Data.Typeable as Typ
import Control.Exception (bracket)
import System.Plugins -- from plugins
import System.IO
import System.Directory
newtype Meta a = Meta { unMeta :: ExpQ }
-- | Super-dodgy for the moment, the Meta type should register the
-- imports it needs.
metaCompile :: forall a. Typeable a => Meta a -> IO (Either String a)
metaCompile (Meta expr) = do
expr' <- runQ expr
-- pretty-print the TH expression as source code to be compiled at
-- run-time
let interpStr = pprint expr'
typeTypeRep = Typ.typeOf (undefined :: a)
let opener = do
(tfile, h) <- openTempFile "." "fooTmpFile.hs"
hPutStr h (unlines
[ "module TempMod where"
, "import Prelude"
, "import Language.Haskell.TH"
, "import GHC.Num"
, "import GHC.Base"
, ""
, "myFunc :: " ++ show typeTypeRep
, "myFunc = " ++ interpStr] )
hFlush h
hClose h
return tfile
bracket opener removeFile $ \tfile -> do
res <- make tfile ["-O2", "-ddump-simpl"]
let ofile = case res of
MakeSuccess _ fp -> fp
MakeFailure errs -> error $ show errs
print $ "loading from: " ++ show ofile
r2 <- load (ofile) [] [] "myFunc"
print "loaded"
case r2 of
LoadFailure er -> return (Left (show er))
LoadSuccess _ (fn :: a) -> return $ Right fn
This function takes an ExpQ, and first runs it in IO to create a plain Exp. The Exp is then pretty-printed into source code, which is compiled and loaded at run-time. In practice, I've found that one of the more difficult obstacles is specifying the correct imports in the generated TH code.
From what I understand you want to create and run a code at runtime which I think you can do using GHC API but I am not very sure of the scope of what you can achieve. If you want something like hot code swapping you can look at the package hotswap.

How to properly communicate compile-time information to Template Haskell functions?

I need to communicate some information from compile scripts into Template Haskell. Currently the compile scripts keep the information in the system environment, so I just read it using System.Environment.getEnvironment wrapped in runIO. Is there a better way, such as passing some arguments to ghc (similar to -D... for the C pre-processor), or perhaps something specifically designed for this purpose in TH?
Since so many people are interested in the question, I'll add my current approach, perhaps somebody will find it useful. Probably the best way would be if TH allowed to read -D parameters on GHC's command line, but it seems nothing like this is currently implemented.
A simple module allows TH to read compile-time environment. A helper function also allows to read files; for example read the path of a configuration file from the environment and then read the file.
{-# LANGUAGE TemplateHaskell #-}
module THEnv
(
-- * Compile-time configuration
lookupCompileEnv
, lookupCompileEnvExp
, getCompileEnv
, getCompileEnvExp
, fileAsString
) where
import Control.Monad
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (Lift(..))
import System.Environment (getEnvironment)
-- Functions that work with compile-time configuration
-- | Looks up a compile-time environment variable.
lookupCompileEnv :: String -> Q (Maybe String)
lookupCompileEnv key = lookup key `liftM` runIO getEnvironment
-- | Looks up a compile-time environment variable. The result is a TH
-- expression of type #Maybe String#.
lookupCompileEnvExp :: String -> Q Exp
lookupCompileEnvExp = (`sigE` [t| Maybe String |]) . lift <=< lookupCompileEnv
-- We need to explicly type the result so that things like `print Nothing`
-- work.
-- | Looks up an compile-time environment variable and fail, if it's not
-- present.
getCompileEnv :: String -> Q String
getCompileEnv key =
lookupCompileEnv key >>=
maybe (fail $ "Environment variable " ++ key ++ " not defined") return
-- | Looks up an compile-time environment variable and fail, if it's not
-- present. The result is a TH expression of type #String#.
getCompileEnvExp :: String -> Q Exp
getCompileEnvExp = lift <=< getCompileEnv
-- | Loads the content of a file as a string constant expression.
-- The given path is relative to the source directory.
fileAsString :: FilePath -> Q Exp
fileAsString = do
-- addDependentFile path -- works only with template-haskell >= 2.7
stringE . T.unpack . T.strip <=< runIO . T.readFile
It can be used like this:
{-# LANGUAGE TemplateHaskell #-}
import THEnv
main = print $( lookupCompileEnvExp "DEBUG" )
Then:
runhaskell Main.hs prints Nothing;
DEBUG="yes" runhaskell Main.hs prints Just "yes".
It looks like what you are trying to do here, The -D option in ghc seems to define a compile time variable.
Here, on the same subject is a question that seems to also answer the other part of your question.
From what I can tell, to do conditional compilation, you do something like:
#ifdef MACRO_NAME
//Do stuff here
#endif

Dynamic module name

I want to do something like this in Haskell, but the compiler is not letting me.
Is there any way to accomplish this task?
-- both modules export function named "hello"
-- and I want to run it in every module
import qualified MyMod as M1
import qualified MyAnotherMod as M2
runmodules = map (\m -> m.hello) [M1, M2]
Modules in Haskell are not even remotely first-class entities in the ways this would require, I'm afraid.
However, as bzn commented, Template Haskell can be used for problems like this. The result can be a bit clumsy, but if you really need some quick metaprogramming hacks it's not a bad choice. I'm not really an expert with TH, but what you want is pretty simple, with one catch: Neither "ambiguous identifiers" nor "module names" can be captured or quoted in any way, as far as I know, so you'll have to put them in strings given as arguments to the TH function.
Here's a quick and dirty, minimal example:
{-# LANGUAGE TemplateHaskell #-}
module MapModuleTH where
import Language.Haskell.TH
mapQual :: [String] -> String -> ExpQ
mapQual ms n = listE $ map (\m -> varE . mkName $ m ++ "." ++ n) ms
mapMQual :: [String] -> String -> ExpQ
mapMQual ms n = appE (varE 'sequence) $ listE $ map (\m -> varE . mkName $ m ++ "." ++ n) ms
You phrased things as "running the function" which sounds more like doing a bunch of IO actions, not just collecting a list of stuff, so I added a variant that also sequences the result.
Note that, despite the use of strings here, this is still statically typed--if the qualified names don't exist, or the types don't match up, you'll get the expected compile-time error just as if you'd written everything out by hand.
Here's a quick example of using it. Given the following:
{-# LANGUAGE TemplateHaskell #-}
module MapModule where
import MapModuleTH
import qualified Test1 as T1
import qualified Test2 as T2
tests = do xs <- $(mapMQual ["T1", "T2"] "test")
putStrLn $ "Count: " ++ show (length xs)
Assuming the other modules are there and define test, then in GHCi we can see:
> tests
Test 1
Test 2
Count: 2
I don't think you can quote a qualified name prefix like that in template haskell, and the hello identifier isn't in scope, so you might have to fall back to programming with strings.
module ModuleParamsTH where
import Language.Haskell.TH
getAll :: String -> [String] -> ExpQ
getAll valueName moduleNames =
listE $ map (varE . mkName . (++ suffix)) moduleNames
where suffix = "." ++ valueName
which can then be used like so,
{-# LANGUAGE TemplateHaskell #-}
import ModuleParamsTH
import qualified ModuleParamsM1 as M1
import qualified ModuleParamsM2 as M2
runmodules = $(getAll "hello" ["M1", "M2"])
However, I would not do all this. You could just write [M1.hello, M2.hello] or use a type class to abstract over implementations.
Modules aren't values in Haskell. Therefore that isn't possible. What do you want to achieve?

Resources