module Morley.Parser.Annotations
( note
, noteT
, noteV
, noteF
, noteF2
, noteTDef
, noteVDef
, _noteFDef
, notesTVF
, notesTVF2
, notesTV
, notesVF
, fieldType
, permute2Def
, permute3Def
) where
import Prelude hiding (many, note, some, try)
import Control.Applicative.Permutations
(runPermutation, toPermutationWithDefault)
import Data.Char (isAlpha, isAlphaNum, isAscii)
import qualified Data.Text as T
import Text.Megaparsec (satisfy, takeWhileP, try)
import Text.Megaparsec.Char (string)
import Morley.Default
import Morley.Lexer
import Morley.Types (Parser)
import qualified Morley.Types as Mo
note :: T.Text -> Parser T.Text
note c = lexeme $ string c >> (note' <|> emptyNote)
where
emptyNote = pure ""
note' = do
a <- string "@"
<|> string "%%"
<|> string "%"
<|> T.singleton <$> satisfy (\ x -> isAlpha x && isAscii x)
let validChar x =
isAscii x && (isAlphaNum x || x == '\\' || x == '.' || x == '_')
b <- takeWhileP Nothing validChar
return $ T.append a b
noteT :: Parser Mo.TypeAnn
noteT = Mo.ann <$> note ":"
noteV :: Parser Mo.VarAnn
noteV = Mo.ann <$> note "@"
noteF :: Parser Mo.FieldAnn
noteF = Mo.ann <$> note "%"
noteF2 :: Parser (Mo.FieldAnn, Mo.FieldAnn)
noteF2 = do a <- noteF; b <- noteF; return (a, b)
parseDef :: Default a => Parser a -> Parser a
parseDef a = try a <|> pure def
noteTDef :: Parser Mo.TypeAnn
noteTDef = parseDef noteT
noteVDef :: Parser Mo.VarAnn
noteVDef = parseDef noteV
_noteFDef :: Parser Mo.FieldAnn
_noteFDef = parseDef noteF
notesTVF :: Parser (Mo.TypeAnn, Mo.VarAnn, Mo.FieldAnn)
notesTVF = permute3Def noteT noteV noteF
notesTVF2 :: Parser (Mo.TypeAnn, Mo.VarAnn, (Mo.FieldAnn, Mo.FieldAnn))
notesTVF2 = permute3Def noteT noteV noteF2
notesTV :: Parser (Mo.TypeAnn, Mo.VarAnn)
notesTV = permute2Def noteT noteV
notesVF :: Parser (Mo.VarAnn, Mo.FieldAnn)
notesVF = permute2Def noteV noteF
fieldType :: Default a
=> Parser a
-> Parser (a, Mo.TypeAnn)
fieldType fp = runPermutation $
(,) <$> toPermutationWithDefault def fp
<*> toPermutationWithDefault Mo.noAnn noteT