{- |
Module      :  ./Common/AnnoParser.hs
Description :  parsers for annotations and annoted items
Copyright   :  (c) Klaus Luettich, Christian Maeder and Uni Bremen 2002-2006
License     :  GPLv2 or higher, see LICENSE.txt

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

Parsers for annotations and annoted items

   Follows Chap. II:5 of the CASL Reference Manual.

   uses Lexer, Keywords and Token rather than CaslLanguage

   semantic annotations now end immediately after the keyword!
-}

module Common.AnnoParser
    ( annotationL
    , annotations
    , fromPos
    , parseAnno
    , parseAnnoId
    , commentLine
    , newlineOrEof
    ) where

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Error
import Text.ParserCombinators.Parsec.Pos as Pos

import Common.Parsec
import Common.Lexer
import Common.Token
import Common.Id as Id
import Common.IRI as IRI
import Common.Keywords
import Common.AS_Annotation
import Common.Utils (trimRight)
import qualified Control.Monad.Fail as Fail

import qualified Data.Map as Map
import Data.List

comment :: GenParser Char st Annotation
comment :: GenParser Char st Annotation
comment = GenParser Char st Annotation
forall st. GenParser Char st Annotation
commentLine GenParser Char st Annotation
-> GenParser Char st Annotation -> GenParser Char st Annotation
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st Annotation
forall st. GenParser Char st Annotation
commentGroup

parseAnnoId :: GenParser Char st Id
parseAnnoId :: GenParser Char st Id
parseAnnoId = let keys :: ([a], [a])
keys = ([], []) in ([String], [String])
-> ([String], [String]) -> GenParser Char st Id
forall st.
([String], [String])
-> ([String], [String]) -> GenParser Char st Id
mixId ([String], [String])
forall a a. ([a], [a])
keys ([String], [String])
forall a a. ([a], [a])
keys

charOrEof :: Char -> GenParser Char st ()
charOrEof :: Char -> GenParser Char st ()
charOrEof c :: Char
c = ParsecT String st Identity Char -> GenParser Char st ()
forall (m :: * -> *) a. Monad m => m a -> m ()
forget (Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c) GenParser Char st ()
-> GenParser Char st () -> GenParser Char st ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

newlineOrEof :: GenParser Char st ()
newlineOrEof :: GenParser Char st ()
newlineOrEof = GenParser Char st () -> GenParser Char st ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (GenParser Char st () -> GenParser Char st ())
-> GenParser Char st () -> GenParser Char st ()
forall a b. (a -> b) -> a -> b
$ Char -> GenParser Char st ()
forall st. Char -> GenParser Char st ()
charOrEof '\n'

mkLineAnno :: String -> Annote_text
mkLineAnno :: String -> Annote_text
mkLineAnno s :: String
s = let r :: String
r = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
s in String -> Annote_text
Line_anno (String -> Annote_text) -> String -> Annote_text
forall a b. (a -> b) -> a -> b
$
  [' ' | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r) Bool -> Bool -> Bool
&& String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf " " String
s] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r

commentLine :: GenParser Char st Annotation
commentLine :: GenParser Char st Annotation
commentLine = do
    Pos
p <- GenParser Char st Pos
forall tok st. GenParser tok st Pos
getPos
    String -> CharParser st String
forall st. String -> CharParser st String
tryString String
percents
    String
line <- ParsecT String st Identity Char
-> ParsecT String st Identity () -> CharParser st String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String st Identity ()
forall st. GenParser Char st ()
newlineOrEof
    Pos
q <- GenParser Char st Pos
forall tok st. GenParser tok st Pos
getPos
    Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> GenParser Char st Annotation)
-> Annotation -> GenParser Char st Annotation
forall a b. (a -> b) -> a -> b
$ Annote_word -> Annote_text -> Range -> Annotation
Unparsed_anno Annote_word
Comment_start (String -> Annote_text
mkLineAnno String
line) ([Pos] -> Range
Range [Pos
p, Pos -> Pos
dec Pos
q])

dec :: Pos -> Pos
dec :: Pos -> Pos
dec p :: Pos
p = Pos -> Int -> Pos
Id.incSourceColumn Pos
p (-1)

