module Parser where

import Control.Applicative (liftA2)
import Data.Char
import Data.Void
import Text.Megaparsec
import Text.Megaparsec.Char

data AST
  = Call String [AST]
  | Seq [AST]
  | List [AST] (Maybe AST)
  | Literal String
  deriving (Show)

specialOp = (`elem` ",;|")

specialChar = (`elem` "()[]")

specialName = (`elem` "_")

specialUnused = (`elem` "\'%")

type Lexer = Parsec Void String

data Lexeme
  = Blank String
  | Tok String
  | QTok String String -- unquoted quoted
  | Cmt String
  deriving (Show)

blank :: Lexer Lexeme
blank = Blank <$> some (satisfy isSpace)

tok :: Lexer Lexeme
tok =
  Tok <$>
  choice
    [ pure <$> satisfy specialOp
    , pure <$> satisfy specialChar
    , some $
      satisfy $ \x ->
        all
          ($ x)
          [ not . specialOp
          , not . specialChar
          , not . specialUnused
          , not . specialName
          , liftA2 (||) isSymbol isPunctuation
          ]
    , (:) <$> satisfy (\x -> any ($ x) [specialName, isAlpha]) <*>
      many (satisfy $ \x -> any ($ x) [specialName, isAlphaNum, isMark])
    ]

qtok :: Lexer Lexeme
qtok = do
  x <- string "'"
  y <- many $ satisfy (/= '\'')
  z <- string "'"
  return $ QTok y (x ++ y ++ z)

cmt :: Lexer Lexeme
cmt =
  Cmt . concat <$>
  sequence
    [string "%", many $ satisfy (/= '\n'), choice [string "\n", "" <$ eof]]

lexeme :: Lexer Lexeme
lexeme = choice [blank, tok, qtok, cmt]

lex :: Lexer [Lexeme]
lex = many lexeme <* eof