Add suggestion, proper position types

Add suggestion, proper position types

module PscIde.Command where

import Prelude
import Control.Alt ((<|>))
import Data.Argonaut (JObject, getField)
import Data.Argonaut.Core (jsonEmptyObject, jsonSingletonObject, jsonNull, Json, toString)
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.?))
import Data.Argonaut.Encode (class EncodeJson, encodeJson, (~>), (:=))
import Data.Argonaut.Parser (jsonParser)
import Data.Array (singleton)
import Data.Either (either, Either(..))
import Data.Maybe (Maybe(..), maybe)
import Data.String (joinWith)

data PursuitType = Package | Ident

instance showPursuitType :: Show PursuitType where
  show Package = "package"
  show Ident   = "completion"

instance encodePursuitType :: EncodeJson PursuitType where
  encodeJson = encodeJson <<< show

data Matcher =
  Flex String
  | Distance String Int

instance encodeMatcher :: EncodeJson Matcher where
  encodeJson (Flex q) =
    "matcher" := "flex"
    ~> "params" := (jsonSingletonObject' "search" q)
    ~> jsonEmptyObject
  encodeJson (Distance q maxDist) =
    "matcher" := "distance"
    ~> "params" := (
       "search" := q
       ~> "maximumDistance" := maxDist
       ~> jsonEmptyObject
      )
    ~> jsonEmptyObject

data Filter =
  ExactFilter String
  | PrefixFilter String
  | ModuleFilter (Array String)
  | DependencyFilter (Array String)

filterWrapper :: forall a. (EncodeJson a) => String -> a -> Json
filterWrapper f q =
  "filter" := f
  ~> ("params" := q)
  ~> jsonEmptyObject

jsonSingletonObject' :: forall a. (EncodeJson a) => String -> a -> Json
jsonSingletonObject' s o = jsonSingletonObject s (encodeJson o)

instance encodeFilter :: EncodeJson Filter where
  encodeJson (ExactFilter q) =
    filterWrapper "exact" (jsonSingletonObject' "search" q)
  encodeJson (PrefixFilter q) =
    filterWrapper "prefix" (jsonSingletonObject' "search" q)
  encodeJson (ModuleFilter modules) =
    filterWrapper "modules" (jsonSingletonObject' "modules" modules)
  encodeJson (DependencyFilter deps) =
    filterWrapper "dependencies" (jsonSingletonObject' "modules" deps)

newtype CompletionOptions = CompletionOptions {
  maxResults :: Maybe Int,
  groupReexports :: Boolean
}

instance encodeCompletionOptions :: EncodeJson CompletionOptions where
  encodeJson (CompletionOptions { maxResults, groupReexports }) =
   "maxResults" := encodeMaybeNull maxResults
    ~> "groupReexports" := encodeJson groupReexports
    ~> jsonEmptyObject

data Command =
  Cwd
  | Ls ListType
  | Quit
  | Reset
  | Load (Array String) (Array String)
  | Complete (Array Filter) (Maybe Matcher) (Maybe String) CompletionOptions
  | Pursuit PursuitType String
  | Type String (Array Filter) (Maybe String)
  | AddClause String Boolean
  | CaseSplit String Int Int Boolean String
  | ImportCmd FileName (Maybe FileName) (Array Filter) ImportCommand
  | RebuildCmd String (Maybe FileName)

data ListType = LoadedModules | Imports String | AvailableModules

type FileName = String
data ImportCommand = AddImplicitImport String | AddQualifiedImport String String | AddImport String (Maybe String)

commandWrapper :: forall a. (EncodeJson a) => String -> a -> Json
commandWrapper s o =
  "command" := s
  ~> ("params" := o)
  ~> jsonEmptyObject

instance encodeCommand :: EncodeJson Command where
  encodeJson Cwd = jsonSingletonObject' "command" "cwd"
  encodeJson (Ls LoadedModules) =
    commandWrapper "list" ("type" := "loadedModules" ~> jsonEmptyObject)
  encodeJson (Ls AvailableModules) =
    commandWrapper "list" ("type" := "availableModules" ~> jsonEmptyObject)
  encodeJson (Ls (Imports fp)) =
    commandWrapper "list" ("type" := "import" ~> "file" := fp ~> jsonEmptyObject)
  encodeJson Quit = jsonSingletonObject' "command" "quit"
  encodeJson Reset = jsonSingletonObject' "command" "reset"
  encodeJson (Load modules dependencies) =
    commandWrapper "load" (
      "modules" := (encodeJson modules)
      ~> "dependencies" := (encodeJson dependencies)
      ~> jsonEmptyObject
      )
  encodeJson (Complete filters matcher currentModule options) =
    commandWrapper "complete" (
      "filters" := (encodeJson filters)
      ~> "matcher" := (encodeMaybeNull matcher)
      ~> "currentModule" := (encodeMaybeNull currentModule)
      ~> "options" := (encodeJson options)
      ~> jsonEmptyObject
      )
  encodeJson (Pursuit psType q) =
    commandWrapper "pursuit" (
        "type" := (encodeJson psType)
        ~> "query" := q
        ~> jsonEmptyObject
      )
  encodeJson (Type text filters currentModule) =
    commandWrapper "type" (
        "search" := encodeJson text
        ~> "filters" := (encodeJson filters)
        ~> "currentModule" := (encodeMaybeNull currentModule)
        ~> jsonEmptyObject
      )
  encodeJson (AddClause line annotations) =
    commandWrapper "addClause" (
        "line" := encodeJson line
        ~> "annotations" := encodeJson annotations
        ~> jsonEmptyObject
      )
  encodeJson (CaseSplit line begin end annotations typ) =
    commandWrapper "caseSplit" (
        "line" := encodeJson line
        ~> "begin" := encodeJson begin
        ~> "end" := encodeJson end
        ~> "annotations" := encodeJson annotations
        ~> "type" := encodeJson typ
        ~> jsonEmptyObject
      )
  encodeJson (ImportCmd inFile outFile filters cmd) =
    commandWrapper "import" (
      "file" := encodeJson inFile
      ~> "outfile" := encodeMaybeNull outFile
      ~> "filters" := encodeJson filters
      ~> "importCommand" := encodeJson cmd
      ~> jsonEmptyObject
      )
  encodeJson (RebuildCmd file actualFile) =
    commandWrapper "rebuild" (
      "file" := encodeJson file
      ~> "actualFile" := encodeMaybeNull actualFile
      ~> jsonEmptyObject
      )

encodeMaybeNull :: forall a. (EncodeJson a) => Maybe a -> Json
encodeMaybeNull = maybe jsonNull encodeJson

instance encodeImportCommand :: EncodeJson ImportCommand where
  encodeJson (AddImplicitImport ident) =
    "importCommand" := "addImplicitImport"
    ~> "module" := encodeJson ident
    ~> jsonEmptyObject
  encodeJson (AddQualifiedImport mod qualifier) =
    "importCommand" := "addQualifiedImport"
    ~> "module" := encodeJson mod
    ~> "qualifier" := encodeJson qualifier
    ~> jsonEmptyObject
  encodeJson (AddImport mod qualifier) =
    "importCommand" := "addImport"
    ~> "identifier" := encodeJson mod
    ~> "qualifier" := encodeJson qualifier
    ~> jsonEmptyObject

type Result a = Either String a

type GenCompletion a = {
  type' :: String,
  identifier :: String,
  module' :: String
  | a
}

newtype TypePosition = TypePosition {
  name :: String,
  start :: Position,
  end :: Position
}

newtype TypeInfo = TypeInfo (GenCompletion (
  definedAt :: Maybe TypePosition,
  expandedType :: Maybe String,
  documentation :: Maybe String,
  exportedFrom :: Array String
))
newtype PursuitCompletion = PursuitCompletion {
  type' :: Maybe String,
  identifier :: String,
  module' :: String,
  package :: String,
  text :: String
  }

newtype ModuleList = ModuleList (Array String)
newtype Message = Message String
newtype ImportList = ImportList { moduleName :: Maybe String, imports :: Array Import }
newtype Import = Import
  {
    moduleName :: String,
    importType :: ImportType,
    qualifier  :: Maybe String
  }

type Position = { line :: Int, column :: Int }
type RangePosition = { startLine :: Int, startColumn :: Int, endLine :: Int, endColumn :: Int }

newtype RebuildError =
  RebuildError
  { position :: Maybe RangePosition
  , moduleName :: Maybe String
  , filename :: Maybe String
  , errorCode :: String
  , message :: String
  , errorLink :: String
  , pursIde :: Maybe PursIdeInfo
  , suggestion :: Maybe PscSuggestion
  }

newtype PscSuggestion =
  PscSuggestion
  { replacement :: String
  , replaceRange :: Maybe RangePosition
  }

newtype RebuildResult = RebuildResult (Array RebuildError)

newtype PursIdeInfo =
  PursIdeInfo
  { name :: String
  , completions :: Array TypeInfo
  }

data ImportType = Implicit | Explicit (Array String) | Hiding (Array String)

data ImportResult = SuccessFile Message | SuccessText (Array String) | MultipleResults (Array TypeInfo)

unwrapResponse :: forall a b. DecodeJson a => DecodeJson b => String -> Either String (Either a b)
unwrapResponse s = do
  json <- jsonParser s
  o <- decodeJson json
  resultType <- o .? "resultType"
  case resultType of
    "success" -> do
      result <- o .? "result"
      pure (Right result)
    _ -> do
      result <- o .? "result"
      pure (Left result)

instance decodeMessage :: DecodeJson Message where
  decodeJson json = maybe (Left "Message not string") (Right <<< Message) $ toString json

instance decodeModuleList :: DecodeJson ModuleList where
  decodeJson json = ModuleList <$> decodeJson json

instance decodeTypeInfo :: DecodeJson TypeInfo where
  decodeJson json = do
    o <- decodeJson json
    identifier <- o .? "identifier"
    type' <- o .? "type"
    module' <- o .? "module"
    definedAt <- o `getFieldMaybe` "definedAt"
    expandedType <- o `getFieldMaybe` "expandedType"
    documentation <- o `getFieldMaybe` "documentation"
    -- TODO: Handling both missing/incorrect exportedFrom. Remove this after 0.12
    exportedFrom <- Right $ either (const []) id $ getField o "exportedFrom"
    pure (TypeInfo { identifier, type', module', definedAt, expandedType, documentation, exportedFrom })
    where
    getFieldMaybe :: forall a. (DecodeJson a) => JObject -> String -> Either String (Maybe a)
    getFieldMaybe o f = Right $ either (const Nothing) Just $ getField o f

instance decodeTypePosition :: DecodeJson TypePosition where
  decodeJson json = do
    o <- decodeJson json
    name <- o .? "name"
    start <- o .? "start"
    end <- o .? "end"
    case start, end of
      [sl, sc], [el, ec] ->
        Right (TypePosition { name, start: { line: sl, column: sc }, end: { line: el, column: ec } })
      _, _ -> Left "Start/end should be arrays"

instance decodePursuitCompletion :: DecodeJson PursuitCompletion where
  decodeJson json = do
    o <- decodeJson json
    identifier <- o .? "ident"
    type' <- o .? "type"
    module' <- o .? "module"
    package <- o .? "package"
    text <- o .? "text"
    pure (PursuitCompletion {
      identifier: identifier,
      type': type',
      module': module',
      package: package,
      text: text
      })

instance decodeImportList :: DecodeJson ImportList where
  decodeJson json = decodeObject <|> decodeArray
    where
      decodeObject = do
        o <- decodeJson json
        moduleNameField <- o .? "moduleName"
        moduleName <- decodeModuleNameBug moduleNameField <|> decodeJson moduleNameField
        imports <- o .? "imports"
        pure (ImportList { moduleName: Just moduleName, imports })
      -- TODO: Working around a bug where module Foo.Bar is jsonified as ["Foo", "Bar"] instead of "Foo.Bar"
      decodeModuleNameBug moduleName = joinWith "." <$> decodeJson moduleName
      decodeArray = do
        imports <- decodeJson json
        pure (ImportList { moduleName: Nothing, imports })

instance decodeImport :: DecodeJson Import where
  decodeJson json = do
    o <- decodeJson json
    moduleName <- o .? "module"
    importType <- o .? "importType"
    q <- (Just <$> o .? "qualifier") <|> pure Nothing
    case importType of
      "implicit" -> do
        pure $ Import {moduleName: moduleName, importType: Implicit, qualifier: q}
      "explicit" -> do
        identifiers <- o .? "identifiers"
        pure $ Import {moduleName: moduleName, importType: Explicit identifiers, qualifier: q}
      "hiding"   -> do
        identifiers <- o .? "identifiers"
        pure $ Import {moduleName: moduleName, importType: Hiding identifiers, qualifier: q}
      _ -> Left "unknown importType"

instance decodeImportResult :: DecodeJson ImportResult where
  decodeJson json = do
    (SuccessText <$> decodeJson json)
    <|> (SuccessFile <$> decodeJson json)
    <|> (MultipleResults <$> decodeJson json)
    <|> (Left "Couldn't parse as ImportResult")

instance decodeRebuildError :: DecodeJson RebuildError where
  decodeJson json = do
    o <- decodeJson json
    message <- o .? "message"
    errorCode <- o .? "errorCode"
    errorLink <- o .? "errorLink"
    moduleName <- o .? "moduleName"
    filename <- o .? "filename"
    position <- pure $ eitherToMaybe do
      p <- o .? "position"
      { startLine: _, startColumn: _, endLine: _, endColumn: _ } <$> p .? "startLine" <*> p .? "startColumn" <*> p .? "endLine" <*> p .? "endColumn"
    pursIde <- pure $ eitherToMaybe do
      pio <- o .? "pursIde"
      name <- pio .? "name"
      completions <- pio .? "completions"
      pure $ PursIdeInfo { name, completions }
    suggestion <- pure $ eitherToMaybe do
      so <- o .? "suggestion"
      replacement <- so .? "replacement"
      rr <- so .? "replaceRange"
      replaceRange <- pure $ eitherToMaybe $ { startLine: _, startColumn: _, endLine: _, endColumn: _ } <$> rr .? "startLine" <*> rr .? "startColumn" <*> rr .? "endLine" <*> rr .? "endColumn"
      pure $ PscSuggestion { replacement, replaceRange }
    pure (RebuildError { errorCode, errorLink, moduleName, filename, message, position, pursIde, suggestion })
    where
    eitherToMaybe :: forall a b. Either a b -> Maybe b
    eitherToMaybe = either (const Nothing) Just

instance decodeRebuildResult :: DecodeJson RebuildResult where
  decodeJson json = RebuildResult <$> (decodeJson json <|> (singleton <$> decodeJson json))

module PscIde.Command where

import Prelude
import Control.Alt ((<|>))
import Data.Argonaut (JObject, getField)
import Data.Argonaut.Core (jsonEmptyObject, jsonSingletonObject, jsonNull, Json, toString)
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.?))
import Data.Argonaut.Encode (class EncodeJson, encodeJson, (~>), (:=))
import Data.Argonaut.Parser (jsonParser)
import Data.Array (singleton)
import Data.Either (either, Either(..))
import Data.Maybe (Maybe(..), maybe)
import Data.String (joinWith)

data PursuitType = Package | Ident

instance showPursuitType :: Show PursuitType where
  show Package = "package"
  show Ident   = "completion"

instance encodePursuitType :: EncodeJson PursuitType where
  encodeJson = encodeJson <<< show

data Matcher =
  Flex String
  | Distance String Int

instance encodeMatcher :: EncodeJson Matcher where
  encodeJson (Flex q) =
    "matcher" := "flex"
    ~> "params" := (jsonSingletonObject' "search" q)
    ~> jsonEmptyObject
  encodeJson (Distance q maxDist) =
    "matcher" := "distance"
    ~> "params" := (
       "search" := q
       ~> "maximumDistance" := maxDist
       ~> jsonEmptyObject
      )
    ~> jsonEmptyObject

data Filter =
  ExactFilter String
  | PrefixFilter String
  | ModuleFilter (Array String)
  | DependencyFilter (Array String)

filterWrapper :: forall a. (EncodeJson a) => String -> a -> Json
filterWrapper f q =
  "filter" := f
  ~> ("params" := q)
  ~> jsonEmptyObject

jsonSingletonObject' :: forall a. (EncodeJson a) => String -> a -> Json
jsonSingletonObject' s o = jsonSingletonObject s (encodeJson o)

instance encodeFilter :: EncodeJson Filter where
  encodeJson (ExactFilter q) =
    filterWrapper "exact" (jsonSingletonObject' "search" q)
  encodeJson (PrefixFilter q) =
    filterWrapper "prefix" (jsonSingletonObject' "search" q)
  encodeJson (ModuleFilter modules) =
    filterWrapper "modules" (jsonSingletonObject' "modules" modules)
  encodeJson (DependencyFilter deps) =
    filterWrapper "dependencies" (jsonSingletonObject' "modules" deps)

newtype CompletionOptions = CompletionOptions {
  maxResults :: Maybe Int,
  groupReexports :: Boolean
}

instance encodeCompletionOptions :: EncodeJson CompletionOptions where
  encodeJson (CompletionOptions { maxResults, groupReexports }) =
   "maxResults" := encodeMaybeNull maxResults
    ~> "groupReexports" := encodeJson groupReexports
    ~> jsonEmptyObject

data Command =
  Cwd
  | Ls ListType
  | Quit
  | Reset
  | Load (Array String) (Array String)
  | Complete (Array Filter) (Maybe Matcher) (Maybe String) CompletionOptions
  | Pursuit PursuitType String
  | Type String (Array Filter) (Maybe String)
  | AddClause String Boolean
  | CaseSplit String Int Int Boolean String
  | ImportCmd FileName (Maybe FileName) (Array Filter) ImportCommand
  | RebuildCmd String (Maybe FileName)

data ListType = LoadedModules | Imports String | AvailableModules

type FileName = String
data ImportCommand = AddImplicitImport String | AddQualifiedImport String String | AddImport String (Maybe String)

commandWrapper :: forall a. (EncodeJson a) => String -> a -> Json
commandWrapper s o =
  "command" := s
  ~> ("params" := o)
  ~> jsonEmptyObject

instance encodeCommand :: EncodeJson Command where
  encodeJson Cwd = jsonSingletonObject' "command" "cwd"
  encodeJson (Ls LoadedModules) =
    commandWrapper "list" ("type" := "loadedModules" ~> jsonEmptyObject)
  encodeJson (Ls AvailableModules) =
    commandWrapper "list" ("type" := "availableModules" ~> jsonEmptyObject)
  encodeJson (Ls (Imports fp)) =
    commandWrapper "list" ("type" := "import" ~> "file" := fp ~> jsonEmptyObject)
  encodeJson Quit = jsonSingletonObject' "command" "quit"
  encodeJson Reset = jsonSingletonObject' "command" "reset"
  encodeJson (Load modules dependencies) =
    commandWrapper "load" (
      "modules" := (encodeJson modules)
      ~> "dependencies" := (encodeJson dependencies)
      ~> jsonEmptyObject
      )
  encodeJson (Complete filters matcher currentModule options) =
    commandWrapper "complete" (
      "filters" := (encodeJson filters)
      ~> "matcher" := (encodeMaybeNull matcher)
      ~> "currentModule" := (encodeMaybeNull currentModule)
      ~> "options" := (encodeJson options)
      ~> jsonEmptyObject
      )
  encodeJson (Pursuit psType q) =
    commandWrapper "pursuit" (
        "type" := (encodeJson psType)
        ~> "query" := q
        ~> jsonEmptyObject
      )
  encodeJson (Type text filters currentModule) =
    commandWrapper "type" (
        "search" := encodeJson text
        ~> "filters" := (encodeJson filters)
        ~> "currentModule" := (encodeMaybeNull currentModule)
        ~> jsonEmptyObject
      )
  encodeJson (AddClause line annotations) =
    commandWrapper "addClause" (
        "line" := encodeJson line
        ~> "annotations" := encodeJson annotations
        ~> jsonEmptyObject
      )
  encodeJson (CaseSplit line begin end annotations typ) =
    commandWrapper "caseSplit" (
        "line" := encodeJson line
        ~> "begin" := encodeJson begin
        ~> "end" := encodeJson end
        ~> "annotations" := encodeJson annotations
        ~> "type" := encodeJson typ
        ~> jsonEmptyObject
      )
  encodeJson (ImportCmd inFile outFile filters cmd) =
    commandWrapper "import" (
      "file" := encodeJson inFile
      ~> "outfile" := encodeMaybeNull outFile
      ~> "filters" := encodeJson filters
      ~> "importCommand" := encodeJson cmd
      ~> jsonEmptyObject
      )
  encodeJson (RebuildCmd file actualFile) =
    commandWrapper "rebuild" (
      "file" := encodeJson file
      ~> "actualFile" := encodeMaybeNull actualFile
      ~> jsonEmptyObject
      )

encodeMaybeNull :: forall a. (EncodeJson a) => Maybe a -> Json
encodeMaybeNull = maybe jsonNull encodeJson

instance encodeImportCommand :: EncodeJson ImportCommand where
  encodeJson (AddImplicitImport ident) =
    "importCommand" := "addImplicitImport"
    ~> "module" := encodeJson ident
    ~> jsonEmptyObject
  encodeJson (AddQualifiedImport mod qualifier) =
    "importCommand" := "addQualifiedImport"
    ~> "module" := encodeJson mod
    ~> "qualifier" := encodeJson qualifier
    ~> jsonEmptyObject
  encodeJson (AddImport mod qualifier) =
    "importCommand" := "addImport"
    ~> "identifier" := encodeJson mod
    ~> "qualifier" := encodeJson qualifier
    ~> jsonEmptyObject

type Result a = Either String a

type GenCompletion a = {
  type' :: String,
  identifier :: String,
  module' :: String
  | a
}

newtype TypePosition = TypePosition {
  name :: String,
  start :: Position,
  end :: Position
}

newtype TypeInfo = TypeInfo (GenCompletion (
  definedAt :: Maybe TypePosition,
  expandedType :: Maybe String,
  documentation :: Maybe String,
  exportedFrom :: Array String
))
newtype PursuitCompletion = PursuitCompletion {
  type' :: Maybe String,
  identifier :: String,
  module' :: String,
  package :: String,
  text :: String
  }

newtype ModuleList = ModuleList (Array String)
newtype Message = Message String
newtype ImportList = ImportList { moduleName :: Maybe String, imports :: Array Import }
newtype Import = Import
  {
    moduleName :: String,
    importType :: ImportType,
    qualifier  :: Maybe String
  }

type Position = {line :: Int, column :: Int}

newtype RebuildError =
  RebuildError
  { position :: Maybe Position
  , moduleName :: Maybe String
  , filename :: Maybe String
  , errorCode :: String
  , message :: String
  , pursIde :: Maybe PursIdeInfo
  }
newtype RebuildResult = RebuildResult (Array RebuildError)

newtype PursIdeInfo =
  PursIdeInfo
  { name :: String
  , completions :: Array TypeInfo
  }

data ImportType = Implicit | Explicit (Array String) | Hiding (Array String)

data ImportResult = SuccessFile Message | SuccessText (Array String) | MultipleResults (Array TypeInfo)

unwrapResponse :: forall a b. DecodeJson a => DecodeJson b => String -> Either String (Either a b)
unwrapResponse s = do
  json <- jsonParser s
  o <- decodeJson json
  resultType <- o .? "resultType"
  case resultType of
    "success" -> do
      result <- o .? "result"
      pure (Right result)
    _ -> do
      result <- o .? "result"
      pure (Left result)

instance decodeMessage :: DecodeJson Message where
  decodeJson json = maybe (Left "Message not string") (Right <<< Message) $ toString json

instance decodeModuleList :: DecodeJson ModuleList where
  decodeJson json = ModuleList <$> decodeJson json

instance decodeTypeInfo :: DecodeJson TypeInfo where
  decodeJson json = do
    o <- decodeJson json
    identifier <- o .? "identifier"
    type' <- o .? "type"
    module' <- o .? "module"
    definedAt <- o `getFieldMaybe` "definedAt"
    expandedType <- o `getFieldMaybe` "expandedType"
    documentation <- o `getFieldMaybe` "documentation"
    -- TODO: Handling both missing/incorrect exportedFrom. Remove this after 0.12
    exportedFrom <- Right $ either (const []) id $ getField o "exportedFrom"
    pure (TypeInfo { identifier, type', module', definedAt, expandedType, documentation, exportedFrom })
    where
    getFieldMaybe :: forall a. (DecodeJson a) => JObject -> String -> Either String (Maybe a)
    getFieldMaybe o f = Right $ either (const Nothing) Just $ getField o f

instance decodeTypePosition :: DecodeJson TypePosition where
  decodeJson json = do
    o <- decodeJson json
    name <- o .? "name"
    start <- o .? "start"
    end <- o .? "end"
    case start, end of
      [sl, sc], [el, ec] ->
        Right (TypePosition { name, start: { line: sl, column: sc }, end: { line: el, column: ec } })
      _, _ -> Left "Start/end should be arrays"

instance decodePursuitCompletion :: DecodeJson PursuitCompletion where
  decodeJson json = do
    o <- decodeJson json
    identifier <- o .? "ident"
    type' <- o .? "type"
    module' <- o .? "module"
    package <- o .? "package"
    text <- o .? "text"
    pure (PursuitCompletion {
      identifier: identifier,
      type': type',
      module': module',
      package: package,
      text: text
      })

instance decodeImportList :: DecodeJson ImportList where
  decodeJson json = decodeObject <|> decodeArray
    where
      decodeObject = do
        o <- decodeJson json
        moduleNameField <- o .? "moduleName"
        moduleName <- decodeModuleNameBug moduleNameField <|> decodeJson moduleNameField
        imports <- o .? "imports"
        pure (ImportList { moduleName: Just moduleName, imports })
      -- TODO: Working around a bug where module Foo.Bar is jsonified as ["Foo", "Bar"] instead of "Foo.Bar"
      decodeModuleNameBug moduleName = joinWith "." <$> decodeJson moduleName
      decodeArray = do
        imports <- decodeJson json
        pure (ImportList { moduleName: Nothing, imports })

instance decodeImport :: DecodeJson Import where
  decodeJson json = do
    o <- decodeJson json
    moduleName <- o .? "module"
    importType <- o .? "importType"
    q <- (Just <$> o .? "qualifier") <|> pure Nothing
    case importType of
      "implicit" -> do
        pure $ Import {moduleName: moduleName, importType: Implicit, qualifier: q}
      "explicit" -> do
        identifiers <- o .? "identifiers"
        pure $ Import {moduleName: moduleName, importType: Explicit identifiers, qualifier: q}
      "hiding"   -> do
        identifiers <- o .? "identifiers"
        pure $ Import {moduleName: moduleName, importType: Hiding identifiers, qualifier: q}
      _ -> Left "unknown importType"

instance decodeImportResult :: DecodeJson ImportResult where
  decodeJson json = do
    (SuccessText <$> decodeJson json)
    <|> (SuccessFile <$> decodeJson json)
    <|> (MultipleResults <$> decodeJson json)
    <|> (Left "Couldn't parse as ImportResult")

instance decodeRebuildError :: DecodeJson RebuildError where
  decodeJson json = do
    o <- decodeJson json
    message <- o .? "message"
    errorCode <- o .? "errorCode"
    moduleName <- o .? "moduleName"
    filename <- o .? "filename"
    position <- pure $ eitherToMaybe do
      p <- o .? "position"
      { line: _, column: _ } <$> p .? "startLine" <*> p .? "startColumn"
    pursIde <- pure $ eitherToMaybe do
      pio <- o .? "pursIde"
      name <- pio .? "name"
      completions <- pio .? "completions"
      pure $ PursIdeInfo { name, completions }
    pure (RebuildError { errorCode, moduleName, filename, message, position, pursIde })
    where
    eitherToMaybe :: forall a b. Either a b -> Maybe b
    eitherToMaybe = either (const Nothing) Just

instance decodeRebuildResult :: DecodeJson RebuildResult where
  decodeJson json = RebuildResult <$> (decodeJson json <|> (singleton <$> decodeJson json))


Add missing evalState, execState, mapState

module Control.Monad.State where

import Prelude
import Control.Monad.Identity
import Control.Monad.State.Trans
import Data.Tuple

type State s a = StateT s Identity a

runState :: forall s a. State s a -> s -> Tuple a s
runState s = runIdentity <<< runStateT s

evalState :: forall s a. State s a -> s -> a
evalState m s = fst (runState m s)

execState :: forall s a. State s a -> s -> s
execState m s = snd (runState m s)

mapState :: forall s a b. (Tuple a s -> Tuple b s) -> State s a -> State s b
mapState f = mapStateT (Identity <<< f <<< runIdentity)

withState :: forall s a. (s -> s) -> State s a -> State s a
withState = withStateT

module Control.Monad.State where

import Prelude
import Control.Monad.Identity
import Control.Monad.State.Trans
import Data.Tuple

type State s a = StateT s Identity a

runState :: forall s a. State s a -> s -> Tuple a s
runState s = runIdentity <<< runStateT s

withState :: forall s a. (s -> s) -> State s a -> State s a
withState = withStateT


Add unsafeFreeze, deprecate runSTArray

Add unsafeFreeze, deprecate runSTArray

-- | Helper functions for working with mutable arrays using the `ST` effect.
-- |
-- | This module can be used when performance is important and mutation is a local effect.

module Data.Array.ST
  ( STArray(..)
  , Assoc()
  , runSTArray
  , emptySTArray
  , peekSTArray
  , pokeSTArray
  , pushSTArray
  , pushAllSTArray
  , spliceSTArray
  , freeze, thaw
  , unsafeFreeze
  , toAssocArray
  ) where

import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.ST (ST)

import Data.Maybe (Maybe(..))
import Unsafe.Coerce (unsafeCoerce)

-- | A reference to a mutable array.
-- |
-- | The first type parameter represents the memory region which the array belongs to.
-- | The second type parameter defines the type of elements of the mutable array.
-- |
-- | The runtime representation of a value of type `STArray h a` is the same as that of `Array a`,
-- | except that mutation is allowed.
foreign import data STArray :: * -> * -> *

-- | An element and its index.
type Assoc a = { value :: a, index :: Int }

-- | **DEPRECATED**: Use `unsafeFreeze` together with `runST` instead.
-- |
-- | Freeze a mutable array, creating an immutable array. Use this function as you would use
-- | `runST` to freeze a mutable reference.
-- |
-- | The rank-2 type prevents the reference from escaping the scope of `runSTArray`.
foreign import runSTArray
  :: forall a r
   . (forall h. Eff (st :: ST h | r) (STArray h a))
  -> Eff r (Array a)

-- | O(1). Convert a mutable array to an immutable array, without copying. The mutable
-- | array must not be mutated afterwards.
unsafeFreeze :: forall a r h. STArray h a -> Eff (st :: ST h | r) (Array a)
unsafeFreeze = pure <<< (unsafeCoerce :: STArray h a -> Array a)

-- | Create an empty mutable array.
foreign import emptySTArray :: forall a h r. Eff (st :: ST h | r) (STArray h a)

-- | Create a mutable copy of an immutable array.
thaw :: forall a h r. Array a -> Eff (st :: ST h | r) (STArray h a)
thaw = copyImpl

-- | Create an immutable copy of a mutable array.
freeze :: forall a h r. STArray h a -> Eff (st :: ST h | r) (Array a)
freeze = copyImpl

foreign import copyImpl :: forall a b h r. a -> Eff (st :: ST h | r) b

-- | Read the value at the specified index in a mutable array.
peekSTArray
  :: forall a h r
   . STArray h a
  -> Int
  -> Eff (st :: ST h | r) (Maybe a)
peekSTArray = peekSTArrayImpl Just Nothing

foreign import peekSTArrayImpl
  :: forall a h e r
   . (a -> r)
  -> r
  -> (STArray h a)
  -> Int
  -> (Eff (st :: ST h | e) r)

-- | Change the value at the specified index in a mutable array.
foreign import pokeSTArray
  :: forall a h r
   . STArray h a -> Int -> a -> Eff (st :: ST h | r) Boolean

-- | Append an element to the end of a mutable array.
pushSTArray :: forall a h r. STArray h a -> a -> Eff (st :: ST h | r) Int
pushSTArray arr a = pushAllSTArray arr [a]

-- | Append the values in an immutable array to the end of a mutable array.
foreign import pushAllSTArray
  :: forall a h r
   . STArray h a
  -> Array a
  -> Eff (st :: ST h | r) Int

-- | Remove and/or insert elements from/into a mutable array at the specified index.
foreign import spliceSTArray
  :: forall a h r
   . STArray h a
  -> Int
  -> Int
  -> Array a
  -> Eff (st :: ST h | r) (Array a)

-- | Create an immutable copy of a mutable array, where each element
-- | is labelled with its index in the original array.
foreign import toAssocArray
  :: forall a h r
   . STArray h a
  -> Eff (st :: ST h | r) (Array (Assoc a))

-- | Helper functions for working with mutable arrays using the `ST` effect.
-- |
-- | This module can be used when performance is important and mutation is a local effect.

module Data.Array.ST
  ( STArray(..)
  , Assoc()
  , runSTArray
  , emptySTArray
  , peekSTArray
  , pokeSTArray
  , pushSTArray
  , pushAllSTArray
  , spliceSTArray
  , freeze, thaw
  , toAssocArray
  ) where

import Control.Monad.Eff (Eff)
import Control.Monad.ST (ST)

import Data.Maybe (Maybe(..))

-- | A reference to a mutable array.
-- |
-- | The first type parameter represents the memory region which the array belongs to.
-- | The second type parameter defines the type of elements of the mutable array.
-- |
-- | The runtime representation of a value of type `STArray h a` is the same as that of `Array a`,
-- | except that mutation is allowed.
foreign import data STArray :: * -> * -> *

-- | An element and its index.
type Assoc a = { value :: a, index :: Int }

-- | Freeze a mutable array, creating an immutable array. Use this function as you would use
-- | `runST` to freeze a mutable reference.
-- |
-- | The rank-2 type prevents the reference from escaping the scope of `runSTArray`.
foreign import runSTArray
  :: forall a r
   . (forall h. Eff (st :: ST h | r) (STArray h a))
  -> Eff r (Array a)

-- | Create an empty mutable array.
foreign import emptySTArray :: forall a h r. Eff (st :: ST h | r) (STArray h a)

-- | Create a mutable copy of an immutable array.
thaw :: forall a h r. Array a -> Eff (st :: ST h | r) (STArray h a)
thaw = copyImpl

-- | Create an immutable copy of a mutable array.
freeze :: forall a h r. STArray h a -> Eff (st :: ST h | r) (Array a)
freeze = copyImpl

foreign import copyImpl :: forall a b h r. a -> Eff (st :: ST h | r) b

-- | Read the value at the specified index in a mutable array.
peekSTArray
  :: forall a h r
   . STArray h a
  -> Int
  -> Eff (st :: ST h | r) (Maybe a)
peekSTArray = peekSTArrayImpl Just Nothing

foreign import peekSTArrayImpl
  :: forall a h e r
   . (a -> r)
  -> r
  -> (STArray h a)
  -> Int
  -> (Eff (st :: ST h | e) r)

-- | Change the value at the specified index in a mutable array.
foreign import pokeSTArray
  :: forall a h r
   . STArray h a -> Int -> a -> Eff (st :: ST h | r) Boolean

-- | Append an element to the end of a mutable array.
pushSTArray :: forall a h r. STArray h a -> a -> Eff (st :: ST h | r) Int
pushSTArray arr a = pushAllSTArray arr [a]

-- | Append the values in an immutable array to the end of a mutable array.
foreign import pushAllSTArray
  :: forall a h r
   . STArray h a
  -> Array a
  -> Eff (st :: ST h | r) Int

-- | Remove and/or insert elements from/into a mutable array at the specified index.
foreign import spliceSTArray
  :: forall a h r
   . STArray h a
  -> Int
  -> Int
  -> Array a
  -> Eff (st :: ST h | r) (Array a)

-- | Create an immutable copy of a mutable array, where each element
-- | is labelled with its index in the original array.
foreign import toAssocArray
  :: forall a h r
   . STArray h a
  -> Eff (st :: ST h | r) (Array (Assoc a))


TileLayer: pass id

TileLayer: pass id

{-
  Author    : Tim Dysinger
  Copyright : 2014
  License   : MIT
-}

module Leaflet.Types where

import Control.Monad.Eff

type URL = String

foreign import data ILayer :: *
foreign import data Icon :: *
foreign import data LatLng :: *
foreign import data LatLngBounds :: *
foreign import data LayerGroup :: *
foreign import data Map :: *
foreign import data Marker :: *
foreign import data Popup :: *
foreign import data TileLayer :: *
foreign import data Polyline :: *

class Layer a where
  toILayer :: a -> ILayer
  addTo :: forall e. a -> Map -> Eff e a

type MapOptions = { attributionControl :: Boolean,
                    center :: LatLng,
                    layers :: Array ILayer,
                    maxBounds :: LatLngBounds,
                    zoom :: Number }

type TileLayerOptions r = { id :: String, subdomains :: Array String | r }

type MarkerOptions r = { icon :: Icon | r }

type PopupOptions r = { | r }

-- All PathOptions plus a few more options.
type PolylineOptions = { stroke :: Boolean,
                         color :: String,
                         weight :: Number,
                         opacity :: Number,
                         fill :: Boolean,
                         fillColor :: String,
                         fillOpacity :: Number,
                         dashArray :: String,
                         lineCap :: String,
                         lineJoin :: String,
                         clickable :: Boolean,
                         pointerEvents :: String,
                         className :: String,
                         smoothFactor :: Number,
                         noClip :: Boolean }

{-
  Author    : Tim Dysinger
  Copyright : 2014
  License   : MIT
-}

module Leaflet.Types where

import Control.Monad.Eff

type URL = String

foreign import data ILayer :: *
foreign import data Icon :: *
foreign import data LatLng :: *
foreign import data LatLngBounds :: *
foreign import data LayerGroup :: *
foreign import data Map :: *
foreign import data Marker :: *
foreign import data Popup :: *
foreign import data TileLayer :: *
foreign import data Polyline :: *

class Layer a where
  toILayer :: a -> ILayer
  addTo :: forall e. a -> Map -> Eff e a

type MapOptions = { attributionControl :: Boolean,
                    center :: LatLng,
                    layers :: Array ILayer,
                    maxBounds :: LatLngBounds,
                    zoom :: Number }

type TileLayerOptions r = { subdomains :: Array String | r }

type MarkerOptions r = { icon :: Icon | r }

type PopupOptions r = { | r }

-- All PathOptions plus a few more options.
type PolylineOptions = { stroke :: Boolean,
                         color :: String,
                         weight :: Number,
                         opacity :: Number,
                         fill :: Boolean,
                         fillColor :: String,
                         fillOpacity :: Number,
                         dashArray :: String,
                         lineCap :: String,
                         lineJoin :: String,
                         clickable :: Boolean,
                         pointerEvents :: String,
                         className :: String,
                         smoothFactor :: Number,
                         noClip :: Boolean }