## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## -----------------------------------------------------------------------------
library(chronicler)

## ----parsermd-chunk-2---------------------------------------------------------
my_sqrt <- function(x){

  sqrt(x)

}


## ----parsermd-chunk-3---------------------------------------------------------
my_sqrt <- function(x, log = ""){

  list(sqrt(x),
       c(log,
         paste0("Running sqrt with input ", x)))

}


## ----parsermd-chunk-4---------------------------------------------------------
my_log <- function(x, log = ""){

  list(log(x),
       c(log,
         paste0("Running log with input ", x)))

}


## ----parsermd-chunk-5---------------------------------------------------------
10 |>
  sqrt() |>
  log()


## ----parsermd-chunk-6, eval = FALSE-------------------------------------------
# 10 |>
#   my_sqrt() |>
#   my_log()
# 

## ----parsermd-chunk-7---------------------------------------------------------
log_it <- function(.f, ..., log = NULL){

  fstring <- deparse(substitute(.f))

  function(..., .log = log){

    list(result = .f(...),
         log = c(.log,
                 paste0("Running ", fstring, " with argument ", ...)))
  }
}


## ----parsermd-chunk-8---------------------------------------------------------
l_sqrt <- log_it(sqrt)

l_sqrt(10)

l_log <- log_it(log)

l_log(10)


## ----parsermd-chunk-9---------------------------------------------------------
bind <- function(.l, .f, ...){

  .f(.l$result, ..., .log = .l$log)

}

## ----parsermd-chunk-10--------------------------------------------------------
10 |>
  l_sqrt() |>
  bind(l_log)


## ----parsermd-chunk-11--------------------------------------------------------
log(sqrt(10))

## ----parsermd-chunk-12--------------------------------------------------------
unit <- log_it(identity)

## ----parsermd-chunk-13--------------------------------------------------------
fmap <- function(m, f, ...){

  fstring <- deparse(substitute(f))

  list(result = f(m$result, ...),
       log = c(m$log,
               paste0("fmapping ", fstring, " with arguments ", paste0(m$result, ..., collapse = ","))))
}


## ----parsermd-chunk-14--------------------------------------------------------
# Let’s use unit(), which we defined above, for this.

(m <- unit(10))

## ----parsermd-chunk-15--------------------------------------------------------
fmap(m, log)

## ----parsermd-chunk-16--------------------------------------------------------
fmap(m, l_log)

## ----parsermd-chunk-17--------------------------------------------------------
flatten <- function(m){

  list(result = m$result$result,
       log = c(m$log))

}


## ----parsermd-chunk-18--------------------------------------------------------
flatten(fmap(m, l_log))

## ----parsermd-chunk-19--------------------------------------------------------
# I first define a composition operator for functions
`%.%` <- \(f,g)(function(...)(f(g(...))))

# I now compose flatten() and fmap()
# flatten %.% fmap is read as "flatten after fmap"
flatmap <- flatten %.% fmap


## ----parsermd-chunk-20--------------------------------------------------------
10 |>
  l_sqrt() |>
  bind(l_log)


## ----parsermd-chunk-21--------------------------------------------------------
10 |>
  l_sqrt() |>
  flatmap(l_log)


## ----parsermd-chunk-22--------------------------------------------------------
# Since I'm using `{purrr}`, might as well use purrr::compose() instead of my own implementation
flatmap_list <- purrr::compose(purrr::flatten, purrr::map)

# Functions that return lists: they don't compose!
# no worries, we implemented `flatmap_list()`
list_sqrt <- \(x)(as.list(sqrt(x)))
list_log <- \(x)(as.list(log(x)))

10 |>
  list_sqrt() |>
  flatmap_list(list_log)


## ----parsermd-chunk-23--------------------------------------------------------
a <- as_chronicle(10)
r_sqrt <- record(sqrt)

testthat::test_that("first monadic law", {
  testthat::expect_equal(bind_record(a, r_sqrt)$value, r_sqrt(10)$value)
})


## ----parsermd-chunk-24--------------------------------------------------------
testthat::test_that("second monadic law", {
  testthat::expect_equal(bind_record(a, as_chronicle)$value, a$value)
})


## ----parsermd-chunk-25--------------------------------------------------------
a <- as_chronicle(10)

r_sqrt <- record(sqrt)
r_exp <- record(exp)
r_mean <- record(mean)

testthat::test_that("third monadic law", {
  testthat::expect_equal(
  (
    (bind_record(a, r_sqrt)) |>
   bind_record(r_exp)
  )$value,
  (
    a |>
    (\(x) bind_record(x, r_sqrt) |> bind_record(r_exp))()
  )$value
  )
})


## ----parsermd-chunk-26--------------------------------------------------------

r_sqrt <- record(sqrt)
r_exp <- record(exp)
r_mean <- record(mean)

a <- 1:10 |>
  r_sqrt() |>
  bind_record(r_exp) |>
  bind_record(r_mean)

flatmap_record <- purrr::compose(flatten_record, fmap_record)

b <- 1:10 |>
  r_sqrt() |>
  flatmap_record(r_exp) |>
  flatmap_record(r_mean)

identical(a$value, b$value)