Modeling a dependent computation task?

Question

I need to model a computation task and some sub-tasks depend on it:

First I run a task, if it fails then it's over. If it succeeds then run a bunch of sub-tasks(zero or many), any of them can fail or succeed, and can run zero or many sub-sub-tasks if it succeeds. So it is roughly in Haskell:

data DepTask a b = Fail a | Success b [DepTask a b] deriving (Functor)

However, I am not a Haskell programmer, just find it is easier to describe my problem in Haskell. My problem is, how could I "fold" this structure? Such as pretty-print it in Html. ChatGPT suggests that I could define this kind of structure as fixed point, so that I can make use of cata to fold it.

data ComplexF a b next = FailF a | SuccessF b [next] deriving (Functor)
type Complex a b = Fix (ComplexF a b)

Is there any Haskell library (maybe also TypeScript equivalent) I can adopt?

ps: Sorry for my bad English since I am not a native English speaker.

Answer 1

If you want to implement this in Haskell as a relatively new Haskell programmer, then it would be best to keep things simple. If you want to identify tasks by integers and represent error messages as strings, then you can use the following simple data type to model your problem:

data Task = Task Int (Either String [Task]) deriving (Show)

That is, a Task identified by an Int either fails with an error String or succeeds with a list of subtasks, [Task].

(You could, optionally, replace the Either type with your own success/failure type:

data Result = Failure String | Success [Task]

but the use of Either for this purpose, including the use of Left for failure and Right for success, is pretty well established in the Haskell world.)

Equipped with Task, if you want a list of failed tasks and their associated errors, just write a plain old recursive function using pattern matching:

failures :: Task -> [(Int, String)]
failures (Task n (Left err))   = [(n, err)]
failures (Task _ (Right tsks)) = concatMap failures tsks

If you want a flattened list of all tasks by IDs with an associated success flag, write another plain old recursive function using pattern matching:

flatten :: Task -> [(Int, Bool)]
flatten (Task n (Left _))    = [(n, False)]
flatten (Task n (Right tsks))  = (n, True) : concatMap flatten tsks

If you want to render the results as HTML, then an ad hoc pretty printer would look something like this:

asHtml :: [Task] -> String
asHtml = ul ""
  where ul pfx body = pfx ++ "<ul>\n"
                          ++ concatMap (li (pfx ++ "  ")) body ++
                      pfx ++ "</ul>\n"
        li pfx (Task n result) = pfx ++ "<li>Task #" ++ show n
          ++ case result of
               Left err -> " failed, the error message is \"" ++ err ++ "\"\n"
               Right [] -> " succeeded with no subtasks\n"
               Right tsks -> " succeeded, invoking subtasks:\n" ++ ul pfx tsks

This will be the most straightforward approach.

After you've written 10 or 15 useful functions, you could give some consideration to "abstracting" out the common fold (AKA catamorphism), but you'll probably find it doesn't buy you much. A fold for Task would look something like this:

foldTask :: (Int -> Either String [a] -> a) -> Task -> a
foldTask f (Task n (Left err)) = f n (Left err)
foldTask f (Task n (Right tsks)) = f n (Right (map (foldTask f) tsks))

If you reimplement your functions in terms of this fold, they will no longer be explicitly recursive, but the result is not noticeably more concise or readable than the original:

failures' :: Task -> [(Int, String)]
failures' = foldTask f
  where f n (Left err) = [(n, err)]
        f _ (Right tsks) = concat tsks

flatten' :: Task -> [(Int, Bool)]
flatten' = foldTask f
  where f n (Left _) = [(n, False)]
        f n (Right tsks) = (n, True) : concat tsks

ChatGPT's advice seems pretty stupid. It's suggesting you reimplement your Task' as a fixed point of a functor TaskF:

data TaskF a = TaskF Int (Either String [a]) deriving (Functor)
data Fix f = Fix { unFix :: f (Fix f) }
type Task' = Fix TaskF

