translating 2014 Nim to 2019 Nim - metaprogramming

I stumbled upon this code defining a DSL for html:
template html(matter: stmt) {.dirty.} =
var result = ""
matter
template tag(tagName) =
template `tagName`(attrs: varargs[expr], matter: stmt = nil) {.dirty.} =
# formatAttrs closes the tag and adds the inner tag if necessary
result.add("<" & astToStr(tagName) & formatAttrs(attrs))
matter
result.add("</" & astToStr(tagName) & ">")
tag head; tag link; tag body
tag ul; tag li; tag title
tag p; tag h2
template css(file) {.dirty.} =
link(relation = "stylesheet", href = file)
macro formatAttrs(args: seq[expr]): expr =
result = newCall("&")
var innerTexts = newSeq[string]()
for arg in args:
if arg.kind == nnkExprEqExpr:
result.addParams($arg[0], "=", quoteString($arg[1]))
else:
innerTexts.add($arg)
result.addParams ">"
result.addParams innerTexts
And the way to use it is this:
type Article = object
title, body: string
proc myPage(articles: seq[Article]): string =
return html:
head:
title "govnokod.ru"
css "moar-blink.css"
body:
ul:
for article in articles:
li:
h2 article.title
p article.body
The desired end result after the template expansion is this Nim code:
proc myPage(articles: seq[Article]): string =
var result = ""
result.add("<" & "head" & ">")
result.add("<" & "title" & ">")
result.add("govnokod.ru")
result.add("</" & "title" & ">")
result.add("<link " & "relation" & "=" & "\"stylesheet\"" &
"href" & "=" & "\"moar-blink.css\"" & ">")
result.add("</" & "link" & ">")
result.add("</" & "head" & ">")
result.add("<" & "body" & ">")
result.add("<" & "ul" & ">")
for article in articles:
result.add("<" & "li" & ">")
result.add("<" & "h2" & ">")
result.add article.title
result.add("</" & "h2" & ">")
result.add("<" & "p" & ">")
result.add article.body
result.add("</" & "p" & ">")
result.add("</" & "li" & ">")
result.add("</" & "ul" & ">")
result.add("</" & "body" & ">")
I found it in these slides:
http://ibob.github.io/slides/nimrodbg/#/12
Expression pattern matching is also used:
http://ibob.github.io/slides/nimrodbg/#/16
template optAdd1 {x = y; x.add(z)} (x, y, z: string) =
x = y & z
template optAdd2 {x.add(y); x.add(z)} (x, y, z: string) =
x.add(y & z)
so the final C code ends up being something equivalent to this (no unnecessary concatenations of strings):
NimString myPage(const Sequence<Article>& articles) {
NimString result =
"<head><title>govnokod.ru</title>"
"<link relation=\"\stylesheet\" href=\"moar-blink.css\></link></head>"
"<body><ul>";
for(const auto& article: articles) {
result.add(Concat("<li><h2>",
article.title, "</h2><p>",
article.body, "</p></li>"));
}
result.add("</ul></body>");
return result;
}
This is Nim syntax from 5 years ago - how would it look like in 2019? Is it still all possible? I'm familiar with the basics of Nim but really want to use this example if I get it up-to-date when showing the language to others.
EDIT: I got it to work thanks to #xbello !
import macros, strformat, strutils
template tag(tagName) =
template `tagName`(body: untyped) =
result.add("<" & astToStr(tagName) & ">")
body
result.add("</" & astToStr(tagName) & ">")
template `tagName`(attrs: varargs[untyped]) =
result.add("<" & astToStr(tagName) & " " & formatAttrs(attrs))
result.add("</" & astToStr(tagName) & ">")
template `tagName`(content: string) =
result.add("<" & astToStr(tagName) & ">" & content)
result.add("</" & astToStr(tagName) & ">")
macro formatAttrs(args: varargs[untyped]): untyped =
result = newCall("&")
var arg_list: seq[string] = #[]
for arg in args:
if arg.kind == nnkExprEqExpr:
arg_list.add(&"{arg[0]}=\"{arg[1]}\"")
arg_list.add(">")
result.add(newLit(join(arg_list, " ")))
template html(matter: untyped) =
result = "<html>"
matter
result.add("</html>")
template css(file) =
link(relation = "stylesheet", href = file)
tag head; tag link; tag body
tag ul; tag li; tag title
tag p; tag h2
type Article = object
title, body: string
proc myPage(articles: seq[Article]): string =
html:
head:
title "govnokod.ru"
css "moar-blink.css"
body:
ul:
for article in articles:
li:
h2 article.title
p article.body
let articles = #[Article(title: "omg", body: "omg_body"), Article(title: "wtf", body: "wtf_body")]
echo myPage(articles)

