{-# LANGUAGE OverloadedStrings #-}
module Language.Bond.Codegen.CustomMapping
( AliasMapping(..)
, Fragment(..)
, NamespaceMapping(..)
, parseAliasMapping
, parseNamespaceMapping
) where
import Control.Applicative hiding (some)
import Data.Void (Void)
import Language.Bond.Syntax.Types
import Prelude
import Text.Megaparsec hiding (many, optional, (<|>))
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
data Fragment =
Fragment String |
Placeholder Int
data AliasMapping = AliasMapping
{ aliasName :: QualifiedName
, aliasTemplate :: [Fragment]
}
data NamespaceMapping = NamespaceMapping
{ fromNamespace :: QualifiedName
, toNamespace :: QualifiedName
}
type Parser = Parsec Void String
identifier :: Parser String
identifier = some (alphaNumChar <|> char '_') <?> "identifier"
qualifiedName :: Parser [String]
qualifiedName = sepBy1 identifier (char '.') <?> "qualified name"
sc :: Parser ()
sc = L.space space1 empty empty
symbol :: String -> Parser String
symbol = L.symbol sc
equal :: Parser String
equal = symbol "="
lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc
decimal :: Parser Integer
decimal = lexeme L.decimal
hexadecimal :: Parser Integer
hexadecimal = lexeme . try $ char '0' >> char' 'x' >> L.hexadecimal
octal :: Parser Integer
octal = lexeme . try $ char '0' >> char' 'o' >> L.octal
natural :: Parser Integer
natural = hexadecimal <|> octal <|> decimal
integer :: Parser Integer
integer = L.signed sc natural
parseAliasMapping :: String -> Either (ParseError Char Void) AliasMapping
parseAliasMapping s = parse aliasMapping "" s
where
aliasMapping = AliasMapping <$> qualifiedName <* equal <*> some (placeholder <|> fragment) <* eof
placeholder = Placeholder <$> fromIntegral <$> between (char '{') (char '}') integer
fragment = Fragment <$> some (notChar '{')
parseNamespaceMapping :: String -> Either (ParseError Char Void) NamespaceMapping
parseNamespaceMapping s = parse namespaceMapping "" s
where
namespaceMapping = NamespaceMapping <$> qualifiedName <* equal <*> qualifiedName