{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
-- |
-- Module      : Gram.Parse
-- Description : Parser for gram notation
-- Copyright   : (c) gram-data, 2024
-- License     : BSD3
-- Maintainer  : gram-data
-- Stability   : experimental
--
-- This module provides parsers for gram notation, converting text into
-- Pattern and Subject data structures.
--
-- == Anonymous Subject Handling
--
-- The default 'fromGram' function preserves anonymous subjects as 'Symbol ""'
-- to enable round-trip compatibility. Anonymous subjects in gram notation
-- (e.g., @()@, @()-[]->()@) will be represented with empty identity.
--
-- If you need unique IDs assigned to anonymous subjects, use 'fromGramWithIds'
-- instead, which assigns sequential IDs (e.g., @#1@, @#2@) to all anonymous
-- subjects.
--
-- == String Value Syntax
--
-- The parser supports multiple string formats:
--
-- === Double-quoted strings
--
-- Standard strings with escape sequences:
--
-- @
-- { name: \"Alice\" }
-- @
--
-- === Single-quoted strings
--
-- Literal strings without escape processing:
--
-- @
-- { pattern: \'[a-z]+\' }
-- @
--
-- === Codefence strings (multiline)
--
-- Triple-backtick delimited strings for multiline content:
--
-- @
-- { content: \`\`\`
-- This content spans
-- multiple lines.
-- \`\`\` }
-- @
--
-- === Tagged codefence strings
--
-- Codefence with a tag indicating the content type:
--
-- @
-- { doc: \`\`\`md
-- # Markdown Title
-- Some **bold** text.
-- \`\`\` }
-- @
--
-- Tagged codefences are parsed as 'VTaggedString' values with the tag
-- and content stored separately.
module Gram.Parse
  ( fromGram
  , fromGramWithIds
  , parseGram
  , ParseError(..)
  ) where

import Gram.CST (Gram(..), AnnotatedPattern(..), PatternElement(..), Path(..), PathSegment(..), Node(..), Relationship(..), SubjectPattern(..), SubjectData(..), Identifier(..), Symbol(..), Annotation(..), Value)
import qualified Gram.Transform as Transform
import qualified Pattern.Core as Core
import qualified Subject.Core as CoreSub
import qualified Subject.Value as V

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Text.Megaparsec (Parsec, parse, eof, optional, try, lookAhead, many, manyTill, some, sepBy, sepBy1, (<|>), satisfy, choice)
import Text.Megaparsec.Char (char, string, digitChar)
import qualified Text.Megaparsec.Error as Error
import Data.Void (Void)
import Control.Monad (void)
import Data.Char (isAlphaNum, isAlpha)

-- | Parser type for gram notation.
type Parser = Parsec Void String

-- | Parse error type for gram notation parsing.
data ParseError = ParseError String
  deriving (ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
/= :: ParseError -> ParseError -> Bool
Eq, Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> ShowS
showList :: [ParseError] -> ShowS
Show)

-- | Convert Megaparsec parse error to ParseError.
convertError :: Error.ParseErrorBundle String Void -> ParseError
convertError :: ParseErrorBundle String Void -> ParseError
convertError ParseErrorBundle String Void
bundle = String -> ParseError
ParseError (ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Error.errorBundlePretty ParseErrorBundle String Void
bundle)

-- | Strip comments from gram notation string.
--
-- Handles line comments starting with @\/\/@. Comments are stripped unless
-- they appear inside string literals (double-quoted, single-quoted, or
-- backtick-quoted) or inside codefence blocks.
--
-- Codefence blocks span multiple lines and start with @\`\`\`@ (optionally
-- followed by a tag) and end with @\`\`\`@ on its own line. Content inside
-- codefences is preserved verbatim, including any @\/\/@ sequences.
stripComments :: String -> String
stripComments :: ShowS
stripComments String
input = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Bool -> [String] -> [String]
processLines Bool
False (String -> [String]
lines String
input)
  where
    -- Process lines while tracking codefence state
    processLines :: Bool -> [String] -> [String]
    processLines :: Bool -> [String] -> [String]
processLines Bool
_ [] = []
    processLines Bool
inCodefence (String
line:[String]
rest)
      | Bool
inCodefence = 
          -- Inside codefence content
          if String -> Bool
isClosingFence String
line
            then ShowS
processClosingFenceLine String
line String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> [String] -> [String]
processLines Bool
False [String]
rest  -- Closing fence, exit codefence
            else String
line String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> [String] -> [String]
processLines Bool
True [String]
rest   -- Keep content verbatim
      | Bool
otherwise =
          -- Outside codefence, check for opening fence and strip comments
          let (String
processed, Bool
nowInCodefence) = String -> (String, Bool)
processLineOutsideCodefence String
line
          in String
processed String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> [String] -> [String]
processLines Bool
nowInCodefence [String]
rest
    
    -- Check if line contains a closing fence (``` at start of line).
    -- The closing fence may be followed by gram syntax like }) on the same line.
    -- Content cannot contain three consecutive backticks (per grammar), so a line
    -- starting with ``` must be the closing fence, regardless of what follows.
    isClosingFence :: String -> Bool
    isClosingFence :: String -> Bool
isClosingFence String
s = 
      let trimmed :: String
trimmed = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWhitespace String
s
      in Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
3 String
trimmed String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"```"
    
    -- Process a closing fence line: preserve the fence, strip comments from the rest.
    -- For a line like "``` }) // comment", returns "``` })"
    processClosingFenceLine :: String -> String
    processClosingFenceLine :: ShowS
processClosingFenceLine String
line =
      let leading :: String
leading = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isWhitespace String
line
          afterLeading :: String
afterLeading = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWhitespace String
line
          fence :: String
fence = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
3 String
afterLeading  -- The "```"
          remainder :: String
remainder = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 String
afterLeading  -- Everything after the fence
          strippedRemainder :: String
strippedRemainder = ShowS
stripLineComment String
remainder
      in String
leading String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fence String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strippedRemainder
    
    -- Process a line when outside codefence, returns (processed line, entering codefence?)
    processLineOutsideCodefence :: String -> (String, Bool)
    processLineOutsideCodefence :: String -> (String, Bool)
processLineOutsideCodefence String
line =
      let stripped :: String
stripped = ShowS
stripLineComment String
line
          -- Check if this line opens a codefence (ends with ``` or ```tag)
          opensCodefence :: Bool
opensCodefence = String -> Bool
endsWithCodefenceOpen String
stripped
      in (String
stripped, Bool
opensCodefence)
    
    -- Check if line ends with opening codefence pattern (``` or ```tag)
    -- This happens when a property value starts a codefence
    endsWithCodefenceOpen :: String -> Bool
    endsWithCodefenceOpen :: String -> Bool
endsWithCodefenceOpen String
s = 
      let rev :: String
rev = ShowS
forall a. [a] -> [a]
reverse String
s
          -- Remove trailing whitespace
          trimmed :: String
trimmed = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWhitespace String
rev
          -- For tagged codefence, the tag appears first in reversed string
          -- e.g., "```md" reversed is "dm```", so skip tag chars to reach ```
          afterTag :: String
afterTag = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isTagChar String
trimmed
      in case String
afterTag of
           -- Now check for the ``` backticks
           (Char
'`':Char
'`':Char
'`':String
rest) -> 
             -- Valid if not followed by more backticks (avoid matching ````)
             case String
rest of
               [] -> Bool
True  -- Just ``` (possibly with tag) at end
               (Char
'`':String
_) -> Bool
False  -- More than 3 backticks, not a codefence
               String
_ -> Bool
True  -- Valid codefence opening
           String
_ -> Bool
False
    
    isWhitespace :: Char -> Bool
    isWhitespace :: Char -> Bool
isWhitespace Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'
    
    isTagChar :: Char -> Bool
    isTagChar :: Char -> Bool
isTagChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
    
    -- Strip line comment from a single line (handles quotes)
    stripLineComment :: String -> String
    stripLineComment :: ShowS
stripLineComment String
line = case String -> Maybe Int
findComment String
line of
      Maybe Int
Nothing -> String
line
      Just Int
idx -> Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
idx String
line
    
    findComment :: String -> Maybe Int
    findComment :: String -> Maybe Int
findComment String
s = String -> Int -> Maybe Char -> Maybe Int
findComment' String
s Int
0 Maybe Char
forall a. Maybe a
Nothing
    
    findComment' :: String -> Int -> Maybe Char -> Maybe Int
    findComment' :: String -> Int -> Maybe Char -> Maybe Int
findComment' [] Int
_ Maybe Char
_ = Maybe Int
forall a. Maybe a
Nothing
    findComment' (Char
'\\' : Char
_ : String
xs) Int
idx Maybe Char
inString = String -> Int -> Maybe Char -> Maybe Int
findComment' String
xs (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Maybe Char
inString
    findComment' (Char
c : String
xs) Int
idx Maybe Char
Nothing
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'  = String -> Int -> Maybe Char -> Maybe Int
findComment' String
xs (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'"')
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' = String -> Int -> Maybe Char -> Maybe Int
findComment' String
xs (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\'')
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`'  = String -> Int -> Maybe Char -> Maybe Int
findComment' String
xs (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'`')
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
&& Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
1 String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"/" = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
idx
      | Bool
