typescripthaskellrecursion-schemescatamorphism# 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
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'
```

- How to use xpath locator in Cypress with TypeScript project?
- Cannot find module '@components/...' or its corresponding type declarations.ts(2307) in React Native
- Angular 17 child routing
- confused by Symbol.iterator with typescript and returned value type in a for-of-loop
- Deno - Relative import path "$fresh/dev.ts" not prefixed
- In Angular, What is 'pathmatch: full' and what effect does it have?
- Typescript prefers importing relative import instead of path alias
- How we can use the argment in rxjs/map operator
- Will pg-promise transaction rollback, if non sql function inside transaction fails?
- Angular ViewChild with Directive as selector returns undefined
- SvelteKit - api response data (PageData) not updated after initial render
- How do I infer generics from an extended interface?
- The difference between "require(x)" and "import x"
- TypeScript: How to combine DefaultTheme with styled-components?
- Taking a typescript object and converting each property into a union of separate objects
- Getting this openai typescript error (Type 'MessageInterface' is not assignable to type 'ChatCompletionMessageParam')
- How to parse JSON object in Angular
- Typescript: computed property name in arguments from prior arguments
- How to infer return type of a generic function with default types
- Obtaining the coordinate of a null value when using spanGaps with ChartJS?
- Can a TypeScript type implement an interface?
- Structuring a TypeScript project with workers
- @viewChild and @ViewChildren gives undefined
- How to use toSorted() method in typescript
- Property 'foo' is protected and only accesible through an instance of class 'Foo' (in instances of Foo)
- Typescript private property subclass can't access
- Typescript complains Property does not exist on type 'JSX.IntrinsicElements' when using React.createClass?
- How to implement select all in angular material drop down angular 5
- How to check for some text on a webpage using playwright?
- Styled Components not being recognized in React