This is the only way I got this working. The templates splitted into body only (head), attrs (link) and content (li):
template tag(tagName) =
template `tagName`(body: untyped) =
result.add("<" & astToStr(tagName) & ">")
body
result.add("</" & astToStr(tagName) & ">")
template `tagName`(attrs: varargs[untyped]) =
result.add("<" & astToStr(tagName) & " " & formatAttrs(attrs))
result.add("</" & astToStr(tagName) & ">")
template `tagName`(content: string) =
result.add("<" & astToStr(tagName) & ">" & content)
result.add("</" & astToStr(tagName) & ">")
Macro writen as this (needs import strformat and strutils):
macro formatAttrs(args: varargs[untyped]): untyped =
result = newCall("&")
var arg_list: seq[string] = #[]
for arg in args:
if arg.kind == nnkExprEqExpr:
arg_list.add(&"{arg[0]}=\"{arg[1]}\"")
arg_list.add(">")
result.add(newLit(join(arg_list, " ")))

Related

VBA - Shell, Run Time Error 5 Invalid Procedure - Thunderbird Email with HTML table

I have a VBA code which allows to create an email(Thunderbird) and in email body appers HTML table based on cell values. Everythings works fine, but only until table has less then 19 rows and 24 columns. Then pops up Run Time Error 5 - line with Call Shell.
Here code for HTML Table(found in Net):
Function create_table(rng As Range) As String
Dim mbody As String
Dim mbody1 As String
Dim i As Long
Dim j As Long
mbody = "<TABLE width=""30%"" Border=""1"", Cellspacing=""0""><TR>" ' configure the table
'create Header row
For i = 1 To rng.Columns.Count
mbody = mbody & "<TD width=""100"", Bgcolor=""#000000"", Align=""Center""><Font Color=#FFFFFF><b><p style=""font-size:12px"">" & rng.Cells(1, i).Value & " </p></Font></TD>"
Next
' add data to the table
For i = 2 To rng.Rows.Count
mbody = mbody & "<TR>"
mbody1 = ""
For j = 1 To rng.Columns.Count
mbody1 = mbody1 & "<TD width=""80"", Align=""Center""><p style=""font-size:12px"">" & rng.Cells(i, j).Value & "</TD>"
Next
mbody = mbody & mbody1 & "</TR>"
Next
create_table = mbody
End Function
Code for email:
email = Worksheets("Sheet1").Range("B1").Value
subj = Worksheets("Sheet1").Range("B2").Value
body = "Hello" & "<br><br>" & _
create_table(ActiveSheet.Range("A1").CurrentRegion) & "</Table></Table>"
thund = "Thunderbird path" & _
" -compose " & """" & _
"to='" & email & "'," & _
"cc='" & cc & "'," & _
"bcc='" & bcc & "'," & _
"subject='" & subj & "'," & _
"body='" & body & "'" & """"
Call Shell(thund, vbNormalNoFocus)
Application.Wait (Now + TimeValue("0:00:03"))
Is there any limition? Is it possible to change it?
Thunderbird allows using a file for the body with the message parameter, use that instead of the body parameter
Dim FSO As New FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
fname = FSO.GetTempName & ".html"
Set FileToCreate = FSO.CreateTextFile(fname)
FileToCreate.Write body
FileToCreate.Close
Email = Worksheets("Sheet1").Range("B1").Value
subj = Worksheets("Sheet1").Range("B2").Value
body = "Hello" & "<br><br>" & _
create_table(ActiveSheet.Range("A1").CurrentRegion) & "</Table></Table>"
thund = "Thunderbird path" & _
" -compose " & """" & _
"to='" & Email & "'," & _
"cc='" & cc & "'," & _
"bcc='" & bcc & "'," & _
"subject='" & subj & "'," & _
"message='" & fname & "'" & """"
Call Shell(thund, vbNormalNoFocus)
Kill fname
Application.Wait (Now + TimeValue("0:00:03"))

