module Simulation.Aivika.Trans.Results.IO
       (
        ResultSourcePrint,
        ResultSourceShowS,
        
        printResultsWithTime,
        printResultsInStartTime,
        printResultsInStopTime,
        printResultsInIntegTimes,
        printResultsInTime,
        printResultsInTimes,
        
        printSimulationResultsInStartTime,
        printSimulationResultsInStopTime,
        printSimulationResultsInIntegTimes,
        printSimulationResultsInTime,
        printSimulationResultsInTimes,
        
        showResultsWithTime,
        showResultsInStartTime,
        showResultsInStopTime,
        showResultsInIntegTimes,
        showResultsInTime,
        showResultsInTimes,
        
        showSimulationResultsInStartTime,
        showSimulationResultsInStopTime,
        showSimulationResultsInIntegTimes,
        showSimulationResultsInTime,
        showSimulationResultsInTimes,
        
        hPrintResultSourceIndented,
        hPrintResultSource,
        hPrintResultSourceInRussian,
        hPrintResultSourceInEnglish,
        printResultSourceIndented,
        printResultSource,
        printResultSourceInRussian,
        printResultSourceInEnglish,
        
        hEnqueuePrintingResultSourceIndented,
        hEnqueuePrintingResultSource,
        hEnqueuePrintingResultSourceInRussian,
        hEnqueuePrintingResultSourceInEnglish,
        enqueuePrintingResultSourceIndented,
        enqueuePrintingResultSource,
        enqueuePrintingResultSourceInRussian,
        enqueuePrintingResultSourceInEnglish,
        
        showResultSourceIndented,
        showResultSource,
        showResultSourceInRussian,
        showResultSourceInEnglish) where
import Control.Monad
import Control.Monad.Trans
import qualified Data.Map as M
import qualified Data.Array as A
import System.IO
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Specs
import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Dynamics
import Simulation.Aivika.Trans.Event
import Simulation.Aivika.Trans.Ref
import Simulation.Aivika.Trans.Results
import Simulation.Aivika.Trans.Results.Locale
type ResultSourceShowS m = ResultSource m -> Event m ShowS
type ResultSourcePrint m = ResultSource m -> Event m ()
hPrintResultSourceIndented :: (MonadDES m, MonadIO (Event m))
                              => Handle
                              
                              -> Int
                              
                              -> ResultLocalisation
                              
                              -> ResultSourcePrint m
hPrintResultSourceIndented h indent loc source@(ResultItemSource (ResultItem x)) =
  hPrintResultSourceIndentedLabelled h indent (resultItemName x) loc source
hPrintResultSourceIndented h indent loc source@(ResultVectorSource x) =
  hPrintResultSourceIndentedLabelled h indent (resultVectorName x) loc source
hPrintResultSourceIndented h indent loc source@(ResultObjectSource x) =
  hPrintResultSourceIndentedLabelled h indent (resultObjectName x) loc source
hPrintResultSourceIndented h indent loc source@(ResultSeparatorSource x) =
  hPrintResultSourceIndentedLabelled h indent (resultSeparatorText x) loc source
hPrintResultSourceIndentedLabelled :: (MonadDES m, MonadIO (Event m))
                                      => Handle
                                      
                                      -> Int
                                      
                                      -> ResultName
                                      
                                      -> ResultLocalisation
                                      
                                      -> ResultSourcePrint m
hPrintResultSourceIndentedLabelled h indent label loc (ResultItemSource (ResultItem x)) =
  do a <- resultValueData $ resultItemToStringValue x
     let tab = replicate indent ' '
     liftIO $
       do hPutStr h tab
          hPutStr h "-- "
          hPutStr h (loc $ resultItemId x)
          hPutStrLn h ""
          hPutStr h tab
          hPutStr h label
          hPutStr h " = "
          hPutStrLn h a
          hPutStrLn h ""
hPrintResultSourceIndentedLabelled h indent label loc (ResultVectorSource x) =
  do let tab = replicate indent ' '
     liftIO $
       do hPutStr h tab
          hPutStr h "-- "
          hPutStr h (loc $ resultVectorId x)
          hPutStrLn h ""
          hPutStr h tab
          hPutStr h label
          hPutStrLn h ":"
          hPutStrLn h ""
     let items = A.elems (resultVectorItems x)
         subscript = A.elems (resultVectorSubscript x)
     forM_ (zip items subscript) $ \(i, s) ->
       hPrintResultSourceIndentedLabelled h (indent + 2) (label ++ s) loc i
