1
1
mirror of https://github.com/aelve/guide.git synced 2024-12-23 21:02:13 +03:00

Very simple form persisting application

This commit is contained in:
Artyom 2016-02-02 14:50:30 +03:00
parent cab27e77ab
commit 2cc514a85f
2 changed files with 47 additions and 2 deletions

View File

@ -24,7 +24,12 @@ executable hslib
main-is: Main.hs main-is: Main.hs
-- other-modules: -- other-modules:
-- other-extensions: -- other-extensions:
build-depends: base >=4.8 && <4.9 build-depends: Spock
, base >=4.8 && <4.9
, base-prelude
, lucid
, text
, transformers
ghc-options: -Wall -fno-warn-unused-do-bind ghc-options: -Wall -fno-warn-unused-do-bind
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

View File

@ -1,4 +1,44 @@
{-# LANGUAGE
OverloadedStrings,
NoImplicitPrelude
#-}
module Main (main) where module Main (main) where
-- General
import BasePrelude
-- IO
import Control.Monad.IO.Class
-- Text
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
-- Web
import Lucid
import Web.Spock
main :: IO () main :: IO ()
main = return () main = runSpock 8080 $ spockT id $ do
textVar <- liftIO $ newIORef ("" :: Text)
get root $ do
t <- liftIO $ readIORef textVar
lucid $ do
script_ "window.onload = function() {\
\ var area = document.getElementsByName('text')[0];\
\ area.addEventListener('input', function() {\
\ var client = new XMLHttpRequest();\
\ client.open('PUT', '/store', true);\
\ client.setRequestHeader('Content-Type', 'text/plain');\
\ client.send(area.value);}, false);};"
with textarea_ [name_ "text"] (toHtml t)
put "store" $ do
t <- T.decodeUtf8 <$> body
liftIO $ writeIORef textVar t
-- Utils
lucid :: Html a -> ActionT IO a
lucid = html . TL.toStrict . renderText