switch from literate to regular haskell source
This commit is contained in:
Jake Wheat
parent
f51600e0b1
commit
ec8ce0243e
74 changed files with 11498 additions and 10996 deletions
34
website/AddLinks.hs
Normal file
34
website/AddLinks.hs
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
|
||||
-- Little hack to add links to the navigation bars
|
||||
|
||||
main :: IO ()
|
||||
main = interact addLinks
|
||||
|
||||
|
||||
addLinks :: String -> String
|
||||
addLinks [] = error "not found"
|
||||
addLinks ('<':'/':'u':'l':'>':'\n':'<':'/':'d':'i':'v':'>':xs) =
|
||||
"</ul>" ++ linkSection ++ "\n</div>" ++ xs
|
||||
addLinks (x:xs) = x : addLinks xs
|
||||
|
||||
linkSection :: String
|
||||
linkSection =
|
||||
"<hr />\n\
|
||||
\<ul class=\"sectlevel1\">\n\
|
||||
\<div id=\"toctitle\">Links</div>\n\
|
||||
\<li><a href=\"index.html\">Index</a></li>\n\
|
||||
\<li><a href='haddock/index.html'>Haddock</li>\n\
|
||||
\<li><a href=\"supported_sql.html\" class=\"bare\">Supported SQL</a></li>\n\
|
||||
\<li><a href=\"test_cases.html\">Test cases</a></li>\n\
|
||||
\</ul>\n\
|
||||
\<br />\n\
|
||||
\<ul class=\"sectlevel1\">\n\
|
||||
\<li><a href=\"http://jakewheat.github.io/simple-sql-parser/latest\" class=\"bare\">Homepage</a></li>\n\
|
||||
\<li><a href=\"http://hackage.haskell.org/package/simple-sql-parser\" class=\"bare\">Hackage</a></li>\n\
|
||||
\<li><a href=\"https://github.com/JakeWheat/simple-sql-parser\" class=\"bare\">Repository</a></li>\n\
|
||||
\<li><a href=\"https://github.com/JakeWheat/simple-sql-parser/issues\" class=\"bare\">Bug tracker</a></li>\n\
|
||||
\<li><a href=\"https://github.com/JakeWheat/simple-sql-parser/blob/master/changelog\" class=\"bare\">Changes</a></li>\n\
|
||||
\<li><a href=\"http://jakewheat.github.io/simple-sql-parser/\" class=\"bare\">Other versions</a></li>\n\
|
||||
\<li><a href=\"http://jakewheat.github.io/\" class=\"bare\">Parent project</a>\n\
|
||||
\</li><li>jakewheatmail@gmail.com</li>\n\
|
||||
\</ul>\n"
|
||||
|
|
@ -1,34 +0,0 @@
|
|||
|
||||
Little hack to add links to the navigation bars
|
||||
|
||||
> main :: IO ()
|
||||
> main = interact addLinks
|
||||
|
||||
|
||||
> addLinks :: String -> String
|
||||
> addLinks [] = error "not found"
|
||||
> addLinks ('<':'/':'u':'l':'>':'\n':'<':'/':'d':'i':'v':'>':xs) =
|
||||
> "</ul>" ++ linkSection ++ "\n</div>" ++ xs
|
||||
> addLinks (x:xs) = x : addLinks xs
|
||||
|
||||
> linkSection :: String
|
||||
> linkSection =
|
||||
> "<hr />\n\
|
||||
> \<ul class=\"sectlevel1\">\n\
|
||||
> \<div id=\"toctitle\">Links</div>\n\
|
||||
> \<li><a href=\"index.html\">Index</a></li>\n\
|
||||
> \<li><a href='haddock/index.html'>Haddock</li>\n\
|
||||
> \<li><a href=\"supported_sql.html\" class=\"bare\">Supported SQL</a></li>\n\
|
||||
> \<li><a href=\"test_cases.html\">Test cases</a></li>\n\
|
||||
> \</ul>\n\
|
||||
> \<br />\n\
|
||||
> \<ul class=\"sectlevel1\">\n\
|
||||
> \<li><a href=\"http://jakewheat.github.io/simple-sql-parser/latest\" class=\"bare\">Homepage</a></li>\n\
|
||||
> \<li><a href=\"http://hackage.haskell.org/package/simple-sql-parser\" class=\"bare\">Hackage</a></li>\n\
|
||||
> \<li><a href=\"https://github.com/JakeWheat/simple-sql-parser\" class=\"bare\">Repository</a></li>\n\
|
||||
> \<li><a href=\"https://github.com/JakeWheat/simple-sql-parser/issues\" class=\"bare\">Bug tracker</a></li>\n\
|
||||
> \<li><a href=\"https://github.com/JakeWheat/simple-sql-parser/blob/master/changelog\" class=\"bare\">Changes</a></li>\n\
|
||||
> \<li><a href=\"http://jakewheat.github.io/simple-sql-parser/\" class=\"bare\">Other versions</a></li>\n\
|
||||
> \<li><a href=\"http://jakewheat.github.io/\" class=\"bare\">Parent project</a>\n\
|
||||
> \</li><li>jakewheatmail@gmail.com</li>\n\
|
||||
> \</ul>\n"
|
||||
77
website/RenderTestCases.hs
Normal file
77
website/RenderTestCases.hs
Normal file
|
|
@ -0,0 +1,77 @@
|
|||
|
||||
-- Converts the test data to asciidoc
|
||||
|
||||
import Language.SQL.SimpleSQL.Tests
|
||||
import Text.Show.Pretty
|
||||
import Control.Monad.State
|
||||
import Language.SQL.SimpleSQL.Parse
|
||||
import Language.SQL.SimpleSQL.Lex
|
||||
import Data.List
|
||||
import Control.Monad (when, unless)
|
||||
|
||||
data TableItem = Heading Int String
|
||||
| Row String String
|
||||
|
||||
doc :: Int -> TestItem -> [TableItem]
|
||||
-- filter out some groups of tests
|
||||
doc n (Group nm _) | "generated" `isInfixOf` nm = []
|
||||
doc n (Group nm is) =
|
||||
Heading n nm
|
||||
: concatMap (doc (n + 1)) is
|
||||
doc _ (TestScalarExpr _ str e) =
|
||||
[Row str (ppShow e)]
|
||||
doc _ (TestQueryExpr _ str e) =
|
||||
[Row str (ppShow e)]
|
||||
doc _ (TestStatement _ str e) =
|
||||
[Row str (ppShow e)]
|
||||
doc _ (TestStatements _ str e) =
|
||||
[Row str (ppShow e)]
|
||||
doc _ (ParseQueryExpr d str) =
|
||||
[Row str (ppShow $ parseQueryExpr d "" Nothing str)]
|
||||
doc _ (ParseQueryExprFails d str) =
|
||||
[Row str (ppShow $ parseQueryExpr d "" Nothing str)]
|
||||
doc _ (ParseScalarExprFails d str) =
|
||||
[Row str (ppShow $ parseScalarExpr d "" Nothing str)]
|
||||
|
||||
doc _ (LexTest d str t) =
|
||||
[Row str (ppShow $ lexSQL d "" Nothing str)]
|
||||
|
||||
doc _ (LexFails d str) =
|
||||
[Row str (ppShow $ lexSQL d "" Nothing str)]
|
||||
|
||||
-- TODO: should put the dialect in the html output
|
||||
|
||||
|
||||
render :: [TableItem] -> IO ()
|
||||
render = go False
|
||||
where
|
||||
go t (Heading level title : is) = do
|
||||
when t $ putStrLn "|==="
|
||||
-- slight hack
|
||||
when (level > 1) $
|
||||
putStrLn $ "\n" ++ replicate level '=' ++ " " ++ title
|
||||
go False is
|
||||
go t (Row sql hask : is) = do
|
||||
unless t $ putStrLn "[cols=\"2\"]\n|==="
|
||||
let sql' = "\n[source,sql]\n----\n" ++ sql ++ "\n----\n"
|
||||
hask' = "\n[source,haskell]\n----\n" ++ hask ++ "\n----\n"
|
||||
putStrLn $ "a| " ++ escapePipe sql'
|
||||
++ "a| " ++ escapePipe hask' ++ " "
|
||||
go True is
|
||||
go t [] = when t $ putStrLn "|==="
|
||||
escapePipe [] = []
|
||||
escapePipe ('\\':'|':xs) = '\\' : '\\' : '\\' : '|' : escapePipe xs
|
||||
escapePipe ('|':xs) = '\\' : '|' : escapePipe xs
|
||||
escapePipe (x:xs) = x : escapePipe xs
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "\n:toc:\n\
|
||||
\:toc-placement: macro\n\
|
||||
\:sectnums:\n\
|
||||
\:toclevels: 10\n\
|
||||
\:sectnumlevels: 10\n\
|
||||
\:source-highlighter: pygments\n\n\
|
||||
\= simple-sql-parser examples/test cases\n\n\
|
||||
\toc::[]\n"
|
||||
render $ doc 1 testData
|
||||
|
|
@ -1,77 +0,0 @@
|
|||
|
||||
Converts the test data to asciidoc
|
||||
|
||||
> import Language.SQL.SimpleSQL.Tests
|
||||
> import Text.Show.Pretty
|
||||
> import Control.Monad.State
|
||||
> import Language.SQL.SimpleSQL.Parse
|
||||
> import Language.SQL.SimpleSQL.Lex
|
||||
> import Data.List
|
||||
> import Control.Monad (when, unless)
|
||||
|
||||
> data TableItem = Heading Int String
|
||||
> | Row String String
|
||||
|
||||
> doc :: Int -> TestItem -> [TableItem]
|
||||
> -- filter out some groups of tests
|
||||
> doc n (Group nm _) | "generated" `isInfixOf` nm = []
|
||||
> doc n (Group nm is) =
|
||||
> Heading n nm
|
||||
> : concatMap (doc (n + 1)) is
|
||||
> doc _ (TestScalarExpr _ str e) =
|
||||
> [Row str (ppShow e)]
|
||||
> doc _ (TestQueryExpr _ str e) =
|
||||
> [Row str (ppShow e)]
|
||||
> doc _ (TestStatement _ str e) =
|
||||
> [Row str (ppShow e)]
|
||||
> doc _ (TestStatements _ str e) =
|
||||
> [Row str (ppShow e)]
|
||||
> doc _ (ParseQueryExpr d str) =
|
||||
> [Row str (ppShow $ parseQueryExpr d "" Nothing str)]
|
||||
> doc _ (ParseQueryExprFails d str) =
|
||||
> [Row str (ppShow $ parseQueryExpr d "" Nothing str)]
|
||||
> doc _ (ParseScalarExprFails d str) =
|
||||
> [Row str (ppShow $ parseScalarExpr d "" Nothing str)]
|
||||
|
||||
> doc _ (LexTest d str t) =
|
||||
> [Row str (ppShow $ lexSQL d "" Nothing str)]
|
||||
|
||||
> doc _ (LexFails d str) =
|
||||
> [Row str (ppShow $ lexSQL d "" Nothing str)]
|
||||
|
||||
TODO: should put the dialect in the html output
|
||||
|
||||
|
||||
> render :: [TableItem] -> IO ()
|
||||
> render = go False
|
||||
> where
|
||||
> go t (Heading level title : is) = do
|
||||
> when t $ putStrLn "|==="
|
||||
> -- slight hack
|
||||
> when (level > 1) $
|
||||
> putStrLn $ "\n" ++ replicate level '=' ++ " " ++ title
|
||||
> go False is
|
||||
> go t (Row sql hask : is) = do
|
||||
> unless t $ putStrLn "[cols=\"2\"]\n|==="
|
||||
> let sql' = "\n[source,sql]\n----\n" ++ sql ++ "\n----\n"
|
||||
> hask' = "\n[source,haskell]\n----\n" ++ hask ++ "\n----\n"
|
||||
> putStrLn $ "a| " ++ escapePipe sql'
|
||||
> ++ "a| " ++ escapePipe hask' ++ " "
|
||||
> go True is
|
||||
> go t [] = when t $ putStrLn "|==="
|
||||
> escapePipe [] = []
|
||||
> escapePipe ('\\':'|':xs) = '\\' : '\\' : '\\' : '|' : escapePipe xs
|
||||
> escapePipe ('|':xs) = '\\' : '|' : escapePipe xs
|
||||
> escapePipe (x:xs) = x : escapePipe xs
|
||||
|
||||
> main :: IO ()
|
||||
> main = do
|
||||
> putStrLn "\n:toc:\n\
|
||||
> \:toc-placement: macro\n\
|
||||
> \:sectnums:\n\
|
||||
> \:toclevels: 10\n\
|
||||
> \:sectnumlevels: 10\n\
|
||||
> \:source-highlighter: pygments\n\n\
|
||||
> \= simple-sql-parser examples/test cases\n\n\
|
||||
> \toc::[]\n"
|
||||
> render $ doc 1 testData
|
||||
Loading…
Add table
Add a link
Reference in a new issue