mylines :: String -> [String]
mylines :: String -> [String]
mylines s :: String
s = let strip :: String -> String
strip = [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words in
  case String -> [String]
lines String
s [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["" | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf "\n" String
s] of
  [] -> []
  [x :: String
x] -> let x0 :: String
x0 = String -> String
strip String
x in
         [if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x0 then String
x0
          else [' ' | String -> Char
forall a. [a] -> a
head String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' '] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ [' ' | String -> Char
forall a. [a] -> a
last String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ']]
  (x :: String
x : r :: [String]
r) ->
     let x0 :: String
x0 = String -> String
strip String
x
         e :: String
e = [String] -> String
forall a. [a] -> a
last [String]
r
         e0 :: String
e0 = String -> String
strip String
e
         needsBlank :: Bool
needsBlank = Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x0) Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
head String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' '
         addBlank :: String -> String
addBlank y :: String
y = [' ' | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
y) Bool -> Bool -> Bool
&& Bool
needsBlank] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y
     in String -> String
addBlank String
x0 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
addBlank (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strip) ([String] -> [String]
forall a. [a] -> [a]
init [String]
r)
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
e then String
e
            else if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
e0 then [' ' | Bool
needsBlank]
            else String -> String
addBlank String
e0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ [' ' | String -> Char
forall a. [a] -> a
last String
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ']]

commentGroup :: GenParser Char st Annotation
commentGroup :: GenParser Char st Annotation
commentGroup = do
    Pos
p <- GenParser Char st Pos
forall tok st. GenParser tok st Pos
getPos
    String
textLines <- String -> String -> CharParser st String
forall st. String -> String -> CharParser st String
plainBlock "%{" "}%"
    Pos
q <- GenParser Char st Pos
forall tok st. GenParser tok st Pos
getPos
    Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> GenParser Char st Annotation)
-> Annotation -> GenParser Char st Annotation
forall a b. (a -> b) -> a -> b
$ Annote_word -> Annote_text -> Range -> Annotation
Unparsed_anno Annote_word
Comment_start
               ([String] -> Annote_text
Group_anno ([String] -> Annote_text) -> [String] -> Annote_text
forall a b. (a -> b) -> a -> b
$ String -> [String]
mylines String
textLines) ([Pos] -> Range
Range [Pos
p, Pos -> Pos
dec Pos
q])

annote :: GenParser Char st Annotation
annote :: GenParser Char st Annotation
annote = GenParser Char st Annotation
forall st. GenParser Char st Annotation
annoLabel GenParser Char st Annotation
-> GenParser Char st Annotation -> GenParser Char st Annotation
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
    Pos
p <- GenParser Char st Pos
forall tok st. GenParser tok st Pos
getPos
    Annote_word
i <- GenParser Char st Annote_word -> GenParser Char st Annote_word
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser Char st Annote_word
forall st. GenParser Char st Annote_word
annoIdent
    Annotation
anno <- Pos -> Annote_word -> GenParser Char st Annotation
forall st. Pos -> Annote_word -> GenParser Char st Annotation
annoteGroup Pos
p Annote_word
i GenParser Char st Annotation
-> GenParser Char st Annotation -> GenParser Char st Annotation
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Pos -> Annote_word -> GenParser Char st Annotation
forall st. Pos -> Annote_word -> GenParser Char st Annotation
annoteLine Pos
p Annote_word
i
    case Annotation -> Pos -> Either ParseError Annotation
parseAnno Annotation
anno Pos
p of
      Left err :: ParseError
err -> do
        SourcePos -> ParsecT String st Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (ParseError -> SourcePos
errorPos ParseError
err)
        String -> GenParser Char st Annotation
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> String
forall a. [a] -> [a]
tail (String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages "or" "unknown parse error"
                    "expecting" "unexpected" "end of input"
                    (ParseError -> [Message]
errorMessages ParseError
err)))
      Right pa :: Annotation
pa -> Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation
pa

annoLabel :: GenParser Char st Annotation
annoLabel :: GenParser Char st Annotation
annoLabel = do
    Pos
p <- GenParser Char st Pos
forall tok st. GenParser tok st Pos
getPos
    String
labelLines <- String -> String -> CharParser st String
forall st. String -> String -> CharParser st String
plainBlock "%(" ")%"
    Pos
q <- GenParser Char st Pos
forall tok st. GenParser tok st Pos
getPos
    Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> GenParser Char st Annotation)
