plugin initialization is now generated by the system

ServerTemplate/package.yaml

@@ -37,6 +37,7 @@ dependencies:
 - ixset
 - acid-state
 - typerep-map
+- threads
 
 library:
   source-dirs: 

ServerTemplate/src/Plugins/Incrementer.hs

@@ -3,33 +3,35 @@ import Control.Concurrent.STM (STM, TQueue, TVar, newTVar, readTVar, writeTVar,
 import Static.ServerTypes
 
 
-data Counter = Counter (TVar Int) --anything you need the runtime to keep track of
+data Incrementer = Incrementer (TVar Int) --anything you need the runtime to keep track of
 
-instance (Plugin Counter) where
-    initPlugin = fmap Counter $ atomically $ newTVar 0
+instance (Plugin Incrementer) where
+    initPlugin = do
+        putStrLn "Initializing incrementer plugin...."
+        fmap Incrementer $ atomically $ newTVar 0
 
 doIncrement :: (Int -> msg) -> Cmd msg
-doIncrement msgf = StateCmd $ \(Counter counter) -> do
+doIncrement msgf = StateCmd $ \(Incrementer counter) -> do
     currN <- atomically $ readTVar counter
     atomically $ writeTVar counter $ currN + 1
     return $ msgf $ currN + 1
 
 doDecrement :: (Int -> msg) -> Cmd msg
-doDecrement msgf = StateCmd $ \(Counter counter) -> do
+doDecrement msgf = StateCmd $ \(Incrementer counter) -> do
     currN <- atomically $ readTVar counter
     atomically $ writeTVar counter $ currN - 1
     return $ msgf $ currN - 1
 
 
 getCounter :: (Int -> msg) -> Cmd msg
-getCounter msgf = StateCmd $ \(Counter counter) -> do
+getCounter msgf = StateCmd $ \(Incrementer counter) -> do
     currN <- atomically $ readTVar counter
     return $ msgf currN
 
 {-type Msg =
     Increment
 
-increment :: Int -> State CounterState Counter
+increment :: Int -> State CounterState Incrementer
 increment n = do
     (currN, state) <- get
     put (currN + n, if currN + n > 10 then False else True)

ServerTemplate/src/Static/Cmd.hs → ServerTemplate/src/Static/Plugins.hs

@@ -1,11 +1,12 @@
-module Static.Cmd where
+module Static.Plugins where
 
 import qualified Plugins.Incrementer
 import Static.ServerTypes
 import qualified Data.TMap as TM
+import Control.Concurrent.Thread (forkIO)
 
 initStateCmds :: IO PluginState
 initStateCmds = do
     let pluginState = TM.empty
-    p1 <- initPlugin :: IO Plugins.Incrementer.Counter
+    (_,p1) <- forkIO $ initPlugin :: IO Plugins.Incrementer.Counter
     return $ TM.insert p1 pluginState

ServerTemplate/src/Static/ServerLogic.hs

@@ -29,7 +29,7 @@ import Static.ServerTypes
 import Static.Encode
 import Static.Decode
 import Static.Init (init)
-import Static.Cmd
+import Static.Plugins
 import Utils.Utils (Result(..))
 import Static.Update (update)
 

elm-haskell-state-diagram.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 2bf7303671731c7892de0f0ac7a948d0f9039a4ea9b6e77f3b9fa749e96e61e6
+-- hash: 4da1eee4b626b7d9120ea74d98b587dd0cc02e543c61b3c890aeeb92abac7423
 
 name:           elm-haskell-state-diagram
 version:        0.1.0.0
@@ -35,6 +35,7 @@ library
       Generate.Dot
       Generate.Helpers
       Generate.OneOf
+      Generate.Plugins
       Generate.Server
       Generate.Standalone
       Generate.Types

src/BlankClientServerSpec.hs

@@ -57,6 +57,7 @@ clientServerApp = (
              ,  []        --extra server types
              ,  csDiagram --client state diagram
              ,  ssDiagram --server state diagram
+             ,  []
              )
 
 clientConnect = ("ClientConnect",[])

src/ClientServerSpec.hs

@@ -81,6 +81,7 @@ clientServerApp = (
              ,  []        --extra server types
              ,  csDiagram --client state diagram
              ,  ssDiagram --server state diagram
+             ,  [Plugin "Incrementer"]
              )
 
 clientConnect = ("ClientConnect",[])

src/FractionSpec.hs

@@ -307,6 +307,7 @@ clientServerApp = (
              ,  [testRGB,fracType,gameState,lobby]        --extra server types
              ,  csDiagram --client state diagram
              ,  ssDiagram --server state diagram
+             ,  []
              )
 
 clientConnect = ("ClientConnect",[])

src/Generate/Dot.hs

@@ -18,7 +18,8 @@ generateDot (startClient
                   ,cExtraT
                   ,sExtraT
                   ,cDiagram
-                  ,sDiagram)= error ""
+                  ,sDiagram
+                  ,plugins)= error ""
     {-let
         replace :: [T.Text] -> [T.Text]
         replace (l1:ls) = ( case lookup l1 swaps of

src/Generate/Helpers.hs

@@ -14,9 +14,9 @@ import                  Data.Time               (getCurrentTime)
 generateHelpers :: FilePath -> [Constructor] -> [Constructor] -> IO ()
 generateHelpers fp cStates sStates = do
     currentTime <- getCurrentTime
-    mapM_ (\(sn,edt) -> writeIfNew (fp </> "server" </> "src" </> "Static" </> "Helpers" </> sn <.> "hs") $ T.unlines $ disclaimer currentTime : [generateHelper True (sn,edt) False]) sStates
-    mapM_ (\(sn,edt) -> writeIfNew (fp </> "client" </> "src" </> "Static" </> "Helpers" </> sn <.> "elm") $ T.unlines $ disclaimer currentTime : [generateHelper False (sn,edt) False]) cStates
-    mapM_ (\(sn,edt) -> writeIfNew (fp </> "client" </> "src" </> "Static" </> "Helpers" </> sn ++ "Model" <.> "elm") $ T.unlines $ disclaimer currentTime : [generateHelper False (sn,edt) True]) cStates
+    mapM_ (\(sn,edt) -> writeIfNew 1 (fp </> "server" </> "src" </> "Static" </> "Helpers" </> sn <.> "hs") $ T.unlines $ disclaimer currentTime : [generateHelper True (sn,edt) False]) sStates
+    mapM_ (\(sn,edt) -> writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Helpers" </> sn <.> "elm") $ T.unlines $ disclaimer currentTime : [generateHelper False (sn,edt) False]) cStates
+    mapM_ (\(sn,edt) -> writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Helpers" </> sn ++ "Model" <.> "elm") $ T.unlines $ disclaimer currentTime : [generateHelper False (sn,edt) True]) cStates
 
 generateHelper :: Bool -> Constructor -> Bool -> T.Text
 generateHelper h (sn,edts) getOnly =

src/Generate/Plugins.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Generate.Plugins where
+
+import qualified Data.Text as T
+import Types
+
+generatePlugins :: [Plugin] -> T.Text
+generatePlugins ps = 
+    let
+        onePlugin n (Plugin name) = T.concat["    (_,rp",T.pack $ show n,") <- forkIO $ (initPlugin :: IO Plugins.",T.pack name,".",T.pack name,")"]
+        oneResult n               = T.concat["    p",T.pack $ show n," <- result =<< rp", T.pack $ show n]
+        return n                  = T.concat["    return $ ",T.concat $ map (\n -> T.concat ["TM.insert p",T.pack $ show n," $ "]) [0..length ps - 1], "TM.empty"]
+    in
+        T.unlines $
+            [
+                "module Static.Plugins where"
+            ,   "import Static.ServerTypes"
+            ,   "import qualified Data.TMap as TM"
+            ,   "import Control.Concurrent.Thread (forkIO, result)\n"
+            ,   T.concat $ map (\(Plugin p) -> T.concat["import qualified Plugins.",T.pack p,"\n"]) ps,""
+            ,   "initStateCmds :: IO PluginState"
+            ,   "initStateCmds = do"
+            ] 
+            ++
+            (map (uncurry onePlugin) $ zip [0..] ps)
+            ++
+            (map oneResult [0..length ps - 1])
+            ++
+            [
+                return $ length ps
+            ]

src/Generate/Server.hs

@@ -17,6 +17,7 @@ import                  Generate.Types
 import                  Generate.OneOf
 import                  Generate.AllOf
 import                  Generate.Helpers
+import                  Generate.Plugins
 import                  System.Directory
 import                  System.FilePath.Posix   ((</>),(<.>))
 import                  Data.Maybe              (mapMaybe,fromMaybe)
@@ -102,6 +103,7 @@ generateServer gsvg onlyStatic fp (startCs
                   ,sExtraTlst
                   ,cDiagram
                   ,sDiagram
+                  ,plugins
                   ) = 
     let
         cExtraTypeMap = M.fromList $ map (\(ElmCustom n a) -> (n,ElmCustom n a)) cExtraTlst
@@ -805,35 +807,35 @@ generateServer gsvg onlyStatic fp (startCs
         unless (null serverOneOfs) $ createDirectoryIfMissing True $ fp </> "server" </> "src" </> "Static" </> "OneOf" 
         unless (null serverAllOfs) $ createDirectoryIfMissing True $ fp </> "server" </> "src" </> "Static" </> "AllOf"
         unless (null clientS2Subs) $ createDirectoryIfMissing True $ fp </> "client" </> "src" </> "userApp" </> "Subs"
-        mapM_ (\n -> writeIfNew (fp </> "server" </> "src" </> "Static" </> "OneOf" </> "OneOf" ++ show n <.> "hs") $ T.concat [disclaimer currentTime, generateOneOf True n]) serverOneOfs
-        mapM_ (\n -> writeIfNew (fp </> "server" </> "src" </> "Static" </> "AllOf" </> "AllOf" ++ show n <.> "hs") $ T.concat [disclaimer currentTime, generateAllOf True n]) serverAllOfs
-        writeIfNew (fp </> "server" </> "src" </> "Static" </> "Types" <.> "hs")  $ T.unlines $ disclaimer currentTime : typesHs
-        writeIfNew (fp </> "server" </> "src" </> "Static" </> "Encode" <.> "hs") $ T.unlines $ disclaimer currentTime : encoderHs
-        writeIfNew (fp </> "server" </> "src" </> "Static" </> "Decode" <.> "hs") $ T.unlines $ disclaimer currentTime : decoderHs
-        writeIfNew (fp </> "server" </> "src" </> "Static" </> "Update" <.> "hs") $ T.unlines $ disclaimer currentTime : hiddenUpdateHs
-        writeIfNew (fp </> "server" </> "src" </> "Static" </> "Init" <.> "hs")   $ T.unlines $ disclaimer currentTime : staticInitHs
+        mapM_ (\n -> writeIfNew 1 (fp </> "server" </> "src" </> "Static" </> "OneOf" </> "OneOf" ++ show n <.> "hs") $ T.concat [disclaimer currentTime, generateOneOf True n]) serverOneOfs
+        mapM_ (\n -> writeIfNew 1 (fp </> "server" </> "src" </> "Static" </> "AllOf" </> "AllOf" ++ show n <.> "hs") $ T.concat [disclaimer currentTime, generateAllOf True n]) serverAllOfs
+        writeIfNew 1 (fp </> "server" </> "src" </> "Static" </> "Types" <.> "hs")  $ T.unlines $ disclaimer currentTime : typesHs
+        writeIfNew 1 (fp </> "server" </> "src" </> "Static" </> "Encode" <.> "hs") $ T.unlines $ disclaimer currentTime : encoderHs
+        writeIfNew 1 (fp </> "server" </> "src" </> "Static" </> "Decode" <.> "hs") $ T.unlines $ disclaimer currentTime : decoderHs
+        writeIfNew 1 (fp </> "server" </> "src" </> "Static" </> "Update" <.> "hs") $ T.unlines $ disclaimer currentTime : hiddenUpdateHs
+        writeIfNew 1 (fp </> "server" </> "src" </> "Static" </> "Init" <.> "hs")   $ T.unlines $ disclaimer currentTime : staticInitHs
         createDirectoryIfMissing True $ fp </> "server" </> "src" </> "userApp" </> "Update"
         unless onlyStatic (do
             mapM_ (\(n,txt) -> writeIfNotExists (fp </> "server" </> "src" </> "userApp" </> "Update" </> n <.> "hs") txt) serverUpdateModules
             writeIfNotExists (fp </> "server" </> "src" </> "userApp" </> "Types" <.> "hs")  $ T.unlines userTypesHs
             writeIfNotExists (fp </> "server" </> "src" </> "userApp" </> "Init" <.> "hs")   $ T.unlines userInitHs)
 
 
-        writeIfNew (fp </> "client" </> "src" </> "Static" </> "Types" <.> "elm") $ T.unlines $ disclaimer currentTime : typesElm
-        writeIfNew (fp </> "client" </> "src" </> "Static" </> "ExtraUserTypes" <.> "elm") $ T.unlines $ disclaimer currentTime : extraUserTypesElm
+        writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Types" <.> "elm") $ T.unlines $ disclaimer currentTime : typesElm
+        writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "ExtraUserTypes" <.> "elm") $ T.unlines $ disclaimer currentTime : extraUserTypesElm
         --TIO.writeFile (fp </> "client" </> "app" </> "Main" <.> "elm") $ T.unlines $ disclaimer currentTime : [if gsvg then mainElmGSVG else mainElm]
-        writeIfNew (fp </> "client" </> "src" </> "Static" </> "Encode" <.> "elm")      $ T.unlines $ disclaimer currentTime : encoderElm
-        writeIfNew (fp </> "client" </> "src" </> "Static" </> "Decode" <.> "elm")      $ T.unlines $ disclaimer currentTime : decoderElm
-        writeIfNew (fp </> "client" </> "src" </> "Static" </> "Update" <.> "elm")      $ T.unlines $ disclaimer currentTime : hiddenUpdateElm
-        writeIfNew (fp </> "client" </> "src" </> "Static" </> "Model" <.> "elm")      $ T.unlines $ disclaimer currentTime : modelElm
-        writeIfNew (fp </> "client" </> "src" </> "Static" </> "Msg" <.> "elm")      $ T.unlines $ disclaimer currentTime : msgElm
-        writeIfNew (fp </> "client" </> "src" </> "Static" </> "Init" <.> "elm")      $ T.unlines $ disclaimer currentTime : staticInitElm
-        writeIfNew (fp </> "client" </> "src" </> "Static" </> "View" <.> "elm")      $ T.unlines $ disclaimer currentTime : [hiddenClientView]
-        writeIfNew (fp </> "client" </> "src" </> "Static" </> "Subs" <.> "elm")      $ T.unlines $ disclaimer currentTime : hiddenSubsElm
+        writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Encode" <.> "elm")      $ T.unlines $ disclaimer currentTime : encoderElm
+        writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Decode" <.> "elm")      $ T.unlines $ disclaimer currentTime : decoderElm
+        writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Update" <.> "elm")      $ T.unlines $ disclaimer currentTime : hiddenUpdateElm
+        writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Model" <.> "elm")      $ T.unlines $ disclaimer currentTime : modelElm
+        writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Msg" <.> "elm")      $ T.unlines $ disclaimer currentTime : msgElm
+        writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Init" <.> "elm")      $ T.unlines $ disclaimer currentTime : staticInitElm
+        writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "View" <.> "elm")      $ T.unlines $ disclaimer currentTime : [hiddenClientView]
+        writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Subs" <.> "elm")      $ T.unlines $ disclaimer currentTime : hiddenSubsElm
 
-        mapM_ (\(n,txt) -> writeIfNew (fp </> "client" </> "src" </> "Static" </> "Wrappers" </> n <.> "elm") $ T.concat [disclaimer currentTime, "\n", txt]) clientWrapModules
+        mapM_ (\(n,txt) -> writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Wrappers" </> n <.> "elm") $ T.concat [disclaimer currentTime, "\n", txt]) clientWrapModules
         createDirectoryIfMissing True $ fp </> "client" </> "src" </> "Static" </> "Types"
-        mapM_ (\(n,txt) -> writeIfNew (fp </> "client" </> "src" </> "Static" </> "Types" </> n <.> "elm") $ T.concat [disclaimer currentTime, "\n", txt]) clientTypeModules
+        mapM_ (\(n,txt) -> writeIfNew 1 (fp </> "client" </> "src" </> "Static" </> "Types" </> n <.> "elm") $ T.concat [disclaimer currentTime, "\n", txt]) clientTypeModules
 
 
         unless onlyStatic (do
@@ -849,5 +851,6 @@ generateServer gsvg onlyStatic fp (startCs
         createDirectoryIfMissing True $ fp </> "server" </> "src" </> "Static" </> "Helpers"
         createDirectoryIfMissing True $ fp </> "client" </> "src" </> "Static" </> "Helpers"
         generateHelpers fp (M.elems cStates) sStateslst
+        writeIfNew 0 (fp </> "server" </> "src" </> "Static" </> "Plugins" <.> "hs") $ generatePlugins plugins
 
         print serverTransitions

src/Types.hs

@@ -72,4 +72,8 @@ type ClientServerApp =
     , ExtraServerTypes        --extra server types used in states or messages
     , ClientStateDiagram    --the client state diagram
     , ServerStateDiagram    --the client state diagram
-    )
+    , [Plugin]              --a list of plugins to be installed
+    )
+
+data Plugin = 
+    Plugin String

src/Utils.hs

@@ -40,8 +40,8 @@ writeIfNotExists fp txt = do
     unless exists $ TIO.writeFile fp txt
 
 -- write the file if more than one line (the date line) has changed
-writeIfNew :: FilePath -> T.Text -> IO ()
-writeIfNew fp txt = do
+writeIfNew :: Int -> FilePath -> T.Text -> IO ()
+writeIfNew n fp txt = do
     exists <- doesFileExist fp
     if not exists then do
             Prelude.putStrLn $ fp ++ " exists:" ++ show exists
@@ -50,7 +50,7 @@ writeIfNew fp txt = do
             currentLines <- return . T.lines =<< TIO.readFile fp
             let diffLines = filter (\(a,b) -> a /= b) $ zipWithDefault "" "" currentLines (T.lines txt)
             Prelude.putStrLn $ "Differences in " ++ fp ++ " : " ++ show (length diffLines)
-            if length diffLines > 1 then
+            if length diffLines > n then
                 TIO.writeFile fp txt
             else
                 return ()