module Test where

import Control.Concurrent
import Control.Exception
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import System.IO
import System.IO.Error
import System.Process

type Capacity = Int
data CaptureBuffer = CaptureBuffer Capacity C.ByteString

type CaptureState = StateT CaptureBuffer IO

type CaptureNumber = Int

main = do
  (_, Just captureOut, _, captureProcess) <- createProcess (proc "/bin/bash" ["-c", "while (true); do echo '[42]'; sleep 1; done"]){ std_out = CreatePipe, std_err = Inherit, close_fds = True }
  assureRunning' "Capture process could not start" captureProcess
  hSetBuffering captureOut NoBuffering
  forkIO $ evalStateT (captureLoop captureOut captureProcess) (CaptureBuffer 30 C.empty)
  threadDelay $ 10 * 60 * 1000 * 1000

captureLoop :: Handle -> ProcessHandle -> CaptureState ()
captureLoop captureOut captureProcess = forever $ do
  maybeNumber <- getLastCapture captureOut captureProcess
  case maybeNumber of
    Just n  -> liftIO $ print n
    Nothing -> return ()

getLastCapture :: Handle -> ProcessHandle -> CaptureState (Maybe CaptureNumber)
getLastCapture captureOut captureProcess = do
  liftIO $ assureRunning captureProcess
  captureBuffer <- get
  ret <- liftIO $ tryJust (guard . isEOFError) $ slurpInput captureOut captureBuffer
  case ret of
    Left _                           -> liftIO $ fail "Capture process exited (EOF)"
    Right (numbers, currentBuffer) -> do
      put currentBuffer
      if null numbers
        then return Nothing
        else return $ Just $ head . head $ numbers

slurpInput :: (Read a) => Handle -> CaptureBuffer -> IO ([a], CaptureBuffer)
slurpInput = slurpInput' []
  where slurpInput' datalist h buffer@(CaptureBuffer capacity before) = do
          ready <- hReady h
          if not ready
            then return (datalist, buffer)
            else do
              after <- C.hGetNonBlocking h (capacity - (fromIntegral $ C.length before))
              let new = before `C.append` after
                  chars = C.unpack new
                  (ds, rest) = readInput chars
              if null ds
                then if (fromIntegral $ C.length new) == capacity
                       then error "Invalid data from input"
                       else return (datalist, (CaptureBuffer capacity new))
                else do
                  let rest' = assert ((fromIntegral $ C.length rest') <= capacity) $ C.pack rest
                  slurpInput' (ds ++ datalist) h (CaptureBuffer capacity rest')

readInput :: (Read a) => String -> ([a], String)
readInput = readInput' []
  where readInput' datalist ""     = (datalist, "")
        readInput' datalist string = case reads string of
                                       [(x, rest)] -> readInput' (x:datalist) rest
                                       []          -> (datalist, string) -- we probably do not have enough data to read data properly
                                       _           -> error "Ambiguous parse from input"

assureRunning :: ProcessHandle -> IO ()
assureRunning = assureRunning' "Capture process exited"

assureRunning' :: String -> ProcessHandle -> IO ()
assureRunning' msg captureProcess = do
  processRunning <- getProcessExitCode captureProcess
  case processRunning of
    Just code -> fail $ msg ++ " (" ++ show code ++ ")"
    _         -> return ()