2016-02-24 19:32:12 +03:00
{- # LANGUAGE
FlexibleInstances ,
GeneralizedNewtypeDeriving ,
OverloadedStrings ,
QuasiQuotes ,
2016-03-12 18:03:15 +03:00
BangPatterns ,
2016-02-24 19:32:12 +03:00
NoImplicitPrelude
#- }
-- TODO: try to make it more type-safe somehow?
2016-04-21 18:10:58 +03:00
-- TODO: maybe use jmacro or something?
2016-02-24 19:32:12 +03:00
module JS where
-- General
import BasePrelude
-- Text
2016-06-12 22:35:13 +03:00
import qualified Data.Text.All as T
import Data.Text.All ( Text )
-- Interpolation
2016-02-24 19:32:12 +03:00
import NeatInterpolation
-- Local
import Utils
-- | Javascript code.
newtype JS = JS { fromJS :: Text }
2016-06-12 22:35:13 +03:00
deriving ( Show , T . Buildable , Monoid )
2016-02-24 19:32:12 +03:00
-- | A concatenation of all Javascript functions defined in this module.
allJSFunctions :: JS
allJSFunctions = JS . T . unlines . map fromJS $ [
-- Utilities
2016-02-25 17:49:17 +03:00
replaceWithData , prependData , appendData ,
2016-02-24 19:32:12 +03:00
moveNodeUp , moveNodeDown ,
2016-03-08 16:43:04 +03:00
switchSection , switchSectionsEverywhere ,
2016-04-10 23:44:55 +03:00
fadeIn , fadeOutAndRemove ,
2016-04-16 23:06:59 +03:00
-- Misc
createAjaxIndicator ,
2016-04-19 20:03:54 +03:00
autosizeTextarea ,
2016-04-20 01:59:29 +03:00
expandHash ,
expandItemNotes ,
2016-06-19 00:52:19 +03:00
showDiffPopup ,
2016-04-19 20:03:54 +03:00
-- Creating parts of interface
makeTraitEditor ,
makeItemNotesEditor ,
2016-02-24 19:32:12 +03:00
-- Add methods
2016-04-21 18:10:58 +03:00
addCategoryAndRedirect , addItem ,
2016-02-24 19:32:12 +03:00
addPro , addCon ,
-- Set methods
2016-05-05 16:50:10 +03:00
submitCategoryInfo , submitCategoryNotes ,
2016-05-01 23:17:55 +03:00
submitItemDescription ,
2016-03-17 02:52:40 +03:00
submitItemInfo , submitItemNotes , submitItemEcosystem ,
2016-02-24 19:32:12 +03:00
submitTrait ,
-- Other things
2016-04-22 01:26:45 +03:00
deleteCategoryAndRedirect ,
2016-02-26 20:45:28 +03:00
moveTraitUp , moveTraitDown , deleteTrait ,
2016-04-08 18:05:52 +03:00
moveItemUp , moveItemDown , deleteItem ,
-- Admin things
2016-04-16 00:06:34 +03:00
acceptEdit , undoEdit ,
acceptBlock , undoBlock ,
createCheckpoint ]
2016-02-24 19:32:12 +03:00
-- | A class for things that can be converted to Javascript syntax.
class ToJS a where toJS :: a -> JS
instance ToJS Bool where
toJS True = JS " true "
toJS False = JS " false "
instance ToJS JS where
toJS = id
instance ToJS Text where
2016-03-12 18:03:15 +03:00
toJS = JS . escapeJSString
2016-02-24 19:32:12 +03:00
instance ToJS Integer where
2016-06-12 22:35:13 +03:00
toJS = JS . T . show
2016-02-24 19:32:12 +03:00
instance ToJS Int where
2016-06-12 22:35:13 +03:00
toJS = JS . T . show
2016-04-09 11:13:26 +03:00
instance ToJS ( Uid a ) where
2016-03-15 13:10:47 +03:00
toJS = toJS . uidToText
2016-02-24 19:32:12 +03:00
-- | A helper class for calling Javascript functions.
class JSParams a where
jsParams :: a -> [ JS ]
instance JSParams () where
jsParams () = []
instance ToJS a => JSParams [ a ] where
jsParams = map toJS
2016-04-19 20:03:54 +03:00
instance ( ToJS a , ToJS b ) => JSParams ( a , b ) where
2016-02-24 19:32:12 +03:00
jsParams ( a , b ) = [ toJS a , toJS b ]
2016-04-19 20:03:54 +03:00
instance ( ToJS a , ToJS b , ToJS c ) => JSParams ( a , b , c ) where
2016-02-24 19:32:12 +03:00
jsParams ( a , b , c ) = [ toJS a , toJS b , toJS c ]
2016-04-19 20:03:54 +03:00
instance ( ToJS a , ToJS b , ToJS c , ToJS d ) => JSParams ( a , b , c , d ) where
2016-02-24 19:32:12 +03:00
jsParams ( a , b , c , d ) = [ toJS a , toJS b , toJS c , toJS d ]
2016-04-19 20:03:54 +03:00
instance ( ToJS a , ToJS b , ToJS c , ToJS d , ToJS e ) => JSParams ( a , b , c , d , e ) where
jsParams ( a , b , c , d , e ) = [ toJS a , toJS b , toJS c , toJS d , toJS e ]
instance ( ToJS a , ToJS b , ToJS c , ToJS d , ToJS e , ToJS f ) => JSParams ( a , b , c , d , e , f ) where
jsParams ( a , b , c , d , e , f ) = [ toJS a , toJS b , toJS c , toJS d , toJS e , toJS f ]
2016-02-24 19:32:12 +03:00
{- | This hacky class lets you construct and use Javascript functions; you give 'makeJSFunction' function name, function parameters, and function body, and you get a polymorphic value of type @JSFunction a => a@, which you can use either as a complete function definition (if you set @a@ to be @JS@), or as a function that you can give some parameters and it would return a Javascript call:
> plus = makeJSFunction " plus " [ " a " , " b " ] " return a+b; "
>>> plus :: JS
JS " function plus(a,b) { \ n return a+b;} \ n "
>>> plus ( 3 , 5 ) :: JS
JS " plus(3,5); "
- }
class JSFunction a where
makeJSFunction
:: Text -- ^ Name
-> [ Text ] -- ^ Parameter names
-> Text -- ^ Definition
-> a
-- This generates function definition
instance JSFunction JS where
makeJSFunction fName fParams fDef =
2016-06-12 22:35:13 +03:00
JS $ T . format " function {}({}) { \ n {}} \ n "
( fName , T . intercalate " , " fParams , fDef )
2016-02-24 19:32:12 +03:00
-- This generates a function that takes arguments and produces a Javascript
-- function call
instance JSParams a => JSFunction ( a -> JS ) where
makeJSFunction fName _fParams _fDef = \ args ->
2016-06-12 22:35:13 +03:00
JS $ T . format " {}({}); "
( fName , T . intercalate " , " ( map fromJS ( jsParams args ) ) )
2016-02-24 19:32:12 +03:00
2016-03-13 01:29:02 +03:00
-- This isn't a standalone function and so it doesn't have to be listed in
-- 'allJSFunctions'.
assign :: ToJS x => JS -> x -> JS
2016-06-12 22:35:13 +03:00
assign v x = JS $ T . format " {} = {}; " ( v , toJS x )
2016-03-13 01:29:02 +03:00
2016-03-20 02:36:16 +03:00
-- TODO: all links here shouldn't be absolute [absolute-links]
2016-02-24 19:32:12 +03:00
replaceWithData :: JSFunction a => a
replaceWithData =
makeJSFunction " replaceWithData " [ " node " ]
[ text |
return function ( data ) { $ ( node ) . replaceWith ( data ) ; } ;
| ]
2016-02-25 17:49:17 +03:00
prependData :: JSFunction a => a
prependData =
makeJSFunction " prependData " [ " node " ]
[ text |
return function ( data ) { $ ( node ) . prepend ( data ) ; } ;
| ]
2016-02-24 19:32:12 +03:00
appendData :: JSFunction a => a
appendData =
makeJSFunction " appendData " [ " node " ]
[ text |
return function ( data ) { $ ( node ) . append ( data ) ; } ;
| ]
-- | Move node up (in a list of sibling nodes), ignoring anchor elements
-- inserted by 'thisNode'.
moveNodeUp :: JSFunction a => a
moveNodeUp =
makeJSFunction " moveNodeUp " [ " node " ]
[ text |
var el = $ ( node ) ;
while ( el . prev () . is ( " .dummy " ) )
el . prev () . before ( el ) ;
if ( el . not ( ': first - child' ) )
el . prev () . before ( el ) ;
| ]
-- | Move node down (in a list of sibling nodes), ignoring anchor elements
-- inserted by 'thisNode'.
moveNodeDown :: JSFunction a => a
moveNodeDown =
makeJSFunction " moveNodeDown " [ " node " ]
[ text |
var el = $ ( node ) ;
while ( el . next () . is ( " .dummy " ) )
el . next () . after ( el ) ;
if ( el . not ( ': last - child' ) )
el . next () . after ( el ) ;
| ]
2016-03-07 21:50:53 +03:00
-- | Given something that contains section divs (or spans), show one and
-- hide the rest. The div/span with the given @class@ will be chosen.
2016-03-27 02:34:07 +03:00
--
-- See Note [show-hide]
2016-03-07 21:50:53 +03:00
switchSection :: JSFunction a => a
switchSection =
makeJSFunction " switchSection " [ " node " , " section " ]
[ text |
$ ( node ) . children ( " .section " ) . removeClass ( " shown " ) ;
$ ( node ) . children ( " .section. " + section ) . addClass ( " shown " ) ;
2016-03-11 13:28:08 +03:00
// See Note [ autosize ]
autosize ( $ ( 'textarea' ) ) ;
autosize . update ( $ ( 'textarea' ) ) ;
2016-03-07 21:50:53 +03:00
| ]
2016-03-27 02:34:07 +03:00
-- | Switch sections /everywhere/ inside the container.
--
-- See Note [show-hide]
2016-03-08 16:43:04 +03:00
switchSectionsEverywhere :: JSFunction a => a
switchSectionsEverywhere =
makeJSFunction " switchSectionsEverywhere " [ " node " , " section " ]
[ text |
$ ( node ) . find ( " .section " ) . removeClass ( " shown " ) ;
$ ( node ) . find ( " .section. " + section ) . addClass ( " shown " ) ;
2016-03-11 13:28:08 +03:00
// See Note [ autosize ]
autosize ( $ ( 'textarea' ) ) ;
autosize . update ( $ ( 'textarea' ) ) ;
2016-03-08 16:43:04 +03:00
| ]
2016-04-10 23:44:55 +03:00
-- | This function makes the node half-transparent and then animates it to
-- full opaqueness. It's useful when e.g. something has been moved and you
-- want to “flash” the item to draw user's attention to it.
2016-03-20 16:41:32 +03:00
fadeIn :: JSFunction a => a
fadeIn =
makeJSFunction " fadeIn " [ " node " ]
[ text |
$ ( node ) . fadeTo ( 0 , 0.2 ) . fadeTo ( 600 , 1 ) ;
| ]
2016-04-10 23:44:55 +03:00
-- | This function animates the node to half-transparency and then removes it
-- completely. It's useful when you're removing something and you want to
-- draw user's attention to the fact that it's being removed.
--
-- The reason there isn't a simple @fadeOut@ utility function here is that
-- removal has to be done by passing a callback to @fadeTo@. In jQuery you
-- can't simply wait until the animation has stopped.
fadeOutAndRemove :: JSFunction a => a
fadeOutAndRemove =
makeJSFunction " fadeOutAndRemove " [ " node " ]
[ text |
$ ( node ) . fadeTo ( 400 , 0.2 , function () { $ ( node ) . remove () } ) ;
| ]
2016-03-20 16:41:32 +03:00
2016-04-16 23:06:59 +03:00
createAjaxIndicator :: JSFunction a => a
createAjaxIndicator =
makeJSFunction " createAjaxIndicator " []
[ text |
$ ( " body " ) . prepend ( '< div id = " ajax-indicator " ></ div > ' ) ;
$ ( document ) . ajaxStart ( function () {
$ ( " #ajax-indicator " ) . show () ;
} ) ;
$ ( document ) . ajaxStop ( function () {
$ ( " #ajax-indicator " ) . hide () ;
} ) ;
$ ( " #ajax-indicator " ) . hide () ;
| ]
2016-04-19 20:03:54 +03:00
autosizeTextarea :: JSFunction a => a
autosizeTextarea =
makeJSFunction " autosizeTextarea " [ " textareaNode " ]
[ text |
autosize ( textareaNode ) ;
autosize . update ( textareaNode ) ;
| ]
2016-04-20 01:59:29 +03:00
-- | Read the anchor from the address bar (i.e. the thing after #) and use it
-- to expand something (e.g. notes). It's needed to implement linking
-- properly – e.g. notes are usually unexpanded, but when you're giving
-- someone a direct link to notes, it makes sense to expand them. If you call
-- 'expandHash' after the page has loaded, it will do just that.
expandHash :: JSFunction a => a
expandHash =
makeJSFunction " expandHash " []
[ text |
hash = $ ( location ) . attr ( 'hash' ) ;
if ( hash . slice ( 0 , 12 ) == " #item-notes- " ) {
2016-04-22 01:06:02 +03:00
if ( hash . indexOf ( '-' , 12 ) != ( - 1 ) )
// For links to sections of items' notes ( from the TOC )
itemId = hash . slice ( 12 , hash . indexOf ( '-' , 12 ) )
else
// For links to items' notes
itemId = hash . slice ( 12 ) ;
2016-04-20 01:59:29 +03:00
expandItemNotes ( itemId ) ;
2016-04-20 21:24:04 +03:00
} else
if ( hash . slice ( 0 , 6 ) == " #item- " ) {
itemId = hash . slice ( 6 ) ;
expandItemNotes ( itemId ) ;
2016-04-20 01:59:29 +03:00
}
| ]
expandItemNotes :: JSFunction a => a
expandItemNotes =
makeJSFunction " expandItemNotes " [ " itemId " ]
[ text |
switchSection ( " #item-notes- " + itemId , " expanded " ) ;
| ]
2016-06-19 00:52:19 +03:00
showDiffPopup :: JSFunction a => a
showDiffPopup =
makeJSFunction " showDiffPopup " [ " ours " , " modified " , " merged " , " send " ]
[ text |
dialog = $ ( " <div> " , {
" class " : " diff-popup "
} ) [ 0 ] ;
choices = $ ( " <div> " , {
" class " : " diff-choices "
} ) [ 0 ] ;
// our version
choiceOurs = $ ( " <div> " , {
" class " : " var-a " } ) [ 0 ] ;
textOurs = $ ( " <div> " , {
" class " : " text " ,
" text " : ours } ) [ 0 ] ;
headerOurs = $ ( " <strong> " , {
" text " : " Your version " } ) [ 0 ] ;
buttonOurs = $ ( " <button> " , {
" text " : " Submit this version, disregard changes on the server " } ) [ 0 ] ;
$ ( buttonOurs ) . click ( function () {
send ( ours ) ; } ) ;
$ ( choiceOurs ) . append ( headerOurs , textOurs , buttonOurs ) ;
// modified version
choiceMod = $ ( " <div> " , {
" class " : " var-b " } ) [ 0 ] ;
textMod = $ ( " <div> " , {
" class " : " text " ,
" text " : modified } ) [ 0 ] ;
headerMod = $ ( " <strong> " , {
" text " : " Version on the server " } ) [ 0 ] ;
buttonMod = $ ( " <button> " , {
" text " : " Accept this version, disregard my changes " } ) [ 0 ] ;
$ ( buttonMod ) . click ( function () {
send ( modified ) ; } ) ;
$ ( choiceMod ) . append ( headerMod , textMod , buttonMod ) ;
// building merged
choiceMerged = $ ( " <div> " , {
" class " : " var-merged " } ) [ 0 ] ;
areaMerged = $ ( " <textarea> " , {
" autocomplete " : " off " ,
" text " : merged } ) [ 0 ] ;
headerMerged = $ ( " <strong> " , {
" text " : " Merged version (edit if needed) " } ) [ 0 ] ;
buttonMerged = $ ( " <button> " , {
" text " : " Submit the merged version " } ) [ 0 ] ;
$ ( buttonMerged ) . click ( function () {
send ( areaMerged . value ) ; } ) ;
$ ( choiceMerged ) . append ( headerMerged , areaMerged , buttonMerged ) ;
$ ( choices ) . append ( choiceOurs , choiceMod , choiceMerged ) ;
$ ( dialog ) . append ( choices ) ;
$. magnificPopup . open ( {
modal : true ,
items : {
src : dialog ,
type : 'inline' }
} ) ;
autosizeTextarea ( areaMerged ) ;
| ]
2016-04-22 16:59:50 +03:00
{- Note [dynamic interface]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
'makeTraitEditor' creates a textbox that appears when you try to edit a pro / con ; 'makeItemNotesEditor' creates a textbox that appears when you try to edit item's notes . ( Both also create some buttons / etc . )
This is rather inelegant , rather hacky , and in most places we try * not * to create any HTML dynamically , instead relying on sections ( see Note [ show - hide ] ) . However , in this case we have to – Firefox has a bug that makes loading pages with lots of < textarea > s slow , and so we have to reduce the number of < textarea > s contained on each page .
See < https :// github . com / aelve / guide / issues / 24 >.
- }
-- | Dynamically creates a 'View.smallMarkdownEditor' (but specifically for a
-- trait). See Note [dynamic interface].
2016-04-19 20:03:54 +03:00
makeTraitEditor :: JSFunction a => a
makeTraitEditor =
makeJSFunction " makeTraitEditor "
2016-06-19 00:52:19 +03:00
[ " traitNode " , " sectionNode " , " textareaUid " ,
" content " , " itemId " , " traitId " ]
2016-04-19 20:03:54 +03:00
[ text |
$ ( sectionNode ) . html ( " " ) ;
area = $ ( " <textarea> " , {
" autocomplete " : " off " ,
" rows " : " 5 " ,
" id " : textareaUid ,
" class " : " fullwidth " ,
" text " : content } ) [ 0 ] ;
2016-04-19 23:09:39 +03:00
area . onkeydown = function ( event ) {
2016-04-19 20:03:54 +03:00
if ( event . keyCode == 13 ) {
2016-06-19 00:52:19 +03:00
submitTrait ( traitNode , itemId , traitId , content , area . value ) ;
2016-04-19 20:03:54 +03:00
return false ; } } ;
br = $ ( " <br> " ) [ 0 ] ;
a = $ ( " <a> " , {
" href " : " # " ,
" text " : " cancel " } ) [ 0 ] ;
a . onclick = function () {
$ ( sectionNode ) . html ( " " ) ;
switchSection ( traitNode , " editable " ) ;
return false ; } ;
cancelBtn = $ ( " <span> " , { " class " : " text-button " } ) [ 0 ] ;
2016-05-02 21:27:49 +03:00
markdown = $ ( " <a> " , {
" href " : " /markdown " ,
" target " : " _blank " ,
" style " : " float:right " ,
" text " : " Markdown " } ) [ 0 ] ;
2016-04-19 20:03:54 +03:00
$ ( cancelBtn ) . append ( a ) ;
2016-05-02 21:27:49 +03:00
$ ( sectionNode ) . append ( area , br , cancelBtn , markdown ) ;
2016-04-19 20:03:54 +03:00
| ]
2016-04-22 16:59:50 +03:00
-- | Dynamically creates a 'View.markdownEdito' (but specifically for item
-- notes). See Note [dynamic interface].
2016-04-19 20:03:54 +03:00
makeItemNotesEditor :: JSFunction a => a
makeItemNotesEditor =
makeJSFunction " makeItemNotesEditor "
[ " notesNode " , " sectionNode " , " textareaUid " , " content " , " itemId " ]
[ text |
$ ( sectionNode ) . html ( " " ) ;
area = $ ( " <textarea> " , {
" autocomplete " : " off " ,
" rows " : " 10 " ,
" id " : textareaUid ,
" class " : " big fullwidth " ,
" text " : content } ) [ 0 ] ;
saveBtn = $ ( " <input> " , {
" value " : " Save " ,
" type " : " button " } ) [ 0 ] ;
saveBtn . onclick = function () {
submitItemNotes ( notesNode , itemId , area . value ) ; } ;
// Can't use $ () - generation here because then the < span > would have
// to be cloned ( since we're inserting it multiple times ) and I don't
// know how to do that .
space = " <span style='margin-left:6px'></span> " ;
cancelBtn = $ ( " <input> " , {
" value " : " Cancel " ,
" type " : " button " } ) [ 0 ] ;
cancelBtn . onclick = function () {
$ ( sectionNode ) . html ( " " ) ;
switchSection ( notesNode , " expanded " ) ; } ;
2016-05-02 21:27:49 +03:00
markdown = $ ( " <a> " , {
" href " : " /markdown " ,
" target " : " _blank " ,
" text " : " Markdown " } ) [ 0 ] ;
2016-04-19 20:03:54 +03:00
$ ( sectionNode ) . append (
2016-05-11 04:13:13 +03:00
area , saveBtn , $ ( space ) , cancelBtn , $ ( space ) , markdown ) ;
2016-04-19 20:03:54 +03:00
| ]
2016-04-21 18:10:58 +03:00
-- | Create a new category and redirect to it (or redirect to an old category
-- if it exists already).
addCategoryAndRedirect :: JSFunction a => a
addCategoryAndRedirect =
makeJSFunction " addCategoryAndRedirect " [ " s " ]
2016-02-24 19:32:12 +03:00
[ text |
2016-03-20 02:36:16 +03:00
$. post ( " /haskell/add/category " , { content : s } )
2016-04-21 18:10:58 +03:00
. done ( function ( url ) {
window . location . href = url ;
} ) ;
2016-02-24 19:32:12 +03:00
| ]
2016-03-14 13:58:45 +03:00
-- | Add a new item to some category.
addItem :: JSFunction a => a
addItem =
makeJSFunction " addItem " [ " node " , " catId " , " s " ]
2016-02-24 19:32:12 +03:00
[ text |
2016-03-20 02:36:16 +03:00
$. post ( " /haskell/add/category/ " + catId + " /item " , { name : s } )
2016-02-24 19:32:12 +03:00
. done ( appendData ( node ) ) ;
| ]
2016-05-05 16:50:10 +03:00
submitCategoryInfo :: JSFunction a => a
submitCategoryInfo =
makeJSFunction " submitCategoryInfo " [ " infoNode " , " catId " , " form " ]
2016-02-24 19:32:12 +03:00
[ text |
2016-05-05 16:50:10 +03:00
$. post ( " /haskell/set/category/ " + catId + " /info " , $ ( form ) . serialize () )
. done ( function ( data ) {
$ ( infoNode ) . replaceWith ( data ) ;
2016-05-22 14:43:46 +03:00
// If pros - cons - enabled and ecosystem - enabled were changed , we
// have to show / hide relevant sections in all items of the category .
// See Note [ enabled sections ] for details .
if ( $ ( form ) [ 0 ] [ " pros-cons-enabled " ] . checked )
$ ( " .pros-cons-wrapper " ) . show () ;
else $ ( " .pros-cons-wrapper " ) . hide () ;
if ( $ ( form ) [ 0 ] [ " ecosystem-enabled " ] . checked )
$ ( " .ecosystem-wrapper " ) . show () ;
else $ ( " .ecosystem-wrapper " ) . hide () ;
2016-05-05 16:50:10 +03:00
} ) ;
2016-05-01 23:17:55 +03:00
| ]
2016-02-24 19:32:12 +03:00
submitCategoryNotes :: JSFunction a => a
submitCategoryNotes =
makeJSFunction " submitCategoryNotes " [ " node " , " catId " , " s " ]
[ text |
2016-03-20 02:36:16 +03:00
$. post ( " /haskell/set/category/ " + catId + " /notes " , { content : s } )
2016-02-24 19:32:12 +03:00
. done ( replaceWithData ( node ) ) ;
| ]
2016-03-11 00:22:28 +03:00
submitItemDescription :: JSFunction a => a
submitItemDescription =
makeJSFunction " submitItemDescription " [ " node " , " itemId " , " s " ]
[ text |
2016-03-20 02:36:16 +03:00
$. post ( " /haskell/set/item/ " + itemId + " /description " , { content : s } )
2016-03-11 00:22:28 +03:00
. done ( replaceWithData ( node ) ) ;
| ]
2016-03-17 02:52:40 +03:00
submitItemEcosystem :: JSFunction a => a
submitItemEcosystem =
makeJSFunction " submitItemEcosystem " [ " node " , " itemId " , " s " ]
[ text |
2016-03-20 02:36:16 +03:00
$. post ( " /haskell/set/item/ " + itemId + " /ecosystem " , { content : s } )
2016-03-17 02:52:40 +03:00
. done ( replaceWithData ( node ) ) ;
| ]
2016-03-05 00:40:51 +03:00
submitItemNotes :: JSFunction a => a
submitItemNotes =
makeJSFunction " submitItemNotes " [ " node " , " itemId " , " s " ]
[ text |
2016-03-20 02:36:16 +03:00
$. post ( " /haskell/set/item/ " + itemId + " /notes " , { content : s } )
2016-03-08 13:32:56 +03:00
. done ( function ( data ) {
$ ( node ) . replaceWith ( data ) ;
switchSection ( node , " expanded " ) ;
} ) ;
// Switching has to be done here and not in 'Main . renderItemNotes'
// because $. post is asynchronous and will be done * after *
// switchSection has worked .
2016-03-05 00:40:51 +03:00
| ]
2016-02-24 19:32:12 +03:00
-- | Add a pro to some item.
addPro :: JSFunction a => a
addPro =
makeJSFunction " addPro " [ " node " , " itemId " , " s " ]
[ text |
2016-03-20 02:36:16 +03:00
$. post ( " /haskell/add/item/ " + itemId + " /pro " , { content : s } )
2016-03-08 16:43:04 +03:00
. done ( function ( data ) {
var jData = $ ( data ) ;
jData . appendTo ( node ) ;
switchSection ( jData , " editable " ) ;
} ) ;
2016-02-24 19:32:12 +03:00
| ]
-- | Add a con to some item.
addCon :: JSFunction a => a
addCon =
makeJSFunction " addCon " [ " node " , " itemId " , " s " ]
[ text |
2016-03-20 02:36:16 +03:00
$. post ( " /haskell/add/item/ " + itemId + " /con " , { content : s } )
2016-03-08 16:43:04 +03:00
. done ( function ( data ) {
var jData = $ ( data ) ;
jData . appendTo ( node ) ;
switchSection ( jData , " editable " ) ;
} ) ;
2016-02-24 19:32:12 +03:00
| ]
submitTrait :: JSFunction a => a
submitTrait =
2016-06-19 00:52:19 +03:00
makeJSFunction " submitTrait "
[ " node " , " itemId " , " traitId " , " original " , " ours " ]
2016-02-24 19:32:12 +03:00
[ text |
2016-06-19 00:52:19 +03:00
$. post ( {
url : " /haskell/set/item/ " + itemId + " /trait/ " + traitId ,
data : {
original : original ,
content : ours } ,
success : function ( data ) {
$. magnificPopup . close () ;
2016-03-08 16:43:04 +03:00
$ ( node ) . replaceWith ( data ) ;
2016-06-19 00:52:19 +03:00
// Switching has to be done here and not in 'Main . renderTrait'
// because $. post is asynchronous and will be done * after *
// switchSection has worked .
switchSection ( node , " editable " ) ; } ,
statusCode : {
409 : function ( xhr , st , err ) {
modified = xhr . responseJSON [ " modified " ] ;
merged = xhr . responseJSON [ " merged " ] ;
showDiffPopup ( ours , modified , merged , function ( x ) {
submitTrait ( node , itemId , traitId , modified , x ) } ) ; } }
2016-03-08 16:43:04 +03:00
} ) ;
2016-02-24 19:32:12 +03:00
| ]
submitItemInfo :: JSFunction a => a
submitItemInfo =
2016-03-17 03:35:56 +03:00
makeJSFunction " submitItemInfo " [ " infoNode " , " bodyNode " , " itemId " , " form " ]
2016-02-24 19:32:12 +03:00
[ text |
2016-04-20 23:16:05 +03:00
custom = $ ( form ) [ 0 ] . elements [ " custom-group " ] . value ;
items = $ ( form ) . closest ( " .items " ) . find ( " .item " ) ;
2016-03-04 12:35:36 +03:00
// If the group was changed , we need to recolor the whole item ,
// but we don't want to rerender the item on the server because
// it would lose the item's state ( e . g . what if the traits were
// being edited ? etc ) . So , instead we query colors from the server
2016-03-17 03:35:56 +03:00
// and change the color of the item's body manually .
2016-03-20 02:36:16 +03:00
$. post ( " /haskell/set/item/ " + itemId + " /info " , $ ( form ) . serialize () )
2016-03-04 12:35:36 +03:00
. done ( function ( data ) {
// Note the order – first we change the color , then we replace
2016-03-17 03:35:56 +03:00
// the info node . The reason is that otherwise the bodyNode
2016-03-04 12:35:36 +03:00
// selector might become invalid ( if it depends on the infoNode
// selector ) .
2016-03-20 02:36:16 +03:00
$. get ( " /haskell/render/item/ " + itemId + " /colors " )
2016-03-04 12:35:36 +03:00
. done ( function ( colors ) {
2016-03-17 03:35:56 +03:00
$ ( bodyNode ) . css ( " background-color " , colors . light ) ;
2016-03-08 16:43:04 +03:00
$ ( infoNode ) . replaceWith ( data ) ;
2016-03-04 12:35:36 +03:00
} ) ;
2016-04-20 23:16:05 +03:00
// And now , if a custom group was created , we should add it to other
// items' lists .
if ( custom != " " ) {
items . each ( function ( i , item ) {
groups = $ ( item ) . find ( " select[name=group] " ) [ 0 ] ;
isOurOption = function ( opt ) { return opt . text == custom } ;
alreadyExists = $. grep ( groups . options , isOurOption ) . length > 0 ;
if ( ! alreadyExists ) {
groups . add ( new Option ( custom , custom ) , 1 ) ; }
} ) ;
}
2016-03-04 12:35:36 +03:00
} ) ;
2016-02-24 19:32:12 +03:00
| ]
2016-04-22 01:26:45 +03:00
deleteCategoryAndRedirect :: JSFunction a => a
deleteCategoryAndRedirect =
makeJSFunction " deleteCategoryAndRedirect " [ " catId " ]
2016-04-07 15:54:11 +03:00
[ text |
if ( confirm ( " Confirm deletion? " ) ) {
$. post ( " /haskell/delete/category/ " + catId )
. done ( function () {
2016-04-22 01:26:45 +03:00
window . location . href = " /haskell " ;
2016-04-07 15:54:11 +03:00
} ) ;
}
| ]
2016-02-24 19:32:12 +03:00
moveTraitUp :: JSFunction a => a
moveTraitUp =
makeJSFunction " moveTraitUp " [ " itemId " , " traitId " , " traitNode " ]
[ text |
2016-04-06 02:04:22 +03:00
$. post ( " /haskell/move/item/ " + itemId + " /trait/ " + traitId , { direction : " up " } )
. done ( function () {
moveNodeUp ( traitNode ) ;
fadeIn ( traitNode ) ;
} ) ;
2016-02-24 19:32:12 +03:00
| ]
moveTraitDown :: JSFunction a => a
moveTraitDown =
makeJSFunction " moveTraitDown " [ " itemId " , " traitId " , " traitNode " ]
[ text |
2016-04-06 02:04:22 +03:00
$. post ( " /haskell/move/item/ " + itemId + " /trait/ " + traitId , { direction : " down " } )
. done ( function () {
moveNodeDown ( traitNode ) ;
fadeIn ( traitNode ) ;
} ) ;
2016-02-24 19:32:12 +03:00
| ]
deleteTrait :: JSFunction a => a
deleteTrait =
2016-03-12 20:06:24 +03:00
makeJSFunction " deleteTrait " [ " itemId " , " traitId " , " traitNode " ]
2016-02-24 19:32:12 +03:00
[ text |
2016-03-12 20:06:24 +03:00
if ( confirm ( " Confirm deletion? " ) ) {
2016-04-06 02:04:22 +03:00
$. post ( " /haskell/delete/item/ " + itemId + " /trait/ " + traitId )
. done ( function () {
2016-04-10 23:44:55 +03:00
fadeOutAndRemove ( traitNode ) ;
2016-04-06 02:04:22 +03:00
} ) ;
2016-02-24 21:08:45 +03:00
}
2016-02-24 19:32:12 +03:00
| ]
2016-02-26 20:45:28 +03:00
moveItemUp :: JSFunction a => a
moveItemUp =
makeJSFunction " moveItemUp " [ " itemId " , " itemNode " ]
[ text |
2016-04-06 02:04:22 +03:00
$. post ( " /haskell/move/item/ " + itemId , { direction : " up " } )
. done ( function () {
moveNodeUp ( itemNode ) ;
fadeIn ( itemNode ) ;
} ) ;
2016-02-26 20:45:28 +03:00
| ]
moveItemDown :: JSFunction a => a
moveItemDown =
makeJSFunction " moveItemDown " [ " itemId " , " itemNode " ]
[ text |
2016-04-06 02:04:22 +03:00
$. post ( " /haskell/move/item/ " + itemId , { direction : " down " } )
. done ( function () {
moveNodeDown ( itemNode ) ;
fadeIn ( itemNode ) ;
} ) ;
2016-02-26 20:45:28 +03:00
| ]
2016-04-08 18:05:52 +03:00
acceptEdit :: JSFunction a => a
acceptEdit =
makeJSFunction " acceptEdit " [ " editId " , " editNode " ]
[ text |
$. post ( " /admin/edit/ " + editId + " /accept " )
. done ( function () {
2016-04-10 23:44:55 +03:00
fadeOutAndRemove ( editNode ) ;
2016-04-08 18:05:52 +03:00
} ) ;
| ]
undoEdit :: JSFunction a => a
undoEdit =
makeJSFunction " undoEdit " [ " editId " , " editNode " ]
[ text |
$. post ( " /admin/edit/ " + editId + " /undo " )
. done ( function ( data ) {
if ( data == " " )
2016-04-10 23:44:55 +03:00
fadeOutAndRemove ( editNode ) ;
2016-04-08 18:05:52 +03:00
else
alert ( " couldn't undo edit: " + data ) ;
} ) ;
| ]
2016-04-15 14:14:01 +03:00
acceptBlock :: JSFunction a => a
acceptBlock =
makeJSFunction " acceptBlock " [ " editLatest " , " editEarliest " , " blockNode " ]
[ text |
$. post ( " /admin/edits/ " + editLatest + " / " + editEarliest + " /accept " )
. done ( function () {
fadeOutAndRemove ( blockNode ) ;
} ) ;
| ]
undoBlock :: JSFunction a => a
undoBlock =
makeJSFunction " undoBlock " [ " editLatest " , " editEarliest " , " blockNode " ]
[ text |
$. post ( " /admin/edits/ " + editLatest + " / " + editEarliest + " /undo " )
. done ( function ( data ) {
if ( data == " " )
fadeOutAndRemove ( blockNode ) ;
else
$ ( blockNode ) . replaceWith ( data ) ;
} ) ;
| ]
2016-04-16 00:06:34 +03:00
createCheckpoint :: JSFunction a => a
createCheckpoint =
makeJSFunction " createCheckpoint " [ " buttonNode " ]
[ text |
$. post ( " /admin/create-checkpoint " )
. done ( function () {
fadeIn ( buttonNode ) ;
} ) ;
| ]
2016-02-26 20:45:28 +03:00
deleteItem :: JSFunction a => a
deleteItem =
2016-03-12 20:06:24 +03:00
makeJSFunction " deleteItem " [ " itemId " , " itemNode " ]
2016-02-26 20:45:28 +03:00
[ text |
2016-03-12 20:06:24 +03:00
if ( confirm ( " Confirm deletion? " ) ) {
2016-04-06 02:04:22 +03:00
$. post ( " /haskell/delete/item/ " + itemId )
. done ( function () {
2016-04-10 23:44:55 +03:00
fadeOutAndRemove ( itemNode ) ;
2016-04-06 02:04:22 +03:00
} ) ;
2016-02-26 20:45:28 +03:00
}
| ]
2016-02-24 19:32:12 +03:00
-- When adding a function, don't forget to add it to 'allJSFunctions'!
2016-03-12 18:03:15 +03:00
escapeJSString :: Text -> Text
escapeJSString s =
2016-06-12 22:35:13 +03:00
T . toStrict $
T . bsingleton '"' <> quote s <> T . bsingleton '"'
2016-03-12 18:03:15 +03:00
where
quote q = case T . uncons t of
2016-06-12 22:35:13 +03:00
Nothing -> T . toBuilder h
Just ( ! c , t' ) -> T . toBuilder h <> escape c <> quote t'
2016-03-12 18:03:15 +03:00
where
( h , t ) = T . break isEscape q
-- 'isEscape' doesn't mention \n, \r and \t because they are handled by
-- the “< '\x20'” case; yes, later 'escape' escapes them differently,
-- but it's irrelevant
isEscape c = c == '\ " ' || c == ' \ \ ' ||
c == '\ x2028' || c == '\ x2029' ||
c < '\ x20'
escape '\ " ' = " \\\ " "
escape '\\ ' = " \ \ \ \ "
escape '\ n' = " \ \ n "
escape '\ r' = " \ \ r "
escape '\ t' = " \ \ t "
escape c
| c < '\ x20' || c == '\ x2028' || c == '\ x2029' =
2016-06-12 22:35:13 +03:00
" \ \ u " <> T . left 4 '0' ( T . hex ( fromEnum c ) )
2016-03-12 18:03:15 +03:00
| otherwise =
2016-06-12 22:35:13 +03:00
T . bsingleton c
2016-03-15 13:10:47 +03:00
newtype JQuerySelector = JQuerySelector Text
2016-06-12 22:35:13 +03:00
deriving ( ToJS , T . Buildable )
2016-03-15 13:10:47 +03:00
selectId :: Text -> JQuerySelector
2016-06-12 22:35:13 +03:00
selectId x = JQuerySelector $ T . format " #{} " [ x ]
2016-03-15 13:10:47 +03:00
2016-04-09 11:13:26 +03:00
selectUid :: Uid Node -> JQuerySelector
2016-06-12 22:35:13 +03:00
selectUid x = JQuerySelector $ T . format " #{} " [ x ]
2016-03-15 13:10:47 +03:00
selectClass :: Text -> JQuerySelector
2016-06-12 22:35:13 +03:00
selectClass x = JQuerySelector $ T . format " .{} " [ x ]
2016-03-15 13:10:47 +03:00
selectParent :: JQuerySelector -> JQuerySelector
2016-06-12 22:35:13 +03:00
selectParent x = JQuerySelector $ T . format " :has(> {}) " [ x ]
2016-03-15 13:10:47 +03:00
selectChildren :: JQuerySelector -> JQuerySelector -> JQuerySelector
2016-06-12 22:35:13 +03:00
selectChildren a b = JQuerySelector $ T . format " {} > {} " ( a , b )