{- |
Module      :  ./Common/AnnoState.hs
Description :  parsing of interspersed annotations
Copyright   :  (c) Christian Maeder and Uni Bremen 2002-2006
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

Parsing of interspersed annotations

- a parser state to collect annotations

- parsing annoted keywords

- parsing an annoted item list
-}

module Common.AnnoState where

import Common.Parsec
import Common.Lexer
import Common.Token
import Common.Id
import Common.Keywords
import Common.AS_Annotation
import Common.AnnoParser

import Text.ParserCombinators.Parsec

import Data.List
import Control.Monad

-- | parsers that can collect annotations via side effects
type AParser st = GenParser Char (AnnoState st)

class AParsable a where
  aparser :: AParser st a

-- used for CASL extensions. If there is no extension, just fail
instance AParsable () where
  aparser :: AParser st ()
aparser = AParser st ()
forall tok st a. GenParser tok st a
pzero

-- a parser for terms or formulas
class TermParser a where
  termParser :: Bool -> AParser st a -- ^ True for terms, formulas otherwise
  termParser _ = AParser st a
forall tok st a. GenParser tok st a
pzero

instance TermParser ()

aToTermParser :: AParser st a -> Bool -> AParser st a
aToTermParser :: AParser st a -> Bool -> AParser st a
aToTermParser p :: AParser st a
p b :: Bool
b = if Bool
b then AParser st a
forall tok st a. GenParser tok st a
pzero else AParser st a
p

-- | just the list of currently collected annotations
data AnnoState st = AnnoState { AnnoState st -> [Annotation]
toAnnos :: [Annotation], AnnoState st -> st
_userState :: st }

-- | no annotations
emptyAnnos :: st -> AnnoState st
emptyAnnos :: st -> AnnoState st
emptyAnnos = [Annotation] -> st -> AnnoState st
forall st. [Annotation] -> st -> AnnoState st
AnnoState []

-- | add further annotations to the input state
parseAnnos :: AnnoState a -> GenParser Char st (AnnoState a)
parseAnnos :: AnnoState a -> GenParser Char st (AnnoState a)
parseAnnos (AnnoState as :: [Annotation]
as b :: a
b) =
    do [Annotation]
a <- CharParser st ()
forall st. CharParser st ()
skip CharParser st ()
-> ParsecT [Char] st Identity [Annotation]
-> ParsecT [Char] st Identity [Annotation]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] st Identity [Annotation]
forall st. GenParser Char st [Annotation]
annotations
       AnnoState a -> GenParser Char st (AnnoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnoState a -> GenParser Char st (AnnoState a))
-> AnnoState a -> GenParser Char st (AnnoState a)
forall a b. (a -> b) -> a -> b
$ [Annotation] -> a -> AnnoState a
forall st. [Annotation] -> st -> AnnoState st
AnnoState ([Annotation]
as [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Annotation]
a) a
b

-- | add only annotations on consecutive lines to the input state
parseLineAnnos :: AnnoState a -> GenParser Char st (AnnoState a)
parseLineAnnos :: AnnoState a -> GenParser Char st (AnnoState a)
parseLineAnnos (AnnoState as :: [Annotation]
as b :: a
b) =
    do [Annotation]
l <- GenParser Char st [Annotation]
forall st. GenParser Char st [Annotation]
mLineAnnos
       AnnoState a -> GenParser Char st (AnnoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnoState a -> GenParser Char st (AnnoState a))
-> AnnoState a -> GenParser Char st (AnnoState a)
forall a b. (a -> b) -> a -> b
$ [Annotation] -> a -> AnnoState a
forall st. [Annotation] -> st -> AnnoState st
AnnoState ([Annotation]
as [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Annotation]
l) a
b

-- | add annotations to the internal state
addAnnos :: AParser st ()
addAnnos :: AParser st ()
addAnnos = ParsecT [Char] (AnnoState st) Identity (AnnoState st)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT [Char] (AnnoState st) Identity (AnnoState st)
-> (AnnoState st
    -> ParsecT [Char] (AnnoState st) Identity (AnnoState st))
-> ParsecT [Char] (AnnoState st) Identity (AnnoState st)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AnnoState st
-> ParsecT [Char] (AnnoState st) Identity (AnnoState st)
forall a st. AnnoState a -> GenParser Char st (AnnoState a)
parseAnnos ParsecT [Char] (AnnoState st) Identity (AnnoState st)
-> (AnnoState st -> AParser st ()) -> AParser st ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AnnoState st -> AParser st ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState

