content: {-# OPTIONS_GHC -Wall #-}
  {-# LANGUAGE OverloadedStrings #-}
  module Reporting.Error
    ( Module(..)
    , Error(..)
    , toDoc
    , toJson
    )
    where
  
  
  import qualified Data.ByteString as B
  import qualified Data.NonEmptyList as NE
  import qualified Data.OneOrMore as OneOrMore
  import qualified System.FilePath as FP
  
  import qualified Elm.ModuleName as ModuleName
  import qualified File
  import qualified Json.Encode as E
  import Json.Encode ((==>))
  import qualified Reporting.Annotation as A
  import qualified Reporting.Doc as D
  import qualified Reporting.Error.Canonicalize as Canonicalize
  import qualified Reporting.Error.Docs as Docs
  import qualified Reporting.Error.Import as Import
  import qualified Reporting.Error.Main as Main
  import qualified Reporting.Error.Pattern as Pattern
  import qualified Reporting.Error.Syntax as Syntax
  import qualified Reporting.Error.Type as Type
  import qualified Reporting.Render.Code as Code
  import qualified Reporting.Render.Type.Localizer as L
  import qualified Reporting.Report as Report
  
  
  import Lamdera
  import qualified Lamdera.Error
  
  -- MODULE
  
  
  data Module =
    Module
      { _name :: ModuleName.Raw
      , _absolutePath :: FilePath
      , _modificationTime :: File.Time
      , _source :: B.ByteString
      , _error :: Error
      }
  
  
  
  -- ERRORS
  
  
  data Error
    = BadSyntax Syntax.Error
    | BadImports (NE.List Import.Error)
    | BadNames (OneOrMore.OneOrMore Canonicalize.Error)
    | BadTypes L.Localizer (NE.List Type.Error)
    | BadMains L.Localizer (OneOrMore.OneOrMore Main.Error)
    | BadPatterns (NE.List Pattern.Error)
    | BadDocs Docs.Error
    | BadLamderaWireIncompatible String D.Doc
    | BadLamdera String D.Doc
    -- @LAMDERA
    | LamderaBadDebugLog (NE.List A.Region)
  
  
  
  -- TO REPORT
  
  
  toReports :: Code.Source -> Error -> NE.List Report.Report
  toReports source err =
    case err of
      BadSyntax syntaxError ->
        NE.List (Syntax.toReport source syntaxError) []
  
      BadImports errs ->
        fmap (Import.toReport source) errs
  
      BadNames errs ->
        fmap (Canonicalize.toReport source) (OneOrMore.destruct NE.List errs)
  
      BadTypes localizer errs ->
        fmap (Type.toReport source localizer) errs
  
      BadMains localizer errs ->
        fmap (Main.toReport localizer source) (OneOrMore.destruct NE.List errs)
  
      BadPatterns errs ->
        fmap (Pattern.toReport source) errs
  
      BadDocs docsErr ->
        Docs.toReports source docsErr
  
      BadLamderaWireIncompatible title doc ->
        NE.singleton $ Lamdera.Error.report title doc
  
      BadLamdera title doc ->
        NE.singleton $ Lamdera.Error.report title doc
  
      LamderaBadDebugLog regions ->
          fmap
              (\region ->
                  Report.Report "USELESS DEBUG.LOG" region [] $
                      Code.toSnippet source region Nothing
                        (
                          D.reflow $
                            "You wrote Debug.log but you forgot to provide it with a second parameter."
                        ,
                          D.stack
                            [
                              D.reflow $
                                "Without a second parameter Debug.log won't print anything to the browser console. Here's an example of what it should look like:"
                              , D.dullyellow $ D.indent 4 $ D.vcat $ [ D.reflow "_ = Debug.log \"debug label\" { someData = 123 }" ]
                            ]
                        )
              )
              regions
  
  
  
  -- TO DOC
  
  
  toDoc :: FilePath -> Module -> [Module] -> D.Doc
  toDoc root err errs =
    let
      (NE.List m ms) = NE.sortBy _modificationTime (NE.List err errs)
    in
    D.vcat (toDocHelp root m ms)
  
  
  toDocHelp :: FilePath -> Module -> [Module] -> [D.Doc]
  toDocHelp root module1 modules =
    case modules of
      [] ->
        [moduleToDoc root module1
        ,""
        ]
  
      module2 : otherModules ->
        moduleToDoc root module1
        : toSeparator module1 module2
        : toDocHelp root module2 otherModules
  
  
  toSeparator :: Module -> Module -> D.Doc
  toSeparator beforeModule afterModule =
    let
      before = ModuleName.toChars (_name beforeModule) ++ "  ↑    "
      after  = "    ↓  " ++  ModuleName.toChars (_name afterModule)
    in
      D.dullred $ D.vcat $
        [ D.indent (80 - length before) (D.fromChars before)
        , "====o======================================================================o===="
        , D.fromChars after
        , ""
        , ""
        ]
  
  
  
  -- MODULE TO DOC
  
  
  moduleToDoc :: FilePath -> Module -> D.Doc
  moduleToDoc root (Module _ absolutePath _ source err) =
    let
      reports =
        toReports (Code.toSource source) err
  
      relativePath =
        FP.makeRelative root absolutePath
    in
    D.vcat $ map (reportToDoc relativePath) (NE.toList reports)
  
  
  reportToDoc :: FilePath -> Report.Report -> D.Doc
  reportToDoc relativePath report@(Report.Report title _ _ message) =
    D.vcat
      [ toMessageBar title relativePath
      , ""
      , message
      , ""
      ]
      & Lamdera.alternativeImplementationPassthrough (Lamdera.Error.reportToDoc relativePath report)
  
  
  toMessageBar :: String -> FilePath -> D.Doc
  toMessageBar title filePath =
    let
      usedSpace =
        4 + length title + 1 + length filePath
    in
      D.dullcyan $ D.fromChars $
        "-- " ++ title
        ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'
        ++ " " ++ filePath
  
  
  
  -- TO JSON
  
  
  toJson :: Module -> E.Value
  toJson (Module name path _ source err) =
    let
      reports =
        toReports (Code.toSource source) err
    in
    E.object
      [ "path" ==> E.chars path
      , "name" ==> E.name name
      , "problems" ==> E.array (map reportToJson (NE.toList reports))
      ]
  
  
  reportToJson :: Report.Report -> E.Value
  reportToJson (Report.Report title region _sgstns message) =
    E.object
      [ "title" ==> E.chars title
      , "region" ==> encodeRegion region
      , "message" ==> D.encode message
      ]
  
  
  encodeRegion :: A.Region -> E.Value
  encodeRegion (A.Region (A.Position sr sc) (A.Position er ec)) =
    E.object
      [ "start" ==>
            E.object
              [ "line" ==> E.int (fromIntegral sr)
              , "column" ==> E.int (fromIntegral sc)
              ]
      , "end" ==>
            E.object
              [ "line" ==> E.int (fromIntegral er)
              , "column" ==> E.int (fromIntegral ec)
              ]
      ]
  