module Language.PureScript.Ide.Command where
import Protolude
import Control.Monad.Fail (fail)
import Data.Aeson
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Language.PureScript as P
import Language.PureScript.Ide.CaseSplit
import Language.PureScript.Ide.Completion
import Language.PureScript.Ide.Filter
import Language.PureScript.Ide.Matcher
import Language.PureScript.Ide.Types
data Command
= Load [P.ModuleName]
| LoadSync [P.ModuleName]
| Type
{ Command -> Text
typeSearch :: Text
, Command -> [Filter]
typeFilters :: [Filter]
, Command -> Maybe ModuleName
typeCurrentModule :: Maybe P.ModuleName
}
| Complete
{ Command -> [Filter]
completeFilters :: [Filter]
, Command -> Matcher IdeDeclarationAnn
completeMatcher :: Matcher IdeDeclarationAnn
, Command -> Maybe ModuleName
completeCurrentModule :: Maybe P.ModuleName
, Command -> CompletionOptions
completeOptions :: CompletionOptions
}
| CaseSplit
{ Command -> Text
caseSplitLine :: Text
, Command -> Int
caseSplitBegin :: Int
, Command -> Int
caseSplitEnd :: Int
, Command -> WildcardAnnotations
caseSplitAnnotations :: WildcardAnnotations
, Command -> Text
caseSplitType :: Text
}
| AddClause
{ Command -> Text
addClauseLine :: Text
, Command -> WildcardAnnotations
addClauseAnnotations :: WildcardAnnotations
}
| FindUsages
{ Command -> ModuleName
usagesModule :: P.ModuleName
, Command -> Text
usagesIdentifier :: Text
, Command -> IdeNamespace
usagesNamespace :: IdeNamespace
}
| Import FilePath (Maybe FilePath) [Filter] ImportCommand
| List { Command -> ListType
listType :: ListType }
| Rebuild FilePath (Maybe FilePath) (Set P.CodegenTarget)
| RebuildSync FilePath (Maybe FilePath) (Set P.CodegenTarget)
| Cwd
| Reset
| Quit
commandName :: Command -> Text
commandName :: Command -> Text
commandName Command
c = case Command
c of
Load{} -> Text
"Load"
LoadSync{} -> Text
"LoadSync"
Type{} -> Text
"Type"
Complete{} -> Text
"Complete"
CaseSplit{} -> Text
"CaseSplit"
AddClause{} -> Text
"AddClause"
FindUsages{} -> Text
"FindUsages"
Import{} -> Text
"Import"
List{} -> Text
"List"
Rebuild{} -> Text
"Rebuild"
RebuildSync{} -> Text
"RebuildSync"
Cwd{} -> Text
"Cwd"
Reset{} -> Text
"Reset"
Quit{} -> Text
"Quit"
data ImportCommand
= AddImplicitImport P.ModuleName
| AddQualifiedImport P.ModuleName P.ModuleName
| AddImportForIdentifier Text (Maybe P.ModuleName)
deriving (Int -> ImportCommand -> ShowS
[ImportCommand] -> ShowS
ImportCommand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportCommand] -> ShowS
$cshowList :: [ImportCommand] -> ShowS
show :: ImportCommand -> String
$cshow :: ImportCommand -> String
showsPrec :: Int -> ImportCommand -> ShowS
$cshowsPrec :: Int -> ImportCommand -> ShowS
Show, ImportCommand -> ImportCommand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportCommand -> ImportCommand -> Bool
$c/= :: ImportCommand -> ImportCommand -> Bool
== :: ImportCommand -> ImportCommand -> Bool
$c== :: ImportCommand -> ImportCommand -> Bool
Eq)
instance FromJSON ImportCommand where
parseJSON :: Value -> Parser ImportCommand
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ImportCommand" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
(Text
command :: Text) <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"importCommand"
case Text
command of
Text
"addImplicitImport" ->
ModuleName -> ImportCommand
AddImplicitImport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ModuleName
P.moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"module")
Text
"addQualifiedImport" ->
ModuleName -> ModuleName -> ImportCommand
AddQualifiedImport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ModuleName
P.moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"module")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> ModuleName
P.moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qualifier")
Text
"addImport" ->
Text -> Maybe ModuleName -> ImportCommand
AddImportForIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identifier")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ModuleName
P.moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"qualifier")
Text
s -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown import command: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show Text
s)
data ListType = LoadedModules | Imports FilePath | AvailableModules
instance FromJSON ListType where
parseJSON :: Value -> Parser ListType
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ListType" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
(Text
listType' :: Text) <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
case Text
listType' of
Text
"import" -> String -> ListType
Imports forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"file"
Text
"loadedModules" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ListType
LoadedModules
Text
"availableModules" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ListType
AvailableModules
Text
s -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown list type: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show Text
s)
instance FromJSON Command where
parseJSON :: Value -> Parser Command
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"command" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
(Text
command :: Text) <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"command"
case Text
command of
Text
"list" -> ListType -> Command
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params" forall a. Parser (Maybe a) -> a -> Parser a
.!= ListType
LoadedModules
Text
"cwd" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Cwd
Text
"quit" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Quit
Text
"reset" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Reset
Text
"load" -> do
Maybe Object
params' <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
case Maybe Object
params' of
Maybe Object
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleName] -> Command
Load [])
Just Object
params ->
[ModuleName] -> Command
Load forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> ModuleName
P.moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"modules" forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
Text
"type" -> do
Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
Text -> [Filter] -> Maybe ModuleName -> Command
Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"search"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filters" forall a. Parser (Maybe a) -> a -> Parser a
.!= []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ModuleName
P.moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"currentModule")
Text
"complete" -> do
Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
[Filter]
-> Matcher IdeDeclarationAnn
-> Maybe ModuleName
-> CompletionOptions
-> Command
Complete
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filters" forall a. Parser (Maybe a) -> a -> Parser a
.!= []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"matcher" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ModuleName
P.moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"currentModule")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options" forall a. Parser (Maybe a) -> a -> Parser a
.!= CompletionOptions
defaultCompletionOptions
Text
"caseSplit" -> do
Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
Text -> Int -> Int -> WildcardAnnotations -> Text -> Command
CaseSplit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"line"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"begin"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"end"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> WildcardAnnotations
mkAnnotations forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotations")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
Text
"addClause" -> do
Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
Text -> WildcardAnnotations -> Command
AddClause
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"line"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> WildcardAnnotations
mkAnnotations forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotations")
Text
"usages" -> do
Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
ModuleName -> Text -> IdeNamespace -> Command
FindUsages
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> ModuleName
P.moduleNameFromString (Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"module")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identifier"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"namespace"
Text
"import" -> do
Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
String -> Maybe String -> [Filter] -> ImportCommand -> Command
Import
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"file"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"outfile"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filters" forall a. Parser (Maybe a) -> a -> Parser a
.!= []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"importCommand"
Text
"rebuild" -> do
Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
String -> Maybe String -> Set CodegenTarget -> Command
Rebuild
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"file"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"actualFile"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall {m :: * -> *}.
MonadFail m =>
[String] -> m (Set CodegenTarget)
parseCodegenTargets forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"codegen" forall a. Parser (Maybe a) -> a -> Parser a
.!= [ String
"js" ])
Text
c -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown command: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show Text
c)
where
parseCodegenTargets :: [String] -> m (Set CodegenTarget)
parseCodegenTargets [String]
ts =
case forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\String
t -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
t Map String CodegenTarget
P.codegenTargets) [String]
ts of
Maybe [CodegenTarget]
Nothing ->
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Failed to parse codegen targets: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show [String]
ts)
Just [CodegenTarget]
ts' ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Ord a => [a] -> Set a
Set.fromList [CodegenTarget]
ts')
mkAnnotations :: Bool -> WildcardAnnotations
mkAnnotations Bool
True = WildcardAnnotations
explicitAnnotations
mkAnnotations Bool
False = WildcardAnnotations
noAnnotations