otherwise = String -> Int -> Maybe Char -> Maybe Int
findComment' String
xs (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Char
forall a. Maybe a
Nothing
    findComment' (Char
c : String
xs) Int
idx (Just Char
q)
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
q    = String -> Int -> Maybe Char -> Maybe Int
findComment' String
xs (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Char
forall a. Maybe a
Nothing
      | Bool
otherwise = String -> Int -> Maybe Char -> Maybe Int
findComment' String
xs (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
q)

-- | Parse optional whitespace (spaces and tabs only, no newlines).
optionalSpace :: Parser ()
optionalSpace :: Parser ()
optionalSpace = ParsecT Void String Identity String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity String -> Parser ())
-> ParsecT Void String Identity String -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
' ' ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\t')

-- | Parse optional whitespace including newlines.
optionalSpaceWithNewlines :: Parser ()
optionalSpaceWithNewlines :: Parser ()
optionalSpaceWithNewlines = ParsecT Void String Identity String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity String -> Parser ())
-> ParsecT Void String Identity String -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
' ' ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\t' ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\n' ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\r')

-- ... [Value Parsers - largely unchanged, but reused from previous implementation] ...

-- | Parse a symbol identifier.
parseSymbol :: Parser Symbol
parseSymbol :: Parser Symbol
parseSymbol = 
  (String -> Symbol
Symbol (String -> Symbol)
-> ParsecT Void String Identity String -> Parser Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void String Identity String
parseBacktickedIdentifier) Parser Symbol -> Parser Symbol -> Parser Symbol
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
    first <- (Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token String
c -> Char -> Bool
isAlpha Char
Token String
c Bool -> Bool -> Bool
|| Char
Token String
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
    rest <- many (satisfy (\Token String
c -> Char -> Bool
isAlphaNum Char
Token String
c Bool -> Bool -> Bool
|| Char
Token String
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
Token String
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
Token String
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
Token String
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@'))
    return $ Symbol (first : rest)

isSymbolStart :: Char -> Bool
isSymbolStart :: Char -> Bool
isSymbolStart Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

parseInteger :: Parser Integer
parseInteger :: Parser Integer
parseInteger = do
  sign <- ParsecT Void String Identity Char
-> ParsecT Void String Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'-')
  digits <- some digitChar
  let num = String -> Integer
forall a. Read a => String -> a
read String
digits :: Integer
  return $ if sign == Just '-' then -num else num

parseDecimal :: Parser Double
parseDecimal :: Parser Double
parseDecimal = do
  sign <- ParsecT Void String Identity Char
-> ParsecT Void String Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'-')
  intPart <- some digitChar
  void $ char '.'
  fracPart <- some digitChar
  let num = String -> Double
forall a. Read a => String -> a
read (String
intPart String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fracPart) :: Double
  return $ if sign == Just '-' then -num else num

parseBoolean :: Parser Bool
parseBoolean :: Parser Bool
parseBoolean = 
  (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"true" ParsecT Void String Identity (Tokens String)
-> Parser Bool -> Parser Bool
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) Parser Bool -> Parser Bool -> Parser Bool
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"false" ParsecT Void String Identity (Tokens String)
-> Parser Bool -> Parser Bool
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

parseString :: Parser String
parseString :: ParsecT Void String Identity String
parseString = ParsecT Void String Identity String
parseDoubleQuotedString ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
parseSingleQuotedString

parseDoubleQuotedString :: Parser String
parseDoubleQuotedString :: ParsecT Void String Identity String
parseDoubleQuotedString = do
  ParsecT Void String Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity Char -> Parser ())
