-----------------------------------------------------------------------------
--
-- Module      :  Transient.Move.Services
-- Copyright   :
-- License     :  GPL-3
--
-- Maintainer  :  agocorona@gmail.com
-- Stability   :
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

module Transient.Move.Services  where

import Transient.Base
import Transient.Move
import Transient.Logged
import Transient.EVars
import Control.Monad.IO.Class
import System.Process
import System.IO.Unsafe
import Control.Concurrent.MVar
import Control.Applicative
import Network (PortID(..))
import GHC.Conc
import System.Directory
import Control.Monad
import Data.List
import Data.TCache hiding(onNothing)

-- for the example
import System.Environment

startServices :: Cloud ()
startServices= do
  node <- getMyNode
  onAll . liftIO $ print node
  mapM_ start $ services node
  where
  start (package,program,port)= onAll . liftIO $ do
          let prog= pathExe (name package) program port
          liftIO $ print prog
          createProcess $ shell prog


pathExe package program port= package++"/dist/build/"++package++"/"++program
                                       ++ " " ++ show port

install :: String  -> String -> Int -> Cloud ()
install package program port =  do
     let packagename = name package
     exist <-  local $ liftIO $ doesDirectoryExist  packagename
     when (not exist) $ local $ liftIO $ do
         callProcess  "git" ["clone",package]
         liftIO $ print "GIT DONE"
         setCurrentDirectory packagename
         callProcess  "cabal" ["install"]
         setCurrentDirectory ".."
         return()
     let prog= pathExe packagename program port
     local $ liftIO $ do
           createProcess $ shell program
           return ()

     let service= (package, program,  port)

     Connection{myNode= rnode} <- onAll getSData <|> error "Mynode not set: use setMyNode"
     local $ liftIO $ do
       atomically $ do
        MyNode( Node h p c servs) <- readTVar rnode

        writeTVar rnode $ MyNode $ Node h p c $ service:servs
       liftIO syncCache
     node <-  getMyNode
     notifyService node service
     return()

name url= do
     let git= "http://github.com/"
     if not $ isPrefixOf git url
       then error "install: only github repos are admitted, sorry"
       else
        let segments = split '/' $ drop (length git) url
            segs'= reverse segments
        in  head  segs'


     where
     split c []= []
     split c xs=
        let (h,t)= span  (/= c) xs
        in  if null t then [h] else h : split c  (tail t)

rfreePort :: MVar Int
rfreePort = unsafePerformIO $ newMVar  3000

freePort :: MonadIO m => m Int
freePort= liftIO $ modifyMVar rfreePort $ \ n -> return (n+1,n)

initService node package program= loggedc $
    case   find  (\(package', program',_) -> package==package' && program== program') $ services node of
       Just (_,_,port) -> return port
       Nothing -> do
            beamTo node
            port <- onAll freePort
            install package program  port
            empty
          <|> do
            Connection{comEvent=ev} <- onAll getSData
            (node', (package', program',port)) <- local waitNodeEvents
            if node'== node && package' == package && program'== program
                 then return port
                 else empty

notifyService :: Node -> Service -> Cloud ()
notifyService node service=  clustered $ do
     onAll . liftIO $ atomically $ do
        nodes <- readTVar nodeList
        let ([nod], nodes')= span (== node) nodes
        let nod' = nod{services=service:services nod}
        writeTVar nodeList $ nod' : nodes'
        return ()

     local $ sendNodeEvent (node,service)
     return ()

{-
main= do
--      keep $ install "http://github.com/agocorona/transient" "MainStreamFiles"  3000
    let node1= createNode "localhost" 2000
    let node2= createNode "localhost" 2001
    args <-getArgs
    let [localNode,remoteNode]= if null args then [node1,node2] else [node2,node1]


    runCloudIO $ do
      onAll $ addNodes [localNode, remoteNode]
      onAll $ setMyNode localNode
      listen localNode <|> return ()
      local $ option "start" "start"

      startServices
      port <-initService remoteNode "http://github.com/agocorona/transient" "MainStreamFiles"
      onAll . liftIO $ putStrLn $ "installed at" ++ show port
-}