module NeSyPatterns.Parse (basicSpec, symb, symbItems, symbMapItems) where

import Common.Keywords
import Common.AnnoState
import Common.Id
import Common.IRI
import Common.Lexer
import Common.Parsec

import qualified Common.GlobalAnnotations as GA (PrefixMap)

import NeSyPatterns.AS

import Data.Maybe (isJust, catMaybes)

import Text.ParserCombinators.Parsec

symb :: GA.PrefixMap -> AParser st SYMB
symb :: PrefixMap -> AParser st SYMB
symb = (Node -> SYMB)
-> ParsecT [Char] (AnnoState st) Identity Node -> AParser st SYMB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node -> SYMB
Symb_id (ParsecT [Char] (AnnoState st) Identity Node -> AParser st SYMB)
-> (PrefixMap -> ParsecT [Char] (AnnoState st) Identity Node)
-> PrefixMap
-> AParser st SYMB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrefixMap -> ParsecT [Char] (AnnoState st) Identity Node
forall st. PrefixMap -> AParser st Node
node

symbItems :: GA.PrefixMap -> AParser st SYMB_ITEMS
symbItems :: PrefixMap -> AParser st SYMB_ITEMS
symbItems pm :: PrefixMap
pm = do
    [SYMB]
is <- ([SYMB], [Token]) -> [SYMB]
forall a b. (a, b) -> a
fst (([SYMB], [Token]) -> [SYMB])
-> ParsecT [Char] (AnnoState st) Identity ([SYMB], [Token])
-> ParsecT [Char] (AnnoState st) Identity [SYMB]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrefixMap -> AParser st SYMB
forall st. PrefixMap -> AParser st SYMB
symb PrefixMap
pm AParser st SYMB
-> GenParser Char (AnnoState st) Token
-> ParsecT [Char] (AnnoState st) Identity ([SYMB], [Token])
forall tok st a b.
GenParser tok st a
-> GenParser tok st b -> GenParser tok st ([a], [b])
`separatedBy` GenParser Char (AnnoState st) Token
forall st. AParser st Token
anComma
    let range :: Range
range = (SYMB -> Range) -> [SYMB] -> Range
forall a. (a -> Range) -> [a] -> Range
concatMapRange SYMB -> Range
forall a. GetRange a => a -> Range
getRange [SYMB]
is
    SYMB_ITEMS -> AParser st SYMB_ITEMS
forall (m :: * -> *) a. Monad m => a -> m a
return (SYMB_ITEMS -> AParser st SYMB_ITEMS)
-> SYMB_ITEMS -> AParser st SYMB_ITEMS
forall a b. (a -> b) -> a -> b
$ [SYMB] -> Range -> SYMB_ITEMS
Symb_items [SYMB]
is Range
range

symbOrMap :: GA.PrefixMap -> AParser st SYMB_OR_MAP
symbOrMap :: PrefixMap -> AParser st SYMB_OR_MAP
symbOrMap pm :: PrefixMap
pm = do
    SYMB
s1 <- PrefixMap -> AParser st SYMB
forall st. PrefixMap -> AParser st SYMB
symb PrefixMap
pm
    Maybe SYMB
s2M <- AParser st SYMB
-> ParsecT [Char] (AnnoState st) Identity (Maybe SYMB)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ([Char] -> AParser st Token
forall st. [Char] -> AParser st Token
asKey [Char]
mapsTo AParser st Token -> AParser st SYMB -> AParser st SYMB
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrefixMap -> AParser st SYMB
forall st. PrefixMap -> AParser st SYMB
symb PrefixMap
pm)
    case Maybe SYMB
s2M of
        Nothing -> SYMB_OR_MAP -> AParser st SYMB_OR_MAP
forall (m :: * -> *) a. Monad m => a -> m a
return (SYMB_OR_MAP -> AParser st SYMB_OR_MAP)
-> SYMB_OR_MAP -> AParser st SYMB_OR_MAP
forall a b. (a -> b) -> a -> b
$ SYMB -> SYMB_OR_MAP
Symb SYMB
s1
        Just s2 :: SYMB
s2 -> SYMB_OR_MAP -> AParser st SYMB_OR_MAP
forall (m :: * -> *) a. Monad m => a -> m a
return (SYMB_OR_MAP -> AParser st SYMB_OR_MAP)
-> SYMB_OR_MAP -> AParser st SYMB_OR_MAP
forall a b. (a -> b) -> a -> b
$ SYMB -> SYMB -> Range -> SYMB_OR_MAP
Symb_map SYMB
s1 SYMB
s2 ((SYMB -> Range) -> [SYMB] -> Range
forall a. (a -> Range) -> [a] -> Range
concatMapRange SYMB -> Range
forall a. GetRange a => a -> Range
getRange [SYMB
s1, SYMB
s2])