Excel to XML nested elements

I am trying to use Excel to generate an XML ,Overview of XML in Excel & Export XML data
My XML looks something like this,more blocks and elements,this is just an example, :
<Block>
<Element1>XXX</Element1>
<Element2>YYY</Element2>
<Element3>ZZZ</Element3>
<Nested_Elements>
<Nested_Element>AAA</Nested_Element>
<Nested_Element>BBB</Nested_Element>
<Nested_Element>CCC</Nested_Element>
</Nested_Elements>
</Block>
in Excel I can map element1 ,element2 and element3 add diffrent values and export to XML,all works in a nice easy way ,which is exactly why I used excel instead of writing a python or c# code,the problem is with Nested_Element1 , Nested_Element2 ,Nested_Element3 .
After alot of search I think there is no way to do nested elements directly with Excel ,what would be the best intermidiate tool to use for this ,My knowledge with Excel is not very good ,so is VBA the only way to do it ?
and if I use VBA will I have to create a code to write the whole XML file so cannot make use of the Excel feature Export XML ?
Ok ,it truned out very easy but I will post an answer here in case someone is still searching for this ,
1- Map flat elements between excel cells with XML Map source .
2- VBA code to export the XML :
'Export XMLMap from worksheet,this will export the flat Mapped elements
Set Map = ActiveWorkbook.XmlMaps(1)
Map.Export Url:=XmlFile, Overwrite:=True
're-Load XML as DOM to process it
Set XDoc = New MSXML2.DOMDocument
XDoc.async = False: XDoc.validateOnParse = False
XDoc.Load XmlFile
'Update XML with nested elements
CellText = sheet_Board.Cells(22, "C").Value 'cell having nested elements values separated with "," ===> AAA,BBB,CCC
Set Node = XDoc.SelectSingleNode("//Block")
Set nodChild = XDoc.createElement("Nested_Elements")
Result = Split(CellText, ",")
For i = LBound(Result()) To UBound(Result())
Set nodGrandChild = XDoc.createElement("Nested_Element")
nodGrandChild.Text = Result(i)
nodChild.appendChild nodGrandChild
Next i
Node.appendChild nodChild
This will create an XML with the added nested nodes having no indentation :
<Block>
<Element1>XXX</Element1>
<Element2>YYY</Element2>
<Element3>ZZZ</Element3>
<Nested_Elements><Nested_Element>AAA</Nested_Element><Nested_Element>BBB</Nested_Element><Nested_Element>CCC</Nested_Element></Nested_Elements></Block>
To Fix the indentation add this piece of code (from stackoverflow https://stackoverflow.com/a/37634549/14360302)
Set xslDoc = New MSXML2.DOMDocument
xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
& "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
& " xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
& " <xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
& " <xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
& " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
& " <xsl:template match=" & Chr(34) & "node() | #*" & Chr(34) & ">" _
& " <xsl:copy>" _
& " <xsl:apply-templates select=" & Chr(34) & "node() | #*" & Chr(34) & " />" _
& " </xsl:copy>" _
& " </xsl:template>" _
& "</xsl:stylesheet>"
xslDoc.async = False
Set XmlNewDoc = New MSXML2.DOMDocument
XDoc.transformNodeToObject xslDoc, XmlNewDoc 'Line to fix indention
XmlNewDoc.Save XmlFile

excel vba countifs evaluate

I am getting an error on my evaluate function.
This code is running on a test sheet, so I know that it should give me "1" as answer, but I cannot make it run.
Here are the codes;
Check1 = Worksheets(Persona).Range("A3:A" & LastRowE3 & "")
Check2 = Worksheets(Persona).Range("J3:J" & LastRowE3 & "")
Ur_Val = "Production_End"
y = Application.Evaluate("=COUNTIFS(" & Check1 & ", " & xu_value & ", " & Check2 & ", " & Ur_Val & ")")
I know that "y" should be equal to "1", but I cannot get the answer right.
first declare your variables:
Dim Check1 as String,Check2 as String,Ur_Val as String,xu_value as String
Then
You want the Address of the ranges not just the range values:
Check1 = Worksheets(Persona).Range("A3:A" & LastRowE3 & "").Address(1,1,,1)
Check2 = Worksheets(Persona).Range("J3:J" & LastRowE3 & "").Address(1,1,,1)
And the strings Ur_Val and xu_value need to be surronded in " in the final formula so we need to add them:
, """ & xu_value & """,
So:
Dim Check1 as String,Check2 as String,Ur_Val as String,xu_value as String
Dim y as Long
Check1 = Worksheets(Persona).Range("A3:A" & LastRowE3 & "").Address(1,1)
Check2 = Worksheets(Persona).Range("J3:J" & LastRowE3 & "").Address(1,1)
Ur_Val = "Production_End"
xu_value = "SOMETHING_ELSE"
y = Application.Evaluate("=COUNTIFS(" & Check1 & ", """ & xu_value & """, " & Check2 & ", """ & Ur_Val & """)")

Convert strings to booleans

I need to import data from excel to access. The importation is now "working" for the obvious types (string, integers). However, In the excel file i have some strings that i need to convert to boolean in my access tables. The strings can take only 2 values "oui" or "non" (yes or no in french).
In my vba code i have the following line:
cSQL = "INSERT INTO " & strTable & " ( [N_CLIENT], [NOM_CLI], ) VALUES (" & Chr(34) & .Range("A" & i) & Chr(34) & "," & Chr(34) & .Range("F" & i) & Chr(34) & ");"
DoCmd.RunSQL cSQL
I would liketo know if i can use an if condition to check the value itself inside the cSQL call and replace it with either true or false. like what follows.
cSQL = "INSERT INTO " & strTable & " ( [N_CLIENT], [NOM_CLI], ) VALUES (If(" & Chr(34) & .Range("A" & i) & Chr(34) & " = "oui") then "true" else then "false"," & Chr(34) & .Range("F" & i) & Chr(34) & ");"
DoCmd.RunSQL cSQL
You can use VBA-Functions in Access-SQL-Queries:
"[...] VALUES(strcomp('" & Range("A" & i) & "','oui', 1)=0 [...]"
Regards,
AKDA
It looks like you want the Access SQL to evaluate your oui / non into true and false. You could do this using the iif statement http://www.techonthenet.com/access/functions/advanced/iif.php. However, why bother? You could just evaluate the range in vba and pass through the boolean variable. Using something like this:
dim result as boolean
if sheet1.Range("A" & i) = "oui" then
result = true
else
result = false
end if
Then just insert that into your SQL:
cSQL = "INSERT INTO " & strTable & " ( [N_CLIENT], [NOM_CLI], ) VALUES (If(" & Chr(34) & result & Chr(34) & , & Chr(34) & .Range("F" & i) & Chr(34) & ");"
You could also use the IIF statement in SQL to check the value:
http://msdn.microsoft.com/en-us/library/hh213574.aspx
It is easier to use apostrophes rather than Chr(34), and splitting the statement across lines using the line-continuation character '_' helps to read the statement. The IIf() function is also used in the following.
Also note that you have an extra comma after the term [NOM_CLI] which shouldn't be there.
cSQL = "INSERT INTO " & strTable & "( [N_CLIENT], [NOM_CLI] ) VALUES ('" _
& IIf(StrComp(.Range("A" & i), "oui", 1) = 0, "true", "false") _
& "','" & .Range("F" & i) & "');"
This results in a string like this:
INSERT INTO ( [N_CLIENT], [NOM_CLI] ) VALUES ('true','hello');
To use the Boolean values (0, -1) change to:
cSQL = "INSERT INTO " & strTable & "( [N_CLIENT], [NOM_CLI] ) VALUES (" _
& IIf(StrComp(.Range("A" & i), "oui", 1) = 0, -1, 0) _
& ",'" & .Range("F" & i) & "');"
which yields
INSERT INTO ( [N_CLIENT], [NOM_CLI] ) VALUES (-1,'hello');

concatenation and max length of string in VBA, access

I've had severas problems with strings in access-vba.
The thing is, access (sometimes) limit the string's length to about 255 characters.
However, depending on HOW the string was built, it may be able to grow bigger then 255 chars.
There's an example of WORKING code :
Dim strReq as String
strReq = "SELECT exampleField1, exampleField2, exampleField3, exampleField4, exampleField5 "
strReq = strRec & ", exampleField6, exampleField7, exampleField8, .... [etc. insert many fields, you get it]"
strReq = strReq & " FROM myTable INNER JOIN Tbl2 ON ...[many JOINs as well]"
And so on, I often work with large queries so the 256 chars is easily busted.
However, these examples doesn't work :
Dim strReq as String
strReq = "SELECT exampleField1, exampleField2, exampleField3, exampleField4, exampleField5 " & _
", exampleField6, exampleField7, exampleField8, .... [etc. insert many fields, you get it]" & _
" WHERE exampleField1 = x AND exampleField2 = y AND exampleField3 = z" & _
" ORDER BY 1,2,3,4,5,6"
And this doesn't work either :
Dim strReq as String
Dim strWhere as String
strReq = "SELECT exampleField1, exampleField2, exampleField3, exampleField4, exampleField5 "
strReq = strRec & ", exampleField6, exampleField7, exampleField8, .... [etc. insert many fields, you get it]"
strWhere = "WHERE exampleField1 = x "
strWhere = strWhere & "AND exampleField2 = y"
strWhere= strWhere & " AND exampleField3 = z"
strReq = strReq & strWhere [& strJoin / strOrder / strHaving / etc]
I know know aproximatively how I can or cannot concatenate strings but I'd like to know how strings exactly work on access vba , because, i'll admit, it seems quite random so far...
*(Please note, these strings are supposed of longer length then the 255 characters AND the query is just there as an example, syntaxe mistakes or exact length in these are not the point here)
*Edit -- adding the code I'm actually using (With the working version, tried both bugging versions to clean up the code and both were bugging
strReq = "SELECT " & IIf(Len(rsRap.Fields("top")) > 0, " TOP " & rsRap.Fields("top"), "") & " " & rsRap.Fields("champs") & ", Sum([Canada]*[Quantité]) AS Montant, Sum(TblDetailCom.Quantité) AS Qty " & IIf(Len(rsRap.Fields("rep")) > 0, ", NickName", "")
strReq = strReq & " FROM (SELECT * FROM TblRepresentant WHERE RefRep not In(13,15,26,27,28)) AS TblRepresentant INNER JOIN "
strReq = strReq & " ((TblProduits LEFT JOIN TblTypBijoux ON TblProduits.Type = TblTypBijoux.IdTypBijoux) "
strReq = strReq & " INNER JOIN (TblCouleur INNER JOIN ((TblClients INNER JOIN ((TblComm LEFT JOIN RqMaxIdTrait ON TblComm.ID = RqMaxIdTrait.IdCommande) "
strReq = strReq & " LEFT JOIN TblTraitement ON RqMaxIdTrait.MaxOfIdTrait = TblTraitement.IdTrait) ON TblClients.ID = TblComm.RefClient) "
strReq = strReq & " INNER JOIN TblDetailCom ON TblComm.ID = TblDetailCom.RefCom) ON TblCouleur.ID = TblDetailCom.RefCoul) "
strReq = strReq & " ON TblProduits.IdMod = TblDetailCom.RefProd) ON TblRepresentant.RefRep = TblClients.RefRepre "
strReq = strReq & " WHERE (TblClients.RefRepre <> 5 OR (TblClients.RefRepre=5 AND TblClients.ID In (1210,219,189,578))) "
'(((TblProduits.Coll)=16) AND((TblComm.CoDatCom)>=#2011-01-01# And (TblComm.CoDatCom)<=#2014-01-01#) " 'Params Collection (16) DteDeb/fin
'strReq = strReq & " AND "
If Len(rsRap.Fields("type")) > 0 Then
strReq = strReq & " AND TblProduits.[Type] = " & rsRap.Fields("type")
End If
If Len(txtDe) > 0 Then
strReq = strReq & " AND TblTraitement.DtTrait >= #" & txtDe & "# "
End If
If Len(txtA) > 0 Then
strReq = strReq & " AND TblTraitement.DtTrait <= #" & txtA & "# "
End If
If Len(rsRap.Fields("pays")) > 0 Then
strReq = strReq & " AND TblClients.ClPaiePays = '" & rsRap.Fields("pays") & "' "
End If
If Len(rsRap.Fields("rep")) > 0 Then
strReq = strReq & " AND TblClients.RefRepre = " & rsRap.Fields("rep")
End If
If Len(rsRap.Fields("col")) > 0 Then
strReq = strReq & " AND TblProduits.Coll=" & rsRap.Fields("col")
End If
If Len(rsRap.Fields("group")) > 0 Then
strReq = strReq & " GROUP BY " & rsRap.Fields("group") & IIf(Len(rsRap.Fields("rep")) > 0, ", NickName", "")
End If
strReq = strReq & " HAVING Sum([Canada]*[Quantité]) >= 0 "
If Len(rsRap.Fields("order")) > 0 Then
strReq = strReq & " ORDER BY " & rsRap.Fields("order")
End If
You seem to accept the fact that a VBA string can contain more than 255 characters. As an example this code creates a 264 character string.
Const cstrSegment As String = "0123456789" & vbCrLf
Dim MyBigString As String
Dim i As Long
For i = 1 To 22
MyBigString = MyBigString & cstrSegment
Next
Debug.Print "Len(MyBigString): " & Len(MyBigString)
Rather you're encountering trouble based on the method you use to concatenate strings. I don't know where that trouble is exactly, but I can tell you there is a limit to the number of line continuations you can use when adding to a string. For example the following code compiles and runs without error. However if I add one more line continuation (& cstrSegment _), the compiler complains "Too many line continuations".
MyBigString = MyBigString & cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment
If that describes the problem you're seeing, the limitation is based on line continuations, not string length. If needed, you could work around that limit by building the string in multiple steps. Do "MyBigString = MyBigString & cstrSegment _" up to the limit of line continuations, then add to MyBigString with another "MyBigString = MyBigString & cstrSegment _" block.
Make sure you're not misled by how many character you see. Perhaps the situation is you're only seeing the first 255 characters, but the string actually contains many more. That would make sense since you reported you're not getting an error building the string apparently fails.
Confirm the actual length of the string with Len():
Debug.Print "Len(MyBigString): " & Len(MyBigString)
You can also print the string's content to the Immediate window to see what it contains:
Debug.Print MyBigString
You can use Ctrl+g to open the Immediate window.
When concatenating strings for SQL, add a vbCrLf character when lines might grow long. Access seems to have trouble ingesting VBA strings (to execute as SQL) greater than about 1000 characters. e.g.
strSQL = strSQL & "SELECT some fields " & vbcrlf & "FROM some table "

Resources