-- | add only annotations on consecutive lines to the internal state
addLineAnnos :: AParser st ()
addLineAnnos :: AParser st ()
addLineAnnos = ParsecT [Char] (AnnoState st) Identity (AnnoState st)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT [Char] (AnnoState st) Identity (AnnoState st)
-> (AnnoState st
    -> ParsecT [Char] (AnnoState st) Identity (AnnoState st))
-> ParsecT [Char] (AnnoState st) Identity (AnnoState st)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AnnoState st
-> ParsecT [Char] (AnnoState st) Identity (AnnoState st)
forall a st. AnnoState a -> GenParser Char st (AnnoState a)
parseLineAnnos ParsecT [Char] (AnnoState st) Identity (AnnoState st)
-> (AnnoState st -> AParser st ()) -> AParser st ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AnnoState st -> AParser st ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState

{- | extract all annotation from the internal state,
resets the internal state to 'emptyAnnos' -}
getAnnos :: AParser st [Annotation]
getAnnos :: AParser st [Annotation]
getAnnos = do
  AnnoState st
aSt <- ParsecT [Char] (AnnoState st) Identity (AnnoState st)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  AnnoState st -> ParsecT [Char] (AnnoState st) Identity ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState AnnoState st
aSt { toAnnos :: [Annotation]
toAnnos = [] }
  [Annotation] -> AParser st [Annotation]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Annotation] -> AParser st [Annotation])
-> [Annotation] -> AParser st [Annotation]
forall a b. (a -> b) -> a -> b
$ AnnoState st -> [Annotation]
forall st. AnnoState st -> [Annotation]
toAnnos AnnoState st
aSt

-- | annotations on consecutive lines
mLineAnnos :: GenParser Char st [Annotation]
mLineAnnos :: GenParser Char st [Annotation]
mLineAnnos = GenParser Char st [Annotation] -> GenParser Char st [Annotation]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (GenParser Char st [Annotation] -> GenParser Char st [Annotation])
-> GenParser Char st [Annotation] -> GenParser Char st [Annotation]
forall a b. (a -> b) -> a -> b
$ do
    Annotation
a <- GenParser Char st Annotation
forall st. GenParser Char st Annotation
annotationL
    CharParser st ()
forall st. CharParser st ()
skipSmart
    ([Annotation] -> [Annotation])
-> GenParser Char st [Annotation] -> GenParser Char st [Annotation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Annotation
a Annotation -> [Annotation] -> [Annotation]
forall a. a -> [a] -> [a]
:) (GenParser Char st [Annotation] -> GenParser Char st [Annotation])
-> GenParser Char st [Annotation] -> GenParser Char st [Annotation]
forall a b. (a -> b) -> a -> b
$ GenParser Char st [Annotation] -> GenParser Char st [Annotation]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL GenParser Char st [Annotation]
forall st. GenParser Char st [Annotation]
mLineAnnos

-- | explicitly parse annotations, reset internal state
annos :: AParser st [Annotation]
annos :: AParser st [Annotation]
annos = AParser st ()
forall st. AParser st ()
addAnnos AParser st () -> AParser st [Annotation] -> AParser st [Annotation]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AParser st [Annotation]
forall st. AParser st [Annotation]
getAnnos

-- | explicitly parse annotations on consecutive lines. reset internal state
lineAnnos :: AParser st [Annotation]
lineAnnos :: AParser st [Annotation]
lineAnnos = AParser st ()
forall st. AParser st ()
addLineAnnos AParser st () -> AParser st [Annotation] -> AParser st [Annotation]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AParser st [Annotation]
forall st. AParser st [Annotation]
getAnnos

-- | succeeds if the previous item is finished
tryItemEnd :: [String] -> AParser st ()
tryItemEnd :: [[Char]] -> AParser st ()
tryItemEnd l :: [[Char]]
l = AParser st () -> AParser st ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (AParser st () -> AParser st ()) -> AParser st () -> AParser st ()
forall a b. (a -> b) -> a -> b
$ do
  [Char]