-> ParsecT Void String Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'"'
  content <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (Char -> ParsecT Void String Identity Char
escapedChar Char
'"') (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'"')
  return content

parseSingleQuotedString :: Parser String
parseSingleQuotedString :: ParsecT Void String Identity String
parseSingleQuotedString = do
  ParsecT Void String Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity Char -> Parser ())
-> ParsecT Void String Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\''
  content <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (Char -> ParsecT Void String Identity Char
escapedChar Char
'\'') (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\'')
  return content

escapedChar :: Char -> Parser Char
escapedChar :: Char -> ParsecT Void String Identity Char
escapedChar Char
quote = 
  (Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token String
x -> Char
Token String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
quote Bool -> Bool -> Bool
&& Char
Token String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\') ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
  (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\\' ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void String Identity Char
ParsecT Void String Identity (Token String)
anyChar ParsecT Void String Identity Char
-> (Char -> ParsecT Void String Identity Char)
-> ParsecT Void String Identity Char
forall a b.
ParsecT Void String Identity a
-> (a -> ParsecT Void String Identity b)
-> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> Char -> ParsecT Void String Identity Char
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (case Char
c of
    Char
'\\' -> Char
'\\'
    Char
'n' -> Char
'\n'
    Char
'r' -> Char
'\r'
    Char
't' -> Char
'\t'
    Char
x | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
quote -> Char
quote
    Char
x -> Char
x))
  where
    anyChar :: ParsecT Void String Identity (Token String)
anyChar = (Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Bool -> Token String -> Bool
forall a b. a -> b -> a
const Bool
True)

parseBacktickedIdentifier :: Parser String
parseBacktickedIdentifier :: ParsecT Void String Identity String
parseBacktickedIdentifier = do
  ParsecT Void String Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity Char -> Parser ())
-> ParsecT Void String Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'`'
  content <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (Char -> ParsecT Void String Identity Char
escapedChar Char
'`') (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'`')
  return content

-- | Parse the content of a fenced string (codefence).
--
-- Captures all characters between the opening fence (after newline)
-- and the closing fence. The closing fence is three backticks that
-- appear after a newline, with optional leading whitespace.
--
-- Content may contain:
--
-- * Newlines
-- * Single backticks
-- * Double backticks
-- * Any other characters
--
-- Content may NOT contain three consecutive backticks at line start
-- (even with leading whitespace).
--
-- === Examples
--
-- The content between fences is captured verbatim:
--
-- @
-- \`\`\`
-- Hello World
-- \`\`\`
-- @
--
-- Produces: @"Hello World"@
--
-- Indented closing fences are supported for better readability in
-- nested structures:
--
-- @
-- ({ content: \`\`\`
-- Some text
--   \`\`\` })
-- @
--
-- === Implementation
--
-- Uses character-by-character parsing to detect the closing fence pattern
-- (newline, optional whitespace, then three backticks). This allows
-- backticks within the content as long as they don't form the closing pattern.
parseFencedContent :: Parser String
parseFencedContent :: ParsecT Void String Identity String
parseFencedContent = do
  -- Check if closing fence appears immediately (empty content case)
  -- Also handles indented empty content: ```\n  ```
  closingAtStart <- Parser () -> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser () -> Parser ()
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser ()
closingFencePattern)
  case closingAtStart of
    Just ()
_ -> String -> ParsecT Void String Identity String
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""  -- Empty content
    Maybe ()
Nothing -> String -> ParsecT Void String Identity String
go []
  where
    -- Pattern for closing fence: optional whitespace followed by ```
    closingFencePattern :: Parser ()
    closingFencePattern :: Parser ()
