Data commit

Task/Comma-quibbling/AppleScript/comma-quibbling.applescript

@@ -0,0 +1,185 @@
+-- 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|