-----------------------------------------------------------------------------
--
-- Module      : Language.PureScript.Ide.Command
-- Description : Datatypes for the commands psc-ide accepts
-- Copyright   : Christoph Hegemann 2016
-- License     : MIT (http://opensource.org/licenses/MIT)
--
-- Maintainer  : Christoph Hegemann <christoph.hegemann1337@gmail.com>
-- Stability   : experimental
--
-- |
-- Datatypes for the commands psc-ide accepts
-----------------------------------------------------------------------------

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] -- used in tests
    | 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 InputFile OutputFile
    | 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