{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE NoImplicitPrelude #-} -- | The home page script: -- -- 1) Make sure that the language samples are highlighted. -- 2) Add a show/hide button for the JS output on all samples. -- 3) For code samples that are too large, hide them. -- -- Because dogfood. This is not necessarily a good example, indeed, it -- may very well be a very bad example of how to write client -- code. But that's the point, really. Even the quick scripts that -- you'd just whip up in JS should be also done in Fay. Alright? -- module Home (main) where import Language.Fay.FFI import Language.Fay.Prelude -- | Main entry point. main :: Fay () main = do ready (wrap [thedocument]) $ do indentAndHighlight setupExpanders setupTableOfContents -- | Setup highlighting/code re-indenting. indentAndHighlight :: Fay () indentAndHighlight = do samples <- query ".language-javascript" each samples $ \i this -> let sample = wrap [this] in do text <- getText sample setText sample (beautify text 2) setTabReplace hljs " " initHighlightingOnLoad hljs -- | Setup example expanders. setupExpanders :: Fay () setupExpanders = do wrapwidth <- query ".wrap" >>= getWidth examples <- query ".example" each examples $ \i this -> do tr <- getFind (wrap [this]) "tr" left <- getFind tr "td" >>= getFirst addClass left "left" right <- getNext left toggle <- makeElement "Show JavaScript" toggleButton <- return $ do visible <- getIs right ":visible" if visible then do setText toggle "Hide JavaScript" swapClasses toggle "toggle-hide" "toggle-show" else do setText toggle "Show JavaScript" swapClasses toggle "toggle-show" "toggle-hide" setClick toggle $ fadeToggle right $ toggleButton width <- getWidth tr when (width > wrapwidth + 20*wrapwidth/100) $ hide right toggleButton panel <- getFind left ".panel" prepend panel toggle return () -- | Generate a table of contents. setupTableOfContents :: Fay () setupTableOfContents = do toc <- makeElement "

Table of Contents

" query ".subheadline" >>= flip after toc ul <- makeElement "" >>= flip appendTo toc headings <- query "h2" each headings $ \i heading -> let anchor = ("section-" ++ show i) h = wrap [heading] in do -- Make sure the anchor exists at the heading point. attr h "id" anchor -- Make the entry. li <- makeElement "
  • " >>= flip appendTo ul a <- makeElement "" >>= flip appendTo li getText h >>= setText a -- Link up to an anchor. attr a "href" ("#" ++ anchor) -- For the indentation. getTagName heading >>= addClass li -------------------------------------------------------------------------------- -- Window object -- | Console log. print :: (Show a,Foreign a) => a -> Fay () print = foreignFay "console.log" FayNone -- | Pop-up an alert. alert :: String -> Fay () alert = foreignFay "window.alert" FayNone -------------------------------------------------------------------------------- -- DOM data Element instance Foreign Element instance Show Element -- | The document. thedocument :: Element thedocument = foreignValue "window.document" FayNone -- | Get the size of the given jquery array. getTagName :: Element -> Fay String getTagName = foreignPropFay "tagName" FayString -------------------------------------------------------------------------------- -- jQuery data JQuery instance Foreign JQuery instance Show JQuery -- | Make a jQuery object out of an element. wrap :: [Element] -> JQuery wrap = foreignPure "window['jQuery']" FayNone -- | Bind a handler for when the element is ready. ready :: JQuery -> Fay () -> Fay () ready = foreignMethodFay "ready" FayNone -- | Bind a handler for when the element is ready. each :: JQuery -> (Double -> Element -> Fay ()) -> Fay () each = foreignMethodFay "each" FayNone -- | Query for elements. query :: String -> Fay JQuery query = foreignFay "window['jQuery']" FayNone -- | Set the text of the given object. setText :: JQuery -> String -> Fay () setText = foreignMethodFay "text" FayNone -- | Set the text of the given object. attr :: JQuery -> String -> String -> Fay () attr = foreignMethodFay "attr" FayNone -- | Set the click of the given object. setClick :: JQuery -> Fay () -> Fay () setClick = foreignMethodFay "click" FayNone -- | Toggle the visibility of an element, faded. fadeToggle :: JQuery -> Fay () -> Fay () fadeToggle = foreignMethodFay "fadeToggle" FayNone -- | Hide an element. hide :: JQuery -> Fay () hide = foreignMethodFay "hide" FayNone -- | Add a class to the given object. addClass :: JQuery -> String -> Fay () addClass = foreignMethodFay "addClass" FayNone -- | Remove a class from the given object. removeClass :: JQuery -> String -> Fay () removeClass = foreignMethodFay "removeClass" FayNone -- | Swap the given classes on the object. swapClasses :: JQuery -> String -> String -> Fay () swapClasses obj addme removeme = do addClass obj addme removeClass obj removeme -- | Get the text of the given object. getText :: JQuery -> Fay String getText = foreignMethodFay "text" FayString -- | Get the text of the given object. getIs :: JQuery -> String -> Fay Bool getIs = foreignMethodFay "is" FayBool -- | Get the size of the given jquery array. getSize :: JQuery -> Fay Double getSize = foreignPropFay "length" FayNone -- | Get the next of the given object. getNext :: JQuery -> Fay JQuery getNext = foreignMethodFay "next" FayNone -- | Get the first of the given object. getFirst :: JQuery -> Fay JQuery getFirst = foreignMethodFay "first" FayNone -- | Get the find of the given object. getFind :: JQuery -> String -> Fay JQuery getFind = foreignMethodFay "find" FayNone -- | Prepend an element to this one. prepend :: JQuery -> JQuery -> Fay JQuery prepend = foreignMethodFay "prepend" FayNone -- | Append an element /after/ this one. after :: JQuery -> JQuery -> Fay JQuery after = foreignMethodFay "after" FayNone -- | Append an element to this one. append :: JQuery -> JQuery -> Fay JQuery append = foreignMethodFay "append" FayNone -- | Append this to an element. appendTo :: JQuery -> JQuery -> Fay JQuery appendTo = foreignMethodFay "appendTo" FayNone -- | Make a new element. makeElement :: String -> Fay JQuery makeElement = foreignFay "window['jQuery']" FayNone -- | Get the width of the given object. getWidth :: JQuery -> Fay Double getWidth = foreignMethodFay "width" FayNone -------------------------------------------------------------------------------- -- Pretty printing / highlighting -- | Pretty print the given JS code. beautify :: String -- ^ The JS code. -> Double -- ^ The indentation level. -> String -- ^ The reformatted JS code. beautify = foreignPure "$jsBeautify" FayString data Highlighter instance Foreign Highlighter -- | Get the highlighter. hljs :: Highlighter hljs = foreignValue "window['hljs']" FayNone -- | Init syntax highlighting on load. initHighlightingOnLoad :: Highlighter -> Fay () initHighlightingOnLoad = foreignMethodFay "initHighlightingOnLoad" FayNone -- | Init syntax highlighting on load. setTabReplace :: Highlighter -> String -> Fay () setTabReplace = foreignSetProp "tabReplace"