The example below defines a snaplet to bind nicEditor to textarea. The following questions are not only related to the example below, but probably they are related to some other similar cases..
Can a newbie follow the instructions below (how to clarify)?
How to make the example use less steps or otherwise simpler? (Is it possible with approximately the same content as below?)
This used interpreted splice. If possible, should a snaplet provide compiled splices, too?
A snaplet probably could give a default handler or couple of handlers to typical situations. And handlers could be defined in the "SnapNic.hs" below. Some callback mechanism to users, then?
--
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
------------------------------------------------------------------------------
-- | This module defines nicEditor snaplet, just a short example to show,
-- how snaplets can be defined together with splices.
-- License: BSD3.
-- Here are hopefully easy instructions, how to use or try:
--
-- 1. Make a directory, we'll use "netry" below, go there.
-- Initialize a project, e.g. "snap init default".
-- 2. Copy this file to netry/src-directory as SnapNic.hs.
-- 3. Add "import SnapNic" to Site.hs and to Application.hs
-- 4. Add ", _niced :: Snaplet Nicsnap" to data App in Application.hs
--
-- 5. Add "n <- nestSnaplet "niced" niced nicsnapInit" to
-- app :: SnapletInit App App in Site.hs.
-- 6. Add "addNicEditSplices n" to the same function as in step 5.
-- 7. Change the return-line of the same function as in step 5:
-- "return $ App h s a n"
-- that is, add "n" into the end. We need this because of step 4.
--
-- 8. Make route, e.g. ", ("/netext", with auth handleNEtext)" to
-- routes-function in Site.hs
--
-- 9. And then add handler into Site.hs:
-- handleNEtext :: Handler App v ()
-- handleNEtext = method GET handleForm <|> method POST handleFormSubmit
-- where
-- handleForm = render "textedit"
-- handleFormSubmit = do
-- p <- getParam "ots"
-- writeText "Submitting text from textarea...\n"
-- writeText (T.pack (show p))
--
-- 10. Last, add the following 2 templates to "netry/snaplets/heist/templates".
-- (This could be made simpler, but this works as an example of apply-tag.)
-- textedit.tpl:
-- <apply template="base">
-- <apply template="_textedit" />
-- </apply>
-- _textedit.tpl:
-- <h2>Your nic editor</h2>
-- <form method="post" action="netext">
-- <neTA/>
-- <button name="ne" value="ne" type="Submit">Send text</button>
-- </form>
-- <neScript/>
--
-- 11. Compile everything "cabal install -fdevelopment". After that,
-- if everything compiled, "netry -p 8000", start your browser and go
-- to "localhost:8000/netext".
--
-- TODO! This could use the config-files at least for some parameters, and more
-- tags,please. Tags could use some attributes (for example, size parameters
-- could be given as attributes of tags)...
--
module SnapNic
( Nicsnap (..)
, nicsnapInit
, addNicEditSplices
) where
------------------------------------------------------------------------------
import Control.Lens (makeLenses, view, (^.))
import qualified Data.Text as T (Text, append, pack)
import Data.Maybe (fromJust, fromMaybe)
import Snap.Core (MonadSnap)
import Snap.Snaplet (Snaplet
, makeSnaplet
, snapletValue
, SnapletInit
, Initializer
)
import Snap.Snaplet.Heist (HasHeist, addSplices)
import qualified Text.XmlHtml as X (Node (Element, TextNode))
import qualified Heist.Interpreted as I (Splice)
------------------------------------------------------------------------------
-- | Nicsnap has fields that can be used to set some basic properties.
-- The editor can have a title and its size can be set. Javascript can be
-- local or remote.
data Nicsnap = Nicsnap
{ _nicsnap :: T.Text -- title
, _areaSize :: (Int,Int) -- rows, cols
, _areaRef :: T.Text -- how to apply nicEditors?
-- (This may not be sufficient in order to refer in some other way, TODO!)
, _localR :: Maybe T.Text -- local route to nicEdit.js
, _webR :: T.Text -- route to nicEdit's javascript source.
}
makeLenses ''Nicsnap -- makes webR and other lenses
------------------------------------------------------------------------------
-- | Configurations are given here. This could use config-files...
-- What other things to configure?
-- If you want to make a local copy of the nicEdit, then add a static route
-- to the "routes"-function.
nicsnapInit :: SnapletInit b Nicsnap
nicsnapInit = makeSnaplet "nicsnap" "NicEditor snaplet " Nothing $ do
let m = "Nic editor title"
aS = (20,80)::(Int,Int) -- rows, cols
aR = "nicEditors.allTextAreas" -- TODO! We need to be able to tell,
-- which textareas have editors in a page.
lR = Nothing
-- lR = Just "/nicEdit.js"
-- If localR is nothing, then webR is used with the following addr.
wR = "http://js.nicedit.com/nicEdit-latest.js"
return $ Nicsnap m aS aR lR wR
------------------------------------------------------------------------------
-- | Internal, this makes the script-tag.
-- Input could be e.g. txt = "/nicEdit.js"
srcElem :: T.Text -> X.Node
srcElem txt = X.Element "script"
[("src",txt),("type","text/javascript")] []
-- | Internal, this makes the script-tag. At the moment this changes all
-- textareas to niceditors, if the example input below is used. TODO!...
-- Input could be e.g. txt = "nicEditors.allTextAreas"
srcOnLoad :: T.Text -> X.Node
srcOnLoad txt = X.Element "script" [("type","text/javascript")]
[X.TextNode (T.append (T.append "bkLib.onDomLoaded(" txt) ");")]
-- | Internal, used to define "divs", where we give a label and size to
-- textarea. Also ids and names.
-- TODO! ids and names could be parameters.
divLabelTX :: T.Text -> T.Text -> T.Text -> X.Node
divLabelTX title r c = X.Element "div" [("class", "required")]
[ X.Element "label" [("for","ots")]
[X.TextNode title]
, X.Element "textarea"
[("id","ots"), ("name","ots"), ("cols",c), ("rows",r)]
[X.TextNode " "]
]
-- | Internal, this can be used in splice-definition.
-- TODO! ids and names could be parameters, too.
nicTextAreaAdd :: MonadSnap m => T.Text -> (Int,Int) -> I.Splice m
nicTextAreaAdd title (r,c) = return [divLabelTX
title
(T.pack . show $ r)
(T.pack . show $ c)]
-- | Add script-tags to web page with splice that tell, what javascript
-- library to use...
nicEditAdd :: MonadSnap m => T.Text -> T.Text -> I.Splice m
nicEditAdd src edElems = return (srcElem src : [srcOnLoad edElems])
------------------------------------------------------------------------------
-- | Get the route to the javascript library that is applied (either local
-- library or construct a link to a web address).
nicRoute :: Nicsnap -> T.Text
nicRoute ns = let mlR = ns ^. localR in fromMaybe (ns ^. webR) mlR
------------------------------------------------------------------------------
-- | neTextAreaTag and neScripTag are used in addSplices to define the tags
-- to be used in templates.
-- What other tags could be useful? Maybe a way to add a nicEditor directly
-- with one or more button bind to it ("send", "clear", etc). TODO!
neTextAreaTag = "neTA" :: T.Text
neScriptTag = "neScript" :: T.Text
-- | Make the tags to be used in templates. At the moment, only the above
-- tags are defined.
addNicEditSplices :: HasHeist b => Snaplet Nicsnap -> Initializer b v ()
addNicEditSplices n = let m = view snapletValue n in addSplices
[(neTextAreaTag, nicTextAreaAdd (m ^. nicsnap) (m ^. areaSize))
,(neScriptTag, nicEditAdd (nicRoute m) (m ^. areaRef) )
]
------------------------------------------------------------------------------
I'm not a newbie, so I can't answer your first question, but I've got some thoughts and answers to some of the others. First of all, if you really want this to be a serious snaplet (either for instructional purposes or real use) you should probably make this into a cabal project. That would eliminate step 2 from your instructions. Next, snaplets can define their own routes. You can do that in your initializer by calling the addRoutes function. This would eliminate step 8. Snaplets can also provide their own filesystem resources that will be copied into any project that uses it. You could use this feature to eliminate step 10, as well as provide default config files. For more information on how to do this, look at the filesystem data and automatic installation section at the end of the snaplet tutorial.
Currently, snaplet-postgresql-simple is probably the best example on hackage of how to use most of the features that snaplets have to offer. If you want to make this a really robust general purpose snaplet for other people to use, then you should definitely include both interpreted and compiled splices. I recently added some new functions to the snap package that make it easier to write generic snaplets that automatically work in either compiled or interpreted splice mode. That code isn't on hackage yet, but I'll probably be releasing it soon.
I have also been working on another snaplet that makes much more comprehensive use of most of the features of the snaplet API. Unlike snaplet-postgresql-simple, this snaplet defines templates and splices. It is still under development, but already demonstrates most of the features. The remaining work will be mostly just polish and robustness.
Related
{-# LANGUAGE DuplicateRecordFields #-}
resolveProjectConfig :: IO (Maybe ProjectConfig)
config :: IO ()
config = do
config <- resolveProjectConfig
case config of
Just c -> putStrLn (name c)
Nothing -> putStrLn "broken"
GHC seems to know in Just c that c is a ProjectConfig, but in putStrLn (name c) I get the error "Ambiguous occurence name. It could refer to either the field name... [list of other stuff with a name field]".
Surely if it knows what c is, it should be able to pick the correct name function? Is there some way to have it figure it out, without adding c :: ProjectConfig ?
This is a current limitation of GHC. We need to write name (c :: ProjectConfig) to disambiguate. Not very convenient.
As an alternative, you can patter match on a more informative pattern (as suggested by Willem Van Onsem):
case config of
Just (ProjectConfig {name=n}) -> putStrLn n
This will disambiguate since name is used only in the pattern after ProjectConfig, so it is accepted.
Another, more cumbersome, alternative would be to use a custom typeclass. Assuming all name fields are strings, we can use:
class HasName a where
getName :: a -> String
instance HasName ProjectConfig where
getName = name
instance HasName Other where -- for other types having the same field
getName = name
config :: IO ()
config = do
config <- resolveProjectConfig
case config of
Just c -> putStrLn (getName c)
...
(Why this is not done automatically under the hood is beyond me.)
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.
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.
I'm trying to use the UnionFind package because I need this structure for my exercise (clustering nodes, numbered 1 .. 500) (notwithstanding this blog post suggesting that it does not help) and to learn about ST.
My first problem is that the package does not seem to have a function for bulk loading initial data. I therefore created the following (based on the foldST example in http://www.haskell.org/haskellwiki/Monad/ST) to initialise the data structure, but I can't find a convincing way to call initialClustering and there is no easy way to see whether data structure was created.
import Control.Monad
import Control.Monad.ST
import qualified Data.UnionFind.ST as UF
type Start = Int
--Union-find: clusters of Nodes
type Cluster = UF.Point [Start]
main = do
let
-- next line is clearly wrong but can't find another way to run function
iCluster = initialClustering [1..500]
print $ UF.repr [5] -- i
print $ UF.repr (UF.Pt [5]) -- ii
return ()
initialClustering :: [t] -> ()
initialClustering xs = runST $ do
forM_ xs $ \x -> do
UF.fresh [x]
But I am doing something wrong as compilation fails with i)
Couldn't match expected type `UF.Point s0 a0'
with actual type `[t1]'
In the first argument of `UF.repr', namely `[5]'
and ii)
Not in scope: data constructor `UF.Point'
This reflects a more fundamental lack of understanding about ST and the newtype used to create the UnionFind.ST library.
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