{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, OverloadedStrings, QuasiQuotes, NoImplicitPrelude #-} -- TODO: try to make it more type-safe somehow? module JS where -- General import BasePrelude -- Text import qualified Data.Text as T import Data.Text (Text) -- Formatting and interpolation import qualified Data.Text.Buildable as Format import NeatInterpolation -- Local import Utils -- | Javascript code. newtype JS = JS {fromJS :: Text} deriving (Show, Format.Buildable, Monoid) -- | A concatenation of all Javascript functions defined in this module. allJSFunctions :: JS allJSFunctions = JS . T.unlines . map fromJS $ [ -- Utilities replaceWithData, prependData, appendData, moveNodeUp, moveNodeDown, -- Search search, -- Add methods addLibrary, addCategory, addPro, addCon, -- Render-as-editable methods setCategoryTitleMode, setCategoryNotesMode, setItemInfoMode, setItemTraitsMode, setTraitMode, -- Set methods submitCategoryTitle, submitCategoryNotes, submitTrait, submitItemInfo, -- Other things moveTraitUp, moveTraitDown, deleteTrait ] -- | 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 toJS = JS . tshow instance ToJS Integer where toJS = JS . tshow instance ToJS Int where toJS = JS . tshow -- | 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 instance (ToJS a, ToJS b) => JSParams (a,b) where jsParams (a,b) = [toJS a, toJS b] instance (ToJS a, ToJS b, ToJS c) => JSParams (a,b,c) where jsParams (a,b,c) = [toJS a, toJS b, toJS c] instance (ToJS a, ToJS b, ToJS c, ToJS d) => JSParams (a,b,c,d) where jsParams (a,b,c,d) = [toJS a, toJS b, toJS c, toJS d] {- | 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) {\nreturn 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 = JS $ format "function {}({}) {\n{}}\n" (fName, T.intercalate "," fParams, fDef) -- 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 -> JS $ format "{}({});" (fName, T.intercalate "," (map fromJS (jsParams args))) replaceWithData :: JSFunction a => a replaceWithData = makeJSFunction "replaceWithData" ["node"] [text| return function(data) {$(node).replaceWith(data);}; |] prependData :: JSFunction a => a prependData = makeJSFunction "prependData" ["node"] [text| return function(data) {$(node).prepend(data);}; |] 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); |] search :: JSFunction a => a search = makeJSFunction "search" ["node", "s"] -- TODO: set address bar to “/?query=...” so that the user would be able to -- see/share the search URL [text| $.post("/search", {query: s}) .done(replaceWithData(node)); |] -- | Create a new category. addCategory :: JSFunction a => a addCategory = makeJSFunction "addCategory" ["node", "s"] [text| $.post("/add/category", {content: s}) .done(prependData(node)); |] -- | Add a new library to some category. addLibrary :: JSFunction a => a addLibrary = makeJSFunction "addLibrary" ["node", "catId", "s"] [text| $.post("/add/category/"+catId+"/library", {name: s}) .done(appendData(node)); |] setCategoryTitleMode :: JSFunction a => a setCategoryTitleMode = makeJSFunction "setCategoryTitleMode" ["node", "catId", "mode"] [text| $.get("/render/category/"+catId+"/title", {mode: mode}) .done(replaceWithData(node)); |] {- | Finish category title editing (this happens when you submit the field). This turns the title with the editbox back into a simple text title. -} submitCategoryTitle :: JSFunction a => a submitCategoryTitle = makeJSFunction "submitCategoryTitle" ["node", "catId", "s"] [text| $.post("/set/category/"+catId+"/title", {content: s}) .done(replaceWithData(node)); |] setCategoryNotesMode :: JSFunction a => a setCategoryNotesMode = makeJSFunction "setCategoryNotesMode" ["node", "catId", "mode"] [text| $.get("/render/category/"+catId+"/notes", {mode: mode}) .done(replaceWithData(node)); |] submitCategoryNotes :: JSFunction a => a submitCategoryNotes = makeJSFunction "submitCategoryNotes" ["node", "catId", "s"] [text| $.post("/set/category/"+catId+"/notes", {content: s}) .done(replaceWithData(node)); |] -- | Add a pro to some item. addPro :: JSFunction a => a addPro = makeJSFunction "addPro" ["node", "itemId", "s"] [text| $.post("/add/item/"+itemId+"/pro", {content: s}) .done(appendData(node)); |] -- | Add a con to some item. addCon :: JSFunction a => a addCon = makeJSFunction "addCon" ["node", "itemId", "s"] [text| $.post("/add/item/"+itemId+"/con", {content: s}) .done(appendData(node)); |] setItemInfoMode :: JSFunction a => a setItemInfoMode = makeJSFunction "setItemInfoMode" ["node", "itemId", "mode"] [text| $.get("/render/item/"+itemId+"/info", {mode: mode}) .done(replaceWithData(node)); |] setItemTraitsMode :: JSFunction a => a setItemTraitsMode = makeJSFunction "setItemTraitsMode" ["node", "itemId", "mode"] [text| $.get("/render/item/"+itemId+"/traits", {mode: mode}) .done(replaceWithData(node)); |] setTraitMode :: JSFunction a => a setTraitMode = makeJSFunction "setTraitMode" ["node", "itemId", "traitId", "mode"] [text| $.get("/render/item/"+itemId+"/trait/"+traitId, {mode: mode}) .done(replaceWithData(node)); |] submitTrait :: JSFunction a => a submitTrait = makeJSFunction "submitTrait" ["node", "itemId", "traitId", "s"] [text| $.post("/set/item/"+itemId+"/trait/"+traitId, {content: s}) .done(replaceWithData(node)); |] submitItemInfo :: JSFunction a => a submitItemInfo = makeJSFunction "submitItemInfo" ["node", "itemId", "form"] [text| $.post("/set/item/"+itemId+"/info", $(form).serialize()) .done(replaceWithData(node)); |] moveTraitUp :: JSFunction a => a moveTraitUp = makeJSFunction "moveTraitUp" ["itemId", "traitId", "traitNode"] [text| $.post("/move/item/"+itemId+"/trait/"+traitId, {direction: "up"}); moveNodeUp(traitNode); |] moveTraitDown :: JSFunction a => a moveTraitDown = makeJSFunction "moveTraitDown" ["itemId", "traitId", "traitNode"] [text| $.post("/move/item/"+itemId+"/trait/"+traitId, {direction: "down"}); moveNodeDown(traitNode); |] deleteTrait :: JSFunction a => a deleteTrait = makeJSFunction "deleteTrait" ["itemId", "traitId", "traitNode", "traitText"] [text| if (confirm("Confirm deletion: “"+traitText+"”")) { $.post("/delete/item/"+itemId+"/trait/"+traitId); $(traitNode).remove(); } |] -- When adding a function, don't forget to add it to 'allJSFunctions'!