closingFencePattern = do
      ParsecT Void String Identity String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity String -> Parser ())
-> ParsecT Void String Identity String -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
' ' ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\t')  -- Skip optional leading whitespace
      ParsecT Void String Identity (Tokens String) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity (Tokens String) -> Parser ())
-> ParsecT Void String Identity (Tokens String) -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"```"
    
    go :: [Char] -> Parser String
    go :: String -> ParsecT Void String Identity String
go String
acc = do
      -- Try to match the closing fence: newline, optional whitespace, then ```
      closingFence <- Parser () -> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser () -> Parser ()
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\n' ParsecT Void String Identity Char -> Parser () -> Parser ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
closingFencePattern))
      case closingFence of
        Just ()
_ -> String -> ParsecT Void String Identity String
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. [a] -> [a]
reverse String
acc)  -- Found closing, return accumulated content
        Maybe ()
Nothing -> do
          -- Check for EOF (unclosed fence)
          isEnd <- Parser () -> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
          case isEnd of
            Just ()
_ -> String -> ParsecT Void String Identity String
forall a. String -> ParsecT Void String Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unclosed codefence: expected closing ```"
            Maybe ()
Nothing -> do
              -- Consume one character and continue
              c <- (Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
              go (c : acc)

-- | Parse a plain fenced string (codefence without tag).
--
-- Recognizes the syntax:
--
-- @
-- \`\`\`
-- content here
-- can span multiple lines
-- \`\`\`
-- @
--
-- Returns the content between the opening and closing fences as a VString.
-- The opening fence must be immediately followed by a newline.
-- Content may be empty.
--
-- === Examples
--
-- >>> parse parseFencedString "" "```\\nHello World\\n```"
-- Right (VString "Hello World")
--
-- >>> parse parseFencedString "" "```\\n```"
-- Right (VString "")
--
-- === Errors
--
-- Fails if:
--
-- * Opening fence is not followed by newline
-- * Closing fence is missing
parseFencedString :: Parser Value
parseFencedString :: Parser Value
parseFencedString = do
  -- Match opening fence: ```
  ParsecT Void String Identity (Tokens String) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity (Tokens String) -> Parser ())
-> ParsecT Void String Identity (Tokens String) -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"```"
  -- Require newline after opening fence (plain codefence has no tag)
  ParsecT Void String Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity Char -> Parser ())
-> ParsecT Void String Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\n'
  -- Parse content until closing fence
  content <- ParsecT Void String Identity String
parseFencedContent
  return $ V.VString content

-- | Parse a tagged fenced string (codefence with tag).
--
-- Recognizes the syntax:
--
-- @
-- \`\`\`tag
-- content here
-- can span multiple lines
-- \`\`\`
-- @
--
-- The tag must be a valid symbol immediately following the opening fence.
-- Returns a VTaggedString with the tag and content.
--
-- === Examples
--
-- >>> parse parseTaggedFencedString "" "```md\\n# Title\\n```"
-- Right (VTaggedString "md" "# Title")
--
-- >>> parse parseTaggedFencedString "" "```json\\n{}\\n```"
-- Right (VTaggedString "json" "{}")
--
-- === Errors
--
-- Fails if:
--
-- * No valid symbol follows opening fence
-- * Tag is not followed by newline
-- * Closing fence is missing
parseTaggedFencedString :: Parser Value
parseTaggedFencedString :: Parser Value
parseTaggedFencedString = do
  -- Match opening fence: ```
  ParsecT Void String Identity (Tokens String) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity (Tokens String) -> Parser ())
-> ParsecT Void String Identity (Tokens String) -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"```"
  -- Parse the tag (must be a valid symbol)
  tag <- Parser Symbol
parseSymbol
  -- Require newline after tag
  void $ char '\n'
  -- Parse content until closing fence
  content <- parseFencedContent
  return $ V.VTaggedString (symbolToString tag) content
  where
    symbolToString :: Symbol -> String
symbolToString (Symbol String
s) = String
s

parseTaggedString :: Parser Value
parseTaggedString :: Parser Value
parseTaggedString = do
  tag <- Parser Symbol
parseSymbol
  void $ char '`'
  content <- manyTill (escapedChar '`') (char '`')
  return $ V.VTaggedString (quoteSymbol tag) content
  where
    quoteSymbol :: Symbol -> String
quoteSymbol (Symbol String
s) = String
s

parseArray :: Parser Value
parseArray :: Parser Value
parseArray = do
  ParsecT Void String Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity Char -> Parser ())
-> ParsecT Void String Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'['
  Parser ()
optionalSpace
  values <- Parser Value -> Parser () -> ParsecT Void String Identity [Value]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy (Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseScalarValue) (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser ()
optionalSpaceWithNewlines Parser ()
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
',') ParsecT Void String Identity Char -> Parser () -> Parser ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
optionalSpaceWithNewlines)
  optionalSpace
  void $ char ']'
  return $ V.VArray values

