-- GHC wants us to remove `Err never` branches from case statements, because it
-- knows we'll never end up in those branches. We like them though, because
-- missing such a branch in a case statement looks like a problem and so is
-- distracting.
{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}

-- | Tasks make it easy to describe asynchronous operations that may fail, like
-- HTTP requests or writing to a database.
module Task
  ( -- * Tasks
    Task,
    perform,
    attempt,

    -- * Chains
    andThen,
    succeed,
    fail,
    sequence,

    -- * Maps
    map,
    map2,
    map3,
    map4,
    map5,
    map6,

    -- * Errors
    onError,
    mapError,

    -- * Special (custom helpers not found in Elm)
    timeout,
    parallel,
  )
where

import Basics
import qualified Control.Concurrent.Async as Async
import qualified Internal.Shortcut as Shortcut
import List (List)
import qualified List
import Maybe (Maybe (..))
import Platform.Internal (Task)
import qualified Platform.Internal as Internal
import Result (Result (..))
import qualified System.Timeout
import Prelude (IO)
import qualified Prelude

-- BASICS

-- | Just having a @Task@ does not mean it is done. We must @perform@ the task:
--
-- > import qualified Task
-- > import qualified Platform
-- >
-- > main :: IO
-- > main =
-- >   Task.perform Platform.silentHandler Time.now
perform :: Internal.LogHandler -> Task Never a -> IO a
perform :: LogHandler -> Task Never a -> IO a
perform LogHandler
output Task Never a
task =
  let onResult :: Result Never p -> p
onResult Result Never p
result =
        case Result Never p
result of
          -- If you remove this branch, consider also removing the
          -- -fno-warn-overlapping-patterns warning above.
          Err Never
err -> Never -> p
forall a. Never -> a
never Never
err
          Ok p
x -> p
x
   in LogHandler -> Task Never a -> IO (Result Never a)
forall x a. LogHandler -> Task x a -> IO (Result x a)
attempt LogHandler
output Task Never a
task
        IO (Result Never a) -> (IO (Result Never a) -> IO a) -> IO a
forall a b. a -> (a -> b) -> b
|> (Result Never a -> a) -> IO (Result Never a) -> IO a
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
Shortcut.map Result Never a -> a
forall p. Result Never p -> p
onResult

-- | This is very similar to perform except it can handle failures!
attempt :: Internal.LogHandler -> Task x a -> IO (Result x a)
attempt :: LogHandler -> Task x a -> IO (Result x a)
attempt LogHandler
output Task x a
task =
  let onResult :: a -> f a
onResult a
result =
        a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure a
result
   in Task x a -> LogHandler -> IO (Result x a)
