* removed entryEscape -> Posting pure HTML from now on (pre tag where necessary)
This commit is contained in:
parent
d1297a50b5
commit
bb981085a6
1 changed files with 5 additions and 11 deletions
16
src/Main.hs
16
src/Main.hs
|
@ -181,8 +181,8 @@ postEntry acid = do
|
||||||
<*> getLang lang
|
<*> getLang lang
|
||||||
<*> readCookieValue "sUser"
|
<*> readCookieValue "sUser"
|
||||||
<*> lookText' "title"
|
<*> lookText' "title"
|
||||||
<*> pure (entryEscape nBtext)
|
<*> pure nBtext
|
||||||
<*> pure (entryEscape nMtext)
|
<*> pure nMtext
|
||||||
<*> pure now
|
<*> pure now
|
||||||
<*> pure [] -- NYI
|
<*> pure [] -- NYI
|
||||||
<*> pure []
|
<*> pure []
|
||||||
|
@ -195,12 +195,6 @@ postEntry acid = do
|
||||||
getLang "de" = return DE
|
getLang "de" = return DE
|
||||||
getLang "en" = return EN
|
getLang "en" = return EN
|
||||||
|
|
||||||
entryEscape :: Text -> Text
|
|
||||||
entryEscape = newlineEscape . newlineRNEscape
|
|
||||||
where
|
|
||||||
newlineEscape = T.replace "\n" "<br>"
|
|
||||||
newlineRNEscape = T.replace "\r\n" "<br>"
|
|
||||||
|
|
||||||
entryList :: AcidState Blog -> BlogLang -> ServerPart Response
|
entryList :: AcidState Blog -> BlogLang -> ServerPart Response
|
||||||
entryList acid lang = do
|
entryList acid lang = do
|
||||||
entries <- query' acid (LatestEntries lang)
|
entries <- query' acid (LatestEntries lang)
|
||||||
|
@ -213,7 +207,7 @@ editEntry acid i = do
|
||||||
where
|
where
|
||||||
eId = EntryId i
|
eId = EntryId i
|
||||||
|
|
||||||
updateEntry :: AcidState Blog -> ServerPart Response
|
updateEntry :: AcidState Blog -> ServerPart Response -- TODO: Clean this up
|
||||||
updateEntry acid = do
|
updateEntry acid = do
|
||||||
decodeBody tmpPolicy
|
decodeBody tmpPolicy
|
||||||
(eId :: Integer) <- lookRead "eid"
|
(eId :: Integer) <- lookRead "eid"
|
||||||
|
@ -222,8 +216,8 @@ updateEntry acid = do
|
||||||
nBtext <- lookText' "btext"
|
nBtext <- lookText' "btext"
|
||||||
nMtext <- lookText' "mtext"
|
nMtext <- lookText' "mtext"
|
||||||
let nEntry = entry { title = nTitle
|
let nEntry = entry { title = nTitle
|
||||||
, btext = entryEscape nBtext
|
, btext = nBtext
|
||||||
, mtext = entryEscape nMtext}
|
, mtext = nMtext}
|
||||||
update' acid (UpdateEntry nEntry)
|
update' acid (UpdateEntry nEntry)
|
||||||
seeOther (concat $ intersperse' "/" [show $ lang entry, show eId])
|
seeOther (concat $ intersperse' "/" [show $ lang entry, show eId])
|
||||||
(toResponse ())
|
(toResponse ())
|
||||||
|
|
Loading…
Reference in a new issue