-> Annotation -> GenParser Char st Annotation
forall a b. (a -> b) -> a -> b
$ [String] -> Range -> Annotation
Label (String -> [String]
mylines String
labelLines) (Range -> Annotation) -> Range -> Annotation
forall a b. (a -> b) -> a -> b
$ [Pos] -> Range
Range [Pos
p, Pos -> Pos
dec Pos
q]

annoIdent :: GenParser Char st Annote_word
annoIdent :: GenParser Char st Annote_word
annoIdent = (String -> Annote_word)
-> ParsecT String st Identity String
-> GenParser Char st Annote_word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Annote_word
Annote_word (ParsecT String st Identity String
 -> GenParser Char st Annote_word)
-> ParsecT String st Identity String
-> GenParser Char st Annote_word
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
percentS ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    (ParsecT String st Identity String
forall st. CharParser st String
scanAnyWords ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
     String -> ParsecT String st Identity String
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "wrong comment or annotation starting with a single %")

annoteGroup :: Pos -> Annote_word -> GenParser Char st Annotation
annoteGroup :: Pos -> Annote_word -> GenParser Char st Annotation
annoteGroup p :: Pos
p s :: Annote_word
s =
  let aP :: ParsecT String st Identity Annotation
aP = do
        String
annoteLines <- String -> String -> CharParser st String
forall st. String -> String -> CharParser st String
plainBlock "(" ")%"
        Pos
q <- GenParser Char st Pos
forall tok st. GenParser tok st Pos
getPos
        Annotation -> ParsecT String st Identity Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> ParsecT String st Identity Annotation)
-> Annotation -> ParsecT String st Identity Annotation
forall a b. (a -> b) -> a -> b
$ Annote_word -> Annote_text -> Range -> Annotation
Unparsed_anno Annote_word
s ([String] -> Annote_text
Group_anno ([String] -> Annote_text) -> [String] -> Annote_text
forall a b. (a -> b) -> a -> b
$ String -> [String]
mylines String
annoteLines)
                  (Range -> Annotation) -> Range -> Annotation
forall a b. (a -> b) -> a -> b
$ [Pos] -> Range
Range [Pos
p, Pos -> Pos
dec Pos
q]
  in case Annote_word
s of
        Annote_word w :: String
w -> case String -> [(String, Semantic_anno)] -> Maybe Semantic_anno
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
w ([(String, Semantic_anno)] -> Maybe Semantic_anno)
-> [(String, Semantic_anno)] -> Maybe Semantic_anno
forall a b. (a -> b) -> a -> b
$ [(Semantic_anno, String)] -> [(String, Semantic_anno)]
forall a b. [(a, b)] -> [(b, a)]
swapTable [(Semantic_anno, String)]
semantic_anno_table of
          Just sa :: Semantic_anno
sa -> Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> GenParser Char st Annotation)
-> Annotation -> GenParser Char st Annotation
forall a b. (a -> b) -> a -> b
$ Semantic_anno -> Range -> Annotation
Semantic_anno Semantic_anno
sa
            (Range -> Annotation) -> Range -> Annotation
forall a b. (a -> b) -> a -> b
$ [Pos] -> Range
Range [Pos
p, Pos -> Int -> Pos
Id.incSourceColumn Pos
p (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Semantic_anno -> String
forall a. Show a => a -> String
show Semantic_anno
sa) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3]
          Nothing -> GenParser Char st Annotation
forall st. GenParser Char st Annotation
aP
        _ -> GenParser Char st Annotation
forall st. GenParser Char st Annotation
aP

annoteLine :: Pos -> Annote_word -> GenParser Char st Annotation
annoteLine :: Pos -> Annote_word -> GenParser Char st Annotation
annoteLine p :: Pos
p s :: Annote_word
s = do
        String
line <- ParsecT String st Identity Char
-> ParsecT String st Identity ()
-> ParsecT String st Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String st Identity ()
forall st. GenParser Char st ()
newlineOrEof
        Pos
q <- GenParser Char st Pos
forall tok st. GenParser tok st Pos
getPos
        Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> GenParser Char st Annotation)
-> Annotation -> GenParser Char st Annotation
forall a b. (a -> b) -> a -> b
$ Annote_word -> Annote_text -> Range -> Annotation
Unparsed_anno Annote_word
s (String -> Annote_text
mkLineAnno String
line) (Range -> Annotation) -> Range -> Annotation
forall a b. (a -> b) -> a -> b
$ [Pos] -> Range
Range [Pos
p, Pos -> Pos
dec Pos
q]