c <- ParsecT [Char] (AnnoState st) Identity [Char]
-> ParsecT [Char] (AnnoState st) Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Char] (AnnoState st) Identity [Char]
 -> ParsecT [Char] (AnnoState st) Identity [Char])
-> ParsecT [Char] (AnnoState st) Identity [Char]
-> ParsecT [Char] (AnnoState st) Identity [Char]
forall a b. (a -> b) -> a -> b
$ AParser st [Annotation]
forall st. AParser st [Annotation]
annos AParser st [Annotation]
-> ParsecT [Char] (AnnoState st) Identity [Char]
-> ParsecT [Char] (AnnoState st) Identity [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    (ParsecT [Char] (AnnoState st) Identity Char
-> ParsecT [Char] (AnnoState st) Identity [Char]
forall (m :: * -> *) a. Monad m => m a -> m [a]
single ([Char] -> ParsecT [Char] (AnnoState st) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf "\"([{") ParsecT [Char] (AnnoState st) Identity [Char]
-> ParsecT [Char] (AnnoState st) Identity [Char]
-> ParsecT [Char] (AnnoState st) Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] (AnnoState st) Identity [Char]
forall st. CharParser st [Char]
placeS ParsecT [Char] (AnnoState st) Identity [Char]
-> ParsecT [Char] (AnnoState st) Identity [Char]
-> ParsecT [Char] (AnnoState st) Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] (AnnoState st) Identity [Char]
forall st. CharParser st [Char]
scanAnySigns
     ParsecT [Char] (AnnoState st) Identity [Char]
-> ParsecT [Char] (AnnoState st) Identity [Char]
-> ParsecT [Char] (AnnoState st) Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] (AnnoState st) Identity Char
-> ParsecT [Char] (AnnoState st) Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Char] (AnnoState st) Identity Char
forall st. CharParser st Char
scanLPD ParsecT [Char] (AnnoState st) Identity Char
-> ParsecT [Char] (AnnoState st) Identity Char
-> ParsecT [Char] (AnnoState st) Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Char] (AnnoState st) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '_' ParsecT [Char] (AnnoState st) Identity Char
-> [Char] -> ParsecT [Char] (AnnoState st) Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "") ParsecT [Char] (AnnoState st) Identity [Char]
-> [Char] -> ParsecT [Char] (AnnoState st) Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "")
  Bool -> AParser st () -> AParser st ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
c Bool -> Bool -> Bool
|| [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
c [[Char]]
l) AParser st ()
forall tok st a. GenParser tok st a
pzero

{- | keywords that indicate a new item for 'tryItemEnd'.
the quantifier exists does not start a new item. -}
startKeyword :: [String]
startKeyword :: [[Char]]
startKeyword = [Char]
dotS [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
cDot [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]] -> [[Char]]
forall a. Eq a => a -> [a] -> [a]
delete [Char]
existsS [[Char]]
casl_reserved_words

-- | parse preceding annotations and the following item
annoParser :: AParser st a -> AParser st (Annoted a)
annoParser :: AParser st a -> AParser st (Annoted a)
annoParser = ([Annotation] -> a -> Annoted a)
-> ParsecT [Char] (AnnoState st) Identity [Annotation]
-> AParser st a
-> AParser st (Annoted a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [Annotation] -> a -> Annoted a
forall a. [Annotation] -> a -> Annoted a
addLeftAnno ParsecT [Char] (AnnoState st) Identity [Annotation]
forall st. AParser st [Annotation]
annos

allAnnoParser :: AParser st a -> AParser st (Annoted a)
allAnnoParser :: AParser st a -> AParser st (Annoted a)
allAnnoParser p :: AParser st a
p = (Annoted a -> [Annotation] -> Annoted a)
-> AParser st (Annoted a)
-> ParsecT [Char] (AnnoState st) Identity [Annotation]
-> AParser st (Annoted a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Annoted a -> [Annotation] -> Annoted a
forall a. Annoted a -> [Annotation] -> Annoted a
appendAnno (AParser st a -> AParser st (Annoted a)
forall st a. AParser st a -> AParser st (Annoted a)
annoParser AParser st a
p) ParsecT [Char] (AnnoState st) Identity [Annotation]
forall st. AParser st [Annotation]
lineAnnos

{- | parse preceding and consecutive trailing annotations of an item in
     between.  Unlike 'annosParser' do not treat all trailing annotations as
     preceding annotations of the next item. -}
trailingAnnosParser :: AParser st a -> AParser st [Annoted a]
trailingAnnosParser :: AParser st a -> AParser st [Annoted a]
trailingAnnosParser p :: AParser st a
p = do
  [Annoted a]
l <- ParsecT [Char] (AnnoState st) Identity (Annoted a)
-> AParser st [Annoted a]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] (AnnoState st) Identity (Annoted a)
 -> AParser st [Annoted a])
