content: -----------------------------------------------------------------------------
  --
  -- Module      : Language.PureScript.Ide.Error
  -- Description : Error types for psc-ide
  -- Copyright   : Christoph Hegemann 2016
  -- License     : MIT (http://opensource.org/licenses/MIT)
  --
  -- Maintainer  : Christoph Hegemann <christoph.hegemann1337@gmail.com>
  -- Stability   : experimental
  --
  -- |
  -- Error types for psc-ide
  -----------------------------------------------------------------------------
  
  module Language.PureScript.Ide.Error
         ( IdeError(..)
         , prettyPrintTypeSingleLine
         ) where
  
  import Data.Aeson (KeyValue(..), ToJSON(..), Value, object)
  import Data.Aeson.Types qualified as Aeson
  import Data.Aeson.KeyMap qualified as KM
  import Data.Text qualified as T
  import Language.PureScript qualified as P
  import Language.PureScript.Errors.JSON (toJSONError)
  import Language.PureScript.Ide.Types (ModuleIdent, Completion(..))
  import Protolude
  
  data IdeError
      = GeneralError Text
      | NotFound Text
      | ModuleNotFound ModuleIdent
      | ModuleFileNotFound ModuleIdent
      | RebuildError [(FilePath, Text)] P.MultipleErrors
      deriving (Show)
  
  instance ToJSON IdeError where
    toJSON (RebuildError files errs) = object
      [ "resultType" .= ("error" :: Text)
      , "result" .= encodeRebuildErrors files errs
      ]
    toJSON err = object
      [ "resultType" .= ("error" :: Text)
      , "result" .= textError err
      ]
  
  encodeRebuildErrors :: [(FilePath, Text)] -> P.MultipleErrors -> Value
  encodeRebuildErrors files = toJSON . map encodeRebuildError . P.runMultipleErrors
    where
      encodeRebuildError err = case err of
        (P.ErrorMessage _
         ((P.HoleInferredType name _ _
           (Just P.TSAfter{tsAfterIdentifiers=idents, tsAfterRecordFields=fields})))) ->
          insertTSCompletions name idents (fromMaybe [] fields) (toJSON (toJSONError False P.Error files err))
        _ ->
          (toJSON . toJSONError False P.Error files) err
  
      insertTSCompletions name idents fields (Aeson.Object value) =
        Aeson.Object
          (KM.insert "pursIde"
           (object [ "name" .= name
                   , "completions" .= ordNub (map identCompletion idents ++ map fieldCompletion fields)
                   ]) value)
      insertTSCompletions _ _ _ v = v
  
      identCompletion (P.Qualified mn i, ty) =
        Completion     
          { complModule = maybe "" P.runModuleName $ P.toMaybeModuleName mn
          , complIdentifier = i
          , complType = prettyPrintTypeSingleLine ty
          , complExpandedType = prettyPrintTypeSingleLine ty
          , complLocation = Nothing
          , complDocumentation = Nothing
          , complExportedFrom = toList $ P.toMaybeModuleName mn
          , complDeclarationType = Nothing
          }
      fieldCompletion (label, ty) =
        Completion 
          { complModule = ""
          , complIdentifier = "_." <> P.prettyPrintLabel label
          , complType = prettyPrintTypeSingleLine ty
          , complExpandedType = prettyPrintTypeSingleLine ty
          , complLocation = Nothing
          , complDocumentation = Nothing
          , complExportedFrom = []
          , complDeclarationType = Nothing
          }
  
  textError :: IdeError -> Text
  textError (GeneralError msg)          = msg
  textError (NotFound ident)            = "Symbol '" <> ident <> "' not found."
  textError (ModuleNotFound ident)      = "Module '" <> ident <> "' not found."
  textError (ModuleFileNotFound ident)  = "Extern file for module " <> ident <> " could not be found"
  textError (RebuildError _ err)        = show err
  
  prettyPrintTypeSingleLine :: P.Type a -> Text
  prettyPrintTypeSingleLine = T.unwords . map T.strip . T.lines . T.pack . P.prettyPrintTypeWithUnicode maxBound
  