{-# 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