[fix javascript embedding. simplify some types.
Jeremy Shaw <jeremy@seereason.com>**20110707005718
 Ignore-this: c176074e5f4ec03ef7ef14fdb465eb9c
] hunk ./Web.hs 145
-web ::
-    forall m.
-    ( Functor m
-    , MonadPlus m
-    , MonadIO m
-    , ServerMonad m
-    , FilterMonad Response m
-    , WebMonad Response m
-    , MonadConfig m
-    , HasRqData m
-    )
-    => WebURL -> RouteT WebURL m Response
hunk ./Web.hs 146
+type Server = RouteT WebURL (ServerPartT (ConfigT IO))
+
+embedScript :: (XMLGenerator m) => HJScript () -> GenChildList m
+embedScript b =
+  asChild $
+    <script type="text/javascript">
+      <% show b %>
+    </script>
+
+web :: WebURL -> Server Response
hunk ./Web.hs 162
---                mediaJS <- imageToggles media --  :: RouteT WebURL m [HJScript (Exp JQuery)]
-                toResponse <$> (unXMLGenT $ boardTemplate here (Right (boardName, maxPageNum)) (Text.unpack (unBoardName boardName)) () {- (ready' mediaJS)  -} <% mapM threadHTML threads %>)
+                mediaJS <- imageToggles media
+                let script = embedScript (ready' mediaJS)
+                toResponse <$> (unXMLGenT $ boardTemplate here (Right (boardName, maxPageNum)) (Text.unpack (unBoardName boardName)) script <% mapM threadHTML threads %>)
hunk ./Web.hs 230
-authWeb ::
-    forall m.
-    ( Functor m
-    , MonadPlus m
-    , MonadIO m
-    , ServerMonad m
-    , FilterMonad Response m
-    , WebMonad Response m
-    , HasRqData m
-    , MonadConfig m
-    )
-    => WebURL -> RouteT WebURL m Response
+authWeb :: WebURL -> Server Response
hunk ./Web.hs 324
-    ( Functor m
-    , MonadIO m
-    , MonadPlus m
-    , XMLGenerator m
-    , FilterMonad Response m
-    , WebMonad Response m
-    , ServerMonad m
-    , HasRqData m
-    , EmbedAsChild m headers
-    , EmbedAsChild m body
---    , EmbedAsChild m (HJScript ())
-    , EmbedAsChild m ()
-    , EmbedAsChild m XML
-    , (HSX.XML m) ~ XML
-    , ShowURL m
-    , URL m ~ WebURL
-    , MonadConfig m
-    ) 
-    => WebURL 
+    ( EmbedAsChild Server headers
+    , EmbedAsChild Server body
+    ) =>
+       WebURL 
hunk ./Web.hs 332
-    -> XMLGenT m (HSX.XML m)
+    -> XMLGenT Server XML
hunk ./Web.hs 444
-webSpec ::
-    ( Functor m
-    , MonadPlus m
-    , MonadIO m
-    , ServerMonad m
-    , HasRqData m
-    , FilterMonad Response m
-    , WebMonad Response m
-    , MonadConfig m
-    )
-    => Site WebURL (m Response)
+webSpec :: Site WebURL (ServerPartT (ConfigT IO) Response)
hunk ./Web.hs 462
-{-
-withDataFn' :: 
-    ( Functor m
-    , MonadPlus m
-    , FilterMonad Response m
-    , ServerMonad m
-    , HasRqData m
-    , MonadIO m
-    ) 
-    => RqData a 
-    -> (a -> m Response) 
-    -> m Response
-withDataFn' rqData f =
-    do params <- getDataFn rqData
-       case params of
-         (Left missing) -> 
-             badRequest (toResponse $ "Missing parameters: " ++ show missing)
-         (Right a) -> 
-             f a
--}
-{-
-data JQuery = JQuery deriving Show
-instance IsClass JQuery
hunk ./Web.hs 463
-jQuery :: JString -> Exp JQuery
-jQuery = call (JConst "$")
-
-toggle2 :: (Exp (() -> ()), Exp (() -> ())) -> Exp JQuery -> Exp JQuery
-toggle2 = callMethod "toggle"
-
-ready :: Exp (() -> t) -> Exp JQuery -> HJScript ()
-ready = callVoidMethod "ready"
-{-
-jtest =
-    do f <- procedure $ \() -> window # alert (string "foo")
-       b <- procedure $ \() -> window # alert (string "bar")
-       jQuery (string "img") # toggle2 (f, b)
--}
--- FIXME: type?     
-
-readyFn :: HJScript (Exp t) -> HJScript ()
-readyFn fns =
-    do f <- function $ \() -> fns
-       jQuery(document) # ready (f)
-
--}
hunk ./Web.hs 494
-
-foo :: HJScript ()
-foo =
-    do e <- itjs (MediumId 0) "foo" "bar"
-       runExp e
-       e <- itjs (MediumId 1) "aoeu" "asf"
-       runExp e
---       itjs (MediumId 1) "aoeu" "asdf"
-
-{-
-setAttr :: (Exp a, Exp v) -> Exp JQuery -> HJScript () -- Exp JQueryund
-setAttr = callVoidMethod "attr"
-
--- window # alert (string $ "full: " ++ fullURL ++ " thumbnail: " ++ thumbnailURL)
--}
-{-
-    do medium <- askMedium mediumId
-       case medium of
-p         (Right img@(Image {})) ->
-             do 
-             serveFile (asContentType "image/jpeg") ((storageDir config) </> (storedName img))
-         (Left InvalidId) ->
-             notFound . toResponse =<< (unXMLGenT $ appTemplate "Not Found" () "The image you are looking for does not exist.")
--}
-{-
-imageToggleJS :: ( ShowURL m
-                 , XMLGenerator m
-                 , EmbedAsChild m (HJScript ())
-                 , URL m ~ WebURL) => Medium -> XMLGenT m [HSX.Child m]
-imageToggleJS img@Image{} =
-    do fullURL      <- showURL (W_Image (mediumId img) FullSize (storedName img))
-       thumbnailURL <- showURL (W_Image (mediumId img) Thumbnail ("t_" ++ storedName img))
-       <% window # alert (string "foo") %>
-
-imageToggleJS2 :: ( ShowURL m
-                 , XMLGenerator m
-                 , EmbedAsChild m (HJScript ())
-                 , URL m ~ WebURL) => Medium -> XMLGenT m [HSX.Child m]
--}
-