-> ParsecT [Char] (AnnoState st) Identity (Annoted a)
-> AParser st [Annoted a]
forall a b. (a -> b) -> a -> b
$ AParser st a -> ParsecT [Char] (AnnoState st) Identity (Annoted a)
forall st a. AParser st a -> AParser st (Annoted a)
allAnnoParser AParser st a
p
  [Annotation]
a <- AParser st [Annotation]
forall st. AParser st [Annotation]
annos -- append remaining annos to last item
  [Annoted a] -> AParser st [Annoted a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Annoted a] -> AParser st [Annoted a])
-> [Annoted a] -> AParser st [Annoted a]
forall a b. (a -> b) -> a -> b
$ [Annoted a] -> [Annoted a]
forall a. [a] -> [a]
init [Annoted a]
l [Annoted a] -> [Annoted a] -> [Annoted a]
forall a. [a] -> [a] -> [a]
++ [Annoted a -> [Annotation] -> Annoted a
forall a. Annoted a -> [Annotation] -> Annoted a
appendAnno ([Annoted a] -> Annoted a
forall a. [a] -> a
last [Annoted a]
l) [Annotation]
a]

-- | parse an item list preceded and followed by annotations
annosParser :: AParser st a -> AParser st [Annoted a]
annosParser :: AParser st a -> AParser st [Annoted a]
annosParser parser :: AParser st a
parser =
    do [Annotation]
a <- AParser st [Annotation]
forall st. AParser st [Annotation]
annos
       [(a, [Annotation])]
l <- ParsecT [Char] (AnnoState st) Identity (a, [Annotation])
-> ParsecT [Char] (AnnoState st) Identity [(a, [Annotation])]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] (AnnoState st) Identity (a, [Annotation])
 -> ParsecT [Char] (AnnoState st) Identity [(a, [Annotation])])
-> ParsecT [Char] (AnnoState st) Identity (a, [Annotation])
-> ParsecT [Char] (AnnoState st) Identity [(a, [Annotation])]
forall a b. (a -> b) -> a -> b
$ AParser st a
-> AParser st [Annotation]
-> ParsecT [Char] (AnnoState st) Identity (a, [Annotation])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m (a, b)
pair AParser st a
parser AParser st [Annotation]
forall st. AParser st [Annotation]
annos
       let ps :: [a]
ps = ((a, [Annotation]) -> a) -> [(a, [Annotation])] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, [Annotation]) -> a
forall a b. (a, b) -> a
fst [(a, [Annotation])]
l
           as :: [[Annotation]]
as = ((a, [Annotation]) -> [Annotation])
-> [(a, [Annotation])] -> [[Annotation]]
forall a b. (a -> b) -> [a] -> [b]
map (a, [Annotation]) -> [Annotation]
forall a b. (a, b) -> b
snd [(a, [Annotation])]
l
           is :: [Annoted a]
is = ([Annotation] -> a -> Annoted a)
-> [[Annotation]] -> [a] -> [Annoted a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Annotation] -> a -> Annoted a
forall a. [Annotation] -> a -> Annoted a
addLeftAnno ([Annotation]
a [Annotation] -> [[Annotation]] -> [[Annotation]]
forall a. a -> [a] -> [a]
: [[Annotation]] -> [[Annotation]]
forall a. [a] -> [a]
init [[Annotation]]
as) [a]
ps
       [Annoted a] -> AParser st [Annoted a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Annoted a] -> [Annoted a]
forall a. [a] -> [a]
init [Annoted a]
is [Annoted a] -> [Annoted a] -> [Annoted a]
forall a. [a] -> [a] -> [a]
++ [Annoted a -> [Annotation] -> Annoted a
forall a. Annoted a -> [Annotation] -> Annoted a
appendAnno ([Annoted a] -> Annoted a
forall a. [a] -> a
last [Annoted a]
is) ([[Annotation]] -> [Annotation]
forall a. [a] -> a
last [[Annotation]]
as)])

