stdio works now sort of

GypsFulvus.cabal

@@ -14,7 +14,7 @@ cabal-version:       >=1.10
 extra-source-files:  README.md
 
 library
-         exposed-modules: GypsFulvus
+         exposed-modules: GypsFulvus, Carrion.Plugin.IO.STDIO
          other-modules:   GypsFulvus.PluginStuff
          default-language:    Haskell2010
          hs-source-dirs:      src
@@ -33,6 +33,8 @@ library
             -threaded
             -with-rtsopts=-N
             -g
+            -keep-o-files
+            -keep-hi-files
 
 executable GypsFulvus
          default-language:    Haskell2010
@@ -51,6 +53,31 @@ executable GypsFulvus
             -threaded
             -with-rtsopts=-N
             -g
+            -keep-o-files
+            -keep-hi-files
          hs-source-dirs:      src
-         other-modules: GypsFulvus, GypsFulvus.PluginStuff
+         other-modules: GypsFulvus.PluginStuff,GypsFulvus, Carrion.Plugin.IO.STDIO
+         exposed-modules: GypsFulvus
          main-is:             Main.hs
+
+executable Test-Carrion-Plugin-IO-STDIO
+           hs-source-dirs: src
+           main-is: Test-STDIO-Haskeline.hs
+           other-modules: Carrion.Plugin.IO.STDIO, GypsFulvus.PluginStuff
+           build-depends:       base >= 4.7 && < 5,
+                                stm,
+                                text >= 1.2.4.0,
+                                unix,
+                                haskeline,
+                                plugins,
+                                directory,
+                                containers,
+                                hashable,
+                                monad-parallel
+           default-language:    Haskell2010
+--           ld-options: -static
+           ghc-options:
+            -O2
+            -threaded
+            -with-rtsopts=-N
+            -g