parseMap :: Parser Value
parseMap :: Parser Value
parseMap = do
  ParsecT Void String Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity Char -> Parser ())
-> ParsecT Void String Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'{'
  Parser ()
optionalSpaceWithNewlines
  pairs <- ParsecT Void String Identity (String, Value)
-> Parser () -> ParsecT Void String Identity [(String, Value)]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy (ParsecT Void String Identity (String, Value)
-> ParsecT Void String Identity (String, Value)
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void String Identity (String, Value)
parseMapping) (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser ()
optionalSpaceWithNewlines Parser ()
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
',') ParsecT Void String Identity Char -> Parser () -> Parser ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
optionalSpaceWithNewlines)
  optionalSpaceWithNewlines
  void $ char '}'
  return $ V.VMap (Map.fromList pairs)
  where
    parseMapping :: ParsecT Void String Identity (String, Value)
parseMapping = do
      key <- Parser Identifier
parseIdentifier
      void $ optionalSpaceWithNewlines >> char ':' >> optionalSpaceWithNewlines
      value <- parseScalarValue
      optionalSpaceWithNewlines
      return (identifierToString key, value)

parseRange :: Parser Value
parseRange :: Parser Value
parseRange = do
  startsWithDots <- ParsecT Void String Identity (Maybe (Tokens String))
-> ParsecT Void String Identity (Maybe (Tokens String))
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity (Maybe (Tokens String))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity (Tokens String)
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"..")))
  lower <- if startsWithDots == Just ".."
    then return Nothing
    else do
      sign <- optional (char '-')
      intPart <- some digitChar
      hasDots <- lookAhead (optional (try (string "..")))
      if hasDots == Just ".."
        then do
          let num = String -> Double
forall a. Read a => String -> a
read String
intPart :: Double
          let numWithSign = if Maybe Char
sign Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'-' then -Double
num else Double
num
          return (Just numWithSign)
        else fail "not a range"
  _firstDot <- char '.'
  _secondDot <- char '.'
  hasThirdDot <- optional (char '.')
  if hasThirdDot == Just '.'
    then do
      upper <- optional (try parseRangeDouble)
      return $ V.VRange (V.RangeValue lower upper)
    else do
      upper <- if lower == Nothing
        then optional (try parseRangeDouble)
        else Just <$> parseRangeDouble
      return $ V.VRange (V.RangeValue lower upper)
  where
    parseRangeDouble :: Parser Double
parseRangeDouble = do
      sign <- ParsecT Void String Identity Char
-> ParsecT Void String Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'-')
      intPart <- some digitChar
      fracPart <- optional (char '.' >> some digitChar)
      let numStr = String
intPart String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
:) Maybe String
fracPart
      let num = String -> Double
forall a. Read a => String -> a
read String
numStr :: Double
      return $ if sign == Just '-' then -num else num

parseMeasurement :: Parser Value
parseMeasurement :: Parser Value
parseMeasurement = do
  sign <- ParsecT Void String Identity Char
-> ParsecT Void String Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'-')
  intPart <- some digitChar
  fracPart <- optional (char '.' >> some digitChar)
  unit <- some (satisfy (\Token String
c -> Char -> Bool
isAlpha Char
Token String
c Bool -> Bool -> Bool
|| Char
Token String
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%'))
  let numStr = String
intPart String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
:) Maybe String
fracPart
  let num = String -> Double
forall a. Read a => String -> a
read String
numStr :: Double
  let value = if Maybe Char
sign Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'-' then -Double
num else Double
num
  return $ V.VMeasurement unit value

parseScalarValue :: Parser Value
parseScalarValue :: Parser Value
parseScalarValue = 
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseRange Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseMeasurement Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Double -> Value
V.VDecimal (Double -> Value) -> Parser Double -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
parseDecimal) Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Integer -> Value
V.VInteger (Integer -> Value) -> Parser Integer -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
parseInteger) Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Bool -> Value
V.VBoolean (Bool -> Value) -> Parser Bool -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
parseBoolean) Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseFencedString Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>        -- Plain codefence (US1)
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseTaggedFencedString Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>  -- Tagged codefence (US2)
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseTaggedString Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>        -- Inline tagged string
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (String -> Value
V.VString (String -> Value)
-> ParsecT Void String Identity String -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
parseString) Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (String -> Value
V.VSymbol (String -> Value) -> (Symbol -> String) -> Symbol -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> String
quoteSymbol (Symbol -> Value) -> Parser Symbol -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
parseSymbol)
  where
    quoteSymbol :: Symbol -> String
quoteSymbol (Symbol String
s) = String
s

parseValue :: Parser Value
parseValue :: Parser Value
parseValue = 
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseRange Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseMeasurement Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Double -> Value
V.VDecimal (Double -> Value) -> Parser Double -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
parseDecimal) Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Integer -> Value
V.VInteger (Integer -> Value) -> Parser Integer -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
parseInteger) Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Bool -> Value
V.VBoolean (Bool -> Value) -> Parser Bool -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
parseBoolean) Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseFencedString Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>        -- Plain codefence (US1)
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseTaggedFencedString Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>  -- Tagged codefence (US2)
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseTaggedString Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>        -- Inline tagged string
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (String -> Value
V.VString (String -> Value)
-> ParsecT Void String Identity String -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
parseString) Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseArray Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Value
parseMap Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (String -> Value
V.VSymbol (String -> Value) -> (Symbol -> String) -> Symbol -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> String
quoteSymbol (Symbol -> Value) -> Parser Symbol -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
parseSymbol)
  where
    quoteSymbol :: Symbol -> String
