elm-repl-0.2.1: src/Parse.hs

module Parse where

import Data.Functor ((<$), (<$>))
import Text.Parsec

import qualified Data.Char as Char
import qualified Data.List as List

import Action

type Parser = Parsec String ()

input :: String -> Action
input inp = case parse result "" inp of
  Left err  -> Command . Help . Just . show $ err
  Right act -> act

result :: Parser Action
result = do
  spaces
  skip <|> cmd <|> term
  where
    skip = Skip <$ eof
    cmd  = char ':' >> Command <$> command
    term = Code . mkTerm <$> many anyChar

command :: Parser Command
command = do
  flag <- many1 notSpace
  spaces
  case flag of
    "exit"  -> basicCommand Exit
    "reset" -> basicCommand Reset
    "help"  -> basicCommand $ Help Nothing
    "flags" -> basicCommand (InfoFlags Nothing) <|> flags
    _       -> return $ Help . Just $ flag
  where basicCommand cmd = cmd <$ eof

flags :: Parser Command
flags = do
  flag <- many1 notSpace
  case flag of
    "add"    -> srcDirFlag AddFlag
    "remove" -> srcDirFlag RemoveFlag
    "list"   -> return ListFlags
    "clear"  -> return ClearFlags
    _        -> return $ InfoFlags . Just $ flag
  where srcDirFlag ctor = do
          many1 space
          ctor <$> srcDir

notSpace :: Parser Char
notSpace = satisfy $ not . Char.isSpace

srcDir :: Parser String
srcDir = do
  string "--src-dir="
  dir <- manyTill anyChar (choice [ space >> return (), eof ])
  return $ "--src-dir=" ++ dir

mkTerm :: String -> Term
mkTerm src = (src, mkCode src)

mkCode :: String -> Maybe Def
mkCode src
  | List.isPrefixOf "import " src = 
    let name = getFirstCap . words $ src
        getFirstCap (tok@(c:_):rest) = if Char.isUpper c
                                       then tok
                                       else getFirstCap rest
        getFirstCap _ = src
    in Just $ Import name

  | List.isPrefixOf "data " src =
      let name = takeWhile (/=' ') . drop 5 $ src
      in  Just $ DataDef name

  | otherwise = case break (=='=') src of
        (_,"") -> Nothing
        (beforeEquals, _:c:_)
          | Char.isSymbol c || hasLet beforeEquals || hasBrace beforeEquals ->
            Nothing
          | otherwise -> Just . VarDef $ declName beforeEquals
        _ -> error "Parse.hs: Case error. Please submit bug report to https://github.com/elm-lang/elm-repl/issues."
        where
          declName pattern =
              case takeWhile Char.isSymbol . dropWhile (not . Char.isSymbol) $ pattern of
                "" -> takeWhile (/=' ') pattern
                op -> op

          hasLet = elem "let" . map token . words
            where
              isVarChar c = Char.isAlpha c || Char.isDigit c || elem c "_'"
              token = takeWhile isVarChar . dropWhile (not . Char.isAlpha)

          hasBrace = elem '{'