symbMapItems :: GA.PrefixMap -> AParser st SYMB_MAP_ITEMS
symbMapItems :: PrefixMap -> AParser st SYMB_MAP_ITEMS
symbMapItems pm :: PrefixMap
pm = do
    [SYMB_OR_MAP]
is <- ([SYMB_OR_MAP], [Token]) -> [SYMB_OR_MAP]
forall a b. (a, b) -> a
fst (([SYMB_OR_MAP], [Token]) -> [SYMB_OR_MAP])
-> ParsecT [Char] (AnnoState st) Identity ([SYMB_OR_MAP], [Token])
-> ParsecT [Char] (AnnoState st) Identity [SYMB_OR_MAP]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrefixMap -> AParser st SYMB_OR_MAP
forall st. PrefixMap -> AParser st SYMB_OR_MAP
symbOrMap PrefixMap
pm AParser st SYMB_OR_MAP
-> GenParser Char (AnnoState st) Token
-> ParsecT [Char] (AnnoState st) Identity ([SYMB_OR_MAP], [Token])
forall tok st a b.
GenParser tok st a
-> GenParser tok st b -> GenParser tok st ([a], [b])
`separatedBy` GenParser Char (AnnoState st) Token
forall st. AParser st Token
anComma
    let range :: Range
range = (SYMB_OR_MAP -> Range) -> [SYMB_OR_MAP] -> Range
forall a. (a -> Range) -> [a] -> Range
concatMapRange SYMB_OR_MAP -> Range
forall a. GetRange a => a -> Range
getRange [SYMB_OR_MAP]
is
    SYMB_MAP_ITEMS -> AParser st SYMB_MAP_ITEMS
forall (m :: * -> *) a. Monad m => a -> m a
return (SYMB_MAP_ITEMS -> AParser st SYMB_MAP_ITEMS)
-> SYMB_MAP_ITEMS -> AParser st SYMB_MAP_ITEMS
forall a b. (a -> b) -> a -> b
$ [SYMB_OR_MAP] -> Range -> SYMB_MAP_ITEMS
Symb_map_items [SYMB_OR_MAP]
is Range
range

nesyKeywords :: [String]
nesyKeywords :: [[Char]]
nesyKeywords = [[Char]
endS]

uriQ :: CharParser st IRI
uriQ :: CharParser st IRI
uriQ = CharParser st IRI
forall st. IRIParser st IRI
iriCurie

expUriP :: GA.PrefixMap -> CharParser st IRI
expUriP :: PrefixMap -> CharParser st IRI
expUriP pm :: PrefixMap
pm = CharParser st IRI
forall st. IRIParser st IRI
uriP CharParser st IRI
-> (IRI -> CharParser st IRI) -> CharParser st IRI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IRI -> CharParser st IRI
forall (m :: * -> *) a. Monad m => a -> m a
return (IRI -> CharParser st IRI)
-> (IRI -> IRI) -> IRI -> CharParser st IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrefixMap -> IRI -> IRI
expandIRI PrefixMap
pm

uriP :: CharParser st IRI
uriP :: CharParser st IRI
uriP = CharParser st IRI -> CharParser st IRI
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser st IRI -> CharParser st IRI)
-> CharParser st IRI -> CharParser st IRI
forall a b. (a -> b) -> a -> b
$ do
  Bool
startsWithColon <- Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Char -> Bool)
-> ParsecT [Char] st Identity (Maybe Char)
-> ParsecT [Char] st Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT [Char] st Identity Char
 -> ParsecT [Char] st Identity (Maybe Char))
-> (ParsecT [Char] st Identity Char
    -> ParsecT [Char] st Identity Char)
-> ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] st Identity Char
 -> ParsecT [Char] st Identity Char)
-> (ParsecT [Char] st Identity Char
    -> ParsecT [Char] st Identity Char)
-> ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT [Char] st Identity Char -> ParsecT [Char] 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] st Identity Char
 -> ParsecT [Char] st Identity (Maybe Char))
-> ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':')
  (IRI -> [Char])
-> CharParser st IRI -> (IRI -> Bool) -> CharParser st IRI
forall a tok st.
(a -> [Char])
-> GenParser tok st a -> (a -> Bool) -> GenParser tok st a
checkWithUsing (\i :: IRI
i -> "keyword \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ IRI -> [Char]
showIRI IRI
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "\"") CharParser st IRI
forall st. IRIParser st IRI
uriQ ((IRI -> Bool) -> CharParser st IRI)
-> (IRI -> Bool) -> CharParser st IRI
forall a b. (a -> b) -> a -> b
$ \ q :: IRI
q -> let p :: [Char]
p = IRI -> [Char]
prefixName IRI
q in
    (Bool -> Bool
not (IRI -> Bool
isAbbrev IRI
q) Bool -> Bool -> Bool
|| Bool
startsWithColon) Bool -> Bool -> Bool
|| (Bool -> Bool
not ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
p) Bool -> Bool -> Bool
|| IRI -> [Char]
iFragment IRI
q [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]]
nesyKeywords)

