Searching Text for paragraph after colon

Hello, first-time postings so I am sorry if the formatting is off or I'm not clear explaining.

I am looking for help designing a macro that will select specified text within a paragraph, copy it, and the put it in a different field within an application (PS Suite - Telus medical EMR software). I can click/highlight the entire text block as I don't think the OS can search for text within that application, but I can certainly copy the entire block of text to clipboard

BLOCK OF TEXT BELOW:

PATHOLOGY: Cancer
Fam History: Mother had colon cancer at age 52
Alcohol consumption: 4 beers/week
Smoking: Non-smoker

I want a macro that will select Cancer, then paste in a desired location, then come back and get "Mother had colon cancer at age 52" then paste it in a [Different] desired location. Repeated for "4 beers/week", and "Non-smoker". Sometimes there will be long answers, sometimes short answers, fields will always have something in them, and all fields (Fam history, alcohol consumption, etc are fixed, as are the destinations within the app.

I have the pasting into specific fields sorted using click at selected location function.

Please see attached screen shot for examples of before and after the macro runs what the desired result will be


Thanks for any help you can provide!!!

No worries. Indeed, I think you did better at explaining it than most new posters. You even included a before and after image. (Although I still can't tell from the images if the data on the right is the destination of the data on the left, or if the data on the right is in another app or just another window in the same app.)

It sounds like you already have a macro that does something (i.e., you said, "I have the pasting into specific fields sorted using click at selected location function.") Are you willing to show us the macro so we can get another way of seeing what you are doing?

And how is the top half of the image the "before image" if the top right hand side already contains the data you are trying to transfer there? I see no change on the right hand side's "before" and "after."

To me, this sounds like a job for a dictionary. I made some assumptions about the input format (mainly that there are no line breaks in the individual history items) and built a short macro that creates a dictionary from the text on the clipboard.

Medical History Stub.kmmacros (3.3 KB)

Image of macro

You get the text of the dictionary items with, for example,

%Dictionary[Local_MedHistory, fam history]%

where the keys to the dictionary items are in lower case. Since you said you've worked out how to enter the items into the form, this should be all you need.

If I've misinterpreted what you want, we can try again.

1 Like

Thats outstanding - thanks very much drdrang.

I added a few fields to the @keys, and figured how modifying the display text function will give me whatever output I'm looking for.

To simplify the display, I changed the "Display text" command to a "Set Named Clipboard to text" function, and created a named clipboard for each field which will then get called on to dump into the relevant fields.

Many thanks! This is going to work like a charm!

You do have a good point about line breaks. Some of the additional fields may end up having line breaks - is that a more complicated solution? I can probably have the source document produced in such a way as to avoid line breaks, but for formatting sake it might be an easier read if that's still an option.

I have zero knowledge of scripting, so don't really know where to start to solve that issue.

John

Thanks Sleepy,

It's all in the same app, the right side is a series of dated entires in a chart. Theres an integration app that generates a lot of the patient history (medications, allergies, family history, etc) that the patient fills out and it appears as a note on the right side as a block of text separated only by those Titles plus colons.

That data is nice to have distributed into specific fields, which the integration app doesn't offer (leaving us to figure out a solution on our own - either having a secretary copy and paste all the data which is time consuming and inaccurate, or dictating off that data, or copy/pasting ourselves etc). Feels like I'm doing the work that the computer should be doing haha!

The goal is to essentially keep the data on the right intact, read it with the macro. Dump the data into the fields on the left based on category.

Then other functions of the medical record that are built in can call upon that data. That secondary part, calling on the data, is all built into the software, the battle is in getting the data into those fields on the left.

As an example if I have a referral form to another doctor that needs to be filled out with the patients information, it may be what the software calls a "custom form" - that "custom form" may have the heading of "family history". Right now I basically have to paste the family history, but I can modify the custom form to suck data out of the "Fam History" heading and put it into that form every time.

Reliable, safer documentation, faster more efficient record keeping etc. Win for everyone.

Move Mouse to Past Medical History, paste clipboard contents.kmmacros (29.7 KB)

I have attached the Macro that I came up with to find the "Past Medical History" tab (that's another field that wasn't included in original example). What the macro does is pastes the contents of the system clipboard into a field.

The first step is for it to move to the heading, and left click.
That opens another window.
It starts with the cursor flashing at the top so you can paste directly. So the paste action does that. I'm planning to switch it to pasting from a named clipboard relevant to each heading as per the comments below.
Then it finds the OK button at the end of that series of text, as I can't seem to find a hotkey that closes that window in the software.
That returns the view to the main screen where it can go on and click the next heading (Pathology, fam history, alcohol, smoking, etc).

Okay, now I think I get it.

But since you solved the problem, and marked the problem as solved, there's nothing more for me to do.

Since it's solved, you don't need a different way. But there's always different ways. My approach would have been to try to find keyboard keys that do most of the work rather than the mouse. For example there's probably a keyboard key that selects the text on the right (I can see the cursor, so it's probably CMD-A) then a key to copy the next (probably CMD-C). Then I would look for a tab character that moves you to the fields on the left side of the screen. Then I would use a KM action to paste the last line into the first field, then I'd tab to the next field, then I'd repeat this until all four fields are filled. Keyboard keys tend to be more reliable, and you probably have a lot of data to process.

@drdrang

Thank you very much.

I’ve implemented it and works perfectly… except for as you said line breaks.

I tried to oversimplify the text input in the original post for clarity not realizing the importance of line breaks. If there are line breaks included in the field is there a solution? For readability there are line breaks in many (but not all) of the fields.

Lesson learned - use real world examples.

Line breaks in the history item text will make the Perl code more cluttered. I’m going to assume that colons may also be in that text, so we can’t use that for splitting into sections.

Do you have an exhaustive list of the field names? If so, we can use those to break up the text.

Thanks again.

I might be making this too open ended, but I can completely control the formatting of the source data as far as spaces, or characters to allow whatever implementation is possible. The field names are a bit different than original example. There would be a risk of a colon within free text fields, so yes, that on its own won't work as the defining feature, unfortunately.

Fields currently:

REASON FOR REFERRAL:
PAST MEDICAL HISTORY:
MEDICATIONS:
ALLERGIES:
SOCIAL HISTORY:
FAMILY HISTORY:
HISTORY OF PRESENTING ILLNESS:

Other field names that may be nice to have in future would include:

CONSENT:
QUESTIONS:

Couple of points:

  • If needed I can get text to start on same line as field (as my original inquiry), but it doesn't look as readable.

- Could we possibly just use the line breaks (Have a BLANK line above every heading/"KEY" - pretty much as it is formatted now, apart from the first field "Reason for referral").

(empty line)
HEADING1
data1
data1
(empty line)
HEADING2
data2
(empty line)
HEADING3
data3
data3
data3
data3

  • Alternativley, while not preferred to above approach, I could certainly add multiple identifying characters to a field if it makes it easier to define for example /FIELD/

(Ie. /REASON FOR REFERRAL:/) or something like that so that I can add anything as a variable later. Those extra characters won't appear in the final document as the final document comes from the extracted data, and doesn't care what variable/field names were in the source document.

  • There are funny « and » characters that the software uses, they are to allow quick edits of stuff patients typed, I plan on doing the corrections to the source data before running the script, so they don't appear in the final product, but figured I'd leave them incase there's a stray somewhere in the source data so it can be accounted for to avoid errors.

Patient intake form

REASON FOR REFERRAL: Weight loss

PAST MEDICAL HISTORY:
T1DM; DLP; VTE; Rheumatoid arthritis
Breast cancer: 1994
Surgery: «Lumpectomy».
No prior endoscopic assessments.

MEDICATIONS:
Tylenol: 1g/day
Advil
Tamoxifen
Does not take naturopathic or herbal medications.

ALLERGIES:
Penicillin - nausea; vomiting
Sulfa - anaphylaxis

SOCIAL HISTORY:
They are presently working - Farmer. Relationship status is married. They do not have children. They live in a apartment/condo. Diet is described as vegan. Exercise typically includes cycling. They are typically active for 2 hours per week.
Not smoking. Ex-smoker. No other tobacco/nicotine products. Drinks alcohol 2-4 times a month. Drinks of alcohol per week: 3-4. They drink caffeinated beverages, approximately 3 cups per day. They do not use cannabis.

FAMILY HISTORY:
First degree relatives:
Colon or rectal cancer present. Age of onset of youngest family member 45. «Was on chemotherapy».
No colonic polyps.
No IBD.
No gastric cancer.
Esophageal cancer present. Age of onset of youngest family member 67. «Father, smoker».
«Diabetes, heart attacks».

HISTORY OF PRESENTING ILLNESS:
They have abdominal pain. This has been going for about 2 months. Pain is located in the RUQ. This has happened most weeks. The patient denies immediate post prandial abdominal pain. They deny delayed onset post prandial abdominal pain. «Sometimes it wakes me up»
They endorse recent changes to their bowel habits. This started about 3 weeks ago. There is no diarrhea. There is no constipation. Rectal bleeding is evident. There is no melena.
They deny reflux symptoms including heartburn, chest pain, regurgitation, dysphagia, odynophagia, globus sensation, or chronic cough.
They endorse weight-loss. This started about 2 months ago. They have lost approximately 20 lbs over this time. There is early satiety. No fever/chills. They deny night sweats.

FWIW, a general Haskell solution using Hutton's parser combinators library. This macro assume each "key-value" pair is separated by two newlines (\n\n) and each "key" is followed by a colon (:). No hardcoding of keys is necessary.

Note this macro requires installation of Haskell dependencies.

Haskell script uses Data.Aeson library encode method to produce a JSON string. Since my interact' has (String -> String) -> IO () type, we have to use more functions to produce the correct type. So,

encode (Data.Aeson) produces:

  • a lazy ByteString

toStrict (Data.ByteString) converts:

  • a lazy ByteString into a strict ByteStrict,

decodeUtf8 (Data.Text.Encoding) converts

  • a ByteString containing UTF-8 ,encoded text into Text, and

unpack (Data.Text) converts

  • Text into String

Medical History.kmmacros (12 KB)

Expand disclosure triangle to view Haskell Source
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

module Parsing
  ( module Parsing,
    module Control.Applicative,
  )
where

import Control.Applicative
  ( Alternative (..),
    Applicative (..),
    Const (..),
    WrappedArrow (..),
    WrappedMonad (..),
    ZipList (..),
    liftA,
    liftA3,
    optional,
    (<$),
    (<$>),
    (<**>),
  )

import Control.Monad (replicateM, void)
import Data.Aeson (encode)
import Data.Bifunctor
import qualified Data.ByteString as B
import Data.ByteString.Lazy (toStrict)
import Data.Char
import Data.List
import Data.Map.Strict (fromList)
import Data.String
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import Data.List.Split (splitOn)

between open close p = open >> p >>= \v -> close >> pure v

-- Based on functional parsing library from chapter 13
-- of Programming in Haskell,
-- Graham Hutton, Cambridge University Press, 2016.

newtype Parser a
  = P (String -> [(a, String)])

parse :: Parser a -> String -> [(a, String)]
parse (P p) = p

item :: Parser Char
item =
  P
    ( \case
        [] -> []
        (x : xs) -> [(x, xs)]
    )

instance Functor Parser where
  -- fmap :: (a -> b) -> Parser a -> Parser b
  fmap f p =
    P
      ( \inp ->
          case parse p inp of
            [] -> []
            [(v, out)] -> [(f v, out)]
      )

instance Applicative Parser where
  -- pure :: a -> Parser a
  pure v = P (\inp -> [(v, inp)])

  -- <*> :: Parser (a -> b) -> Parser a -> Parser b
  (<*>) pg px =
    P
      ( \inp ->
          case parse pg inp of
            [] -> []
            [(g, out)] -> parse (fmap g px) out
      )

instance Monad Parser where
  -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
  p >>= f =
    P
      ( \inp ->
          case parse p inp of
            [] -> []
            [(v, out)] -> parse (f v) out
      )

-- Making choices
instance Alternative Parser where
  -- empty :: Parser a
  empty = P (const [])

  -- (<|>) :: Parser a -> Parser a -> Parser a
  p <|> q =
    P
      ( \inp ->
          case parse p inp of
            [] -> parse q inp
            [(v, out)] -> [(v, out)]
      )

-- Derived primitives
-- sepBy1 p sep = liftM2 (:) p (many (sep >> p))

sepBy1 :: (Alternative f, Monad f) => f a1 -> f a2 -> f [a1]
sepBy1 p sep = (:) <$> p <*> many (sep >> p)

sepBy2 p = (:) <$> p <*> many p

commaSep p = sepBy1 p (string ",")

tagSep p = sepBy1 p (string " @")

count :: Int -> Parser a -> Parser [a]
count = replicateM

satisfy :: (Char -> Bool) -> Parser Char
satisfy p = item >>= go
  where
    go x
      | p x = pure x
      | otherwise = empty

digit :: Parser Char
digit = satisfy isDigit

digits :: Parser [Char]
digits = some digit

lower :: Parser Char
lower = satisfy isLower

upper :: Parser Char
upper = satisfy isUpper

letter :: Parser Char
letter = satisfy isAlpha

alphanum :: Parser Char
alphanum = satisfy isAlphaNum

char :: Char -> Parser Char
char x = satisfy (== x)

noneOf :: String -> Parser Char
noneOf cs = satisfy (`notElem` cs)

oneOf :: String -> Parser Char
oneOf cs = satisfy (`elem` cs)

string :: String -> Parser String
string [] = pure []
string (x : xs) = char x >> string xs >> pure (x : xs)

ident :: Parser String
ident = lower >>= \x -> many alphanum >>= \xs -> pure (x : xs)

constructor :: Parser String
constructor = upper >>= \x -> many alphanum >>= \xs -> pure (x : xs)

nat :: Parser Int
nat = read <$> some digit

int :: Parser Int
int = (char '-' >> nat >>= \n -> pure (-n)) <|> nat

-- Handling spacing
space :: Parser ()
space = void $ many (satisfy isSpace)

digitString :: Parser String
digitString = many (satisfy isDigit)

naturalNumber :: Parser Int
naturalNumber = read <$> digitString

token :: Parser a -> Parser a
token p = space >> p >>= \v -> space >> pure v

identifier :: Parser String
identifier = token ident

natural :: Parser Int
natural = token nat

integer :: Parser Int
integer = token int

symbol :: String -> Parser String
symbol xs = token (string xs)

interact' :: (String -> String) -> IO ()
interact' f = putStr . f =<< readFile =<< getContents

p =
  many (satisfy (/= ':'))
    >>= \k ->
      char ':'
        >> token (many item)
          >>= \v -> pure (k, v)

main :: IO ()
main =
  interact' $
    T.unpack
      . decodeUtf8
      . toStrict
      . encode
      . fromList
      . concatMap ((fst <$>) . parse p)
      . splitOn "\n\n"

Output:

@1234John1234 Feel free to ask if you have any questions about the macro posted above.

If you can guarantee a line break between each section of the input, this macro should work.

Medical History Stub.kmmacros (3.6 KB)

Image of macro

I've changed from using lowercase field names to uppercase, as you seem to prefer that. If the user types "Medication:" instead of "MEDICATION:", the field name will still be "MEDICATION".

The macro now allows the value of a field to start on either the same line as the field name (as in your REASON FOR REFERRAL example) or on the line immediately after the field name. If the value starts on the line after the name, the name line doesn't have to end with a colon.

I'm sure there are inputs that it will fail to interpret correctly, but it's fairly robust. It doesn't require a predetermined set of field names and can handle Unicode characters in the input.

Adding to drdrang's perl script, here is a translation of my Haskell script using the excellent Rob Trew's library:

and Parser Combinators library (also by Rob Trew).

I should note this macro do not have any dependencies.

Medical History (JS).kmmacros (29 KB)

Expand disclosure triangle to view JS Source
(() => {
    'use strict';

    // jxaContext :: IO ()
    const jxaContext = () => {
        const main = () => {
            const
                s = kmVar("Local_medicalHistory"),
                // p =
                //     many (satisfy (/= ':'))
                //         >>= \k ->
                //         char ':'
                //             >> token (many item)
                //             >>= \v -> pure (k, v)
                p = fmapP(
                    join(bimap)(intercalate(""))
                )(
                    bindP(
                        many(satisfy(x => x !== ":"))
                    )(
                        k => bindP(
                            thenP(
                                char(":")
                            )(
                                token(many(item()))
                            )
                        )(
                            v => pureP(
                                Tuple(k)(v)
                            )
                        )
                    )
                )
            return compose(
                JSON.stringify,
                dictFromList,
                concatMap(compose(map(fst), parse(p))),
                splitOn("\n\n")
            )(s)
        };

        // GENERICS ----------------------------------------------------------------
        // https://github.com/RobTrew/prelude-jxa
        // JS For Automation -------------------------------------------
        // kmVar :: String -> String
        const kmVar = strVariable => {
            const
                kmInst = standardAdditions().systemAttribute("KMINSTANCE"),
                kmeApp = Application("Keyboard Maestro Engine");
            return kmeApp.getvariable(strVariable, {
                instance: kmInst
            });
        };

        // standardAdditions :: () -> Application
        const standardAdditions = () =>
            Object.assign(Application.currentApplication(), {
                includeStandardAdditions: true
            });

        // JS Prelude --------------------------------------------------

        // Just :: a -> Maybe a
        const Just = x => ({
            type: "Maybe",
            Nothing: false,
            Just: x
        });

        // Left :: a -> Either a b
        const Left = x => ({
            type: "Either",
            Left: x
        });

        // Nothing :: Maybe a
        const Nothing = () => ({
            type: "Maybe",
            Nothing: true
        });

        // Right :: b -> Either a b
        const Right = x => ({
            type: "Either",
            Right: x
        });

        // Tuple (,) :: a -> b -> (a, b)
        const Tuple = a =>
            // A pair of values, possibly of
            // different types.
            b => ({
                type: "Tuple",
                "0": a,
                "1": b,
                length: 2,
                *[Symbol.iterator]() {
                    for (const k in this) {
                        if (!isNaN(k)) {
                            yield this[k];
                        }
                    }
                }
            });

        // all :: (a -> Bool) -> [a] -> Bool
        const all = p =>
            // True if p(x) holds for every x in xs.
            xs => [...xs].every(p);

        // and :: [Bool] -> Bool
        const and = xs =>
            // True unless any value in xs is false.
            [...xs].every(Boolean);

        // any :: (a -> Bool) -> [a] -> Bool
        const any = p =>
            // True if p(x) holds for at least
            // one item in xs.
            xs => [...xs].some(p);

        // append (<>) :: [a] -> [a] -> [a]
        const append = xs =>
            // Two lists joined into one.
            ys => xs.concat(ys);

        // bimap :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
        const bimap = f =>
            // Tuple instance of bimap.
            // A tuple of the application of f and g to the
            // first and second values respectively.
            g => tpl => Tuple(f(tpl[0]))(
                g(tpl[1])
            );

        // bind (>>=) :: Monad m => m a -> (a -> m b) -> m b
        const bind = m =>
            // Two computations sequentially composed,
            // with any value produced by the first
            // passed as an argument to the second.
            mf => Array.isArray(m) ? (
                bindList(m)(mf)
            ) : (
                ({
                    "Either": () => bindLR,
                    "Maybe": () => bindMay,
                    "Tuple": () => bindTuple,
                    "function": () => bindFn
                })[m.type || typeof m]()(m)(mf)
            );

        // bindFn (>>=) :: (a -> b) -> (b -> a -> c) -> a -> c
        const bindFn = f =>
            // Binary operator applied over f x and x.
            op => x => op(f(x))(x);

        // bindLR (>>=) :: Either a ->
        // (a -> Either b) -> Either b
        const bindLR = lr =>
            // Bind operator for the Either option type.
            // If lr has a Left value then lr unchanged,
            // otherwise the function mf applied to the
            // Right value in lr.
            mf => "Left" in lr ? (
                lr
            ) : mf(lr.Right);

        // bindList (>>=) :: [a] -> (a -> [b]) -> [b]
        const bindList = xs =>
            // The bind operator for Arrays.
            mf => [...xs].flatMap(mf);

        // bindMay (>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b
        const bindMay = mb =>
            // Nothing if mb is Nothing, or the application of the
            // (a -> Maybe b) function mf to the contents of mb.
            mf => mb.Nothing ? (
                mb
            ) : mf(mb.Just);

        // bindTuple (>>=) :: Monoid a => (a, a) -> (a -> (a, b)) -> (a, b)
        const bindTuple = ([a, b]) =>
            // The bind operator for Tuples
            f => first(mappend(a))(
                f(b)
            );

        // both :: (a -> b) -> (a, a) -> (b, b)
        const both = f =>
            // A tuple obtained by applying f to both values
            // in the given tuple.
            ([a, b]) => Tuple(
                f(a)
            )(
                f(b)
            );

        // compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
        const compose = (...fs) =>
            // A function defined by the right-to-left
            // composition of all the functions in fs.
            fs.reduce(
                (f, g) => x => f(g(x)),
                x => x
            );

        // concat :: [[a]] -> [a]
        const concat = xs =>
            xs.flat(1);

        // concatMap :: (a -> [b]) -> [a] -> [b]
        const concatMap = f =>
            // Concatenated results of a map of f over xs.
            // f is any function which returns a list value.
            // Any empty lists returned are filtered out by
            // the concatenation.
            xs => xs.flatMap(f);

        // dictFromList :: [(k, v)] -> Dict
        const dictFromList = kvs =>
            Object.fromEntries(kvs);

        // findIndices :: (a -> Bool) -> [a] -> [Int]
        // findIndices :: (String -> Bool) -> String -> [Int]
        const findIndices = p =>
            xs => {
                const ys = [...xs];

                return ys.flatMap(
                    (y, i) => p(y, i, ys) ? (
                        [i]
                    ) : []
                );
            };

        // first :: (a -> b) -> ((a, c) -> (b, c))
        const first = f =>
            // A simple function lifted to one which applies
            // to a tuple, transforming only its first item.
            ([x, y]) => Tuple(f(x))(y);

        // fst :: (a, b) -> a
        const fst = tpl =>
            // First member of a pair.
            tpl[0];

        // identity :: a -> a
        const identity = x =>
            // The identity function.
            x;

        // intercalate :: [a] -> [[a]] -> [a]
        // intercalate :: String -> [String] -> String
        const intercalate = sep => xs =>
            0 < xs.length && "string" === typeof sep &&
            "string" === typeof xs[0] ? (
                xs.join(sep)
            ) : concat(intersperse(sep)(xs));

        // intersperse :: a -> [a] -> [a]
        // intersperse :: Char -> String -> String
        const intersperse = sep => xs => {
            // intersperse(0, [1,2,3]) -> [1, 0, 2, 0, 3]
            const bln = "string" === typeof xs;

            return xs.length > 1 ? (
                (bln ? concat : x => x)(
                    (bln ? (
                        xs.split("")
                    ) : xs)
                    .slice(1)
                    .reduce((a, x) => a.concat([sep, x]), [xs[0]])
                )) : xs;
        };

        // isDigit :: Char -> Bool
        const isDigit = c => {
            const n = c.codePointAt(0);

            return 48 <= n && 57 >= n;
        };

        // join :: Monad m => m (m a) -> m a
        const join = x =>
            bind(x)(identity);

        // length :: [a] -> Int
        const length = xs =>
            // Returns Infinity over objects without finite
            // length. This enables zip and zipWith to choose
            // the shorter argument when one is non-finite,
            // like cycle, repeat etc
            "GeneratorFunction" !== xs.constructor
            .constructor.name ? (
                xs.length
            ) : Infinity;

        // list :: StringOrArrayLike b => b -> [a]
        const list = xs =>
            // xs itself, if it is an Array,
            // or an Array derived from xs.
            Array.isArray(xs) ? (
                xs
            ) : Array.from(xs || []);

        // map :: (a -> b) -> [a] -> [b]
        const map = f =>
            // The list obtained by applying f
            // to each element of xs.
            // (The image of xs under f).
            xs => [...xs].map(f);

        // mappEndo (<>) :: Endo a -> Endo a -> Endo a
        const mappEndo = a =>
            // mappend is defined as composition
            // for the Endo type.
            b => Endo(x => a.appEndo(b.appEndo(x)));

        // mappend (<>) :: Monoid a => a -> a -> a
        const mappend = a =>
            // Associative operation
            // defined for various monoids.
            ({
                "(a -> b)": () => mappendFn,
                "Endo": () => mappEndo,
                "List": () => append,
                "Maybe": () => mappendMaybe,
                "Num": () => mappendOrd,
                "String": () => append,
                "Tuple": () => mappendTupleN,
                "TupleN": () => mappendTupleN
            })[typeName(a)]()(a);

        // mappendFn (<>) :: Monoid b => (a -> b) -> (a -> b) -> (a -> b)
        const mappendFn = f =>
            g => x => mappend(f(x))(
                g(x)
            );

        // mappendMaybe (<>) :: Maybe a -> Maybe a -> Maybe a
        const mappendMaybe = a =>
            b => a.Nothing ? (
                b
            ) : b.Nothing ? (
                a
            ) : Just(
                mappend(a.Just)(
                    b.Just
                )
            );

        // mappendOrd (<>) :: Ordering -> Ordering -> Ordering
        const mappendOrd = x =>
            y => 0 !== x ? (
                x
            ) : y;

        // mappendTupleN (<>) ::
        // (a, b, ...) -> (a, b, ...) -> (a, b, ...)
        const mappendTupleN = t => t1 => {
            const lng = t.length;

            return lng === t1.length ? (
                TupleN(
                    [...t].map(
                        (x, i) => mappend(x)(t1[i])
                    )
                )
            ) : undefined;
        };

        // member :: Key -> Dict -> Bool
        const member = k =>
            // True if dict contains the key k.
            dict => k in dict;

        // negate :: Num -> Num
        const negate = n =>
            -n;

        // or :: [Bool] -> Bool
        const or = xs =>
            xs.some(Boolean);

        // read :: Read a => String -> a
        const read = JSON.parse;

        // repeat :: a -> Generator [a]
        const repeat = function* (x) {
            while (true) {
                yield x;
            }
        };

        // second :: (a -> b) -> ((c, a) -> (c, b))
        const second = f =>
            // A function over a simple value lifted
            // to a function over a tuple.
            // f (a, b) -> (a, f(b))
            ([x, y]) => Tuple(x)(f(y));

        // splitOn :: [a] -> [a] -> [[a]]
        // splitOn :: String -> String -> [String]
        const splitOn = pat => src =>
            // A list of the strings delimited by
            // instances of a given pattern in s.
            ("string" === typeof src) ? (
                src.split(pat)
            ) : (() => {
                const
                    lng = pat.length,
                    [a, b] = findIndices(matching(pat))(src).reduce(
                        ([x, y], i) => Tuple(
                            x.concat([src.slice(y, i)])
                        )(lng + i),
                        Tuple([])(0)
                    );

                return a.concat([src.slice(b)]);
            })();

        // ParserCombinatorsJS -----------------------------------------
        // Parser :: String -> [(a, String)] -> Parser a
        const Parser = f =>
            // A function lifted into a Parser object.
            ({
                type: "Parser",
                parser: f
            });

        // altP (<|>) :: Parser a -> Parser a -> Parser a
        const altP = p =>
            // p, or q if p doesn't match.
            q => Parser(s => {
                const xs = parse(p)(s);

                return 0 < xs.length ? (
                    xs
                ) : parse(q)(s);
            });

        // apP <*> :: Parser (a -> b) -> Parser a -> Parser b
        const apP = pf =>
            // A new parser obtained by the application
            // of a Parser-wrapped function,
            // to a Parser-wrapped value.
            p => Parser(
                s => parse(pf)(s).flatMap(
                    ([v, r]) => parse(
                        fmapP(v)(p)
                    )(r)
                )
            );

        // between :: Parser open -> Parser close ->
        // Parser a -> Parser a
        const between = pOpen =>
            // A version of p which matches between
            // pOpen and pClose (both discarded).
            pClose => p => thenBindP(pOpen)(
                p
            )(
                compose(thenP(pClose), pureP)
            );

        // bindP (>>=) :: Parser a ->
        // (a -> Parser b) -> Parser b
        const bindP = p =>
            // A new parser obtained by the application of
            // a function to a Parser-wrapped value.
            // The function must enrich its output, lifting it
            // into a new Parser.
            // Allows for the nesting of parsers.
            f => Parser(
                s => parse(p)(s).flatMap(
                    ([x, r]) => parse(f(x))(r)
                )
            );

        // char :: Char -> Parser Char
        const char = x =>
            // A particular single character.
            satisfy(c => x === c);

        // decimal :: () -> Parser Number
        const decimal = () => {
            // The value of a decimal number string.
            const
                digitsOrZero = altP(
                    fmapP(concat)(some(digit()))
                )(pureP("0"));

            return bindP(
                token(sign())
            )(f => bindP(
                digitsOrZero
            )(ns => thenBindP(char("."))(
                digitsOrZero
            )(ds => pureP(f(read(`${ns}.${ds}`))))));
        };

        // digit :: Parser Char
        const digit = () =>
            // A single digit.
            satisfy(isDigit);

        // fmapP :: (a -> b) -> Parser a -> Parser b
        const fmapP = f =>
            // A new parser derived by the structure-preserving
            // application of f to the value in p.
            p => Parser(
                s => parse(p)(s).flatMap(
                    first(f)
                )
            );

        // integer :: () -> Parser Integer
        const integer = () =>
            // Signed integer value.
            bindP(
                token(sign())
            )(f => bindP(
                naturalNumber()
            )(x => pureP(f(x))));

        // item :: () -> Parser Char
        const item = () =>
            // A single character.
            Parser(s => {
                const [h, ...t] = s;

                return Boolean(h) ? [
                    Tuple(h)(t)
                ] : [];
            });

        // liftA2P :: (a -> b -> c) ->
        // Parser a -> Parser b -> Parser c
        const liftA2P = op =>
            // The binary function op, lifted
            // to a function over two parsers.
            p => apP(fmapP(op)(p));

        // many :: Parser a -> Parser [a]
        const many = p => {
            // Zero or more instances of p.
            // Lifts a parser for a simple type of value
            // to a parser for a list of such values.
            const someP = q =>
                liftA2P(
                    x => xs => [x].concat(xs)
                )(q)(many(q));

            return Parser(
                s => parse(
                    0 < s.length ? (
                        altP(someP(p))(pureP([]))
                    ) : pureP([])
                )(s)
            );
        };

        // naturalNumber :: () -> Parser Natural Number
        const naturalNumber = () =>
            // The value of an unsigned integer.
            fmapP(
                x => read(concat(x))
            )(
                some(digit())
            );

        // number :: Parser Number
        const number = () =>
            // The value of a signed number, with or
            // without a floating point component.
            altP(
                decimal()
            )(
                integer()
            );

        // oneOf :: [Char] -> Parser Char
        const oneOf = s =>
            // One instance of any character found
            // the given string.
            satisfy(c => s.includes(c));

        // option :: a -> Parser a -> Parser a
        const option = x =>
            // Either p or the default value x.
            p => altP(p)(pureP(x));

        // parse :: Parser a -> String -> [(a, String)]
        const parse = p =>
            // The result of parsing s with p.
            s => p.parser([...s]);

        // pureP :: a -> Parser a
        const pureP = x =>
            // The value x lifted, unchanged,
            // into the Parser monad.
            Parser(s => [Tuple(x)(s)]);

        // satisfy :: (Char -> Bool) -> Parser Char
        const satisfy = test =>
            // Any character for which the
            // given predicate returns true.
            Parser(s => {
                const [h, ...t] = s;

                return Boolean(h) ? (
                    test(h) ? [
                        Tuple(h)(t)
                    ] : []
                ) : [];
            });

        // sequenceP :: [Parser a] -> Parser [a]
        const sequenceP = ps =>
            // A single parser for a list of values, derived
            // from a list of parsers for single values.
            Parser(
                s => ps.reduce(
                    (a, q) => a.flatMap(
                        ([v, r]) => parse(q)(r).flatMap(
                            first(xs => v.concat(xs))
                        )
                    ),
                    [Tuple([])(s)]
                )
            );

        // sign :: () -> Parser Function
        const sign = () =>
            // The negate function as a parse of
            // any '-', or the identity function.
            altP(
                bindP(
                    oneOf("+-")
                )(c => pureP(
                    ("-" !== c) ? identity : negate
                ))
            )(pureP(identity));

        // some :: Parser a -> Parser [a]
        const some = p => {
            // One or more instances of p.
            // Lifts a parser for a simple type of value
            // to a parser for a list of such values.
            const manyP = q =>
                altP(some(q))(pureP([]));

            return Parser(
                s => parse(
                    liftA2P(
                        x => xs => [x].concat(xs)
                    )(p)(manyP(p))
                )(s)
            );
        };

        // string :: String -> Parser String
        const string = s =>
            // A particular string.
            fmapP(cs => cs.join(""))(
                sequenceP([...s].map(char))
            );

        // thenBindP :: Parser a -> Parser b ->
        // (b -> Parser c) Parser c
        const thenBindP = o =>
            // A combination of thenP and bindP in which a
            // preliminary  parser consumes text and discards
            // its output, before any output of a subsequent
            // parser is bound.
            p => f => Parser(
                s => parse(o)(s).flatMap(
                    ([, r]) => parse(p)(r).flatMap(
                        ([a, b]) => parse(f(a))(b)
                    )
                )
            );

        // thenP (>>) :: Parser a -> Parser b -> Parser b
        const thenP = o =>
            // A composite parser in which o just consumes text
            // and then p consumes more and returns a value.
            p => Parser(
                s => parse(o)(s).flatMap(
                    ([, r]) => parse(p)(r)
                )
            );

        // token :: Parser a -> Parser a
        const token = p => {
            // A new parser for a space-wrapped
            // instance of p. Any flanking
            // white space is discarded.
            const space = whiteSpace();

            return between(space)(space)(p);
        };

        // whiteSpace :: Parser String
        const whiteSpace = () =>
            // Zero or more non-printing characters.
            many(oneOf(" \t\n\r"));

        // MAIN --
        return main();
    };

    return jxaContext();
})();

Thanks very much! I'll check it out later tonight - really appreciate the reply!

1 Like

Many thanks for the revision - really appreciate it - will give it a go tonight!

Worked like a charm - thank you very much for your expertise!

Worked perfectly - I'm very grateful thank you! Just tried the second one without additional plugins.

2 Likes