quoteSymbol (Symbol String
s) = String
s

identifierToString :: Identifier -> String
identifierToString :: Identifier -> String
identifierToString (IdentSymbol (Symbol String
s)) = String
s
identifierToString (IdentString String
s) = String
s
identifierToString (IdentInteger Integer
i) = Integer -> String
forall a. Show a => a -> String
show Integer
i

parseIdentifier :: Parser Identifier
parseIdentifier :: Parser Identifier
parseIdentifier = 
  Parser Identifier -> Parser Identifier
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Symbol -> Identifier
IdentSymbol (Symbol -> Identifier) -> Parser Symbol -> Parser Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
parseSymbol) Parser Identifier -> Parser Identifier -> Parser Identifier
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Identifier -> Parser Identifier
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (String -> Identifier
IdentString (String -> Identifier)
-> ParsecT Void String Identity String -> Parser Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
parseString) Parser Identifier -> Parser Identifier -> Parser Identifier
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Identifier -> Parser Identifier
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Integer -> Identifier
IdentInteger (Integer -> Identifier) -> Parser Integer -> Parser Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
parseInteger)

parseLabelSeparator :: Parser ()
parseLabelSeparator :: Parser ()
parseLabelSeparator = (Parser () -> Parser ()
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"::" ParsecT Void String Identity (Tokens String)
-> Parser () -> Parser ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Parser () -> Parser () -> Parser ()
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
':' ParsecT Void String Identity Char -> Parser () -> Parser ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))

parseLabels :: Parser (Set String)
parseLabels :: Parser (Set String)
parseLabels = do
  firstLabel <- ParsecT Void String Identity String
parseLabel
  restLabels <- many parseLabel
  return $ Set.fromList (firstLabel : restLabels)
  where
    parseLabel :: ParsecT Void String Identity String
parseLabel = do
      Parser ()
parseLabelSeparator
      lbl <- Parser Symbol
parseSymbol
      return $ quoteSymbol lbl
    quoteSymbol :: Symbol -> String
quoteSymbol (Symbol String
s) = String
s

parsePropertyRecord :: Parser (Map String Value)
parsePropertyRecord :: Parser (Map String Value)
parsePropertyRecord = do
  ParsecT Void String Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity Char -> Parser ())
-> ParsecT Void String Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'{'
  Parser ()
optionalSpaceWithNewlines
  pairs <- ParsecT Void String Identity (String, Value)
-> Parser () -> ParsecT Void String Identity [(String, Value)]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy (ParsecT Void String Identity (String, Value)
-> ParsecT Void String Identity (String, Value)
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void String Identity (String, Value)
parseProperty) (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser ()
optionalSpaceWithNewlines Parser ()
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
',') ParsecT Void String Identity Char -> Parser () -> Parser ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
optionalSpaceWithNewlines)
  optionalSpaceWithNewlines
  void $ char '}'
  return $ Map.fromList pairs
  where
    parseProperty :: ParsecT Void String Identity (String, Value)
parseProperty = do
      key <- Parser Identifier
parseIdentifier
      optionalSpaceWithNewlines
      parseLabelSeparator
      optionalSpaceWithNewlines
      value <- parseValue
      optionalSpaceWithNewlines
      return (identifierToString key, value)

-- ... [CST Specific Parsers] ...

parseAnnotation :: Parser Annotation
parseAnnotation :: Parser Annotation
parseAnnotation = do
  ParsecT Void String Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity Char -> Parser ())
-> ParsecT Void String Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'@'
  key <- Parser Symbol
parseSymbol
  void $ char '('
  value <- parseValue
  void $ char ')'
  optionalSpace
  return $ Annotation key value

parseAnnotations :: Parser [Annotation]
parseAnnotations :: Parser [Annotation]
parseAnnotations = Parser Annotation -> Parser [Annotation]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser Annotation -> Parser Annotation
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Annotation
parseAnnotation)

parseSubjectData :: Parser SubjectData
parseSubjectData :: Parser SubjectData
parseSubjectData = do
  nextChar <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ((Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True))
  case nextChar of
    Char
'{' -> do
      props <- Parser (Map String Value) -> Parser (Map String Value)
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Map String Value)
parsePropertyRecord
      return $ SubjectData Nothing Set.empty props
    Char
':' -> do
      lbls <- Parser (Set String)
parseLabels
      optionalSpace
      props <- optional (try parsePropertyRecord)
      return $ SubjectData Nothing lbls (maybe Map.empty id props)
    Char
_ -> do
      ident <- Parser Identifier
parseIdentifier
      optionalSpace
      hasLabels <- lookAhead (optional (try (char ':')))
      lbls <- if hasLabels == Just ':'
        then do
          labels <- parseLabels
          optionalSpace
          return labels
        else return Set.empty
      optionalSpace
      hasRecord <- lookAhead (optional (char '{'))
      props <- if hasRecord == Just '{'
        then parsePropertyRecord
        else return Map.empty
      return $ SubjectData (Just ident) lbls props

parseNode :: Parser Node
parseNode :: Parser Node
parseNode = do
  ParsecT Void String Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity Char -> Parser ())
-> ParsecT Void String Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'('
  Parser ()
optionalSpace
  data' <- ParsecT Void String Identity (Maybe SubjectData)