{- | parse an item list preceded by a singular or plural keyword,
interspersed with semicolons and an optional semicolon at the end -}
itemList :: [String] -> String -> ([String] -> AParser st b)
               -> ([Annoted b] -> Range -> a) -> AParser st a
itemList :: [[Char]]
-> [Char]
-> ([[Char]] -> AParser st b)
-> ([Annoted b] -> Range -> a)
-> AParser st a
itemList ks :: [[Char]]
ks kw :: [Char]
kw ip :: [[Char]] -> AParser st b
ip constr :: [Annoted b] -> Range -> a
constr =
    do Token
p <- [Char] -> CharParser (AnnoState st) Token
forall st. [Char] -> CharParser st Token
pluralKeyword [Char]
kw
       [[Char]]
-> [Token]
-> AParser st b
-> ([Annoted b] -> Range -> a)
-> AParser st a
forall st b a.
[[Char]]
-> [Token]
-> AParser st b
-> ([Annoted b] -> Range -> a)
-> AParser st a
auxItemList ([[Char]]
ks [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
startKeyword) [Token
p] ([[Char]] -> AParser st b
ip [[Char]]
ks) [Annoted b] -> Range -> a
constr

{- | generalized version of 'itemList'
for an other keyword list for 'tryItemEnd' and without 'pluralKeyword' -}
auxItemList :: [String] -> [Token] -> AParser st b
            -> ([Annoted b] -> Range -> a) -> AParser st a
auxItemList :: [[Char]]
-> [Token]
-> AParser st b
-> ([Annoted b] -> Range -> a)
-> AParser st a
auxItemList startKeywords :: [[Char]]
startKeywords ps :: [Token]
ps parser :: AParser st b
parser constr :: [Annoted b] -> Range -> a
constr = do
       (vs :: [Annoted b]
vs, ts :: [Token]
ts, ans :: [[Annotation]]
ans) <- [[Char]]
-> AParser st (Annoted b)
-> AParser st ([Annoted b], [Token], [[Annotation]])
forall st a.
[[Char]]
-> AParser st a -> AParser st ([a], [Token], [[Annotation]])
itemAux [[Char]]
startKeywords (AParser st b -> AParser st (Annoted b)
forall st a. AParser st a -> AParser st (Annoted a)
annoParser AParser st b
parser)
       let r :: [Annoted b]
r = (Annoted b -> [Annotation] -> Annoted b)
-> [Annoted b] -> [[Annotation]] -> [Annoted b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Annoted b -> [Annotation] -> Annoted b
forall a. Annoted a -> [Annotation] -> Annoted a
appendAnno [Annoted b]
vs [[Annotation]]
ans in
           a -> AParser st a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Annoted b] -> Range -> a
constr [Annoted b]
r ([Token] -> Range
catRange ([Token]
ps [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
ts)))

-- | parse an item list without a starting keyword
itemAux :: [String] -> AParser st a
        -> AParser st ([a], [Token], [[Annotation]])
itemAux :: [[Char]]
-> AParser st a -> AParser st ([a], [Token], [[Annotation]])
itemAux startKeywords :: [[Char]]
startKeywords itemParser :: AParser st a
itemParser =
    do a
a <- AParser st a
itemParser
       (m :: [Token]
m, an :: [Annotation]
an) <- AParser st ([Token], [Annotation])
forall st. AParser st ([Token], [Annotation])
optSemi
       let r :: ParsecT [Char] (AnnoState st) Identity ([a], [a], [[Annotation]])
r = ([a], [a], [[Annotation]])
-> ParsecT
     [Char] (AnnoState st) Identity ([a], [a], [[Annotation]])
forall (m :: * -> *) a. Monad m => a -> m a
return ([a
a], [], [[Annotation]
an])
       ([[Char]] -> AParser st ()
forall st. [[Char]] -> AParser st ()
tryItemEnd [[Char]]
startKeywords AParser st ()
-> AParser st ([a], [Token], [[Annotation]])
-> AParser st ([a], [Token], [[Annotation]])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AParser st ([a], [Token], [[Annotation]])
forall a.
ParsecT [Char] (AnnoState st) Identity ([a], [a], [[Annotation]])
r) AParser st ([a], [Token], [[Annotation]])
-> AParser st ([a], [Token], [[Annotation]])
-> AParser st ([a], [Token], [[Annotation]])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          do (ergs :: [a]
ergs, ts :: [Token]
ts, ans :: [[Annotation]]
ans) <- [[Char]]
-> AParser st a -> AParser st ([a], [Token], [[Annotation]])
forall st a.
[[Char]]
-> AParser st a -> AParser st ([a], [Token], [[Annotation]])
itemAux [[Char]]
startKeywords AParser st a
itemParser
             ([a], [Token], [[Annotation]])
-> AParser st ([a], [Token], [[Annotation]])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ergs, [Token]
m [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
ts, [Annotation]
an [Annotation] -> [[Annotation]] -> [[Annotation]]
forall a. a -> [a] -> [a]
: [[Annotation]]
ans)

-- | collect preceding and trailing annotations
wrapAnnos :: AParser st a -> AParser st a
wrapAnnos :: AParser st a -> AParser st a
wrapAnnos p :: AParser st a
p = AParser st a -> AParser st a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (AParser st ()
forall st. AParser st ()
addAnnos AParser st () -> AParser st a -> AParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AParser st a
p) AParser st a -> AParser st () -> AParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< AParser st ()
forall st. AParser st ()
addAnnos

-- | parse an annoted keyword
asKey :: String -> AParser st Token
asKey :: [Char] -> AParser st Token
asKey = AParser st Token -> AParser st Token
forall st a. AParser st a -> AParser st a
wrapAnnos (AParser st Token -> AParser st Token)
-> ([Char] -> AParser st Token) -> [Char] -> AParser st Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharParser (AnnoState st) [Char] -> AParser st Token
forall st. CharParser st [Char] -> CharParser st Token
pToken (CharParser (AnnoState st) [Char] -> AParser st Token)
-> ([Char] -> CharParser (AnnoState st) [Char])
-> [Char]
-> AParser st Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> CharParser (AnnoState st) [Char]
forall st. [Char] -> CharParser st [Char]
toKey

-- * annoted keywords

anComma :: AParser st Token
anComma :: AParser st Token
anComma = AParser st Token -> AParser st Token
forall st a. AParser st a -> AParser st a
wrapAnnos AParser st Token
forall st. CharParser st Token
commaT

anSemi :: AParser st Token
anSemi :: AParser st Token
anSemi = AParser st Token -> AParser st Token
forall st a. AParser st a -> AParser st a
wrapAnnos AParser st Token
forall st. CharParser st Token
semiT

semiOrComma :: CharParser st Token
semiOrComma :: CharParser st Token
semiOrComma = CharParser st Token
forall st. CharParser st Token
semiT CharParser st Token -> CharParser st Token -> CharParser st Token
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st Token
forall st. CharParser st Token
commaT

anSemiOrComma :: AParser st Token
anSemiOrComma :: AParser st Token
anSemiOrComma = AParser st Token -> AParser st Token
forall st a. AParser st a -> AParser st a
wrapAnnos AParser st Token
forall st. CharParser st Token
semiOrComma AParser st Token
-> ParsecT [Char] (AnnoState st) Identity () -> AParser st Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT [Char] (AnnoState st) Identity ()
forall st. AParser st ()
addLineAnnos

-- | check for a semicolon beyond annotations
trySemi :: AParser st Token
trySemi :: AParser st Token
trySemi = AParser st Token -> AParser st Token
forall tok st a. GenParser tok st a -> GenParser tok st a
try (AParser st Token -> AParser st Token)
-> AParser st Token -> AParser st Token
forall a b. (a -> b) -> a -> b
$ AParser st ()
forall st. AParser st ()
addAnnos AParser st () -> AParser st Token -> AParser st Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AParser st Token
forall st. CharParser st Token
semiT

-- | check for a semicolon or comma beyond annotations and trailing line annos
trySemiOrComma :: AParser st Token
trySemiOrComma :: AParser st Token
trySemiOrComma = AParser st Token -> AParser st Token
forall tok st a. GenParser tok st a -> GenParser tok st a
try (AParser st ()
forall st. AParser st ()
addAnnos AParser st () -> AParser st Token -> AParser st Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AParser st Token
forall st. CharParser st Token
semiOrComma) AParser st Token -> AParser st () -> AParser st Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< AParser st ()
forall st. AParser st ()
addLineAnnos

-- | optional semicolon followed by annotations on consecutive lines
optSemi :: AParser st ([Token], [Annotation])
optSemi :: AParser st ([Token], [Annotation])
optSemi = do
    Token
s <- AParser st Token
forall st. AParser st Token
trySemi
    [Annotation]
a1 <- AParser st [Annotation]
forall st. AParser st [Annotation]
getAnnos
    [Annotation]
a2 <- AParser st [Annotation]
forall st. AParser st [Annotation]
lineAnnos
    ([Token], [Annotation]) -> AParser st ([Token], [Annotation])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Token
s], [Annotation]
a1 [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Annotation]
a2)
  AParser st ([Token], [Annotation])