annotationL :: GenParser Char st Annotation
annotationL :: GenParser Char st Annotation
annotationL = GenParser Char st Annotation
forall st. GenParser Char st Annotation
comment GenParser Char st Annotation
-> GenParser Char st Annotation -> GenParser Char st Annotation
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st Annotation
forall st. GenParser Char st Annotation
annote GenParser Char st Annotation
-> String -> GenParser Char st Annotation
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "\"%\""

annotations :: GenParser Char st [Annotation]
annotations :: GenParser Char st [Annotation]
annotations = ParsecT String st Identity Annotation
-> GenParser Char st [Annotation]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity Annotation
forall st. GenParser Char st Annotation
annotationL ParsecT String st Identity Annotation
-> ParsecT String st Identity ()
-> ParsecT String st Identity Annotation
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity ()
forall st. GenParser Char st ()
skip)

{- ---------------------------------------
parser for the contents of annotations
--------------------------------------- -}

commaIds :: GenParser Char st [Id]
commaIds :: GenParser Char st [Id]
commaIds = CharParser st Id -> GenParser Char st [Id]
forall st a. CharParser st a -> CharParser st [a]
commaSep1 CharParser st Id
forall st. GenParser Char st Id
parseAnnoId

parseAnno :: Annotation -> Pos -> Either ParseError Annotation
parseAnno :: Annotation -> Pos -> Either ParseError Annotation
parseAnno anno :: Annotation
anno sp :: Pos
sp = case Annotation
anno of
    Unparsed_anno (Annote_word kw :: String
kw) txt :: Annote_text
txt qs :: Range
qs -> let
          nsp :: Pos
nsp = Pos -> Int -> Pos
Id.incSourceColumn Pos
sp (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
kw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
          inp :: String
inp = Annote_text -> String
annoArg Annote_text
txt
          mkAssoc :: AssocEither -> m [Id] -> m Annotation
mkAssoc dir :: AssocEither
dir p :: m [Id]
p = do
                        [Id]
res <- m [Id]
p
                        Annotation -> m Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (AssocEither -> [Id] -> Range -> Annotation
Assoc_anno AssocEither
dir [Id]
res Range
qs)
          in Either ParseError Annotation
-> String
-> Map String (Either ParseError Annotation)
-> Either ParseError Annotation
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Annotation -> Either ParseError Annotation
forall a b. b -> Either a b
Right Annotation
anno) String
kw (Map String (Either ParseError Annotation)
 -> Either ParseError Annotation)
-> Map String (Either ParseError Annotation)
-> Either ParseError Annotation
forall a b. (a -> b) -> a -> b
$ (GenParser Char () Annotation -> Either ParseError Annotation)
-> Map String (GenParser Char () Annotation)
-> Map String (Either ParseError Annotation)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ( \ p :: GenParser Char () Annotation
p ->
                              GenParser Char () Annotation
-> Pos -> String -> Either ParseError Annotation
forall a.
GenParser Char () a -> Pos -> String -> Either ParseError a
parseInternal GenParser Char () Annotation
p Pos
nsp String
inp) (Map String (GenParser Char () Annotation)
 -> Map String (Either ParseError Annotation))
-> Map String (GenParser Char () Annotation)
-> Map String (Either ParseError Annotation)
forall a b. (a -> b) -> a -> b
$ [(String, GenParser Char () Annotation)]
-> Map String (GenParser Char () Annotation)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
             [ (String
left_assocS, AssocEither
-> ParsecT String () Identity [Id] -> GenParser Char () Annotation
forall (m :: * -> *).
Monad m =>
AssocEither -> m [Id] -> m Annotation
mkAssoc AssocEither
ALeft ParsecT String () Identity [Id]
forall st. GenParser Char st [Id]
commaIds)
             , (String
right_assocS, AssocEither
-> ParsecT String () Identity [Id] -> GenParser Char () Annotation
forall (m :: * -> *).
Monad m =>
AssocEither -> m [Id] -> m Annotation
mkAssoc AssocEither
ARight ParsecT String () Identity [Id]
forall st. GenParser Char st [Id]
commaIds)
             , (String
precS , Range -> GenParser Char () Annotation
forall st. Range -> GenParser Char st Annotation
precAnno Range
qs)
             , (String
displayS , Range -> GenParser Char () Annotation
forall st. Range -> GenParser Char st Annotation
displayAnno Range
qs)
             , (String
numberS , Range -> GenParser Char () Annotation
forall st. Range -> GenParser Char st Annotation
numberAnno Range
qs)
             , (String
stringS , Range -> GenParser Char () Annotation
forall st. Range -> GenParser Char st Annotation
stringAnno Range
qs)
             , (String
listS , Range -> GenParser Char () Annotation
forall st. Range -> GenParser Char st Annotation
listAnno Range
qs)
             , (String
floatingS, Range -> GenParser Char () Annotation
forall st. Range -> GenParser Char st Annotation
floatingAnno Range
qs)
             , (String
prefixS, Range -> GenParser Char () Annotation
forall st. Range -> GenParser Char st Annotation
prefixAnno Range
qs)]
    _ -> Annotation -> Either ParseError Annotation
