Footnote:
a variant which lists files under UTI group headings:
use AppleScript version "2.4"
use framework "Foundation"
use framework "Appkit"
use scripting additions
on run
set fldr to filePath("~/Desktop")
script nameAndUTI
on |λ|(strName)
if strName starts with "." then
{}
else
{{name:strName, uti:fileUTI(fldr & "/" & strName)}}
end if
end |λ|
end script
script groupListing
on |λ|(a, gp)
script indented
on |λ|(x)
tab & "- " & (name of x)
end |λ|
end script
a & uti of item 1 of gp & ":" & linefeed & ¬
unlines(map(indented, gp)) & ¬
linefeed & linefeed
end |λ|
end script
fldr & linefeed & linefeed & ¬
foldl(groupListing, "", ¬
groupBy(|on|(my eq, fpUTI), ¬
sortBy(mappendComparing({fpUTI, fpName}), ¬
concatMap(nameAndUTI, getDirectoryContents(fldr)))))
end run
on fpUTI(x)
uti of x
end fpUTI
on fpName(x)
name of x
end fpName
on label(x)
(name of x) -- & tab & (uti of x)
end label
-- GENERIC FUNCTIONS ----------------------------------------------------
-- https://github.com/RobTrew/prelude-applescript
-- Left :: a -> Either a b
on |Left|(x)
{type:"Either", |Left|:x, |Right|:missing value}
end |Left|
-- Right :: b -> Either a b
on |Right|(x)
{type:"Either", |Left|:missing value, |Right|:x}
end |Right|
-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
{type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple
-- bindLR (>>=) :: Either a -> (a -> Either b) -> Either b
on bindLR(m, mf)
if missing value is not |Right| of m then
mReturn(mf)'s |λ|(|Right| of m)
else
m
end if
end bindLR
-- Ordering :: (-1 | 0 | 1)
-- compare :: a -> a -> Ordering
on compare(a, b)
if a < b then
-1
else if a > b then
1
else
0
end if
end compare
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lng to length of xs
if 0 < lng and class of xs is string then
set acc to ""
else
set acc to {}
end if
tell mReturn(f)
repeat with i from 1 to lng
set acc to acc & |λ|(item i of xs, i, xs)
end repeat
end tell
return acc
end concatMap
-- eq :: a -> a -> Bool
on eq(a, b)
a = b
end eq
-- filePath :: String -> FilePath
on filePath(s)
((current application's ¬
NSString's stringWithString:s)'s ¬
stringByStandardizingPath()) as string
end filePath
-- fileStatus :: FilePath -> Either String Dict
on fileStatus(fp)
set e to reference
set {v, e} to current application's NSFileManager's defaultManager's ¬
attributesOfItemAtPath:fp |error|:e
if v is not missing value then
|Right|(v as record)
else
|Left|((localizedDescription of e) as string)
end if
end fileStatus
-- fileUTI :: FilePath -> String
on fileUTI(fp)
set {uti, e} to (current application's ¬
NSWorkspace's sharedWorkspace()'s ¬
typeOfFile:fp |error|:(reference)) as list
if uti is missing value then
e's localizedDescription() as text
else
uti as text
end if
end fileUTI
-- 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
-- getDirectoryContents :: FilePath -> IO [FilePath]
on getDirectoryContents(strPath)
set ca to current application
(ca's NSFileManager's defaultManager()'s ¬
contentsOfDirectoryAtPath:(stringByStandardizingPath of ¬
(ca's NSString's stringWithString:(strPath))) ¬
|error|:(missing value)) as list
end getDirectoryContents
-- Typical usage: groupBy(on(eq, f), xs)
-- groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
on groupBy(f, xs)
set mf to mReturn(f)
script enGroup
on |λ|(a, x)
if length of (active of a) > 0 then
set h to item 1 of active of a
else
set h to missing value
end if
if h is not missing value and mf's |λ|(h, x) then
{active:(active of a) & {x}, sofar:sofar of a}
else
{active:{x}, sofar:(sofar of a) & {active of a}}
end if
end |λ|
end script
if length of xs > 0 then
set dct to foldl(enGroup, {active:{item 1 of xs}, sofar:{}}, tail(xs))
if length of (active of dct) > 0 then
sofar of dct & {active of dct}
else
sofar of dct
end if
else
{}
end if
end groupBy
-- 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
-- mappendComparing :: [(a -> b)] -> (a -> a -> Ordering)
on mappendComparing(fs)
script
on |λ|(x, y)
script
on |λ|(ordr, f)
if ordr ≠ 0 then
ordr
else
tell mReturn(f)
compare(|λ|(x), |λ|(y))
end tell
end if
end |λ|
end script
foldl(result, 0, fs)
end |λ|
end script
end mappendComparing
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- e.g. sortBy(|on|(compare, |length|), ["epsilon", "mu", "gamma", "beta"])
-- on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
on |on|(f, g)
script
on |λ|(a, b)
tell mReturn(g) to set {va, vb} to {|λ|(a), |λ|(b)}
tell mReturn(f) to |λ|(va, vb)
end |λ|
end script
end |on|
-- partition :: predicate -> List -> (Matches, nonMatches)
-- partition :: (a -> Bool) -> [a] -> ([a], [a])
on partition(f, xs)
tell mReturn(f)
set ys to {}
set zs to {}
repeat with x in xs
set v to contents of x
if |λ|(v) then
set end of ys to v
else
set end of zs to v
end if
end repeat
end tell
Tuple(ys, zs)
end partition
-- Enough for small scale sorts.
-- Use instead sortOn :: Ord b => (a -> b) -> [a] -> [a]
-- which is equivalent to the more flexible sortBy(comparing(f), xs)
-- and uses a much faster ObjC NSArray sort method
-- sortBy :: (a -> a -> Ordering) -> [a] -> [a]
on sortBy(f, xs)
if length of xs > 1 then
set h to item 1 of xs
set f to mReturn(f)
script
on |λ|(x)
f's |λ|(x, h) ≤ 0
end |λ|
end script
set lessMore to partition(result, rest of xs)
sortBy(f, |1| of lessMore) & {h} & ¬
sortBy(f, |2| of lessMore)
else
xs
end if
end sortBy
-- tail :: [a] -> [a]
on tail(xs)
if xs = {} then
missing value
else
rest of xs
end if
end tail
-- unlines :: [String] -> String
on unlines(xs)
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set str to xs as text
set my text item delimiters to dlm
str
end unlines