-> AParser st ([Token], [Annotation])
-> AParser st ([Token], [Annotation])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
    [Annotation]
a <- AParser st [Annotation]
forall st. AParser st [Annotation]
lineAnnos
    ([Token], [Annotation]) -> AParser st ([Token], [Annotation])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Annotation]
a)

equalT :: AParser st Token
equalT :: AParser st Token
equalT = AParser st Token -> AParser st Token
forall st a. AParser st a -> AParser st a
wrapAnnos (AParser st Token -> AParser st Token)
-> AParser st Token -> AParser st Token
forall a b. (a -> b) -> a -> b
$ CharParser (AnnoState st) [Char] -> AParser st Token
forall st. CharParser st [Char] -> CharParser st Token
pToken (CharParser (AnnoState st) [Char] -> AParser st Token)
-> CharParser (AnnoState st) [Char] -> AParser st Token
forall a b. (a -> b) -> a -> b
$ [[Char]]
-> CharParser (AnnoState st) [Char]
-> CharParser (AnnoState st) [Char]
forall st. [[Char]] -> CharParser st [Char] -> CharParser st [Char]
reserved [[Char]
exEqual]
         ([CharParser (AnnoState st) [Char]]
-> CharParser (AnnoState st) [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (([Char] -> CharParser (AnnoState st) [Char])
-> [[Char]] -> [CharParser (AnnoState st) [Char]]
forall a b. (a -> b) -> [a] -> [b]
map (CharParser (AnnoState st) [Char]
-> CharParser (AnnoState st) [Char]
forall st a. CharParser st a -> CharParser st a
keySign (CharParser (AnnoState st) [Char]
 -> CharParser (AnnoState st) [Char])
-> ([Char] -> CharParser (AnnoState st) [Char])
-> [Char]
-> CharParser (AnnoState st) [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> CharParser (AnnoState st) [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string) [[Char]
exEqual, [Char]
equalS]) CharParser (AnnoState st) [Char]
-> [Char] -> CharParser (AnnoState st) [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
equalS)

colonT :: AParser st Token
colonT :: AParser st Token
colonT = [Char] -> AParser st Token
forall st. [Char] -> AParser st Token
asKey [Char]
colonS

equiT :: AParser st Token
equiT :: AParser st Token
equiT = [Char] -> AParser st Token
forall st. [Char] -> AParser st Token
asKey [Char]
equiS

lessT :: AParser st Token
lessT :: AParser st Token
lessT = [Char] -> AParser st Token
forall st. [Char] -> AParser st Token
asKey [Char]
lessS

dotT :: AParser st Token
dotT :: AParser st Token
dotT = [Char] -> AParser st Token
forall st. [Char] -> AParser st Token
asKey [Char]
dotS AParser st Token -> AParser st Token -> AParser st Token
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> AParser st Token
forall st. [Char] -> AParser st Token
asKey [Char]
cDot AParser st Token -> [Char] -> AParser st Token
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
dotS

asT :: AParser st Token
asT :: AParser st Token
asT = [Char] -> AParser st Token
forall st. [Char] -> AParser st Token
asKey [Char]
asS

barT :: AParser st Token
barT :: AParser st Token
barT = [Char] -> AParser st Token
forall st. [Char] -> AParser st Token
asKey [Char]
barS

forallT :: AParser st Token
forallT :: AParser st Token
forallT = [Char] -> AParser st Token
forall st. [Char] -> AParser st Token
asKey [Char]
forallS