forall x a. Task x a -> LogHandler -> IO (Result x a)
Internal._run Task x a
task LogHandler
output IO (Result x a)
-> (IO (Result x a) -> IO (Result x a)) -> IO (Result x a)
forall a b. a -> (a -> b) -> b
|> (Result x a -> IO (Result x a))
-> IO (Result x a) -> IO (Result x a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
Shortcut.andThen Result x a -> IO (Result x a)
forall (f :: * -> *) a. Applicative f => a -> f a
onResult

-- | A task that succeeds immediately when run. It is usually used with
-- @andThen@. You can use it like @map@ if you want:
--
-- > import qualified Time
-- >
-- > timeInMillis : Task x Int
-- > timeInMillis =
-- >   Time.now
-- >     |> andThen (\t -> succeed (Time.posixToMillis t))
succeed :: a -> Task x a
succeed :: a -> Task x a
succeed a
a =
  (LogHandler -> IO (Result x a)) -> Task x a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Internal.Task ((LogHandler -> IO (Result x a)) -> Task x a)
-> (LogHandler -> IO (Result x a)) -> Task x a
forall a b. (a -> b) -> a -> b
<| \LogHandler
_ -> Result x a -> IO (Result x a)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (a -> Result x a
forall error value. value -> Result error value
Ok a
a)

-- | A task that fails immediately when run. Like with @succeed@, this can be
-- used with @andThen@ to check on the outcome of another task.
--
-- > type Error = NotFound
-- >
-- > notFound : Task Error a
-- > notFound =
-- >   fail NotFound
fail :: x -> Task x a
fail :: x -> Task x a
fail x
x =
  (LogHandler -> IO (Result x a)) -> Task x a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Internal.Task ((LogHandler -> IO (Result x a)) -> Task x a)
-> (LogHandler -> IO (Result x a)) -> Task x a
forall a b. (a -> b) -> a -> b
<| \LogHandler
_ -> Result x a -> IO (Result x a)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (x -> Result x a
forall error value. error -> Result error value
Err x
x)

-- MAPS

-- | Transform a task. Maybe you want to figure out what time it will be in one
-- hour:
--
-- > import Task exposing (Task)
-- > import qualified Time
-- >
-- > timeInOneHour : Task x Time.Posix
-- > timeInOneHour =
-- >   Task.map addAnHour Time.now
-- >
-- > addAnHour : Time.Posix -> Time.Posix
-- > addAnHour time =
-- >   Time.millisToPosix (Time.posixToMillis time + 60 * 60 * 1000)
map :: (a -> b) -> Task x a -> Task x b
map :: (a -> b) -> Task x a -> Task x b
map =
  (a -> b) -> Task x a -> Task x b
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
Shortcut.map

-- | Put the results of two tasks together. For example, if we wanted to know
-- the current month, we could ask:
--
--  >  import qualified Task exposing (Task)
--  >  import qualified Time
--  >
--  >  getMonth : Task x Int
--  >  getMonth =
--  >    Task.map2 Time.toMonth Time.here Time.now
--
-- __Note:__ Say we were doing HTTP requests instead. @map2@ does each task in
-- order, so it would try the first request and only continue after it succeeds.
-- If it fails, the whole thing fails!
map2 :: (a -> b -> result) -> Task x a -> Task x b -> Task x result
map2 :: (a -> b -> result) -> Task x a -> Task x b -> Task x result
map2 =
  (a -> b -> result) -> Task x a -> Task x b -> Task x result
forall (m :: * -> *) a b value.
Applicative m =>
(a -> b -> value) -> m a -> m b -> m value
Shortcut.map2

-- |
map3 :: (a -> b -> c -> result) -> Task x a -> Task x b -> Task x c -> Task x result
map3 :: (a -> b -> c -> result)
-> Task x a -> Task x b -> Task x c -> Task x result
map3 =
  (a -> b -> c -> result)
-> Task x a -> Task x b -> Task x c -> Task x result
forall (m :: * -> *) a b c value.
Applicative m =>
(a -> b -> c -> value) -> m a -> m b -> m c -> m value
Shortcut.map3

-- |
map4 :: (a -> b -> c -> d -> result) -> Task x a -> Task x b -> Task x c -> Task x d -> Task x result
map4 :: (a -> b -> c -> d -> result)
-> Task x a -> Task x b -> Task x c -> Task x d -> Task x result
map4 =
  (a -> b -> c -> d -> result)
-> Task x a -> Task x b -> Task x c -> Task x d -> Task x result
forall (m :: * -> *) a b c d value.
Applicative m =>
(a -> b -> c -> d -> value) -> m a -> m b -> m c -> m d -> m value
Shortcut.map4

-- |
map5 :: (a -> b -> c -> d -> e -> result) -> Task x a -> Task x b -> Task x c -> Task x d -> Task x e -> Task x result
map5 :: (a -> b -> c -> d -> e -> result)
-> Task x a
-> Task x b
-> Task x c
-> Task x d
-> Task x e
-> Task x result
map5 =
  (a -> b -> c -> d -> e -> result)
-> Task x a
-> Task x b
-> Task x c
-> Task x d
-> Task x e
-> Task x result
forall (m :: * -> *) a b c d e value.
Applicative m =>
(a -> b -> c -> d -> e -> value)
-> m a -> m b -> m c -> m d -> m e -> m value
Shortcut.map5

-- |
map6 :: (a -> b -> c -> d -> e -> f -> result) -> Task x a -> Task x b -> Task x c -> Task x d -> Task x e -> Task x f -> Task x result
map6 :: (a -> b -> c -> d -> e -> f -> result)
-> Task x a
-> Task x b
-> Task x c
-> Task x d
-> Task x e
-> Task x f
-> Task x result
map6 =
  (a -> b -> c -> d -> e -> f -> result)
-> Task x a
-> Task x b
-> Task x c
-> Task x d
-> Task x e
-> Task x f
-> Task x result
forall (m :: * -> *) a b c d e f value.
Applicative m =>
(a -> b -> c -> d -> e -> f -> value)
-> m a -> m b -> m c -> m d -> m e -> m f -> m value
Shortcut.map6

-- | Chain together a task and a callback. The first task will run, and if it is
-- successful, you give the result to the callback resulting in another task. This
-- task then gets run. We could use this to make a task that resolves an hour from
-- now:
--
-- > import qualified Time
-- > import qualified Process
-- >
-- > timeInOneHour : Task x Time.Posix
-- > timeInOneHour =
-- >   Process.sleep (60 * 60 * 1000)
-- >     |> andThen (\_ -> Time.now)
--
-- First the process sleeps for an hour __and then__ it tells us what time it is.
andThen :: (a -> Task x b) -> Task x a -> Task x b
andThen :: (a -> Task x b) -> Task x a -> Task x b
andThen =
  (a -> Task x b) -> Task x a -> Task x b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
Shortcut.andThen

-- | Start with a list of tasks, and turn them into a single task that returns a
-- list. The tasks will be run in order one-by-one and if any task fails the whole
-- sequence fails.
--
-- > sequence [ succeed 1, succeed 2 ] == succeed [ 1, 2 ]
sequence :: List (Task x a) -> Task x (List a)
sequence :: List (Task x a) -> Task x (List a)
sequence List (Task x a)
tasks =
  (Task x a -> Task x (List a) -> Task x (List a))
-> Task x (List a) -> List (Task x a) -> Task x (List a)
forall a b. (a -> b -> b) -> b -> List a -> b
List.foldr ((a -> List a -> List a)
-> Task x a -> Task x (List a) -> Task x (List a)
forall (m :: * -> *) a b value.
Applicative m =>
(a -> b -> value) -> m a -> m b -> m value
Shortcut.map2 (:)) (List a -> Task x (List a)
forall a x. a -> Task x a
succeed []) List (Task x a)
tasks

-- | Start with a list of tasks, and turn them into a single task that returns a
-- list. The tasks will be run in parallel and if any task fails the whole
-- parallel call fails.
--
-- > parallel [ succeed 1, succeed 2 ] == succeed [ 1, 2 ]
parallel :: List (Task x a) -> Task x (List a)
parallel :: List (Task x a) -> Task x (List a)
parallel List (Task x a)
tasks =
  (LogHandler -> IO (Result x (List a))) -> Task x (List a)
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Internal.Task
    ( \LogHandler
handler ->
        List (Task x a) -> (Task x a -> IO (Result x a)) -> IO [Result x a]
forall (t :: * -> *) a b.
Traversable t =>
t a -> (a -> IO b) -> IO (t b)
Async.forConcurrently List (Task x a)
tasks (\Task x a
task -> Task x a -> LogHandler -> IO (Result x a)
forall x a. Task x a -> LogHandler -> IO (Result x a)
Internal._run Task x a
task LogHandler
handler)
          IO [Result x a]
-> (IO [Result x a] -> IO (Result x (List a)))
-> IO (Result x (List a))
forall a b. a -> (a -> b) -> b
|> ([Result x a] -> Result x (List a))
-> IO [Result x a] -> IO (Result x (List a))
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
Shortcut.map [Result x a] -> Result x (List a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
Prelude.sequence
    )

-- | Recover from a failure in a task. If the given task fails, we use the
-- callback to recover.
--
-- > fail "file not found"
-- >   |> onError (\msg -> succeed 42)
-- >   -- succeed 42
-- >
-- > succeed 9
-- >   |> onError (\msg -> succeed 42)
-- >   -- succeed 9
onError :: (x -> Task y a) -> Task x a -> Task y a
onError :: (x -> Task y a) -> Task x a -> Task y a
onError x -> Task y a
func Task x a
task =
  (LogHandler -> IO (Result y a)) -> Task y a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Internal.Task ((LogHandler -> IO (Result y a)) -> Task y a)
-> (LogHandler -> IO (Result y a)) -> Task y a
forall a b. (a -> b) -> a -> b
<| \LogHandler
key ->
    let onResult :: Result x a -> IO (Result y a)
onResult Result x a
result =
          case Result x a
result of
            Ok a
ok -> Result y a -> IO (Result y a)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (a -> Result y a
forall error value. value -> Result error value
Ok a
ok)
            Err x
err -> Task y a -> LogHandler -> IO (Result y a)
forall x a. Task x a -> LogHandler -> IO (Result x a)
Internal._run (x -> Task y a
func x
err) LogHandler
key
     in Task x a -> LogHandler -> IO (Result x a)
forall x a. Task x a -> LogHandler -> IO (Result x a)
Internal._run Task x a
task LogHandler
key
          IO (Result x a)
-> (IO (Result x a) -> IO (Result y a)) -> IO (Result y a)
forall a b. a -> (a -> b) -> b
|> (Result x a -> IO (Result y a))
-> IO (Result x a) -> IO (Result y a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
Shortcut.andThen Result x a -> IO (Result y a)
onResult

-- | Transform the error value. This can be useful if you need a bunch of error
-- types to match up.
--
-- > type Error
-- >   = Http Http.Error
-- >   | WebGL WebGL.Error
-- >
-- > getResources : Task Error Resource
-- > getResources =
-- >   sequence
-- >     [ mapError Http serverTask
-- >     , mapError WebGL textureTask
-- >     ]
mapError :: (x -> y) -> Task x a -> Task y a
mapError :: (x -> y) -> Task x a -> Task y a
mapError x -> y
func Task x a
task =
  Task x a
task Task x a -> (Task x a -> Task y a) -> Task y a
forall a b. a -> (a -> b) -> b
|> (x -> Task y a) -> Task x a -> Task y a
forall x y a. (x -> Task y a) -> Task x a -> Task y a
onError (y -> Task y a
forall x a. x -> Task x a
fail (y -> Task y a) -> (x -> y) -> x -> Task y a
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< x -> y
func)

-- | Run a task. If it doesn't complete within the given number of milliseconds
-- then fail it with the provided error.
--
-- > Process.sleep 2000
-- >   |> timeout 1000 "overslept!"
timeout :: Float -> err -> Task err a -> Task err a
timeout :: Float -> err -> Task err a -> Task err a
timeout Float
duration err
err Task err a
task =
  (LogHandler -> IO (Result err a)) -> Task err a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Internal.Task
    ( \LogHandler
handler -> do
        Maybe (Result err a)
maybeResult <-
          Int -> IO (Result err a) -> IO (Maybe (Result err a))
forall a. Int -> IO a -> IO (Maybe a)
System.Timeout.timeout
            (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
Prelude.round (Float
1000 Float -> Float -> Float
forall number. Num number => number -> number -> number
* Float
duration))
            (Task err a -> LogHandler -> IO (Result err a)
forall x a. Task x a -> LogHandler -> IO (Result x a)
Internal._run Task err a
task LogHandler
handler)
        case Maybe (Result err a)
maybeResult of
          Just Result err a
result -> Result err a -> IO (Result err a)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Result err a
result
          Maybe (Result err a)
Nothing -> Result err a -> IO (Result err a)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (err -> Result err a
forall error value. error -> Result error value
Err err
err)
    )