-- |

module Parser

( parseCommand

) where

import Prelude hiding (lex)

import Data.Char (isSpace)

import Data.List (intercalate)

import Control.Applicative hiding (many)

import Text.Parsec hiding ((<|>))

import qualified Language.PureScript as P

import Language.PureScript.Parser.Common (mark, same)

import qualified Directive as D

import Types

-- |

parseCommand :: String -> Either String Command

parseCommand cmdString =

case cmdString of

(':' : cmd) -> parseDirective cmd

_ -> parseRest psciCommand cmdString

parseRest :: P.TokenParser a -> String -> Either String a

parseRest p s = either (Left . show) Right $ do

ts <- P.lex "" s

P.runTokenParser "" (p <* eof) ts

psciCommand :: P.TokenParser Command

psciCommand = choice (map try parsers)

where

parsers =

[ psciLet

, psciImport

, psciOtherDeclaration

, psciExpression

]

trim :: String -> String

trim = trimEnd . trimStart

trimStart :: String -> String

trimStart = dropWhile isSpace

trimEnd :: String -> String

trimEnd = reverse . trimStart . reverse

parseDirective :: String -> Either String Command

parseDirective cmd =

case D.directivesFor' dstr of

[(d, _)] -> commandFor d

[] -> Left "Unrecognized directive. Type :? for help."

ds -> Left ("Ambiguous directive. Possible matches: " ++

intercalate ", " (map snd ds) ++ ". Type :? for help.")

where

(dstr, arg) = break isSpace cmd

commandFor d = case d of

Help -> return ShowHelp

Quit -> return QuitPSCi

Reset -> return ResetState

Browse -> BrowseModule <$> parseRest P.moduleName arg

Load -> return $ LoadFile (trim arg)

Show -> ShowInfo <$> parseReplQuery' (trim arg)

Type -> TypeOf <$> parseRest P.parseValue arg

Kind -> KindOf <$> parseRest P.parseType arg

-- |

psciExpression :: P.TokenParser Command

psciExpression = Expression <$> P.parseValue

-- |

psciLet :: P.TokenParser Command

psciLet = Decls <$> (P.reserved "let" *> P.indented *> manyDecls)

where

manyDecls :: P.TokenParser [P.Declaration]

manyDecls = mark (many1 (same *> P.parseLocalDeclaration))

-- | Imports must be handled separately from other declarations, so that

psciImport :: P.TokenParser Command

psciImport = Import <$> P.parseImportDeclaration'

-- | Any other declaration that we don't need a 'special case' parser for

psciOtherDeclaration :: P.TokenParser Command

psciOtherDeclaration = Decls . (:[]) <$> do

decl <- discardPositionInfo <$> P.parseDeclaration

if acceptable decl

then return decl

else fail "this kind of declaration is not supported in psci"

discardPositionInfo :: P.Declaration -> P.Declaration

discardPositionInfo (P.PositionedDeclaration _ _ d) = d

discardPositionInfo d = d

acceptable :: P.Declaration -> Bool

acceptable P.DataDeclaration{} = True

acceptable P.TypeSynonymDeclaration{} = True

acceptable P.ExternDeclaration{} = True

acceptable P.ExternDataDeclaration{} = True

acceptable P.ExternInstanceDeclaration{} = True

acceptable P.TypeClassDeclaration{} = True

acceptable P.TypeInstanceDeclaration{} = True

acceptable _ = False

parseReplQuery' :: String -> Either String ReplQuery

parseReplQuery' str =

case parseReplQuery str of

Nothing -> Left ("Don't know how to show " ++ str ++ ". Try one of: " ++

intercalate ", " replQueryStrings ++ ".")

Just query -> Right query