hPrintResultSourceIndentedLabelled h indent label loc (ResultObjectSource x) =
  do let tab = replicate indent ' '
     liftIO $
       do hPutStr h tab
          hPutStr h "-- "
          hPutStr h (loc $ resultObjectId x)
          hPutStrLn h ""
          hPutStr h tab
          hPutStr h label
          hPutStrLn h ":"
          hPutStrLn h ""
     forM_ (resultObjectProperties x) $ \p ->
       do let indent' = 2 + indent
              tab'    = "  " ++ tab
              label'  = resultPropertyLabel p
              source' = resultPropertySource p
          hPrintResultSourceIndentedLabelled h indent' label' loc source'
hPrintResultSourceIndentedLabelled h indent label loc (ResultSeparatorSource x) =
  do let tab = replicate indent ' '
     liftIO $
       do hPutStr h tab
          hPutStr h label
          hPutStrLn h ""
          hPutStrLn h ""
printResultSourceIndented :: (MonadDES m, MonadIO (Event m))
                             => Int
                             
                             -> ResultLocalisation
                             
                             -> ResultSourcePrint m
printResultSourceIndented = hPrintResultSourceIndented stdout
hPrintResultSource :: (MonadDES m, MonadIO (Event m))
                      => Handle
                      
                      -> ResultLocalisation
                      
                      -> ResultSourcePrint m
hPrintResultSource h = hPrintResultSourceIndented h 0
printResultSource :: (MonadDES m, MonadIO (Event m))
                     => ResultLocalisation
                     
                     -> ResultSourcePrint m
printResultSource = hPrintResultSource stdout
hPrintResultSourceInRussian :: (MonadDES m, MonadIO (Event m)) => Handle -> ResultSourcePrint m
hPrintResultSourceInRussian h = hPrintResultSource h russianResultLocalisation
hPrintResultSourceInEnglish :: (MonadDES m, MonadIO (Event m)) => Handle -> ResultSourcePrint m
hPrintResultSourceInEnglish h = hPrintResultSource h englishResultLocalisation
printResultSourceInRussian :: (MonadDES m, MonadIO (Event m)) => ResultSourcePrint m
printResultSourceInRussian = hPrintResultSourceInRussian stdout
printResultSourceInEnglish :: (MonadDES m, MonadIO (Event m)) => ResultSourcePrint m
printResultSourceInEnglish = hPrintResultSourceInEnglish stdout
hEnqueuePrintingResultSourceIndented :: (MonadDES m, EventIOQueueing m)
                                        => Handle
                                        
                                        -> Int
                                        
                                        -> ResultLocalisation
                                        
                                        -> ResultSourcePrint m
hEnqueuePrintingResultSourceIndented h indent loc source =
  do t <- liftDynamics time
     enqueueEventIO t $
       hPrintResultSourceIndented h indent loc source
enqueuePrintingResultSourceIndented :: (MonadDES m, EventIOQueueing m)
                                       => Int
                                       
                                       -> ResultLocalisation
                                       
                                       -> ResultSourcePrint m
enqueuePrintingResultSourceIndented = hEnqueuePrintingResultSourceIndented stdout
hEnqueuePrintingResultSource :: (MonadDES m, EventIOQueueing m)
                                => Handle
                                
                                -> ResultLocalisation
                                
                                -> ResultSourcePrint m
hEnqueuePrintingResultSource h = hEnqueuePrintingResultSourceIndented h 0
enqueuePrintingResultSource :: (MonadDES m, EventIOQueueing m)
                               => ResultLocalisation
                               
                               -> ResultSourcePrint m
enqueuePrintingResultSource = hEnqueuePrintingResultSource stdout
hEnqueuePrintingResultSourceInRussian :: (MonadDES m, EventIOQueueing m) => Handle -> ResultSourcePrint m
hEnqueuePrintingResultSourceInRussian h = hEnqueuePrintingResultSource h russianResultLocalisation
hEnqueuePrintingResultSourceInEnglish :: (MonadDES m, EventIOQueueing m) => Handle -> ResultSourcePrint m
hEnqueuePrintingResultSourceInEnglish h = hEnqueuePrintingResultSource h englishResultLocalisation
enqueuePrintingResultSourceInRussian :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m
enqueuePrintingResultSourceInRussian = hEnqueuePrintingResultSourceInRussian stdout
enqueuePrintingResultSourceInEnglish :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m
enqueuePrintingResultSourceInEnglish = hEnqueuePrintingResultSourceInEnglish stdout
showResultSourceIndented :: MonadDES m
                            => Int
                            
                            -> ResultLocalisation
                            
                            -> ResultSourceShowS m
