To be clear, I am only interested in using heist, not snap. I'm reading through ocharles's tutorial (https://ocharles.org.uk/blog/posts/2013-12-11-24-days-of-hackage-heist.html) and trying to adapt his first example. It is a simple bind tag. My code is as follows:
-- main.hs
main :: IO ()
main = billy
billy :: IO ()
billy = do
heistState <- either (error . concat) id <$>
(runEitherT $ initHeist myConfig)
builder <- maybe (error "oops2") fst $
renderTemplate heistState "billy"
toByteStringIO BS.putStr builder
BS.putStr "\n"
myConfig = (set hcNamespace "") $
(set hcInterpretedSplices defaultInterpretedSplices) $
(set hcTemplateLocations [loadTemplates "templates"]) $
emptyHeistConfig
And the template I'm using:
<bind tag="kiddo">Billy</bind>
Merry Christmas, <kiddo/>!
The output I get is this:
<bind tag='kiddo'>Billy</bind>
Merry Christmas, <kiddo></kiddo>!
I cannot see why the bind tag doesn't work. I've actually updated his code to use the new lens-style heist config, and I know about the namespace trickery that was introduced somewhat recently in heist, but I can't see what else needs to change to get this example working.
Here is what I was able to get to work:
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString as B
import Blaze.ByteString.Builder (toByteStringIO)
import Control.Applicative
import Control.Monad.Trans.Either (runEitherT)
import Heist
import Heist.Compiled (renderTemplate)
import Control.Lens
heistConfig =
(set hcNamespace "") $
-- (set hcInterpretedSplices defaultInterpretedSplices) $
(set hcLoadTimeSplices defaultLoadTimeSplices) $
(set hcTemplateLocations [loadTemplates "."]) $
emptyHeistConfig
main = do
heistState <- either (error "oops") id <$>
(runEitherT $ initHeist heistConfig)
builder <- maybe (error "oops") fst $
renderTemplate heistState "billy"
toByteStringIO B.putStr builder
Apparently bind is a load time splice, not an interpreted splice.
Related
I am aware of this thread and the agreed-upon ghci :browse command, but I am looking for something similar to run from a script.hs file:
Say I have a module that I can import into my script.hs. How do I then view the list of functions I have just gained access to?
What I've settled on for now
Adapting this thread that suggests the now-deprecated ghc-mod command-line program, I am
calling the terminal command ghc -e ':browse <module, e.g. Data.List>'
from my script.hs using Shelly.
My full script:
#!/usr/bin/env runghc
{-# LANGUAGE OverloadedStrings #-}
import Safe (headDef)
import Shelly
import System.Environment (getArgs)
import qualified Data.Text as T
mdl :: IO String
mdl = getArgs >>= return . headDef "Data.List"
runShelly :: String -> IO ()
runShelly mdl = shelly $ silently $ do
out <- run "ghc" ["-e", T.pack (":browse " ++ mdl)]
let lns = T.lines out
liftIO $ mapM_ (putStrLn .T.unpack) $ lns
main :: IO ()
main = mdl >>= runShelly
This way I can pass the module name on the command line as <script> <module> and get back the functions, one per line. It defaults to Data.List if I pass no arguments.
So that's a solution, but surely there must be handier introspection facilities than this?
I'm getting to grips with writing an API in Haskell using Scotty. My files are provided below. My questions are:
In the routes definition, I'm extracting from liftIO whatsTheTime in a do block. This works, but it seems verbose. Is there a nicer syntax?
In the whatsTheTime definition, I'm needing to do fromString. I'd have thought OverloadedString would take care of that, but that's not the case. I'd really appreciate it if somebody pointed out why it doesn't work without fromString.
In a stack project, if I need a directive like OverloadedStrings, do I need to include it every file that needs it, or just at the top of the main entrypoint?
Api.hs:
{-# LANGUAGE OverloadedStrings #-}
module Api
( whatsTheTime
) where
import Data.Time (getCurrentTime)
import Web.Scotty
import Data.String
whatsTheTime :: IO (ActionM ())
whatsTheTime = do
time <- getCurrentTime
return $ text $ fromString ("The time is now " ++ show time)
Main.hs:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Main where
import Api
import Web.Scotty
import Control.Monad.IO.Class
routes = do
get "/" $ do
res <- liftIO whatsTheTime
res
main :: IO ()
main = do
putStrLn "Starting server..."
scotty 3000 routes
(1) This:
do
res <- liftIO whatsTheTime
res
Desugars to this:
liftIO whatsTheTime >>= \ res -> res
If you look at the type of \ m -> m >>= id:
(Monad m) => m (m a) -> m a
That’s exactly the type of join (Hoogle), so you can use:
get "/" $ join $ liftIO whatsTheTime
join is a common idiom for “execute this action which returns an action, and also execute the returned action”.
(2) OverloadedStrings is for overloading of string literals. You have an overloaded literal "The time is now ", but you constrain it to be of type String by using it as an operand of (++) with a String (the result of show time). You can pack the result of show time as a Text instead using fromString or Data.Text.pack:
import Data.Monoid ((<>))
import qualified Data.Text as Text
-- ...
return $ text $ "The time is now " <> Text.pack (show time)
(3) LANGUAGE pragmas operate per file; as #mgsloan notes, you can add OverloadedStrings to the default-extensions: field of your library or executable in your .cabal file.
I have the following code, just copy-pasted and modernised (the original example does not compile with recent versions of Heist anymore) from here.
{-# LANGUAGE OverloadedStrings #-}
module Main where
import qualified Data.ByteString.Char8 as BS
import Data.Monoid
import Data.Maybe
import Data.List
import Control.Applicative
import Control.Lens
import Control.Monad.Trans
import Control.Monad.Trans.Either
import Heist
import Heist.Compiled
import Blaze.ByteString.Builder
conf :: HeistConfig IO
conf = set hcTemplateLocations [ loadTemplates "." ] $
set hcInterpretedSplices defaultInterpretedSplices $
emptyHeistConfig
runHeistConf :: Either [String] (HeistState IO) -> IO (HeistState IO)
runHeistConf (Right hs) = return hs
runHeistConf (Left msgs) = error . intercalate "\n" $ map ("[Heist error]: " ++) msgs
main :: IO ()
main = do
heist <- id <$> (runEitherT $ initHeist conf) >>= runHeistConf
output <- fst $ fromMaybe (error "xxx") $ renderTemplate heist "billy"
BS.putStrLn . toByteString $ output
And the following template:
<!-- billy.tpl -->
<bind tag="wanted">Playstation 4</bind>
<bind tag="got">Monopoly board game</bind>
<apply template="letter">
<bind tag="kiddo">Billy</bind>
I regret to inform you the "<wanted />" you have requested is currently
unavailable. I have substituted this with "<got />". I hope this does not
disappoint you.
</apply>
Running this program outputs to the console the whole template (almost) as is. No substistutions are made. Probably there's some function call missing, required by modern Hesit versions. I was trying to track it down in the documentation, but no luck. Why doesn't it work?
Output:
<!-- billy.tpl --><bind tag='wanted'>Playstation 4</bind>
<bind tag='got'>Monopoly board game</bind>
<apply template='letter'>
<bind tag='kiddo'>Billy</bind>
I regret to inform you the "<wanted></wanted>" you have requested is currently
unavailable. I have substituted this with "<got></got>". I hope this does not
disappoint you.
</apply>
It looks like you are using renderTemplate from Heist.Compiled, but defining interpreted splices. I believe if you change this line:
set hcInterpretedSplices defaultInterpretedSplices
to this
set hcLoadTimeSplices defaultLoadTimeSplices
it should work
Is it possible to add routes dynamically at compile time through a config file by using Template Haskell or any other way.
Scotty has a function addRoute but I want to use it dynamically.
Example
import qualified Data.Text.Lazy as LTB
sampleRoutes :: [(String, LTB.Text)]
sampleRoutes = [("hello", LTB.pack "hello"), ("world", LTB.pack "world")]
I want to iterate over the sampleRoutes array and define routes and responses at compile time.
import Web.Scotty
main = scotty 3000 $ do
middleware logStdoutDev
someFunc sampleRoutes
OK, so given the above list, I am assuming you are looking to something that is equivalent to writing the following by hand:
{-! LANGUAGE OverloadedStrings #-}
import Web.Scotty
import Data.String
main = scotty 3000 $ do
middleware logStdoutDev
get (fromString $ '/' : "hello") (text "hello")
get (fromString $ '/' : "world") (text "world")
The good news is, there's nothing in there that would need any TH magic!
Remember, addroute / get are just regular functions that return a ScottyM () value. If I have
r1 = get (fromString $ '/' : "hello") (text "hello")
r2 = get (fromString $ '/' : "world") (text "world")
then the preceding main function is exactly equivalent to
main = do
middleware logStdoutDev
r1
r2
This, and the common structure of r1 and r2 suggests the following solution:
import Control.Monad (forM_)
main = do
middleware logStdoutDev
forM_ sampleRoutes $ \(name, response) ->
get (fromString $ '/':name) (text response)
Good day, i have mongodb database filled with some data, i ensured that data stored in correct charset, to fetch data i use following snippet:
{-# LANGUAGE OverloadedStrings #-}
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Data.Enumerator (Iteratee (..))
import Data.Either (either)
import Control.Monad (join)
import Data.Maybe (fromMaybe)
import Network.HTTP.Types (statusOK, status404)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Char8 (unpack)
import Data.ByteString.Lazy.Char8 (pack)
import qualified Data.Text.Lazy as T
import Data.Text (Text(..))
import Control.Monad.IO.Class (liftIO, MonadIO)
import Data.Aeson (encode)
import qualified Data.Map as Map
import qualified Database.MongoDB as DB
application dbpipe req = do
case unpack $ rawPathInfo req of
"/items" -> itemsJSON dbpipe req
_ -> return $ responseLBS status404 [("Content-Type", "text/plain")] "404"
indexPage :: Iteratee B.ByteString IO Response
indexPage = do
page <- liftIO $ processTemplate "templates/index.html" []
return $ responseLBS statusOK [("Content-Type", "text/html; charset=utf-8")] page
processTemplate f attrs = do
page <- L.readFile f
return page
itemsJSON :: DB.Pipe -> Request -> Iteratee B.ByteString IO Response
itemsJSON dbpipe req = do
dbresult <- liftIO $ rundb dbpipe $ DB.find (DB.select [] $ tu "table") >>= DB.rest
let docs = either (const []) id dbresult
-- liftIO $ L.putStrLn $ encode $ show $ map docToMap docs
return $ responseLBS statusOK [("Content-Type", "text/plain; charset=utf-8")]
(encode $ map docToMap docs)
docToMap doc = Map.fromList $ map (\f -> (T.dropAround (== '"') $ T.pack $ show $ DB.label f, T.dropAround (== '"') $ T.pack $ show $ DB.value f)) doc
main = do
pipe <- DB.runIOE $ DB.connect $ DB.host "127.0.0.1"
run 3000 $ application pipe
rundb pipe act = DB.access pipe DB.master database act
tu :: B.ByteString -> UString
tu = DB.u . C8.unpack
Then the result is suprprising, DB.label works well, but DB.value giving me native characters as some escape codes, so the result is look like:
curl http://localhost:3000/items gives:
[{"Марка": "\1058\1080\1087 \1087\1086\1076",
"Model": "BD-W LG BP06LU10 Slim \1058\1080\1087 \1087\1086\1076\1082\1083\1102\1095\1077\1085\1080\1103"},
...
]
This happens in case i trying to print data and also in case i return data encoded as JSON
Any idea how correctly extract values from MongoDB driver ?
The following line confirms that aeson's encoding works properly (using the utf8-string library to read utf8 data off the lazy bytestring back to a haskell string:
> putStrLn $ Data.ByteString.Lazy.UTF8.toString $ encode $ ("\1058\1080\1087 \1087\1086\1076",12)
["Тип под",12]
Looking at your code more closely I see the real problem. You're calling T.pack $ show $ DB.value -- this will render out as literal codepoints, and then pack those into a text object. The fix is to switch from show to something smarter. Look at this (untested)
smartShow :: DB.Value -> Text
smartShow (String s) = Data.Text.Encoding.decodeUtf8 $ Data.CompactString.UTF8.toByteString s
smartShow x = T.pack $ show x
Obviously to handle the recursive cases, etc. you need to be smarter than that, but that's the general notion...
In fact, the "best" thing to do is to write a function of BSON -> JSON directly, rather than go through any intermediate structures at all.
Everything is working as expected -- only your expectations are wrong. =)
What you're seeing there are not raw Strings; they are String's which have been escaped to exist purely in the printable ASCII range by the show function, called by print:
print = putStrLn . show
Never fear: in memory, the string that prints as "\1058" is in fact a single Unicode codepoint long. You can observe this by printing the length of one of the Strings you're interested in and comparing that to the number of Unicode codepoints you expect.