src/Carrion/Plugin/IO/STDIO.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Carrion.Plugin.IO.STDIO
+    ( initPlugin,
+      processCommand,
+      testThing,
+      tellCommands,
+    ) where
+import Control.Monad.IO.Class
+import Control.Monad
+import Control.Concurrent(forkIO)
+import Control.Concurrent.STM
+import qualified Data.Text as T
+import GypsFulvus.PluginStuff(Manhole(..),Sewage(..), InitStatus(..),SewageAutorInfo(..),genericAutorToNSAutor,inspectManhole,regift, stripCommandPrefix')
+import System.Console.Haskeline
+import Data.Maybe
+import qualified Data.List as L
+import Prelude hiding ((++))
+
+a ++ b = T.append a b
+testThing = runInputT defaultSettings loop
+   where
+       loop :: InputT IO ()
+       loop = do
+           minput <- getInputLine "% "
+           case minput of
+               Nothing -> return ()
+               Just "quit" -> return ()
+               Just input -> do outputStrLn $ T.unpack ("Input was: " ++ T.pack input)
+                                loop
+mySignature = GenericStyleAutor "STDIO haskeline" "local" "local"
+tellCommands = [""]
+
+stripCommandLocal c m = stripCommandPrefix' c tellCommands m mySignature
+initPlugin :: Manhole -> IO InitStatus
+initPlugin manhole = do
+  
+  forkIO $ rEPL manhole
+  return GoodInitStatus
+
+processCommand = undefined
+
+processUserInputs = undefined
+processCommandResults = undefined
+
+rEPL manhole = do
+  let getInputs = runInputT defaultSettings loop
+      fuku :: InputT IO ()
+      fuku = do
+        aresult <- liftIO (inspectManhole manhole)
+        outputStrLn $ T.unpack . getSewage $ aresult
+        fuku
+      loop :: InputT IO ()
+      loop = do
+           minput <- getInputLine "% "
+           case minput of
+               Nothing -> return ()
+               Just "quit" -> return ()
+               Just input -> do liftIO $ regift (Sewage mySignature (T.pack input)) manhole
+                                loop
+      getResults = runInputT defaultSettings fuku      
+  forkIO $ getInputs
+  forkIO $ getResults
+  return ()

src/GypsFulvus.hs

@@ -1,4 +1,5 @@
-module GypsFulvus(execMain, Manhole(..), Sewage(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor, regift,stripCommandPrefix',inspectManhole) where
+{-# LANGUAGE OverloadedStrings #-}
+module GypsFulvus(execMain) where
 import Control.Concurrent.STM
 import Control.Concurrent.STM.TMVar
 import Control.Concurrent.STM.TChan
@@ -6,28 +7,27 @@ import System.Directory
 import qualified Data.Text as T
 import Control.Concurrent(ThreadId, forkIO, killThread)
 import GypsFulvus.PluginStuff
-import Control.Monad(liftM,filterM)
+import Control.Monad(liftM,filterM,forever)
 import Control.Monad.IO.Class
 import qualified Data.Map.Strict as M
 import Data.Hashable
 import qualified Control.Monad.Parallel as Par
 import System.Plugins.Load
+import qualified Carrion.Plugin.IO.STDIO as CPISTDIO
+import Prelude hiding ((++),putStrLn)
+import Data.Text.IO(putStrLn)
 data Placeholder = Placeholder
 data CommandMap = CommandMap (M.Map T.Text Placeholder)
 data CommandWorkspace = CommandWorkspace Placeholder
 data Sewer = Sewer {getSewerMap :: M.Map Int Manhole}
+a ++ b = T.append a b
 
 
-srcPluginPath :: IO FilePath
+sharedDataPath :: IO FilePath
-srcPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute
+sharedDataPath = getXdgDirectory XdgData "gypsfulvus" >>= makeAbsolute
-binPluginPath :: IO FilePath
-binPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute
-
-ioBinPluginPath :: IO FilePath
-ioBinPluginPath = getXdgDirectory XdgData "gypsfulvus/binplugins/io" >>= makeAbsolute
 
 configPath :: IO FilePath
-configPath = getXdgDirectory XdgConfig "gypsfulvus"
+configPath = getXdgDirectory XdgConfig "gypsfulvus" >>= makeAbsolute
 
 
 
@@ -42,6 +42,7 @@ assCallbackWithManholeInSewer sewer callback_name callback_manhole = do
   putTMVar sewer $ newSewer
   return sewer
 
+lookupManholeInSewer :: TMVar(Sewer) -> T.Text -> STM (Maybe Manhole)
 lookupManholeInSewer s p = do
   s_l <- readTMVar s
   return $ M.lookup (hash p) (getSewerMap s_l)
@@ -56,35 +57,28 @@ collectInputs collectorChannel availableCommandMap sharedCommandWorkspace shared
 -- load all the routines that the bot can run (e.g. run tcl code, calculator, youtube, etc.)
 loadLabourPlugins availableCommandMap = undefined
 -- thread to pass any work to be done
+corePlugName :: T.Text
+corePlugName = "core"
 
-
+runForever :: TMVar Sewer -> IO ()
-runForever :: TMVar Bool -> IO ()
+runForever s =
-runForever diediedie =
   let block = do
-        canaryDead <- readTMVar diediedie
+                mh <- lookupManholeInSewer s corePlugName
-        if (canaryDead) then
+                case mh of
-          return canaryDead
+                  Just mh' -> readTChan $ getInputChan mh'
-        else
+                  Nothing -> retry
-          retry
+  in forever $ do
-  in atomically block >>= \isDone ->
+       someGarbage <- atomically block
-      if (isDone) then putStrLn "Exiting cleanly." else error "I escaped my eternal prison somehow." -- it shouldn't be possible for the else to be reached unless something melts down
+       let theAutor = show $ getSewageAutor someGarbage
+       putStrLn $ (T.pack theAutor) ++ " sez:"
+       putStrLn $ getSewage someGarbage
 registerComms = undefined
 
 listDirectory' = listDirectory
   
-loadIOBackends :: TMVar (Sewer) -> IO ()
-loadIOBackends sewer = do
-  potentialPlugins <- do
-    pp <- ioBinPluginPath
-    xs <- listDirectory pp
-    xs' <- filterM (\sd -> doesDirectoryExist (pp ++ "/" ++ sd)) xs
-    Par.mapM (\sind -> return $ ((pp ++ "/" ++ sind), sind)) xs'
-  Par.mapM (\(pp,sd) -> tryRegisterIOPlugin sewer pp sd) potentialPlugins
-  return ()
-  
 makeInputManhole :: TMVar(Sewer) -> String -> IO (Maybe Manhole)
 makeInputManhole s p = do
-  coreManhole <- atomically $ lookupManholeInSewer s "core"
+  coreManhole <- atomically $ lookupManholeInSewer s corePlugName
   case coreManhole of
     Just cm -> do
       coreInputChan <- return $ getInputChan cm
@@ -92,26 +86,26 @@ makeInputManhole s p = do
       return $ Just $ Manhole pluginInputChan coreInputChan
     Nothing -> return Nothing
 
-tryRegisterIOPlugin :: TMVar(Sewer) -> FilePath -> String -> IO InitStatus
+tryRegisterIOPlugin :: TMVar(Sewer) -> IO InitStatus
-tryRegisterIOPlugin s pp pn = do
+tryRegisterIOPlugin s = do
-  im <- makeInputManhole s pn
+  let plugName = "STDIO"
+  im <- makeInputManhole s plugName
   case im of
     Just im' -> do
---      let  initPluginLoad :: IO ( LoadStatus Module (Manhole -> IO InitStatus))
+      stdioModuleStatus <- CPISTDIO.initPlugin im'
-      putStrLn $ pp ++ "/" ++ pn ++ ".o"
+      case stdioModuleStatus of
-      initPluginLoad <- load_ (pp ++ "/" ++ pn ++ ".o") ["/usr/lib","/usr","/home/pszczola/.stack","/home/pszczola/.stack/programs/x86_64-linux/ghc-tinfo6-8.8.4/lib/ghc-8.8.4/base-4.13.0.0","/home/pszczola/.stack/programs/x86_64-linux/ghc-tinfo6-8.8.4/lib/ghc-8.8.4/base-4.13.0.0","/home/pszczola/.stack/programs/x86_64-linux/ghc-tinfo6-8.8.4/lib/ghc-8.8.4/haskeline-0.7.5.0/","/home/pszczola/.stack/programs/x86_64-linux/ghc-tinfo6-8.8.4/lib/ghc-8.8.4/haskeline-0.7.5.0/libHShaskeline-0.7.5.0-ghc8.8.4.so","/home/pszczola/.stack/snapshots/x86_64-linux-tinfo6/edde100bf8de6cb65f105b56e08069dfa3348c9270d546adc9aa73e98e3c573a/8.8.4/lib/x86_64-linux-ghc-8.8.4/","/home/pszczola/.stack/snapshots/x86_64-linux-tinfo6/edde100bf8de6cb65f105b56e08069dfa3348c9270d546adc9aa73e98e3c573a/8.8.4/lib/x86_64-linux-ghc-8.8.4/lib/","/home/pszczola/.stack/snapshots/x86_64-linux-tinfo6/edde100bf8de6cb65f105b56e08069dfa3348c9270d546adc9aa73e98e3c573a/8.8.4/lib/x86_64-linux-ghc-8.8.4/haskeline-0.8.1.0-2IMMl1Qcetx8pSusZdUu4N/"] "initPlugin"
+        GoodInitStatus -> do
-      case initPluginLoad of
+          atomically $ assCallbackWithManholeInSewer s plugName im'
-        LoadSuccess m sym -> putStrLn "loaded symbol initPlugin for pn"
+          return GoodInitStatus
-        LoadFailure e -> mapM putStrLn e >> return ()
+        BadInitStatus errs -> return $ BadInitStatus $ "couldn't load stdio plugin: " ++ errs
---      initPlugin <- initPluginLoad
-      atomically $ assCallbackWithManholeInSewer s pn im'
-      return GoodInitStatus
     Nothing -> return $ BadInitStatus $ T.pack "Catastrophic failure - core ejected."
 loadCoreCommands = undefined
 
 makeNewSewer coreManhole = do
+  let
+    plugName = "core"
   emptySewer <- atomically $ newTMVar $ Sewer M.empty
-  atomically $ assCallbackWithManholeInSewer (emptySewer) "core" coreManhole
+  atomically $ assCallbackWithManholeInSewer (emptySewer) corePlugName coreManhole
   
 
 execMain :: IO ()
@@ -119,7 +113,7 @@ execMain = do
   collectorChannel <- atomically newTChan -- normal channel for dumping any user input, this is the output channel for all plugins
   dumperChannel <- atomically newTChan -- uh this doesnt make any sense, every dings needs to have its own channel
   newSewer <- makeNewSewer $ Manhole collectorChannel dumperChannel
-  loadIOBackends newSewer
+  tryRegisterIOPlugin newSewer
   canary <- atomically $ newTMVar False -- simple 'should I exit' canary
   
 --  forkIO $ loadCommsPlugins canary collectorChannel
@@ -133,7 +127,7 @@ execMain = do
 --  collectorTID <- forkIO $ collectInputs collectorChannel availableCommandMap sharedCommandWorkspace sharedTaskQueue
 --  myTIDs = [dispatchTID,broadcastTID,collectorTID] 
   let myTIDs  = []
-  runForever canary
+  runForever newSewer
   mapM_ killThread myTIDs
 
 

src/Test-STDIO-Haskeline.hs

@@ -0,0 +1,19 @@
+module Main
+where
+import Carrion.Plugin.IO.STDIO
+import GypsFulvus.PluginStuff
+import Control.Concurrent.STM
+import Control.Concurrent.STM.TChan
+import Control.Monad
+import qualified Data.Text as T
+main :: IO ()
+main = do
+  inchan <- atomically $ newTChan
+  outchan <- atomically $ newTChan
+  let mymanhole = Manhole inchan outchan
+  initPlugin mymanhole
+  let testCommand = Sewage (GenericStyleAutor (T.pack "Test Bin") (T.pack "local") (T.pack "local")) (T.pack "inspect inspect")
+  atomically $ writeTChan inchan testCommand
+  forever $ do
+    newstuff <- atomically $ readTChan outchan
+    putStrLn $ "Backend " ++ (show $ getSewageAutor newstuff) ++ " returned " ++ (T.unpack $ getSewage newstuff)

stack.yaml

@@ -37,6 +37,8 @@ packages:
 extra-deps:
   - git: git@github.com:v-e-h/plugins.git
     commit: e175d3c2ea9a8cc08126d37d9e30a327d8dc8b29
+  - haskeline-0.8.1.0
+
 # - acme-missiles-0.3
 # - git: https://github.com/commercialhaskell/stack.git
 #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a

stack.yaml.lock

@@ -18,6 +18,13 @@ packages:
   original:
     git: git@github.com:v-e-h/plugins.git
     commit: e175d3c2ea9a8cc08126d37d9e30a327d8dc8b29
+- completed:
+    hackage: haskeline-0.8.1.0@sha256:6a6158c90b929ce7aa5331ff5e9819aa32c7df8f4a7ba324b3cc055ee96b48cb,5818
+    pantry-tree:
+      size: 2955
+      sha256: b80332551d20389637851299b618679a8435531bed1fed905195ae7163526999
+  original:
+    hackage: haskeline-0.8.1.0
 snapshots:
 - completed:
     size: 532381