{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}
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
{-# INLINABLE hPrintResultSourceIndented #-}
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
{-# INLINABLE hPrintResultSourceIndentedLabelled #-}
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 (localiseResultDescription 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 (localiseResultDescription 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 (localiseResultDescription 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
{-# INLINABLE printResultSourceIndented #-}
printResultSourceIndented = hPrintResultSourceIndented stdout
hPrintResultSource :: (MonadDES m, MonadIO (Event m))
=> Handle
-> ResultLocalisation
-> ResultSourcePrint m
{-# INLINABLE hPrintResultSource #-}
hPrintResultSource h = hPrintResultSourceIndented h 0
printResultSource :: (MonadDES m, MonadIO (Event m))
=> ResultLocalisation
-> ResultSourcePrint m
{-# INLINABLE printResultSource #-}
printResultSource = hPrintResultSource stdout
hPrintResultSourceInRussian :: (MonadDES m, MonadIO (Event m)) => Handle -> ResultSourcePrint m
{-# INLINABLE hPrintResultSourceInRussian #-}
hPrintResultSourceInRussian h = hPrintResultSource h russianResultLocalisation
hPrintResultSourceInEnglish :: (MonadDES m, MonadIO (Event m)) => Handle -> ResultSourcePrint m
{-# INLINABLE hPrintResultSourceInEnglish #-}
hPrintResultSourceInEnglish h = hPrintResultSource h englishResultLocalisation
printResultSourceInRussian :: (MonadDES m, MonadIO (Event m)) => ResultSourcePrint m
{-# INLINABLE printResultSourceInRussian #-}
printResultSourceInRussian = hPrintResultSourceInRussian stdout
printResultSourceInEnglish :: (MonadDES m, MonadIO (Event m)) => ResultSourcePrint m
{-# INLINABLE printResultSourceInEnglish #-}
printResultSourceInEnglish = hPrintResultSourceInEnglish stdout
hEnqueuePrintingResultSourceIndented :: (MonadDES m, EventIOQueueing m)
=> Handle
-> Int
-> ResultLocalisation
-> ResultSourcePrint m
{-# INLINABLE hEnqueuePrintingResultSourceIndented #-}
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
{-# INLINABLE enqueuePrintingResultSourceIndented #-}
enqueuePrintingResultSourceIndented = hEnqueuePrintingResultSourceIndented stdout
hEnqueuePrintingResultSource :: (MonadDES m, EventIOQueueing m)
=> Handle
-> ResultLocalisation
-> ResultSourcePrint m
{-# INLINABLE hEnqueuePrintingResultSource #-}
hEnqueuePrintingResultSource h = hEnqueuePrintingResultSourceIndented h 0
enqueuePrintingResultSource :: (MonadDES m, EventIOQueueing m)
=> ResultLocalisation
-> ResultSourcePrint m
{-# INLINABLE enqueuePrintingResultSource #-}
enqueuePrintingResultSource = hEnqueuePrintingResultSource stdout
hEnqueuePrintingResultSourceInRussian :: (MonadDES m, EventIOQueueing m) => Handle -> ResultSourcePrint m
{-# INLINABLE hEnqueuePrintingResultSourceInRussian #-}
hEnqueuePrintingResultSourceInRussian h = hEnqueuePrintingResultSource h russianResultLocalisation
hEnqueuePrintingResultSourceInEnglish :: (MonadDES m, EventIOQueueing m) => Handle -> ResultSourcePrint m
{-# INLINABLE hEnqueuePrintingResultSourceInEnglish #-}
hEnqueuePrintingResultSourceInEnglish h = hEnqueuePrintingResultSource h englishResultLocalisation
enqueuePrintingResultSourceInRussian :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m
{-# INLINABLE enqueuePrintingResultSourceInRussian #-}
enqueuePrintingResultSourceInRussian = hEnqueuePrintingResultSourceInRussian stdout
enqueuePrintingResultSourceInEnglish :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m
{-# INLINABLE enqueuePrintingResultSourceInEnglish #-}
enqueuePrintingResultSourceInEnglish = hEnqueuePrintingResultSourceInEnglish stdout
showResultSourceIndented :: MonadDES m
=> Int
-> ResultLocalisation
-> ResultSourceShowS m
{-# INLINABLE showResultSourceIndented #-}
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
{-# INLINABLE showResultSourceIndentedLabelled #-}
showResultSourceIndentedLabelled indent label loc (ResultItemSource (ResultItem x)) =
do a <- resultValueData $ resultItemToStringValue x
let tab = replicate indent ' '
return $
showString tab .
showString "-- " .
showString (localiseResultDescription 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 (localiseResultDescription 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 (localiseResultDescription 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
{-# INLINABLE showResultSource #-}
showResultSource = showResultSourceIndented 0
showResultSourceInRussian :: MonadDES m => ResultSourceShowS m
{-# INLINABLE showResultSourceInRussian #-}
showResultSourceInRussian = showResultSource russianResultLocalisation
showResultSourceInEnglish :: MonadDES m => ResultSourceShowS m
{-# INLINABLE showResultSourceInEnglish #-}
showResultSourceInEnglish = showResultSource englishResultLocalisation
printResultsWithTime :: (MonadDES m, MonadIO (Event m)) => ResultSourcePrint m -> Results m -> Event m ()
{-# INLINABLE printResultsWithTime #-}
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 ()
{-# INLINABLE printResultsInStartTime #-}
printResultsInStartTime print results =
do runEventInStartTime $
enqueueEventIOWithStartTime $
printResultsWithTime print results
runEventInStopTime $
return ()
printResultsInStopTime :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m -> Results m -> Simulation m ()
{-# INLINABLE printResultsInStopTime #-}
printResultsInStopTime print results =
do runEventInStartTime $
enqueueEventIOWithStopTime $
printResultsWithTime print results
runEventInStopTime $
return ()
printResultsInIntegTimes :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m -> Results m -> Simulation m ()
{-# INLINABLE printResultsInIntegTimes #-}
printResultsInIntegTimes print results =
do runEventInStartTime $
enqueueEventIOWithIntegTimes $
printResultsWithTime print results
runEventInStopTime $
return ()
printResultsInTime :: (MonadDES m, EventIOQueueing m) => Double -> ResultSourcePrint m -> Results m -> Simulation m ()
{-# INLINABLE printResultsInTime #-}
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 ()
{-# INLINABLE printResultsInTimes #-}
printResultsInTimes ts print results =
do runEventInStartTime $
enqueueEventIOWithTimes ts $
printResultsWithTime print results
runEventInStopTime $
return ()
showResultsWithTime :: MonadDES m => ResultSourceShowS m -> Results m -> Event m ShowS
{-# INLINABLE showResultsWithTime #-}
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
{-# INLINABLE showResultsInStartTime #-}
showResultsInStartTime f results =
do g <- runEventInStartTime $ showResultsWithTime f results
runEventInStopTime $ return g
showResultsInStopTime :: MonadDES m => ResultSourceShowS m -> Results m -> Simulation m ShowS
{-# INLINABLE showResultsInStopTime #-}
showResultsInStopTime f results =
runEventInStopTime $ showResultsWithTime f results
showResultsInIntegTimes :: MonadDES m => ResultSourceShowS m -> Results m -> Simulation m ShowS
{-# INLINABLE showResultsInIntegTimes #-}
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
{-# INLINABLE showResultsInTime #-}
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
{-# INLINABLE showResultsInTimes #-}
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 ()
{-# INLINABLE printSimulationResultsInStartTime #-}
printSimulationResultsInStartTime print model specs =
flip runSimulation specs $
model >>= printResultsInStartTime print
printSimulationResultsInStopTime :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
{-# INLINABLE printSimulationResultsInStopTime #-}
printSimulationResultsInStopTime print model specs =
flip runSimulation specs $
model >>= printResultsInStopTime print
printSimulationResultsInIntegTimes :: (MonadDES m, EventIOQueueing m) => ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
{-# INLINABLE printSimulationResultsInIntegTimes #-}
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 ()
{-# INLINABLE printSimulationResultsInTime #-}
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 ()
{-# INLINABLE printSimulationResultsInTimes #-}
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
{-# INLINABLE showSimulationResultsInStartTime #-}
showSimulationResultsInStartTime f model specs =
flip runSimulation specs $
model >>= showResultsInStartTime f
showSimulationResultsInStopTime :: MonadDES m => ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
{-# INLINABLE showSimulationResultsInStopTime #-}
showSimulationResultsInStopTime f model specs =
flip runSimulation specs $
model >>= showResultsInStopTime f
showSimulationResultsInIntegTimes :: MonadDES m => ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
{-# INLINABLE showSimulationResultsInIntegTimes #-}
showSimulationResultsInIntegTimes f model specs =
flip runSimulation specs $
model >>= showResultsInIntegTimes f
showSimulationResultsInTime :: MonadDES m => Double -> ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
{-# INLINABLE showSimulationResultsInTime #-}
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
{-# INLINABLE showSimulationResultsInTimes #-}
showSimulationResultsInTimes ts f model specs =
flip runSimulation specs $
model >>= showResultsInTimes ts f