186 lines
4.1 KiB
AppleScript
186 lines
4.1 KiB
AppleScript
-- quibble :: [String] -> String
|
|
on quibble(xs)
|
|
if length of xs > 1 then
|
|
set applyCommas to ¬
|
|
compose([curry(my intercalate)'s |λ|(", "), my |reverse|, my tail])
|
|
|
|
intercalate(" and ", ap({applyCommas, my head}, {|reverse|(xs)}))
|
|
else
|
|
concat(xs)
|
|
end if
|
|
end quibble
|
|
|
|
-- TEST -----------------------------------------------------------------------
|
|
on run
|
|
script braces
|
|
on |λ|(x)
|
|
"{" & x & "}"
|
|
end |λ|
|
|
end script
|
|
|
|
unlines(map(compose({braces, quibble}), ¬
|
|
append({{}, {"ABC"}, {"ABC", "DEF"}, {"ABC", "DEF", "G", "H"}}, ¬
|
|
map(|words|, ¬
|
|
{"One two three four", "Me myself I", "Jack Jill", "Loner"}))))
|
|
end run
|
|
|
|
|
|
-- GENERIC FUNCTIONS ----------------------------------------------------------
|
|
|
|
-- A list of functions applied to a list of arguments
|
|
-- (<*> | ap) :: [(a -> b)] -> [a] -> [b]
|
|
on ap(fs, xs)
|
|
set {intFs, intXs} to {length of fs, length of xs}
|
|
set lst to {}
|
|
repeat with i from 1 to intFs
|
|
tell mReturn(item i of fs)
|
|
repeat with j from 1 to intXs
|
|
set end of lst to |λ|(contents of (item j of xs))
|
|
end repeat
|
|
end tell
|
|
end repeat
|
|
return lst
|
|
end ap
|
|
|
|
-- (++) :: [a] -> [a] -> [a]
|
|
on append(xs, ys)
|
|
xs & ys
|
|
end append
|
|
|
|
-- compose :: [(a -> a)] -> (a -> a)
|
|
on compose(fs)
|
|
script
|
|
on |λ|(x)
|
|
script
|
|
on |λ|(a, f)
|
|
mReturn(f)'s |λ|(a)
|
|
end |λ|
|
|
end script
|
|
|
|
foldr(result, x, fs)
|
|
end |λ|
|
|
end script
|
|
end compose
|
|
|
|
-- concat :: [[a]] -> [a] | [String] -> String
|
|
on concat(xs)
|
|
script append
|
|
on |λ|(a, b)
|
|
a & b
|
|
end |λ|
|
|
end script
|
|
|
|
if length of xs > 0 and class of (item 1 of xs) is string then
|
|
set unit to ""
|
|
else
|
|
set unit to {}
|
|
end if
|
|
foldl(append, unit, xs)
|
|
end concat
|
|
|
|
-- curry :: (Script|Handler) -> Script
|
|
on curry(f)
|
|
script
|
|
on |λ|(a)
|
|
script
|
|
on |λ|(b)
|
|
|λ|(a, b) of mReturn(f)
|
|
end |λ|
|
|
end script
|
|
end |λ|
|
|
end script
|
|
end curry
|
|
|
|
-- foldl :: (a -> b -> a) -> a -> [b] -> a
|
|
on foldl(f, startValue, xs)
|
|
tell mReturn(f)
|
|
set v to startValue
|
|
set lng to length of xs
|
|
repeat with i from 1 to lng
|
|
set v to |λ|(v, item i of xs, i, xs)
|
|
end repeat
|
|
return v
|
|
end tell
|
|
end foldl
|
|
|
|
-- foldr :: (a -> b -> a) -> a -> [b] -> a
|
|
on foldr(f, startValue, xs)
|
|
tell mReturn(f)
|
|
set v to startValue
|
|
set lng to length of xs
|
|
repeat with i from lng to 1 by -1
|
|
set v to |λ|(v, item i of xs, i, xs)
|
|
end repeat
|
|
return v
|
|
end tell
|
|
end foldr
|
|
|
|
-- head :: [a] -> a
|
|
on head(xs)
|
|
if length of xs > 0 then
|
|
item 1 of xs
|
|
else
|
|
missing value
|
|
end if
|
|
end head
|
|
|
|
-- intercalate :: Text -> [Text] -> Text
|
|
on intercalate(strText, lstText)
|
|
set {dlm, my text item delimiters} to {my text item delimiters, strText}
|
|
set strJoined to lstText as text
|
|
set my text item delimiters to dlm
|
|
return strJoined
|
|
end intercalate
|
|
|
|
-- map :: (a -> b) -> [a] -> [b]
|
|
on map(f, xs)
|
|
tell mReturn(f)
|
|
set lng to length of xs
|
|
set lst to {}
|
|
repeat with i from 1 to lng
|
|
set end of lst to |λ|(item i of xs, i, xs)
|
|
end repeat
|
|
return lst
|
|
end tell
|
|
end map
|
|
|
|
-- Lift 2nd class handler function into 1st class script wrapper
|
|
-- mReturn :: Handler -> Script
|
|
on mReturn(f)
|
|
if class of f is script then
|
|
f
|
|
else
|
|
script
|
|
property |λ| : f
|
|
end script
|
|
end if
|
|
end mReturn
|
|
|
|
-- |reverse| :: [a] -> [a]
|
|
on |reverse|(xs)
|
|
if class of xs is text then
|
|
(reverse of characters of xs) as text
|
|
else
|
|
reverse of xs
|
|
end if
|
|
end |reverse|
|
|
|
|
-- tail :: [a] -> [a]
|
|
on tail(xs)
|
|
if length of xs > 1 then
|
|
items 2 thru -1 of xs
|
|
else
|
|
{}
|
|
end if
|
|
end tail
|
|
|
|
-- unlines :: [String] -> String
|
|
on unlines(xs)
|
|
intercalate(linefeed, xs)
|
|
end unlines
|
|
|
|
-- words :: String -> [String]
|
|
on |words|(s)
|
|
words of s
|
|
end |words|
|