AnnoState.hs revision 61e38a4f194d3adc66646326c938eb9263a2f39b
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina SojakovaModule : $Header$
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina SojakovaDescription : parsing of interspersed annotations
097b7fb3f8f90e87120d30bf37a1d89fe0ddfaf0Kristina SojakovaCopyright : (c) Christian Maeder and Uni Bremen 2002-2006
94e2e03f6efde106de095ef4ea0ec87f74955a31Kristina SojakovaLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
211c5fb252e0a776baad9a4857ab198659289a4aKristina SojakovaMaintainer : Christian.Maeder@dfki.de
94e2e03f6efde106de095ef4ea0ec87f74955a31Kristina SojakovaStability : provisional
211c5fb252e0a776baad9a4857ab198659289a4aKristina SojakovaPortability : portable
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina SojakovaParsing of interspersed annotations
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova- a parser state to collect annotations
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova- parsing annoted keywords
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova- parsing an annoted item list
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova-- | parsers that can collect annotations via side effects
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakovatype AParser st a = GenParser Char (AnnoState st) a
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakovaclass AParsable a where
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova aparser :: AParser st a
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova-- used for CASL extensions. If there is no extension, just fail
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakovainstance AParsable () where
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova aparser = pzero
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova-- | just the list of currently collected annotations
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakovadata AnnoState st = AnnoState { toAnnos :: [Annotation]
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova , userState :: st }
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova-- | no annotations
14650c9e129d8dc51ed55b2edc6ec27d9f0f6d00Kristina SojakovaemptyAnnos :: st -> AnnoState st
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina SojakovaemptyAnnos st = AnnoState [] st
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova-- | add further annotations to the input state
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina SojakovaparseAnnos :: AnnoState a -> GenParser Char st (AnnoState a)
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina SojakovaparseAnnos (AnnoState as b) =
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova do a <- skip >> annotations
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova return $ AnnoState (as ++ a) b
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova-- | add only annotations on consecutive lines to the input state
14650c9e129d8dc51ed55b2edc6ec27d9f0f6d00Kristina SojakovaparseLineAnnos :: AnnoState a -> GenParser Char st (AnnoState a)
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina SojakovaparseLineAnnos (AnnoState as b) =
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakova do l <- mLineAnnos
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakova return $ AnnoState (as ++ l) b
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakova-- | add annotations to the internal state
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina SojakovaaddAnnos :: AParser st ()
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina SojakovaaddAnnos = getState >>= parseAnnos >>= setState
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova-- | add only annotations on consecutive lines to the internal state
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina SojakovaaddLineAnnos :: AParser st ()
81d28e8372831ae5e6054d8d2212f0114b09b79aKristina SojakovaaddLineAnnos = getState >>= parseLineAnnos >>= setState
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina SojakovagetUserState :: AParser st st
81d28e8372831ae5e6054d8d2212f0114b09b79aKristina SojakovagetUserState = fmap userState getState
fc08da86ea2ef76a631faca30ca30b8ed112d864Christian MaedersetUserState :: st -> AParser st ()
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina SojakovasetUserState st = getState >>= \ s -> setState s { userState = st }
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakova-- | extract all annotation from the internal state,
81d28e8372831ae5e6054d8d2212f0114b09b79aKristina Sojakova-- resets the internal state to 'emptyAnnos'
81d28e8372831ae5e6054d8d2212f0114b09b79aKristina SojakovagetAnnos :: AParser st [Annotation]
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina SojakovagetAnnos = do aSt <- getState
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova setState aSt { toAnnos = [] }
f2f62e61c66f678b0042d1a772ff89849d8b2113Kristina Sojakova return $ toAnnos aSt
14650c9e129d8dc51ed55b2edc6ec27d9f0f6d00Kristina Sojakova-- | annotations on consecutive lines
14650c9e129d8dc51ed55b2edc6ec27d9f0f6d00Kristina SojakovamLineAnnos :: GenParser Char st [Annotation]
f2f62e61c66f678b0042d1a772ff89849d8b2113Kristina Sojakova do a <- annotationL
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova do l <- mLineAnnos
887a1999374d1fb3a534e602a8d322de6ef4c8e8Kristina Sojakova <|> return [a]
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova-- | explicitly parse annotations, reset internal state
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakovaannos :: AParser st [Annotation]
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakovaannos = addAnnos >> getAnnos
fc08da86ea2ef76a631faca30ca30b8ed112d864Christian Maeder-- | explicitly parse annotations on consecutive lines. reset internal state
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovalineAnnos :: AParser st [Annotation]
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovalineAnnos = addLineAnnos >> getAnnos
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova-- | optional semicolon followed by annotations on consecutive lines
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaoptSemi :: AParser st ([Token], [Annotation])
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaoptSemi = do (a1, s) <- try $ bind (,) annos semiT
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova a2 <- lineAnnos
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova return ([s], a1 ++ a2)
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova <|> do a <- lineAnnos
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova return ([], a)
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova-- | succeeds if the previous item is finished
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovatryItemEnd :: [String] -> AParser st ()
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovatryItemEnd l = try $ do
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova c <- lookAhead $ annos >>
12d9bff7c82145a8b68bfb8553688172655c926eKristina Sojakova (single (oneOf "\"([{") <|> placeS <|> scanAnySigns
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova <|> many (scanLPD <|> char '_' <?> "") <?> "")
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova if null c || c `elem` l then return () else pzero
12d9bff7c82145a8b68bfb8553688172655c926eKristina Sojakova-- | keywords that indicate a new item for 'tryItemEnd'.
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova-- the quantifier exists does not start a new item.
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovastartKeyword :: [String]
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovastartKeyword = dotS:cDot:
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova (delete existsS casl_reserved_words)
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova-- | parse preceding annotations and the following item
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaannoParser :: AParser st a
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova -> AParser st (Annoted a)
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaannoParser parser = bind addLeftAnno annos parser
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova-- | parse an item list preceded and followed by annotations
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaannosParser :: AParser st a
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova -> AParser st [Annoted a]
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaannosParser parser =
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova l <- many1 $ bind (,) parser annos
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova let ps = map fst l
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova as = map snd l
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova is = zipWith addLeftAnno (a: init as) ps
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova return (init is ++ [appendAnno (last is) (last as)])
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova-- | parse an item list preceded by a singular or plural keyword,
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova-- interspersed with semicolons and an optional semicolon at the end
12d9bff7c82145a8b68bfb8553688172655c926eKristina SojakovaitemList :: [String] -> String -> ([String] -> AParser st b)
12d9bff7c82145a8b68bfb8553688172655c926eKristina Sojakova -> ([Annoted b] -> Range -> a) -> AParser st a
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaitemList ks kw ip constr =
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova do p <- pluralKeyword kw
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova auxItemList (ks++startKeyword) [p] (ip ks) constr
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova-- | generalized version of 'itemList'
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova-- for an other keyword list for 'tryItemEnd' and without 'pluralKeyword'
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina SojakovaauxItemList :: [String] -> [Token] -> AParser st b
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova -> ([Annoted b] -> Range -> a) -> AParser st a
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina SojakovaauxItemList startKeywords ps parser constr = do
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova (vs, ts, ans) <- itemAux startKeywords (annoParser parser)
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova let r = zipWith appendAnno vs ans in
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova return (constr r (catRange (ps++ts)))
fc08da86ea2ef76a631faca30ca30b8ed112d864Christian Maeder-- | parse an item list without a starting keyword
fc08da86ea2ef76a631faca30ca30b8ed112d864Christian MaederitemAux :: [String] -> AParser st a
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova -> AParser st ([a], [Token], [[Annotation]])
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaitemAux startKeywords itemParser =
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova do a <- itemParser
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova (m, an) <- optSemi
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova let r = return ([a], [], [an])
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova if null m then r else (tryItemEnd startKeywords >> r) <|>
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova do (ergs, ts, ans) <- itemAux startKeywords itemParser
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova return (a:ergs, m++ts, an:ans)
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova-- | collect preceding and trailing annotations
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina SojakovawrapAnnos :: AParser st a -> AParser st a
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina SojakovawrapAnnos p = try (addAnnos >> p) << addAnnos
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova-- | parse an annoted keyword
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina SojakovaasKey :: String -> AParser st Token
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina SojakovaasKey s = wrapAnnos $ pToken $ toKey s
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova-- * annoted keywords
fc08da86ea2ef76a631faca30ca30b8ed112d864Christian MaederanComma, anSemi :: AParser st Token
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaanComma = wrapAnnos Common.Lexer.commaT
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaanSemi = wrapAnnos Common.Lexer.semiT
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaequalT, colonT, lessT, dotT :: AParser st Token
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina SojakovaequalT = wrapAnnos $ pToken $
b470a3e54a4289b4189906e41f0c04578c85619dKristina Sojakova (((lookAhead $ keySign $ string exEqual)
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova >> unexpected exEqual)
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova <|> keySign (string equalS))
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina SojakovacolonT = asKey colonS
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina SojakovalessT = asKey lessS
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina SojakovadotT = asKey dotS <|> asKey cDot <?> "dot"
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina SojakovaasT, barT, forallT :: AParser st Token
887a1999374d1fb3a534e602a8d322de6ef4c8e8Kristina SojakovaasT = asKey asS
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina SojakovabarT = asKey barS
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina SojakovaforallT = asKey forallS