name :: GA.PrefixMap -> AParser st IRI
name :: PrefixMap -> AParser st IRI
name pm :: PrefixMap
pm = AParser st IRI -> AParser st IRI
forall st a. AParser st a -> AParser st a
wrapAnnos (AParser st IRI -> AParser st IRI)
-> AParser st IRI -> AParser st IRI
forall a b. (a -> b) -> a -> b
$ PrefixMap -> AParser st IRI
forall st. PrefixMap -> CharParser st IRI
expUriP PrefixMap
pm

node :: GA.PrefixMap -> AParser st Node
node :: PrefixMap -> AParser st Node
node pm :: PrefixMap
pm = do
    IRI
n <- PrefixMap -> AParser st IRI
forall st. PrefixMap -> AParser st IRI
name PrefixMap
pm
    Maybe IRI
classM <- AParser st IRI
-> ParsecT [Char] (AnnoState st) Identity (Maybe IRI)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ([Char] -> AParser st Token
forall st. [Char] -> AParser st Token
asKey ":" AParser st Token -> AParser st IRI -> AParser st IRI
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrefixMap -> AParser st IRI
forall st. PrefixMap -> AParser st IRI
name PrefixMap
pm)
    let range :: Range
range = [IRI] -> Range
forall a. GetRange a => a -> Range
getRange ([IRI] -> Range) -> ([Maybe IRI] -> [IRI]) -> [Maybe IRI] -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe IRI] -> [IRI]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe IRI] -> Range) -> [Maybe IRI] -> Range
forall a b. (a -> b) -> a -> b
$ [IRI -> Maybe IRI
forall a. a -> Maybe a
Just IRI
n, Maybe IRI
classM]
    Node -> AParser st Node
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> AParser st Node) -> Node -> AParser st Node
forall a b. (a -> b) -> a -> b
$ case Maybe IRI
classM of
        Nothing -> IRI -> Maybe IRI -> Range -> Node
Node IRI
n Maybe IRI
forall a. Maybe a
Nothing Range
range
        Just ot :: IRI
ot -> IRI -> Maybe IRI -> Range -> Node
Node IRI
ot (IRI -> Maybe IRI
forall a. a -> Maybe a
Just IRI
n) Range
range


basicItem :: GA.PrefixMap -> AParser st BASIC_ITEM
basicItem :: PrefixMap -> AParser st BASIC_ITEM
basicItem pm :: PrefixMap
pm = [Node] -> BASIC_ITEM
Path ([Node] -> BASIC_ITEM)
-> (([Node], [Token]) -> [Node]) -> ([Node], [Token]) -> BASIC_ITEM
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Node], [Token]) -> [Node]
forall a b. (a, b) -> a
fst (([Node], [Token]) -> BASIC_ITEM)
-> ParsecT [Char] (AnnoState st) Identity ([Node], [Token])
-> AParser st BASIC_ITEM
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char (AnnoState st) Node
-> GenParser Char (AnnoState st) Token
-> ParsecT [Char] (AnnoState st) Identity ([Node], [Token])
forall tok st a b.
GenParser tok st a
-> GenParser tok st b -> GenParser tok st ([a], [b])
separatedBy (PrefixMap -> GenParser Char (AnnoState st) Node
forall st. PrefixMap -> AParser st Node
node PrefixMap
pm) ([Char] -> GenParser Char (AnnoState st) Token
forall st. [Char] -> AParser st Token
asKey "->") AParser st BASIC_ITEM
-> GenParser Char (AnnoState st) Token -> AParser st BASIC_ITEM
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< GenParser Char (AnnoState st) Token
forall st. AParser st Token
anSemi

basicSpec :: GA.PrefixMap -> AParser st BASIC_SPEC
basicSpec :: PrefixMap -> AParser st BASIC_SPEC
basicSpec pm :: PrefixMap
pm = [Annoted BASIC_ITEM] -> BASIC_SPEC
Basic_spec ([Annoted BASIC_ITEM] -> BASIC_SPEC)
-> ParsecT [Char] (AnnoState st) Identity [Annoted BASIC_ITEM]
-> AParser st BASIC_SPEC
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser st BASIC_ITEM
-> ParsecT [Char] (AnnoState st) Identity [Annoted BASIC_ITEM]
forall st a. AParser st a -> AParser st [Annoted a]
annosParser (PrefixMap -> AParser st BASIC_ITEM
forall st. PrefixMap -> AParser st BASIC_ITEM
basicItem PrefixMap
pm)



-- -- Function for easier testing
-- test :: AParser () a -> String -> a
-- test p s = case runParser p (emptyAnnos ()) "NeSyPatterns.Parse.test" s of
--     Left e -> error $ "***Error:"  ++ show e
--     Right a -> a