hfmAnnotation: HFM Internal Package for Annotations

#' @importFrom assertthat assert_that

library("assertthat")

#' Represent values that exist.
#'
#' One of the choice types for a Maybe monad (the other being Nothing)
#'
#' Based off the Maybe monad in Haskell and Elm but similar in construction to
#' the result "monad" supplied by purrr::safely(). A Maybe monad is a choice type:
#' it is either \code{Just(a_value)} or it is \code{Nothing()}. It can be used
#' to document optional arguments, force proper error handling, and deal with
#' lists/records with optional entries. It can be useful if you have a value
#' that is only filled in sometimes. Or if a function takes a value sometimes,
#' but does not absolutely need it. Or if a function would otherwise return
#' a NULL. The Maybe type reminds users of your code to remember to handle both
#' possible states: when the value exists and when it does not.
#'
#' @format Just :: a -> Maybe a
#'
#' @family Maybe type
#'
#' @param a A value of any non-null type
#'
#' @return An Maybe type (a wrapper around the original value of type 'a')
#'
#' @examples
#' safer_division <- function(x, y) { if (y == 0) { Nothing() } else { Just(x / y) } }
#' safer_division(1, 2) # Just(0.5)
#' safer_division(1, 0) # Nothing()
#'
#' \dontrun{safer_division(1, NULL)}
#' # Runtime error:
#' # ... argument is of length zero
#'
#' @export
#'
Just <-
  function(a) {
    assert_that(!is.null(a))

    list(value = a)
  }


#' Represents values that do not exist
#'
#' One of the choice types for the Maybe monad (the other being Just)
#'
#' Return this type instead of using NULL.
#'
#' @format Nothing :: () -> Maybe ()
#'
#' @family Maybe type
#'
#' @return A Maybe type
#'
#' @export
#'
Nothing <-
  function() {
    list(value = NULL)
  }


is_maybe <-
  function(m) {
    !is.null(m) &&
      is.list(m) &&
      is.element(names(m), "value")
  }


#' Determines whether or not its value is of type Nothing
#'
#' @format is_nothing :: Maybe a -> Boolean
#'
#' @family Maybe functions
#'
#' @param m A Maybe type object (Just | Nothing)
#'
#' @return A boolean indicating whether its value is of type Nothing
#'
#' @examples
#' is_nothing(Nothing()) # TRUE
#' is_nothing(Just(1)) # FALSE
#'
#' \dontrun{is_none(NA) # ERROR}
#' \dontrun{is_none(NULL) # ERROR}
#'
#' @export
#'
is_nothing <-
  function(m) {
    assert_that(is_maybe(m))

    is.null(m$value)
  }


is_just <-
  function(a) {
    is_maybe(a) && !is.null(a$value)
  }


#' Provide a default value, turning an optional value into a normal value.
#'
#' For when you truly need to unpack the original value before you can continue
#'     operations. Try to avoid using this. Preferably, it should only be used
#'     at the end of a chain of function calls - all preceding function calls
#'     should be lifted to operate on Maybe types.
#'
#' N.B. Don't access the maybe element of the underlying list directly (i.e, never
#'     write \code{my_value$value}), always access the value using maybe_default().
#'
#' @format maybe_default :: Maybe a -> a -> a
#'
#' @family Maybe functions
#'
#' @param m A Maybe type object (Just or Nothing)
#' @param default A value to return if m is Nothing. Cannot be null.
#'
#' @return The contained value or, if m is Nothing, the default value
#'
#' @examples
#' maybe_default(Just(42), 100) # 42
#' maybe_default(Nothing(), 100) # 100
#'
#' @export
#'
maybe_default <-
  function(m, default) {
    assert_that(is_maybe(m), !is.null(default))

    if (is_nothing(m)) {
      default
    } else {
      m$value
    }
  }


#' Convert value of any type to a Maybe type
#'
#' In functional programming, this function would be called "return"
#'     as it *returns* a value of type Maybe. To avoid name collision, and
#'     to follow the convention for existing types, the coversion function is
#'     instead named "as_maybe"
#'
#' @format as_maybe :: a -> Maybe a
#'
#' @family Maybe functions
#'
#' @param a Any type of value
#'
#' @return A Maybe type
#'
#' @examples
#' as_maybe(42) # Just(42)
#' as_maybe(Just(42)) # Just(Just(42))
#' as_maybe(NULL) # Nothing()
#'
#' @export
#'
as_maybe <-
  function(a) {
    if (is.null(a)) {
      Nothing()
    } else {
      Just(a)
    }
  }