showResultSourceIndented indent loc source@(ResultItemSource (ResultItem x)) =
  showResultSourceIndentedLabelled indent (resultItemName x) loc source
showResultSourceIndented indent loc source@(ResultVectorSource x) =
  showResultSourceIndentedLabelled indent (resultVectorName x) loc source
showResultSourceIndented indent loc source@(ResultObjectSource x) =
  showResultSourceIndentedLabelled indent (resultObjectName x) loc source
showResultSourceIndented indent loc source@(ResultSeparatorSource x) =
  showResultSourceIndentedLabelled indent (resultSeparatorText x) loc source
showResultSourceIndentedLabelled :: MonadDES m
                                    => Int
                                    
                                    -> String
                                    
                                    -> ResultLocalisation
                                    
                                    -> ResultSourceShowS m
showResultSourceIndentedLabelled indent label loc (ResultItemSource (ResultItem x)) =
  do a <- resultValueData $ resultItemToStringValue x
     let tab = replicate indent ' '
     return $
       showString tab .
       showString "-- " .
       showString (loc $ resultItemId x) .
       showString "\n" .
       showString tab .
       showString label .
       showString " = " .
       showString a .
       showString "\n\n"
showResultSourceIndentedLabelled indent label loc (ResultVectorSource x) =
  do let tab = replicate indent ' '
         items = A.elems (resultVectorItems x)
         subscript = A.elems (resultVectorSubscript x)
     contents <-
       forM (zip items subscript) $ \(i, s) ->
       showResultSourceIndentedLabelled (indent + 2) (label ++ s) loc i
     let showContents = foldr (.) id contents
     return $
       showString tab .
       showString "-- " .
       showString (loc $ resultVectorId x) .
       showString "\n" .
       showString tab .
       showString label .
       showString ":\n\n" .
       showContents
showResultSourceIndentedLabelled indent label loc (ResultObjectSource x) =
  do let tab = replicate indent ' '
     contents <-
       forM (resultObjectProperties x) $ \p ->
       do let indent' = 2 + indent
              tab'    = "  " ++ tab
              label'  = resultPropertyLabel p
              output' = resultPropertySource p
          showResultSourceIndentedLabelled indent' label' loc output'
     let showContents = foldr (.) id contents
     return $
       showString tab .
       showString "-- " .
       showString (loc $ resultObjectId x) .
       showString "\n" .
       showString tab .
       showString label .
       showString ":\n\n" .
       showContents
showResultSourceIndentedLabelled indent label loc (ResultSeparatorSource x) =
  do let tab = replicate indent ' '
     return $
       showString tab .
       showString label .
       showString "\n\n"
showResultSource :: MonadDES m
                    => ResultLocalisation
                    
                    -> ResultSourceShowS m
showResultSource = showResultSourceIndented 0
showResultSourceInRussian :: MonadDES m => ResultSourceShowS m
showResultSourceInRussian = showResultSource russianResultLocalisation
showResultSourceInEnglish :: MonadDES m => ResultSourceShowS m
showResultSourceInEnglish = showResultSource englishResultLocalisation
printResultsWithTime :: (MonadDES m, MonadIO (Event m)) => ResultSourcePrint m -> Results m -> Event m ()
printResultsWithTime print results =
  do let x1 = textResultSource "----------"
         x2 = timeResultSource
         x3 = textResultSource ""
         xs = resultSourceList results
     print x1
     print x2
     
     mapM_ print xs
     
printResultsInStartTime :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m -> Results m -> Simulation m ()
printResultsInStartTime print results =
  do runEventInStartTime $
       enqueueEventIOWithStartTime $
       printResultsWithTime print results
     runEventInStopTime $
       return ()
printResultsInStopTime :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m -> Results m -> Simulation m ()
printResultsInStopTime print results =
  do runEventInStartTime $
       enqueueEventIOWithStopTime $
       printResultsWithTime print results
     runEventInStopTime $
       return ()
printResultsInIntegTimes :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m -> Results m -> Simulation m ()
printResultsInIntegTimes print results =
  do runEventInStartTime $
       enqueueEventIOWithIntegTimes $
       printResultsWithTime print results
     runEventInStopTime $
       return ()
