{- |
Module      :  ./Maude/Parse.hs
Description :  extract Maude text in structured specs
Copyright   :  (c) C. Maeder, DFKI GmbH 2009
License     :  GPLv2 or higher, see LICENSE.txt

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

extract Maude text from structured specs and stops at an unbalanced curly brace
-}

module Maude.Parse where

import Text.ParserCombinators.Parsec
import Common.Parsec

mStuff :: CharParser st String
mStuff :: CharParser st String
mStuff = ParsecT String st Identity [String] -> CharParser st String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity [String] -> CharParser st String)
-> (CharParser st String -> ParsecT String st Identity [String])
-> CharParser st String
-> CharParser st String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharParser st String -> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (CharParser st String -> CharParser st String)
-> CharParser st String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ CharParser st String
forall st. CharParser st String
lineComment 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
<|> CharParser st String
forall st. CharParser st String
blockComment 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
<|> CharParser st String
forall st. CharParser st String
stringLit
        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 st. String -> CharParser st String
balanced "{}"
        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 st. String -> CharParser st String
balanced "()"
        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 st. String -> CharParser st String
balanced "[]"
        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
<|> (Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '`' ParsecT String st Identity Char
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity Char -> CharParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a]
single ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
        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
<|> (Char -> String)
-> ParsecT String st Identity Char -> CharParser st String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> String -> String
forall a. a -> [a] -> [a]
: []) (String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf "\"`])}")

balanced :: String -> CharParser st String
balanced :: String -> CharParser st String
balanced [o :: Char
o, c :: Char
c] = Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
o ParsecT String st Identity Char
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> CharParser st String
forall st. CharParser st String
mStuff CharParser st String
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string [Char
c]
balanced _ = String -> CharParser st String
forall a. HasCallStack => String -> a
error "balanced"

blockComment :: CharParser st String
blockComment :: CharParser st String
blockComment = String -> CharParser st String
forall st. String -> CharParser st String
tryString "***(" CharParser st String
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> CharParser st String
forall st. CharParser st String
parbalanced CharParser st String
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ")"

parbalanced :: CharParser st String
parbalanced :: CharParser st String
parbalanced = ParsecT String st Identity [String] -> CharParser st String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity [String] -> CharParser st String)
-> (CharParser st String -> ParsecT String st Identity [String])
-> CharParser st String
-> CharParser st String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharParser st String -> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (CharParser st String -> CharParser st String)
-> CharParser st String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '(' ParsecT String st Identity Char
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> CharParser st String
forall st. CharParser st String
parbalanced CharParser st String
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ")"
  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
<|> ParsecT String st Identity Char -> CharParser st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf "()")

lineComment :: CharParser st String
lineComment :: CharParser st String
lineComment = (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 st. String -> CharParser st String
tryString "***")
              CharParser st String
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> ParsecT String st Identity Char -> CharParser st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf "\n")