120 lines
3.1 KiB
AppleScript
120 lines
3.1 KiB
AppleScript
-- WRITER MONAD FOR APPLESCRIPT
|
|
|
|
-- How can we compose functions which take simple values as arguments
|
|
-- but return an output value which is paired with a log string ?
|
|
|
|
-- We can prevent functions which expect simple values from choking
|
|
-- on log-wrapped output (from nested functions)
|
|
-- by writing Unit/Return() and Bind() for the Writer monad in AppleScript
|
|
|
|
on run {}
|
|
|
|
-- Derive logging versions of three simple functions, pairing
|
|
-- each function with a particular comment string
|
|
|
|
-- (a -> b) -> (a -> (b, String))
|
|
set wRoot to writerVersion(root, "obtained square root")
|
|
set wSucc to writerVersion(succ, "added one")
|
|
set wHalf to writerVersion(half, "divided by two")
|
|
|
|
loggingHalfOfRootPlusOne(5)
|
|
|
|
--> value + log string
|
|
end run
|
|
|
|
|
|
-- THREE SIMPLE FUNCTIONS
|
|
on root(x)
|
|
x ^ (1 / 2)
|
|
end root
|
|
|
|
on succ(x)
|
|
x + 1
|
|
end succ
|
|
|
|
on half(x)
|
|
x / 2
|
|
end half
|
|
|
|
-- DERIVE A LOGGING VERSION OF A FUNCTION BY COMBINING IT WITH A
|
|
-- LOG STRING FOR THAT FUNCTION
|
|
-- (SEE 'on run()' handler at top of script)
|
|
-- (a -> b) -> String -> (a -> (b, String))
|
|
on writerVersion(f, strComment)
|
|
script
|
|
on call(x)
|
|
{value:sReturn(f)'s call(x), comment:strComment}
|
|
end call
|
|
end script
|
|
end writerVersion
|
|
|
|
|
|
-- DEFINE A COMPOSITION OF THE SAFE VERSIONS
|
|
on loggingHalfOfRootPlusOne(x)
|
|
logCompose([my wHalf, my wSucc, my wRoot], x)
|
|
end loggingHalfOfRootPlusOne
|
|
|
|
|
|
-- Monadic UNIT/RETURN and BIND functions for the writer monad
|
|
on writerUnit(a)
|
|
try
|
|
set strValue to ": " & a as string
|
|
on error
|
|
set strValue to ""
|
|
end try
|
|
{value:a, comment:"Initial value" & strValue}
|
|
end writerUnit
|
|
|
|
on writerBind(recWriter, wf)
|
|
set recB to wf's call(value of recWriter)
|
|
set v to value of recB
|
|
|
|
try
|
|
set strV to " -> " & (v as string)
|
|
on error
|
|
set strV to ""
|
|
end try
|
|
|
|
{value:v, comment:(comment of recWriter) & linefeed & (comment of recB) & strV}
|
|
end writerBind
|
|
|
|
-- THE TWO HIGHER ORDER FUNCTIONS ABOVE ENABLE COMPOSITION OF
|
|
-- THE LOGGING VERSIONS OF EACH FUNCTION
|
|
on logCompose(lstFunctions, varValue)
|
|
reduceRight(lstFunctions, writerBind, writerUnit(varValue))
|
|
end logCompose
|
|
|
|
-- xs: list, f: function, a: initial accumulator value
|
|
-- the arguments available to the function f(a, x, i, l) are
|
|
-- v: current accumulator value
|
|
-- x: current item in list
|
|
-- i: [ 1-based index in list ] optional
|
|
-- l: [ a reference to the list itself ] optional
|
|
on reduceRight(xs, f, a)
|
|
set sf to sReturn(f)
|
|
|
|
repeat with i from length of xs to 1 by -1
|
|
set a to sf's call(a, item i of xs, i, xs)
|
|
end repeat
|
|
end reduceRight
|
|
|
|
-- Unit/Return and bind for composing handlers in script wrappers
|
|
-- lift 2nd class function into 1st class wrapper
|
|
-- handler function --> first class script object
|
|
on sReturn(f)
|
|
script
|
|
property call : f
|
|
end script
|
|
end sReturn
|
|
|
|
-- return a new script in which function g is composed
|
|
-- with the f (call()) of the Mf script
|
|
-- Mf -> (f -> Mg) -> Mg
|
|
on sBind(mf, g)
|
|
script
|
|
on call(x)
|
|
sReturn(g)'s call(mf's call(x))
|
|
end call
|
|
end script
|
|
end sBind
|