printResultsInTime :: (MonadDES m, EventIOQueueing m) => Double -> ResultSourcePrint m -> Results m -> Simulation m ()
printResultsInTime t print results =
  do runEventInStartTime $
       enqueueEventIO t $
       printResultsWithTime print results
     runEventInStopTime $
       return ()
printResultsInTimes :: (MonadDES m, EventIOQueueing m) => [Double] -> ResultSourcePrint m -> Results m -> Simulation m ()
printResultsInTimes ts print results =
  do runEventInStartTime $
       enqueueEventIOWithTimes ts $
       printResultsWithTime print results
     runEventInStopTime $
       return ()
showResultsWithTime :: MonadDES m => ResultSourceShowS m -> Results m -> Event m ShowS
showResultsWithTime f results =
  do let x1 = textResultSource "----------"
         x2 = timeResultSource
         x3 = textResultSource ""
         xs = resultSourceList results
     y1 <- f x1
     y2 <- f x2
     y3 <- f x3
     ys <- forM xs f
     return $
       y1 .
       y2 .
       
       foldr (.) id ys
       
showResultsInStartTime :: MonadDES m => ResultSourceShowS m -> Results m -> Simulation m ShowS
showResultsInStartTime f results =
  do g <- runEventInStartTime $ showResultsWithTime f results
     runEventInStopTime $ return g
showResultsInStopTime :: MonadDES m => ResultSourceShowS m -> Results m -> Simulation m ShowS
showResultsInStopTime f results =
  runEventInStopTime $ showResultsWithTime f results
showResultsInIntegTimes :: MonadDES m => ResultSourceShowS m -> Results m -> Simulation m ShowS
showResultsInIntegTimes f results =
  do r <- newRef id
     runEventInStartTime $
       enqueueEventWithIntegTimes $
       do g <- showResultsWithTime f results
          modifyRef r (. g)
     runEventInStopTime $
       readRef r
showResultsInTime :: MonadDES m => Double -> ResultSourceShowS m -> Results m -> Simulation m ShowS
showResultsInTime t f results =
  do r <- newRef id
     runEventInStartTime $
       enqueueEvent t $
       do g <- showResultsWithTime f results
          writeRef r g
     runEventInStopTime $
       readRef r
showResultsInTimes :: MonadDES m => [Double] -> ResultSourceShowS m -> Results m -> Simulation m ShowS
showResultsInTimes ts f results =
  do r <- newRef id
     runEventInStartTime $
       enqueueEventWithTimes ts $
       do g <- showResultsWithTime f results
          modifyRef r (. g)
     runEventInStopTime $
       readRef r
printSimulationResultsInStartTime :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
printSimulationResultsInStartTime print model specs =
  flip runSimulation specs $
  model >>= printResultsInStartTime print
printSimulationResultsInStopTime :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
printSimulationResultsInStopTime print model specs =
  flip runSimulation specs $
  model >>= printResultsInStopTime print
printSimulationResultsInIntegTimes :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
printSimulationResultsInIntegTimes print model specs =
  flip runSimulation specs $
  model >>= printResultsInIntegTimes print
printSimulationResultsInTime :: (MonadDES m, EventIOQueueing m) => Double -> ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
printSimulationResultsInTime t print model specs =
  flip runSimulation specs $
  model >>= printResultsInTime t print
printSimulationResultsInTimes :: (MonadDES m, EventIOQueueing m) => [Double] -> ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
printSimulationResultsInTimes ts print model specs =
  flip runSimulation specs $
  model >>= printResultsInTimes ts print
showSimulationResultsInStartTime :: MonadDES m => ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
showSimulationResultsInStartTime f model specs =
  flip runSimulation specs $
  model >>= showResultsInStartTime f
showSimulationResultsInStopTime :: MonadDES m => ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
showSimulationResultsInStopTime f model specs =
  flip runSimulation specs $
  model >>= showResultsInStopTime f
showSimulationResultsInIntegTimes :: MonadDES m => ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
showSimulationResultsInIntegTimes f model specs =
  flip runSimulation specs $
  model >>= showResultsInIntegTimes f
showSimulationResultsInTime :: MonadDES m => Double -> ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
showSimulationResultsInTime t f model specs =
  flip runSimulation specs $
  model >>= showResultsInTime t f
showSimulationResultsInTimes :: MonadDES m => [Double] -> ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
showSimulationResultsInTimes ts f model specs =
  flip runSimulation specs $
  model >>= showResultsInTimes ts f