-> ParsecT Void String Identity (Maybe SubjectData)
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (SubjectData -> Maybe SubjectData
forall a. a -> Maybe a
Just (SubjectData -> Maybe SubjectData)
-> Parser SubjectData
-> ParsecT Void String Identity (Maybe SubjectData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SubjectData
parseSubjectData) ParsecT Void String Identity (Maybe SubjectData)
-> ParsecT Void String Identity (Maybe SubjectData)
-> ParsecT Void String Identity (Maybe SubjectData)
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SubjectData
-> ParsecT Void String Identity (Maybe SubjectData)
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SubjectData
forall a. Maybe a
Nothing
  optionalSpace
  void $ char ')'
  return $ Node data'

parseReference :: Parser PatternElement
parseReference :: Parser PatternElement
parseReference = do
  ident <- Parser Identifier
parseIdentifier
  optionalSpace
  return $ PEReference ident

parseRelationshipKind :: Parser String
parseRelationshipKind :: ParsecT Void String Identity String
parseRelationshipKind = 
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"<==>") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"<-->") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"<~~>") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"<--") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"-->") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"<==>") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"==>") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"<==") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"<~~>") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"~~>") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"<~~") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"==") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"~~") ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"--"

-- | Parses the arrow part (including potential attributes)
parseArrow :: Parser (String, Maybe SubjectData)
parseArrow :: Parser (String, Maybe SubjectData)
parseArrow = 
  Parser (String, Maybe SubjectData)
-> Parser (String, Maybe SubjectData)
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (String, Maybe SubjectData)
parseInterruptedArrow Parser (String, Maybe SubjectData)
-> Parser (String, Maybe SubjectData)
-> Parser (String, Maybe SubjectData)
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser (String, Maybe SubjectData)
forall {a}. ParsecT Void String Identity (String, Maybe a)
parseSimpleArrow
  where
    parseSimpleArrow :: ParsecT Void String Identity (String, Maybe a)
parseSimpleArrow = do
      kind <- ParsecT Void String Identity String
parseRelationshipKind
      return (kind, Nothing)
      
    parseInterruptedArrow :: Parser (String, Maybe SubjectData)
parseInterruptedArrow = do
      -- Simplified for now, capturing the whole interrupted arrow logic is complex
      -- But we need to capture attributes inside.
      -- (This mirrors existing logic but adapted for CST)
       prefix <- [ParsecT Void String Identity String]
-> ParsecT Void String Identity String
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
         [ ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"<-")
         , ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"<=")
         , ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"<~")
         , ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"-")
         , ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"=")
         , ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"~")
         ]
       void $ char '['
       optionalSpace
       -- Annotations are no longer allowed in relationships
       optionalSpace
       data' <- optional parseSubjectData
       optionalSpace
       void $ char ']'
       suffix <- choice
         [ try (string "->")
         , try (string "=>")
         , try (string "~>")
         , try (string "-")
         , try (string "=")
         , try (string "~")
         ]
       return (prefix ++ "..." ++ suffix, data')

parsePath :: Parser Path
parsePath :: Parser Path
parsePath = do
  start <- Parser Node
parseNode
  optionalSpace
  segments <- many (try parsePathSegment)
  return $ Path start segments

parsePathSegment :: Parser PathSegment
parsePathSegment :: ParsecT Void String Identity PathSegment
parsePathSegment = do
  (arrow, data') <- Parser (String, Maybe SubjectData)
parseArrow
  optionalSpace
  next <- parseNode
  optionalSpace
  return $ PathSegment (Relationship arrow data') next

parseSubPatternElement :: Parser PatternElement
parseSubPatternElement :: Parser PatternElement
parseSubPatternElement = Parser PatternElement -> Parser PatternElement
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (SubjectPattern -> PatternElement
PESubjectPattern (SubjectPattern -> PatternElement)
-> ParsecT Void String Identity SubjectPattern
-> Parser PatternElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity SubjectPattern
parseSubjectPattern) Parser PatternElement
-> Parser PatternElement -> Parser PatternElement
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser PatternElement -> Parser PatternElement
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Path -> PatternElement
PEPath (Path -> PatternElement) -> Parser Path -> Parser PatternElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path
parsePath) Parser PatternElement
-> Parser PatternElement -> Parser PatternElement
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser PatternElement -> Parser PatternElement
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser PatternElement
parseReference

parseSubjectPattern :: Parser SubjectPattern
parseSubjectPattern :: ParsecT Void String Identity SubjectPattern
parseSubjectPattern = do
  ParsecT Void String Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity Char -> Parser ())
-> ParsecT Void String Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'['
  Parser ()
optionalSpace
  data' <- Parser SubjectData
-> ParsecT Void String Identity (Maybe SubjectData)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser SubjectData
parseSubjectData
  optionalSpace
  nested <- optional (do
    void $ char '|'
    optionalSpaceWithNewlines
    elements <- sepBy1 (try parseSubPatternElement) (try (optionalSpaceWithNewlines >> char ',') >> optionalSpaceWithNewlines)
    optionalSpace
    return elements)
  optionalSpaceWithNewlines
  void $ char ']'
  return $ SubjectPattern data' (maybe [] id nested)

parsePatternElement :: Parser PatternElement
parsePatternElement :: Parser PatternElement
parsePatternElement = Parser PatternElement -> Parser PatternElement
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (SubjectPattern -> PatternElement
PESubjectPattern (SubjectPattern -> PatternElement)
-> ParsecT Void String Identity SubjectPattern
-> Parser PatternElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity SubjectPattern
parseSubjectPattern) Parser PatternElement
-> Parser PatternElement -> Parser PatternElement
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Path -> PatternElement
PEPath (Path -> PatternElement) -> Parser Path -> Parser PatternElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Path
parsePath)

