I'm learning Haskell, and some functions like text aren't easy to google. Look at this example:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Web.Spock
import Web.Spock.Config
import Control.Monad.Trans
import Data.IORef
import qualified Data.Text as T
data MySession = EmptySession
data MyAppState = DummyAppState (IORef Int)
main :: IO ()
main =
do ref <- newIORef 0
spockCfg <- defaultSpockCfg EmptySession PCNoDatabase (DummyAppState ref)
runSpock 8080 (spock spockCfg app)
app :: SpockM () MySession MyAppState ()
app =
do get root $ text "Hello World!"
get ("hello" <//> var) $ \name ->
do (DummyAppState ref) <- getState
visitorNumber <- liftIO $ atomicModifyIORef' ref $ \i -> (i+1, i+1)
text ("Hello " <> name <> ", you are visitor number " <> T.pack (show visitorNumber))
do get root $ text "Hello World!"
Normally, on VSCode, with any language, I would click on text with the rigth button, and "go to defintion". How do I find the definition of a function in VSCode?
I installed the haskell.haskell extension, and it didn't add this functionality.
Related
I have a sample I picked up from the reactive-banana repo. This uses gloss.
But when I work with events I have my own events with data. These events are not necessarily UI events. So I was expecting that FRP can help me code with custom events. So, for example, a list could change and the changed data is inside an event and another part of the application uses the changed data.
My preliminary Haskell knowledge didn't help me to achieve this using reactive-banana but I did come across something similar.
How can I use my own events likemakeTickEvent and fire them ? Can it hold data ?
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Control.Monad (when)
import Data.Maybe (isJust, fromJust)
import Data.List (nub)
import System.Random
import System.IO
import Debug.Trace
import Data.IORef
import Reactive.Banana as R
import Reactive.Banana.Frameworks as R
import Graphics.Gloss
import Graphics.Gloss.Data.Extent
import Graphics.Gloss.Interface.Pure.Game
import Graphics.Gloss.Data.Picture
main :: IO()
main = do
sources <- makeSources
network <- compile $ networkDescription sources
actuate network
eventLoop sources
display windowDisplay white drawBoard
windowDisplay :: Display
windowDisplay = InWindow "Window" (200, 200) (10, 10)
makeTickEvent :: MomentIO (R.Event ())
makeTickEvent = do
(etick, tick) <- newEvent
tid <- liftIO $ do
tick ()
pure etick
drawBoard :: Picture
drawBoard =
Pictures $ [ translate x y $ rectangleWire 90 90| x<-[0,90..180], y<-[0,90..180] ]
makeSources = newAddHandler
type EventSource a = (AddHandler a, a -> IO ())
addHandler :: EventSource a -> AddHandler a
addHandler = fst
eventLoop :: (EventSource ()) -> IO ()
eventLoop (displayvalueevent) =
fire displayvalueevent ()
fire :: EventSource a -> a -> IO ()
fire = snd
networkDescription :: (EventSource ()) -> MomentIO ()
networkDescription ( displayvalueevent )= do
-- Obtain events
displayvalue <- fromAddHandler (addHandler displayvalueevent)
reactimate $ putStrLn . showValue <$> displayvalue
showValue value = "Value is " ++ show value
This is from the documentation.
plainChanges :: Behavior a -> MomentIO (Event a)
plainChanges b = do
(e, handle) <- newEvent
eb <- changes b
reactimate' $ (fmap handle) <$> eb
return e
Does this create a new Event that can be fired ?
I have managed to make this code work for now. An event is fired and a new frame is rendered in the initial Gloss Window. It seems to be possible to fire a custom event. But I am not sure about encapsulating data inside the event.
makeNewEvent :: MomentIO (Reactive.Banana.Event ())
makeNewEvent = do
(enew, new) <- newEvent
tid <- liftIO $ do
putStrLn "Fire new Event"
new ()
return enew
The following code answers some questions. If I have more details I can edit later. This is still very basic as I am learning reactive-banana and 'haskell'
------------------------------------------------------------------------------}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BlockArguments #-}
module Main where
import Data.IORef
import Data.Bool (bool)
import Data.IORef (newIORef, readIORef, writeIORef)
import Graphics.Gloss hiding (pictures)
import Reactive.Banana
import Reactive.Banana.Frameworks
import Graphics.Gloss.Interface.IO.Game( Event(..) )
import Graphics.Gloss.Interface.IO.Game( MouseButton(..) )
import Graphics.Gloss.Interface.IO.Game( KeyState( Down ) )
import Graphics.Gloss.Interface.IO.Game
import qualified Graphics.Gloss.Interface.IO.Game as Gloss (Event, playIO)
main = do
(eventHandler,event)<- makeSources
picRef ← newIORef blank
network <- compile $ networkDescriptor picRef eventHandler
actuate network
let handleEvent e#(EventKey k Down _ _) = case k of
(SpecialKey KeySpace) -> event e
_ -> return ()
handleEvent e = return ()
Gloss.playIO
(InWindow "Functional Reactive" (550, 490) (800, 200))
white
30
()
(\() -> readIORef picRef)
(\ ev () -> handleEvent ev)
(\_ () -> pure ())
reactToKeyPress :: IO ()
reactToKeyPress = putStrLn "Key Pressed"
drawBoard :: Picture
drawBoard =
Pictures $ [ color violet $ translate x y $ rectangleWire 90 90| x<-[0,90..180], y<-[0,90..180] ]
makeSources = newAddHandler
type EventSource a = (AddHandler a, a -> IO ())
addHandler :: EventSource a -> AddHandler a
addHandler = fst
fire :: EventSource a -> a -> IO ()
fire = snd
networkDescriptor :: IORef Picture -> AddHandler Gloss.Event -> MomentIO ()
networkDescriptor lastFrame displayGlossEvent = do
glossEvent <- fromAddHandler displayGlossEvent
reactimate $ putStrLn . showValue <$> glossEvent
picture <- liftMoment (handleKeys glossEvent )
changes picture >>= reactimate' . fmap (fmap (writeIORef lastFrame))
valueBLater picture >>= liftIO . writeIORef lastFrame
showValue value = "Value is " ++ show value
handleKeys :: Reactive.Banana.Event e -> Moment (Behavior Picture)
handleKeys glossEvent = do
let picture = drawBoard
return $ pure picture
I would like for my default handler to be able to catch all of the exceptions that my App throws but in order for this to happen I need to manually call raise after manually adding some exception catching around my IO code.
below is an example minimal server:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Lib
( someFunc
) where
import Web.Scotty.Trans
import Control.Monad.Trans
import Control.Monad.Reader
import Control.Monad.Catch
import Control.Monad.Except
import Data.Text.Lazy as TL
data AppEnv = AppEnv
{ appStuff :: String
}
newtype App a = App
{ unApp :: ReaderT AppEnv IO a
} deriving (Functor, Applicative, Monad, MonadIO, MonadReader AppEnv, MonadThrow)
someFunc :: IO ()
someFunc = do
let run a = runReaderT (unApp $ App a) (AppEnv "APPY STUFF")
scottyT 8080 run $ do
defaultHandler $ \(e :: TL.Text) -> do
liftIO $ print "HERE"
liftIO $ print $ showError e
html $ "Something Went Seriously Wrong"
get "/" $ do
(r :: (Either TL.Text String)) <- liftIO $ runExceptT $ do
(uId) <- lift $ readFile "./helloworld.txt"
return $ ("hello")
liftIO $ print r
case r of
Left l -> raise l
Right s -> (html "hello world")
get "/catch-this" $ do
error "Catch Me"
(html "hello world")
notFound $ do
html "That is not a valid route"
I would like to be able to catch all of my uncaught exceptions in my default handler however this is not the default behavior of scotty that only happens if you call raise. I could wrap all of my ActionM code blocks in ExceptT however this seems like a messy/mechanical way of solving this problem. I mostly want to do this for logging purposes so I can report out to Sentry or Log to a file and this would make it much more convenient.
I figured I'd throw this in there as I recently was looking for this same solution again. It's unfortunate but I was never able to get the behavior that I wanted out of scotty.
Fortunately since scotty is just a nice library to create WAI application's you can get a nice work around using the Settings type from warp and the Options type from scotty.
Below is an example of how you can approach this:
{-# LANGUAGE OverloadedStrings #-}
module Lib
( someFunc
) where
import Web.Scotty.Trans
import Data.Text
import qualified Data.Text.Lazy as TL
import Control.Monad.IO.Class
import Control.Exception
import Network.HTTP.Types
import System.IO.Error
import Network.Wai.Handler.Warp
import Network.Wai
myOpts :: Options
myOpts = Options 1 mySettings
mySettings :: Settings
mySettings = setOnExceptionResponse myHandler $ setPort 3002 $ defaultSettings
myHandler :: SomeException -> Response
myHandler se = responseLBS status500 [] "HERE WE ARE"
someFunc :: IO ()
someFunc = do
scottyOptsT myOpts id routes
myExceptions :: (MonadIO m) => TL.Text -> ActionT TL.Text m ()
myExceptions t = do
liftIO $ print t
html "error"
routes :: (MonadIO m) => ScottyT TL.Text m ()
routes = do
defaultHandler $ \str -> do
liftAndCatchIO $ print str
status status500
json ("welp you thought"::Text)
get "/:here" $ do
liftIO $ ioError $ userError "Hahah"
text "here"
You can then tap further into the Settings type provided by warp so that you could maybe log all the error messages or perform some custom action using the following methods setOnException setOnExceptionResponse.
I am trying to do something similar to this, where for an element in list of strings, I have a checkbox next to it and figure out which checkbox is checked or not. Using examples from the internet, I was able to get an example running
{-# LANGUAGE OverloadedStrings #-}
import Data.Monoid
import Data.String
import Data.List
import qualified Data.Text as T
import Web.Spock.Safe
import Web.Spock.Digestive
import Text.Blaze (ToMarkup(..))
import Text.Blaze.Html5 hiding (html, param, main)
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Digestive
import Text.Digestive.Blaze.Html5
import System.Directory
import Control.Monad.IO.Class
import Control.Monad (forM_)
gen :: Html -> [Html] -> Html
gen title elts = H.html $ do
H.head $
H.title title
H.body $
H.ul $ mapM_ H.li elts
data CheckBox = CheckBox { postTitle :: T.Text }
checkboxForm = CheckBox
<$> "title" .: Text.Digestive.text Nothing
renderForm :: View Html -> Html
renderForm v = do
Text.Digestive.Blaze.Html5.form v "POST" $ do
H.p $ do
Text.Digestive.Blaze.Html5.label "title" v "Post title: "
inputText "text" v
inputSubmit "Submit Post"
main :: IO ()
main =
runSpock 8080 $ spockT Prelude.id $ do
get root $ do
listing <- liftIO $ getDirectoryContents "/home/hasenov/mydir"
let filteredListing = filter (\l -> not $ isPrefixOf "." l) listing
(view, result) <- runForm "checkboxForm" checkboxForm
case result of
Nothing -> lazyBytes $ renderHtml (renderForm view)
Just newCheckbox -> lazyBytes $ renderHtml (renderForm view)
-- lazyBytes $ renderHtml (gen "My Blog" (Data.List.map fromString filteredListing))
-- get ("hello" <//> var) $ \name ->
-- text ("Hello " <> name <> "!")
However, in the function renderForm, when I change inputText to something like inputCheckbox "True", I get the error True does not exist. I am not able to find an example where inputCheckbox is used, I was hoping someone would help me adapt filteredString so it would display checkboxes next to it, and I can run the form properly. Also, in previous link I posted, I don't know what the function inputCheckBox, since I could only find inputCheckbox. Perhaps this is an outdated function?
I'm answering my own question since I figured out how to get inputCheckbox instead of inputText. Actually, this example helped alot. It was the only one I could find which uses inputCheckbox. What I needed to do was change
data CheckBox = CheckBox { postTitle :: T.Text }
to
data CheckBox = CheckBox Bool
Then I could just initialized
checkboxForm = CheckBox
<$> "title" .: bool (Just False)
Here is the full source:
{-# LANGUAGE OverloadedStrings #-}
import Data.Monoid
import Data.String
import Data.List
import qualified Data.Text as T
import Web.Spock.Safe
import Web.Spock.Digestive
import Text.Blaze (ToMarkup(..))
import Text.Blaze.Html5 hiding (html, param, main)
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Digestive
import Text.Digestive.Blaze.Html5
import System.Directory
import Control.Monad.IO.Class
import Control.Monad (forM_)
gen :: Html -> [Html] -> Html
gen title elts = H.html $ do
H.head $
H.title title
H.body $
H.ul $ mapM_ H.li elts
data CheckBox = CheckBox Bool
checkboxForm = CheckBox
<$> "title" .: bool (Just False)
renderForm :: View Html -> [Html] -> Html
renderForm v strings = do
Text.Digestive.Blaze.Html5.form v "POST" $ do
H.p $ mapM_ (\string -> do
inputCheckbox "title" v
Text.Digestive.Blaze.Html5.label "title" v string
H.br) strings
inputSubmit "Submit Post"
main :: IO ()
main =
runSpock 8080 $ spockT Prelude.id $ do
get root $ do
listing <- liftIO $ getDirectoryContents "/home/ecks/btsync-gambino"
let filteredListing = filter (\l -> not $ isPrefixOf "." l) listing
(view, result) <- runForm "checkboxForm" checkboxForm
case result of
Nothing -> lazyBytes $ renderHtml (renderForm view (Data.List.map fromString filteredListing))
Just newCheckbox -> lazyBytes $ renderHtml (renderForm view (Data.List.map fromString filteredListing))
-- lazyBytes $ renderHtml (gen "My Blog" (Data.List.map fromString filteredListing))
-- get ("hello" <//> var) $ \name ->
-- text ("Hello " <> name <> "!")
I'm trying to read some irregular input (for example, a commands, that can appear from time to time) from file. E.g. initially source file is empty, and my program was started. Then a some string was appended to the file, and my program must read this string.
A first naive implementation:
import System.IO
import Control.Monad
listen :: Handle -> IO ()
listen file = forever $ do
ineof <- hIsEOF file
if ineof
then do
s <- hGetLine file
putStrLn s
else
return ()
But it's not working properly of course (because of a performance issues first of all). How can I implement this correctly (maybe with a conduits usage)?
I've put together an example of implementing this below. The basic idea is:
Monitor for file changes using the fsnotify package.
Use sourceFileRange to stream the previously unconsumed portions of the file.
Use an MVar to let the fsnotify callback signal the Source to continue reading.
This assumes that the source file is only ever added to, never delete or shortened.
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar,
takeMVar)
import Control.Exception (IOException, try)
import Control.Monad (forever, void, when)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import Data.Conduit (MonadResource, Source, bracketP,
runResourceT, ($$), ($=))
import Data.Conduit.Binary (sourceFileRange)
import qualified Data.Conduit.List as CL
import Data.IORef (IORef, modifyIORef, newIORef,
readIORef)
import Data.Time (getCurrentTime)
import Filesystem (canonicalizePath)
import Filesystem.Path.CurrentOS (decodeString, directory)
import System.FSNotify (Event (..), startManager,
stopManager, watchDir)
tryIO :: IO a -> IO (Either IOException a)
tryIO = try
sourceFileForever :: MonadResource m => FilePath -> Source m ByteString
sourceFileForever fp' = bracketP startManager stopManager $ \manager -> do
fp <- liftIO $ canonicalizePath $ decodeString fp'
baton <- liftIO newEmptyMVar
liftIO $ watchDir manager (directory fp) (const True) $ \event -> void $ tryIO $ do
fpE <- canonicalizePath $
case event of
Added x _ -> x
Modified x _ -> x
Removed x _ -> x
when (fpE == fp) $ putMVar baton ()
consumedRef <- liftIO $ newIORef 0
loop baton consumedRef
where
loop :: MonadResource m => MVar () -> IORef Integer -> Source m ByteString
loop baton consumedRef = forever $ do
consumed <- liftIO $ readIORef consumedRef
sourceFileRange fp' (Just consumed) Nothing $= CL.iterM counter
liftIO $ takeMVar baton
where
counter bs = liftIO $ modifyIORef consumedRef (+ fromIntegral (S.length bs))
main :: IO ()
main = do
let fp = "foo.txt"
writeFile fp "Hello World!"
_ <- forkIO $ runResourceT $ sourceFileForever fp $$ CL.mapM_ (liftIO . print)
forever $ do
now <- getCurrentTime
appendFile fp $ show now ++ "\n"
threadDelay 1000000
I am trying to write a simple program in Haskell which listens over Zero MQ socket and publishes it to websocket connection, below is my code
{-# LANGUAGE OverloadedStrings #-}
import Data.Char (isPunctuation, isSpace)
import Data.Monoid (mappend)
import Data.Text (Text)
import Control.Exception (fromException)
import Control.Monad (forM_, forever)
import Control.Concurrent (MVar, newMVar, modifyMVar_, readMVar)
import Control.Monad.IO.Class (liftIO)
import Control.Monad
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Network.WebSockets as WS
import System.ZMQ3.Monadic
import Data.ByteString.Char8 (pack, unpack)
import Control.Concurrent (threadDelay)
import Data.Text.Encoding
import Data.ByteString.Internal
main :: IO ()
main = do
liftIO $ putStrLn "starting main..."
WS.runServer "0.0.0.0" 9160 $ application
application :: WS.Request -> WS.WebSockets WS.Hybi00 ()
application rq = do
liftIO $ putStrLn "starting..."
WS.acceptRequest rq
sink <- WS.getSink
WS.getVersion >>= liftIO . putStrLn . ("Client version: " ++)
msg <- WS.receiveData
liftIO $ putStrLn $ show $ (msg:: Text)
WS.sendTextData (msg :: Text)
runZMQ $ do
repSocket<- socket Rep
s<-return $bind repSocket "tcp://*:6555"
msg2 <- receive repSocket
let quote = msg2
--msg2 <- WS.receiveData
--liftIO $ putStrLn $ quote
WS.sendTextData $ ("test"::Text)
But compiler fails at statement WS.sendTextData $ ("test"::Text) saying below error
websocket_server.hs:42:17:
Couldn't match expected type `ZMQ z a0'
with actual type `WS.WebSockets p0 ()'
In a stmt of a 'do' block: WS.sendTextData $ ("test" :: Text)
In the second argument of `($)', namely
`do { repSocket <- socket Rep;
s <- return $ bind repSocket "tcp://*:6555";
msg2 <- receive repSocket;
let quote = msg2;
.... }'
In a stmt of a 'do' block:
runZMQ
$ do { repSocket <- socket Rep;
s <- return $ bind repSocket "tcp://*:6555";
msg2 <- receive repSocket;
let quote = msg2;
.... }
I am not sure how to deal with this issue how can I make do block statements return same value when the values cannot be converted into each other?
A simple liftIO should be enough for that call, but I haven't tried.
The trouble is that both the ZMQ and Websockets libraries define a "top level monad" that is not a monad transformer. So there is no provided way to layer the monads. This is poor design on their parts.
My suggestion would be to A) write your own ZMQ transformer or B) use the nonmonadic interface provided by ZMQ at the top level.