# Modeling a dependent computation task?

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.

Solution

• 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
``````

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)]
where f n (Left err) = [(n, err)]
f _ (Right tsks) = concat tsks

flatten' :: Task -> [(Int, Bool)]
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) }
``````

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

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 = 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

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

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

--
--

data Fix f = Fix { unFix :: f (Fix f) }

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
, Task 3 (Right []) ]
putStrLn \$ asHtml ex1

let ex2 = Task 0 (Right ex1)

print \$ failures ex2
print \$ failures' ex2