parseAnnotatedPattern :: Parser AnnotatedPattern
parseAnnotatedPattern :: Parser AnnotatedPattern
parseAnnotatedPattern = do
  Parser ()
optionalSpace
  anns <- Parser [Annotation]
parseAnnotations
  optionalSpace
  -- Strict Mode: AnnotatedPattern contains exactly ONE PatternElement.
  -- Comma-separated sequences are only allowed inside SubjectPattern [...].
  element <- parsePatternElement
  return $ AnnotatedPattern anns [element]

parseGram :: Parser Gram
parseGram :: Parser Gram
parseGram = do
  Parser ()
optionalSpace
  rootRecord <- Parser (Map String Value)
-> ParsecT Void String Identity (Maybe (Map String Value))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser (Map String Value) -> Parser (Map String Value)
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Map String Value)
parsePropertyRecord)
  optionalSpace
  
  firstPatterns <- if rootRecord == Nothing
    then (:[]) <$> parseAnnotatedPattern
    else optional (try parseAnnotatedPattern) >>= \Maybe AnnotatedPattern
p -> [AnnotatedPattern]
-> ParsecT Void String Identity [AnnotatedPattern]
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AnnotatedPattern]
 -> ParsecT Void String Identity [AnnotatedPattern])
-> [AnnotatedPattern]
-> ParsecT Void String Identity [AnnotatedPattern]
forall a b. (a -> b) -> a -> b
$ [AnnotatedPattern]
-> (AnnotatedPattern -> [AnnotatedPattern])
-> Maybe AnnotatedPattern
-> [AnnotatedPattern]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (AnnotatedPattern -> [AnnotatedPattern] -> [AnnotatedPattern]
forall a. a -> [a] -> [a]
:[]) Maybe AnnotatedPattern
p
    
  additionalPatterns <- many (try (do
    optionalSpaceWithNewlines
    -- Commas are NOT allowed as separators at the top level in strict gram
    -- void $ optional (char ',')
    nextChar <- lookAhead (satisfy (const True))
    if nextChar == '(' || nextChar == '[' || nextChar == '@'
      then parseAnnotatedPattern
      else fail "no pattern"))
      
  optionalSpaceWithNewlines
  eof
  
  return $ Gram rootRecord (firstPatterns ++ additionalPatterns)

-- | Parse gram notation string into a Pattern Subject.
--
-- This function preserves anonymous subjects as 'Symbol ""' to enable
-- round-trip compatibility. Anonymous subjects in the gram notation
-- (e.g., @()@, @()-[]->()@) will be represented with empty identity.
--
-- If you need unique IDs assigned to anonymous subjects, use
-- 'fromGramWithIds' instead.
fromGram :: String -> Either ParseError (Core.Pattern CoreSub.Subject)
fromGram :: String -> Either ParseError (Pattern Subject)
fromGram String
input = do
  let stripped :: String
stripped = ShowS
stripComments String
input
  case Parser Gram
-> String -> String -> Either (ParseErrorBundle String Void) Gram
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser Gram
parseGram String
"gram" String
stripped of
    Left ParseErrorBundle String Void
err -> ParseError -> Either ParseError (Pattern Subject)
forall a b. a -> Either a b
Left (ParseErrorBundle String Void -> ParseError
convertError ParseErrorBundle String Void
err)
    Right Gram
cst -> Pattern Subject -> Either ParseError (Pattern Subject)
forall a b. b -> Either a b
Right (Gram -> Pattern Subject
Transform.transformGram Gram
cst)

-- | Parse gram notation string into a Pattern Subject with ID assignment.
--
-- This function is equivalent to applying 'Transform.assignIdentities' to the
-- result of 'fromGram'. It assigns unique sequential IDs (e.g., @#1@, @#2@)
-- to all anonymous subjects in the parsed pattern.
--
-- Use this function when you need unique identifiers for anonymous subjects,
-- such as for graph algorithms or when distinguishing between anonymous
-- instances is important.
--
-- For round-trip compatibility, use 'fromGram' instead, which preserves
-- anonymity.
fromGramWithIds :: String -> Either ParseError (Core.Pattern CoreSub.Subject)
fromGramWithIds :: String -> Either ParseError (Pattern Subject)
fromGramWithIds String
input = do
  let stripped :: String
stripped = ShowS
stripComments String
input
  case Parser Gram
-> String -> String -> Either (ParseErrorBundle String Void) Gram
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser Gram
parseGram String
"gram" String
stripped of
    Left ParseErrorBundle String Void
err -> ParseError -> Either ParseError (Pattern Subject)
forall a b. a -> Either a b
Left (ParseErrorBundle String Void -> ParseError
convertError ParseErrorBundle String Void
err)
    Right Gram
cst -> Pattern Subject -> Either ParseError (Pattern Subject)
forall a b. b -> Either a b
Right (Gram -> Pattern Subject
Transform.transformGramWithIds Gram
cst)