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