#' Convert a one-track function to a two-track function.
#'
#'  A “bind” function or method can be thought of as feeding an
#'     input value to a function. This is known as “binding” a value to the
#'     parameter of the function. When you need to use a function that does
#'     not already take a Maybe type argument, use maybe_bind to "lift" a
#'     new function that *does* take a Maybe type argument.
#'
#' @format maybe_bind :: (a -> b) -> (Maybe a -> Maybe b)
#'
#' @family Maybe functions
#'
#' @param f A function taking a non-optional (one-track) argument and returning
#'     an optional (two-track) value.
#'
#' @return A function taking an optional (two-track) argument and returning
#'     an optional (two-track) value.
#'
#' @examples
#' library(assertthat)
#' is_maybe_numeric <- maybe_bind(is.numeric)
#' is_maybe_numeric(Just(1)) # Just(TRUE)
#' is_maybe_numeric(Just("cat")) # Just(FALSE)
#' is_maybe_numeric(Nothing()) # Nothing()
#'
#' @export
#'
maybe_bind <- function(f) {
  function(m) {
    assert_that(is_maybe(m))

    if (is_nothing(m)) {
      m
    } else {
      f_ <-
        purrr::as_mapper(f)

      m_ <-
        f_(m$value)

      if (is_maybe(m_)) {
        m_
      }
      else {
        as_maybe(m_)
      }
    }
  }
}


#' Chain together many computations that may fail (return Nothing()).
#'
#'  Binds then calls function. If the first argument, m, is Nothing()
#'    any chain of operations will short-circuit and result in Nothing()
#'
#' @format maybe_then :: Maybe a -> (a -> Maybe b) -> Maybe b
#'
#' @family Maybe functions
#'
#' @param m A Maybe (two-track) value.
#'
#' @param f A function taking a non-optional (one-track) argument and returning
#'     an optional (two-track) value. May or may not be called.
#'
#' @return Nothing() if the m is Nothing(). Otherwise the result of applying the function
#'
#' @export
#'
maybe_then <-
  function(m, f) {
    maybe_bind(f)(m)
  }


#' Apply a one-track function to a two-track argument.
#'
#' Similar to "bind" but maybe_map passes its argument to the
#'     continuation function and evaluates the resulting expression
#'     immediately rather than wrapping it in an anonymous function to be
#'     evaluated later. This is particular useful when using magrittr %>%
#'     piping operators to compose chains of function calls.
#'
#' @format maybe_map :: Maybe a -> (a -> b) -> Maybe b
#'
#' @family Maybe functions
#'
#' @param m A Maybe (two-track) value.
#'
#' @param f A function taking a non-optional (one-track) argument and returning
#'     a non-optional (one-track) value.
#'
#' @return A Maybe (two-track) value
#'
#' @examples
#'
#' library("magrittr")
#' library(assertthat)
#' Just(1) %>% maybe_map(is.numeric) # Just(TRUE)
#' Just("cat") %>% maybe_map(is.numeric) # Just(FALSE)
#' Nothing() %>% maybe_map(is.numeric) # Nothing()
#'
#' @export
#'
maybe_map <-
  function(m, f) {
    assert_that(is_maybe(m))

    if (is_nothing(m)) {
      Nothing()
    } else {
      f_ <-
        purrr::as_mapper(f)

      as_maybe(f_(m$value))
    }
  }



#' Apply a one-track function to 2 two-track arguments.
#'
#' Similar to maybe_map but for input of two Maybe type values.
#' Cannot use purrr-style lambdas (~ .x).
#'
#' @format maybe_map_2 :: Maybe a -> Maybe b -> (a -> b -> c) -> Maybe c
#'
#' @family Maybe functions
#'
#' @param a A Maybe (two-track) value.
#'
#' @param b A Maybe (two-track) value.
#'
#' @param f A function taking two non-Maybe (one-track) arguments and returning
#'     either a non-Maybe (one-track) value or a Maybe (two-track) value.
#'
#' @return A Maybe (two-track) value
#'
#' @export
#'
maybe_map_2 <-
  function(a, b, f) {
    arguments_ <-
      list(a, b)

    assert_that(all(sapply(arguments_, is_maybe)))

    if (any(sapply(arguments_, is_nothing))) {
      Nothing()
    } else {
      m <-
        f(a$value, b$value)

      if (is_maybe(m)) {
        m
      } else {
        as_maybe(m)
      }
    }
  }


#' Apply a one-track function to 3 two-track arguments.
#'
#' Similar to maybe_map but for input of three Maybe type values.
#' Cannot use purrr-style lambdas (~ .x).
#'
#' @format maybe_map_3 :: Maybe a -> Maybe b -> Maybe c -> (a -> b -> c -> d) -> Maybe d
#'
#' @family Maybe functions
#'
#' @param a A Maybe (two-track) value.
#'
#' @param b A Maybe (two-track) value.
#'
#' @param c A Maybe (two-track) value.
#'
#' @param f A function taking three non-Maybe (one-track) arguments and returning
#'     either a non-Maybe (one-track) value or a Maybe (two-track) value.
#'
#' @return A Maybe (two-track) value
#'
#' @export
#'
maybe_map_3 <-
  function(a, b, c, f) {
    arguments <-
      list(a, b, c)

    assert_that(all(sapply(arguments, is_maybe)))

    if (any(sapply(arguments, is_nothing))) {
      Nothing()
    } else {
      m <-
        f(a$value, b$value, c$value)

      if (is_maybe(m)) {
        m
      } else {
        as_maybe(m)
      }
    }
  }


