content: {-# OPTIONS_GHC -Wall #-}
  {-# LANGUAGE OverloadedStrings #-}
  module Diff
    ( Args(..)
    , run
    )
    where
  
  
  import qualified Data.List as List
  import qualified Data.Map as Map
  import qualified Data.Maybe as Maybe
  import qualified Data.Name as Name
  import qualified Data.NonEmptyList as NE
  
  import qualified BackgroundWriter as BW
  import qualified Build
  import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..))
  import qualified Deps.Diff as DD
  import qualified Deps.Registry as Registry
  import qualified Elm.Compiler.Type as Type
  import qualified Elm.Details as Details
  import qualified Elm.Docs as Docs
  import qualified Elm.Magnitude as M
  import qualified Elm.Outline as Outline
  import qualified Elm.Package as Pkg
  import qualified Elm.Version as V
  import qualified Http
  import qualified Reporting
  import Reporting.Doc ((<>), (<+>))
  import qualified Reporting.Doc as D
  import qualified Reporting.Exit as Exit
  import qualified Reporting.Exit.Help as Help
  import qualified Reporting.Render.Type.Localizer as L
  import qualified Reporting.Task as Task
  import qualified Stuff
  
  
  
  -- RUN
  
  
  data Args
    = CodeVsLatest
    | CodeVsExactly V.Version
    | LocalInquiry V.Version V.Version
    | GlobalInquiry Pkg.Name V.Version V.Version
  
  
  run :: Args -> () -> IO ()
  run args () =
    Reporting.attempt Exit.diffToReport $
      Task.run $
        do  env <- getEnv
            diff env args
  
  
  
  -- ENVIRONMENT
  
  
  data Env =
    Env
      { _maybeRoot :: Maybe FilePath
      , _cache :: Stuff.PackageCache
      , _manager :: Http.Manager
      , _registry :: Registry.Registry
      }
  
  
  getEnv :: Task Env
  getEnv =
    do  maybeRoot <- Task.io $ Stuff.findRoot
        cache     <- Task.io $ Stuff.getPackageCache
        manager   <- Task.io $ Http.getManager
        registry  <- Task.eio Exit.DiffMustHaveLatestRegistry $ Registry.latest manager cache
        return (Env maybeRoot cache manager registry)
  
  
  
  -- DIFF
  
  
  type Task a =
    Task.Task Exit.Diff a
  
  
  diff :: Env -> Args -> Task ()
  diff env@(Env _ _ _ registry) args =
    case args of
      GlobalInquiry name v1 v2 ->
        case Registry.getVersions' name registry of
          Right vsns ->
            do  oldDocs <- getDocs env name vsns (min v1 v2)
                newDocs <- getDocs env name vsns (max v1 v2)
                writeDiff oldDocs newDocs
  
          Left suggestions ->
            Task.throw $ Exit.DiffUnknownPackage name suggestions
  
      LocalInquiry v1 v2 ->
        do  (name, vsns) <- readOutline env
            oldDocs <- getDocs env name vsns (min v1 v2)
            newDocs <- getDocs env name vsns (max v1 v2)
            writeDiff oldDocs newDocs
  
      CodeVsLatest ->
        do  (name, vsns) <- readOutline env
            oldDocs <- getLatestDocs env name vsns
            newDocs <- generateDocs env
            writeDiff oldDocs newDocs
  
      CodeVsExactly version ->
        do  (name, vsns) <- readOutline env
            oldDocs <- getDocs env name vsns version
            newDocs <- generateDocs env
            writeDiff oldDocs newDocs
  
  
  
  -- GET DOCS
  
  
  getDocs :: Env -> Pkg.Name -> Registry.KnownVersions -> V.Version -> Task Docs.Documentation
  getDocs (Env _ cache manager _) name (Registry.KnownVersions latest previous) version =
    if latest == version || elem version previous
    then Task.eio (Exit.DiffDocsProblem version) $ DD.getDocs cache manager name version
    else Task.throw $ Exit.DiffUnknownVersion name version (latest:previous)
  
  
  getLatestDocs :: Env -> Pkg.Name -> Registry.KnownVersions -> Task Docs.Documentation
  getLatestDocs (Env _ cache manager _) name (Registry.KnownVersions latest _) =
    Task.eio (Exit.DiffDocsProblem latest) $ DD.getDocs cache manager name latest
  
  
  
  -- READ OUTLINE
  
  
  readOutline :: Env -> Task (Pkg.Name, Registry.KnownVersions)
  readOutline (Env maybeRoot _ _ registry) =
    case maybeRoot of
      Nothing ->
        Task.throw $ Exit.DiffNoOutline
  
      Just root ->
        do  result <- Task.io $ Outline.read root False
            case result of
              Left err ->
                Task.throw $ Exit.DiffBadOutline err
  
              Right outline ->
                case outline of
                  Outline.App _ ->
                    Task.throw $ Exit.DiffApplication
  
                  Outline.Pkg (Outline.PkgOutline pkg _ _ _ _ _ _ _) ->
                    case Registry.getVersions pkg registry of
                      Just vsns -> return (pkg, vsns)
                      Nothing   -> Task.throw Exit.DiffUnpublished
  
  
  
  -- GENERATE DOCS
  
  
  generateDocs :: Env -> Task Docs.Documentation
  generateDocs (Env maybeRoot _ _ _) =
    case maybeRoot of
      Nothing ->
        Task.throw $ Exit.DiffNoOutline
  
      Just root ->
        do  details <-
              Task.eio Exit.DiffBadDetails $ BW.withScope $ \scope ->
                Details.load Reporting.silent scope root
  
            case Details._outline details of
              Details.ValidApp _ ->
                Task.throw $ Exit.DiffApplication
  
              Details.ValidPkg _ exposed _ ->
                case exposed of
                  [] ->
                    Task.throw $ Exit.DiffNoExposed
  
                  e:es ->
                    Task.eio Exit.DiffBadBuild $
                      Build.fromExposed Reporting.silent root details Build.KeepDocs (NE.List e es)
  
  
  
  -- WRITE DIFF
  
  
  writeDiff :: Docs.Documentation -> Docs.Documentation -> Task ()
  writeDiff oldDocs newDocs =
    let
      changes = DD.diff oldDocs newDocs
      localizer = L.fromNames (Map.union oldDocs newDocs)
    in
    Task.io $ Help.toStdout $ toDoc localizer changes <> "\n"
  
  
  
  -- TO DOC
  
  
  toDoc :: L.Localizer -> PackageChanges -> D.Doc
  toDoc localizer changes@(PackageChanges added changed removed) =
    if null added && Map.null changed && null removed then
      "No API changes detected, so this is a" <+> D.green "PATCH" <+> "change."
    else
      let
        magDoc =
          D.fromChars (M.toChars (DD.toMagnitude changes))
  
        header =
          "This is a" <+> D.green magDoc <+> "change."
  
        addedChunk =
          if null added then [] else
            [ Chunk "ADDED MODULES" M.MINOR $
                D.vcat $ map D.fromName added
            ]
  
        removedChunk =
          if null removed then [] else
            [ Chunk "REMOVED MODULES" M.MAJOR $
                D.vcat $ map D.fromName removed
            ]
  
        chunks =
          addedChunk ++ removedChunk ++ map (changesToChunk localizer) (Map.toList changed)
      in
        D.vcat (header : "" : map chunkToDoc chunks)
  
  
  data Chunk =
    Chunk
      { _title :: String
      , _magnitude :: M.Magnitude
      , _details :: D.Doc
      }
  
  
  chunkToDoc :: Chunk -> D.Doc
  chunkToDoc (Chunk title magnitude details) =
    let
      header =
        "----" <+> D.fromChars title <+> "-" <+> D.fromChars (M.toChars magnitude) <+> "----"
    in
      D.vcat
        [ D.dullcyan header
        , ""
        , D.indent 4 details
        , ""
        , ""
        ]
  
  
  changesToChunk :: L.Localizer -> (Name.Name, ModuleChanges) -> Chunk
  changesToChunk localizer (name, changes@(ModuleChanges unions aliases values binops)) =
    let
      magnitude =
        DD.moduleChangeMagnitude changes
  
      (unionAdd, unionChange, unionRemove) =
        changesToDocTriple (unionToDoc localizer) unions
  
      (aliasAdd, aliasChange, aliasRemove) =
        changesToDocTriple (aliasToDoc localizer) aliases
  
      (valueAdd, valueChange, valueRemove) =
        changesToDocTriple (valueToDoc localizer) values
  
      (binopAdd, binopChange, binopRemove) =
        changesToDocTriple (binopToDoc localizer) binops
    in
      Chunk (Name.toChars name) magnitude $
        D.vcat $ List.intersperse "" $ Maybe.catMaybes $
          [ changesToDoc "Added" unionAdd aliasAdd valueAdd binopAdd
          , changesToDoc "Removed" unionRemove aliasRemove valueRemove binopRemove
          , changesToDoc "Changed" unionChange aliasChange valueChange binopChange
          ]
  
  
  changesToDocTriple :: (k -> v -> D.Doc) -> Changes k v -> ([D.Doc], [D.Doc], [D.Doc])
  changesToDocTriple entryToDoc (Changes added changed removed) =
    let
      indented (name, value) =
        D.indent 4 (entryToDoc name value)
  
      diffed (name, (oldValue, newValue)) =
        D.vcat
          [ "  - " <> entryToDoc name oldValue
          , "  + " <> entryToDoc name newValue
          , ""
          ]
    in
      ( map indented (Map.toList added)
      , map diffed   (Map.toList changed)
      , map indented (Map.toList removed)
      )
  
  
  changesToDoc :: String -> [D.Doc] -> [D.Doc] -> [D.Doc] -> [D.Doc] -> Maybe D.Doc
  changesToDoc categoryName unions aliases values binops =
    if null unions && null aliases && null values && null binops then
      Nothing
  
    else
      Just $ D.vcat $
        D.fromChars categoryName <> ":" : unions ++ aliases ++ binops ++ values
  
  
  unionToDoc :: L.Localizer -> Name.Name -> Docs.Union -> D.Doc
  unionToDoc localizer name (Docs.Union _ tvars ctors) =
    let
      setup =
        "type" <+> D.fromName name <+> D.hsep (map D.fromName tvars)
  
      ctorDoc (ctor, tipes) =
        typeDoc localizer (Type.Type ctor tipes)
    in
      D.hang 4 (D.sep (setup : zipWith (<+>) ("=" : repeat "|") (map ctorDoc ctors)))
  
  
  aliasToDoc :: L.Localizer -> Name.Name -> Docs.Alias -> D.Doc
  aliasToDoc localizer name (Docs.Alias _ tvars tipe) =
    let
      declaration =
        "type" <+> "alias" <+> D.hsep (map D.fromName (name:tvars)) <+> "="
    in
      D.hang 4 (D.sep [ declaration, typeDoc localizer tipe ])
  
  
  valueToDoc :: L.Localizer -> Name.Name -> Docs.Value -> D.Doc
  valueToDoc localizer name (Docs.Value _ tipe) =
    D.hang 4 $ D.sep [ D.fromName name <+> ":", typeDoc localizer tipe ]
  
  
  binopToDoc :: L.Localizer -> Name.Name -> Docs.Binop -> D.Doc
  binopToDoc localizer name (Docs.Binop _ tipe associativity (Docs.Precedence n)) =
      "(" <> D.fromName name <> ")" <+> ":" <+> typeDoc localizer tipe <> D.black details
    where
      details =
        "    (" <> D.fromName assoc <> "/" <> D.fromInt n <> ")"
  
      assoc =
        case associativity of
          Docs.Left  -> "left"
          Docs.Non   -> "non"
          Docs.Right -> "right"
  
  
  typeDoc :: L.Localizer -> Type.Type -> D.Doc
  typeDoc localizer tipe =
    Type.toDoc localizer Type.None tipe
  