forall a b. b -> Either a b
Right Annotation
anno

fromPos :: Pos -> SourcePos
fromPos :: Pos -> SourcePos
fromPos p :: Pos
p = String -> Int -> Int -> SourcePos
Pos.newPos (Pos -> String
Id.sourceName Pos
p) (Pos -> Int
Id.sourceLine Pos
p) (Pos -> Int
Id.sourceColumn Pos
p)

parseInternal :: GenParser Char () a -> Pos -> String -> Either ParseError a
parseInternal :: GenParser Char () a -> Pos -> String -> Either ParseError a
parseInternal p :: GenParser Char () a
p sp :: Pos
sp = GenParser Char () a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse
  (do
    SourcePos -> ParsecT String () Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT String () Identity ())
-> SourcePos -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Pos -> SourcePos
fromPos Pos
sp
    ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    a
res <- GenParser Char () a
p
    ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
    a -> GenParser Char () a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res) (Pos -> String
Id.sourceName Pos
sp)

checkForPlaces :: [Token] -> GenParser Char st [Token]
checkForPlaces :: [Token] -> GenParser Char st [Token]
checkForPlaces ts :: [Token]
ts =
    do let ps :: [Token]
ps = (Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter Token -> Bool
isPlace [Token]
ts
       if [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
ps then GenParser Char st [Token] -> GenParser Char st [Token]
forall st. GenParser Char st [Token] -> GenParser Char st [Token]
nextListToks (GenParser Char st [Token] -> GenParser Char st [Token])
-> GenParser Char st [Token] -> GenParser Char st [Token]
forall a b. (a -> b) -> a -> b
$ ([String], [String]) -> GenParser Char st [Token]
forall st. ([String], [String]) -> GenParser Char st [Token]
topMix3 ([], [])
          -- topMix3 starts with square brackets
          else if [Token] -> Bool
forall a. [a] -> Bool
isSingle [Token]
ps then [Token] -> GenParser Char st [Token]
forall (m :: * -> *) a. Monad m => a -> m a
return []
               else String -> GenParser Char st [Token]
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected "multiple places"

nextListToks :: GenParser Char st [Token] -> GenParser Char st [Token]
nextListToks :: GenParser Char st [Token] -> GenParser Char st [Token]
nextListToks f :: GenParser Char st [Token]
f =
    do [Token]
ts <- GenParser Char st [Token]
f
       [Token]
cs <- [Token] -> GenParser Char st [Token]
forall st. [Token] -> GenParser Char st [Token]
checkForPlaces [Token]
ts
       [Token] -> GenParser Char st [Token]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Token]
ts [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
cs)

caslListBrackets :: GenParser Char st Id
caslListBrackets :: GenParser Char st Id
caslListBrackets =
    do [Token]
l <- GenParser Char st [Token] -> GenParser Char st [Token]
forall st. GenParser Char st [Token] -> GenParser Char st [Token]
nextListToks (GenParser Char st [Token] -> GenParser Char st [Token])
-> GenParser Char st [Token] -> GenParser Char st [Token]
forall a b. (a -> b) -> a -> b
$ ([String], [String]) -> GenParser Char st [Token]
forall st. ([String], [String]) -> GenParser Char st [Token]
afterPlace ([], [])
       (c :: [Id]
c, p :: Range
p) <- ([Id], Range)
-> ParsecT String st Identity ([Id], Range)
-> ParsecT String st Identity ([Id], Range)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option ([], Range
nullRange) (ParsecT String st Identity ([Id], Range)
 -> ParsecT String st Identity ([Id], Range))
-> ParsecT String st Identity ([Id], Range)
-> ParsecT String st Identity ([Id], Range)
forall a b. (a -> b) -> a -> b
$ ([String], [String]) -> ParsecT String st Identity ([Id], Range)
forall st. ([String], [String]) -> GenParser Char st ([Id], Range)
comps ([], [])
       Id -> GenParser Char st Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> GenParser Char st Id) -> Id -> GenParser Char st Id