so you can implement an abstract catamorphism:

cata :: (Functor f) => (f a -> a) -> Fix f -> a
cata k = k . fmap (cata k) . unFix

that can be used as follows:

failures'' :: Task' -> [(Int, String)]
failures'' = cata f
  where f (TaskF n (Left err)) = [(n, err)]
        f (TaskF _ (Right tsks)) = concat tsks

flatten'' :: Task' -> [(Int, Bool)]
flatten'' = cata f
  where f (TaskF n (Left _)) = [(n, False)]
        f (TaskF n (Right tsks)) = (n, True) : concat tsks

This is perhaps of some theoretical interest, and there are some cool related libraries, like recursion-schemes, but this isn't particular useful to a new Haskell programmer implementing a simple model like this.

Anyway, here's a complete file with sample code:

module DepTask where

--
-- Implementation for normal humans
--

data Task = Task Int (Either String [Task]) deriving (Show)

failures :: Task -> [(Int, String)]
failures (Task n (Left err))   = [(n, err)]
failures (Task _ (Right tsks)) = concatMap failures tsks

flatten :: Task -> [(Int, Bool)]
flatten (Task n (Left _))    = [(n, False)]
flatten (Task n (Right tsks))  = (n, True) : concatMap flatten tsks

asHtml :: [Task] -> String
asHtml = ul ""
  where ul pfx body = pfx ++ "<ul>\n"
                          ++ concatMap (li (pfx ++ "  ")) body ++
                      pfx ++ "</ul>\n"
        li pfx (Task n result) = pfx ++ "<li>Task #" ++ show n
          ++ case result of
               Left err -> " failed, the error message is \"" ++ err ++ "\"\n"
               Right [] -> " succeeded with no subtasks\n"
               Right tsks -> " succeeded, invoking subtasks:\n" ++ ul pfx tsks

--
-- Unnecessary abstraction of the fold
--

foldTask :: (Int -> Either String [a] -> a) -> Task -> a
foldTask f (Task n (Left err)) = f n (Left err)
foldTask f (Task n (Right tsks)) = f n (Right (map (foldTask f) tsks))

failures' :: Task -> [(Int, String)]
failures' = foldTask f
  where f n (Left err) = [(n, err)]
        f _ (Right tsks) = concat tsks

flatten' :: Task -> [(Int, Bool)]
flatten' = foldTask f
  where f n (Left _) = [(n, False)]
        f n (Right tsks) = (n, True) : concat tsks

--
-- ChatGPTs crazy advice
--

data TaskF a = TaskF Int (Either String [a]) deriving (Functor)
data Fix f = Fix { unFix :: f (Fix f) }
type Task' = Fix TaskF

cata :: (Functor f) => (f a -> a) -> Fix f -> a
cata k = k . fmap (cata k) . unFix

failures'' :: Task' -> [(Int, String)]
failures'' = cata f
  where f (TaskF n (Left err)) = [(n, err)]
        f (TaskF _ (Right tsks)) = concat tsks

flatten'' :: Task' -> [(Int, Bool)]
flatten'' = cata f
  where f (TaskF n (Left _)) = [(n, False)]
        f (TaskF n (Right tsks)) = (n, True) : concat tsks

--
-- Some examples
--

main :: IO ()
main = do
  let ex1 = [ Task 1 (Left "file not found")
            , Task 2 (Right [ Task 3 (Right [])
                            , Task 4 (Right [Task 5 (Left "bad parameter")])])
            , Task 3 (Right []) ]
  putStrLn $ asHtml ex1

  let ex2 = Task 0 (Right ex1)

  print $ failures ex2
  print $ failures' ex2

  let task n r = Fix (TaskF n r)
      ex2' = task 0 (Right
        [ task 1 (Left "file not found")
        , task 2 (Right [ task 3 (Right [])
                        , task 4 (Right [task 5 (Left "bad parameter")])])
        , task 3 (Right []) ])

  print $ failures'' ex2'