Suspendable Process
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950
{-# LANGUAGE GADTs, StandaloneDeriving #-}
half x = fromIntegral x / 2 :: Rational
data Stage a where
StageInit :: Stage Int
StageHalf :: Stage Rational
StageCalc :: Stage Double
StageFinal :: Stage String
deriving instance Show (Stage a)
data Suspended where
Suspended :: Show as => Stage as -> as -> Suspended
instance Show Suspended where
show (Suspended stage as) = show stage ++ ", " ++ show as
instance Read Suspended where
readsPrec = const $ uncurry ($) . mapFst parse . fmap (drop 2) . break (==',')
where
parse :: String -> String -> [(Suspended, String)]
parse stage = case stage of
"StageInit" -> parse' StageInit
"StageHalf" -> parse' StageHalf
"StageCalc" -> parse' StageCalc
"StageFinal" -> parse' StageFinal
_ -> const []
parse' :: (Show as, Read as) => Stage as -> String -> [(Suspended, String)]
parse' stg st = [(Suspended stg (read st), mempty)]
mapFst :: (a -> c) -> (a, b) -> (c, b)
mapFst f ~(a, b) = (f a, b)
runTAListStep :: Suspended -> Suspended
runTAListStep (Suspended StageInit r) = Suspended StageHalf (half r)
runTAListStep (Suspended StageHalf r) = Suspended StageCalc (fromRational r)
runTAListStep (Suspended StageCalc r) = Suspended StageFinal (show r)
main = do
let s1 = show $ runTAListStep $ read "StageInit, 5"
putStrLn s1
let s2 = show $ runTAListStep $ read s1
putStrLn s2
let s3 = show $ runTAListStep $ read s2
putStrLn s3
Haskell
INFO