forall a b. (a -> b) -> a -> b
$ [Token] -> [Id] -> Range -> Id
Id [Token]
l [Id]
c Range
p

precAnno, numberAnno, stringAnno, listAnno, floatingAnno
    :: Range -> GenParser Char st Annotation
precAnno :: Range -> GenParser Char st Annotation
precAnno ps :: Range
ps = do
    [Id]
leftIds <- CharParser st [Id] -> CharParser st [Id]
forall st a. CharParser st a -> CharParser st a
braces CharParser st [Id]
forall st. GenParser Char st [Id]
commaIds
    String
sign <- (String -> CharParser st String
forall st. String -> CharParser st String
tryString "<>" CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "<") CharParser st String
-> ParsecT String st Identity () -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    [Id]
rightIds <- CharParser st [Id] -> CharParser st [Id]
forall st a. CharParser st a -> CharParser st a
braces CharParser st [Id]
forall st. GenParser Char st [Id]
commaIds
    Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> GenParser Char st Annotation)
-> Annotation -> GenParser Char st Annotation
forall a b. (a -> b) -> a -> b
$ PrecRel -> [Id] -> [Id] -> Range -> Annotation
Prec_anno
               (if String
sign String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "<" then PrecRel
Lower else PrecRel
BothDirections)
               [Id]
leftIds
               [Id]
rightIds
               Range
ps

numberAnno :: Range -> GenParser Char st Annotation
numberAnno ps :: Range
ps = do
    Id
n <- GenParser Char st Id
forall st. GenParser Char st Id
parseAnnoId
    Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> GenParser Char st Annotation)
-> Annotation -> GenParser Char st Annotation
forall a b. (a -> b) -> a -> b
$ Id -> Range -> Annotation
Number_anno Id
n Range
ps

listAnno :: Range -> GenParser Char st Annotation
listAnno ps :: Range
ps = do
    Id
bs <- GenParser Char st Id
forall st. GenParser Char st Id
caslListBrackets
    CharParser st Token
forall st. CharParser st Token
commaT
    Id
ni <- GenParser Char st Id
forall st. GenParser Char st Id
parseAnnoId
    CharParser st Token
forall st. CharParser st Token
commaT
    Id
ci <- GenParser Char st Id
forall st. GenParser Char st Id
parseAnnoId
    Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> GenParser Char st Annotation)
-> Annotation -> GenParser Char st Annotation
forall a b. (a -> b) -> a -> b
$ Id -> Id -> Id -> Range -> Annotation
List_anno Id
bs Id
ni Id
ci Range
ps

stringAnno :: Range -> GenParser Char st Annotation
stringAnno ps :: Range
ps = Range
-> (Id -> Id -> Range -> Annotation)
-> GenParser Char st Annotation
forall st.
Range
-> (Id -> Id -> Range -> Annotation)
-> GenParser Char st Annotation
literal2idsAnno Range
ps Id -> Id -> Range -> Annotation
String_anno

floatingAnno :: Range -> GenParser Char st Annotation
floatingAnno ps :: Range
ps = Range
-> (Id -> Id -> Range -> Annotation)
-> GenParser Char st Annotation
forall st.
Range
-> (Id -> Id -> Range -> Annotation)
-> GenParser Char st Annotation
literal2idsAnno Range
ps Id -> Id -> Range -> Annotation
Float_anno

prefixAnno :: Range -> GenParser Char st Annotation
prefixAnno :: Range -> GenParser Char st Annotation
prefixAnno ps :: Range
ps = do
    [(String, IRI)]
prefixes <- ParsecT String st Identity (String, IRI)
-> ParsecT String st Identity [(String, IRI)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity (String, IRI)
 -> ParsecT String st Identity [(String, IRI)])
-> ParsecT String st Identity (String, IRI)
-> ParsecT String st Identity [(String, IRI)]
forall a b. (a -> b) -> a -> b
$ do
        String
