[migrate from HJscript to JMacro
Jeremy Shaw <jeremy@seereason.com>**20110707203444
 Ignore-this: ca5ca6934bdf119b0faa95c5786215bf
] hunk ./ConfigT.hs 6
+import Control.Monad.State
hunk ./ConfigT.hs 43
+
+instance (Monad m, MonadConfig m) => MonadConfig (StateT s m) where
+    type ConfigType (StateT s m) = ConfigType m
+    askConfig      = lift askConfig
+    localConfig f  = mapStateT (localConfig f)
+
+    
hunk ./Pages/AppTemplate.hs 8
-import HJScript
hunk ./Pages/AppTemplate.hs 56
-                   
-
-embedScript :: (XMLGenerator m) => HJScript () -> GenChildList m
-embedScript b =
-  asChild $
-    <script type="text/javascript">
-      <% show b %>
-    </script>
hunk ./Pages/Board.hs 1
-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, TypeFamilies, QuasiQuotes #-}
hunk ./Pages/Board.hs 21
-import HJScript.DOM (Node, alert, document, window)
-import HJScript.Utils ()
-import HJScript hiding ((<|>))
-import HJScript.Objects.JQuery hiding (submit)
hunk ./Pages/Board.hs 23
+import HSX.JMacro
+import Language.Javascript.JMacro
hunk ./Pages/Board.hs 43
-                mediaJS <- imageToggles media
-                let script = embedScript (ready' mediaJS)
+                script <- genOnReady media
hunk ./Pages/Board.hs 191
+{-
+window.jQuery(document).ready(
+  function () {
+      window.jQuery('#medium_0').toggle( function (){window.jQuery(this).attr('src','/web/images/0/full/0_82t00g2.jpg');}
+                                       , function (){window.jQuery(this).attr('src','/web/images/0/thumbnail/t_0_82t00g2.jpg');}
+                                       );
+  }
+);
+-}
hunk ./Pages/Board.hs 201
-imageToggleJS :: (WebURL ~ URL m, ShowURL m, Monad m) => Medium -> m (HJScript (Exp JQuery))
-imageToggleJS img@Image{} =
-    do fullURL      <- showURL (W_Image (mediumId img) FullSize (storedName img))
-       thumbnailURL <- showURL (W_Image (mediumId img) Thumbnail ("t_" ++ storedName img))
-       return $ itjs (mediumId img) fullURL thumbnailURL
+onReady :: [(String, String, String)] -> JStat
+onReady images =
+    [$jmacro|
+      fun makeToggle id full thumbnail {
+                $(id).toggle( function () { $(this).attr('src', full) }
+                            , function () { $(this).attr('src', thumbnail) }
+                            );
+      }
+      $(document).ready ( 
+        function () {
+          var imgs = `(images)`;
+          for (var i = 0; i < imgs.length; i++) {
+                    makeToggle(imgs[i][0],imgs[i][1],imgs[i][2]);
+                  }
+        } 
+       );
+    |]
hunk ./Pages/Board.hs 219
-jSetAttr :: (JString, JString) -> JObject JQuery -> JObject JQuery
-jSetAttr = methodCall "attr"
-
-toggle2 :: (Exp (() -> ()), Exp (() -> ())) -> Exp JQuery -> Exp JQuery
-toggle2 = callMethod "toggle"
-
-
-itjs :: MediumId -> String -> String -> HJScript (Exp JQuery)
-itjs mediumId fullURL thumbnailURL = 
-    do full  <- procedure $ \() -> runExp $ selectExpr (this :: JObject Node) # jSetAttr (string "src", string fullURL)
-       thumb <- procedure $ \() -> runExp $ selectExpr (this :: JObject Node) # jSetAttr (string "src", string thumbnailURL)
-       return $ selectExpr (string $ "#medium_" ++ show (unMediumId mediumId)) # toggle2 (full, thumb)
-
-imageToggles :: (WebURL ~ URL m, ShowURL m, Monad m) => [Medium] -> m (HJScript ())
-imageToggles media =
-    do js <- mapM imageToggleJS media
-       return $ mapM_ (runExp =<<) js
-
-ready' :: HJScript () -> HJScript ()
-ready' script
-    = do fn <- procedure $ \() -> script
-         runExp $ selectExpr document # readyFn fn
-
-readyFn :: Exp (() -> ()) -> JObject JQuery -> Exp ()
-readyFn = methodCall "ready"
+genOnReady :: [Medium] -> Server JStat
+genOnReady mediums =
+    do fullURL      <- mapM (\img -> showURL (W_Image (mediumId img) FullSize (storedName img))) mediums
+       thumbnailURL <- mapM (\img -> showURL (W_Image (mediumId img) Thumbnail ("t_" ++ storedName img))) mediums
+       let ids = map (\m -> "#medium_" ++ show (unMediumId (mediumId m))) mediums
+       return $ onReady $ zipWith3 (,,) ids fullURL thumbnailURL
hunk ./Server.hs 1
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies, TypeSynonymInstances #-}
hunk ./Server.hs 5
+import Control.Monad.Reader
+import Control.Monad.State
hunk ./Server.hs 13
+import HSX.JMacro
hunk ./Server.hs 24
-                     , acid       :: AcidState State
+                     , acid       :: AcidState BoardState
hunk ./Server.hs 27
-type Server = RouteT WebURL (ServerPartT (ConfigT Config IO))
+type Server = RouteT WebURL (ServerPartT (StateT Integer (ConfigT Config IO)))
hunk ./Server.hs 29
+instance IntegerSupply Server where
+    nextInteger = nextInteger'
hunk ./Server.hs 32
-query :: (ConfigType m ~ Config, MonadIO m, MonadConfig m, QueryEvent ev, MethodState ev ~ State) => ev -> m (EventResult ev)
+toServerPartT :: (Monad m) => Config -> ServerPartT (StateT Integer (ConfigT Config m)) a -> ServerPartT m a
+toServerPartT config = mapServerPartT f
+    where
+      f m = runReaderT (runConfigT (evalStateT m 0)) config
+
+query :: (ConfigType m ~ Config, MonadIO m, MonadConfig m, QueryEvent ev, MethodState ev ~ BoardState) => ev -> m (EventResult ev)
hunk ./Server.hs 42
-update :: (ConfigType m ~ Config, MonadIO m, MonadConfig m, UpdateEvent ev, MethodState ev ~ State) => ev -> m (EventResult ev)
+update :: (ConfigType m ~ Config, MonadIO m, MonadConfig m, UpdateEvent ev, MethodState ev ~ BoardState) => ev -> m (EventResult ev)
hunk ./State.hs 36
-        State { boards = IxSet.fromList [ Board { boardId = BoardId 0
-                                                , name = Text.pack "lambdacats"
-                                                , abbrev = Text.pack "l"
-                                                }
-                                        , Board { boardId = BoardId 1
-                                                , name = Text.pack "codez"
-                                                , abbrev = Text.pack "c"
-                                                }
-                                        , Board { boardId = BoardId 2
-                                                , name = Text.pack "lambdagrrlz"
-                                                , abbrev = Text.pack "s"
-                                                }
-                                        ]
-              , threads      = IxSet.empty
-              , nextPostId   = (PostId 0)
-              , media        = IxSet.empty
-              , nextMediumId = (MediumId 0)
-              , accounts     = Map.fromList [("admin",     (Password (Salt "aoeu") (doHash (Salt "aoeu") "foobar"), Admin))
-                                            ,("moderator", (Password (Salt "asdf") (doHash (Salt "asdf") "barbaz"), Moderator))
-                                            ]
-              }
+        BoardState { boards = IxSet.fromList [ Board { boardId = BoardId 0
+                                                     , name = Text.pack "lambdacats"
+                                                     , abbrev = Text.pack "l"
+                                                     }
+                                             , Board { boardId = BoardId 1
+                                                     , name = Text.pack "codez"
+                                                     , abbrev = Text.pack "c"
+                                                     }
+                                             , Board { boardId = BoardId 2
+                                                     , name = Text.pack "lambdagrrlz"
+                                                     , abbrev = Text.pack "s"
+                                                     }
+                                             ]
+                   , threads      = IxSet.empty
+                   , nextPostId   = (PostId 0)
+                   , media        = IxSet.empty
+                   , nextMediumId = (MediumId 0)
+                   , accounts     = Map.fromList [("admin",     (Password (Salt "aoeu") (doHash (Salt "aoeu") "foobar"), Admin))
+                                                 ,("moderator", (Password (Salt "asdf") (doHash (Salt "asdf") "barbaz"), Moderator))
+                                                 ]
+                   }
hunk ./State.hs 71
-getPostId :: Update State PostId
+getPostId :: Update BoardState PostId
hunk ./State.hs 78
-getMediumId :: Update State MediumId
+getMediumId :: Update BoardState MediumId
hunk ./State.hs 85
-addMedium :: Medium -> Update State Bool
+addMedium :: Medium -> Update BoardState Bool
hunk ./State.hs 94
-askMedium :: MediumId -> Query State (Either InvalidId Medium)
+askMedium :: MediumId -> Query BoardState (Either InvalidId Medium)
hunk ./State.hs 102
-newPost :: UTCTime -> Maybe Text -> Maybe String -> Maybe Text -> Maybe Medium -> Text -> Update State Post
+newPost :: UTCTime -> Maybe Text -> Maybe String -> Maybe Text -> Maybe Medium -> Text -> Update BoardState Post
hunk ./State.hs 118
-addThread :: Thread -> Update State ()
+addThread :: Thread -> Update BoardState ()
hunk ./State.hs 122
-newThread :: UTCTime -> BoardName -> Maybe Text -> Maybe String -> Maybe Text -> Maybe Medium -> Text -> Update State (Either InvalidBoard Thread)
+newThread :: UTCTime -> BoardName -> Maybe Text -> Maybe String -> Maybe Text -> Maybe Medium -> Text -> Update BoardState (Either InvalidBoard Thread)
hunk ./State.hs 133
-replyThread :: UTCTime -> ThreadId -> Maybe Text -> Maybe String -> Maybe Text -> Maybe Medium -> Text -> Update State (Either InvalidId Post)
+replyThread :: UTCTime -> ThreadId -> Maybe Text -> Maybe String -> Maybe Text -> Maybe Medium -> Text -> Update BoardState (Either InvalidId Post)
hunk ./State.hs 148
-getThreads :: Int -> BoardName -> Query State (Either InvalidBoard ([Thread], Int))
+getThreads :: Int -> BoardName -> Query BoardState (Either InvalidBoard ([Thread], Int))
hunk ./State.hs 159
-getThread :: ThreadId -> Query State (Either InvalidId Thread)
+getThread :: ThreadId -> Query BoardState (Either InvalidId Thread)
hunk ./State.hs 166
-boardNameToId :: (MonadState State m) => BoardName -> m (Maybe BoardId)
+boardNameToId :: (MonadState BoardState m) => BoardName -> m (Maybe BoardId)
hunk ./State.hs 171
-askBoards :: Query State Boards
+askBoards :: Query BoardState Boards
hunk ./State.hs 178
-checkPassword :: String -> String -> Query State (Either InvalidLogin Role)
+checkPassword :: String -> String -> Query BoardState (Either InvalidLogin Role)
hunk ./State.hs 186
-$(makeAcidic ''State
+$(makeAcidic ''BoardState
hunk ./State.hs 198
-saveImage :: (MonadIO m) => AcidState State -> FilePath -> FilePath -> FilePath -> m Medium
+saveImage :: (MonadIO m) => AcidState BoardState -> FilePath -> FilePath -> FilePath -> m Medium
hunk ./State.hs 224
-requestFilteredImage :: (Functor m, MonadIO m) => AcidState State -> IOThread (Medium, Size) FilePath -> MediumId -> Size -> m (Either InvalidId FilePath)
+requestFilteredImage :: (Functor m, MonadIO m) => AcidState BoardState -> IOThread (Medium, Size) FilePath -> MediumId -> Size -> m (Either InvalidId FilePath)
hunk ./Types.hs 96
-data State
-    = State { boards       :: Boards
+data BoardState
+    = BoardState { boards       :: Boards
hunk ./Types.hs 106
-$(deriveSafeCopy 1 'base ''State)
+$(deriveSafeCopy 1 'base ''BoardState)
hunk ./Types.hs 108
-{- 
-instance Version Size
-$(deriveSerialize ''Size)
-instance Version Medium
-$(deriveSerialize ''Medium)
-instance Version Post
-$(deriveSerialize ''Post)
-instance Version Thread
-$(deriveSerialize ''Thread)
-instance Version BoardName
-$(deriveSerialize ''BoardName)
-instance Version Board
-$(deriveSerialize ''Board)
-instance Version Role
-$(deriveSerialize ''Role)
-instance Version State
-$(deriveSerialize ''State)
--}
hunk ./Web.hs 7
+import Control.Monad.State
hunk ./Web.hs 32
-import HJScript.DOM (Node, alert, document, window)
-import HJScript.Utils ()
-import HJScript hiding ((<|>))
-import HJScript.Objects.JQuery hiding (submit)
hunk ./Web.hs 102
-webSpec :: Site WebURL (ServerPartT (ConfigT Config IO) Response)
+webSpec :: Site WebURL (ServerPartT (StateT Integer (ConfigT Config IO)) Response)
hunk ./Web.hs 111
-            , toIO config $ implSite {- (uriToString id (connectURL facebookConfig) "") -} "/" "web/" webSpec
+            , toServerPartT config $ implSite {- (uriToString id (connectURL facebookConfig) "") -} "/" "web/" webSpec
hunk ./Web.hs 113
-
-toIO :: (Monad m) => Config -> ServerPartT (ConfigT Config m) a -> ServerPartT m a
-toIO config = mapServerPartT f
-    where
---      f :: ConfigT m (Maybe (Either Response a, FilterFun Response)) -> m (Maybe (Either Response a, FilterFun Response))
-      f m = runReaderT (runConfigT m) config
hunk ./imageboard.cabal 12
-Library
- Extensions:       MultiParamTypeClasses,
-                   TypeFamilies,
-                   FlexibleContexts,
-                   FlexibleInstances,
-                   TypeSynonymInstances,
-                   OverlappingInstances,
-                   UndecidableInstances
-
- Exposed-Modules:  State,
-                   Types,
-                   Web,
-                   UACCT,
-                   Util
- Build-Depends:    base,
-                   acid-state,
-                   applicative-extras,
-                   bytestring,
-                   directory,
-                   containers,
-                   Extra,
-                   filepath,
-                   formlets,
-                   formlets-hsp,
-                   gd,
-                   happstack,
-                   happstack-extra >= 0.71,
-                   happstack-ixset,
-                   happstack-server,
-                   happstack-util, 
-                   happstack-hsp,
-                   HJScript,
-                   hsx,
-                   hsp,
-                   mtl,
-                   old-locale,
-                   QuickCheck,
-                   network,
-                   random,
-                   safecopy,
-                   text >= 0.5,
-                   time,
-                   web-routes >= 0.25,
-                   web-routes-mtl,
-                   web-routes-happstack,
-                   web-routes-hsp,
-                   utf8-string,
-                   hslogger
-
hunk ./imageboard.cabal 17
+                   acid-state,
hunk ./imageboard.cabal 34
-                   HJScript,
+                   happstack-hsp,
hunk ./imageboard.cabal 36
+                   hsx-jmacro,
hunk ./imageboard.cabal 38
+                   jmacro,
hunk ./imageboard.cabal 44
+                   safecopy,