module Simulation.Aivika.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,
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.Specs
import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Event
import Simulation.Aivika.Results
import Simulation.Aivika.Results.Locale
type ResultSourceShowS = ResultSource -> Event ShowS
type ResultSourcePrint = ResultSource -> Event ()
hPrintResultSourceIndented :: Handle
-> Int
-> ResultLocalisation
-> ResultSourcePrint
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 :: Handle
-> Int
-> ResultName
-> ResultLocalisation
-> ResultSourcePrint
hPrintResultSourceIndentedLabelled h indent label loc (ResultItemSource (ResultItem x)) =
case resultValueData (resultItemToStringValue x) of
Just m ->
do a <- m
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 ""
_ ->
error $
"Expected to see a string value for variable " ++
(resultItemName x) ++ ": hPrintResultSourceIndentedLabelled"
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 :: Int
-> ResultLocalisation
-> ResultSourcePrint
printResultSourceIndented = hPrintResultSourceIndented stdout
hPrintResultSource :: Handle
-> ResultLocalisation
-> ResultSourcePrint
hPrintResultSource h = hPrintResultSourceIndented h 0
printResultSource :: ResultLocalisation
-> ResultSourcePrint
printResultSource = hPrintResultSource stdout
hPrintResultSourceInRussian :: Handle -> ResultSourcePrint
hPrintResultSourceInRussian h = hPrintResultSource h russianResultLocalisation
hPrintResultSourceInEnglish :: Handle -> ResultSourcePrint
hPrintResultSourceInEnglish h = hPrintResultSource h englishResultLocalisation
printResultSourceInRussian :: ResultSourcePrint
printResultSourceInRussian = hPrintResultSourceInRussian stdout
printResultSourceInEnglish :: ResultSourcePrint
printResultSourceInEnglish = hPrintResultSourceInEnglish stdout
showResultSourceIndented :: Int
-> ResultLocalisation
-> ResultSourceShowS
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 :: Int
-> String
-> ResultLocalisation
-> ResultSourceShowS
showResultSourceIndentedLabelled indent label loc (ResultItemSource (ResultItem x)) =
case resultValueData (resultItemToStringValue x) of
Just m ->
do a <- m
let tab = replicate indent ' '
return $
showString tab .
showString "-- " .
showString (loc $ resultItemId x) .
showString "\n" .
showString tab .
showString label .
showString " = " .
showString a .
showString "\n\n"
_ ->
error $
"Expected to see a string value for variable " ++
(resultItemName x) ++ ": showResultSourceIndentedLabelled"
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 :: ResultLocalisation
-> ResultSourceShowS
showResultSource = showResultSourceIndented 0
showResultSourceInRussian :: ResultSourceShowS
showResultSourceInRussian = showResultSource russianResultLocalisation
showResultSourceInEnglish :: ResultSourceShowS
showResultSourceInEnglish = showResultSource englishResultLocalisation
printResultsWithTime :: ResultSourcePrint -> Results -> Event ()
printResultsWithTime print results =
do let x1 = textResultSource "----------"
x2 = timeResultSource
x3 = textResultSource ""
xs = resultSourceList results
print x1
print x2
mapM_ print xs
printResultsInStartTime :: ResultSourcePrint -> Results -> Simulation ()
printResultsInStartTime print results =
runEventInStartTime $ printResultsWithTime print results
printResultsInStopTime :: ResultSourcePrint -> Results -> Simulation ()
printResultsInStopTime print results =
runEventInStopTime $ printResultsWithTime print results
printResultsInIntegTimes :: ResultSourcePrint -> Results -> Simulation ()
printResultsInIntegTimes print results =
do let loop (m : ms) = m >> loop ms
loop [] = return ()
ms <- runDynamicsInIntegTimes $ runEvent $
printResultsWithTime print results
liftIO $ loop ms
printResultsInTime :: Double -> ResultSourcePrint -> Results -> Simulation ()
printResultsInTime t print results =
runDynamicsInTime t $ runEvent $
printResultsWithTime print results
printResultsInTimes :: [Double] -> ResultSourcePrint -> Results -> Simulation ()
printResultsInTimes ts print results =
do let loop (m : ms) = m >> loop ms
loop [] = return ()
ms <- runDynamicsInTimes ts $ runEvent $
printResultsWithTime print results
liftIO $ loop ms
showResultsWithTime :: ResultSourceShowS -> Results -> Event 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 :: ResultSourceShowS -> Results -> Simulation ShowS
showResultsInStartTime f results =
runEventInStartTime $ showResultsWithTime f results
showResultsInStopTime :: ResultSourceShowS -> Results -> Simulation ShowS
showResultsInStopTime f results =
runEventInStopTime $ showResultsWithTime f results
showResultsInIntegTimes :: ResultSourceShowS -> Results -> Simulation ShowS
showResultsInIntegTimes f results =
do let loop (m : ms) = return (.) `ap` m `ap` loop ms
loop [] = return id
ms <- runDynamicsInIntegTimes $ runEvent $
showResultsWithTime f results
liftIO $ loop ms
showResultsInTime :: Double -> ResultSourceShowS -> Results -> Simulation ShowS
showResultsInTime t f results =
runDynamicsInTime t $ runEvent $
showResultsWithTime f results
showResultsInTimes :: [Double] -> ResultSourceShowS -> Results -> Simulation ShowS
showResultsInTimes ts f results =
do let loop (m : ms) = return (.) `ap` m `ap` loop ms
loop [] = return id
ms <- runDynamicsInTimes ts $ runEvent $
showResultsWithTime f results
liftIO $ loop ms
printSimulationResultsInStartTime :: ResultSourcePrint -> Simulation Results -> Specs -> IO ()
printSimulationResultsInStartTime print model specs =
flip runSimulation specs $
model >>= printResultsInStartTime print
printSimulationResultsInStopTime :: ResultSourcePrint -> Simulation Results -> Specs -> IO ()
printSimulationResultsInStopTime print model specs =
flip runSimulation specs $
model >>= printResultsInStopTime print
printSimulationResultsInIntegTimes :: ResultSourcePrint -> Simulation Results -> Specs -> IO ()
printSimulationResultsInIntegTimes print model specs =
flip runSimulation specs $
model >>= printResultsInIntegTimes print
printSimulationResultsInTime :: Double -> ResultSourcePrint -> Simulation Results -> Specs -> IO ()
printSimulationResultsInTime t print model specs =
flip runSimulation specs $
model >>= printResultsInTime t print
printSimulationResultsInTimes :: [Double] -> ResultSourcePrint -> Simulation Results -> Specs -> IO ()
printSimulationResultsInTimes ts print model specs =
flip runSimulation specs $
model >>= printResultsInTimes ts print
showSimulationResultsInStartTime :: ResultSourceShowS -> Simulation Results -> Specs -> IO ShowS
showSimulationResultsInStartTime f model specs =
flip runSimulation specs $
model >>= showResultsInStartTime f
showSimulationResultsInStopTime :: ResultSourceShowS -> Simulation Results -> Specs -> IO ShowS
showSimulationResultsInStopTime f model specs =
flip runSimulation specs $
model >>= showResultsInStopTime f
showSimulationResultsInIntegTimes :: ResultSourceShowS -> Simulation Results -> Specs -> IO ShowS
showSimulationResultsInIntegTimes f model specs =
flip runSimulation specs $
model >>= showResultsInIntegTimes f
showSimulationResultsInTime :: Double -> ResultSourceShowS -> Simulation Results -> Specs -> IO ShowS
showSimulationResultsInTime t f model specs =
flip runSimulation specs $
model >>= showResultsInTime t f
showSimulationResultsInTimes :: [Double] -> ResultSourceShowS -> Simulation Results -> Specs -> IO ShowS
showSimulationResultsInTimes ts f model specs =
flip runSimulation specs $
model >>= showResultsInTimes ts f