p <- (String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
colonS ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return "") ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             (ParsecT String st Identity String
forall st. CharParser st String
IRI.ncname ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
colonS)
        ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
        IRI
i <- IRIParser st IRI -> IRIParser st IRI
forall st. IRIParser st IRI -> IRIParser st IRI
angles IRIParser st IRI
forall st. IRIParser st IRI
IRI.iriParser
        ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
        (String, IRI) -> ParsecT String st Identity (String, IRI)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, IRI
i)
    Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> GenParser Char st Annotation)
-> Annotation -> GenParser Char st Annotation
forall a b. (a -> b) -> a -> b
$ [(String, IRI)] -> Range -> Annotation
Prefix_anno [(String, IRI)]
prefixes Range
ps

literal2idsAnno :: Range -> (Id -> Id -> Range -> Annotation)
                -> GenParser Char st Annotation
literal2idsAnno :: Range
-> (Id -> Id -> Range -> Annotation)
-> GenParser Char st Annotation
literal2idsAnno ps :: Range
ps con :: Id -> Id -> Range -> Annotation
con = do
    Id
i1 <- GenParser Char st Id
forall st. GenParser Char st Id
parseAnnoId
    CharParser st Token
forall st. CharParser st Token
commaT
    Id
i2 <- GenParser Char st Id
forall st. GenParser Char st Id
parseAnnoId
    Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> GenParser Char st Annotation)
-> Annotation -> GenParser Char st Annotation
forall a b. (a -> b) -> a -> b
$ Id -> Id -> Range -> Annotation
con Id
i1 Id
i2 Range
ps

displayAnno :: Range -> GenParser Char st Annotation
displayAnno :: Range -> GenParser Char st Annotation
displayAnno ps :: Range
ps = do
    Id
ident <- GenParser Char st Id
forall st. GenParser Char st Id
parseAnnoId
    [(Display_format, String)]
tls <- ParsecT String st Identity (Display_format, String)
-> ParsecT String st Identity [(Display_format, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity (Display_format, String)
 -> ParsecT String st Identity [(Display_format, String)])
-> ParsecT String st Identity (Display_format, String)
-> ParsecT String st Identity [(Display_format, String)]
forall a b. (a -> b) -> a -> b
$ (ParsecT String st Identity (Display_format, String)
 -> ParsecT String st Identity (Display_format, String)
 -> ParsecT String st Identity (Display_format, String))
-> [ParsecT String st Identity (Display_format, String)]
-> ParsecT String st Identity (Display_format, String)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 ParsecT String st Identity (Display_format, String)
-> ParsecT String st Identity (Display_format, String)
-> ParsecT String st Identity (Display_format, String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) ([ParsecT String st Identity (Display_format, String)]
 -> ParsecT String st Identity (Display_format, String))
-> [ParsecT String st Identity (Display_format, String)]
-> ParsecT String st Identity (Display_format, String)
forall a b. (a -> b) -> a -> b
$ ((Display_format, String)
 -> ParsecT String st Identity (Display_format, String))
-> [(Display_format, String)]
-> [ParsecT String st Identity (Display_format, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Display_format, String)
-> ParsecT String st Identity (Display_format, String)
forall st.
(Display_format, String)
-> GenParser Char st (Display_format, String)
dispSymb [(Display_format, String)]
display_format_table
    Annotation -> GenParser Char st Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> [(Display_format, String)] -> Range -> Annotation
Display_anno Id
ident [(Display_format, String)]
tls Range
ps)

dispSymb :: (Display_format, String)
          -> GenParser Char st (Display_format, String)
dispSymb :: (Display_format, String)
-> GenParser Char st (Display_format, String)
dispSymb (dfSymb :: Display_format
dfSymb, symb :: String
symb) = do
  String -> CharParser st String
forall st. String -> CharParser st String
tryString (String
percentS String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
symb) CharParser st String
-> ParsecT String st Identity () -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  String
str <- ParsecT String st Identity Char
-> ParsecT String st Identity () -> CharParser st String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String st Identity () -> CharParser st String)
-> ParsecT String st Identity () -> CharParser st String
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity () -> ParsecT String st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT String st Identity () -> ParsecT String st Identity ())
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String st Identity ()
forall st. Char -> GenParser Char st ()
charOrEof '%'
  (Display_format, String)
-> GenParser Char st (Display_format, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Display_format
dfSymb, String -> String
trimRight String
str)