#' Apply a one-track function to 4 two-track arguments.
#'
#' Similar to maybe_map but for input of four Maybe type values.
#' Cannot use purrr-style lambdas (~ .x).
#'
#' @format maybe_map_4 :: Maybe a -> Maybe b -> Maybe c -> Maybe d -> (a -> b -> c -> d -> x) -> Maybe x
#'
#' @family Maybe functions
#'
#' @param a A Maybe (two-track) value.
#'
#' @param b A Maybe (two-track) value.
#'
#' @param c A Maybe (two-track) value.
#'
#' @param d A Maybe (two-track) value.
#'
#' @param f A function taking four non-Maybe (one-track) arguments and returning
#'     either a non-Maybe (one-track) value or a Maybe (two-track) value.
#'
#' @return A Maybe (two-track) value
#'
#' @export
#'
maybe_map_4 <-
  function(a, b, c, d, f) {
    arguments <-
      list(a, b, c, d)

    assert_that(all(sapply(arguments, is_maybe)))

    if (any(sapply(arguments, is_nothing))) {
      Nothing()
    } else {
      m <-
        f(a$value, b$value, c$value, d$value)

      if (is_maybe(m)) {
        m
      } else {
        as_maybe(m)
      }
    }
  }


#' Apply a one-track function to 5 two-track arguments.
#'
#' Similar to maybe_map but for input of five Maybe type values.
#' Cannot use purrr-style lambdas (~ .x).
#'
#' @format maybe_map_5 :: Maybe a -> Maybe b -> Maybe c -> Maybe d -> Maybe x -> (a -> b -> c -> d -> x -> y) -> Maybe y
#'
#' @family Maybe functions
#'
#' @param a A Maybe (two-track) value.
#'
#' @param b A Maybe (two-track) value.
#'
#' @param c A Maybe (two-track) value.
#'
#' @param d A Maybe (two-track) value.
#'
#' @param x A Maybe (two-track) value.
#'
#' @param f A function taking four non-Maybe (one-track) arguments and returning
#'     either a non-Maybe (one-track) value or a Maybe (two-track) value.
#'
#' @return A Maybe (two-track) value
#'
#' @export
#'
maybe_map_5 <-
  function(a, b, c, d, x, f) {
    arguments <-
      list(a, b, c, d, x)

    assert_that(all(sapply(arguments, is_maybe)))

    if (any(sapply(arguments, is_nothing))) {
      Nothing()
    } else {
      m <-
        f(a$value, b$value, c$value, d$value, x$value)

      if (is_maybe(m)) {
        m
      } else {
        as_maybe(m)
      }
    }
  }


#' Apply a Maybe function to a Maybe argument
#'
#' @description For handling instances where your code calls a function
#'     that was created by a generator (where the generator may not have
#'     returned a function).
#'
#' @format maybe_apply :: Maybe a -> (Maybe a -> Maybe b) -> Maybe b
#'
#' @family Maybe functions
#'
#' @param m A Maybe value.
#'
#' @param mf A Maybe function (i.e., there may or may not be a function).
#'
#' @return A Maybe value
#'
#' @export
#'
maybe_apply <-
  function(m, mf) {
    assert_that(is_maybe(m), is_maybe(mf))

    if (is_nothing(mf)) {
      Nothing()
    } else {
      maybe_map(m, mf$value)
    }
  }



#' Partition a list of "Maybe a" type values into a list containing a
#' list of Just(a) values and a list of Nothing() values.
#'
#' @format maybes_partition :: List (Maybe a) -> List(List Just a, List Nothing)
#'
#' @family Maybe functions
#'
#' @param maybes A list of "Maybe a" type values
#'
#' @return A list containing a list of Just(a) values and a list of Nothing() values.
#'
#' @export
#'
maybes_partition <-
  function(maybes) {
    assert_that(all(sapply(maybes, is_maybe)))

    list(
      justs = purrr::keep(maybes, is_just),
      nothings = purrr::keep(maybes, is_nothing)
    )
  }


#' Collapse a list of "Maybe a" type values into a list of "a" type values.
#' If any element of the list is an Nothing type value, return the Nothing.
#'
#' @format maybes_collapse :: List (Maybe a) -> Maybe (List a)
#'
#' @family Maybe functions
#'
#' @param maybes A list of "Maybe a" type values
#'
#' @return Either Just(List a) type values or Nothing()
#'
#' @export
#'
maybes_collapse <-
  function(maybes) {
    assert_that(all(sapply(maybes, is_maybe)))

    grouped <-
      maybes %>%
      maybes_partition

    if (length(grouped$nothings) > 0) {
      Nothing()
    } else {
      grouped$justs %>%
        purrr::map(~ .x$value) %>%
        Just()
    }
  }