[
  {
    "path": ".github/CONTRIBUTING.md",
    "content": "# Contributing to Elm\n\nThanks helping with the development of Elm! This document describes the basic\nstandards for opening pull requests and making the review process as smooth as\npossible.\n\n\n## Expectations\n\n- Pull requests are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response.\n- Smaller pull requests are easier to review. To fix nine typos, nine specific issues will always go faster than one big one. Learn why [here](https://github.com/elm/expectations/blob/master/small-pull-requests.md).\n- Reviewers may not know as much as you about certain situations, so add links to supporting evidence for important claims, especially regarding standards for CSS, HTTP, URI, etc.\n\nFinally, please be patient with the core team. They are trying their best with limited resources!\n\n\n## Style Guide\n\n  * Haskell — conform to [these guidelines][haskell]\n  * JavaScript — use [Google's JS style guide][js]\n\n[haskell]: https://gist.github.com/evancz/0a1f3717c92fe71702be\n[js]: https://google.github.io/styleguide/javascriptguide.xml\n\n\n## Branches\n\n[The master branch][master] is the home of the next release of the compiler\nso new features and improvements get merged there. Most pull requests\nshould target this branch!\n\n[master]: http://github.com/elm-lang/elm/tree/master\n\n\n## Licensing\n\nNothing extra to do for this. The default on GitHub described [here](https://docs.github.com/en/github/site-policy/github-terms-of-service#6-contributions-under-repository-license) is that:\n\n> Whenever you add Content to a repository containing notice of a license, you license that Content under the same terms, and you agree that you have the right to license that Content under those terms. If you have a separate agreement to license that Content under different terms, such as a contributor license agreement, that agreement will supersede.\n\n\n"
  },
  {
    "path": ".github/ISSUE_TEMPLATE.md",
    "content": "\n**Quick Summary:** ???\n\n\n## SSCCE\n\n```elm\n\n```\n\n- **Elm:** ???\n- **Browser:** ???\n- **Operating System:** ???\n\n\n## Additional Details\n\n???"
  },
  {
    "path": ".github/PULL_REQUEST_TEMPLATE.md",
    "content": "\n**Quick Summary:** ???\n\n\n## SSCCE\n\n```elm\n\n```\n\n- **Elm:** ???\n- **Browser:** ???\n- **Operating System:** ???\n\n\n## Additional Details\n\n???\n"
  },
  {
    "path": ".github/workflows/set-issue-expectations.yml",
    "content": "name: Set Issue Expectations\non:\n  issues:\n    types: [opened]\njobs:\n  comment-on-issue:\n    name: Comment On Issue\n    runs-on: ubuntu-latest\n    steps:\n      - uses: actions/github@v1.0.0\n        env:\n          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}\n        with:\n          args: |\n            comment \"Thanks for reporting this! To set expectations:\n\n            - Issues are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response.\n            - Ask questions in a [community forum](https://elm-lang.org/community). You will get an answer quicker that way!\n            - If you experience something similar, open a new issue. [We like duplicates](https://github.com/elm/expectations/blob/master/duplicates.md).\n\n            Finally, please be patient with the core team. They are trying their best with limited resources.\"\n"
  },
  {
    "path": ".github/workflows/set-pull-expectations.yml",
    "content": "on:\n  pull_request_target:\n    types: [opened]\n\njobs:\n  comment-on-pull:\n    name: Comment On Pull\n    runs-on: ubuntu-latest\n    steps:\n      - uses: actions/github-script@v3\n        with:\n          github-token: ${{secrets.GITHUB_TOKEN}}\n          script: |\n            github.issues.createComment({\n              issue_number: context.issue.number,\n              owner: context.repo.owner,\n              repo: context.repo.repo,\n              body: \"Thanks for suggesting these code changes. To set expectations:\\n\\n- Pull requests are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response.\\n- Smaller pull requests are easier to review. To fix nine typos, nine specific issues will always go faster than one big one. Learn why [here](https://github.com/elm/expectations/blob/master/small-pull-requests.md).\\n- Reviewers may not know as much as you about certain situations, so add links to supporting evidence for important claims, especially regarding standards for CSS, HTTP, URI, etc.\\n\\nFinally, please be patient with the core team. They are trying their best with limited resources.\"\n            })\n"
  },
  {
    "path": ".gitignore",
    "content": "elm-stuff\ndist\ndist-newstyle\ncabal-dev\n.cabal-sandbox/\ncabal.sandbox.config\n.DS_Store\n*~\ntravis.log\n"
  },
  {
    "path": ".travis.yml",
    "content": "language: minimal\nservices: docker\n\nenv:\n  global:\n    - LINUX_ARCHIVE=binary-for-linux-64-bit.gz\n\nbefore_install:\n  - docker build -t elm -f installers/linux/Dockerfile .\n  - docker cp $(docker create elm):/usr/local/bin/elm .\n  - gzip -9 -c elm > $LINUX_ARCHIVE\n\ndeploy:\n  provider: releases\n  api_key:\n    secure: Yz2Lo4u9rZQ7Ee7ohAsrZpkqsYDUerCSMdSQIH8ryrf7phHhiloPEkTKsM+NupHqU/LEAVsunxbau4QrCEjA2vPavAPVk8cKomRUWK/YjbXHKa24hPkal2c+A2bnMQ6w3qYk/PjL9rW+Goq++/SNLcYZwHBV0Chl2blivMwWCSA=\n  file: $LINUX_ARCHIVE\n  skip_cleanup: true\n  on:\n    branch: master\n    tags: true\n\nnotifications:\n  email:\n    recipients:\n      - rlefevre@dmy.fr\n    on_success: change\n    on_failure: change\n"
  },
  {
    "path": "LICENSE",
    "content": "Copyright 2012-present Evan Czaplicki\n\nRedistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:\n\n1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS \"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n"
  },
  {
    "path": "README.md",
    "content": "# Elm\n\nA delightful language for reliable webapps.\n\nCheck out the [Home Page](http://elm-lang.org/), [Try Online](http://elm-lang.org/try), or [The Official Guide](http://guide.elm-lang.org/)\n\n\n<br>\n\n## Install\n\n✨ [Install](https://guide.elm-lang.org/install/elm.html) ✨\n\nFor multiple versions, previous versions, and uninstallation, see the instructions [here](https://github.com/elm/compiler/blob/master/installers/README.md).\n\n<br>\n\n## Help\n\nIf you are stuck, ask around on [the Elm slack channel][slack]. Folks are friendly and happy to help with questions!\n\n[slack]: http://elmlang.herokuapp.com/\n"
  },
  {
    "path": "builder/src/BackgroundWriter.hs",
    "content": "{-# LANGUAGE BangPatterns #-}\nmodule BackgroundWriter\n  ( Scope\n  , withScope\n  , writeBinary\n  )\n  where\n\n\nimport Control.Concurrent (forkIO)\nimport Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)\nimport qualified Data.Binary as Binary\nimport Data.Foldable (traverse_)\n\nimport qualified File\n\n\n\n-- BACKGROUND WRITER\n\n\nnewtype Scope =\n  Scope (MVar [MVar ()])\n\n\nwithScope :: (Scope -> IO a) -> IO a\nwithScope callback =\n  do  workList <- newMVar []\n      result <- callback (Scope workList)\n      mvars <- takeMVar workList\n      traverse_ takeMVar mvars\n      return result\n\n\nwriteBinary :: (Binary.Binary a) => Scope -> FilePath -> a -> IO ()\nwriteBinary (Scope workList) path value =\n  do  mvar <- newEmptyMVar\n      _ <- forkIO (File.writeBinary path value >> putMVar mvar ())\n      oldWork <- takeMVar workList\n      let !newWork = mvar:oldWork\n      putMVar workList newWork\n\n"
  },
  {
    "path": "builder/src/Build.hs",
    "content": "{-# OPTIONS_GHC -Wno-unused-do-bind #-}\n{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings #-}\nmodule Build\n  ( fromExposed\n  , fromPaths\n  , fromRepl\n  , Artifacts(..)\n  , Root(..)\n  , Module(..)\n  , CachedInterface(..)\n  , ReplArtifacts(..)\n  , DocsGoal(..)\n  , getRootNames\n  )\n  where\n\n\nimport Control.Concurrent (forkIO)\nimport Control.Concurrent.MVar\nimport Control.Monad (filterM)\nimport qualified Data.ByteString as B\nimport qualified Data.Char as Char\nimport qualified Data.Graph as Graph\nimport qualified Data.List as List\nimport qualified Data.Map.Utils as Map\nimport qualified Data.Map.Strict as Map\nimport Data.Map.Strict ((!))\nimport qualified Data.Maybe as Maybe\nimport qualified Data.Name as Name\nimport qualified Data.NonEmptyList as NE\nimport qualified Data.OneOrMore as OneOrMore\nimport qualified Data.Set as Set\nimport qualified System.Directory as Dir\nimport qualified System.FilePath as FP\nimport System.FilePath ((</>), (<.>))\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Source as Src\nimport qualified AST.Optimized as Opt\nimport qualified Compile\nimport qualified Elm.Details as Details\nimport qualified Elm.Docs as Docs\nimport qualified Elm.Interface as I\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Outline as Outline\nimport qualified Elm.Package as Pkg\nimport qualified File\nimport qualified Json.Encode as E\nimport qualified Parse.Module as Parse\nimport qualified Reporting\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error as Error\nimport qualified Reporting.Error.Docs as EDocs\nimport qualified Reporting.Error.Syntax as Syntax\nimport qualified Reporting.Error.Import as Import\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Render.Type.Localizer as L\nimport qualified Stuff\n\n\n\n-- ENVIRONMENT\n\n\ndata Env =\n  Env\n    { _key :: Reporting.BKey\n    , _root :: FilePath\n    , _project :: Parse.ProjectType\n    , _srcDirs :: [AbsoluteSrcDir]\n    , _buildID :: Details.BuildID\n    , _locals :: Map.Map ModuleName.Raw Details.Local\n    , _foreigns :: Map.Map ModuleName.Raw Details.Foreign\n    }\n\n\nmakeEnv :: Reporting.BKey -> FilePath -> Details.Details -> IO Env\nmakeEnv key root (Details.Details _ validOutline buildID locals foreigns _) =\n  case validOutline of\n    Details.ValidApp givenSrcDirs ->\n      do  srcDirs <- traverse (toAbsoluteSrcDir root) (NE.toList givenSrcDirs)\n          return $ Env key root Parse.Application srcDirs buildID locals foreigns\n\n    Details.ValidPkg pkg _ _ ->\n      do  srcDir <- toAbsoluteSrcDir root (Outline.RelativeSrcDir \"src\")\n          return $ Env key root (Parse.Package pkg) [srcDir] buildID locals foreigns\n\n\n\n-- SOURCE DIRECTORY\n\n\nnewtype AbsoluteSrcDir =\n  AbsoluteSrcDir FilePath\n\n\ntoAbsoluteSrcDir :: FilePath -> Outline.SrcDir -> IO AbsoluteSrcDir\ntoAbsoluteSrcDir root srcDir =\n  AbsoluteSrcDir <$> Dir.canonicalizePath\n    (\n      case srcDir of\n        Outline.AbsoluteSrcDir dir -> dir\n        Outline.RelativeSrcDir dir -> root </> dir\n    )\n\n\naddRelative :: AbsoluteSrcDir -> FilePath -> FilePath\naddRelative (AbsoluteSrcDir srcDir) path =\n  srcDir </> path\n\n\n\n-- FORK\n\n\n-- PERF try using IORef semephore on file crawl phase?\n-- described in Chapter 13 of Parallel and Concurrent Programming in Haskell by Simon Marlow\n-- https://www.oreilly.com/library/view/parallel-and-concurrent/9781449335939/ch13.html#sec_conc-par-overhead\n--\nfork :: IO a -> IO (MVar a)\nfork work =\n  do  mvar <- newEmptyMVar\n      _ <- forkIO $ putMVar mvar =<< work\n      return mvar\n\n\n{-# INLINE forkWithKey #-}\nforkWithKey :: (k -> a -> IO b) -> Map.Map k a -> IO (Map.Map k (MVar b))\nforkWithKey func dict =\n  Map.traverseWithKey (\\k v -> fork (func k v)) dict\n\n\n\n-- FROM EXPOSED\n\n\nfromExposed :: Reporting.Style -> FilePath -> Details.Details -> DocsGoal docs -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem docs)\nfromExposed style root details docsGoal exposed@(NE.List e es) =\n  Reporting.trackBuild style $ \\key ->\n  do  env <- makeEnv key root details\n      dmvar <- Details.loadInterfaces root details\n\n      -- crawl\n      mvar <- newEmptyMVar\n      let docsNeed = toDocsNeed docsGoal\n      roots <- Map.fromKeysA (fork . crawlModule env mvar docsNeed) (e:es)\n      putMVar mvar roots\n      mapM_ readMVar roots\n      statuses <- traverse readMVar =<< readMVar mvar\n\n      -- compile\n      midpoint <- checkMidpoint dmvar statuses\n      case midpoint of\n        Left problem ->\n          return (Left (Exit.BuildProjectProblem problem))\n\n        Right foreigns ->\n          do  rmvar <- newEmptyMVar\n              resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses\n              putMVar rmvar resultMVars\n              results <- traverse readMVar resultMVars\n              writeDetails root details results\n              finalizeExposed root docsGoal exposed results\n\n\n\n-- FROM PATHS\n\n\ndata Artifacts =\n  Artifacts\n    { _name :: Pkg.Name\n    , _deps :: Dependencies\n    , _roots :: NE.List Root\n    , _modules :: [Module]\n    }\n\n\ndata Module\n  = Fresh ModuleName.Raw I.Interface Opt.LocalGraph\n  | Cached ModuleName.Raw Bool (MVar CachedInterface)\n\n\ntype Dependencies =\n  Map.Map ModuleName.Canonical I.DependencyInterface\n\n\nfromPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)\nfromPaths style root details paths =\n  Reporting.trackBuild style $ \\key ->\n  do  env <- makeEnv key root details\n\n      elroots <- findRoots env paths\n      case elroots of\n        Left problem ->\n          return (Left (Exit.BuildProjectProblem problem))\n\n        Right lroots ->\n          do  -- crawl\n              dmvar <- Details.loadInterfaces root details\n              smvar <- newMVar Map.empty\n              srootMVars <- traverse (fork . crawlRoot env smvar) lroots\n              sroots <- traverse readMVar srootMVars\n              statuses <- traverse readMVar =<< readMVar smvar\n\n              midpoint <- checkMidpointAndRoots dmvar statuses sroots\n              case midpoint of\n                Left problem ->\n                  return (Left (Exit.BuildProjectProblem problem))\n\n                Right foreigns ->\n                  do  -- compile\n                      rmvar <- newEmptyMVar\n                      resultsMVars <- forkWithKey (checkModule env foreigns rmvar) statuses\n                      putMVar rmvar resultsMVars\n                      rrootMVars <- traverse (fork . checkRoot env resultsMVars) sroots\n                      results <- traverse readMVar resultsMVars\n                      writeDetails root details results\n                      toArtifacts env foreigns results <$> traverse readMVar rrootMVars\n\n\n\n-- GET ROOT NAMES\n\n\ngetRootNames :: Artifacts -> NE.List ModuleName.Raw\ngetRootNames (Artifacts _ _ roots _) =\n  fmap getRootName roots\n\n\ngetRootName :: Root -> ModuleName.Raw\ngetRootName root =\n  case root of\n    Inside  name     -> name\n    Outside name _ _ -> name\n\n\n\n-- CRAWL\n\n\ntype StatusDict =\n  Map.Map ModuleName.Raw (MVar Status)\n\n\ndata Status\n  = SCached Details.Local\n  | SChanged Details.Local B.ByteString Src.Module DocsNeed\n  | SBadImport Import.Problem\n  | SBadSyntax FilePath File.Time B.ByteString Syntax.Error\n  | SForeign Pkg.Name\n  | SKernel\n\n\ncrawlDeps :: Env -> MVar StatusDict -> [ModuleName.Raw] -> a -> IO a\ncrawlDeps env mvar deps blockedValue =\n  do  statusDict <- takeMVar mvar\n      let depsDict = Map.fromKeys (\\_ -> ()) deps\n      let newsDict = Map.difference depsDict statusDict\n      statuses <- Map.traverseWithKey crawlNew newsDict\n      putMVar mvar (Map.union statuses statusDict)\n      mapM_ readMVar statuses\n      return blockedValue\n  where\n    crawlNew name () = fork (crawlModule env mvar (DocsNeed False) name)\n\n\ncrawlModule :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> IO Status\ncrawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar docsNeed name =\n  do  let fileName = ModuleName.toFilePath name <.> \"elm\"\n\n      paths <- filterM File.exists (map (`addRelative` fileName) srcDirs)\n\n      case paths of\n        [path] ->\n          case Map.lookup name foreigns of\n            Just (Details.Foreign dep deps) ->\n              return $ SBadImport $ Import.Ambiguous path [] dep deps\n\n            Nothing ->\n              do  newTime <- File.getTime path\n                  case Map.lookup name locals of\n                    Nothing ->\n                      crawlFile env mvar docsNeed name path newTime buildID\n\n                    Just local@(Details.Local oldPath oldTime deps _ lastChange _) ->\n                      if path /= oldPath || oldTime /= newTime || needsDocs docsNeed\n                      then crawlFile env mvar docsNeed name path newTime lastChange\n                      else crawlDeps env mvar deps (SCached local)\n\n        p1:p2:ps ->\n          return $ SBadImport $ Import.AmbiguousLocal (FP.makeRelative root p1) (FP.makeRelative root p2) (map (FP.makeRelative root) ps)\n\n        [] ->\n          case Map.lookup name foreigns of\n            Just (Details.Foreign dep deps) ->\n              case deps of\n                [] ->\n                  return $ SForeign dep\n\n                d:ds ->\n                  return $ SBadImport $ Import.AmbiguousForeign dep d ds\n\n            Nothing ->\n              if Name.isKernel name && Parse.isKernel projectType then\n                do  exists <- File.exists (\"src\" </> ModuleName.toFilePath name <.> \"js\")\n                    return $ if exists then SKernel else SBadImport Import.NotFound\n              else\n                return $ SBadImport Import.NotFound\n\n\ncrawlFile :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> FilePath -> File.Time -> Details.BuildID -> IO Status\ncrawlFile env@(Env _ root projectType _ buildID _ _) mvar docsNeed expectedName path time lastChange =\n  do  source <- File.readUtf8 (root </> path)\n\n      case Parse.fromByteString projectType source of\n        Left err ->\n          return $ SBadSyntax path time source err\n\n        Right modul@(Src.Module maybeActualName _ _ imports values _ _ _ _) ->\n          case maybeActualName of\n            Nothing ->\n              return $ SBadSyntax path time source (Syntax.ModuleNameUnspecified expectedName)\n\n            Just name@(A.At _ actualName) ->\n              if expectedName == actualName then\n                let\n                  deps = map Src.getImportName imports\n                  local = Details.Local path time deps (any isMain values) lastChange buildID\n                in\n                crawlDeps env mvar deps (SChanged local source modul docsNeed)\n              else\n                return $ SBadSyntax path time source (Syntax.ModuleNameMismatch expectedName name)\n\n\nisMain :: A.Located Src.Value -> Bool\nisMain (A.At _ (Src.Value (A.At _ name) _ _ _)) =\n  name == Name._main\n\n\n\n-- CHECK MODULE\n\n\ntype ResultDict =\n  Map.Map ModuleName.Raw (MVar Result)\n\n\ndata Result\n  = RNew !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)\n  | RSame !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)\n  | RCached Bool Details.BuildID (MVar CachedInterface)\n  | RNotFound Import.Problem\n  | RProblem Error.Module\n  | RBlocked\n  | RForeign I.Interface\n  | RKernel\n\n\ndata CachedInterface\n  = Unneeded\n  | Loaded I.Interface\n  | Corrupted\n\n\ncheckModule :: Env -> Dependencies -> MVar ResultDict -> ModuleName.Raw -> Status -> IO Result\ncheckModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name status =\n  case status of\n    SCached local@(Details.Local path time deps hasMain lastChange lastCompile) ->\n      do  results <- readMVar resultsMVar\n          depsStatus <- checkDeps root results deps lastCompile\n          case depsStatus of\n            DepsChange ifaces ->\n              do  source <- File.readUtf8 path\n                  case Parse.fromByteString projectType source of\n                    Right modul -> compile env (DocsNeed False) local source ifaces modul\n                    Left err ->\n                      return $ RProblem $\n                        Error.Module name path time source (Error.BadSyntax err)\n\n            DepsSame _ _ ->\n              do  mvar <- newMVar Unneeded\n                  return (RCached hasMain lastChange mvar)\n\n            DepsBlock ->\n              return RBlocked\n\n            DepsNotFound problems ->\n              do  source <- File.readUtf8 path\n                  return $ RProblem $ Error.Module name path time source $\n                    case Parse.fromByteString projectType source of\n                      Right (Src.Module _ _ _ imports _ _ _ _ _) ->\n                         Error.BadImports (toImportErrors env results imports problems)\n\n                      Left err ->\n                        Error.BadSyntax err\n\n    SChanged local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _) docsNeed ->\n      do  results <- readMVar resultsMVar\n          depsStatus <- checkDeps root results deps lastCompile\n          case depsStatus of\n            DepsChange ifaces ->\n              compile env docsNeed local source ifaces modul\n\n            DepsSame same cached ->\n              do  maybeLoaded <- loadInterfaces root same cached\n                  case maybeLoaded of\n                    Nothing     -> return RBlocked\n                    Just ifaces -> compile env docsNeed local source ifaces modul\n\n            DepsBlock ->\n              return RBlocked\n\n            DepsNotFound problems ->\n              return $ RProblem $ Error.Module name path time source $\n                Error.BadImports (toImportErrors env results imports problems)\n\n    SBadImport importProblem ->\n      return (RNotFound importProblem)\n\n    SBadSyntax path time source err ->\n      return $ RProblem $ Error.Module name path time source $\n        Error.BadSyntax err\n\n    SForeign home ->\n      case foreigns ! ModuleName.Canonical home name of\n        I.Public iface -> return (RForeign iface)\n        I.Private _ _ _ -> error $ \"mistakenly seeing private interface for \" ++ Pkg.toChars home ++ \" \" ++ ModuleName.toChars name\n\n    SKernel ->\n      return RKernel\n\n\n\n-- CHECK DEPS\n\n\ndata DepsStatus\n  = DepsChange (Map.Map ModuleName.Raw I.Interface)\n  | DepsSame [Dep] [CDep]\n  | DepsBlock\n  | DepsNotFound (NE.List (ModuleName.Raw, Import.Problem))\n\n\ncheckDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> Details.BuildID -> IO DepsStatus\ncheckDeps root results deps lastCompile =\n  checkDepsHelp root results deps [] [] [] [] False 0 lastCompile\n\n\ntype Dep = (ModuleName.Raw, I.Interface)\ntype CDep = (ModuleName.Raw, MVar CachedInterface)\n\n\ncheckDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> [(ModuleName.Raw,Import.Problem)] -> Bool -> Details.BuildID -> Details.BuildID -> IO DepsStatus\ncheckDepsHelp root results deps new same cached importProblems isBlocked lastDepChange lastCompile =\n  case deps of\n    dep:otherDeps ->\n      do  result <- readMVar (results ! dep)\n          case result of\n            RNew (Details.Local _ _ _ _ lastChange _) iface _ _ ->\n              checkDepsHelp root results otherDeps ((dep,iface) : new) same cached importProblems isBlocked (max lastChange lastDepChange) lastCompile\n\n            RSame (Details.Local _ _ _ _ lastChange _) iface _ _ ->\n              checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked (max lastChange lastDepChange) lastCompile\n\n            RCached _ lastChange mvar ->\n              checkDepsHelp root results otherDeps new same ((dep,mvar) : cached) importProblems isBlocked (max lastChange lastDepChange) lastCompile\n\n            RNotFound prob ->\n              checkDepsHelp root results otherDeps new same cached ((dep,prob) : importProblems) True lastDepChange lastCompile\n\n            RProblem _ ->\n              checkDepsHelp root results otherDeps new same cached importProblems True lastDepChange lastCompile\n\n            RBlocked ->\n              checkDepsHelp root results otherDeps new same cached importProblems True lastDepChange lastCompile\n\n            RForeign iface ->\n              checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked lastDepChange lastCompile\n\n            RKernel ->\n              checkDepsHelp root results otherDeps new same cached importProblems isBlocked lastDepChange lastCompile\n\n\n    [] ->\n      case reverse importProblems of\n        p:ps ->\n          return $ DepsNotFound (NE.List p ps)\n\n        [] ->\n          if isBlocked then\n            return $ DepsBlock\n\n          else if null new && lastDepChange <= lastCompile then\n            return $ DepsSame same cached\n\n          else\n            do  maybeLoaded <- loadInterfaces root same cached\n                case maybeLoaded of\n                  Nothing     -> return DepsBlock\n                  Just ifaces -> return $ DepsChange $ Map.union (Map.fromList new) ifaces\n\n\n\n-- TO IMPORT ERROR\n\n\ntoImportErrors :: Env -> ResultDict -> [Src.Import] -> NE.List (ModuleName.Raw, Import.Problem) -> NE.List Import.Error\ntoImportErrors (Env _ _ _ _ _ locals foreigns) results imports problems =\n  let\n    knownModules =\n      Set.unions\n        [ Map.keysSet foreigns\n        , Map.keysSet locals\n        , Map.keysSet results\n        ]\n\n    unimportedModules =\n      Set.difference knownModules (Set.fromList (map Src.getImportName imports))\n\n    regionDict =\n      Map.fromList (map (\\(Src.Import (A.At region name) _ _) -> (name, region)) imports)\n\n    toError (name, problem) =\n      Import.Error (regionDict ! name) name unimportedModules problem\n  in\n  fmap toError problems\n\n\n\n-- LOAD CACHED INTERFACES\n\n\nloadInterfaces :: FilePath -> [Dep] -> [CDep] -> IO (Maybe (Map.Map ModuleName.Raw I.Interface))\nloadInterfaces root same cached =\n  do  loading <- traverse (fork . loadInterface root) cached\n      maybeLoaded <- traverse readMVar loading\n      case sequence maybeLoaded of\n        Nothing ->\n          return Nothing\n\n        Just loaded ->\n          return $ Just $ Map.union (Map.fromList loaded) (Map.fromList same)\n\n\nloadInterface :: FilePath -> CDep -> IO (Maybe Dep)\nloadInterface root (name, ciMvar) =\n  do  cachedInterface <- takeMVar ciMvar\n      case cachedInterface of\n        Corrupted ->\n          do  putMVar ciMvar cachedInterface\n              return Nothing\n\n        Loaded iface ->\n          do  putMVar ciMvar cachedInterface\n              return (Just (name, iface))\n\n        Unneeded ->\n          do  maybeIface <- File.readBinary (Stuff.elmi root name)\n              case maybeIface of\n                Nothing ->\n                  do  putMVar ciMvar Corrupted\n                      return Nothing\n\n                Just iface ->\n                  do  putMVar ciMvar (Loaded iface)\n                      return (Just (name, iface))\n\n\n\n-- CHECK PROJECT\n\n\ncheckMidpoint :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> IO (Either Exit.BuildProjectProblem Dependencies)\ncheckMidpoint dmvar statuses =\n  case checkForCycles statuses of\n    Nothing ->\n      do  maybeForeigns <- readMVar dmvar\n          case maybeForeigns of\n            Nothing -> return (Left Exit.BP_CannotLoadDependencies)\n            Just fs -> return (Right fs)\n\n    Just (NE.List name names) ->\n      do  _ <- readMVar dmvar\n          return (Left (Exit.BP_Cycle name names))\n\n\ncheckMidpointAndRoots :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List RootStatus -> IO (Either Exit.BuildProjectProblem Dependencies)\ncheckMidpointAndRoots dmvar statuses sroots =\n  case checkForCycles statuses of\n    Nothing ->\n      case checkUniqueRoots statuses sroots of\n        Nothing ->\n          do  maybeForeigns <- readMVar dmvar\n              case maybeForeigns of\n                Nothing -> return (Left Exit.BP_CannotLoadDependencies)\n                Just fs -> return (Right fs)\n\n        Just problem ->\n          do  _ <- readMVar dmvar\n              return (Left problem)\n\n    Just (NE.List name names) ->\n      do  _ <- readMVar dmvar\n          return (Left (Exit.BP_Cycle name names))\n\n\n\n-- CHECK FOR CYCLES\n\n\ncheckForCycles :: Map.Map ModuleName.Raw Status -> Maybe (NE.List ModuleName.Raw)\ncheckForCycles modules =\n  let\n    !graph = Map.foldrWithKey addToGraph [] modules\n    !sccs = Graph.stronglyConnComp graph\n  in\n  checkForCyclesHelp sccs\n\n\ncheckForCyclesHelp :: [Graph.SCC ModuleName.Raw] -> Maybe (NE.List ModuleName.Raw)\ncheckForCyclesHelp sccs =\n  case sccs of\n    [] ->\n      Nothing\n\n    scc:otherSccs ->\n      case scc of\n        Graph.AcyclicSCC _     -> checkForCyclesHelp otherSccs\n        Graph.CyclicSCC []     -> checkForCyclesHelp otherSccs\n        Graph.CyclicSCC (m:ms) -> Just (NE.List m ms)\n\n\ntype Node =\n  ( ModuleName.Raw, ModuleName.Raw, [ModuleName.Raw] )\n\n\naddToGraph :: ModuleName.Raw -> Status -> [Node] -> [Node]\naddToGraph name status graph =\n  let\n    dependencies =\n      case status of\n        SCached  (Details.Local _ _ deps _ _ _)       -> deps\n        SChanged (Details.Local _ _ deps _ _ _) _ _ _ -> deps\n        SBadImport _                                  -> []\n        SBadSyntax _ _ _ _                            -> []\n        SForeign _                                    -> []\n        SKernel                                       -> []\n  in\n  (name, name, dependencies) : graph\n\n\n\n-- CHECK UNIQUE ROOTS\n\n\ncheckUniqueRoots :: Map.Map ModuleName.Raw Status -> NE.List RootStatus -> Maybe Exit.BuildProjectProblem\ncheckUniqueRoots insides sroots =\n  let\n    outsidesDict =\n      Map.fromListWith OneOrMore.more (Maybe.mapMaybe rootStatusToNamePathPair (NE.toList sroots))\n  in\n  case Map.traverseWithKey checkOutside outsidesDict of\n    Left problem ->\n      Just problem\n\n    Right outsides ->\n      case sequence_ (Map.intersectionWithKey checkInside outsides insides) of\n        Right ()     -> Nothing\n        Left problem -> Just problem\n\n\nrootStatusToNamePathPair :: RootStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)\nrootStatusToNamePathPair sroot =\n  case sroot of\n    SInside _                                         -> Nothing\n    SOutsideOk (Details.Local path _ _ _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)\n    SOutsideErr _                                     -> Nothing\n\n\ncheckOutside :: ModuleName.Raw -> OneOrMore.OneOrMore FilePath -> Either Exit.BuildProjectProblem FilePath\ncheckOutside name paths =\n  case OneOrMore.destruct NE.List paths of\n    NE.List p  []     -> Right p\n    NE.List p1 (p2:_) -> Left (Exit.BP_RootNameDuplicate name p1 p2)\n\n\ncheckInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()\ncheckInside name p1 status =\n  case status of\n    SCached  (Details.Local p2 _ _ _ _ _)       -> Left (Exit.BP_RootNameDuplicate name p1 p2)\n    SChanged (Details.Local p2 _ _ _ _ _) _ _ _ -> Left (Exit.BP_RootNameDuplicate name p1 p2)\n    SBadImport _                                -> Right ()\n    SBadSyntax _ _ _ _                          -> Right ()\n    SForeign _                                  -> Right ()\n    SKernel                                     -> Right ()\n\n\n\n-- COMPILE MODULE\n\n\ncompile :: Env -> DocsNeed -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result\ncompile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path time deps main lastChange _) source ifaces modul =\n  let\n    pkg = projectTypeToPkg projectType\n  in\n  case Compile.compile pkg ifaces modul of\n    Right (Compile.Artifacts canonical annotations objects) ->\n      case makeDocs docsNeed canonical of\n        Left err ->\n          return $ RProblem $\n            Error.Module (Src.getName modul) path time source (Error.BadDocs err)\n\n        Right docs ->\n          do  let name = Src.getName modul\n              let iface = I.fromModule pkg canonical annotations\n              let elmi = Stuff.elmi root name\n              File.writeBinary (Stuff.elmo root name) objects\n              maybeOldi <- File.readBinary elmi\n              case maybeOldi of\n                Just oldi | oldi == iface ->\n                  do  -- iface should be fully forced by equality check\n                      Reporting.report key Reporting.BDone\n                      let local = Details.Local path time deps main lastChange buildID\n                      return (RSame local iface objects docs)\n\n                _ ->\n                  do  -- iface may be lazy still\n                      File.writeBinary elmi iface\n                      Reporting.report key Reporting.BDone\n                      let local = Details.Local path time deps main buildID buildID\n                      return (RNew local iface objects docs)\n\n    Left err ->\n      return $ RProblem $\n        Error.Module (Src.getName modul) path time source err\n\n\nprojectTypeToPkg :: Parse.ProjectType -> Pkg.Name\nprojectTypeToPkg projectType =\n  case projectType of\n    Parse.Package pkg -> pkg\n    Parse.Application -> Pkg.dummyName\n\n\n\n-- WRITE DETAILS\n\n\nwriteDetails :: FilePath -> Details.Details -> Map.Map ModuleName.Raw Result -> IO ()\nwriteDetails root (Details.Details time outline buildID locals foreigns extras) results =\n  File.writeBinary (Stuff.details root) $\n    Details.Details time outline buildID (Map.foldrWithKey addNewLocal locals results) foreigns extras\n\n\naddNewLocal :: ModuleName.Raw -> Result -> Map.Map ModuleName.Raw Details.Local -> Map.Map ModuleName.Raw Details.Local\naddNewLocal name result locals =\n  case result of\n    RNew  local _ _ _ -> Map.insert name local locals\n    RSame local _ _ _ -> Map.insert name local locals\n    RCached _ _ _     -> locals\n    RNotFound _       -> locals\n    RProblem _        -> locals\n    RBlocked          -> locals\n    RForeign _        -> locals\n    RKernel           -> locals\n\n\n\n-- FINALIZE EXPOSED\n\n\nfinalizeExposed :: FilePath -> DocsGoal docs -> NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> IO (Either Exit.BuildProblem docs)\nfinalizeExposed root docsGoal exposed results =\n  case foldr (addImportProblems results) [] (NE.toList exposed) of\n    p:ps ->\n      return $ Left $ Exit.BuildProjectProblem (Exit.BP_MissingExposed (NE.List p ps))\n\n    [] ->\n      case Map.foldr addErrors [] results of\n        []   -> Right <$> finalizeDocs docsGoal results\n        e:es -> return $ Left $ Exit.BuildBadModules root e es\n\n\naddErrors :: Result -> [Error.Module] -> [Error.Module]\naddErrors result errors =\n  case result of\n    RNew  _ _ _ _ ->   errors\n    RSame _ _ _ _ ->   errors\n    RCached _ _ _ ->   errors\n    RNotFound _   ->   errors\n    RProblem e    -> e:errors\n    RBlocked      ->   errors\n    RForeign _    ->   errors\n    RKernel       ->   errors\n\n\naddImportProblems :: Map.Map ModuleName.Raw Result -> ModuleName.Raw -> [(ModuleName.Raw, Import.Problem)] -> [(ModuleName.Raw, Import.Problem)]\naddImportProblems results name problems =\n  case results ! name of\n    RNew  _ _ _ _ -> problems\n    RSame _ _ _ _ -> problems\n    RCached _ _ _ -> problems\n    RNotFound p   -> (name, p) : problems\n    RProblem _    -> problems\n    RBlocked      -> problems\n    RForeign _    -> problems\n    RKernel       -> problems\n\n\n\n-- DOCS\n\n\ndata DocsGoal a where\n  KeepDocs :: DocsGoal Docs.Documentation\n  WriteDocs :: FilePath -> DocsGoal ()\n  IgnoreDocs :: DocsGoal ()\n\n\nnewtype DocsNeed =\n  DocsNeed { needsDocs :: Bool }\n\n\ntoDocsNeed :: DocsGoal a -> DocsNeed\ntoDocsNeed goal =\n  case goal of\n    IgnoreDocs  -> DocsNeed False\n    WriteDocs _ -> DocsNeed True\n    KeepDocs    -> DocsNeed True\n\n\nmakeDocs :: DocsNeed -> Can.Module -> Either EDocs.Error (Maybe Docs.Module)\nmakeDocs (DocsNeed isNeeded) modul =\n  if isNeeded then\n    case Docs.fromModule modul of\n      Right docs -> Right (Just docs)\n      Left err   -> Left err\n  else\n    Right Nothing\n\n\nfinalizeDocs :: DocsGoal docs -> Map.Map ModuleName.Raw Result -> IO docs\nfinalizeDocs goal results =\n  case goal of\n    KeepDocs ->\n      return $ Map.mapMaybe toDocs results\n\n    WriteDocs path ->\n      E.writeUgly path $ Docs.encode $ Map.mapMaybe toDocs results\n\n    IgnoreDocs ->\n      return ()\n\n\ntoDocs :: Result -> Maybe Docs.Module\ntoDocs result =\n  case result of\n    RNew  _ _ _ d -> d\n    RSame _ _ _ d -> d\n    RCached _ _ _ -> Nothing\n    RNotFound _   -> Nothing\n    RProblem _    -> Nothing\n    RBlocked      -> Nothing\n    RForeign _    -> Nothing\n    RKernel       -> Nothing\n\n\n\n--------------------------------------------------------------------------------\n------ NOW FOR SOME REPL STUFF -------------------------------------------------\n--------------------------------------------------------------------------------\n\n\n-- FROM REPL\n\n\ndata ReplArtifacts =\n  ReplArtifacts\n    { _repl_home :: ModuleName.Canonical\n    , _repl_modules :: [Module]\n    , _repl_localizer :: L.Localizer\n    , _repl_annotations :: Map.Map Name.Name Can.Annotation\n    }\n\n\nfromRepl :: FilePath -> Details.Details -> B.ByteString -> IO (Either Exit.Repl ReplArtifacts)\nfromRepl root details source =\n  do  env@(Env _ _ projectType _ _ _ _) <- makeEnv Reporting.ignorer root details\n      case Parse.fromByteString projectType source of\n        Left syntaxError ->\n          return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError\n\n        Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->\n          do  dmvar <- Details.loadInterfaces root details\n\n              let deps = map Src.getImportName imports\n              mvar <- newMVar Map.empty\n              crawlDeps env mvar deps ()\n\n              statuses <- traverse readMVar =<< readMVar mvar\n              midpoint <- checkMidpoint dmvar statuses\n\n              case midpoint of\n                Left problem ->\n                  return $ Left $ Exit.ReplProjectProblem problem\n\n                Right foreigns ->\n                  do  rmvar <- newEmptyMVar\n                      resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses\n                      putMVar rmvar resultMVars\n                      results <- traverse readMVar resultMVars\n                      writeDetails root details results\n                      depsStatus <- checkDeps root resultMVars deps 0\n                      finalizeReplArtifacts env source modul depsStatus resultMVars results\n\n\nfinalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)\nfinalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) depsStatus resultMVars results =\n  let\n    pkg =\n      projectTypeToPkg projectType\n\n    compileInput ifaces =\n      case Compile.compile pkg ifaces modul of\n        Right (Compile.Artifacts canonical annotations objects) ->\n          let\n            h = Can._name canonical\n            m = Fresh (Src.getName modul) (I.fromModule pkg canonical annotations) objects\n            ms = Map.foldrWithKey addInside [] results\n          in\n          return $ Right $ ReplArtifacts h (m:ms) (L.fromModule modul) annotations\n\n        Left errors ->\n          return $ Left $ Exit.ReplBadInput source errors\n  in\n  case depsStatus of\n    DepsChange ifaces ->\n      compileInput ifaces\n\n    DepsSame same cached ->\n      do  maybeLoaded <- loadInterfaces root same cached\n          case maybeLoaded of\n            Just ifaces -> compileInput ifaces\n            Nothing     -> return $ Left $ Exit.ReplBadCache\n\n    DepsBlock ->\n      case Map.foldr addErrors [] results of\n        []   -> return $ Left $ Exit.ReplBlocked\n        e:es -> return $ Left $ Exit.ReplBadLocalDeps root e es\n\n    DepsNotFound problems ->\n      return $ Left $ Exit.ReplBadInput source $ Error.BadImports $\n        toImportErrors env resultMVars imports problems\n\n\n\n--------------------------------------------------------------------------------\n--------------------------------------------------------------------------------\n------ AFTER THIS, EVERYTHING IS ABOUT HANDLING MODULES GIVEN BY FILEPATH ------\n--------------------------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n\n\n-- FIND ROOT\n\n\ndata RootLocation\n  = LInside ModuleName.Raw\n  | LOutside FilePath\n\n\nfindRoots :: Env -> NE.List FilePath -> IO (Either Exit.BuildProjectProblem (NE.List RootLocation))\nfindRoots env paths =\n  do  mvars <- traverse (fork . getRootInfo env) paths\n      einfos <- traverse readMVar mvars\n      return $ checkRoots =<< sequence einfos\n\n\ncheckRoots :: NE.List RootInfo -> Either Exit.BuildProjectProblem (NE.List RootLocation)\ncheckRoots infos =\n  let\n    toOneOrMore loc@(RootInfo absolute _ _) =\n      (absolute, OneOrMore.one loc)\n\n    fromOneOrMore loc locs =\n      case locs of\n        [] -> Right ()\n        loc2:_ -> Left (Exit.BP_MainPathDuplicate (_relative loc) (_relative loc2))\n  in\n  fmap (\\_ -> fmap _location infos) $\n    traverse (OneOrMore.destruct fromOneOrMore) $\n      Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList infos)\n\n\n\n-- ROOT INFO\n\n\ndata RootInfo =\n  RootInfo\n    { _absolute :: FilePath\n    , _relative :: FilePath\n    , _location :: RootLocation\n    }\n\n\ngetRootInfo :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)\ngetRootInfo env path =\n  do  exists <- File.exists path\n      if exists\n        then getRootInfoHelp env path =<< Dir.canonicalizePath path\n        else return (Left (Exit.BP_PathUnknown path))\n\n\ngetRootInfoHelp :: Env -> FilePath -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)\ngetRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath =\n  let\n    (dirs, file) = FP.splitFileName absolutePath\n    (final, ext) = FP.splitExtension file\n  in\n  if ext /= \".elm\"\n  then\n    return $ Left $ Exit.BP_WithBadExtension path\n  else\n    let\n      absoluteSegments = FP.splitDirectories dirs ++ [final]\n    in\n    case Maybe.mapMaybe (isInsideSrcDirByPath absoluteSegments) srcDirs of\n      [] ->\n        return $ Right $ RootInfo absolutePath path (LOutside path)\n\n      [(_, Right names)] ->\n        do  let name = Name.fromChars (List.intercalate \".\" names)\n            matchingDirs <- filterM (isInsideSrcDirByName names) srcDirs\n            case matchingDirs of\n              d1:d2:_ ->\n                do  let p1 = addRelative d1 (FP.joinPath names <.> \"elm\")\n                    let p2 = addRelative d2 (FP.joinPath names <.> \"elm\")\n                    return $ Left $ Exit.BP_RootNameDuplicate name p1 p2\n\n              _ ->\n                return $ Right $ RootInfo absolutePath path (LInside name)\n\n      [(s, Left names)] ->\n        return $ Left $ Exit.BP_RootNameInvalid path s names\n\n      (s1,_):(s2,_):_ ->\n        return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2\n\n\n\nisInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool\nisInsideSrcDirByName names srcDir =\n  File.exists (addRelative srcDir (FP.joinPath names <.> \"elm\"))\n\n\nisInsideSrcDirByPath :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String])\nisInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) =\n  case dropPrefix (FP.splitDirectories srcDir) segments of\n    Nothing ->\n      Nothing\n\n    Just names ->\n      if all isGoodName names\n      then Just (srcDir, Right names)\n      else Just (srcDir, Left names)\n\n\nisGoodName :: [Char] -> Bool\nisGoodName name =\n  case name of\n    [] ->\n      False\n\n    char:chars ->\n      Char.isUpper char && all (\\c -> Char.isAlphaNum c || c == '_') chars\n\n\n-- INVARIANT: Dir.canonicalizePath has been run on both inputs\n--\ndropPrefix :: [FilePath] -> [FilePath] -> Maybe [FilePath]\ndropPrefix roots paths =\n  case roots of\n    [] ->\n      Just paths\n\n    r:rs ->\n      case paths of\n        []   -> Nothing\n        p:ps -> if r == p then dropPrefix rs ps else Nothing\n\n\n\n-- CRAWL ROOTS\n\n\ndata RootStatus\n  = SInside ModuleName.Raw\n  | SOutsideOk Details.Local B.ByteString Src.Module\n  | SOutsideErr Error.Module\n\n\ncrawlRoot :: Env -> MVar StatusDict -> RootLocation -> IO RootStatus\ncrawlRoot env@(Env _ _ projectType _ buildID _ _) mvar root =\n  case root of\n    LInside name ->\n      do  statusMVar <- newEmptyMVar\n          statusDict <- takeMVar mvar\n          putMVar mvar (Map.insert name statusMVar statusDict)\n          putMVar statusMVar =<< crawlModule env mvar (DocsNeed False) name\n          return (SInside name)\n\n    LOutside path ->\n      do  time <- File.getTime path\n          source <- File.readUtf8 path\n          case Parse.fromByteString projectType source of\n            Right modul@(Src.Module _ _ _ imports values _ _ _ _) ->\n              do  let deps = map Src.getImportName imports\n                  let local = Details.Local path time deps (any isMain values) buildID buildID\n                  crawlDeps env mvar deps (SOutsideOk local source modul)\n\n            Left syntaxError ->\n              return $ SOutsideErr $\n                Error.Module \"???\" path time source (Error.BadSyntax syntaxError)\n\n\n\n-- CHECK ROOTS\n\n\ndata RootResult\n  = RInside ModuleName.Raw\n  | ROutsideOk ModuleName.Raw I.Interface Opt.LocalGraph\n  | ROutsideErr Error.Module\n  | ROutsideBlocked\n\n\ncheckRoot :: Env -> ResultDict -> RootStatus -> IO RootResult\ncheckRoot env@(Env _ root _ _ _ _ _) results rootStatus =\n  case rootStatus of\n    SInside name ->\n      return (RInside name)\n\n    SOutsideErr err ->\n      return (ROutsideErr err)\n\n    SOutsideOk local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _) ->\n      do  depsStatus <- checkDeps root results deps lastCompile\n          case depsStatus of\n            DepsChange ifaces ->\n              compileOutside env local source ifaces modul\n\n            DepsSame same cached ->\n              do  maybeLoaded <- loadInterfaces root same cached\n                  case maybeLoaded of\n                    Nothing     -> return ROutsideBlocked\n                    Just ifaces -> compileOutside env local source ifaces modul\n\n            DepsBlock ->\n              return ROutsideBlocked\n\n            DepsNotFound problems ->\n              return $ ROutsideErr $ Error.Module (Src.getName modul) path time source $\n                  Error.BadImports (toImportErrors env results imports problems)\n\n\ncompileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO RootResult\ncompileOutside (Env key _ projectType _ _ _ _) (Details.Local path time _ _ _ _) source ifaces modul =\n  let\n    pkg = projectTypeToPkg projectType\n    name = Src.getName modul\n  in\n  case Compile.compile pkg ifaces modul of\n    Right (Compile.Artifacts canonical annotations objects) ->\n      do  Reporting.report key Reporting.BDone\n          return $ ROutsideOk name (I.fromModule pkg canonical annotations) objects\n\n    Left errors ->\n      return $ ROutsideErr $ Error.Module name path time source errors\n\n\n\n-- TO ARTIFACTS\n\n\ndata Root\n  = Inside ModuleName.Raw\n  | Outside ModuleName.Raw I.Interface Opt.LocalGraph\n\n\ntoArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either Exit.BuildProblem Artifacts\ntoArtifacts (Env _ root projectType _ _ _ _) foreigns results rootResults =\n  case gatherProblemsOrMains results rootResults of\n    Left (NE.List e es) ->\n      Left (Exit.BuildBadModules root e es)\n\n    Right roots ->\n      Right $ Artifacts (projectTypeToPkg projectType) foreigns roots $\n        Map.foldrWithKey addInside (foldr addOutside [] rootResults) results\n\n\ngatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either (NE.List Error.Module) (NE.List Root)\ngatherProblemsOrMains results (NE.List rootResult rootResults) =\n  let\n    addResult result (es, roots) =\n      case result of\n        RInside n        -> (  es, Inside n      : roots)\n        ROutsideOk n i o -> (  es, Outside n i o : roots)\n        ROutsideErr e    -> (e:es,                 roots)\n        ROutsideBlocked  -> (  es,                 roots)\n\n    errors = Map.foldr addErrors [] results\n  in\n  case (rootResult, foldr addResult (errors, []) rootResults) of\n    (RInside n       , (  [], ms)) -> Right (NE.List (Inside n) ms)\n    (RInside _       , (e:es, _ )) -> Left  (NE.List e es)\n    (ROutsideOk n i o, (  [], ms)) -> Right (NE.List (Outside n i o) ms)\n    (ROutsideOk _ _ _, (e:es, _ )) -> Left  (NE.List e es)\n    (ROutsideErr e   , (  es, _ )) -> Left  (NE.List e es)\n    (ROutsideBlocked , (  [], _ )) -> error \"seems like elm-stuff/ is corrupted\"\n    (ROutsideBlocked , (e:es, _ )) -> Left  (NE.List e es)\n\n\naddInside :: ModuleName.Raw -> Result -> [Module] -> [Module]\naddInside name result modules =\n  case result of\n    RNew  _ iface objs _ -> Fresh name iface objs : modules\n    RSame _ iface objs _ -> Fresh name iface objs : modules\n    RCached main _ mvar  -> Cached name main mvar : modules\n    RNotFound _          -> error (badInside name)\n    RProblem _           -> error (badInside name)\n    RBlocked             -> error (badInside name)\n    RForeign _           -> modules\n    RKernel              -> modules\n\n\nbadInside :: ModuleName.Raw -> [Char]\nbadInside name =\n  \"Error from `\" ++ Name.toChars name ++ \"` should have been reported already.\"\n\n\naddOutside :: RootResult -> [Module] -> [Module]\naddOutside root modules =\n  case root of\n    RInside _                  -> modules\n    ROutsideOk name iface objs -> Fresh name iface objs : modules\n    ROutsideErr _              -> modules\n    ROutsideBlocked            -> modules\n"
  },
  {
    "path": "builder/src/Deps/Bump.hs",
    "content": "module Deps.Bump\n  ( getPossibilities\n  )\n  where\n\n\nimport qualified Data.List as List\n\nimport qualified Deps.Registry as Registry\nimport qualified Elm.Magnitude as M\nimport qualified Elm.Version as V\n\n\n\n-- GET POSSIBILITIES\n\n\ngetPossibilities :: Registry.KnownVersions -> [(V.Version, V.Version, M.Magnitude)]\ngetPossibilities (Registry.KnownVersions latest previous) =\n  let\n    allVersions = reverse (latest:previous)\n    minorPoints = map last (List.groupBy sameMajor allVersions)\n    patchPoints = map last (List.groupBy sameMinor allVersions)\n  in\n  (latest, V.bumpMajor latest, M.MAJOR)\n  :  map (\\v -> (v, V.bumpMinor v, M.MINOR)) minorPoints\n  ++ map (\\v -> (v, V.bumpPatch v, M.PATCH)) patchPoints\n\n\nsameMajor :: V.Version -> V.Version -> Bool\nsameMajor (V.Version major1 _ _) (V.Version major2 _ _) =\n  major1 == major2\n\n\nsameMinor :: V.Version -> V.Version -> Bool\nsameMinor (V.Version major1 minor1 _) (V.Version major2 minor2 _) =\n  major1 == major2 && minor1 == minor2\n"
  },
  {
    "path": "builder/src/Deps/Diff.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Deps.Diff\n  ( diff\n  , PackageChanges(..)\n  , ModuleChanges(..)\n  , Changes(..)\n  , moduleChangeMagnitude\n  , toMagnitude\n  , bump\n  , getDocs\n  )\n  where\n\n\nimport Control.Monad (zipWithM)\nimport Data.Function (on)\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\nimport qualified System.Directory as Dir\nimport System.FilePath ((</>))\n\nimport qualified Deps.Website as Website\nimport qualified Elm.Compiler.Type as Type\nimport qualified Elm.Docs as Docs\nimport qualified Elm.Magnitude as M\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified File\nimport qualified Http\nimport qualified Json.Decode as D\nimport qualified Reporting.Exit as Exit\nimport qualified Stuff\n\n\n\n-- CHANGES\n\n\ndata PackageChanges =\n  PackageChanges\n    { _modules_added :: [ModuleName.Raw]\n    , _modules_changed :: Map.Map ModuleName.Raw ModuleChanges\n    , _modules_removed :: [ModuleName.Raw]\n    }\n\n\ndata ModuleChanges =\n  ModuleChanges\n    { _unions :: Changes Name.Name Docs.Union\n    , _aliases :: Changes Name.Name Docs.Alias\n    , _values :: Changes Name.Name Docs.Value\n    , _binops :: Changes Name.Name Docs.Binop\n    }\n\n\ndata Changes k v =\n  Changes\n    { _added :: Map.Map k v\n    , _changed :: Map.Map k (v,v)\n    , _removed :: Map.Map k v\n    }\n\n\ngetChanges :: (Ord k) => (v -> v -> Bool) -> Map.Map k v -> Map.Map k v -> Changes k v\ngetChanges isEquivalent old new =\n  let\n    overlap = Map.intersectionWith (,) old new\n    changed = Map.filter (not . uncurry isEquivalent) overlap\n  in\n    Changes (Map.difference new old) changed (Map.difference old new)\n\n\n\n-- DIFF\n\n\ndiff :: Docs.Documentation -> Docs.Documentation -> PackageChanges\ndiff oldDocs newDocs =\n  let\n    filterOutPatches chngs =\n      Map.filter (\\chng -> moduleChangeMagnitude chng /= M.PATCH) chngs\n\n    (Changes added changed removed) =\n      getChanges (\\_ _ -> False) oldDocs newDocs\n  in\n    PackageChanges\n      (Map.keys added)\n      (filterOutPatches (Map.map diffModule changed))\n      (Map.keys removed)\n\n\n\ndiffModule :: (Docs.Module, Docs.Module) -> ModuleChanges\ndiffModule (Docs.Module _ _ u1 a1 v1 b1, Docs.Module _ _ u2 a2 v2 b2) =\n  ModuleChanges\n    (getChanges isEquivalentUnion u1 u2)\n    (getChanges isEquivalentAlias a1 a2)\n    (getChanges isEquivalentValue v1 v2)\n    (getChanges isEquivalentBinop b1 b2)\n\n\n\n-- EQUIVALENCE\n\n\nisEquivalentUnion :: Docs.Union -> Docs.Union -> Bool\nisEquivalentUnion (Docs.Union oldComment oldVars oldCtors) (Docs.Union newComment newVars newCtors) =\n    length oldCtors == length newCtors\n    && and (zipWith (==) (map fst oldCtors) (map fst newCtors))\n    && and (Map.elems (Map.intersectionWith equiv (Map.fromList oldCtors) (Map.fromList newCtors)))\n  where\n    equiv :: [Type.Type] -> [Type.Type] -> Bool\n    equiv oldTypes newTypes =\n      let\n        allEquivalent =\n          zipWith\n            isEquivalentAlias\n            (map (Docs.Alias oldComment oldVars) oldTypes)\n            (map (Docs.Alias newComment newVars) newTypes)\n      in\n        length oldTypes == length newTypes\n        && and allEquivalent\n\n\nisEquivalentAlias :: Docs.Alias -> Docs.Alias -> Bool\nisEquivalentAlias (Docs.Alias _ oldVars oldType) (Docs.Alias _ newVars newType) =\n  case diffType oldType newType of\n    Nothing ->\n      False\n\n    Just renamings ->\n      length oldVars == length newVars\n      && isEquivalentRenaming (zip oldVars newVars ++ renamings)\n\n\nisEquivalentValue :: Docs.Value -> Docs.Value -> Bool\nisEquivalentValue (Docs.Value c1 t1) (Docs.Value c2 t2) =\n  isEquivalentAlias (Docs.Alias c1 [] t1) (Docs.Alias c2 [] t2)\n\n\nisEquivalentBinop :: Docs.Binop -> Docs.Binop -> Bool\nisEquivalentBinop (Docs.Binop c1 t1 a1 p1) (Docs.Binop c2 t2 a2 p2) =\n  isEquivalentAlias (Docs.Alias c1 [] t1) (Docs.Alias c2 [] t2)\n  && a1 == a2\n  && p1 == p2\n\n\n\n-- DIFF TYPES\n\n\ndiffType :: Type.Type -> Type.Type -> Maybe [(Name.Name,Name.Name)]\ndiffType oldType newType =\n  case (oldType, newType) of\n    (Type.Var oldName, Type.Var newName) ->\n      Just [(oldName, newName)]\n\n    (Type.Lambda a b, Type.Lambda a' b') ->\n      (++)\n        <$> diffType a a'\n        <*> diffType b b'\n\n    (Type.Type oldName oldArgs, Type.Type newName newArgs) ->\n      if not (isSameName oldName newName) || length oldArgs /= length newArgs then\n        Nothing\n      else\n        concat <$> zipWithM diffType oldArgs newArgs\n\n    (Type.Record fields maybeExt, Type.Record fields' maybeExt') ->\n      case (maybeExt, maybeExt') of\n        (Nothing, Just _) ->\n          Nothing\n\n        (Just _, Nothing) ->\n          Nothing\n\n        (Nothing, Nothing) ->\n          diffFields fields fields'\n\n        (Just oldExt, Just newExt) ->\n          (:) (oldExt, newExt) <$> diffFields fields fields'\n\n    (Type.Unit, Type.Unit) ->\n      Just []\n\n    (Type.Tuple a b cs, Type.Tuple x y zs) ->\n      if length cs /= length zs then\n        Nothing\n      else\n        do  aVars <- diffType a x\n            bVars <- diffType b y\n            cVars <- concat <$> zipWithM diffType cs zs\n            return (aVars ++ bVars ++ cVars)\n\n    (_, _) ->\n      Nothing\n\n\n-- handle very old docs that do not use qualified names\nisSameName :: Name.Name -> Name.Name -> Bool\nisSameName oldFullName newFullName =\n  let\n    dedot name =\n      reverse (Name.splitDots name)\n  in\n    case ( dedot oldFullName, dedot newFullName ) of\n      (oldName:[], newName:_) ->\n        oldName == newName\n\n      (oldName:_, newName:[]) ->\n        oldName == newName\n\n      _ ->\n        oldFullName == newFullName\n\n\ndiffFields :: [(Name.Name, Type.Type)] -> [(Name.Name, Type.Type)] -> Maybe [(Name.Name,Name.Name)]\ndiffFields oldRawFields newRawFields =\n  let\n    sort = List.sortBy (compare `on` fst)\n    oldFields = sort oldRawFields\n    newFields = sort newRawFields\n  in\n    if length oldRawFields /= length newRawFields then\n      Nothing\n\n    else if or (zipWith ((/=) `on` fst) oldFields newFields) then\n      Nothing\n\n    else\n      concat <$> zipWithM (diffType `on` snd) oldFields newFields\n\n\n\n-- TYPE VARIABLES\n\n\nisEquivalentRenaming :: [(Name.Name,Name.Name)] -> Bool\nisEquivalentRenaming varPairs =\n  let\n    renamings =\n      Map.toList (foldr insert Map.empty varPairs)\n\n    insert (old,new) dict =\n      Map.insertWith (++) old [new] dict\n\n    verify (old, news) =\n      case news of\n        [] ->\n          Nothing\n\n        new : rest ->\n          if all (new ==) rest then\n            Just (old, new)\n          else\n            Nothing\n\n    allUnique list =\n      length list == Set.size (Set.fromList list)\n  in\n    case mapM verify renamings of\n      Nothing ->\n        False\n\n      Just verifiedRenamings ->\n        all compatibleVars verifiedRenamings\n        &&\n        allUnique (map snd verifiedRenamings)\n\n\ncompatibleVars :: (Name.Name, Name.Name) -> Bool\ncompatibleVars (old, new) =\n  case (categorizeVar old, categorizeVar new) of\n    (CompAppend, CompAppend) -> True\n    (Comparable, Comparable) -> True\n    (Appendable, Appendable) -> True\n    (Number    , Number    ) -> True\n    (Number    , Comparable) -> True\n\n    (_, Var) -> True\n\n    (_, _) -> False\n\n\ndata TypeVarCategory\n  = CompAppend\n  | Comparable\n  | Appendable\n  | Number\n  | Var\n\n\ncategorizeVar :: Name.Name -> TypeVarCategory\ncategorizeVar name\n  | Name.isCompappendType name = CompAppend\n  | Name.isComparableType name = Comparable\n  | Name.isAppendableType name = Appendable\n  | Name.isNumberType     name = Number\n  | otherwise                  = Var\n\n\n\n-- MAGNITUDE\n\n\nbump :: PackageChanges -> V.Version -> V.Version\nbump changes version =\n  case toMagnitude changes of\n    M.PATCH ->\n      V.bumpPatch version\n\n    M.MINOR ->\n      V.bumpMinor version\n\n    M.MAJOR ->\n      V.bumpMajor version\n\n\ntoMagnitude :: PackageChanges -> M.Magnitude\ntoMagnitude (PackageChanges added changed removed) =\n  let\n    addMag = if null added then M.PATCH else M.MINOR\n    removeMag = if null removed then M.PATCH else M.MAJOR\n    changeMags = map moduleChangeMagnitude (Map.elems changed)\n  in\n    maximum (addMag : removeMag : changeMags)\n\n\nmoduleChangeMagnitude :: ModuleChanges -> M.Magnitude\nmoduleChangeMagnitude (ModuleChanges unions aliases values binops) =\n  maximum\n    [ changeMagnitude unions\n    , changeMagnitude aliases\n    , changeMagnitude values\n    , changeMagnitude binops\n    ]\n\n\nchangeMagnitude :: Changes k v -> M.Magnitude\nchangeMagnitude (Changes added changed removed) =\n  if Map.size removed > 0 || Map.size changed > 0 then\n    M.MAJOR\n\n  else if Map.size added > 0 then\n    M.MINOR\n\n  else\n    M.PATCH\n\n\n\n-- GET DOCS\n\n\ngetDocs :: Stuff.PackageCache -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.DocsProblem Docs.Documentation)\ngetDocs cache manager name version =\n  do  let home = Stuff.package cache name version\n      let path = home </> \"docs.json\"\n      exists <- File.exists path\n      if exists\n        then\n          do  bytes <- File.readUtf8 path\n              case D.fromByteString Docs.decoder bytes of\n                Right docs ->\n                  return $ Right docs\n\n                Left _ ->\n                  do  File.remove path\n                      return $ Left Exit.DP_Cache\n        else\n          do  let url = Website.metadata name version \"docs.json\"\n              Http.get manager url [] Exit.DP_Http $ \\body ->\n                case D.fromByteString Docs.decoder body of\n                  Right docs ->\n                    do  Dir.createDirectoryIfMissing True home\n                        File.writeUtf8 path body\n                        return $ Right docs\n\n                  Left _ ->\n                    return $ Left $ Exit.DP_Data url body\n"
  },
  {
    "path": "builder/src/Deps/Registry.hs",
    "content": "{-# LANGUAGE BangPatterns, OverloadedStrings #-}\nmodule Deps.Registry\n  ( Registry(..)\n  , KnownVersions(..)\n  , read\n  , fetch\n  , update\n  , latest\n  , getVersions\n  , getVersions'\n  )\n  where\n\n\nimport Prelude hiding (read)\nimport Control.Monad (liftM2)\nimport Data.Binary (Binary, get, put)\nimport qualified Data.List as List\nimport qualified Data.Map.Strict as Map\n\nimport qualified Deps.Website as Website\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified File\nimport qualified Http\nimport qualified Json.Decode as D\nimport qualified Parse.Primitives as P\nimport qualified Reporting.Exit as Exit\nimport qualified Stuff\n\n\n\n-- REGISTRY\n\n\ndata Registry =\n  Registry\n    { _count :: !Int\n    , _versions :: !(Map.Map Pkg.Name KnownVersions)\n    }\n\n\ndata KnownVersions =\n  KnownVersions\n    { _newest :: V.Version\n    , _previous :: ![V.Version]\n    }\n\n\n\n-- READ\n\n\nread :: Stuff.PackageCache -> IO (Maybe Registry)\nread cache =\n  File.readBinary (Stuff.registry cache)\n\n\n\n-- FETCH\n\n\nfetch :: Http.Manager -> Stuff.PackageCache -> IO (Either Exit.RegistryProblem Registry)\nfetch manager cache =\n  post manager \"/all-packages\" allPkgsDecoder $\n    \\versions ->\n      do  let size = Map.foldr' addEntry 0 versions\n          let registry = Registry size versions\n          let path = Stuff.registry cache\n          File.writeBinary path registry\n          return registry\n\n\naddEntry :: KnownVersions -> Int -> Int\naddEntry (KnownVersions _ vs) count =\n  count + 1 + length vs\n\n\nallPkgsDecoder :: D.Decoder () (Map.Map Pkg.Name KnownVersions)\nallPkgsDecoder =\n  let\n    keyDecoder =\n      Pkg.keyDecoder bail\n\n    versionsDecoder =\n      D.list (D.mapError (\\_ -> ()) V.decoder)\n\n    toKnownVersions versions =\n      case List.sortBy (flip compare) versions of\n        v:vs -> return (KnownVersions v vs)\n        []   -> D.failure ()\n  in\n  D.dict keyDecoder (toKnownVersions =<< versionsDecoder)\n\n\n\n-- UPDATE\n\n\nupdate :: Http.Manager -> Stuff.PackageCache -> Registry -> IO (Either Exit.RegistryProblem Registry)\nupdate manager cache oldRegistry@(Registry size packages) =\n  post manager (\"/all-packages/since/\" ++ show size) (D.list newPkgDecoder) $\n    \\news ->\n      case news of\n        [] ->\n          return oldRegistry\n\n        _:_ ->\n          let\n            newSize = size + length news\n            newPkgs = foldr addNew packages news\n            newRegistry = Registry newSize newPkgs\n          in\n          do  File.writeBinary (Stuff.registry cache) newRegistry\n              return newRegistry\n\n\naddNew :: (Pkg.Name, V.Version) -> Map.Map Pkg.Name KnownVersions -> Map.Map Pkg.Name KnownVersions\naddNew (name, version) versions =\n  let\n    add maybeKnowns =\n      case maybeKnowns of\n        Just (KnownVersions v vs) ->\n          KnownVersions version (v:vs)\n\n        Nothing ->\n          KnownVersions version []\n  in\n  Map.alter (Just . add) name versions\n\n\n\n-- NEW PACKAGE DECODER\n\n\nnewPkgDecoder :: D.Decoder () (Pkg.Name, V.Version)\nnewPkgDecoder =\n  D.customString newPkgParser bail\n\n\nnewPkgParser :: P.Parser () (Pkg.Name, V.Version)\nnewPkgParser =\n  do  pkg <- P.specialize (\\_ _ _ -> ()) Pkg.parser\n      P.word1 0x40 {-@-} bail\n      vsn <- P.specialize (\\_ _ _ -> ()) V.parser\n      return (pkg, vsn)\n\n\nbail :: row -> col -> ()\nbail _ _ =\n  ()\n\n\n\n-- LATEST\n\n\nlatest :: Http.Manager -> Stuff.PackageCache -> IO (Either Exit.RegistryProblem Registry)\nlatest manager cache =\n  do  maybeOldRegistry <- read cache\n      case maybeOldRegistry of\n        Just oldRegistry ->\n          update manager cache oldRegistry\n\n        Nothing ->\n          fetch manager cache\n\n\n\n-- GET VERSIONS\n\n\ngetVersions :: Pkg.Name -> Registry -> Maybe KnownVersions\ngetVersions name (Registry _ versions) =\n  Map.lookup name versions\n\n\ngetVersions' :: Pkg.Name -> Registry -> Either [Pkg.Name] KnownVersions\ngetVersions' name (Registry _ versions) =\n  case Map.lookup name versions of\n    Just kvs -> Right kvs\n    Nothing -> Left $ Pkg.nearbyNames name (Map.keys versions)\n\n\n\n-- POST\n\n\npost :: Http.Manager -> String -> D.Decoder x a -> (a -> IO b) -> IO (Either Exit.RegistryProblem b)\npost manager path decoder callback =\n  let\n    url = Website.route path []\n  in\n  Http.post manager url [] Exit.RP_Http $\n    \\body ->\n      case D.fromByteString decoder body of\n        Right a -> Right <$> callback a\n        Left _ -> return $ Left $ Exit.RP_Data url body\n\n\n\n-- BINARY\n\n\ninstance Binary Registry where\n  get = liftM2 Registry get get\n  put (Registry a b) = put a >> put b\n\n\ninstance Binary KnownVersions where\n  get = liftM2 KnownVersions get get\n  put (KnownVersions a b) = put a >> put b\n"
  },
  {
    "path": "builder/src/Deps/Solver.hs",
    "content": "{-# LANGUAGE OverloadedStrings, Rank2Types #-}\nmodule Deps.Solver\n  ( Solver\n  , Result(..)\n  , Connection(..)\n  --\n  , Details(..)\n  , verify\n  --\n  , AppSolution(..)\n  , addToApp\n  --\n  , Env(..)\n  , initEnv\n  )\n  where\n\n\nimport Control.Monad (foldM)\nimport Control.Concurrent (forkIO, newEmptyMVar, putMVar, readMVar)\nimport qualified Data.Map as Map\nimport Data.Map ((!))\nimport qualified System.Directory as Dir\nimport System.FilePath ((</>))\n\nimport qualified Deps.Registry as Registry\nimport qualified Deps.Website as Website\nimport qualified Elm.Constraint as C\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Outline as Outline\nimport qualified Elm.Version as V\nimport qualified File\nimport qualified Http\nimport qualified Json.Decode as D\nimport qualified Reporting.Exit as Exit\nimport qualified Stuff\n\n\n\n-- SOLVER\n\n\nnewtype Solver a =\n  Solver\n  (\n    forall b.\n      State\n      -> (State -> a -> (State -> IO b) -> IO b)\n      -> (State -> IO b)\n      -> (Exit.Solver -> IO b)\n      -> IO b\n  )\n\n\ndata State =\n  State\n    { _cache :: Stuff.PackageCache\n    , _connection :: Connection\n    , _registry :: Registry.Registry\n    , _constraints :: Map.Map (Pkg.Name, V.Version) Constraints\n    }\n\n\ndata Constraints =\n  Constraints\n    { _elm :: C.Constraint\n    , _deps :: Map.Map Pkg.Name C.Constraint\n    }\n\n\ndata Connection\n  = Online Http.Manager\n  | Offline\n\n\n\n-- RESULT\n\n\ndata Result a\n  = Ok a\n  | NoSolution\n  | NoOfflineSolution\n  | Err Exit.Solver\n\n\n\n-- VERIFY -- used by Elm.Details\n\n\ndata Details =\n  Details V.Version (Map.Map Pkg.Name C.Constraint)\n\n\nverify :: Stuff.PackageCache -> Connection -> Registry.Registry -> Map.Map Pkg.Name C.Constraint -> IO (Result (Map.Map Pkg.Name Details))\nverify cache connection registry constraints =\n  Stuff.withRegistryLock cache $\n  case try constraints of\n    Solver solver ->\n      solver (State cache connection registry Map.empty)\n        (\\s a _ -> return $ Ok (Map.mapWithKey (addDeps s) a))\n        (\\_     -> return $ noSolution connection)\n        (\\e     -> return $ Err e)\n\n\naddDeps :: State -> Pkg.Name -> V.Version -> Details\naddDeps (State _ _ _ constraints) name vsn =\n  case Map.lookup (name, vsn) constraints of\n    Just (Constraints _ deps) -> Details vsn deps\n    Nothing                   -> error \"compiler bug manifesting in Deps.Solver.addDeps\"\n\n\nnoSolution :: Connection -> Result a\nnoSolution connection =\n  case connection of\n    Online _ -> NoSolution\n    Offline -> NoOfflineSolution\n\n\n\n-- ADD TO APP - used in Install\n\n\ndata AppSolution =\n  AppSolution\n    { _old :: Map.Map Pkg.Name V.Version\n    , _new :: Map.Map Pkg.Name V.Version\n    , _app :: Outline.AppOutline\n    }\n\n\naddToApp :: Stuff.PackageCache -> Connection -> Registry.Registry -> Pkg.Name -> Outline.AppOutline -> IO (Result AppSolution)\naddToApp cache connection registry pkg outline@(Outline.AppOutline _ _ direct indirect testDirect testIndirect) =\n  Stuff.withRegistryLock cache $\n  let\n    allIndirects = Map.union indirect testIndirect\n    allDirects = Map.union direct testDirect\n    allDeps = Map.union allDirects allIndirects\n\n    attempt toConstraint deps =\n      try (Map.insert pkg C.anything (Map.map toConstraint deps))\n  in\n  case\n    oneOf\n      ( attempt C.exactly allDeps )\n      [ attempt C.exactly allDirects\n      , attempt C.untilNextMinor allDirects\n      , attempt C.untilNextMajor allDirects\n      , attempt (\\_ -> C.anything) allDirects\n      ]\n  of\n    Solver solver ->\n      solver (State cache connection registry Map.empty)\n        (\\s a _ -> return $ Ok (toApp s pkg outline allDeps a))\n        (\\_     -> return $ noSolution connection)\n        (\\e     -> return $ Err e)\n\n\ntoApp :: State -> Pkg.Name -> Outline.AppOutline -> Map.Map Pkg.Name V.Version -> Map.Map Pkg.Name V.Version -> AppSolution\ntoApp (State _ _ _ constraints) pkg (Outline.AppOutline elm srcDirs direct _ testDirect _) old new =\n  let\n    d   = Map.intersection new (Map.insert pkg V.one direct)\n    i   = Map.difference (getTransitive constraints new (Map.toList d) Map.empty) d\n    td  = Map.intersection new (Map.delete pkg testDirect)\n    ti  = Map.difference new (Map.unions [d,i,td])\n  in\n  AppSolution old new (Outline.AppOutline elm srcDirs d i td ti)\n\n\ngetTransitive :: Map.Map (Pkg.Name, V.Version) Constraints -> Map.Map Pkg.Name V.Version -> [(Pkg.Name,V.Version)] -> Map.Map Pkg.Name V.Version -> Map.Map Pkg.Name V.Version\ngetTransitive constraints solution unvisited visited =\n  case unvisited of\n    [] ->\n      visited\n\n    info@(pkg,vsn) : infos ->\n      if Map.member pkg visited\n      then getTransitive constraints solution infos visited\n      else\n        let\n          newDeps = _deps (constraints ! info)\n          newUnvisited = Map.toList (Map.intersection solution (Map.difference newDeps visited))\n          newVisited = Map.insert pkg vsn visited\n        in\n        getTransitive constraints solution infos $\n          getTransitive constraints solution newUnvisited newVisited\n\n\n\n-- TRY\n\n\ntry :: Map.Map Pkg.Name C.Constraint -> Solver (Map.Map Pkg.Name V.Version)\ntry constraints =\n  exploreGoals (Goals constraints Map.empty)\n\n\n\n-- EXPLORE GOALS\n\n\ndata Goals =\n  Goals\n    { _pending :: Map.Map Pkg.Name C.Constraint\n    , _solved :: Map.Map Pkg.Name V.Version\n    }\n\n\nexploreGoals :: Goals -> Solver (Map.Map Pkg.Name V.Version)\nexploreGoals (Goals pending solved) =\n  case Map.minViewWithKey pending of\n    Nothing ->\n      return solved\n\n    Just ((name, constraint), otherPending) ->\n      do  let goals1 = Goals otherPending solved\n          let addVsn = addVersion goals1 name\n          (v,vs) <- getRelevantVersions name constraint\n          goals2 <- oneOf (addVsn v) (map addVsn vs)\n          exploreGoals goals2\n\n\naddVersion :: Goals -> Pkg.Name -> V.Version -> Solver Goals\naddVersion (Goals pending solved) name version =\n  do  (Constraints elm deps) <- getConstraints name version\n      if C.goodElm elm\n        then\n          do  newPending <- foldM (addConstraint solved) pending (Map.toList deps)\n              return (Goals newPending (Map.insert name version solved))\n        else\n          backtrack\n\n\naddConstraint :: Map.Map Pkg.Name V.Version -> Map.Map Pkg.Name C.Constraint -> (Pkg.Name, C.Constraint) -> Solver (Map.Map Pkg.Name C.Constraint)\naddConstraint solved unsolved (name, newConstraint) =\n  case Map.lookup name solved of\n    Just version ->\n      if C.satisfies newConstraint version\n      then return unsolved\n      else backtrack\n\n    Nothing ->\n      case Map.lookup name unsolved of\n        Nothing ->\n          return $ Map.insert name newConstraint unsolved\n\n        Just oldConstraint ->\n          case C.intersect oldConstraint newConstraint of\n            Nothing ->\n              backtrack\n\n            Just mergedConstraint ->\n              if oldConstraint == mergedConstraint\n              then return unsolved\n              else return (Map.insert name mergedConstraint unsolved)\n\n\n\n-- GET RELEVANT VERSIONS\n\n\ngetRelevantVersions :: Pkg.Name -> C.Constraint -> Solver (V.Version, [V.Version])\ngetRelevantVersions name constraint =\n  Solver $ \\state@(State _ _ registry _) ok back _ ->\n    case Registry.getVersions name registry of\n      Just (Registry.KnownVersions newest previous) ->\n        case filter (C.satisfies constraint) (newest:previous) of\n          []   -> back state\n          v:vs -> ok state (v,vs) back\n\n      Nothing ->\n        back state\n\n\n\n-- GET CONSTRAINTS\n\n\ngetConstraints :: Pkg.Name -> V.Version -> Solver Constraints\ngetConstraints pkg vsn =\n  Solver $ \\state@(State cache connection registry cDict) ok back err ->\n    do  let key = (pkg, vsn)\n        case Map.lookup key cDict of\n          Just cs ->\n            ok state cs back\n\n          Nothing ->\n            do  let toNewState cs = State cache connection registry (Map.insert key cs cDict)\n                let home = Stuff.package cache pkg vsn\n                let path = home </> \"elm.json\"\n                outlineExists <- File.exists path\n                if outlineExists\n                  then\n                    do  bytes <- File.readUtf8 path\n                        case D.fromByteString constraintsDecoder bytes of\n                          Right cs ->\n                            case connection of\n                              Online _ ->\n                                ok (toNewState cs) cs back\n\n                              Offline ->\n                                do  srcExists <- Dir.doesDirectoryExist (Stuff.package cache pkg vsn </> \"src\")\n                                    if srcExists\n                                      then ok (toNewState cs) cs back\n                                      else back state\n\n                          Left  _  ->\n                            do  File.remove path\n                                err (Exit.SolverBadCacheData pkg vsn)\n                  else\n                    case connection of\n                      Offline ->\n                        back state\n\n                      Online manager ->\n                        do  let url = Website.metadata pkg vsn \"elm.json\"\n                            result <- Http.get manager url [] id (return . Right)\n                            case result of\n                              Left httpProblem ->\n                                err (Exit.SolverBadHttp pkg vsn httpProblem)\n\n                              Right body ->\n                                case D.fromByteString constraintsDecoder body of\n                                  Right cs ->\n                                    do  Dir.createDirectoryIfMissing True home\n                                        File.writeUtf8 path body\n                                        ok (toNewState cs) cs back\n\n                                  Left _ ->\n                                    err (Exit.SolverBadHttpData pkg vsn url)\n\n\nconstraintsDecoder :: D.Decoder () Constraints\nconstraintsDecoder =\n  do  outline <- D.mapError (const ()) Outline.decoder\n      case outline of\n        Outline.Pkg (Outline.PkgOutline _ _ _ _ _ deps _ elmConstraint) ->\n          return (Constraints elmConstraint deps)\n\n        Outline.App _ ->\n          D.failure ()\n\n\n\n-- ENVIRONMENT\n\n\ndata Env =\n  Env Stuff.PackageCache Http.Manager Connection Registry.Registry\n\n\ninitEnv :: IO (Either Exit.RegistryProblem Env)\ninitEnv =\n  do  mvar  <- newEmptyMVar\n      _     <- forkIO $ putMVar mvar =<< Http.getManager\n      cache <- Stuff.getPackageCache\n      Stuff.withRegistryLock cache $\n        do  maybeRegistry <- Registry.read cache\n            manager       <- readMVar mvar\n\n            case maybeRegistry of\n              Nothing ->\n                do  eitherRegistry <- Registry.fetch manager cache\n                    case eitherRegistry of\n                      Right latestRegistry ->\n                        return $ Right $ Env cache manager (Online manager) latestRegistry\n\n                      Left problem ->\n                        return $ Left $ problem\n\n              Just cachedRegistry ->\n                do  eitherRegistry <- Registry.update manager cache cachedRegistry\n                    case eitherRegistry of\n                      Right latestRegistry ->\n                        return $ Right $ Env cache manager (Online manager) latestRegistry\n\n                      Left _ ->\n                        return $ Right $ Env cache manager Offline cachedRegistry\n\n\n\n-- INSTANCES\n\n\ninstance Functor Solver where\n  fmap func (Solver solver) =\n    Solver $ \\state ok back err ->\n      let\n        okA stateA arg backA = ok stateA (func arg) backA\n      in\n      solver state okA back err\n\n\ninstance Applicative Solver where\n  pure a =\n    Solver $ \\state ok back _ -> ok state a back\n\n  (<*>) (Solver solverFunc) (Solver solverArg) =\n    Solver $ \\state ok back err ->\n      let\n        okF stateF func backF =\n          let\n            okA stateA arg backA = ok stateA (func arg) backA\n          in\n          solverArg stateF okA backF err\n      in\n      solverFunc state okF back err\n\n\ninstance Monad Solver where\n  (>>=) (Solver solverA) callback =\n    Solver $ \\state ok back err ->\n      let\n        okA stateA a backA =\n          case callback a of\n            Solver solverB -> solverB stateA ok backA err\n      in\n      solverA state okA back err\n\n\noneOf :: Solver a -> [Solver a] -> Solver a\noneOf solver@(Solver solverHead) solvers =\n  case solvers of\n    [] ->\n      solver\n\n    s:ss ->\n      Solver $ \\state0 ok back err ->\n        let\n          tryTail state1 =\n            let\n              (Solver solverTail) = oneOf s ss\n            in\n            solverTail state1 ok back err\n        in\n        solverHead state0 ok tryTail err\n\n\nbacktrack :: Solver a\nbacktrack =\n  Solver $ \\state _ back _ -> back state\n"
  },
  {
    "path": "builder/src/Deps/Website.hs",
    "content": "module Deps.Website\n  ( domain\n  , route\n  , metadata\n  )\n  where\n\n\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified Http\n\n\ndomain :: String\ndomain =\n  \"https://package.elm-lang.org\"\n\n\nroute :: String -> [(String,String)] -> String\nroute path params =\n  Http.toUrl (domain ++ path) params\n\n\nmetadata :: Pkg.Name -> V.Version -> String -> String\nmetadata name version file =\n  domain ++ \"/packages/\" ++ Pkg.toUrl name ++ \"/\" ++ V.toChars version ++ \"/\" ++ file\n"
  },
  {
    "path": "builder/src/Elm/Details.hs",
    "content": "{-# LANGUAGE BangPatterns, OverloadedStrings #-}\nmodule Elm.Details\n  ( Details(..)\n  , BuildID\n  , ValidOutline(..)\n  , Local(..)\n  , Foreign(..)\n  , load\n  , loadObjects\n  , loadInterfaces\n  , verifyInstall\n  )\n  where\n\n\nimport Control.Concurrent (forkIO)\nimport Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, takeMVar)\nimport Control.Monad (liftM, liftM2, liftM3)\nimport Data.Binary (Binary, get, put, getWord8, putWord8)\nimport qualified Data.Either as Either\nimport qualified Data.Map as Map\nimport qualified Data.Map.Utils as Map\nimport qualified Data.Map.Merge.Strict as Map\nimport qualified Data.Maybe as Maybe\nimport qualified Data.Name as Name\nimport qualified Data.NonEmptyList as NE\nimport qualified Data.OneOrMore as OneOrMore\nimport qualified Data.Set as Set\nimport qualified Data.Utf8 as Utf8\nimport Data.Word (Word64)\nimport qualified System.Directory as Dir\nimport System.FilePath ((</>), (<.>))\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Source as Src\nimport qualified AST.Optimized as Opt\nimport qualified BackgroundWriter as BW\nimport qualified Compile\nimport qualified Deps.Registry as Registry\nimport qualified Deps.Solver as Solver\nimport qualified Deps.Website as Website\nimport qualified Elm.Constraint as Con\nimport qualified Elm.Docs as Docs\nimport qualified Elm.Interface as I\nimport qualified Elm.Kernel as Kernel\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Outline as Outline\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified File\nimport qualified Http\nimport qualified Json.Decode as D\nimport qualified Json.Encode as E\nimport qualified Parse.Module as Parse\nimport qualified Reporting\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Task as Task\nimport qualified Stuff\n\n\n\n-- DETAILS\n\n\ndata Details =\n  Details\n    { _outlineTime :: File.Time\n    , _outline :: ValidOutline\n    , _buildID :: BuildID\n    , _locals :: Map.Map ModuleName.Raw Local\n    , _foreigns :: Map.Map ModuleName.Raw Foreign\n    , _extras :: Extras\n    }\n\n\ntype BuildID = Word64\n\n\ndata ValidOutline\n  = ValidApp (NE.List Outline.SrcDir)\n  | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})\n\n\n-- NOTE: we need two ways to detect if a file must be recompiled:\n--\n-- (1) _time is the modification time from the last time we compiled the file.\n-- By checking EQUALITY with the current modification time, we can detect file\n-- saves and `git checkout` of previous versions. Both need a recompile.\n--\n-- (2) _lastChange is the BuildID from the last time a new interface file was\n-- generated, and _lastCompile is the BuildID from the last time the file was\n-- compiled. These may be different if a file is recompiled but the interface\n-- stayed the same. When the _lastCompile is LESS THAN the _lastChange of any\n-- imports, we need to recompile. This can happen when a project has multiple\n-- entrypoints and some modules are compiled less often than their imports.\n--\ndata Local =\n  Local\n    { _path :: FilePath\n    , _time :: File.Time\n    , _deps :: [ModuleName.Raw]\n    , _main :: Bool\n    , _lastChange :: BuildID\n    , _lastCompile :: BuildID\n    }\n\n\ndata Foreign =\n  Foreign Pkg.Name [Pkg.Name]\n\n\ndata Extras\n  = ArtifactsCached\n  | ArtifactsFresh Interfaces Opt.GlobalGraph\n\n\ntype Interfaces =\n  Map.Map ModuleName.Canonical I.DependencyInterface\n\n\n\n-- LOAD ARTIFACTS\n\n\nloadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))\nloadObjects root (Details _ _ _ _ _ extras) =\n  case extras of\n    ArtifactsFresh _ o -> newMVar (Just o)\n    ArtifactsCached    -> fork (File.readBinary (Stuff.objects root))\n\n\nloadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))\nloadInterfaces root (Details _ _ _ _ _ extras) =\n  case extras of\n    ArtifactsFresh i _ -> newMVar (Just i)\n    ArtifactsCached    -> fork (File.readBinary (Stuff.interfaces root))\n\n\n\n-- VERIFY INSTALL -- used by Install\n\n\nverifyInstall :: BW.Scope -> FilePath -> Solver.Env -> Outline.Outline -> IO (Either Exit.Details ())\nverifyInstall scope root (Solver.Env cache manager connection registry) outline =\n  do  time <- File.getTime (root </> \"elm.json\")\n      let key = Reporting.ignorer\n      let env = Env key scope root cache manager connection registry\n      case outline of\n        Outline.Pkg pkg -> Task.run (verifyPkg env time pkg >> return ())\n        Outline.App app -> Task.run (verifyApp env time app >> return ())\n\n\n\n-- LOAD -- used by Make, Repl, Reactor\n\n\nload :: Reporting.Style -> BW.Scope -> FilePath -> IO (Either Exit.Details Details)\nload style scope root =\n  do  newTime <- File.getTime (root </> \"elm.json\")\n      maybeDetails <- File.readBinary (Stuff.details root)\n      case maybeDetails of\n        Nothing ->\n          generate style scope root newTime\n\n        Just details@(Details oldTime _ buildID _ _ _) ->\n          if oldTime == newTime\n          then return (Right details { _buildID = buildID + 1 })\n          else generate style scope root newTime\n\n\n\n-- GENERATE\n\n\ngenerate :: Reporting.Style -> BW.Scope -> FilePath -> File.Time -> IO (Either Exit.Details Details)\ngenerate style scope root time =\n  Reporting.trackDetails style $ \\key ->\n    do  result <- initEnv key scope root\n        case result of\n          Left exit ->\n            return (Left exit)\n\n          Right (env, outline) ->\n            case outline of\n              Outline.Pkg pkg -> Task.run (verifyPkg env time pkg)\n              Outline.App app -> Task.run (verifyApp env time app)\n\n\n\n-- ENV\n\n\ndata Env =\n  Env\n    { _key :: Reporting.DKey\n    , _scope :: BW.Scope\n    , _root :: FilePath\n    , _cache :: Stuff.PackageCache\n    , _manager :: Http.Manager\n    , _connection :: Solver.Connection\n    , _registry :: Registry.Registry\n    }\n\n\ninitEnv :: Reporting.DKey -> BW.Scope -> FilePath -> IO (Either Exit.Details (Env, Outline.Outline))\ninitEnv key scope root =\n  do  mvar <- fork Solver.initEnv\n      eitherOutline <- Outline.read root\n      case eitherOutline of\n        Left problem ->\n          return $ Left $ Exit.DetailsBadOutline problem\n\n        Right outline ->\n          do  maybeEnv <- readMVar mvar\n              case maybeEnv of\n                Left problem ->\n                  return $ Left $ Exit.DetailsCannotGetRegistry problem\n\n                Right (Solver.Env cache manager connection registry) ->\n                  return $ Right (Env key scope root cache manager connection registry, outline)\n\n\n\n-- VERIFY PROJECT\n\n\ntype Task a = Task.Task Exit.Details a\n\n\nverifyPkg :: Env -> File.Time -> Outline.PkgOutline -> Task Details\nverifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct testDirect elm) =\n  if Con.goodElm elm\n  then\n    do  solution <- verifyConstraints env =<< union noDups direct testDirect\n        let exposedList = Outline.flattenExposed exposed\n        let exactDeps = Map.map (\\(Solver.Details v _) -> v) solution -- for pkg docs in reactor\n        verifyDependencies env time (ValidPkg pkg exposedList exactDeps) solution direct\n  else\n    Task.throw $ Exit.DetailsBadElmInPkg elm\n\n\nverifyApp :: Env -> File.Time -> Outline.AppOutline -> Task Details\nverifyApp env time outline@(Outline.AppOutline elmVersion srcDirs direct _ _ _) =\n  if elmVersion == V.compiler\n  then\n    do  stated <- checkAppDeps outline\n        actual <- verifyConstraints env (Map.map Con.exactly stated)\n        if Map.size stated == Map.size actual\n          then verifyDependencies env time (ValidApp srcDirs) actual direct\n          else Task.throw $ Exit.DetailsHandEditedDependencies\n  else\n    Task.throw $ Exit.DetailsBadElmInAppOutline elmVersion\n\n\ncheckAppDeps :: Outline.AppOutline -> Task (Map.Map Pkg.Name V.Version)\ncheckAppDeps (Outline.AppOutline _ _ direct indirect testDirect testIndirect) =\n  do  x <- union allowEqualDups indirect testDirect\n      y <- union noDups direct testIndirect\n      union noDups x y\n\n\n\n-- VERIFY CONSTRAINTS\n\n\nverifyConstraints :: Env -> Map.Map Pkg.Name Con.Constraint -> Task (Map.Map Pkg.Name Solver.Details)\nverifyConstraints (Env _ _ _ cache _ connection registry) constraints =\n  do  result <- Task.io $ Solver.verify cache connection registry constraints\n      case result of\n        Solver.Ok details        -> return details\n        Solver.NoSolution        -> Task.throw $ Exit.DetailsNoSolution\n        Solver.NoOfflineSolution -> Task.throw $ Exit.DetailsNoOfflineSolution\n        Solver.Err exit          -> Task.throw $ Exit.DetailsSolverProblem exit\n\n\n\n-- UNION\n\n\nunion :: (Ord k) => (k -> v -> v -> Task v) -> Map.Map k v -> Map.Map k v -> Task (Map.Map k v)\nunion tieBreaker deps1 deps2 =\n  Map.mergeA Map.preserveMissing Map.preserveMissing (Map.zipWithAMatched tieBreaker) deps1 deps2\n\n\nnoDups :: k -> v -> v -> Task v\nnoDups _ _ _ =\n  Task.throw Exit.DetailsHandEditedDependencies\n\n\nallowEqualDups :: (Eq v) => k -> v -> v -> Task v\nallowEqualDups _ v1 v2 =\n  if v1 == v2\n  then return v1\n  else Task.throw Exit.DetailsHandEditedDependencies\n\n\n\n-- FORK\n\n\nfork :: IO a -> IO (MVar a)\nfork work =\n  do  mvar <- newEmptyMVar\n      _ <- forkIO $ putMVar mvar =<< work\n      return mvar\n\n\n\n-- VERIFY DEPENDENCIES\n\n\nverifyDependencies :: Env -> File.Time -> ValidOutline -> Map.Map Pkg.Name Solver.Details -> Map.Map Pkg.Name a -> Task Details\nverifyDependencies env@(Env key scope root cache _ _ _) time outline solution directDeps =\n  Task.eio id $\n  do  Reporting.report key (Reporting.DStart (Map.size solution))\n      mvar <- newEmptyMVar\n      mvars <- Stuff.withRegistryLock cache $\n        Map.traverseWithKey (\\k v -> fork (verifyDep env mvar solution k v)) solution\n      putMVar mvar mvars\n      deps <- traverse readMVar mvars\n      case sequence deps of\n        Left _ ->\n          do  home <- Stuff.getElmHome\n              return $ Left $ Exit.DetailsBadDeps home $\n                Maybe.catMaybes $ Either.lefts $ Map.elems deps\n\n        Right artifacts ->\n          let\n            objs = Map.foldr addObjects Opt.empty artifacts\n            ifaces = Map.foldrWithKey (addInterfaces directDeps) Map.empty artifacts\n            foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty $ Map.intersection artifacts directDeps\n            details = Details time outline 0 Map.empty foreigns (ArtifactsFresh ifaces objs)\n          in\n          do  BW.writeBinary scope (Stuff.objects    root) objs\n              BW.writeBinary scope (Stuff.interfaces root) ifaces\n              BW.writeBinary scope (Stuff.details    root) details\n              return (Right details)\n\n\naddObjects :: Artifacts -> Opt.GlobalGraph -> Opt.GlobalGraph\naddObjects (Artifacts _ objs) graph =\n  Opt.addGlobalGraph objs graph\n\n\naddInterfaces :: Map.Map Pkg.Name a -> Pkg.Name -> Artifacts -> Interfaces -> Interfaces\naddInterfaces directDeps pkg (Artifacts ifaces _) dependencyInterfaces =\n  Map.union dependencyInterfaces $ Map.mapKeysMonotonic (ModuleName.Canonical pkg) $\n    if Map.member pkg directDeps\n      then ifaces\n      else Map.map I.privatize ifaces\n\n\ngatherForeigns :: Pkg.Name -> Artifacts -> Map.Map ModuleName.Raw (OneOrMore.OneOrMore Pkg.Name) -> Map.Map ModuleName.Raw (OneOrMore.OneOrMore Pkg.Name)\ngatherForeigns pkg (Artifacts ifaces _) foreigns =\n  let\n    isPublic di =\n      case di of\n        I.Public _      -> Just (OneOrMore.one pkg)\n        I.Private _ _ _ -> Nothing\n  in\n  Map.unionWith OneOrMore.more foreigns (Map.mapMaybe isPublic ifaces)\n\n\n\n-- VERIFY DEPENDENCY\n\n\ndata Artifacts =\n  Artifacts\n    { _ifaces :: Map.Map ModuleName.Raw I.DependencyInterface\n    , _objects :: Opt.GlobalGraph\n    }\n\n\ntype Dep =\n  Either (Maybe Exit.DetailsBadDep) Artifacts\n\n\nverifyDep :: Env -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Map.Map Pkg.Name Solver.Details -> Pkg.Name -> Solver.Details -> IO Dep\nverifyDep (Env key _ _ cache manager _ _) depsMVar solution pkg details@(Solver.Details vsn directDeps) =\n  do  let fingerprint = Map.intersectionWith (\\(Solver.Details v _) _ -> v) solution directDeps\n      exists <- Dir.doesDirectoryExist (Stuff.package cache pkg vsn </> \"src\")\n      if exists\n        then\n          do  Reporting.report key Reporting.DCached\n              maybeCache <- File.readBinary (Stuff.package cache pkg vsn </> \"artifacts.dat\")\n              case maybeCache of\n                Nothing ->\n                  build key cache depsMVar pkg details fingerprint Set.empty\n\n                Just (ArtifactCache fingerprints artifacts) ->\n                  if Set.member fingerprint fingerprints\n                    then Reporting.report key Reporting.DBuilt >> return (Right artifacts)\n                    else build key cache depsMVar pkg details fingerprint fingerprints\n        else\n          do  Reporting.report key Reporting.DRequested\n              result <- downloadPackage cache manager pkg vsn\n              case result of\n                Left problem ->\n                  do  Reporting.report key (Reporting.DFailed pkg vsn)\n                      return $ Left $ Just $ Exit.BD_BadDownload pkg vsn problem\n\n                Right () ->\n                  do  Reporting.report key (Reporting.DReceived pkg vsn)\n                      build key cache depsMVar pkg details fingerprint Set.empty\n\n\n\n-- ARTIFACT CACHE\n\n\ndata ArtifactCache =\n  ArtifactCache\n    { _fingerprints :: Set.Set Fingerprint\n    , _artifacts :: Artifacts\n    }\n\n\ntype Fingerprint =\n  Map.Map Pkg.Name V.Version\n\n\n\n-- BUILD\n\n\nbuild :: Reporting.DKey -> Stuff.PackageCache -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Pkg.Name -> Solver.Details -> Fingerprint -> Set.Set Fingerprint -> IO Dep\nbuild key cache depsMVar pkg (Solver.Details vsn _) f fs =\n  do  eitherOutline <- Outline.read (Stuff.package cache pkg vsn)\n      case eitherOutline of\n        Left _ ->\n          do  Reporting.report key Reporting.DBroken\n              return $ Left $ Just $ Exit.BD_BadBuild pkg vsn f\n\n        Right (Outline.App _) ->\n          do  Reporting.report key Reporting.DBroken\n              return $ Left $ Just $ Exit.BD_BadBuild pkg vsn f\n\n        Right (Outline.Pkg (Outline.PkgOutline _ _ _ _ exposed deps _ _)) ->\n          do  allDeps <- readMVar depsMVar\n              directDeps <- traverse readMVar (Map.intersection allDeps deps)\n              case sequence directDeps of\n                Left _ ->\n                  do  Reporting.report key Reporting.DBroken\n                      return $ Left $ Nothing\n\n                Right directArtifacts ->\n                  do  let src = Stuff.package cache pkg vsn </> \"src\"\n                      let foreignDeps = gatherForeignInterfaces directArtifacts\n                      let exposedDict = Map.fromKeys (\\_ -> ()) (Outline.flattenExposed exposed)\n                      docsStatus <- getDocsStatus cache pkg vsn\n                      mvar <- newEmptyMVar\n                      mvars <- Map.traverseWithKey (const . fork . crawlModule foreignDeps mvar pkg src docsStatus) exposedDict\n                      putMVar mvar mvars\n                      mapM_ readMVar mvars\n                      maybeStatuses <- traverse readMVar =<< readMVar mvar\n                      case sequence maybeStatuses of\n                        Nothing ->\n                          do  Reporting.report key Reporting.DBroken\n                              return $ Left $ Just $ Exit.BD_BadBuild pkg vsn f\n\n                        Just statuses ->\n                          do  rmvar <- newEmptyMVar\n                              rmvars <- traverse (fork . compile pkg rmvar) statuses\n                              putMVar rmvar rmvars\n                              maybeResults <- traverse readMVar rmvars\n                              case sequence maybeResults of\n                                Nothing ->\n                                  do  Reporting.report key Reporting.DBroken\n                                      return $ Left $ Just $ Exit.BD_BadBuild pkg vsn f\n\n                                Just results ->\n                                  let\n                                    path = Stuff.package cache pkg vsn </> \"artifacts.dat\"\n                                    ifaces = gatherInterfaces exposedDict results\n                                    objects = gatherObjects results\n                                    artifacts = Artifacts ifaces objects\n                                    fingerprints = Set.insert f fs\n                                  in\n                                  do  writeDocs cache pkg vsn docsStatus results\n                                      File.writeBinary path (ArtifactCache fingerprints artifacts)\n                                      Reporting.report key Reporting.DBuilt\n                                      return (Right artifacts)\n\n\n\n-- GATHER\n\n\ngatherObjects :: Map.Map ModuleName.Raw Result -> Opt.GlobalGraph\ngatherObjects results =\n  Map.foldrWithKey addLocalGraph Opt.empty results\n\n\naddLocalGraph :: ModuleName.Raw -> Result -> Opt.GlobalGraph -> Opt.GlobalGraph\naddLocalGraph name status graph =\n  case status of\n    RLocal _ objs _ -> Opt.addLocalGraph objs graph\n    RForeign _      -> graph\n    RKernelLocal cs -> Opt.addKernel (Name.getKernel name) cs graph\n    RKernelForeign  -> graph\n\n\ngatherInterfaces :: Map.Map ModuleName.Raw () -> Map.Map ModuleName.Raw Result -> Map.Map ModuleName.Raw I.DependencyInterface\ngatherInterfaces exposed artifacts =\n  let\n    onLeft  = Map.mapMissing (error \"compiler bug manifesting in Elm.Details.gatherInterfaces\")\n    onRight = Map.mapMaybeMissing     (\\_    iface -> toLocalInterface I.private iface)\n    onBoth  = Map.zipWithMaybeMatched (\\_ () iface -> toLocalInterface I.public  iface)\n  in\n  Map.merge onLeft onRight onBoth exposed artifacts\n\n\ntoLocalInterface :: (I.Interface -> a) -> Result -> Maybe a\ntoLocalInterface func result =\n  case result of\n    RLocal iface _ _ -> Just (func iface)\n    RForeign _       -> Nothing\n    RKernelLocal _   -> Nothing\n    RKernelForeign   -> Nothing\n\n\n\n-- GATHER FOREIGN INTERFACES\n\n\ndata ForeignInterface\n  = ForeignAmbiguous\n  | ForeignSpecific I.Interface\n\n\ngatherForeignInterfaces :: Map.Map Pkg.Name Artifacts -> Map.Map ModuleName.Raw ForeignInterface\ngatherForeignInterfaces directArtifacts =\n    Map.map (OneOrMore.destruct finalize) $\n      Map.foldrWithKey gather Map.empty directArtifacts\n  where\n    finalize :: I.Interface -> [I.Interface] -> ForeignInterface\n    finalize i is =\n      case is of\n        [] -> ForeignSpecific i\n        _:_ -> ForeignAmbiguous\n\n    gather :: Pkg.Name -> Artifacts -> Map.Map ModuleName.Raw (OneOrMore.OneOrMore I.Interface) -> Map.Map ModuleName.Raw (OneOrMore.OneOrMore I.Interface)\n    gather _ (Artifacts ifaces _) buckets =\n      Map.unionWith OneOrMore.more buckets (Map.mapMaybe isPublic ifaces)\n\n    isPublic :: I.DependencyInterface -> Maybe (OneOrMore.OneOrMore I.Interface)\n    isPublic di =\n      case di of\n        I.Public iface  -> Just (OneOrMore.one iface)\n        I.Private _ _ _ -> Nothing\n\n\n\n-- CRAWL\n\n\ntype StatusDict =\n  Map.Map ModuleName.Raw (MVar (Maybe Status))\n\n\ndata Status\n  = SLocal DocsStatus (Map.Map ModuleName.Raw ()) Src.Module\n  | SForeign I.Interface\n  | SKernelLocal [Kernel.Chunk]\n  | SKernelForeign\n\n\ncrawlModule :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> IO (Maybe Status)\ncrawlModule foreignDeps mvar pkg src docsStatus name =\n  do  let path = src </> ModuleName.toFilePath name <.> \"elm\"\n      exists <- File.exists path\n      case Map.lookup name foreignDeps of\n        Just ForeignAmbiguous ->\n          return Nothing\n\n        Just (ForeignSpecific iface) ->\n          if exists\n          then return Nothing\n          else return (Just (SForeign iface))\n\n        Nothing ->\n          if exists then\n            crawlFile foreignDeps mvar pkg src docsStatus name path\n\n          else if Pkg.isKernel pkg && Name.isKernel name then\n            crawlKernel foreignDeps mvar pkg src name\n\n          else\n            return Nothing\n\n\ncrawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> FilePath -> IO (Maybe Status)\ncrawlFile foreignDeps mvar pkg src docsStatus expectedName path =\n  do  bytes <- File.readUtf8 path\n      case Parse.fromByteString (Parse.Package pkg) bytes of\n        Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _) | expectedName == actualName ->\n          do  deps <- crawlImports foreignDeps mvar pkg src imports\n              return (Just (SLocal docsStatus deps modul))\n\n        _ ->\n          return Nothing\n\n\ncrawlImports :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> [Src.Import] -> IO (Map.Map ModuleName.Raw ())\ncrawlImports foreignDeps mvar pkg src imports =\n  do  statusDict <- takeMVar mvar\n      let deps = Map.fromList (map (\\i -> (Src.getImportName i, ())) imports)\n      let news = Map.difference deps statusDict\n      mvars <- Map.traverseWithKey (const . fork . crawlModule foreignDeps mvar pkg src DocsNotNeeded) news\n      putMVar mvar (Map.union mvars statusDict)\n      mapM_ readMVar mvars\n      return deps\n\n\ncrawlKernel :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> ModuleName.Raw -> IO (Maybe Status)\ncrawlKernel foreignDeps mvar pkg src name =\n  do  let path = src </> ModuleName.toFilePath name <.> \"js\"\n      exists <- File.exists path\n      if exists\n        then\n          do  bytes <- File.readUtf8 path\n              case Kernel.fromByteString pkg (Map.mapMaybe getDepHome foreignDeps) bytes of\n                Nothing ->\n                  return Nothing\n\n                Just (Kernel.Content imports chunks) ->\n                  do  _ <- crawlImports foreignDeps mvar pkg src imports\n                      return (Just (SKernelLocal chunks))\n        else\n          return (Just SKernelForeign)\n\n\ngetDepHome :: ForeignInterface -> Maybe Pkg.Name\ngetDepHome fi =\n  case fi of\n    ForeignSpecific (I.Interface pkg _ _ _ _) -> Just pkg\n    ForeignAmbiguous                          -> Nothing\n\n\n\n-- COMPILE\n\n\ndata Result\n  = RLocal !I.Interface !Opt.LocalGraph (Maybe Docs.Module)\n  | RForeign I.Interface\n  | RKernelLocal [Kernel.Chunk]\n  | RKernelForeign\n\n\ncompile :: Pkg.Name -> MVar (Map.Map ModuleName.Raw (MVar (Maybe Result))) -> Status -> IO (Maybe Result)\ncompile pkg mvar status =\n  case status of\n    SLocal docsStatus deps modul ->\n      do  resultsDict <- readMVar mvar\n          maybeResults <- traverse readMVar (Map.intersection resultsDict deps)\n          case sequence maybeResults of\n            Nothing ->\n              return Nothing\n\n            Just results ->\n              case Compile.compile pkg (Map.mapMaybe getInterface results) modul of\n                Left _ ->\n                  return Nothing\n\n                Right (Compile.Artifacts canonical annotations objects) ->\n                  let\n                    ifaces = I.fromModule pkg canonical annotations\n                    docs = makeDocs docsStatus canonical\n                  in\n                  return (Just (RLocal ifaces objects docs))\n\n    SForeign iface ->\n      return (Just (RForeign iface))\n\n    SKernelLocal chunks ->\n      return (Just (RKernelLocal chunks))\n\n    SKernelForeign ->\n      return (Just RKernelForeign)\n\n\ngetInterface :: Result -> Maybe I.Interface\ngetInterface result =\n  case result of\n    RLocal iface _ _ -> Just iface\n    RForeign iface   -> Just iface\n    RKernelLocal _   -> Nothing\n    RKernelForeign   -> Nothing\n\n\n\n-- MAKE DOCS\n\n\ndata DocsStatus\n  = DocsNeeded\n  | DocsNotNeeded\n\n\ngetDocsStatus :: Stuff.PackageCache -> Pkg.Name -> V.Version -> IO DocsStatus\ngetDocsStatus cache pkg vsn =\n  do  exists <- File.exists (Stuff.package cache pkg vsn </> \"docs.json\")\n      if exists\n        then return DocsNotNeeded\n        else return DocsNeeded\n\n\nmakeDocs :: DocsStatus -> Can.Module -> Maybe Docs.Module\nmakeDocs status modul =\n  case status of\n    DocsNeeded ->\n      case Docs.fromModule modul of\n        Right docs -> Just docs\n        Left _     -> Nothing\n\n    DocsNotNeeded ->\n      Nothing\n\n\nwriteDocs :: Stuff.PackageCache -> Pkg.Name -> V.Version -> DocsStatus -> Map.Map ModuleName.Raw Result -> IO ()\nwriteDocs cache pkg vsn status results =\n  case status of\n    DocsNeeded ->\n      E.writeUgly (Stuff.package cache pkg vsn </> \"docs.json\") $\n        Docs.encode $ Map.mapMaybe toDocs results\n\n    DocsNotNeeded ->\n      return ()\n\n\ntoDocs :: Result -> Maybe Docs.Module\ntoDocs result =\n  case result of\n    RLocal _ _ docs -> docs\n    RForeign _      -> Nothing\n    RKernelLocal _  -> Nothing\n    RKernelForeign  -> Nothing\n\n\n\n-- DOWNLOAD PACKAGE\n\n\ndownloadPackage :: Stuff.PackageCache -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.PackageProblem ())\ndownloadPackage cache manager pkg vsn =\n  let\n    url = Website.metadata pkg vsn \"endpoint.json\"\n  in\n  do  eitherByteString <-\n        Http.get manager url [] id (return . Right)\n\n      case eitherByteString of\n        Left err ->\n          return $ Left $ Exit.PP_BadEndpointRequest err\n\n        Right byteString ->\n          case D.fromByteString endpointDecoder byteString of\n            Left _ ->\n              return $ Left $ Exit.PP_BadEndpointContent url\n\n            Right (endpoint, expectedHash) ->\n              Http.getArchive manager endpoint Exit.PP_BadArchiveRequest (Exit.PP_BadArchiveContent endpoint) $\n                \\(sha, archive) ->\n                  if expectedHash == Http.shaToChars sha\n                  then Right <$> File.writePackage (Stuff.package cache pkg vsn) archive\n                  else return $ Left $ Exit.PP_BadArchiveHash endpoint expectedHash (Http.shaToChars sha)\n\n\nendpointDecoder :: D.Decoder e (String, String)\nendpointDecoder =\n  do  url <- D.field \"url\" D.string\n      hash <- D.field \"hash\" D.string\n      return (Utf8.toChars url, Utf8.toChars hash)\n\n\n\n-- BINARY\n\n\ninstance Binary Details where\n  put (Details a b c d e _) = put a >> put b >> put c >> put d >> put e\n  get =\n    do  a <- get\n        b <- get\n        c <- get\n        d <- get\n        e <- get\n        return (Details a b c d e ArtifactsCached)\n\n\ninstance Binary ValidOutline where\n  put outline =\n    case outline of\n      ValidApp a     -> putWord8 0 >> put a\n      ValidPkg a b c -> putWord8 1 >> put a >> put b >> put c\n\n  get =\n    do  n <- getWord8\n        case n of\n          0 -> liftM  ValidApp get\n          1 -> liftM3 ValidPkg get get get\n          _ -> fail \"binary encoding of ValidOutline was corrupted\"\n\n\ninstance Binary Local where\n  put (Local a b c d e f) = put a >> put b >> put c >> put d >> put e >> put f\n  get =\n    do  a <- get\n        b <- get\n        c <- get\n        d <- get\n        e <- get\n        f <- get\n        return (Local a b c d e f)\n\n\ninstance Binary Foreign where\n  get = liftM2 Foreign get get\n  put (Foreign a b) = put a >> put b\n\n\ninstance Binary Artifacts where\n  get = liftM2 Artifacts get get\n  put (Artifacts a b) = put a >> put b\n\n\ninstance Binary ArtifactCache where\n  get = liftM2 ArtifactCache get get\n  put (ArtifactCache a b) = put a >> put b\n"
  },
  {
    "path": "builder/src/Elm/Outline.hs",
    "content": "{-# LANGUAGE MultiWayIf, OverloadedStrings #-}\nmodule Elm.Outline\n  ( Outline(..)\n  , AppOutline(..)\n  , PkgOutline(..)\n  , Exposed(..)\n  , SrcDir(..)\n  , read\n  , write\n  , encode\n  , decoder\n  , defaultSummary\n  , flattenExposed\n  )\n  where\n\n\nimport Prelude hiding (read)\nimport Control.Monad (filterM, liftM)\nimport Data.Binary (Binary, get, put, getWord8, putWord8)\nimport qualified Data.Map as Map\nimport qualified Data.NonEmptyList as NE\nimport qualified Data.OneOrMore as OneOrMore\nimport Foreign.Ptr (minusPtr)\nimport qualified System.Directory as Dir\nimport qualified System.FilePath as FP\nimport System.FilePath ((</>))\n\nimport qualified Elm.Constraint as Con\nimport qualified Elm.Licenses as Licenses\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified File\nimport qualified Json.Decode as D\nimport qualified Json.Encode as E\nimport Json.Encode ((==>))\nimport qualified Json.String as Json\nimport qualified Parse.Primitives as P\nimport qualified Reporting.Exit as Exit\n\n\n\n-- OUTLINE\n\n\ndata Outline\n  = App AppOutline\n  | Pkg PkgOutline\n\n\ndata AppOutline =\n  AppOutline\n    { _app_elm_version :: V.Version\n    , _app_source_dirs :: NE.List SrcDir\n    , _app_deps_direct :: Map.Map Pkg.Name V.Version\n    , _app_deps_indirect :: Map.Map Pkg.Name V.Version\n    , _app_test_direct :: Map.Map Pkg.Name V.Version\n    , _app_test_indirect :: Map.Map Pkg.Name V.Version\n    }\n\n\ndata PkgOutline =\n  PkgOutline\n    { _pkg_name :: Pkg.Name\n    , _pkg_summary :: Json.String\n    , _pkg_license :: Licenses.License\n    , _pkg_version :: V.Version\n    , _pkg_exposed :: Exposed\n    , _pkg_deps :: Map.Map Pkg.Name Con.Constraint\n    , _pkg_test_deps :: Map.Map Pkg.Name Con.Constraint\n    , _pkg_elm_version :: Con.Constraint\n    }\n\n\ndata Exposed\n  = ExposedList [ModuleName.Raw]\n  | ExposedDict [(Json.String, [ModuleName.Raw])]\n\n\ndata SrcDir\n  = AbsoluteSrcDir FilePath\n  | RelativeSrcDir FilePath\n\n\n\n-- DEFAULTS\n\n\ndefaultSummary :: Json.String\ndefaultSummary =\n  Json.fromChars \"helpful summary of your project, less than 80 characters\"\n\n\n\n-- HELPERS\n\n\nflattenExposed :: Exposed -> [ModuleName.Raw]\nflattenExposed exposed =\n  case exposed of\n    ExposedList names ->\n      names\n\n    ExposedDict sections ->\n      concatMap snd sections\n\n\n\n-- WRITE\n\n\nwrite :: FilePath -> Outline -> IO ()\nwrite root outline =\n  E.write (root </> \"elm.json\") (encode outline)\n\n\n\n-- JSON ENCODE\n\n\nencode :: Outline -> E.Value\nencode outline =\n  case outline of\n    App (AppOutline elm srcDirs depsDirect depsTrans testDirect testTrans) ->\n      E.object\n        [ \"type\" ==> E.chars \"application\"\n        , \"source-directories\" ==> E.list encodeSrcDir (NE.toList srcDirs)\n        , \"elm-version\" ==> V.encode elm\n        , \"dependencies\" ==>\n            E.object\n              [ \"direct\" ==> encodeDeps V.encode depsDirect\n              , \"indirect\" ==> encodeDeps V.encode depsTrans\n              ]\n        , \"test-dependencies\" ==>\n            E.object\n              [ \"direct\" ==> encodeDeps V.encode testDirect\n              , \"indirect\" ==> encodeDeps V.encode testTrans\n              ]\n        ]\n\n    Pkg (PkgOutline name summary license version exposed deps tests elm) ->\n      E.object\n        [ \"type\" ==> E.string (Json.fromChars \"package\")\n        , \"name\" ==> Pkg.encode name\n        , \"summary\" ==> E.string summary\n        , \"license\" ==> Licenses.encode license\n        , \"version\" ==> V.encode version\n        , \"exposed-modules\" ==> encodeExposed exposed\n        , \"elm-version\" ==> Con.encode elm\n        , \"dependencies\" ==> encodeDeps Con.encode deps\n        , \"test-dependencies\" ==> encodeDeps Con.encode tests\n        ]\n\n\nencodeExposed :: Exposed -> E.Value\nencodeExposed exposed =\n  case exposed of\n    ExposedList modules ->\n      E.list encodeModule modules\n\n    ExposedDict chunks ->\n      E.object (map (fmap (E.list encodeModule)) chunks)\n\n\nencodeModule :: ModuleName.Raw -> E.Value\nencodeModule name =\n  E.name name\n\n\nencodeDeps :: (a -> E.Value) -> Map.Map Pkg.Name a -> E.Value\nencodeDeps encodeValue deps =\n  E.dict Pkg.toJsonString encodeValue deps\n\n\nencodeSrcDir :: SrcDir -> E.Value\nencodeSrcDir srcDir =\n  case srcDir of\n    AbsoluteSrcDir dir -> E.chars dir\n    RelativeSrcDir dir -> E.chars dir\n\n\n\n-- PARSE AND VERIFY\n\n\nread :: FilePath -> IO (Either Exit.Outline Outline)\nread root =\n  do  bytes <- File.readUtf8 (root </> \"elm.json\")\n      case D.fromByteString decoder bytes of\n        Left err ->\n          return $ Left (Exit.OutlineHasBadStructure err)\n\n        Right outline ->\n          case outline of\n            Pkg (PkgOutline pkg _ _ _ _ deps _ _) ->\n              return $\n                if Map.notMember Pkg.core deps && pkg /= Pkg.core\n                then Left Exit.OutlineNoPkgCore\n                else Right outline\n\n            App (AppOutline _ srcDirs direct indirect _ _)\n              | Map.notMember Pkg.core direct ->\n                  return $ Left Exit.OutlineNoAppCore\n\n              | Map.notMember Pkg.json direct && Map.notMember Pkg.json indirect ->\n                  return $ Left Exit.OutlineNoAppJson\n\n              | otherwise ->\n                  do  badDirs <- filterM (isSrcDirMissing root) (NE.toList srcDirs)\n                      case map toGiven badDirs of\n                        d:ds ->\n                          return $ Left (Exit.OutlineHasMissingSrcDirs d ds)\n\n                        [] ->\n                          do  maybeDups <- detectDuplicates root (NE.toList srcDirs)\n                              case maybeDups of\n                                Nothing ->\n                                  return $ Right outline\n\n                                Just (canonicalDir, (dir1,dir2)) ->\n                                  return $ Left (Exit.OutlineHasDuplicateSrcDirs canonicalDir dir1 dir2)\n\n\nisSrcDirMissing :: FilePath -> SrcDir -> IO Bool\nisSrcDirMissing root srcDir =\n  not <$> Dir.doesDirectoryExist (toAbsolute root srcDir)\n\n\ntoGiven :: SrcDir -> FilePath\ntoGiven srcDir =\n  case srcDir of\n    AbsoluteSrcDir dir -> dir\n    RelativeSrcDir dir -> dir\n\n\ntoAbsolute :: FilePath -> SrcDir -> FilePath\ntoAbsolute root srcDir =\n  case srcDir of\n    AbsoluteSrcDir dir -> dir\n    RelativeSrcDir dir -> root </> dir\n\n\ndetectDuplicates :: FilePath -> [SrcDir] -> IO (Maybe (FilePath, (FilePath, FilePath)))\ndetectDuplicates root srcDirs =\n  do  pairs <- traverse (toPair root) srcDirs\n      return $ Map.lookupMin $ Map.mapMaybe isDup $\n        Map.fromListWith OneOrMore.more pairs\n\n\ntoPair :: FilePath -> SrcDir -> IO (FilePath, OneOrMore.OneOrMore FilePath)\ntoPair root srcDir =\n  do  key <- Dir.canonicalizePath (toAbsolute root srcDir)\n      return (key, OneOrMore.one (toGiven srcDir))\n\n\nisDup :: OneOrMore.OneOrMore FilePath -> Maybe (FilePath, FilePath)\nisDup paths =\n  case paths of\n    OneOrMore.One _    -> Nothing\n    OneOrMore.More a b -> Just (OneOrMore.getFirstTwo a b)\n\n\n\n-- JSON DECODE\n\n\ntype Decoder a =\n  D.Decoder Exit.OutlineProblem a\n\n\ndecoder :: Decoder Outline\ndecoder =\n  let\n    application = Json.fromChars \"application\"\n    package     = Json.fromChars \"package\"\n  in\n  do  tipe <- D.field \"type\" D.string\n      if  | tipe == application -> App <$> appDecoder\n          | tipe == package     -> Pkg <$> pkgDecoder\n          | otherwise           -> D.failure Exit.OP_BadType\n\n\nappDecoder :: Decoder AppOutline\nappDecoder =\n  AppOutline\n    <$> D.field \"elm-version\" versionDecoder\n    <*> D.field \"source-directories\" dirsDecoder\n    <*> D.field \"dependencies\" (D.field \"direct\" (depsDecoder versionDecoder))\n    <*> D.field \"dependencies\" (D.field \"indirect\" (depsDecoder versionDecoder))\n    <*> D.field \"test-dependencies\" (D.field \"direct\" (depsDecoder versionDecoder))\n    <*> D.field \"test-dependencies\" (D.field \"indirect\" (depsDecoder versionDecoder))\n\n\npkgDecoder :: Decoder PkgOutline\npkgDecoder =\n  PkgOutline\n    <$> D.field \"name\" nameDecoder\n    <*> D.field \"summary\" summaryDecoder\n    <*> D.field \"license\" (Licenses.decoder Exit.OP_BadLicense)\n    <*> D.field \"version\" versionDecoder\n    <*> D.field \"exposed-modules\" exposedDecoder\n    <*> D.field \"dependencies\" (depsDecoder constraintDecoder)\n    <*> D.field \"test-dependencies\" (depsDecoder constraintDecoder)\n    <*> D.field \"elm-version\" constraintDecoder\n\n\n\n-- JSON DECODE HELPERS\n\n\nnameDecoder :: Decoder Pkg.Name\nnameDecoder =\n  D.mapError (uncurry Exit.OP_BadPkgName) Pkg.decoder\n\n\nsummaryDecoder :: Decoder Json.String\nsummaryDecoder =\n  D.customString\n    (boundParser 80 Exit.OP_BadSummaryTooLong)\n    (\\_ _ -> Exit.OP_BadSummaryTooLong)\n\n\nversionDecoder :: Decoder V.Version\nversionDecoder =\n  D.mapError (uncurry Exit.OP_BadVersion) V.decoder\n\n\nconstraintDecoder :: Decoder Con.Constraint\nconstraintDecoder =\n  D.mapError Exit.OP_BadConstraint Con.decoder\n\n\ndepsDecoder :: Decoder a -> Decoder (Map.Map Pkg.Name a)\ndepsDecoder valueDecoder =\n  D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder\n\n\ndirsDecoder :: Decoder (NE.List SrcDir)\ndirsDecoder =\n  fmap (toSrcDir . Json.toChars) <$> D.nonEmptyList D.string Exit.OP_NoSrcDirs\n\n\ntoSrcDir :: FilePath -> SrcDir\ntoSrcDir path =\n  if FP.isRelative path\n  then RelativeSrcDir path\n  else AbsoluteSrcDir path\n\n\n\n-- EXPOSED MODULES DECODER\n\n\nexposedDecoder :: Decoder Exposed\nexposedDecoder =\n  D.oneOf\n    [ ExposedList <$> D.list moduleDecoder\n    , ExposedDict <$> D.pairs headerKeyDecoder (D.list moduleDecoder)\n    ]\n\n\nmoduleDecoder :: Decoder ModuleName.Raw\nmoduleDecoder =\n  D.mapError (uncurry Exit.OP_BadModuleName) ModuleName.decoder\n\n\nheaderKeyDecoder :: D.KeyDecoder Exit.OutlineProblem Json.String\nheaderKeyDecoder =\n  D.KeyDecoder\n    (boundParser 20 Exit.OP_BadModuleHeaderTooLong)\n    (\\_ _ -> Exit.OP_BadModuleHeaderTooLong)\n\n\n\n-- BOUND PARSER\n\n\nboundParser :: Int -> x -> P.Parser x Json.String\nboundParser bound tooLong =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr _ ->\n    let\n      len = minusPtr end pos\n      newCol = col + fromIntegral len\n    in\n    if len < bound\n    then cok (Json.fromPtr pos end) (P.State src end end indent row newCol)\n    else cerr row newCol (\\_ _ -> tooLong)\n\n\n\n-- BINARY\n\n\ninstance Binary SrcDir where\n  put outline =\n    case outline of\n      AbsoluteSrcDir a -> putWord8 0 >> put a\n      RelativeSrcDir a -> putWord8 1 >> put a\n\n  get =\n    do  n <- getWord8\n        case n of\n          0 -> liftM AbsoluteSrcDir get\n          1 -> liftM RelativeSrcDir get\n          _ -> fail \"binary encoding of SrcDir was corrupted\"\n"
  },
  {
    "path": "builder/src/File.hs",
    "content": "module File\n  ( Time\n  , getTime\n  , zeroTime\n  , writeBinary\n  , readBinary\n  , writeUtf8\n  , readUtf8\n  , writeBuilder\n  , writePackage\n  , exists\n  , remove\n  , removeDir\n  )\n  where\n\n\nimport qualified Codec.Archive.Zip as Zip\nimport Control.Exception (catch)\nimport qualified Data.Binary as Binary\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Internal as BS\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.ByteString.Lazy as LBS\nimport qualified Data.Fixed as Fixed\nimport qualified Data.List as List\nimport qualified Data.Time.Clock as Time\nimport qualified Data.Time.Clock.POSIX as Time\nimport qualified Foreign.ForeignPtr as FPtr\nimport GHC.IO.Exception (IOException, IOErrorType(InvalidArgument))\nimport qualified System.Directory as Dir\nimport qualified System.FilePath as FP\nimport System.FilePath ((</>))\nimport qualified System.IO as IO\nimport System.IO.Error (ioeGetErrorType, annotateIOError, modifyIOError)\n\n\n\n-- TIME\n\n\nnewtype Time = Time Fixed.Pico\n  deriving (Eq, Ord)\n\n\ngetTime :: FilePath -> IO Time\ngetTime path =\n  fmap\n    (Time . Time.nominalDiffTimeToSeconds . Time.utcTimeToPOSIXSeconds)\n    (Dir.getModificationTime path)\n\n\nzeroTime :: Time\nzeroTime =\n  Time 0\n\n\ninstance Binary.Binary Time where\n  put (Time time) = Binary.put time\n  get = Time <$> Binary.get\n\n\n\n-- BINARY\n\n\nwriteBinary :: (Binary.Binary a) => FilePath -> a -> IO ()\nwriteBinary path value =\n  do  let dir = FP.dropFileName path\n      Dir.createDirectoryIfMissing True dir\n      Binary.encodeFile path value\n\n\nreadBinary :: (Binary.Binary a) => FilePath -> IO (Maybe a)\nreadBinary path =\n  do  pathExists <- Dir.doesFileExist path\n      if pathExists\n        then\n          do  result <- Binary.decodeFileOrFail path\n              case result of\n                Right a ->\n                  return (Just a)\n\n                Left (offset, message) ->\n                  do  IO.hPutStrLn IO.stderr $ unlines $\n                        [ \"+-------------------------------------------------------------------------------\"\n                        , \"|  Corrupt File: \" ++ path\n                        , \"|   Byte Offset: \" ++ show offset\n                        , \"|       Message: \" ++ message\n                        , \"|\"\n                        , \"| Please report this to https://github.com/elm/compiler/issues\"\n                        , \"| Trying to continue anyway.\"\n                        , \"+-------------------------------------------------------------------------------\"\n                        ]\n                      return Nothing\n        else\n          return Nothing\n\n\n\n-- WRITE UTF-8\n\n\nwriteUtf8 :: FilePath -> BS.ByteString -> IO ()\nwriteUtf8 path content =\n  withUtf8 path IO.WriteMode $ \\handle ->\n    BS.hPut handle content\n\n\nwithUtf8 :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a\nwithUtf8 path mode callback =\n  IO.withFile path mode $ \\handle ->\n    do  IO.hSetEncoding handle IO.utf8\n        callback handle\n\n\n\n-- READ UTF-8\n\n\nreadUtf8 :: FilePath -> IO BS.ByteString\nreadUtf8 path =\n  withUtf8 path IO.ReadMode $ \\handle ->\n    modifyIOError (encodingError path) $\n      do  fileSize <- catch (IO.hFileSize handle) useZeroIfNotRegularFile\n          let readSize = max 0 (fromIntegral fileSize) + 1\n          hGetContentsSizeHint handle readSize (max 255 readSize)\n\n\nuseZeroIfNotRegularFile :: IOException -> IO Integer\nuseZeroIfNotRegularFile _ =\n  return 0\n\n\nhGetContentsSizeHint :: IO.Handle -> Int -> Int -> IO BS.ByteString\nhGetContentsSizeHint handle =\n    readChunks []\n  where\n    readChunks chunks readSize incrementSize =\n      do  fp <- BS.mallocByteString readSize\n          readCount <- FPtr.withForeignPtr fp $ \\buf -> IO.hGetBuf handle buf readSize\n          let chunk = BS.PS fp 0 readCount\n          if readCount < readSize && readSize > 0\n            then return $! BS.concat (reverse (chunk:chunks))\n            else readChunks (chunk:chunks) incrementSize (min 32752 (readSize + incrementSize))\n\n\nencodingError :: FilePath -> IOError -> IOError\nencodingError path ioErr =\n  case ioeGetErrorType ioErr of\n    InvalidArgument ->\n      annotateIOError\n        (userError \"Bad encoding; the file must be valid UTF-8\")\n        \"\"\n        Nothing\n        (Just path)\n\n    _ ->\n      ioErr\n\n\n\n-- WRITE BUILDER\n\n\nwriteBuilder :: FilePath -> B.Builder -> IO ()\nwriteBuilder path builder =\n  IO.withBinaryFile path IO.WriteMode $ \\handle ->\n    do  IO.hSetBuffering handle (IO.BlockBuffering Nothing)\n        B.hPutBuilder handle builder\n\n\n\n-- WRITE PACKAGE\n\n\nwritePackage :: FilePath -> Zip.Archive -> IO ()\nwritePackage destination archive =\n  case Zip.zEntries archive of\n    [] ->\n      return ()\n\n    entry:entries ->\n      do  let root = length (Zip.eRelativePath entry)\n          mapM_ (writeEntry destination root) entries\n\n\nwriteEntry :: FilePath -> Int -> Zip.Entry -> IO ()\nwriteEntry destination root entry =\n  let\n    path = drop root (Zip.eRelativePath entry)\n  in\n  if List.isPrefixOf \"src/\" path\n    || path == \"LICENSE\"\n    || path == \"README.md\"\n    || path == \"elm.json\"\n  then\n      if not (null path) && last path == '/'\n      then Dir.createDirectoryIfMissing True (destination </> path)\n      else LBS.writeFile (destination </> path) (Zip.fromEntry entry)\n  else\n      return ()\n\n\n\n-- EXISTS\n\n\nexists :: FilePath -> IO Bool\nexists path =\n  Dir.doesFileExist path\n\n\n\n-- REMOVE FILES\n\n\nremove :: FilePath -> IO ()\nremove path =\n  do  exists_ <- Dir.doesFileExist path\n      if exists_\n        then Dir.removeFile path\n        else return ()\n\n\nremoveDir :: FilePath -> IO ()\nremoveDir path =\n  do  exists_ <- Dir.doesDirectoryExist path\n      if exists_\n        then Dir.removeDirectoryRecursive path\n        else return ()\n"
  },
  {
    "path": "builder/src/Generate.hs",
    "content": "{-# LANGUAGE BangPatterns #-}\nmodule Generate\n  ( debug\n  , dev\n  , prod\n  , repl\n  )\n  where\n\n\nimport Prelude hiding (cycle, print)\nimport Control.Concurrent (MVar, forkIO, newEmptyMVar, newMVar, putMVar, readMVar)\nimport Control.Monad (liftM2)\nimport qualified Data.ByteString.Builder as B\nimport Data.Map ((!))\nimport qualified Data.Map as Map\nimport qualified Data.Maybe as Maybe\nimport qualified Data.Name as N\nimport qualified Data.NonEmptyList as NE\n\nimport qualified AST.Optimized as Opt\nimport qualified Build\nimport qualified Elm.Compiler.Type.Extract as Extract\nimport qualified Elm.Details as Details\nimport qualified Elm.Interface as I\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified File\nimport qualified Generate.JavaScript as JS\nimport qualified Generate.Mode as Mode\nimport qualified Nitpick.Debug as Nitpick\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Task as Task\nimport qualified Stuff\n\n\n-- NOTE: This is used by Make, Repl, and Reactor right now. But it may be\n-- desireable to have Repl and Reactor to keep foreign objects in memory\n-- to make things a bit faster?\n\n\n\n-- GENERATORS\n\n\ntype Task a =\n  Task.Task Exit.Generate a\n\n\ndebug :: FilePath -> Details.Details -> Build.Artifacts -> Task B.Builder\ndebug root details (Build.Artifacts pkg ifaces roots modules) =\n  do  loading <- loadObjects root details modules\n      types   <- loadTypes root ifaces modules\n      objects <- finalizeObjects loading\n      let mode = Mode.Dev (Just types)\n      let graph = objectsToGlobalGraph objects\n      let mains = gatherMains pkg objects roots\n      return $ JS.generate mode graph mains\n\n\ndev :: FilePath -> Details.Details -> Build.Artifacts -> Task B.Builder\ndev root details (Build.Artifacts pkg _ roots modules) =\n  do  objects <- finalizeObjects =<< loadObjects root details modules\n      let mode = Mode.Dev Nothing\n      let graph = objectsToGlobalGraph objects\n      let mains = gatherMains pkg objects roots\n      return $ JS.generate mode graph mains\n\n\nprod :: FilePath -> Details.Details -> Build.Artifacts -> Task B.Builder\nprod root details (Build.Artifacts pkg _ roots modules) =\n  do  objects <- finalizeObjects =<< loadObjects root details modules\n      checkForDebugUses objects\n      let graph = objectsToGlobalGraph objects\n      let mode = Mode.Prod (Mode.shortenFieldNames graph)\n      let mains = gatherMains pkg objects roots\n      return $ JS.generate mode graph mains\n\n\nrepl :: FilePath -> Details.Details -> Bool -> Build.ReplArtifacts -> N.Name -> Task B.Builder\nrepl root details ansi (Build.ReplArtifacts home modules localizer annotations) name =\n  do  objects <- finalizeObjects =<< loadObjects root details modules\n      let graph = objectsToGlobalGraph objects\n      return $ JS.generateForRepl ansi localizer graph home name (annotations ! name)\n\n\n\n-- CHECK FOR DEBUG\n\n\ncheckForDebugUses :: Objects -> Task ()\ncheckForDebugUses (Objects _ locals) =\n  case Map.keys (Map.filter Nitpick.hasDebugUses locals) of\n    []   -> return ()\n    m:ms -> Task.throw (Exit.GenerateCannotOptimizeDebugValues m ms)\n\n\n\n-- GATHER MAINS\n\n\ngatherMains :: Pkg.Name -> Objects -> NE.List Build.Root -> Map.Map ModuleName.Canonical Opt.Main\ngatherMains pkg (Objects _ locals) roots =\n  Map.fromList $ Maybe.mapMaybe (lookupMain pkg locals) (NE.toList roots)\n\n\nlookupMain :: Pkg.Name -> Map.Map ModuleName.Raw Opt.LocalGraph -> Build.Root -> Maybe (ModuleName.Canonical, Opt.Main)\nlookupMain pkg locals root =\n  let\n    toPair name (Opt.LocalGraph maybeMain _ _) =\n      (,) (ModuleName.Canonical pkg name) <$> maybeMain\n  in\n  case root of\n    Build.Inside  name     -> toPair name =<< Map.lookup name locals\n    Build.Outside name _ g -> toPair name g\n\n\n\n-- LOADING OBJECTS\n\n\ndata LoadingObjects =\n  LoadingObjects\n    { _foreign_mvar :: MVar (Maybe Opt.GlobalGraph)\n    , _local_mvars :: Map.Map ModuleName.Raw (MVar (Maybe Opt.LocalGraph))\n    }\n\n\nloadObjects :: FilePath -> Details.Details -> [Build.Module] -> Task LoadingObjects\nloadObjects root details modules =\n  Task.io $\n  do  mvar <- Details.loadObjects root details\n      mvars <- traverse (loadObject root) modules\n      return $ LoadingObjects mvar (Map.fromList mvars)\n\n\nloadObject :: FilePath -> Build.Module -> IO (ModuleName.Raw, MVar (Maybe Opt.LocalGraph))\nloadObject root modul =\n  case modul of\n    Build.Fresh name _ graph ->\n      do  mvar <- newMVar (Just graph)\n          return (name, mvar)\n\n    Build.Cached name _ _ ->\n      do  mvar <- newEmptyMVar\n          _ <- forkIO $ putMVar mvar =<< File.readBinary (Stuff.elmo root name)\n          return (name, mvar)\n\n\n\n-- FINALIZE OBJECTS\n\n\ndata Objects =\n  Objects\n    { _foreign :: Opt.GlobalGraph\n    , _locals :: Map.Map ModuleName.Raw Opt.LocalGraph\n    }\n\n\nfinalizeObjects :: LoadingObjects -> Task Objects\nfinalizeObjects (LoadingObjects mvar mvars) =\n  Task.eio id $\n  do  result  <- readMVar mvar\n      results <- traverse readMVar mvars\n      case liftM2 Objects result (sequence results) of\n        Just loaded -> return (Right loaded)\n        Nothing     -> return (Left Exit.GenerateCannotLoadArtifacts)\n\n\nobjectsToGlobalGraph :: Objects -> Opt.GlobalGraph\nobjectsToGlobalGraph (Objects globals locals) =\n  foldr Opt.addLocalGraph globals locals\n\n\n\n-- LOAD TYPES\n\n\nloadTypes :: FilePath -> Map.Map ModuleName.Canonical I.DependencyInterface -> [Build.Module] -> Task Extract.Types\nloadTypes root ifaces modules =\n  Task.eio id $\n  do  mvars <- traverse (loadTypesHelp root) modules\n      let !foreigns = Extract.mergeMany (Map.elems (Map.mapWithKey Extract.fromDependencyInterface ifaces))\n      results <- traverse readMVar mvars\n      case sequence results of\n        Just ts -> return (Right (Extract.merge foreigns (Extract.mergeMany ts)))\n        Nothing -> return (Left Exit.GenerateCannotLoadArtifacts)\n\n\nloadTypesHelp :: FilePath -> Build.Module -> IO (MVar (Maybe Extract.Types))\nloadTypesHelp root modul =\n  case modul of\n    Build.Fresh name iface _ ->\n      newMVar (Just (Extract.fromInterface name iface))\n\n    Build.Cached name _ ciMVar ->\n      do  cachedInterface <- readMVar ciMVar\n          case cachedInterface of\n            Build.Unneeded ->\n              do  mvar <- newEmptyMVar\n                  _ <- forkIO $\n                    do  maybeIface <- File.readBinary (Stuff.elmi root name)\n                        putMVar mvar (Extract.fromInterface name <$> maybeIface)\n                  return mvar\n\n            Build.Loaded iface ->\n              newMVar (Just (Extract.fromInterface name iface))\n\n            Build.Corrupted ->\n              newMVar Nothing\n"
  },
  {
    "path": "builder/src/Http.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Http\n  ( Manager\n  , getManager\n  , toUrl\n  -- fetch\n  , get\n  , post\n  , Header\n  , accept\n  , Error(..)\n  -- archives\n  , Sha\n  , shaToChars\n  , getArchive\n  -- upload\n  , upload\n  , filePart\n  , jsonPart\n  , stringPart\n  )\n  where\n\n\nimport Prelude hiding (zip)\nimport qualified Codec.Archive.Zip as Zip\nimport Control.Exception (SomeException, handle)\nimport qualified Data.Binary as Binary\nimport qualified Data.Binary.Get as Binary\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.ByteString.Char8 as BS\nimport qualified Data.Digest.Pure.SHA as SHA\nimport qualified Data.String as String\nimport Network.HTTP (urlEncodeVars)\nimport Network.HTTP.Client\nimport Network.HTTP.Client.TLS (tlsManagerSettings)\nimport Network.HTTP.Types.Header (Header, hAccept, hAcceptEncoding, hUserAgent)\nimport Network.HTTP.Types.Method (Method, methodGet, methodPost)\nimport qualified Network.HTTP.Client as Multi (RequestBody(RequestBodyLBS))\nimport qualified Network.HTTP.Client.MultipartFormData as Multi\n\nimport qualified Json.Encode as Encode\nimport qualified Elm.Version as V\n\n\n\n-- MANAGER\n\n\ngetManager :: IO Manager\ngetManager =\n  newManager tlsManagerSettings\n\n\n\n-- URL\n\n\ntoUrl :: String -> [(String,String)] -> String\ntoUrl url params =\n  case params of\n    []  -> url\n    _:_ -> url ++ \"?\" ++ urlEncodeVars params\n\n\n\n-- FETCH\n\n\nget :: Manager -> String -> [Header] -> (Error -> e) -> (BS.ByteString -> IO (Either e a)) -> IO (Either e a)\nget =\n  fetch methodGet\n\n\npost :: Manager -> String -> [Header] -> (Error -> e) -> (BS.ByteString -> IO (Either e a)) -> IO (Either e a)\npost =\n  fetch methodPost\n\n\nfetch :: Method -> Manager -> String -> [Header] -> (Error -> e) -> (BS.ByteString -> IO (Either e a)) -> IO (Either e a)\nfetch methodVerb manager url headers onError onSuccess =\n  handle (handleSomeException url onError) $\n  handle (handleHttpException url onError) $\n  do  req0 <- parseUrlThrow url\n      let req1 =\n            req0\n              { method = methodVerb\n              , requestHeaders = addDefaultHeaders headers\n              }\n      withResponse req1 manager $ \\response ->\n        do  chunks <- brConsume (responseBody response)\n            onSuccess (BS.concat chunks)\n\n\naddDefaultHeaders :: [Header] -> [Header]\naddDefaultHeaders headers =\n  (hUserAgent, userAgent) : (hAcceptEncoding, \"gzip\") : headers\n\n\n{-# NOINLINE userAgent #-}\nuserAgent :: BS.ByteString\nuserAgent =\n  BS.pack (\"elm/\" ++ V.toChars V.compiler)\n\n\naccept :: BS.ByteString -> Header\naccept mime =\n  (hAccept, mime)\n\n\n\n-- EXCEPTIONS\n\n\ndata Error\n  = BadUrl String String\n  | BadHttp String HttpExceptionContent\n  | BadMystery String SomeException\n\n\nhandleHttpException :: String -> (Error -> e) -> HttpException -> IO (Either e a)\nhandleHttpException url onError httpException =\n  case httpException of\n    InvalidUrlException _ reason ->\n      return (Left (onError (BadUrl url reason)))\n\n    HttpExceptionRequest _ content ->\n      return (Left (onError (BadHttp url content)))\n\n\nhandleSomeException :: String -> (Error -> e) -> SomeException -> IO (Either e a)\nhandleSomeException url onError exception =\n  return (Left (onError (BadMystery url exception)))\n\n\n\n-- SHA\n\n\ntype Sha = SHA.Digest SHA.SHA1State\n\n\nshaToChars :: Sha -> String\nshaToChars =\n  SHA.showDigest\n\n\n\n-- FETCH ARCHIVE\n\n\ngetArchive\n  :: Manager\n  -> String\n  -> (Error -> e)\n  -> e\n  -> ((Sha, Zip.Archive) -> IO (Either e a))\n  -> IO (Either e a)\ngetArchive manager url onError err onSuccess =\n  handle (handleSomeException url onError) $\n  handle (handleHttpException url onError) $\n  do  req0 <- parseUrlThrow url\n      let req1 =\n            req0\n              { method = methodGet\n              , requestHeaders = addDefaultHeaders []\n              }\n      withResponse req1 manager $ \\response ->\n        do  result <- readArchive (responseBody response)\n            case result of\n              Nothing -> return (Left err)\n              Just shaAndArchive -> onSuccess shaAndArchive\n\n\nreadArchive :: BodyReader -> IO (Maybe (Sha, Zip.Archive))\nreadArchive body =\n  readArchiveHelp body $\n    AS 0 SHA.sha1Incremental (Binary.runGetIncremental Binary.get)\n\n\ndata ArchiveState =\n  AS\n    { _len :: !Int\n    , _sha :: !(Binary.Decoder SHA.SHA1State)\n    , _zip :: !(Binary.Decoder Zip.Archive)\n    }\n\n\nreadArchiveHelp :: BodyReader -> ArchiveState -> IO (Maybe (Sha, Zip.Archive))\nreadArchiveHelp body (AS len sha zip) =\n  case zip of\n    Binary.Fail _ _ _ ->\n      return Nothing\n\n    Binary.Partial k ->\n      do  chunk <- brRead body\n          readArchiveHelp body $\n            AS\n              { _len = len + BS.length chunk\n              , _sha = Binary.pushChunk sha chunk\n              , _zip = k (if BS.null chunk then Nothing else Just chunk)\n              }\n\n    Binary.Done _ _ archive ->\n      return $ Just ( SHA.completeSha1Incremental sha len, archive )\n\n\n\n-- UPLOAD\n\n\nupload :: Manager -> String -> [Multi.Part] -> IO (Either Error ())\nupload manager url parts =\n  handle (handleSomeException url id) $\n  handle (handleHttpException url id) $\n  do  req0 <- parseUrlThrow url\n      req1 <-\n        Multi.formDataBody parts $\n          req0\n            { method = methodPost\n            , requestHeaders = addDefaultHeaders []\n            , responseTimeout = responseTimeoutNone\n            }\n      withResponse req1 manager $ \\_ ->\n        return (Right ())\n\n\nfilePart :: String -> FilePath -> Multi.Part\nfilePart name filePath =\n  Multi.partFileSource (String.fromString name) filePath\n\n\njsonPart :: String -> FilePath -> Encode.Value -> Multi.Part\njsonPart name filePath value =\n  let\n    body =\n      Multi.RequestBodyLBS $ B.toLazyByteString $ Encode.encodeUgly value\n  in\n  Multi.partFileRequestBody (String.fromString name) filePath body\n\n\nstringPart :: String -> String -> Multi.Part\nstringPart name string =\n  Multi.partBS (String.fromString name) (BS.pack string)\n"
  },
  {
    "path": "builder/src/Reporting/Exit/Help.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Exit.Help\n  ( Report\n  , report\n  , docReport\n  , jsonReport\n  , compilerReport\n  , reportToDoc\n  , reportToJson\n  , toString\n  , toStdout\n  , toStderr\n  )\n  where\n\n\nimport GHC.IO.Handle (hIsTerminalDevice)\nimport System.IO (Handle, hPutStr, stderr, stdout)\n\nimport qualified Json.Encode as E\nimport Json.Encode ((==>))\nimport Reporting.Doc ((<+>))\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Error as Error\n\n\n\n-- REPORT\n\n\ndata Report\n  = CompilerReport FilePath Error.Module [Error.Module]\n  | Report\n      { _title :: String\n      , _path :: Maybe FilePath\n      , _message :: D.Doc\n      }\n\n\nreport :: String -> Maybe FilePath -> String -> [D.Doc] -> Report\nreport title path startString others =\n  Report title path $ D.stack (D.reflow startString:others)\n\n\ndocReport :: String -> Maybe FilePath -> D.Doc -> [D.Doc] -> Report\ndocReport title path startDoc others =\n  Report title path $ D.stack (startDoc:others)\n\n\njsonReport :: String -> Maybe FilePath -> D.Doc -> Report\njsonReport =\n  Report\n\n\ncompilerReport :: FilePath -> Error.Module -> [Error.Module] -> Report\ncompilerReport =\n  CompilerReport\n\n\n\n-- TO DOC\n\n\nreportToDoc :: Report -> D.Doc\nreportToDoc report_ =\n  case report_ of\n    CompilerReport root e es ->\n      Error.toDoc root e es\n\n    Report title maybePath message ->\n      let\n        makeDashes n =\n          replicate (max 1 (80 - n)) '-'\n\n        errorBarEnd =\n          case maybePath of\n            Nothing ->\n              makeDashes (4 + length title)\n\n            Just path ->\n              makeDashes (5 + length title + length path) ++ \" \" ++ path\n\n        errorBar =\n          D.dullcyan $\n            \"--\" <+> D.fromChars title <+> D.fromChars errorBarEnd\n      in\n        D.stack [errorBar, message, \"\"]\n\n\n\n-- TO JSON\n\n\nreportToJson :: Report -> E.Value\nreportToJson report_ =\n  case report_ of\n    CompilerReport _ e es ->\n      E.object\n        [ \"type\" ==> E.chars \"compile-errors\"\n        , \"errors\" ==> E.list Error.toJson (e:es)\n        ]\n\n    Report title maybePath message ->\n      E.object\n        [ \"type\" ==> E.chars \"error\"\n        , \"path\" ==> maybe E.null E.chars maybePath\n        , \"title\" ==> E.chars title\n        , \"message\" ==> D.encode message\n        ]\n\n\n\n-- OUTPUT\n\n\ntoString :: D.Doc -> String\ntoString =\n  D.toString\n\n\ntoStdout :: D.Doc -> IO ()\ntoStdout doc =\n  toHandle stdout doc\n\n\ntoStderr :: D.Doc -> IO ()\ntoStderr doc =\n  toHandle stderr doc\n\n\ntoHandle :: Handle -> D.Doc -> IO ()\ntoHandle handle doc =\n  do  isTerminal <- hIsTerminalDevice handle\n      if isTerminal\n        then D.toAnsi handle doc\n        else hPutStr handle (toString doc)\n"
  },
  {
    "path": "builder/src/Reporting/Exit.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Exit\n  ( Init(..), initToReport\n  , Diff(..), diffToReport\n  , Make(..), makeToReport\n  , Bump(..), bumpToReport\n  , Repl(..), replToReport\n  , Publish(..), publishToReport\n  , Install(..), installToReport\n  , Reactor(..), reactorToReport\n  , newPackageOverview\n  --\n  , Solver(..)\n  , Outline(..)\n  , OutlineProblem(..)\n  , Details(..)\n  , DetailsBadDep(..)\n  , PackageProblem(..)\n  , RegistryProblem(..)\n  , BuildProblem(..)\n  , BuildProjectProblem(..)\n  , DocsProblem(..)\n  , Generate(..)\n  --\n  , toString\n  , toStderr\n  , toJson\n  )\n  where\n\n\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.UTF8 as BS_UTF8\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Name as N\nimport qualified Data.NonEmptyList as NE\nimport qualified Network.HTTP.Client as HTTP\nimport qualified Network.HTTP.Types.Header as HTTP\nimport qualified Network.HTTP.Types.Status as HTTP\nimport qualified System.FilePath as FP\nimport System.FilePath ((</>), (<.>))\n\nimport qualified Elm.Constraint as C\nimport qualified Elm.Magnitude as M\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified File\nimport qualified Http\nimport qualified Json.Decode as Decode\nimport qualified Json.Encode as Encode\nimport qualified Json.String as Json\nimport Parse.Primitives (Row, Col)\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Error.Import as Import\nimport qualified Reporting.Error.Json as Json\nimport qualified Reporting.Exit.Help as Help\nimport qualified Reporting.Error as Error\nimport qualified Reporting.Render.Code as Code\n\n\n\n-- RENDERERS\n\n\ntoString :: Help.Report -> String\ntoString report =\n  Help.toString (Help.reportToDoc report)\n\n\ntoStderr :: Help.Report -> IO ()\ntoStderr report =\n  Help.toStderr (Help.reportToDoc report)\n\n\ntoJson :: Help.Report -> Encode.Value\ntoJson report =\n  Help.reportToJson report\n\n\n\n-- INIT\n\n\ndata Init\n  = InitNoSolution [Pkg.Name]\n  | InitNoOfflineSolution [Pkg.Name]\n  | InitSolverProblem Solver\n  | InitAlreadyExists\n  | InitRegistryProblem RegistryProblem\n\n\ninitToReport :: Init -> Help.Report\ninitToReport exit =\n  case exit of\n    InitNoSolution pkgs ->\n      Help.report \"NO SOLUTION\" Nothing\n        \"I tried to create an elm.json with the following direct dependencies:\"\n        [ D.indent 4 $ D.vcat $\n            map (D.dullyellow . D.fromChars . Pkg.toChars) pkgs\n        , D.reflow $\n            \"I could not find compatible versions though! This should not happen, so please\\\n            \\ ask around one of the community forums at https://elm-lang.org/community to learn\\\n            \\ what is going on!\"\n        ]\n\n    InitNoOfflineSolution pkgs ->\n      Help.report \"NO OFFLINE SOLUTION\" Nothing\n        \"I tried to create an elm.json with the following direct dependencies:\"\n        [ D.indent 4 $ D.vcat $\n            map (D.dullyellow . D.fromChars . Pkg.toChars) pkgs\n        , D.reflow $\n            \"I could not find compatible versions though, but that may be because I could not\\\n            \\ connect to https://package.elm-lang.org to get the latest list of packages. Are\\\n            \\ you able to connect to the internet? Please ask around one of the community\\\n            \\ forums at https://elm-lang.org/community for help!\"\n        ]\n\n    InitSolverProblem solver ->\n      toSolverReport solver\n\n    InitAlreadyExists ->\n      Help.report \"EXISTING PROJECT\" Nothing\n        \"You already have an elm.json file, so there is nothing for me to initialize!\"\n        [ D.fillSep\n            [\"Maybe\",D.green (D.fromChars (D.makeLink \"init\")),\"can\",\"help\"\n            ,\"you\",\"figure\",\"out\",\"what\",\"to\",\"do\",\"next?\"\n            ]\n        ]\n\n    InitRegistryProblem problem ->\n      toRegistryProblemReport \"PROBLEM LOADING PACKAGE LIST\" problem $\n        \"I need the list of published packages before I can start initializing projects\"\n\n\n\n-- DIFF\n\n\ndata Diff\n  = DiffNoOutline\n  | DiffBadOutline Outline\n  | DiffApplication\n  | DiffNoExposed\n  | DiffUnpublished\n  | DiffUnknownPackage Pkg.Name [Pkg.Name]\n  | DiffUnknownVersion Pkg.Name V.Version [V.Version]\n  | DiffDocsProblem V.Version DocsProblem\n  | DiffMustHaveLatestRegistry RegistryProblem\n  | DiffBadDetails Details\n  | DiffBadBuild BuildProblem\n\n\ndiffToReport :: Diff -> Help.Report\ndiffToReport diff =\n  case diff of\n    DiffNoOutline ->\n      Help.report \"DIFF WHAT?\" Nothing\n        \"I cannot find an elm.json so I am not sure what you want me to diff.\\\n        \\ Normally you run `elm diff` from within a project!\"\n        [ D.reflow $ \"If you are just curious to see a diff, try running this command:\"\n        , D.indent 4 $ D.green $ \"elm diff elm/http 1.0.0 2.0.0\"\n        ]\n\n    DiffBadOutline outline ->\n      toOutlineReport outline\n\n    DiffApplication ->\n      Help.report \"CANNOT DIFF APPLICATIONS\" (Just \"elm.json\")\n        \"Your elm.json says this project is an application, but `elm diff` only works\\\n        \\ with packages. That way there are previously published versions of the API to\\\n        \\ diff against!\"\n        [ D.reflow $ \"If you are just curious to see a diff, try running this command:\"\n        , D.indent 4 $ D.dullyellow $ \"elm diff elm/json 1.0.0 1.1.2\"\n        ]\n\n    DiffNoExposed ->\n      Help.report \"NO EXPOSED MODULES\" (Just \"elm.json\")\n        \"Your elm.json has no \\\"exposed-modules\\\" which means there is no public API at\\\n        \\ all right now! What am I supposed to diff?\"\n        [ D.reflow $\n            \"Try adding some modules back to the \\\"exposed-modules\\\" field.\"\n        ]\n\n    DiffUnpublished ->\n      Help.report \"UNPUBLISHED\" Nothing\n        \"This package is not published yet. There is nothing to diff against!\"\n        []\n\n    DiffUnknownPackage pkg suggestions ->\n      Help.report \"UNKNOWN PACKAGE\" Nothing\n        ( \"I cannot find a package called:\"\n        )\n        [ D.indent 4 $ D.red $ D.fromChars $ Pkg.toChars pkg\n        , \"Maybe you want one of these instead?\"\n        , D.indent 4 $ D.dullyellow $ D.vcat $ map (D.fromChars . Pkg.toChars) suggestions\n        , \"But check <https://package.elm-lang.org> to see all possibilities!\"\n        ]\n\n    DiffUnknownVersion _pkg vsn realVersions ->\n      Help.docReport \"UNKNOWN VERSION\" Nothing\n        ( D.fillSep $\n            [ \"Version\", D.red (D.fromVersion vsn)\n            , \"has\", \"never\", \"been\", \"published,\", \"so\", \"I\"\n            , \"cannot\", \"diff\", \"against\", \"it.\"\n            ]\n        )\n        [ \"Here are all the versions that HAVE been published:\"\n        , D.indent 4 $ D.dullyellow $ D.vcat $\n            let\n              sameMajor v1 v2 = V._major v1 == V._major v2\n              mkRow vsns = D.hsep $ map D.fromVersion vsns\n            in\n              map mkRow $ List.groupBy sameMajor (List.sort realVersions)\n        , \"Want one of those instead?\"\n        ]\n\n    DiffDocsProblem version problem ->\n      toDocsProblemReport problem $\n        \"I need the docs for \" ++ V.toChars version ++ \" to compute this diff\"\n\n    DiffMustHaveLatestRegistry problem ->\n      toRegistryProblemReport \"PROBLEM UPDATING PACKAGE LIST\" problem $\n        \"I need the latest list of published packages before I do this diff\"\n\n    DiffBadDetails details ->\n      toDetailsReport details\n\n    DiffBadBuild buildProblem ->\n      toBuildProblemReport buildProblem\n\n\n\n-- BUMP\n\n\ndata Bump\n  = BumpNoOutline\n  | BumpBadOutline Outline\n  | BumpApplication\n  | BumpUnexpectedVersion V.Version [V.Version]\n  | BumpMustHaveLatestRegistry RegistryProblem\n  | BumpCannotFindDocs Pkg.Name V.Version DocsProblem\n  | BumpBadDetails Details\n  | BumpNoExposed\n  | BumpBadBuild BuildProblem\n\n\nbumpToReport :: Bump -> Help.Report\nbumpToReport bump =\n  case bump of\n    BumpNoOutline ->\n      Help.report \"BUMP WHAT?\" Nothing\n        \"I cannot find an elm.json so I am not sure what you want me to bump.\"\n        [ D.reflow $\n            \"Elm packages always have an elm.json that says current the version number. If\\\n            \\ you run this command from a directory with an elm.json file, I will try to bump\\\n            \\ the version in there based on the API changes.\"\n        ]\n\n    BumpBadOutline outline ->\n      toOutlineReport outline\n\n    BumpApplication ->\n      Help.report \"CANNOT BUMP APPLICATIONS\" (Just \"elm.json\")\n        \"Your elm.json says this is an application. That means it cannot be published\\\n        \\ on <https://package.elm-lang.org> and therefore has no version to bump!\"\n        []\n\n    BumpUnexpectedVersion vsn versions ->\n      Help.docReport \"CANNOT BUMP\" (Just \"elm.json\")\n        ( D.fillSep\n            [\"Your\",\"elm.json\",\"says\",\"I\",\"should\",\"bump\",\"relative\",\"to\",\"version\"\n            ,D.red (D.fromVersion vsn) <> \",\"\n            ,\"but\",\"I\",\"cannot\",\"find\",\"that\",\"version\",\"on\",\"<https://package.elm-lang.org>.\"\n            ,\"That\",\"means\",\"there\",\"is\",\"no\",\"API\",\"for\",\"me\",\"to\",\"diff\",\"against\",\"and\"\n            ,\"figure\",\"out\",\"if\",\"these\",\"are\",\"MAJOR,\",\"MINOR,\",\"or\",\"PATCH\",\"changes.\"\n            ]\n        )\n        [ D.fillSep $\n            [\"Try\",\"bumping\",\"again\",\"after\",\"changing\",\"the\",D.dullyellow \"\\\"version\\\"\",\"in\",\"elm.json\"]\n            ++ if length versions == 1 then [\"to:\"] else [\"to\",\"one\",\"of\",\"these:\"]\n        , D.vcat $ map (D.green . D.fromVersion) versions\n        ]\n\n    BumpMustHaveLatestRegistry problem ->\n      toRegistryProblemReport \"PROBLEM UPDATING PACKAGE LIST\" problem $\n        \"I need the latest list of published packages before I can bump any versions\"\n\n    BumpCannotFindDocs _ version problem ->\n      toDocsProblemReport problem $\n        \"I need the docs for \" ++ V.toChars version ++ \" to compute the next version number\"\n\n    BumpBadDetails details ->\n      toDetailsReport details\n\n    BumpNoExposed ->\n      Help.docReport \"NO EXPOSED MODULES\" (Just \"elm.json\")\n        ( D.fillSep $\n            [ \"To\", \"bump\", \"a\", \"package,\", \"the\"\n            , D.dullyellow \"\\\"exposed-modules\\\"\", \"field\", \"of\", \"your\"\n            , \"elm.json\", \"must\", \"list\", \"at\", \"least\", \"one\", \"module.\"\n            ]\n        )\n        [ D.reflow $\n            \"Try adding some modules back to the \\\"exposed-modules\\\" field.\"\n        ]\n\n    BumpBadBuild problem ->\n      toBuildProblemReport problem\n\n\n\n-- OVERVIEW OF VERSIONING\n\n\nnewPackageOverview :: String\nnewPackageOverview =\n  unlines\n    [ \"This package has never been published before. Here's how things work:\"\n    , \"\"\n    , \"  - Versions all have exactly three parts: MAJOR.MINOR.PATCH\"\n    , \"\"\n    , \"  - All packages start with initial version \" ++ V.toChars V.one\n    , \"\"\n    , \"  - Versions are incremented based on how the API changes:\"\n    , \"\"\n    , \"        PATCH = the API is the same, no risk of breaking code\"\n    , \"        MINOR = values have been added, existing values are unchanged\"\n    , \"        MAJOR = existing values have been changed or removed\"\n    , \"\"\n    , \"  - I will bump versions for you, automatically enforcing these rules\"\n    , \"\"\n    ]\n\n\n\n-- PUBLISH\n\n\ndata Publish\n  = PublishNoOutline\n  | PublishBadOutline Outline\n  | PublishBadDetails Details\n  | PublishMustHaveLatestRegistry RegistryProblem\n  | PublishApplication\n  | PublishNotInitialVersion V.Version\n  | PublishAlreadyPublished V.Version\n  | PublishInvalidBump V.Version V.Version\n  | PublishBadBump V.Version V.Version M.Magnitude V.Version M.Magnitude\n  | PublishNoSummary\n  | PublishNoExposed\n  | PublishNoReadme\n  | PublishShortReadme\n  | PublishNoLicense\n  | PublishBuildProblem BuildProblem\n  | PublishMissingTag V.Version\n  | PublishCannotGetTag V.Version Http.Error\n  | PublishCannotGetTagData V.Version String BS.ByteString\n  | PublishCannotGetZip Http.Error\n  | PublishCannotDecodeZip String\n  | PublishCannotGetDocs V.Version V.Version DocsProblem\n  | PublishCannotRegister Http.Error\n  | PublishNoGit\n  | PublishLocalChanges V.Version\n  --\n  | PublishZipBadDetails Details\n  | PublishZipApplication\n  | PublishZipNoExposed\n  | PublishZipBuildProblem BuildProblem\n\n\npublishToReport :: Publish -> Help.Report\npublishToReport publish =\n  case publish of\n    PublishNoOutline ->\n      Help.report \"PUBLISH WHAT?\" Nothing\n        \"I cannot find an elm.json so I am not sure what you want me to publish.\"\n        [ D.reflow $\n            \"Elm packages always have an elm.json that states the version number,\\\n            \\ dependencies, exposed modules, etc.\"\n        ]\n\n    PublishBadOutline outline ->\n      toOutlineReport outline\n\n    PublishBadDetails problem ->\n      toDetailsReport problem\n\n    PublishMustHaveLatestRegistry problem ->\n      toRegistryProblemReport \"PROBLEM UPDATING PACKAGE LIST\" problem $\n        \"I need the latest list of published packages to make sure this is safe to publish\"\n\n    PublishApplication ->\n      Help.report \"UNPUBLISHABLE\" Nothing \"I cannot publish applications, only packages!\" []\n\n    PublishNotInitialVersion vsn ->\n      Help.docReport \"INVALID VERSION\" Nothing\n        ( D.fillSep\n            [\"I\",\"cannot\",\"publish\"\n            ,D.red (D.fromVersion vsn)\n            ,\"as\",\"the\",\"initial\",\"version.\"\n            ]\n        )\n        [ D.fillSep\n            [\"Change\",\"it\",\"to\",D.green \"1.0.0\",\"which\",\"is\"\n            ,\"the\",\"initial\",\"version\",\"for\",\"all\",\"Elm\",\"packages.\"\n            ]\n        ]\n\n    PublishAlreadyPublished vsn ->\n      Help.docReport \"ALREADY PUBLISHED\" Nothing\n        ( D.vcat\n            [ D.fillSep\n                [ \"Version\", D.green (D.fromVersion vsn)\n                , \"has\", \"already\", \"been\", \"published.\", \"You\", \"cannot\"\n                , \"publish\", \"it\", \"again!\"\n                ]\n            , \"Try using the `bump` command:\"\n            ]\n        )\n        [ D.dullyellow $ D.indent 4 \"elm bump\"\n        , D.reflow $\n            \"It computes the version number based on API changes, ensuring\\\n            \\ that no breaking changes end up in PATCH releases!\"\n        ]\n\n    PublishInvalidBump statedVersion latestVersion ->\n      Help.docReport \"INVALID VERSION\" (Just \"elm.json\")\n        ( D.fillSep $\n            [\"Your\",\"elm.json\",\"says\",\"the\",\"next\",\"version\",\"should\",\"be\"\n            ,D.red (D.fromVersion statedVersion) <> \",\"\n            ,\"but\",\"that\",\"is\",\"not\",\"valid\",\"based\",\"on\",\"the\",\"previously\"\n            ,\"published\",\"versions.\"\n            ]\n        )\n        [ D.fillSep $\n            [\"Change\",\"the\",\"version\",\"back\",\"to\"\n            ,D.green (D.fromVersion latestVersion)\n            ,\"which\",\"is\",\"the\",\"most\",\"recently\",\"published\",\"version.\"\n            ,\"From\",\"there,\",\"have\",\"Elm\",\"bump\",\"the\",\"version\",\"by\",\"running:\"\n            ]\n        , D.indent 4 $ D.green \"elm bump\"\n        , D.reflow $\n            \"If you want more insight on the API changes Elm detects, you\\\n            \\ can run `elm diff` at this point as well.\"\n        ]\n\n    PublishBadBump old new magnitude realNew realMagnitude ->\n      Help.docReport \"INVALID VERSION\" (Just \"elm.json\")\n        (\n          D.fillSep $\n            [\"Your\",\"elm.json\",\"says\",\"the\",\"next\",\"version\",\"should\",\"be\"\n            ,D.red (D.fromVersion new) <> \",\"\n            ,\"indicating\",\"a\",D.fromChars (M.toChars magnitude)\n            ,\"change\",\"to\",\"the\",\"public\",\"API.\"\n            ,\"This\",\"does\",\"not\",\"match\",\"the\",\"API\",\"diff\",\"given\",\"by:\"\n            ]\n        )\n        [ D.indent 4 $ D.fromChars $\n            \"elm diff \" ++ V.toChars old\n\n        , D.fillSep $\n            [\"This\",\"command\",\"says\",\"this\",\"is\",\"a\"\n            ,D.fromChars (M.toChars realMagnitude)\n            ,\"change,\",\"so\",\"the\",\"next\",\"version\",\"should\",\"be\"\n            ,D.green (D.fromVersion realNew) <> \".\"\n            ,\"Double\",\"check\",\"everything\",\"to\",\"make\",\"sure\",\"you\"\n            ,\"are\",\"publishing\",\"what\",\"you\",\"want!\"\n            ]\n        , D.reflow $\n            \"Also, next time use `elm bump` and I'll figure all this out for you!\"\n        ]\n\n    PublishNoSummary ->\n      Help.docReport \"NO SUMMARY\" (Just \"elm.json\")\n        ( D.fillSep $\n            [ \"To\", \"publish\", \"a\", \"package,\", \"your\", \"elm.json\", \"must\"\n            , \"have\", \"a\", D.dullyellow \"\\\"summary\\\"\", \"field\", \"that\", \"gives\"\n            , \"a\", \"consice\", \"overview\", \"of\", \"your\", \"project.\"\n            ]\n        )\n        [ D.reflow $\n            \"The summary must be less than 80 characters. It should describe\\\n            \\ the concrete use of your package as clearly and as plainly as possible.\"\n        ]\n\n    PublishNoExposed ->\n      Help.docReport \"NO EXPOSED MODULES\" (Just \"elm.json\")\n        ( D.fillSep $\n            [ \"To\", \"publish\", \"a\", \"package,\", \"the\"\n            , D.dullyellow \"\\\"exposed-modules\\\"\", \"field\", \"of\", \"your\"\n            , \"elm.json\", \"must\", \"list\", \"at\", \"least\", \"one\", \"module.\"\n            ]\n        )\n        [ D.reflow $\n            \"Which modules do you want users of the package to have access to? Add their\\\n            \\ names to the \\\"exposed-modules\\\" list.\"\n        ]\n\n    PublishNoReadme ->\n      toBadReadmeReport \"NO README\" $\n        \"Every published package must have a helpful README.md\\\n        \\ file, but I do not see one in your project.\"\n\n    PublishShortReadme ->\n      toBadReadmeReport \"SHORT README\" $\n        \"This README.md is too short. Having more details will help\\\n        \\ people assess your package quickly and fairly.\"\n\n    PublishNoLicense ->\n      Help.report \"NO LICENSE FILE\" (Just \"LICENSE\")\n        \"By publishing a package you are inviting the Elm community to build\\\n        \\ upon your work. But without knowing your license, we have no idea if\\\n        \\ that is legal!\"\n        [ D.reflow $\n            \"Once you pick an OSI approved license from <https://spdx.org/licenses/>,\\\n            \\ you must share that choice in two places. First, the license\\\n            \\ identifier must appear in your elm.json file. Second, the full\\\n            \\ license text must appear in the root of your project in a file\\\n            \\ named LICENSE. Add that file and you will be all set!\"\n        ]\n\n    PublishBuildProblem buildProblem ->\n      toBuildProblemReport buildProblem\n\n    PublishMissingTag version ->\n      let vsn = V.toChars version in\n      Help.docReport \"NO TAG\" Nothing\n        ( D.fillSep $\n            [ \"Packages\", \"must\", \"be\", \"tagged\", \"in\", \"git,\", \"but\", \"I\"\n            , \"cannot\", \"find\", \"a\", D.green (D.fromChars vsn), \"tag.\"\n            ]\n        )\n        [ D.vcat\n            [ \"These tags make it possible to find this specific version on GitHub.\"\n            , \"To tag the most recent commit and push it to GitHub, run this:\"\n            ]\n        , D.indent 4 $ D.dullyellow $ D.vcat $ map D.fromChars $\n            [ \"git tag -a \" ++ vsn ++ \" -m \\\"new release\\\"\"\n            , \"git push origin \" ++ vsn\n            ]\n        , \"The -m flag is for a helpful message. Try to make it more informative!\"\n        ]\n\n    PublishCannotGetTag version httpError ->\n      case httpError of\n        Http.BadHttp _ (HTTP.StatusCodeException response _)\n          | HTTP.statusCode (HTTP.responseStatus response) == 404 ->\n              let vsn = V.toChars version in\n              Help.report \"NO TAG ON GITHUB\" Nothing\n                (\"You have version \" ++ vsn ++ \" tagged locally, but not on GitHub.\")\n                [ D.reflow\n                    \"Run the following command to make this tag available on GitHub:\"\n                , D.indent 4 $ D.dullyellow $ D.fromChars $\n                    \"git push origin \" ++ vsn\n                , D.reflow\n                    \"This will make it possible to find your code online based on the version number.\"\n                ]\n\n        _ ->\n          toHttpErrorReport \"PROBLEM VERIFYING TAG\" httpError\n            \"I need to check that the version tag is registered on GitHub\"\n\n    PublishCannotGetTagData version url body ->\n      Help.report \"PROBLEM VERIFYING TAG\" Nothing\n        (\"I need to check that version \" ++ V.toChars version ++ \" is tagged on GitHub, so I fetched:\")\n        [ D.indent 4 $ D.dullyellow $ D.fromChars url\n        , D.reflow $\n            \"I got the data back, but it was not what I was expecting. The response\\\n            \\ body contains \" ++ show (BS.length body) ++ \" bytes. Here is the \"\n            ++ if BS.length body <= 76 then \"whole thing:\" else \"beginning:\"\n        , D.indent 4 $ D.dullyellow $ D.fromChars $\n            if BS.length body <= 76\n            then BS_UTF8.toString body\n            else take 73 (BS_UTF8.toString body) ++ \"...\"\n        , D.reflow $\n            \"Does this error keep showing up? Maybe there is something weird with your\\\n            \\ internet connection. We have gotten reports that schools, businesses,\\\n            \\ airports, etc. sometimes intercept requests and add things to the body\\\n            \\ or change its contents entirely. Could that be the problem?\"\n        ]\n\n    PublishCannotGetZip httpError ->\n      toHttpErrorReport \"PROBLEM DOWNLOADING CODE\" httpError $\n        \"I need to check that folks can download and build the source code when they\\\n        \\ install this package\"\n\n    PublishCannotDecodeZip url ->\n      Help.report \"PROBLEM DOWNLOADING CODE\" Nothing\n        \"I need to check that folks can download and build the source code when they\\\n        \\ install this package, so I downloaded the code from:\"\n        [ D.indent 4 $ D.dullyellow $ D.fromChars url\n        , D.reflow $\n            \"I was unable to unzip the archive though. Maybe there is something weird with\\\n            \\ your internet connection. We have gotten reports that schools, businesses,\\\n            \\ airports, etc. sometimes intercept requests and add things to the body or\\\n            \\ change its contents entirely. Could that be the problem?\"\n        ]\n\n    PublishCannotGetDocs old new docsProblem ->\n      toDocsProblemReport docsProblem $\n        \"I need the docs for \" ++ V.toChars old ++ \" to verify that \"\n        ++ V.toChars new ++ \" really does come next\"\n\n    PublishCannotRegister httpError ->\n      toHttpErrorReport \"PROBLEM PUBLISHING PACKAGE\" httpError $\n        \"I need to send information about your package to the package website\"\n\n    PublishNoGit ->\n      Help.report \"NO GIT\" Nothing\n        \"I searched your PATH environment variable for `git` and could not\\\n        \\ find it. Is it available through your PATH?\"\n        [ D.reflow $\n            \"Who cares about this? Well, I currently use `git` to check if there\\\n            \\ are any local changes in your code. Local changes are a good sign\\\n            \\ that some important improvements have gotten mistagged, so this\\\n            \\ check can be extremely helpful for package authors!\"\n        , D.toSimpleNote $\n            \"We plan to do this without the `git` binary in a future release.\"\n        ]\n\n    PublishLocalChanges version ->\n      let vsn = V.toChars version in\n      Help.docReport \"LOCAL CHANGES\" Nothing\n        ( D.fillSep $\n            [ \"The\", \"code\", \"tagged\", \"as\", D.green (D.fromChars vsn), \"in\"\n            , \"git\", \"does\", \"not\", \"match\", \"the\", \"code\", \"in\", \"your\"\n            , \"working\", \"directory.\", \"This\", \"means\", \"you\", \"have\"\n            , \"commits\", \"or\", \"local\", \"changes\", \"that\", \"are\", \"not\"\n            , \"going\", \"to\", \"be\", \"published!\"\n            ]\n        )\n        [ D.toSimpleNote $\n            \"If you are sure everything is in order, you can run `git checkout \"\n            ++ vsn ++ \"` and publish your code from there.\"\n        ]\n\n    PublishZipBadDetails _ ->\n      badZipReport\n\n    PublishZipApplication ->\n      badZipReport\n\n    PublishZipNoExposed ->\n      badZipReport\n\n    PublishZipBuildProblem _ ->\n      badZipReport\n\n\ntoBadReadmeReport :: String -> String -> Help.Report\ntoBadReadmeReport title summary =\n  Help.report title (Just \"README.md\") summary\n    [ D.reflow $\n        \"When people look at your README, they are wondering:\"\n    , D.vcat\n        [ \"  - What does this package even do?\"\n        , \"  - Will it help me solve MY problems?\"\n        ]\n    , D.reflow $\n        \"So I recommend starting your README with a small example of the\\\n        \\ most common usage scenario. Show people what they can expect if\\\n        \\ they learn more!\"\n    , D.toSimpleNote $\n        \"By publishing your package, you are inviting people to invest time in\\\n        \\ understanding your work. Spending an hour on your README to communicate your\\\n        \\ knowledge more clearly can save the community days or weeks of time in\\\n        \\ aggregate, and saving time in aggregate is the whole point of publishing\\\n        \\ packages! People really appreciate it, and it makes the whole ecosystem feel\\\n        \\ nicer!\"\n    ]\n\n\nbadZipReport :: Help.Report\nbadZipReport =\n  Help.report \"PROBLEM VERIFYING PACKAGE\" Nothing\n    \"Before publishing packages, I download the code from GitHub and try to build it\\\n    \\ from scratch. That way I can be more confident that it will work for other\\\n    \\ people too. But I am not able to build it!\"\n    [ D.reflow $\n        \"I was just able to build your local copy though. Is there some way the version\\\n        \\ on GitHub could be different?\"\n    ]\n\n\n\n-- DOCS\n\n\ndata DocsProblem\n  = DP_Http Http.Error\n  | DP_Data String BS.ByteString\n  | DP_Cache\n\n\ntoDocsProblemReport :: DocsProblem -> String -> Help.Report\ntoDocsProblemReport problem context =\n  case problem of\n    DP_Http httpError ->\n      toHttpErrorReport \"PROBLEM LOADING DOCS\" httpError context\n\n    DP_Data url body ->\n      Help.report \"PROBLEM LOADING DOCS\" Nothing (context ++ \", so I fetched:\")\n        [ D.indent 4 $ D.dullyellow $ D.fromChars url\n        , D.reflow $\n            \"I got the data back, but it was not what I was expecting. The response\\\n            \\ body contains \" ++ show (BS.length body) ++ \" bytes. Here is the \"\n            ++ if BS.length body <= 76 then \"whole thing:\" else \"beginning:\"\n        , D.indent 4 $ D.dullyellow $ D.fromChars $\n            if BS.length body <= 76\n            then BS_UTF8.toString body\n            else take 73 (BS_UTF8.toString body) ++ \"...\"\n        , D.reflow $\n            \"Does this error keep showing up? Maybe there is something weird with your\\\n            \\ internet connection. We have gotten reports that schools, businesses,\\\n            \\ airports, etc. sometimes intercept requests and add things to the body\\\n            \\ or change its contents entirely. Could that be the problem?\"\n        ]\n\n    DP_Cache ->\n      Help.report \"PROBLEM LOADING DOCS\" Nothing (context ++ \", but the local copy seems to be corrupted.\")\n        [ D.reflow $\n            \"I deleted the cached version, so the next run should download a fresh copy of\\\n            \\ the docs. Hopefully that will get you unstuck, but it will not resolve the root\\\n            \\ problem if, for example, a 3rd party editor plugin is modifing cached files\\\n            \\ for some reason.\"\n        ]\n\n\n\n-- INSTALL\n\n\ndata Install\n  = InstallNoOutline\n  | InstallBadOutline Outline\n  | InstallBadRegistry RegistryProblem\n  | InstallNoArgs FilePath\n  | InstallNoOnlineAppSolution Pkg.Name\n  | InstallNoOfflineAppSolution Pkg.Name\n  | InstallNoOnlinePkgSolution Pkg.Name\n  | InstallNoOfflinePkgSolution Pkg.Name\n  | InstallHadSolverTrouble Solver\n  | InstallUnknownPackageOnline Pkg.Name [Pkg.Name]\n  | InstallUnknownPackageOffline Pkg.Name [Pkg.Name]\n  | InstallBadDetails Details\n\n\ninstallToReport :: Install -> Help.Report\ninstallToReport exit =\n  case exit of\n    InstallNoOutline ->\n      Help.report \"NEW PROJECT?\" Nothing\n        \"Are you trying to start a new project? Try this command instead:\"\n        [ D.indent 4 $ D.green \"elm init\"\n        , D.reflow \"It will help you get started!\"\n        ]\n\n    InstallBadOutline outline ->\n      toOutlineReport outline\n\n    InstallBadRegistry problem ->\n      toRegistryProblemReport \"PROBLEM LOADING PACKAGE LIST\" problem $\n        \"I need the list of published packages to figure out how to install things\"\n\n    InstallNoArgs elmHome ->\n      Help.report \"INSTALL WHAT?\" Nothing\n        \"I am expecting commands like:\"\n        [ D.green $ D.indent 4 $ D.vcat $\n            [ \"elm install elm/http\"\n            , \"elm install elm/json\"\n            , \"elm install elm/random\"\n            ]\n        , D.toFancyHint\n            [\"In\",\"JavaScript\",\"folks\",\"run\",\"`npm install`\",\"to\",\"start\",\"projects.\"\n            ,\"\\\"Gotta\",\"download\",\"everything!\\\"\",\"But\",\"why\",\"download\",\"packages\"\n            ,\"again\",\"and\",\"again?\",\"Instead,\",\"Elm\",\"caches\",\"packages\",\"in\"\n            ,D.dullyellow (D.fromChars elmHome)\n            ,\"so\",\"each\",\"one\",\"is\",\"downloaded\",\"and\",\"built\",\"ONCE\",\"on\",\"your\",\"machine.\"\n            ,\"Elm\",\"projects\",\"check\",\"that\",\"cache\",\"before\",\"trying\",\"the\",\"internet.\"\n            ,\"This\",\"reduces\",\"build\",\"times,\",\"reduces\",\"server\",\"costs,\",\"and\",\"makes\",\"it\"\n            ,\"easier\",\"to\",\"work\",\"offline.\",\"As\",\"a\",\"result\"\n            ,D.dullcyan \"elm install\",\"is\",\"only\",\"for\",\"adding\",\"dependencies\",\"to\",\"elm.json,\"\n            ,\"whereas\",D.dullcyan \"elm make\",\"is\",\"in\",\"charge\",\"of\",\"gathering\",\"dependencies\"\n            ,\"and\",\"building\",\"everything.\",\"So\",\"maybe\",\"try\",D.green \"elm make\",\"instead?\"\n            ]\n        ]\n\n    InstallNoOnlineAppSolution pkg ->\n      Help.report \"CANNOT FIND COMPATIBLE VERSION\" (Just \"elm.json\")\n        (\n          \"I cannot find a version of \" ++ Pkg.toChars pkg ++ \" that is compatible\\\n          \\ with your existing dependencies.\"\n        )\n        [ D.reflow $\n            \"I checked all the published versions. When that failed, I tried to find any\\\n            \\ compatible combination of these packages, even if it meant changing all your\\\n            \\ existing dependencies! That did not work either!\"\n        , D.reflow $\n            \"This is most likely to happen when a package is not upgraded yet. Maybe a new\\\n            \\ version of Elm came out recently? Maybe a common package was changed recently?\\\n            \\ Maybe a better package came along, so there was no need to upgrade this one?\\\n            \\ Try asking around https://elm-lang.org/community to learn what might be going on\\\n            \\ with this package.\"\n        , D.toSimpleNote $\n            \"Whatever the case, please be kind to the relevant package authors! Having\\\n            \\ friendly interactions with users is great motivation, and conversely, getting\\\n            \\ berated by strangers on the internet sucks your soul dry. Furthermore, package\\\n            \\ authors are humans with families, friends, jobs, vacations, responsibilities,\\\n            \\ goals, etc. They face obstacles outside of their technical work you will never\\\n            \\ know about, so please assume the best and try to be patient and supportive!\"\n        ]\n\n    InstallNoOfflineAppSolution pkg ->\n      Help.report \"CANNOT FIND COMPATIBLE VERSION LOCALLY\" (Just \"elm.json\")\n        (\n          \"I cannot find a version of \" ++ Pkg.toChars pkg ++ \" that is compatible\\\n          \\ with your existing dependencies.\"\n        )\n        [ D.reflow $\n            \"I was not able to connect to https://package.elm-lang.org/ though, so I was only\\\n            \\ able to look through packages that you have downloaded in the past.\"\n        , D.reflow $\n            \"Try again later when you have internet!\"\n        ]\n\n    InstallNoOnlinePkgSolution pkg ->\n      Help.report \"CANNOT FIND COMPATIBLE VERSION\" (Just \"elm.json\")\n        (\n          \"I cannot find a version of \" ++ Pkg.toChars pkg ++ \" that is compatible\\\n          \\ with your existing constraints.\"\n        )\n        [ D.reflow $\n            \"With applications, I try to broaden the constraints to see if anything works,\\\n            \\ but messing with package constraints is much more delicate business. E.g. making\\\n            \\ your constraints stricter may make it harder for applications to find compatible\\\n            \\ dependencies. So fixing something here may break it for a lot of other people!\"\n        , D.reflow $\n            \"So I recommend making an application with the same dependencies as your package.\\\n            \\ See if there is a solution at all. From there it may be easier to figure out\\\n            \\ how to proceed in a way that will disrupt your users as little as possible. And\\\n            \\ the solution may be to help other package authors to get their packages updated,\\\n            \\ or to drop a dependency entirely.\"\n        ]\n\n    InstallNoOfflinePkgSolution pkg ->\n      Help.report \"CANNOT FIND COMPATIBLE VERSION LOCALLY\" (Just \"elm.json\")\n        (\n          \"I cannot find a version of \" ++ Pkg.toChars pkg ++ \" that is compatible\\\n          \\ with your existing constraints.\"\n        )\n        [ D.reflow $\n            \"I was not able to connect to https://package.elm-lang.org/ though, so I was only\\\n            \\ able to look through packages that you have downloaded in the past.\"\n        , D.reflow $\n            \"Try again later when you have internet!\"\n        ]\n\n    InstallHadSolverTrouble solver ->\n      toSolverReport solver\n\n    InstallUnknownPackageOnline pkg suggestions ->\n      Help.docReport \"UNKNOWN PACKAGE\" Nothing\n        (\n          D.fillSep\n            [\"I\",\"cannot\",\"find\",\"a\",\"package\",\"named\",D.red (D.fromPackage pkg) <> \".\"]\n        )\n        [ D.reflow $\n            \"I looked through https://package.elm-lang.org for packages with similar names\\\n            \\ and found these:\"\n        , D.indent 4 $ D.dullyellow $ D.vcat $ map D.fromPackage suggestions\n        , D.reflow $ \"Maybe you want one of these instead?\"\n        ]\n\n    InstallUnknownPackageOffline pkg suggestions ->\n      Help.docReport \"UNKNOWN PACKAGE\" Nothing\n        (\n          D.fillSep\n            [\"I\",\"cannot\",\"find\",\"a\",\"package\",\"named\",D.red (D.fromPackage pkg) <> \".\"]\n        )\n        [ D.reflow $\n            \"I could not connect to https://package.elm-lang.org though, so new packages may\\\n            \\ have been published since I last updated my local cache of package names.\"\n        , D.reflow $\n            \"Looking through the locally cached names, the closest ones are:\"\n        , D.indent 4 $ D.dullyellow $ D.vcat $ map D.fromPackage suggestions\n        , D.reflow $ \"Maybe you want one of these instead?\"\n        ]\n\n    InstallBadDetails details ->\n      toDetailsReport details\n\n\n\n-- SOLVER\n\n\ndata Solver\n  = SolverBadCacheData Pkg.Name V.Version\n  | SolverBadHttpData Pkg.Name V.Version String\n  | SolverBadHttp Pkg.Name V.Version Http.Error\n\n\ntoSolverReport :: Solver -> Help.Report\ntoSolverReport problem =\n  case problem of\n    SolverBadCacheData pkg vsn ->\n      Help.report \"PROBLEM SOLVING PACKAGE CONSTRAINTS\" Nothing\n        (\n          \"I need the elm.json of \" ++ Pkg.toChars pkg ++ \" \" ++ V.toChars vsn ++ \" to\\\n          \\ help me search for a set of compatible packages. I had it cached locally, but\\\n          \\ it looks like the file was corrupted!\"\n        )\n        [ D.reflow $\n            \"I deleted the cached version, so the next run should download a fresh copy.\\\n            \\ Hopefully that will get you unstuck, but it will not resolve the root\\\n            \\ problem if a 3rd party tool is modifing cached files for some reason.\"\n        ]\n\n    SolverBadHttpData pkg vsn url ->\n      Help.report \"PROBLEM SOLVING PACKAGE CONSTRAINTS\" Nothing\n        (\n          \"I need the elm.json of \" ++ Pkg.toChars pkg ++ \" \" ++ V.toChars vsn ++ \" to\\\n          \\ help me search for a set of compatible packages, but I ran into corrupted\\\n          \\ information from:\"\n        )\n        [ D.indent 4 $ D.dullyellow $ D.fromChars url\n        , D.reflow $\n            \"Is something weird with your internet connection. We have gotten reports that\\\n            \\ schools, businesses, airports, etc. sometimes intercept requests and add things\\\n            \\ to the body or change its contents entirely. Could that be the problem?\"\n        ]\n\n    SolverBadHttp pkg vsn httpError ->\n      toHttpErrorReport \"PROBLEM SOLVING PACKAGE CONSTRAINTS\" httpError $\n        \"I need the elm.json of \" ++ Pkg.toChars pkg ++ \" \" ++ V.toChars vsn\n        ++ \" to help me search for a set of compatible packages\"\n\n\n\n-- OUTLINE\n\n\ndata Outline\n  = OutlineHasBadStructure (Decode.Error OutlineProblem)\n  | OutlineHasMissingSrcDirs FilePath [FilePath]\n  | OutlineHasDuplicateSrcDirs FilePath FilePath FilePath\n  | OutlineNoPkgCore\n  | OutlineNoAppCore\n  | OutlineNoAppJson\n\n\ndata OutlineProblem\n  = OP_BadType\n  | OP_BadPkgName Row Col\n  | OP_BadVersion Row Col\n  | OP_BadConstraint C.Error\n  | OP_BadModuleName Row Col\n  | OP_BadModuleHeaderTooLong\n  | OP_BadDependencyName Row Col\n  | OP_BadLicense Json.String [Json.String]\n  | OP_BadSummaryTooLong\n  | OP_NoSrcDirs\n\n\ntoOutlineReport :: Outline -> Help.Report\ntoOutlineReport problem =\n  case problem of\n    OutlineHasBadStructure decodeError ->\n      Json.toReport \"elm.json\" (Json.FailureToReport toOutlineProblemReport) decodeError $\n        Json.ExplicitReason \"I ran into a problem with your elm.json file.\"\n\n    OutlineHasMissingSrcDirs dir dirs ->\n      case dirs of\n        [] ->\n          Help.report \"MISSING SOURCE DIRECTORY\" (Just \"elm.json\")\n            \"I need a valid elm.json file, but the \\\"source-directories\\\" field lists the following directory:\"\n            [ D.indent 4 $ D.red $ D.fromChars dir\n            , D.reflow $\n                \"I cannot find it though. Is it missing? Is there a typo?\"\n            ]\n\n        _:_ ->\n          Help.report \"MISSING SOURCE DIRECTORIES\" (Just \"elm.json\")\n            \"I need a valid elm.json file, but the \\\"source-directories\\\" field lists the following directories:\"\n            [ D.indent 4 $ D.vcat $\n                map (D.red . D.fromChars) (dir:dirs)\n            , D.reflow $\n                \"I cannot find them though. Are they missing? Are there typos?\"\n            ]\n\n    OutlineHasDuplicateSrcDirs canonicalDir dir1 dir2 ->\n      if dir1 == dir2 then\n        Help.report \"REDUNDANT SOURCE DIRECTORIES\" (Just \"elm.json\")\n          \"I need a valid elm.json file, but the \\\"source-directories\\\" field lists the same directory twice:\"\n          [ D.indent 4 $ D.vcat $\n              map (D.red . D.fromChars) [dir1,dir2]\n          , D.reflow $\n              \"Remove one of the entries!\"\n          ]\n      else\n        Help.report \"REDUNDANT SOURCE DIRECTORIES\" (Just \"elm.json\")\n          \"I need a valid elm.json file, but the \\\"source-directories\\\" field has some redundant directories:\"\n          [ D.indent 4 $ D.vcat $\n              map (D.red . D.fromChars) [dir1,dir2]\n          , D.reflow $\n              \"These are two different ways of refering to the same directory:\"\n          , D.indent 4 $ D.dullyellow $ D.fromChars canonicalDir\n          , D.reflow $\n              \"Remove one of the redundant entries from your \\\"source-directories\\\" field.\"\n          ]\n\n    OutlineNoPkgCore ->\n      Help.report \"MISSING DEPENDENCY\" (Just \"elm.json\")\n        \"I need to see an \\\"elm/core\\\" dependency your elm.json file. The default imports\\\n        \\ of `List` and `Maybe` do not work without it.\"\n        [ D.reflow $\n            \"If you modified your elm.json by hand, try to change it back! And if you are\\\n            \\ having trouble getting back to a working elm.json, it may be easier to find a\\\n            \\ working package and start fresh with their elm.json file.\"\n        ]\n\n    OutlineNoAppCore ->\n      Help.report \"MISSING DEPENDENCY\" (Just \"elm.json\")\n        \"I need to see an \\\"elm/core\\\" dependency your elm.json file. The default imports\\\n        \\ of `List` and `Maybe` do not work without it.\"\n        [ D.reflow $\n            \"If you modified your elm.json by hand, try to change it back! And if you are\\\n            \\ having trouble getting back to a working elm.json, it may be easier to delete it\\\n            \\ and use `elm init` to start fresh.\"\n        ]\n\n    OutlineNoAppJson ->\n      Help.report \"MISSING DEPENDENCY\" (Just \"elm.json\")\n        \"I need to see an \\\"elm/json\\\" dependency your elm.json file. It helps me handle\\\n        \\ flags and ports.\"\n        [ D.reflow $\n            \"If you modified your elm.json by hand, try to change it back! And if you are\\\n            \\ having trouble getting back to a working elm.json, it may be easier to delete it\\\n            \\ and use `elm init` to start fresh.\"\n        ]\n\n\ntoOutlineProblemReport :: FilePath -> Code.Source -> Json.Context -> A.Region -> OutlineProblem -> Help.Report\ntoOutlineProblemReport path source _ region problem =\n  let\n    toHighlight row col =\n      Just $ A.Region (A.Position row col) (A.Position row col)\n\n    toSnippet title highlight pair =\n      Help.jsonReport title (Just path) $\n        Code.toSnippet source region highlight pair\n  in\n  case problem of\n    OP_BadType ->\n      toSnippet \"UNEXPECTED TYPE\" Nothing\n        ( D.reflow $\n            \"I got stuck while reading your elm.json file. I cannot handle a \\\"type\\\" like this:\"\n        , D.fillSep\n            [\"Try\",\"changing\",\"the\",\"\\\"type\\\"\",\"to\"\n            ,D.green \"\\\"application\\\"\",\"or\",D.green \"\\\"package\\\"\",\"instead.\"\n            ]\n        )\n\n    OP_BadPkgName row col ->\n      toSnippet \"INVALID PACKAGE NAME\" (toHighlight row col)\n        ( D.reflow $\n            \"I got stuck while reading your elm.json file. I ran into trouble with the package name:\"\n        , D.stack\n            [ D.fillSep\n                [\"Package\",\"names\",\"are\",\"always\",\"written\",\"as\"\n                ,D.green \"\\\"author/project\\\"\"\n                ,\"so\",\"I\",\"am\",\"expecting\",\"to\",\"see\",\"something\",\"like:\"\n                ]\n            , D.dullyellow $ D.indent 4 $ D.vcat $\n                [ \"\\\"mdgriffith/elm-ui\\\"\"\n                , \"\\\"w0rm/elm-physics\\\"\"\n                , \"\\\"Microsoft/elm-json-tree-view\\\"\"\n                , \"\\\"FordLabs/elm-star-rating\\\"\"\n                , \"\\\"1602/json-schema\\\"\"\n                ]\n            , D.reflow\n                \"The author name should match your GitHub name exactly, and the project name\\\n                \\ needs to follow these rules:\"\n            , D.indent 4 $ D.vcat $\n                [ \"+--------------------------------------+-----------+-----------+\"\n                , \"| RULE                                 | BAD       | GOOD      |\"\n                , \"+--------------------------------------+-----------+-----------+\"\n                , \"| only lower case, digits, and hyphens | elm-HTTP  | elm-http  |\"\n                , \"| no leading digits                    | 3D        | elm-3d    |\"\n                , \"| no non-ASCII characters              | elm-bjørn | elm-bear  |\"\n                , \"| no underscores                       | elm_ui    | elm-ui    |\"\n                , \"| no double hyphens                    | elm--hash | elm-hash  |\"\n                , \"| no starting or ending hyphen         | -elm-tar- | elm-tar   |\"\n                , \"+--------------------------------------+-----------+-----------+\"\n                ]\n            , D.toSimpleNote $\n                \"These rules only apply to the project name, so you should never need\\\n                \\ to change your GitHub name!\"\n            ]\n        )\n\n    OP_BadVersion row col ->\n      toSnippet \"PROBLEM WITH VERSION\" (toHighlight row col)\n        ( D.reflow $\n            \"I got stuck while reading your elm.json file. I was expecting a version number here:\"\n        , D.fillSep\n            [\"I\",\"need\",\"something\",\"like\",D.green \"\\\"1.0.0\\\"\",\"or\",D.green \"\\\"2.0.4\\\"\"\n            ,\"that\",\"explicitly\",\"states\",\"all\",\"three\",\"numbers!\"\n            ]\n        )\n\n    OP_BadConstraint constraintError ->\n      case constraintError of\n        C.BadFormat row col ->\n          toSnippet \"PROBLEM WITH CONSTRAINT\" (toHighlight row col)\n            ( D.reflow $\n                \"I got stuck while reading your elm.json file. I do not understand this version constraint:\"\n            , D.stack\n                [ D.fillSep\n                    [\"I\",\"need\",\"something\",\"like\",D.green \"\\\"1.0.0 <= v < 2.0.0\\\"\"\n                    ,\"that\",\"explicitly\",\"lists\",\"the\",\"lower\",\"and\",\"upper\",\"bounds.\"\n                    ]\n                , D.toSimpleNote $\n                    \"The spaces in there are required! Taking them out will confuse me. Adding\\\n                    \\ extra spaces confuses me too. I recommend starting with a valid example\\\n                    \\ and just changing the version numbers.\"\n                ]\n            )\n\n        C.InvalidRange before after ->\n          if before == after then\n            toSnippet \"PROBLEM WITH CONSTRAINT\" Nothing\n              ( D.reflow $\n                  \"I got stuck while reading your elm.json file. I ran into an invalid version constraint:\"\n              , D.fillSep\n                  [\"Elm\",\"checks\",\"that\",\"all\",\"package\",\"APIs\",\"follow\",\"semantic\",\"versioning,\"\n                  ,\"so\",\"it\",\"is\",\"best\",\"to\",\"use\",\"wide\",\"constraints.\",\"I\",\"recommend\"\n                  ,D.green $ \"\\\"\" <> D.fromVersion before <> \" <= v < \" <> D.fromVersion (V.bumpMajor after) <> \"\\\"\"\n                  ,\"since\",\"it\",\"is\",\"guaranteed\",\"that\",\"breaking\",\"API\",\"changes\",\"cannot\"\n                  ,\"happen\",\"in\",\"any\",\"of\",\"the\",\"versions\",\"in\",\"that\",\"range.\"\n                  ]\n              )\n\n          else\n            toSnippet \"PROBLEM WITH CONSTRAINT\" Nothing\n              ( D.reflow $\n                  \"I got stuck while reading your elm.json file. I ran into an invalid version constraint:\"\n              , D.fillSep\n                  [\"Maybe\",\"you\",\"want\",\"something\",\"like\"\n                  ,D.green $ \"\\\"\" <> D.fromVersion before <> \" <= v < \" <> D.fromVersion (V.bumpMajor before) <> \"\\\"\"\n                  ,\"instead?\",\"Elm\",\"checks\",\"that\",\"all\",\"package\",\"APIs\",\"follow\",\"semantic\"\n                  ,\"versioning,\",\"so\",\"it\",\"is\",\"guaranteed\",\"that\",\"breaking\",\"API\",\"changes\"\n                  ,\"cannot\",\"happen\",\"in\",\"any\",\"of\",\"the\",\"versions\",\"in\",\"that\",\"range.\"\n                  ]\n              )\n\n    OP_BadModuleName row col ->\n      toSnippet \"PROBLEM WITH MODULE NAME\" (toHighlight row col)\n        ( D.reflow $\n            \"I got stuck while reading your elm.json file. I was expecting a module name here:\"\n        , D.fillSep\n            [\"I\",\"need\",\"something\",\"like\",D.green \"\\\"Html.Events\\\"\"\n            ,\"or\",D.green \"\\\"Browser.Navigation\\\"\"\n            ,\"where\",\"each\",\"segment\",\"starts\",\"with\",\"a\",\"capital\"\n            ,\"letter\",\"and\",\"the\",\"segments\",\"are\",\"separated\",\"by\",\"dots.\"\n            ]\n        )\n\n    OP_BadModuleHeaderTooLong ->\n      toSnippet \"HEADER TOO LONG\" Nothing\n        ( D.reflow $\n            \"I got stuck while reading your elm.json file. This section header is too long:\"\n        , D.stack\n            [ D.fillSep\n                [\"I\",\"need\",\"it\",\"to\",\"be\"\n                ,D.green \"under\",D.green \"20\",D.green \"bytes\"\n                ,\"so\",\"it\",\"renders\",\"nicely\",\"on\",\"the\",\"package\",\"website!\"\n                ]\n            , D.toSimpleNote\n                \"I count the length in bytes, so using non-ASCII characters costs extra.\\\n                \\ Please report your case at https://github.com/elm/compiler/issues if this seems\\\n                \\ overly restrictive for your needs.\"\n            ]\n        )\n\n    OP_BadDependencyName row col ->\n      toSnippet \"PROBLEM WITH DEPENDENCY NAME\" (toHighlight row col)\n        ( D.reflow $\n            \"I got stuck while reading your elm.json file. There is something wrong with this dependency name:\"\n        , D.stack\n            [ D.fillSep\n                [\"Package\",\"names\",\"always\",\"include\",\"the\",\"name\",\"of\",\"the\",\"author,\"\n                ,\"so\",\"I\",\"am\",\"expecting\",\"to\",\"see\",\"dependencies\",\"like\"\n                ,D.dullyellow \"\\\"mdgriffith/elm-ui\\\"\",\"and\"\n                ,D.dullyellow \"\\\"Microsoft/elm-json-tree-view\\\"\" <> \".\"\n                ]\n            , D.fillSep $\n                [\"I\",\"generally\",\"recommend\",\"finding\",\"the\",\"package\",\"you\",\"want\",\"on\"\n                ,\"the\",\"package\",\"website,\",\"and\",\"installing\",\"it\",\"with\",\"the\"\n                ,D.green \"elm install\",\"command!\"\n                ]\n            ]\n        )\n\n    OP_BadLicense _ suggestions ->\n      toSnippet \"UNKNOWN LICENSE\" Nothing\n        ( D.reflow $\n            \"I got stuck while reading your elm.json file. I do not know about this type of license:\"\n        ,\n          D.stack\n            [ D.fillSep\n                [\"Elm\",\"packages\",\"generally\",\"use\"\n                ,D.green \"\\\"BSD-3-Clause\\\"\",\"or\",D.green \"\\\"MIT\\\"\" <> \",\"\n                ,\"but\",\"I\",\"accept\",\"any\",\"OSI\",\"approved\",\"SPDX\",\"license.\"\n                ,\"Here\",\"some\",\"that\",\"seem\",\"close\",\"to\",\"what\",\"you\",\"wrote:\"\n                ]\n            , D.indent 4 $ D.dullyellow $ D.vcat $ map (D.fromChars . Json.toChars) suggestions\n            , D.reflow $\n                \"Check out https://spdx.org/licenses/ for the full list of options.\"\n            ]\n        )\n\n    OP_BadSummaryTooLong ->\n      toSnippet \"SUMMARY TOO LONG\" Nothing\n        ( D.reflow $\n            \"I got stuck while reading your elm.json file. Your \\\"summary\\\" is too long:\"\n        , D.stack\n            [ D.fillSep\n                [\"I\",\"need\",\"it\",\"to\",\"be\"\n                ,D.green \"under\",D.green \"80\",D.green \"bytes\"\n                ,\"so\",\"it\",\"renders\",\"nicely\",\"on\",\"the\",\"package\",\"website!\"\n                ]\n            , D.toSimpleNote\n                \"I count the length in bytes, so using non-ASCII characters costs extra.\\\n                \\ Please report your case at https://github.com/elm/compiler/issues if this seems\\\n                \\ overly restrictive for your needs.\"\n            ]\n        )\n\n    OP_NoSrcDirs ->\n      toSnippet \"NO SOURCE DIRECTORIES\" Nothing\n        ( D.reflow $\n            \"I got stuck while reading your elm.json file. You do not have any \\\"source-directories\\\" listed here:\"\n        , D.fillSep\n            [\"I\",\"need\",\"something\",\"like\",D.green \"[\\\"src\\\"]\"\n            ,\"so\",\"I\",\"know\",\"where\",\"to\",\"look\",\"for\",\"your\",\"modules!\"\n            ]\n        )\n\n\n\n-- DETAILS\n\n\ndata Details\n  = DetailsNoSolution\n  | DetailsNoOfflineSolution\n  | DetailsSolverProblem Solver\n  | DetailsBadElmInPkg C.Constraint\n  | DetailsBadElmInAppOutline V.Version\n  | DetailsHandEditedDependencies\n  | DetailsBadOutline Outline\n  | DetailsCannotGetRegistry RegistryProblem\n  | DetailsBadDeps FilePath [DetailsBadDep]\n\n\ndata DetailsBadDep\n  = BD_BadDownload Pkg.Name V.Version PackageProblem\n  | BD_BadBuild Pkg.Name V.Version (Map.Map Pkg.Name V.Version)\n\n\ntoDetailsReport :: Details -> Help.Report\ntoDetailsReport details =\n  case details of\n    DetailsNoSolution ->\n      Help.report \"INCOMPATIBLE DEPENDENCIES\" (Just \"elm.json\")\n        \"The dependencies in your elm.json are not compatible.\"\n        [ D.fillSep\n            [\"Did\",\"you\",\"change\",\"them\",\"by\",\"hand?\",\"Try\",\"to\",\"change\",\"it\",\"back!\"\n            ,\"It\",\"is\",\"much\",\"more\",\"reliable\",\"to\",\"add\",\"dependencies\",\"with\",D.green \"elm install\" <> \".\"\n            ]\n        , D.reflow $\n            \"Please ask for help on the community forums if you try those paths and are still\\\n            \\ having problems!\"\n        ]\n\n    DetailsNoOfflineSolution ->\n      Help.report \"TROUBLE VERIFYING DEPENDENCIES\" (Just \"elm.json\")\n        \"I could not connect to https://package.elm-lang.org to get the latest list of\\\n        \\ packages, and I was unable to verify your dependencies with the information I\\\n        \\ have cached locally.\"\n        [ D.reflow $\n            \"Are you able to connect to the internet? These dependencies may work once you\\\n            \\ get access to the registry!\"\n        , D.toFancyNote\n            [\"If\",\"you\",\"changed\",\"your\",\"dependencies\",\"by\",\"hand,\",\"try\",\"to\",\"change\",\"them\",\"back!\"\n            ,\"It\",\"is\",\"much\",\"more\",\"reliable\",\"to\",\"add\",\"dependencies\",\"with\",D.green \"elm install\" <> \".\"\n            ]\n        ]\n\n    DetailsSolverProblem solver ->\n      toSolverReport solver\n\n    DetailsBadElmInPkg constraint ->\n      Help.report \"ELM VERSION MISMATCH\" (Just \"elm.json\")\n        \"Your elm.json says this package needs a version of Elm in this range:\"\n        [ D.indent 4 $ D.dullyellow $ D.fromChars $ C.toChars constraint\n        , D.fillSep\n            [ \"But\", \"you\", \"are\", \"using\", \"Elm\"\n            , D.red (D.fromVersion V.compiler)\n            , \"right\", \"now.\"\n            ]\n        ]\n\n    DetailsBadElmInAppOutline version ->\n      Help.report \"ELM VERSION MISMATCH\" (Just \"elm.json\")\n        \"Your elm.json says this application needs a different version of Elm.\"\n        [ D.fillSep\n            [ \"It\", \"requires\"\n            , D.green (D.fromVersion version) <> \",\"\n            , \"but\", \"you\", \"are\", \"using\"\n            , D.red (D.fromVersion V.compiler)\n            , \"right\", \"now.\"\n            ]\n        ]\n\n    DetailsHandEditedDependencies ->\n      Help.report \"ERROR IN DEPENDENCIES\" (Just \"elm.json\")\n        \"It looks like the dependencies elm.json in were edited by hand (or by a 3rd\\\n        \\ party tool) leaving them in an invalid state.\"\n        [ D.fillSep\n            [\"Try\",\"to\",\"change\",\"them\",\"back\",\"to\",\"what\",\"they\",\"were\",\"before!\"\n            ,\"It\",\"is\",\"much\",\"more\",\"reliable\",\"to\",\"add\",\"dependencies\",\"with\",D.green \"elm install\" <> \".\"\n            ]\n        , D.reflow $\n            \"Please ask for help on the community forums if you try those paths and are still\\\n            \\ having problems!\"\n        ]\n\n    DetailsBadOutline outline ->\n      toOutlineReport outline\n\n    DetailsCannotGetRegistry problem ->\n      toRegistryProblemReport \"PROBLEM LOADING PACKAGE LIST\" problem $\n        \"I need the list of published packages to verify your dependencies\"\n\n    DetailsBadDeps cacheDir deps ->\n      case List.sortOn toBadDepRank deps of\n        [] ->\n          Help.report \"PROBLEM BUILDING DEPENDENCIES\" Nothing\n            \"I am not sure what is going wrong though.\"\n            [ D.reflow $\n                \"I would try deleting the \" ++ cacheDir ++ \" and elm-stuff/ directories, then\\\n                \\ trying to build again. That will work if some cached files got corrupted\\\n                \\ somehow.\"\n            , D.reflow $\n                \"If that does not work, go to https://elm-lang.org/community and ask for\\\n                \\ help. This is a weird case!\"\n            ]\n\n        d:_ ->\n          case d of\n            BD_BadDownload pkg vsn packageProblem ->\n              toPackageProblemReport pkg vsn packageProblem\n\n            BD_BadBuild pkg vsn fingerprint ->\n              Help.report \"PROBLEM BUILDING DEPENDENCIES\" Nothing\n                \"I ran into a compilation error when trying to build the following package:\"\n                [ D.indent 4 $ D.red $ D.fromChars $ Pkg.toChars pkg ++ \" \" ++ V.toChars vsn\n                , D.reflow $\n                    \"This probably means it has package constraints that are too wide. It may be\\\n                    \\ possible to tweak your elm.json to avoid the root problem as a stopgap. Head\\\n                    \\ over to https://elm-lang.org/community to get help figuring out how to take\\\n                    \\ this path!\"\n                , D.toSimpleNote $\n                    \"To help with the root problem, please report this to the package author along\\\n                    \\ with the following information:\"\n                , D.indent 4 $ D.vcat $\n                    map (\\(p,v) -> D.fromChars $ Pkg.toChars p ++ \" \" ++ V.toChars v) $\n                      Map.toList fingerprint\n                , D.reflow $\n                    \"If you want to help out even more, try building the package locally. That should\\\n                    \\ give you much more specific information about why this package is failing to\\\n                    \\ build, which will in turn make it easier for the package author to fix it!\"\n                ]\n\n\ntoBadDepRank :: DetailsBadDep -> Int -- lower is better\ntoBadDepRank badDep =\n  case badDep of\n    BD_BadDownload _ _ _ -> 0\n    BD_BadBuild _ _ _ -> 1\n\n\n\n-- PACKAGE PROBLEM\n\n\ndata PackageProblem\n  = PP_BadEndpointRequest Http.Error\n  | PP_BadEndpointContent String\n  | PP_BadArchiveRequest Http.Error\n  | PP_BadArchiveContent String\n  | PP_BadArchiveHash String String String\n\n\ntoPackageProblemReport :: Pkg.Name -> V.Version -> PackageProblem -> Help.Report\ntoPackageProblemReport pkg vsn problem =\n  let\n    thePackage =\n      Pkg.toChars pkg ++ \" \" ++ V.toChars vsn\n  in\n  case problem of\n    PP_BadEndpointRequest httpError ->\n      toHttpErrorReport \"PROBLEM DOWNLOADING PACKAGE\" httpError $\n        \"I need to find the latest download link for \" ++ thePackage\n\n    PP_BadEndpointContent url ->\n      Help.report \"PROBLEM DOWNLOADING PACKAGE\" Nothing\n        (\n          \"I need to find the latest download link for \" ++ thePackage ++ \", but I ran into corrupted information from:\"\n        )\n        [ D.indent 4 $ D.dullyellow $ D.fromChars url\n        , D.reflow $\n            \"Is something weird with your internet connection. We have gotten reports that\\\n            \\ schools, businesses, airports, etc. sometimes intercept requests and add things\\\n            \\ to the body or change its contents entirely. Could that be the problem?\"\n        ]\n\n    PP_BadArchiveRequest httpError ->\n      toHttpErrorReport \"PROBLEM DOWNLOADING PACKAGE\" httpError $\n        \"I was trying to download the source code for \" ++ thePackage\n\n    PP_BadArchiveContent url ->\n      Help.report \"PROBLEM DOWNLOADING PACKAGE\" Nothing\n        (\n          \"I downloaded the source code for \" ++ thePackage ++ \" from:\"\n        )\n        [ D.indent 4 $ D.dullyellow $ D.fromChars url\n        , D.reflow $\n           \"But I was unable to unzip the data. Maybe there is something weird with\\\n            \\ your internet connection. We have gotten reports that schools, businesses,\\\n            \\ airports, etc. sometimes intercept requests and add things to the body or\\\n            \\ change its contents entirely. Could that be the problem?\"\n        ]\n\n    PP_BadArchiveHash url expectedHash actualHash ->\n      Help.report \"CORRUPT PACKAGE DATA\" Nothing\n        (\n          \"I downloaded the source code for \" ++ thePackage ++ \" from:\"\n        )\n        [ D.indent 4 $ D.dullyellow $ D.fromChars url\n        , D.reflow \"But it looks like the hash of the archive has changed since publication:\"\n        , D.vcat $ map D.fromChars $\n            [ \"  Expected: \" ++ expectedHash\n            , \"    Actual: \" ++ actualHash\n            ]\n        , D.reflow $\n            \"This usually means that the package author moved the version\\\n            \\ tag, so report it to them and see if that is the issue. Folks\\\n            \\ on Elm slack can probably help as well.\"\n        ]\n\n\n\n-- REGISTRY PROBLEM\n\n\ndata RegistryProblem\n  = RP_Http Http.Error\n  | RP_Data String BS.ByteString\n\n\ntoRegistryProblemReport :: String -> RegistryProblem -> String -> Help.Report\ntoRegistryProblemReport title problem context =\n  case problem of\n    RP_Http err ->\n      toHttpErrorReport title err context\n\n    RP_Data url body ->\n      Help.report title Nothing (context ++ \", so I fetched:\")\n        [ D.indent 4 $ D.dullyellow $ D.fromChars url\n        , D.reflow $\n            \"I got the data back, but it was not what I was expecting. The response\\\n            \\ body contains \" ++ show (BS.length body) ++ \" bytes. Here is the \"\n            ++ if BS.length body <= 76 then \"whole thing:\" else \"beginning:\"\n        , D.indent 4 $ D.dullyellow $ D.fromChars $\n            if BS.length body <= 76\n            then BS_UTF8.toString body\n            else take 73 (BS_UTF8.toString body) ++ \"...\"\n        , D.reflow $\n            \"Does this error keep showing up? Maybe there is something weird with your\\\n            \\ internet connection. We have gotten reports that schools, businesses,\\\n            \\ airports, etc. sometimes intercept requests and add things to the body\\\n            \\ or change its contents entirely. Could that be the problem?\"\n        ]\n\n\ntoHttpErrorReport :: String -> Http.Error -> String -> Help.Report\ntoHttpErrorReport title err context =\n  let\n    toHttpReport intro url details =\n      Help.report title Nothing intro $\n        D.indent 4 (D.dullyellow (D.fromChars url)) : details\n  in\n  case err of\n    Http.BadUrl url reason ->\n      toHttpReport (context ++ \", so I wanted to fetch:\") url\n        [ D.reflow $ \"But my HTTP library is saying this is not a valid URL. It is saying:\"\n        , D.indent 4 $ D.fromChars reason\n        , D.reflow $\n            \"This may indicate that there is some problem in the compiler, so please open an\\\n            \\ issue at https://github.com/elm/compiler/issues listing your operating system, Elm\\\n            \\ version, the command you ran, the terminal output, and any additional information\\\n            \\ that might help others reproduce the error.\"\n        ]\n\n    Http.BadHttp url httpExceptionContent ->\n      case httpExceptionContent of\n        HTTP.StatusCodeException response body ->\n          let\n            (HTTP.Status code message) = HTTP.responseStatus response\n          in\n          toHttpReport (context ++ \", so I tried to fetch:\") url\n            [ D.fillSep $\n                [\"But\",\"it\",\"came\",\"back\",\"as\",D.red (D.fromInt code)]\n                ++ map D.fromChars (words (BS_UTF8.toString message))\n            , D.indent 4 $ D.reflow $ BS_UTF8.toString body\n            , D.reflow $\n                \"This may mean some online endpoint changed in an unexpected way, so if does not\\\n                \\ seem like something on your side is causing this (e.g. firewall) please report\\\n                \\ this to https://github.com/elm/compiler/issues with your operating system, Elm\\\n                \\ version, the command you ran, the terminal output, and any additional information\\\n                \\ that can help others reproduce the error!\"\n            ]\n\n        HTTP.TooManyRedirects responses ->\n          toHttpReport (context ++ \", so I tried to fetch:\") url\n            [ D.reflow $ \"But I gave up after following these \" ++ show (length responses) ++ \" redirects:\"\n            , D.indent 4 $ D.vcat $ map toRedirectDoc responses\n            , D.reflow $\n                \"Is it possible that your internet connection intercepts certain requests? That\\\n                \\ sometimes causes problems for folks in schools, businesses, airports, hotels,\\\n                \\ and certain countries. Try asking for help locally or in a community forum!\"\n            ]\n\n        otherException ->\n          toHttpReport (context ++ \", so I tried to fetch:\") url\n            [ D.reflow $ \"But my HTTP library is giving me the following error message:\"\n            , D.indent 4 $ D.fromChars (show otherException)\n            , D.reflow $\n                \"Are you somewhere with a slow internet connection? Or no internet?\\\n                \\ Does the link I am trying to fetch work in your browser? Maybe the\\\n                \\ site is down? Does your internet connection have a firewall that\\\n                \\ blocks certain domains? It is usually something like that!\"\n            ]\n\n    Http.BadMystery url someException ->\n      toHttpReport (context ++ \", so I tried to fetch:\") url\n        [ D.reflow $ \"But I ran into something weird! I was able to extract this error message:\"\n        , D.indent 4 $ D.fromChars (show someException)\n        , D.reflow $\n            \"Is it possible that your internet connection intercepts certain requests? That\\\n            \\ sometimes causes problems for folks in schools, businesses, airports, hotels,\\\n            \\ and certain countries. Try asking for help locally or in a community forum!\"\n        ]\n\n\ntoRedirectDoc :: HTTP.Response body -> D.Doc\ntoRedirectDoc response =\n  let\n    (HTTP.Status code message) = HTTP.responseStatus response\n  in\n  case List.lookup HTTP.hLocation (HTTP.responseHeaders response) of\n    Just loc -> D.red (D.fromInt code) <> \" - \" <> D.fromChars (BS_UTF8.toString loc)\n    Nothing  -> D.red (D.fromInt code) <> \" - \" <> D.fromChars (BS_UTF8.toString message)\n\n\n\n-- MAKE\n\n\ndata Make\n  = MakeNoOutline\n  | MakeCannotOptimizeAndDebug\n  | MakeBadDetails Details\n  | MakeAppNeedsFileNames\n  | MakePkgNeedsExposing\n  | MakeMultipleFilesIntoHtml\n  | MakeNoMain\n  | MakeNonMainFilesIntoJavaScript ModuleName.Raw [ModuleName.Raw]\n  | MakeCannotBuild BuildProblem\n  | MakeBadGenerate Generate\n\n\nmakeToReport :: Make -> Help.Report\nmakeToReport make =\n  case make of\n    MakeNoOutline ->\n      Help.report \"NO elm.json FILE\" Nothing\n        \"It looks like you are starting a new Elm project. Very exciting! Try running:\"\n        [ D.indent 4 $ D.green $ \"elm init\"\n        , D.reflow $\n            \"It will help you get set up. It is really simple!\"\n        ]\n\n    MakeCannotOptimizeAndDebug ->\n      Help.docReport \"CLASHING FLAGS\" Nothing\n        ( D.fillSep\n            [\"I\",\"cannot\",\"compile\",\"with\",D.red \"--optimize\",\"and\"\n            ,D.red \"--debug\",\"at\",\"the\",\"same\",\"time.\"\n            ]\n        )\n        [ D.reflow\n            \"I need to take away information to optimize things, and I need to\\\n            \\ add information to add the debugger. It is impossible to do both\\\n            \\ at once though! Pick just one of those flags and it should work!\"\n        ]\n\n    MakeBadDetails detailsProblem ->\n      toDetailsReport detailsProblem\n\n    MakeAppNeedsFileNames ->\n      Help.report \"NO INPUT\" Nothing\n        \"What should I make though? I need specific files like:\"\n        [ D.vcat\n            [ D.indent 4 $ D.green \"elm make src/Main.elm\"\n            , D.indent 4 $ D.green \"elm make src/This.elm src/That.elm\"\n            ]\n        , D.reflow $\n            \"I recommend reading through https://guide.elm-lang.org for guidance on what to\\\n            \\ actually put in those files!\"\n        ]\n\n    MakePkgNeedsExposing ->\n      Help.report \"NO INPUT\" Nothing\n        \"What should I make though? I need specific files like:\"\n        [ D.vcat\n            [ D.indent 4 $ D.green \"elm make src/Main.elm\"\n            , D.indent 4 $ D.green \"elm make src/This.elm src/That.elm\"\n            ]\n        , D.reflow $\n            \"You can also entries to the \\\"exposed-modules\\\" list in your elm.json file, and\\\n            \\ I will try to compile the relevant files.\"\n        ]\n\n    MakeMultipleFilesIntoHtml ->\n      Help.report \"TOO MANY FILES\" Nothing\n        (\n          \"When producing an HTML file, I can only handle one file.\"\n        )\n        [ D.fillSep\n            [\"Switch\",\"to\",D.dullyellow \"--output=/dev/null\",\"if\",\"you\",\"just\",\"want\"\n            ,\"to\",\"get\",\"compile\",\"errors.\",\"This\",\"skips\",\"the\",\"code\",\"gen\",\"phase,\"\n            ,\"so\",\"it\",\"can\",\"be\",\"a\",\"bit\",\"faster\",\"than\",\"other\",\"options\",\"sometimes.\"\n            ]\n        , D.fillSep\n            [\"Switch\",\"to\",D.dullyellow \"--output=elm.js\",\"if\",\"you\",\"want\",\"multiple\"\n            ,\"`main`\",\"values\",\"available\",\"in\",\"a\",\"single\",\"JavaScript\",\"file.\",\"Then\"\n            ,\"you\",\"can\",\"make\",\"your\",\"own\",\"customized\",\"HTML\",\"file\",\"that\",\"embeds\"\n            ,\"multiple\",\"Elm\",\"nodes.\",\"The\",\"generated\",\"JavaScript\",\"also\",\"shares\"\n            ,\"dependencies\",\"between\",\"modules,\",\"so\",\"it\",\"should\",\"be\",\"smaller\",\"than\"\n            ,\"compiling\",\"each\",\"module\",\"separately.\"\n            ]\n        ]\n\n    MakeNoMain ->\n      Help.report \"NO MAIN\" Nothing\n        (\n          \"When producing an HTML file, I require that the given file has a `main` value.\\\n          \\ That way I have something to show on screen!\"\n        )\n        [ D.reflow $\n            \"Try adding a `main` value to your file? Or if you just want to verify that this\\\n            \\ module compiles, switch to --output=/dev/null to skip the code gen phase\\\n            \\ altogether.\"\n        , D.toSimpleNote $\n            \"Adding a `main` value can be as brief as adding something like this:\"\n        , D.vcat\n            [ D.fillSep [D.cyan \"import\",\"Html\"]\n            , \"\"\n            , D.fillSep [D.green \"main\",\"=\"]\n            , D.indent 2 $ D.fillSep [D.cyan \"Html\" <> \".text\",D.dullyellow \"\\\"Hello!\\\"\"]\n            ]\n        , D.reflow $\n            \"From there I can create an HTML file that says \\\"Hello!\\\" on screen. I recommend\\\n            \\ looking through https://guide.elm-lang.org for more guidance on how to fill in\\\n            \\ the `main` value.\"\n        ]\n\n    MakeNonMainFilesIntoJavaScript m ms ->\n      case ms of\n        [] ->\n          Help.report \"NO MAIN\" Nothing\n            (\n              \"When producing a JS file, I require that the given file has a `main` value. That\\\n              \\ way Elm.\" ++ ModuleName.toChars m ++ \".init() is definitely defined in the\\\n              \\ resulting file!\"\n            )\n            [ D.reflow $\n                \"Try adding a `main` value to your file? Or if you just want to verify that this\\\n                \\ module compiles, switch to --output=/dev/null to skip the code gen phase\\\n                \\ altogether.\"\n            , D.toSimpleNote $\n                \"Adding a `main` value can be as brief as adding something like this:\"\n            , D.vcat\n                [ D.fillSep [D.cyan \"import\",\"Html\"]\n                , \"\"\n                , D.fillSep [D.green \"main\",\"=\"]\n                , D.indent 2 $ D.fillSep [D.cyan \"Html\" <> \".text\",D.dullyellow \"\\\"Hello!\\\"\"]\n                ]\n            , D.reflow $\n                \"Or use https://package.elm-lang.org/packages/elm/core/latest/Platform#worker to\\\n                \\ make a `main` with no user interface.\"\n            ]\n\n        _:_ ->\n          Help.report \"NO MAIN\" Nothing\n            (\n              \"When producing a JS file, I require that given files all have `main` values.\\\n              \\ That way functions like Elm.\" ++ ModuleName.toChars m ++ \".init() are\\\n              \\ definitely defined in the resulting file. I am missing `main` values in:\"\n            )\n            [ D.indent 4 $ D.red $ D.vcat $ map D.fromName (m:ms)\n            , D.reflow $\n                \"Try adding a `main` value to them? Or if you just want to verify that these\\\n                \\ modules compile, switch to --output=/dev/null to skip the code gen phase\\\n                \\ altogether.\"\n            , D.toSimpleNote $\n                \"Adding a `main` value can be as brief as adding something like this:\"\n            , D.vcat\n                [ D.fillSep [D.cyan \"import\",\"Html\"]\n                , \"\"\n                , D.fillSep [D.green \"main\",\"=\"]\n                , D.indent 2 $ D.fillSep [D.cyan \"Html\" <> \".text\",D.dullyellow \"\\\"Hello!\\\"\"]\n                ]\n            , D.reflow $\n                \"Or use https://package.elm-lang.org/packages/elm/core/latest/Platform#worker to\\\n                \\ make a `main` with no user interface.\"\n            ]\n\n    MakeCannotBuild buildProblem ->\n      toBuildProblemReport buildProblem\n\n    MakeBadGenerate generateProblem ->\n      toGenerateReport generateProblem\n\n\n\n-- BUILD PROBLEM\n\n\ndata BuildProblem\n  = BuildBadModules FilePath Error.Module [Error.Module]\n  | BuildProjectProblem BuildProjectProblem\n\n\ndata BuildProjectProblem\n  = BP_PathUnknown FilePath\n  | BP_WithBadExtension FilePath\n  | BP_WithAmbiguousSrcDir FilePath FilePath FilePath\n  | BP_MainPathDuplicate FilePath FilePath\n  | BP_RootNameDuplicate ModuleName.Raw FilePath FilePath\n  | BP_RootNameInvalid FilePath FilePath [String]\n  | BP_CannotLoadDependencies\n  | BP_Cycle ModuleName.Raw [ModuleName.Raw]\n  | BP_MissingExposed (NE.List (ModuleName.Raw, Import.Problem))\n\n\ntoBuildProblemReport :: BuildProblem -> Help.Report\ntoBuildProblemReport problem =\n  case problem of\n    BuildBadModules root e es ->\n      Help.compilerReport root e es\n\n    BuildProjectProblem projectProblem ->\n      toProjectProblemReport projectProblem\n\n\ntoProjectProblemReport :: BuildProjectProblem -> Help.Report\ntoProjectProblemReport projectProblem =\n  case projectProblem of\n    BP_PathUnknown path ->\n      Help.report \"FILE NOT FOUND\" Nothing\n        \"I cannot find this file:\"\n        [ D.indent 4 $ D.red $ D.fromChars path\n        , D.reflow $ \"Is there a typo?\"\n        , D.toSimpleNote $\n            \"If you are just getting started, try working through the examples in the\\\n            \\ official guide https://guide.elm-lang.org to get an idea of the kinds of things\\\n            \\ that typically go in a src/Main.elm file.\"\n        ]\n\n    BP_WithBadExtension path ->\n      Help.report \"UNEXPECTED FILE EXTENSION\" Nothing\n        \"I can only compile Elm files (with a .elm extension) but you want me to compile:\"\n        [ D.indent 4 $ D.red $ D.fromChars path\n        , D.reflow $ \"Is there a typo? Can the file extension be changed?\"\n        ]\n\n    BP_WithAmbiguousSrcDir path srcDir1 srcDir2 ->\n      Help.report \"CONFUSING FILE\" Nothing\n        \"I am getting confused when I try to compile this file:\"\n        [ D.indent 4 $ D.red $ D.fromChars path\n        , D.reflow $\n            \"I always check if files appear in any of the \\\"source-directories\\\" listed in\\\n            \\ your elm.json to see if there might be some cached information about them. That\\\n            \\ can help me compile faster! But in this case, it looks like this file may be in\\\n            \\ either of these directories:\"\n        , D.indent 4 $ D.red $ D.vcat $ map D.fromChars [srcDir1,srcDir2]\n        , D.reflow $\n            \"Try to make it so no source directory contains another source directory!\"\n        ]\n\n    BP_MainPathDuplicate path1 path2 ->\n      Help.report \"CONFUSING FILES\" Nothing\n        \"You are telling me to compile these two files:\"\n        [ D.indent 4 $ D.red $ D.vcat $ map D.fromChars [ path1, path2 ]\n        , D.reflow $\n            if path1 == path2 then\n              \"Why are you telling me twice? Is something weird going on with a script?\\\n              \\ I figured I would let you know about it just in case something is wrong.\\\n              \\ Only list it once and you should be all set!\"\n            else\n              \"But seem to be the same file though... It makes me think something tricky is\\\n              \\ going on with symlinks in your project, so I figured I would let you know\\\n              \\ about it just in case. Remove one of these files from your command to get\\\n              \\ unstuck!\"\n        ]\n\n    BP_RootNameDuplicate name outsidePath otherPath ->\n      Help.report \"MODULE NAME CLASH\" Nothing\n        \"These two files are causing a module name clash:\"\n        [ D.indent 4 $ D.red $ D.vcat $ map D.fromChars [ outsidePath, otherPath ]\n        , D.reflow $\n            \"They both say `module \" ++ ModuleName.toChars name ++ \" exposing (..)` up\\\n            \\ at the top, but they cannot have the same name!\"\n        , D.reflow $\n            \"Try changing to a different module name in one of them!\"\n        ]\n\n    BP_RootNameInvalid givenPath srcDir _ ->\n      Help.report \"UNEXPECTED FILE NAME\" Nothing\n        \"I am having trouble with this file name:\"\n        [ D.indent 4 $ D.red $ D.fromChars givenPath\n        , D.reflow $\n            \"I found it in your \" ++ FP.addTrailingPathSeparator srcDir ++ \" directory\\\n            \\ which is good, but I expect all of the files in there to use the following\\\n            \\ module naming convention:\"\n        , toModuleNameConventionTable srcDir [ \"Main\", \"HomePage\", \"Http.Helpers\" ]\n        , D.reflow $\n            \"Notice that the names always start with capital letters! Can you make your file\\\n            \\ use this naming convention?\"\n        , D.toSimpleNote $\n            \"Having a strict naming convention like this makes it a lot easier to find\\\n            \\ things in large projects. If you see a module imported, you know where to look\\\n            \\ for the corresponding file every time!\"\n        ]\n\n    BP_CannotLoadDependencies ->\n      corruptCacheReport\n\n    BP_Cycle name names ->\n      Help.report \"IMPORT CYCLE\" Nothing\n        \"Your module imports form a cycle:\"\n        [ D.cycle 4 name names\n        , D.reflow $\n            \"Learn more about why this is disallowed and how to break cycles here:\"\n            ++ D.makeLink \"import-cycles\"\n        ]\n\n    BP_MissingExposed (NE.List (name, problem) _) ->\n      case problem of\n        Import.NotFound ->\n          Help.report \"MISSING MODULE\" (Just \"elm.json\")\n            \"The  \\\"exposed-modules\\\" of your elm.json lists the following module:\"\n            [ D.indent 4 $ D.red $ D.fromName name\n            , D.reflow $\n                \"But I cannot find it in your src/ directory. Is there a typo? Was it renamed?\"\n            ]\n\n        Import.Ambiguous _ _ pkg _ ->\n          Help.report \"AMBIGUOUS MODULE NAME\" (Just \"elm.json\")\n            \"The  \\\"exposed-modules\\\" of your elm.json lists the following module:\"\n            [ D.indent 4 $ D.red $ D.fromName name\n            , D.reflow $\n                \"But a module from \" ++ Pkg.toChars pkg ++ \" already uses that name. Try\\\n                \\ choosing a different name for your local file.\"\n            ]\n\n        Import.AmbiguousLocal path1 path2 paths ->\n          Help.report \"AMBIGUOUS MODULE NAME\" (Just \"elm.json\")\n            \"The  \\\"exposed-modules\\\" of your elm.json lists the following module:\"\n            [ D.indent 4 $ D.red $ D.fromName name\n            , D.reflow $\n                \"But I found multiple files with that name:\"\n            , D.dullyellow $ D.indent 4 $ D.vcat $\n                map D.fromChars (path1:path2:paths)\n            , D.reflow $\n                \"Change the module names to be distinct!\"\n            ]\n\n        Import.AmbiguousForeign _ _ _ ->\n          Help.report \"MISSING MODULE\" (Just \"elm.json\")\n            \"The  \\\"exposed-modules\\\" of your elm.json lists the following module:\"\n            [ D.indent 4 $ D.red $ D.fromName name\n            , D.reflow $\n                \"But I cannot find it in your src/ directory. Is there a typo? Was it renamed?\"\n            , D.toSimpleNote $\n                \"It is not possible to \\\"re-export\\\" modules from other packages. You can only\\\n                \\ expose modules that you define in your own code.\"\n            ]\n\n\ntoModuleNameConventionTable :: FilePath -> [String] -> D.Doc\ntoModuleNameConventionTable srcDir names =\n  let\n    toPair name =\n      ( name\n      , srcDir </> map (\\c -> if c == '.' then FP.pathSeparator else c) name <.> \"elm\"\n      )\n\n    namePairs = map toPair names\n    nameWidth = maximum (11 : map (length . fst) namePairs)\n    pathWidth = maximum ( 9 : map (length . snd) namePairs)\n\n    padded width str =\n      str ++ replicate (width - length str) ' '\n\n    toRow (name, path) =\n      D.fromChars $\n        \"| \" ++ padded nameWidth name ++ \" | \" ++ padded pathWidth path ++ \" |\"\n\n    bar =\n      D.fromChars $\n        \"+-\" ++ replicate nameWidth '-' ++ \"-+-\" ++ replicate pathWidth '-' ++ \"-+\"\n  in\n  D.indent 4 $ D.vcat $\n    [ bar, toRow (\"Module Name\", \"File Path\"), bar ] ++ map toRow namePairs ++ [ bar ]\n\n\n\n-- GENERATE\n\n\ndata Generate\n  = GenerateCannotLoadArtifacts\n  | GenerateCannotOptimizeDebugValues ModuleName.Raw [ModuleName.Raw]\n\n\ntoGenerateReport :: Generate -> Help.Report\ntoGenerateReport problem =\n  case problem of\n    GenerateCannotLoadArtifacts ->\n      corruptCacheReport\n\n    GenerateCannotOptimizeDebugValues m ms ->\n      Help.report \"DEBUG REMNANTS\" Nothing\n        \"There are uses of the `Debug` module in the following modules:\"\n        [ D.indent 4 $ D.red $ D.vcat $ map (D.fromChars . ModuleName.toChars) (m:ms)\n        , D.reflow \"But the --optimize flag only works if all `Debug` functions are removed!\"\n        , D.toSimpleNote $\n            \"The issue is that --optimize strips out info needed by `Debug` functions.\\\n            \\ Here are two examples:\"\n        , D.indent 4 $ D.reflow $\n            \"(1) It shortens record field names. This makes the generated JavaScript\\\n            \\ smaller, but `Debug.toString` cannot know the real field names anymore.\"\n        , D.indent 4 $ D.reflow $\n            \"(2) Values like `type Height = Height Float` are unboxed. This reduces\\\n            \\ allocation, but it also means that `Debug.toString` cannot tell if it is\\\n            \\ looking at a `Height` or `Float` value.\"\n        , D.reflow $\n            \"There are a few other cases like that, and it will be much worse once we start\\\n            \\ inlining code. That optimization could move `Debug.log` and `Debug.todo` calls,\\\n            \\ resulting in unpredictable behavior. I hope that clarifies why this restriction\\\n            \\ exists!\"\n        ]\n\n\n\n-- CORRUPT CACHE\n\n\ncorruptCacheReport :: Help.Report\ncorruptCacheReport =\n  Help.report \"CORRUPT CACHE\" Nothing\n    \"It looks like some of the information cached in elm-stuff/ has been corrupted.\"\n    [ D.reflow $\n        \"Try deleting your elm-stuff/ directory to get unstuck.\"\n    , D.toSimpleNote $\n        \"This almost certainly means that a 3rd party tool (or editor plugin) is\\\n        \\ causing problems your the elm-stuff/ directory. Try disabling 3rd party tools\\\n        \\ one by one until you figure out which it is!\"\n    ]\n\n\n\n-- REACTOR\n\n\ndata Reactor\n  = ReactorNoOutline\n  | ReactorBadDetails Details\n  | ReactorBadBuild BuildProblem\n  | ReactorBadGenerate Generate\n\n\nreactorToReport :: Reactor -> Help.Report\nreactorToReport problem =\n  case problem of\n    ReactorNoOutline ->\n      Help.report \"NEW PROJECT?\" Nothing\n        \"Are you trying to start a new project? Try this command in the terminal:\"\n        [ D.indent 4 $ D.green \"elm init\"\n        , D.reflow \"It will help you get started!\"\n        ]\n\n    ReactorBadDetails details ->\n      toDetailsReport details\n\n    ReactorBadBuild buildProblem ->\n      toBuildProblemReport buildProblem\n\n    ReactorBadGenerate generate ->\n      toGenerateReport generate\n\n\n\n-- REPL\n\n\ndata Repl\n  = ReplBadDetails Details\n  | ReplBadInput BS.ByteString Error.Error\n  | ReplBadLocalDeps FilePath Error.Module [Error.Module]\n  | ReplProjectProblem BuildProjectProblem\n  | ReplBadGenerate Generate\n  | ReplBadCache\n  | ReplBlocked\n\n\nreplToReport :: Repl -> Help.Report\nreplToReport problem =\n  case problem of\n    ReplBadDetails details ->\n      toDetailsReport details\n\n    ReplBadInput source err ->\n      Help.compilerReport \"/\" (Error.Module N.replModule \"REPL\" File.zeroTime source err) []\n\n    ReplBadLocalDeps root e es ->\n      Help.compilerReport root e es\n\n    ReplProjectProblem projectProblem ->\n      toProjectProblemReport projectProblem\n\n    ReplBadGenerate generate ->\n      toGenerateReport generate\n\n    ReplBadCache ->\n      corruptCacheReport\n\n    ReplBlocked ->\n      corruptCacheReport\n"
  },
  {
    "path": "builder/src/Reporting/Task.hs",
    "content": "{-# LANGUAGE Rank2Types #-}\nmodule Reporting.Task\n  ( Task\n  , run\n  , throw\n  , mapError\n  --\n  , io\n  , mio\n  , eio\n  )\n  where\n\n\n\n-- TASKS\n\n\nnewtype Task x a =\n  Task\n  (\n    forall result. (a -> IO result) -> (x -> IO result) -> IO result\n  )\n\n\nrun :: Task x a -> IO (Either x a)\nrun (Task task) =\n  task (return . Right) (return . Left)\n\n\nthrow :: x -> Task x a\nthrow x =\n  Task $ \\_ err -> err x\n\n\nmapError :: (x -> y) -> Task x a -> Task y a\nmapError func (Task task) =\n  Task $ \\ok err ->\n    task ok (err . func)\n\n\n\n-- IO\n\n\n{-# INLINE io #-}\nio :: IO a -> Task x a\nio work =\n  Task $ \\ok _ -> work >>= ok\n\n\nmio :: x -> IO (Maybe a) -> Task x a\nmio x work =\n  Task $ \\ok err ->\n    do  result <- work\n        case result of\n          Just a -> ok a\n          Nothing -> err x\n\n\neio :: (x -> y) -> IO (Either x a) -> Task y a\neio func work =\n  Task $ \\ok err ->\n    do  result <- work\n        case result of\n          Right a -> ok a\n          Left x -> err (func x)\n\n\n\n-- INSTANCES\n\n\ninstance Functor (Task x) where\n  {-# INLINE fmap #-}\n  fmap func (Task taskA) =\n    Task $ \\ok err ->\n      let\n        okA arg = ok (func arg)\n      in\n      taskA okA err\n\n\ninstance Applicative (Task x) where\n  {-# INLINE pure #-}\n  pure a =\n    Task $ \\ok _ -> ok a\n\n  {-# INLINE (<*>) #-}\n  (<*>) (Task taskFunc) (Task taskArg) =\n    Task $ \\ok err ->\n      let\n        okFunc func =\n          let\n            okArg arg = ok (func arg)\n          in\n          taskArg okArg err\n      in\n      taskFunc okFunc err\n\n\ninstance Monad (Task x) where\n  {-# INLINE return #-}\n  return = pure\n\n  {-# INLINE (>>=) #-}\n  (>>=) (Task taskA) callback =\n    Task $ \\ok err ->\n      let\n        okA a =\n          case callback a of\n            Task taskB -> taskB ok err\n      in\n      taskA okA err\n"
  },
  {
    "path": "builder/src/Reporting.hs",
    "content": "{-# LANGUAGE BangPatterns, OverloadedStrings #-}\nmodule Reporting\n  ( Style\n  , silent\n  , json\n  , terminal\n  --\n  , attempt\n  , attemptWithStyle\n  --\n  , Key\n  , report\n  , ignorer\n  , ask\n  --\n  , DKey\n  , DMsg(..)\n  , trackDetails\n  --\n  , BKey\n  , BMsg(..)\n  , trackBuild\n  --\n  , reportGenerate\n  )\n  where\n\n\nimport Control.Concurrent\nimport Control.Exception (SomeException, AsyncException(UserInterrupt), catch, fromException, throw)\nimport Control.Monad (when)\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.NonEmptyList as NE\nimport qualified System.Exit as Exit\nimport qualified System.Info as Info\nimport System.IO (hFlush, hPutStr, hPutStrLn, stderr, stdout)\n\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified Json.Encode as Encode\nimport Reporting.Doc ((<+>))\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Exit.Help as Help\n\n\n\n-- STYLE\n\n\ndata Style\n  = Silent\n  | Json\n  | Terminal (MVar ())\n\n\nsilent :: Style\nsilent =\n  Silent\n\n\njson :: Style\njson =\n  Json\n\n\nterminal :: IO Style\nterminal =\n  Terminal <$> newMVar ()\n\n\n\n-- ATTEMPT\n\n\nattempt :: (x -> Help.Report) -> IO (Either x a) -> IO a\nattempt toReport work =\n  do  result <- work `catch` reportExceptionsNicely\n      case result of\n        Right a ->\n          return a\n\n        Left x ->\n          do  Exit.toStderr (toReport x)\n              Exit.exitFailure\n\n\nattemptWithStyle :: Style -> (x -> Help.Report) -> IO (Either x a) -> IO a\nattemptWithStyle style toReport work =\n  do  result <- work `catch` reportExceptionsNicely\n      case result of\n        Right a ->\n          return a\n\n        Left x ->\n          case style of\n            Silent ->\n              do  Exit.exitFailure\n\n            Json ->\n              do  B.hPutBuilder stderr (Encode.encodeUgly (Exit.toJson (toReport x)))\n                  Exit.exitFailure\n\n            Terminal mvar ->\n              do  readMVar mvar\n                  Exit.toStderr (toReport x)\n                  Exit.exitFailure\n\n\n\n-- MARKS\n\n\ngoodMark :: D.Doc\ngoodMark =\n  D.green $ if isWindows then \"+\" else \"●\"\n\n\nbadMark :: D.Doc\nbadMark =\n  D.red $ if isWindows then \"X\" else \"✗\"\n\n\nisWindows :: Bool\nisWindows =\n  Info.os == \"mingw32\"\n\n\n\n-- KEY\n\n\nnewtype Key msg = Key (msg -> IO ())\n\n\nreport :: Key msg -> msg -> IO ()\nreport (Key send) msg =\n  send msg\n\n\nignorer :: Key msg\nignorer =\n  Key (\\_ -> return ())\n\n\n\n-- ASK\n\n\nask :: D.Doc -> IO Bool\nask doc =\n  do  Help.toStdout doc\n      askHelp\n\n\naskHelp :: IO Bool\naskHelp =\n  do  hFlush stdout\n      input <- getLine\n      case input of\n        \"\"  -> return True\n        \"Y\" -> return True\n        \"y\" -> return True\n        \"n\" -> return False\n        _   ->\n          do  putStr \"Must type 'y' for yes or 'n' for no: \"\n              askHelp\n\n\n-- DETAILS\n\n\ntype DKey = Key DMsg\n\n\ntrackDetails :: Style -> (DKey -> IO a) -> IO a\ntrackDetails style callback =\n  case style of\n    Silent ->\n      callback (Key (\\_ -> return ()))\n\n    Json ->\n      callback (Key (\\_ -> return ()))\n\n    Terminal mvar ->\n      do  chan <- newChan\n\n          _ <- forkIO $\n            do  takeMVar mvar\n                detailsLoop chan (DState 0 0 0 0 0 0 0)\n                putMVar mvar ()\n\n          answer <- callback (Key (writeChan chan . Just))\n          writeChan chan Nothing\n          return answer\n\n\ndetailsLoop :: Chan (Maybe DMsg) -> DState -> IO ()\ndetailsLoop chan state@(DState total _ _ _ _ built _) =\n  do  msg <- readChan chan\n      case msg of\n        Just dmsg ->\n          detailsLoop chan =<< detailsStep dmsg state\n\n        Nothing ->\n          putStrLn $ clear (toBuildProgress total total) $\n            if built == total\n            then \"Dependencies ready!\"\n            else \"Dependency problem!\"\n\n\ndata DState =\n  DState\n    { _total :: !Int\n    , _cached :: !Int\n    , _requested :: !Int\n    , _received :: !Int\n    , _failed :: !Int\n    , _built :: !Int\n    , _broken :: !Int\n    }\n\n\ndata DMsg\n  = DStart Int\n  | DCached\n  | DRequested\n  | DReceived Pkg.Name V.Version\n  | DFailed Pkg.Name V.Version\n  | DBuilt\n  | DBroken\n\n\ndetailsStep :: DMsg -> DState -> IO DState\ndetailsStep msg (DState total cached rqst rcvd failed built broken) =\n  case msg of\n    DStart numDependencies ->\n      return (DState numDependencies 0 0 0 0 0 0)\n\n    DCached ->\n      putTransition (DState total (cached + 1) rqst rcvd failed built broken)\n\n    DRequested ->\n      do  when (rqst == 0) (putStrLn \"Starting downloads...\\n\")\n          return (DState total cached (rqst + 1) rcvd failed built broken)\n\n    DReceived pkg vsn ->\n      do  putDownload goodMark pkg vsn\n          putTransition (DState total cached rqst (rcvd + 1) failed built broken)\n\n    DFailed pkg vsn ->\n      do  putDownload badMark pkg vsn\n          putTransition (DState total cached rqst rcvd (failed + 1) built broken)\n\n    DBuilt ->\n      putBuilt (DState total cached rqst rcvd failed (built + 1) broken)\n\n    DBroken ->\n      putBuilt (DState total cached rqst rcvd failed built (broken + 1))\n\n\nputDownload :: D.Doc -> Pkg.Name -> V.Version -> IO ()\nputDownload mark pkg vsn =\n  Help.toStdout $ D.indent 2 $\n    mark\n    <+> D.fromPackage pkg\n    <+> D.fromVersion vsn\n    <> \"\\n\"\n\n\nputTransition :: DState -> IO DState\nputTransition state@(DState total cached _ rcvd failed built broken) =\n  if cached + rcvd + failed < total then\n    return state\n\n  else\n    do  let char = if rcvd + failed == 0 then '\\r' else '\\n'\n        putStrFlush (char : toBuildProgress (built + broken + failed) total)\n        return state\n\n\nputBuilt :: DState -> IO DState\nputBuilt state@(DState total cached _ rcvd failed built broken) =\n  do  when (total == cached + rcvd + failed) $\n        putStrFlush $ '\\r' : toBuildProgress (built + broken + failed) total\n      return state\n\n\ntoBuildProgress :: Int -> Int -> [Char]\ntoBuildProgress built total =\n  \"Verifying dependencies (\" ++ show built ++ \"/\" ++ show total ++ \")\"\n\n\nclear :: [Char] -> [Char] -> [Char]\nclear before after =\n  '\\r' : replicate (length before) ' ' ++ '\\r' : after\n\n\n\n-- BUILD\n\n\ntype BKey = Key BMsg\n\ntype BResult a = Either Exit.BuildProblem a\n\n\ntrackBuild :: Style -> (BKey -> IO (BResult a)) -> IO (BResult a)\ntrackBuild style callback =\n  case style of\n    Silent ->\n      callback (Key (\\_ -> return ()))\n\n    Json ->\n      callback (Key (\\_ -> return ()))\n\n    Terminal mvar ->\n      do  chan <- newChan\n\n          _ <- forkIO $\n            do  takeMVar mvar\n                putStrFlush \"Compiling ...\"\n                buildLoop chan 0\n                putMVar mvar ()\n\n          result <- callback (Key (writeChan chan . Left))\n          writeChan chan (Right result)\n          return result\n\n\ndata BMsg\n  = BDone\n\n\nbuildLoop :: Chan (Either BMsg (BResult a)) -> Int -> IO ()\nbuildLoop chan done =\n  do  msg <- readChan chan\n      case msg of\n        Left BDone ->\n          do  let !done1 = done + 1\n              putStrFlush $ \"\\rCompiling (\" ++ show done1 ++ \")\"\n              buildLoop chan done1\n\n        Right result ->\n          let\n            !message = toFinalMessage done result\n            !width = 12 + length (show done)\n          in\n          putStrLn $\n            if length message < width\n            then '\\r' : replicate width ' ' ++ '\\r' : message\n            else '\\r' : message\n\n\ntoFinalMessage :: Int -> BResult a -> [Char]\ntoFinalMessage done result =\n  case result of\n    Right _ ->\n      case done of\n        0 -> \"Success!\"\n        1 -> \"Success! Compiled 1 module.\"\n        n -> \"Success! Compiled \" ++ show n ++ \" modules.\"\n\n    Left problem ->\n      case problem of\n        Exit.BuildBadModules _ _ [] ->\n          \"Detected problems in 1 module.\"\n\n        Exit.BuildBadModules _ _ (_:ps) ->\n          \"Detected problems in \" ++ show (2 + length ps) ++ \" modules.\"\n\n        Exit.BuildProjectProblem _ ->\n          \"Detected a problem.\"\n\n\n\n-- GENERATE\n\n\nreportGenerate :: Style -> NE.List ModuleName.Raw -> FilePath -> IO ()\nreportGenerate style names output =\n  case style of\n    Silent ->\n      return ()\n\n    Json ->\n      return ()\n\n    Terminal mvar ->\n      do  readMVar mvar\n          let cnames = fmap ModuleName.toChars names\n          putStrLn ('\\n' : toGenDiagram cnames output)\n\n\ntoGenDiagram :: NE.List [Char] -> FilePath -> [Char]\ntoGenDiagram (NE.List name names) output =\n  let\n    width = 3 + foldr (max . length) (length name) names\n  in\n  case names of\n    [] ->\n      toGenLine width name ('>' : ' ' : output ++ \"\\n\")\n\n    _:_ ->\n      unlines $\n        toGenLine width name (vtop : hbar : hbar : '>' : ' ' : output)\n        : reverse (zipWith (toGenLine width) (reverse names) ([vbottom] : repeat [vmiddle]))\n\n\ntoGenLine :: Int -> [Char] -> [Char] -> [Char]\ntoGenLine width name end =\n  \"    \" ++ name ++ ' ' : replicate (width - length name) hbar ++ end\n\n\nhbar :: Char\nhbar = if isWindows then '-' else '─'\n\nvtop :: Char\nvtop = if isWindows then '+' else '┬'\n\nvmiddle :: Char\nvmiddle = if isWindows then '+' else '┤'\n\nvbottom :: Char\nvbottom = if isWindows then '+' else '┘'\n\n\n--\n\n\nputStrFlush :: String -> IO ()\nputStrFlush str =\n  hPutStr stdout str >> hFlush stdout\n\n\n\n-- REPORT EXCEPTIONS NICELY\n\n\nreportExceptionsNicely :: SomeException -> IO a\nreportExceptionsNicely e =\n  case fromException e of\n    Just UserInterrupt -> throw e\n    _                  -> putException e >> throw e\n\n\nputException :: SomeException -> IO ()\nputException e = do\n  hPutStrLn stderr \"\"\n  Help.toStderr $ D.stack $\n    [ D.dullyellow \"-- ERROR -----------------------------------------------------------------------\"\n    , D.reflow $\n        \"I ran into something that bypassed the normal error reporting process!\\\n        \\ I extracted whatever information I could from the internal error:\"\n    , D.vcat $ map (\\line -> D.red \">\" <> \"   \" <> D.fromChars line) (lines (show e))\n    , D.reflow $\n        \"These errors are usually pretty confusing, so start by asking around on one of\\\n        \\ forums listed at https://elm-lang.org/community to see if anyone can get you\\\n        \\ unstuck quickly.\"\n    , D.dullyellow \"-- REQUEST ---------------------------------------------------------------------\"\n    , D.reflow $\n        \"If you are feeling up to it, please try to get your code down to the smallest\\\n        \\ version that still triggers this message. Ideally in a single Main.elm and\\\n        \\ elm.json file.\"\n    , D.reflow $\n        \"From there open a NEW issue at https://github.com/elm/compiler/issues with\\\n        \\ your reduced example pasted in directly. (Not a link to a repo or gist!) Do not\\\n        \\ worry about if someone else saw something similar. More examples is better!\"\n    , D.reflow $\n        \"This kind of error is usually tied up in larger architectural choices that are\\\n        \\ hard to change, so even when we have a couple good examples, it can take some\\\n        \\ time to resolve in a solid way.\"\n    ]\n"
  },
  {
    "path": "builder/src/Stuff.hs",
    "content": "module Stuff\n  ( details\n  , interfaces\n  , objects\n  , prepublishDir\n  , elmi\n  , elmo\n  , temp\n  , findRoot\n  , withRootLock\n  , withRegistryLock\n  , PackageCache\n  , getPackageCache\n  , registry\n  , package\n  , getReplCache\n  , getElmHome\n  )\n  where\n\n\nimport qualified System.Directory as Dir\nimport qualified System.Environment as Env\nimport qualified System.FileLock as Lock\nimport qualified System.FilePath as FP\nimport System.FilePath ((</>), (<.>))\n\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\n\n\n\n-- PATHS\n\n\nstuff :: FilePath -> FilePath\nstuff root =\n  root </> \"elm-stuff\" </> compilerVersion\n\n\ndetails :: FilePath -> FilePath\ndetails root =\n  stuff root </> \"d.dat\"\n\n\ninterfaces :: FilePath -> FilePath\ninterfaces root =\n  stuff root </> \"i.dat\"\n\n\nobjects :: FilePath -> FilePath\nobjects root =\n  stuff root </> \"o.dat\"\n\n\nprepublishDir :: FilePath -> FilePath\nprepublishDir root =\n  stuff root </> \"prepublish\"\n\n\ncompilerVersion :: FilePath\ncompilerVersion =\n  V.toChars V.compiler\n\n\n\n-- ELMI and ELMO\n\n\nelmi :: FilePath -> ModuleName.Raw -> FilePath\nelmi root name =\n  toArtifactPath root name \"elmi\"\n\n\nelmo :: FilePath -> ModuleName.Raw -> FilePath\nelmo root name =\n  toArtifactPath root name \"elmo\"\n\n\ntoArtifactPath :: FilePath -> ModuleName.Raw -> String -> FilePath\ntoArtifactPath root name ext =\n  stuff root </> ModuleName.toHyphenPath name <.> ext\n\n\n\n-- TEMP\n\n\ntemp :: FilePath -> String -> FilePath\ntemp root ext =\n  stuff root </> \"temp\" <.> ext\n\n\n\n-- ROOT\n\n\nfindRoot :: IO (Maybe FilePath)\nfindRoot =\n  do  dir <- Dir.getCurrentDirectory\n      findRootHelp (FP.splitDirectories dir)\n\n\nfindRootHelp :: [String] -> IO (Maybe FilePath)\nfindRootHelp dirs =\n  case dirs of\n    [] ->\n      return Nothing\n\n    _:_ ->\n      do  exists <- Dir.doesFileExist (FP.joinPath dirs </> \"elm.json\")\n          if exists\n            then return (Just (FP.joinPath dirs))\n            else findRootHelp (init dirs)\n\n\n\n-- LOCKS\n\n\nwithRootLock :: FilePath -> IO a -> IO a\nwithRootLock root work =\n  do  let dir = stuff root\n      Dir.createDirectoryIfMissing True dir\n      Lock.withFileLock (dir </> \"lock\") Lock.Exclusive (\\_ -> work)\n\n\nwithRegistryLock :: PackageCache -> IO a -> IO a\nwithRegistryLock (PackageCache dir) work =\n  Lock.withFileLock (dir </> \"lock\") Lock.Exclusive (\\_ -> work)\n\n\n\n-- PACKAGE CACHES\n\n\nnewtype PackageCache = PackageCache FilePath\n\n\ngetPackageCache :: IO PackageCache\ngetPackageCache =\n  PackageCache <$> getCacheDir \"packages\"\n\n\nregistry :: PackageCache -> FilePath\nregistry (PackageCache dir) =\n  dir </> \"registry.dat\"\n\n\npackage :: PackageCache -> Pkg.Name -> V.Version -> FilePath\npackage (PackageCache dir) name version =\n  dir </> Pkg.toFilePath name </> V.toChars version\n\n\n\n-- CACHE\n\n\ngetReplCache :: IO FilePath\ngetReplCache =\n  getCacheDir \"repl\"\n\n\ngetCacheDir :: FilePath -> IO FilePath\ngetCacheDir projectName =\n  do  home <- getElmHome\n      let root = home </> compilerVersion </> projectName\n      Dir.createDirectoryIfMissing True root\n      return root\n\n\ngetElmHome :: IO FilePath\ngetElmHome =\n  do  maybeCustomHome <- Env.lookupEnv \"ELM_HOME\"\n      case maybeCustomHome of\n        Just customHome -> return customHome\n        Nothing -> Dir.getAppUserDataDirectory \"elm\"\n"
  },
  {
    "path": "cabal.config",
    "content": "profiling: False\nlibrary-profiling: True\n"
  },
  {
    "path": "compiler/src/AST/Canonical.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule AST.Canonical\n  ( Expr, Expr_(..)\n  , CaseBranch(..)\n  , FieldUpdate(..)\n  , CtorOpts(..)\n  -- definitions\n  , Def(..)\n  , Decls(..)\n  -- patterns\n  , Pattern, Pattern_(..)\n  , PatternCtorArg(..)\n  -- types\n  , Annotation(..)\n  , Type(..)\n  , AliasType(..)\n  , FieldType(..)\n  , fieldsToList\n  -- modules\n  , Module(..)\n  , Alias(..)\n  , Binop(..)\n  , Union(..)\n  , Ctor(..)\n  , Exports(..)\n  , Export(..)\n  , Effects(..)\n  , Port(..)\n  , Manager(..)\n  )\n  where\n\n{- Creating a canonical AST means finding the home module for all variables.\nSo if you have L.map, you need to figure out that it is from the elm/core\npackage in the List module.\n\nIn later phases (e.g. type inference, exhaustiveness checking, optimization)\nyou need to look up additional info from these modules. What is the type?\nWhat are the alternative type constructors? These lookups can be quite costly,\nespecially in type inference. To reduce costs the canonicalization phase\ncaches info needed in later phases. This means we no longer build large\ndictionaries of metadata with O(log(n)) lookups in those phases. Instead\nthere is an O(1) read of an existing field! I have tried to mark all\ncached data with comments like:\n\n-- CACHE for exhaustiveness\n-- CACHE for inference\n\nSo it is clear why the data is kept around.\n-}\n\n\nimport Control.Monad (liftM, liftM2, liftM3, liftM4, replicateM)\nimport Data.Binary\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport Data.Name (Name)\n\nimport qualified AST.Source as Src\nimport qualified AST.Utils.Binop as Binop\nimport qualified AST.Utils.Shader as Shader\nimport qualified Data.Index as Index\nimport qualified Elm.Float as EF\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.String as ES\nimport qualified Reporting.Annotation as A\n\n\n\n-- EXPRESSIONS\n\n\ntype Expr =\n  A.Located Expr_\n\n\n-- CACHE Annotations for type inference\ndata Expr_\n  = VarLocal Name\n  | VarTopLevel ModuleName.Canonical Name\n  | VarKernel Name Name\n  | VarForeign ModuleName.Canonical Name Annotation\n  | VarCtor CtorOpts ModuleName.Canonical Name Index.ZeroBased Annotation\n  | VarDebug ModuleName.Canonical Name Annotation\n  | VarOperator Name ModuleName.Canonical Name Annotation -- CACHE real name for optimization\n  | Chr ES.String\n  | Str ES.String\n  | Int Int\n  | Float EF.Float\n  | List [Expr]\n  | Negate Expr\n  | Binop Name ModuleName.Canonical Name Annotation Expr Expr -- CACHE real name for optimization\n  | Lambda [Pattern] Expr\n  | Call Expr [Expr]\n  | If [(Expr, Expr)] Expr\n  | Let Def Expr\n  | LetRec [Def] Expr\n  | LetDestruct Pattern Expr Expr\n  | Case Expr [CaseBranch]\n  | Accessor Name\n  | Access Expr (A.Located Name)\n  | Update Name Expr (Map.Map Name FieldUpdate)\n  | Record (Map.Map Name Expr)\n  | Unit\n  | Tuple Expr Expr (Maybe Expr)\n  | Shader Shader.Source Shader.Types\n\n\ndata CaseBranch =\n  CaseBranch Pattern Expr\n\n\ndata FieldUpdate =\n  FieldUpdate A.Region Expr\n\n\n\n-- DEFS\n\n\ndata Def\n  = Def (A.Located Name) [Pattern] Expr\n  | TypedDef (A.Located Name) FreeVars [(Pattern, Type)] Expr Type\n\n\n\n-- DECLARATIONS\n\n\ndata Decls\n  = Declare Def Decls\n  | DeclareRec Def [Def] Decls\n  | SaveTheEnvironment\n\n\n\n-- PATTERNS\n\n\ntype Pattern =\n  A.Located Pattern_\n\n\ndata Pattern_\n  = PAnything\n  | PVar Name\n  | PRecord [Name]\n  | PAlias Pattern Name\n  | PUnit\n  | PTuple Pattern Pattern (Maybe Pattern)\n  | PList [Pattern]\n  | PCons Pattern Pattern\n  | PBool Union Bool\n  | PChr ES.String\n  | PStr ES.String\n  | PInt Int\n  | PCtor\n      { _p_home :: ModuleName.Canonical\n      , _p_type :: Name\n      , _p_union :: Union\n      , _p_name :: Name\n      , _p_index :: Index.ZeroBased\n      , _p_args :: [PatternCtorArg]\n      }\n      -- CACHE _p_home, _p_type, and _p_vars for type inference\n      -- CACHE _p_index to replace _p_name in PROD code gen\n      -- CACHE _p_opts to allocate less in PROD code gen\n      -- CACHE _p_alts and _p_numAlts for exhaustiveness checker\n\n\ndata PatternCtorArg =\n  PatternCtorArg\n    { _index :: Index.ZeroBased -- CACHE for destructors/errors\n    , _type :: Type             -- CACHE for type inference\n    , _arg :: Pattern\n    }\n\n\n\n-- TYPES\n\n\ndata Annotation = Forall FreeVars Type\n  deriving (Eq)\n\n\ntype FreeVars = Map.Map Name ()\n\n\ndata Type\n  = TLambda Type Type\n  | TVar Name\n  | TType ModuleName.Canonical Name [Type]\n  | TRecord (Map.Map Name FieldType) (Maybe Name)\n  | TUnit\n  | TTuple Type Type (Maybe Type)\n  | TAlias ModuleName.Canonical Name [(Name, Type)] AliasType\n  deriving (Eq)\n\n\ndata AliasType\n  = Holey Type\n  | Filled Type\n  deriving (Eq)\n\n\ndata FieldType = FieldType {-# UNPACK #-} !Word16 Type\n  deriving (Eq)\n\n\n-- NOTE: The Word16 marks the source order, but it may not be available\n-- for every canonical type. For example, if the canonical type is inferred\n-- the orders will all be zeros.\n--\nfieldsToList :: Map.Map Name FieldType -> [(Name, Type)]\nfieldsToList fields =\n  let\n    getIndex (_, FieldType index _) =\n      index\n\n    dropIndex (name, FieldType _ tipe) =\n      (name, tipe)\n  in\n  map dropIndex (List.sortOn getIndex (Map.toList fields))\n\n\n\n-- MODULES\n\n\ndata Module =\n  Module\n    { _name    :: ModuleName.Canonical\n    , _exports :: Exports\n    , _docs    :: Src.Docs\n    , _decls   :: Decls\n    , _unions  :: Map.Map Name Union\n    , _aliases :: Map.Map Name Alias\n    , _binops  :: Map.Map Name Binop\n    , _effects :: Effects\n    }\n\n\ndata Alias = Alias [Name] Type\n  deriving (Eq)\n\n\ndata Binop = Binop_ Binop.Associativity Binop.Precedence Name\n  deriving (Eq)\n\n\ndata Union =\n  Union\n    { _u_vars :: [Name]\n    , _u_alts :: [Ctor]\n    , _u_numAlts :: Int -- CACHE numAlts for exhaustiveness checking\n    , _u_opts :: CtorOpts -- CACHE which optimizations are available\n    }\n  deriving (Eq)\n\n\ndata CtorOpts\n  = Normal\n  | Enum\n  | Unbox\n  deriving (Eq, Ord)\n\n\ndata Ctor = Ctor Name Index.ZeroBased Int [Type] -- CACHE length args\n  deriving (Eq)\n\n\n\n-- EXPORTS\n\n\ndata Exports\n  = ExportEverything A.Region\n  | Export (Map.Map Name (A.Located Export))\n\n\ndata Export\n  = ExportValue\n  | ExportBinop\n  | ExportAlias\n  | ExportUnionOpen\n  | ExportUnionClosed\n  | ExportPort\n\n\n\n-- EFFECTS\n\n\ndata Effects\n  = NoEffects\n  | Ports (Map.Map Name Port)\n  | Manager A.Region A.Region A.Region Manager\n\n\ndata Port\n  = Incoming { _freeVars :: FreeVars, _payload :: Type, _func :: Type }\n  | Outgoing { _freeVars :: FreeVars, _payload :: Type, _func :: Type }\n\n\ndata Manager\n  = Cmd Name\n  | Sub Name\n  | Fx Name Name\n\n\n\n-- BINARY\n\n\ninstance Binary Alias where\n  get = liftM2 Alias get get\n  put (Alias a b) = put a >> put b\n\n\ninstance Binary Union where\n  put (Union a b c d) = put a >> put b >> put c >> put d\n  get = liftM4 Union get get get get\n\n\ninstance Binary Ctor where\n  get = liftM4 Ctor get get get get\n  put (Ctor a b c d) = put a >> put b >> put c >> put d\n\n\ninstance Binary CtorOpts where\n  put opts =\n    case opts of\n      Normal -> putWord8 0\n      Enum   -> putWord8 1\n      Unbox  -> putWord8 2\n\n  get =\n    do  n <- getWord8\n        case n of\n          0 -> return Normal\n          1 -> return Enum\n          2 -> return Unbox\n          _ -> fail \"binary encoding of CtorOpts was corrupted\"\n\n\ninstance Binary Annotation where\n  get = liftM2 Forall get get\n  put (Forall a b) = put a >> put b\n\n\ninstance Binary Type where\n  put tipe =\n    case tipe of\n      TLambda a b        -> putWord8 0 >> put a >> put b\n      TVar a             -> putWord8 1 >> put a\n      TRecord a b        -> putWord8 2 >> put a >> put b\n      TUnit              -> putWord8 3\n      TTuple a b c       -> putWord8 4 >> put a >> put b >> put c\n      TAlias a b c d     -> putWord8 5 >> put a >> put b >> put c >> put d\n      TType home name ts ->\n        let potentialWord = length ts + 7 in\n        if potentialWord <= fromIntegral (maxBound :: Word8) then\n          do  putWord8 (fromIntegral potentialWord)\n              put home\n              put name\n              mapM_ put ts\n        else\n          putWord8 6 >> put home >> put name >> put ts\n\n  get =\n    do  word <- getWord8\n        case word of\n          0 -> liftM2 TLambda get get\n          1 -> liftM  TVar get\n          2 -> liftM2 TRecord get get\n          3 -> return TUnit\n          4 -> liftM3 TTuple get get get\n          5 -> liftM4 TAlias get get get get\n          6 -> liftM3 TType get get get\n          n -> liftM3 TType get get (replicateM (fromIntegral (n - 7)) get)\n\n\ninstance Binary AliasType where\n  put aliasType =\n    case aliasType of\n      Holey tipe  -> putWord8 0 >> put tipe\n      Filled tipe -> putWord8 1 >> put tipe\n\n  get =\n    do  n <- getWord8\n        case n of\n          0 -> liftM Holey get\n          1 -> liftM Filled get\n          _ -> fail \"binary encoding of AliasType was corrupted\"\n\n\ninstance Binary FieldType where\n  get = liftM2 FieldType get get\n  put (FieldType a b) = put a >> put b\n"
  },
  {
    "path": "compiler/src/AST/Optimized.hs",
    "content": "module AST.Optimized\n  ( Def(..)\n  , Expr(..)\n  , Global(..)\n  , Path(..)\n  , Destructor(..)\n  , Decider(..)\n  , Choice(..)\n  , GlobalGraph(..)\n  , LocalGraph(..)\n  , Main(..)\n  , Node(..)\n  , EffectsType(..)\n  , empty\n  , addGlobalGraph\n  , addLocalGraph\n  , addKernel\n  , toKernelGlobal\n  )\n  where\n\n\nimport Control.Monad (liftM, liftM2, liftM3, liftM4)\nimport Data.Binary (Binary, get, put, getWord8, putWord8)\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport Data.Name (Name)\nimport qualified Data.Set as Set\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Utils.Shader as Shader\nimport qualified Data.Index as Index\nimport qualified Elm.Float as EF\nimport qualified Elm.Kernel as K\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Elm.String as ES\nimport qualified Optimize.DecisionTree as DT\nimport qualified Reporting.Annotation as A\n\n\n\n-- EXPRESSIONS\n\n\ndata Expr\n  = Bool Bool\n  | Chr ES.String\n  | Str ES.String\n  | Int Int\n  | Float EF.Float\n  | VarLocal Name\n  | VarGlobal Global\n  | VarEnum Global Index.ZeroBased\n  | VarBox Global\n  | VarCycle ModuleName.Canonical Name\n  | VarDebug Name ModuleName.Canonical A.Region (Maybe Name)\n  | VarKernel Name Name\n  | List [Expr]\n  | Function [Name] Expr\n  | Call Expr [Expr]\n  | TailCall Name [(Name, Expr)]\n  | If [(Expr, Expr)] Expr\n  | Let Def Expr\n  | Destruct Destructor Expr\n  | Case Name Name (Decider Choice) [(Int, Expr)]\n  | Accessor Name\n  | Access Expr Name\n  | Update Expr (Map.Map Name Expr)\n  | Record (Map.Map Name Expr)\n  | Unit\n  | Tuple Expr Expr (Maybe Expr)\n  | Shader Shader.Source (Set.Set Name) (Set.Set Name)\n\n\ndata Global = Global ModuleName.Canonical Name\n\n\n\n-- DEFINITIONS\n\n\ndata Def\n  = Def Name Expr\n  | TailDef Name [Name] Expr\n\n\ndata Destructor =\n  Destructor Name Path\n\n\ndata Path\n  = Index Index.ZeroBased Path\n  | Field Name Path\n  | Unbox Path\n  | Root Name\n\n\n\n-- BRANCHING\n\n\ndata Decider a\n  = Leaf a\n  | Chain\n      { _testChain :: [(DT.Path, DT.Test)]\n      , _success :: Decider a\n      , _failure :: Decider a\n      }\n  | FanOut\n      { _path :: DT.Path\n      , _tests :: [(DT.Test, Decider a)]\n      , _fallback :: Decider a\n      }\n  deriving (Eq)\n\n\ndata Choice\n  = Inline Expr\n  | Jump Int\n\n\n\n-- OBJECT GRAPH\n\n\ndata GlobalGraph =\n  GlobalGraph\n    { _g_nodes :: Map.Map Global Node\n    , _g_fields :: Map.Map Name Int\n    }\n\n\ndata LocalGraph =\n  LocalGraph\n    { _l_main :: Maybe Main\n    , _l_nodes :: Map.Map Global Node  -- PERF profile switching Global to Name\n    , _l_fields :: Map.Map Name Int\n    }\n\n\ndata Main\n  = Static\n  | Dynamic\n      { _message :: Can.Type\n      , _decoder :: Expr\n      }\n\n\ndata Node\n  = Define Expr (Set.Set Global)\n  | DefineTailFunc [Name] Expr (Set.Set Global)\n  | Ctor Index.ZeroBased Int\n  | Enum Index.ZeroBased\n  | Box\n  | Link Global\n  | Cycle [Name] [(Name, Expr)] [Def] (Set.Set Global)\n  | Manager EffectsType\n  | Kernel [K.Chunk] (Set.Set Global)\n  | PortIncoming Expr (Set.Set Global)\n  | PortOutgoing Expr (Set.Set Global)\n\n\ndata EffectsType = Cmd | Sub | Fx\n\n\n\n-- GRAPHS\n\n\n{-# NOINLINE empty #-}\nempty :: GlobalGraph\nempty =\n  GlobalGraph Map.empty Map.empty\n\n\naddGlobalGraph :: GlobalGraph -> GlobalGraph -> GlobalGraph\naddGlobalGraph (GlobalGraph nodes1 fields1) (GlobalGraph nodes2 fields2) =\n  GlobalGraph\n    { _g_nodes = Map.union nodes1 nodes2\n    , _g_fields = Map.union fields1 fields2\n    }\n\n\naddLocalGraph :: LocalGraph -> GlobalGraph -> GlobalGraph\naddLocalGraph (LocalGraph _ nodes1 fields1) (GlobalGraph nodes2 fields2) =\n  GlobalGraph\n    { _g_nodes = Map.union nodes1 nodes2\n    , _g_fields = Map.union fields1 fields2\n    }\n\n\naddKernel :: Name.Name -> [K.Chunk] -> GlobalGraph -> GlobalGraph\naddKernel shortName chunks (GlobalGraph nodes fields) =\n  let\n    global = toKernelGlobal shortName\n    node = Kernel chunks (foldr addKernelDep Set.empty chunks)\n  in\n  GlobalGraph\n    { _g_nodes = Map.insert global node nodes\n    , _g_fields = Map.union (K.countFields chunks) fields\n    }\n\n\naddKernelDep :: K.Chunk -> Set.Set Global -> Set.Set Global\naddKernelDep chunk deps =\n  case chunk of\n    K.JS _              -> deps\n    K.ElmVar home name  -> Set.insert (Global home name) deps\n    K.JsVar shortName _ -> Set.insert (toKernelGlobal shortName) deps\n    K.ElmField _        -> deps\n    K.JsField _         -> deps\n    K.JsEnum _          -> deps\n    K.Debug             -> deps\n    K.Prod              -> deps\n\n\ntoKernelGlobal :: Name.Name -> Global\ntoKernelGlobal shortName =\n  Global (ModuleName.Canonical Pkg.kernel shortName) Name.dollar\n\n\n\n-- INSTANCES\n\n\ninstance Eq Global where\n  (==) (Global home1 name1) (Global home2 name2) =\n    name1 == name2 && home1 == home2\n\n\ninstance Ord Global where\n  compare (Global home1 name1) (Global home2 name2) =\n    case compare name1 name2 of\n      LT -> LT\n      EQ -> compare home1 home2\n      GT -> GT\n\n\n\n-- BINARY\n\n\ninstance Binary Global where\n  get = liftM2 Global get get\n  put (Global a b) = put a >> put b\n\n\ninstance Binary Expr where\n  put expr =\n    case expr of\n      Bool a           -> putWord8  0 >> put a\n      Chr a            -> putWord8  1 >> put a\n      Str a            -> putWord8  2 >> put a\n      Int a            -> putWord8  3 >> put a\n      Float a          -> putWord8  4 >> put a\n      VarLocal a       -> putWord8  5 >> put a\n      VarGlobal a      -> putWord8  6 >> put a\n      VarEnum a b      -> putWord8  7 >> put a >> put b\n      VarBox a         -> putWord8  8 >> put a\n      VarCycle a b     -> putWord8  9 >> put a >> put b\n      VarDebug a b c d -> putWord8 10 >> put a >> put b >> put c >> put d\n      VarKernel a b    -> putWord8 11 >> put a >> put b\n      List a           -> putWord8 12 >> put a\n      Function a b     -> putWord8 13 >> put a >> put b\n      Call a b         -> putWord8 14 >> put a >> put b\n      TailCall a b     -> putWord8 15 >> put a >> put b\n      If a b           -> putWord8 16 >> put a >> put b\n      Let a b          -> putWord8 17 >> put a >> put b\n      Destruct a b     -> putWord8 18 >> put a >> put b\n      Case a b c d     -> putWord8 19 >> put a >> put b >> put c >> put d\n      Accessor a       -> putWord8 20 >> put a\n      Access a b       -> putWord8 21 >> put a >> put b\n      Update a b       -> putWord8 22 >> put a >> put b\n      Record a         -> putWord8 23 >> put a\n      Unit             -> putWord8 24\n      Tuple a b c      -> putWord8 25 >> put a >> put b >> put c\n      Shader a b c     -> putWord8 26 >> put a >> put b >> put c\n\n  get =\n    do  word <- getWord8\n        case word of\n          0  -> liftM  Bool get\n          1  -> liftM  Chr get\n          2  -> liftM  Str get\n          3  -> liftM  Int get\n          4  -> liftM  Float get\n          5  -> liftM  VarLocal get\n          6  -> liftM  VarGlobal get\n          7  -> liftM2 VarEnum get get\n          8  -> liftM  VarBox get\n          9  -> liftM2 VarCycle get get\n          10 -> liftM4 VarDebug get get get get\n          11 -> liftM2 VarKernel get get\n          12 -> liftM  List get\n          13 -> liftM2 Function get get\n          14 -> liftM2 Call get get\n          15 -> liftM2 TailCall get get\n          16 -> liftM2 If get get\n          17 -> liftM2 Let get get\n          18 -> liftM2 Destruct get get\n          19 -> liftM4 Case get get get get\n          20 -> liftM  Accessor get\n          21 -> liftM2 Access get get\n          22 -> liftM2 Update get get\n          23 -> liftM  Record get\n          24 -> pure   Unit\n          25 -> liftM3 Tuple get get get\n          26 -> liftM3 Shader get get get\n          _  -> fail \"problem getting Opt.Expr binary\"\n\n\ninstance Binary Def where\n  put def =\n    case def of\n      Def a b       -> putWord8 0 >> put a >> put b\n      TailDef a b c -> putWord8 1 >> put a >> put b >> put c\n\n  get =\n    do  word <- getWord8\n        case word of\n          0 -> liftM2 Def get get\n          1 -> liftM3 TailDef get get get\n          _ -> fail \"problem getting Opt.Def binary\"\n\n\ninstance Binary Destructor where\n  get = liftM2 Destructor get get\n  put (Destructor a b) = put a >> put b\n\n\ninstance Binary Path where\n  put destructor =\n    case destructor of\n      Index a b -> putWord8 0 >> put a >> put b\n      Field a b -> putWord8 1 >> put a >> put b\n      Unbox a   -> putWord8 2 >> put a\n      Root a    -> putWord8 3 >> put a\n\n  get =\n    do  word <- getWord8\n        case word of\n          0 -> liftM2 Index get get\n          1 -> liftM2 Field get get\n          2 -> liftM  Unbox get\n          3 -> liftM  Root get\n          _ -> fail \"problem getting Opt.Path binary\"\n\n\ninstance (Binary a) => Binary (Decider a) where\n  put decider =\n    case decider of\n      Leaf a       -> putWord8 0 >> put a\n      Chain a b c  -> putWord8 1 >> put a >> put b >> put c\n      FanOut a b c -> putWord8 2 >> put a >> put b >> put c\n\n  get =\n    do  word <- getWord8\n        case word of\n          0 -> liftM  Leaf get\n          1 -> liftM3 Chain get get get\n          2 -> liftM3 FanOut get get get\n          _ -> fail \"problem getting Opt.Decider binary\"\n\n\ninstance Binary Choice where\n  put choice =\n    case choice of\n      Inline expr -> putWord8 0 >> put expr\n      Jump index  -> putWord8 1 >> put index\n\n  get =\n    do  word <- getWord8\n        case word of\n          0 -> liftM Inline get\n          1 -> liftM Jump get\n          _ -> fail \"problem getting Opt.Choice binary\"\n\n\n\ninstance Binary GlobalGraph where\n  get = liftM2 GlobalGraph get get\n  put (GlobalGraph a b) = put a >> put b\n\n\ninstance Binary LocalGraph where\n  get = liftM3 LocalGraph get get get\n  put (LocalGraph a b c) = put a >> put b >> put c\n\n\ninstance Binary Main where\n  put main =\n    case main of\n      Static      -> putWord8 0\n      Dynamic a b -> putWord8 1 >> put a >> put b\n\n  get =\n    do  word <- getWord8\n        case word of\n          0 -> return Static\n          1 -> liftM2 Dynamic get get\n          _ -> fail \"problem getting Opt.Main binary\"\n\n\ninstance Binary Node where\n  put node =\n    case node of\n      Define a b           -> putWord8  0 >> put a >> put b\n      DefineTailFunc a b c -> putWord8  1 >> put a >> put b >> put c\n      Ctor a b             -> putWord8  2 >> put a >> put b\n      Enum a               -> putWord8  3 >> put a\n      Box                  -> putWord8  4\n      Link a               -> putWord8  5 >> put a\n      Cycle a b c d        -> putWord8  6 >> put a >> put b >> put c >> put d\n      Manager a            -> putWord8  7 >> put a\n      Kernel a b           -> putWord8  8 >> put a >> put b\n      PortIncoming a b     -> putWord8  9 >> put a >> put b\n      PortOutgoing a b     -> putWord8 10 >> put a >> put b\n\n  get =\n    do  word <- getWord8\n        case word of\n          0  -> liftM2 Define get get\n          1  -> liftM3 DefineTailFunc get get get\n          2  -> liftM2 Ctor get get\n          3  -> liftM  Enum get\n          4  -> return Box\n          5  -> liftM  Link get\n          6  -> liftM4 Cycle get get get get\n          7  -> liftM  Manager get\n          8  -> liftM2 Kernel get get\n          9  -> liftM2 PortIncoming get get\n          10 -> liftM2 PortOutgoing get get\n          _  -> fail \"problem getting Opt.Node binary\"\n\n\ninstance Binary EffectsType where\n  put effectsType =\n    case effectsType of\n      Cmd -> putWord8 0\n      Sub -> putWord8 1\n      Fx  -> putWord8 2\n\n  get =\n    do  word <- getWord8\n        case word of\n          0 -> return Cmd\n          1 -> return Sub\n          2 -> return Fx\n          _ -> fail \"problem getting Opt.EffectsType binary\"\n"
  },
  {
    "path": "compiler/src/AST/Source.hs",
    "content": "module AST.Source\n  ( Expr, Expr_(..), VarType(..)\n  , Def(..)\n  , Pattern, Pattern_(..)\n  , Type, Type_(..)\n  , Module(..)\n  , getName\n  , getImportName\n  , Import(..)\n  , Value(..)\n  , Union(..)\n  , Alias(..)\n  , Infix(..)\n  , Port(..)\n  , Effects(..)\n  , Manager(..)\n  , Docs(..)\n  , Comment(..)\n  , Exposing(..)\n  , Exposed(..)\n  , Privacy(..)\n  )\n  where\n\n\nimport Data.Name (Name)\nimport qualified Data.Name as Name\n\nimport qualified AST.Utils.Binop as Binop\nimport qualified AST.Utils.Shader as Shader\nimport qualified Elm.Float as EF\nimport qualified Elm.String as ES\nimport qualified Parse.Primitives as P\nimport qualified Reporting.Annotation as A\n\n\n\n-- EXPRESSIONS\n\n\ntype Expr = A.Located Expr_\n\n\ndata Expr_\n  = Chr ES.String\n  | Str ES.String\n  | Int Int\n  | Float EF.Float\n  | Var VarType Name\n  | VarQual VarType Name Name\n  | List [Expr]\n  | Op Name\n  | Negate Expr\n  | Binops [(Expr, A.Located Name)] Expr\n  | Lambda [Pattern] Expr\n  | Call Expr [Expr]\n  | If [(Expr, Expr)] Expr\n  | Let [A.Located Def] Expr\n  | Case Expr [(Pattern, Expr)]\n  | Accessor Name\n  | Access Expr (A.Located Name)\n  | Update (A.Located Name) [(A.Located Name, Expr)]\n  | Record [(A.Located Name, Expr)]\n  | Unit\n  | Tuple Expr Expr [Expr]\n  | Shader Shader.Source Shader.Types\n\n\ndata VarType = LowVar | CapVar\n\n\n\n-- DEFINITIONS\n\n\ndata Def\n  = Define (A.Located Name) [Pattern] Expr (Maybe Type)\n  | Destruct Pattern Expr\n\n\n\n-- PATTERN\n\n\ntype Pattern = A.Located Pattern_\n\n\ndata Pattern_\n  = PAnything\n  | PVar Name\n  | PRecord [A.Located Name]\n  | PAlias Pattern (A.Located Name)\n  | PUnit\n  | PTuple Pattern Pattern [Pattern]\n  | PCtor A.Region Name [Pattern]\n  | PCtorQual A.Region Name Name [Pattern]\n  | PList [Pattern]\n  | PCons Pattern Pattern\n  | PChr ES.String\n  | PStr ES.String\n  | PInt Int\n\n\n\n-- TYPE\n\n\ntype Type =\n    A.Located Type_\n\n\ndata Type_\n  = TLambda Type Type\n  | TVar Name\n  | TType A.Region Name [Type]\n  | TTypeQual A.Region Name Name [Type]\n  | TRecord [(A.Located Name, Type)] (Maybe (A.Located Name))\n  | TUnit\n  | TTuple Type Type [Type]\n\n\n\n-- MODULE\n\n\ndata Module =\n  Module\n    { _name    :: Maybe (A.Located Name)\n    , _exports :: A.Located Exposing\n    , _docs    :: Docs\n    , _imports :: [Import]\n    , _values  :: [A.Located Value]\n    , _unions  :: [A.Located Union]\n    , _aliases :: [A.Located Alias]\n    , _binops  :: [A.Located Infix]\n    , _effects :: Effects\n    }\n\n\ngetName :: Module -> Name\ngetName (Module maybeName _ _ _ _ _ _ _ _) =\n  case maybeName of\n    Just (A.At _ name) ->\n      name\n\n    Nothing ->\n      Name._Main\n\n\ngetImportName :: Import -> Name\ngetImportName (Import (A.At _ name) _ _) =\n  name\n\n\ndata Import =\n  Import\n    { _import :: A.Located Name\n    , _alias :: Maybe Name\n    , _exposing :: Exposing\n    }\n\n\ndata Value = Value (A.Located Name) [Pattern] Expr (Maybe Type)\ndata Union = Union (A.Located Name) [A.Located Name] [(A.Located Name, [Type])]\ndata Alias = Alias (A.Located Name) [A.Located Name] Type\ndata Infix = Infix Name Binop.Associativity Binop.Precedence Name\ndata Port = Port (A.Located Name) Type\n\n\ndata Effects\n  = NoEffects\n  | Ports [Port]\n  | Manager A.Region Manager\n\n\ndata Manager\n  = Cmd (A.Located Name)\n  | Sub (A.Located Name)\n  | Fx (A.Located Name) (A.Located Name)\n\n\ndata Docs\n  = NoDocs A.Region\n  | YesDocs Comment [(Name, Comment)]\n\n\nnewtype Comment =\n  Comment P.Snippet\n\n\n\n-- EXPOSING\n\n\ndata Exposing\n  = Open\n  | Explicit [Exposed]\n\n\ndata Exposed\n  = Lower (A.Located Name)\n  | Upper (A.Located Name) Privacy\n  | Operator A.Region Name\n\n\ndata Privacy\n  = Public A.Region\n  | Private\n"
  },
  {
    "path": "compiler/src/AST/Utils/Binop.hs",
    "content": "module AST.Utils.Binop\n  ( Precedence(..)\n  , Associativity(..)\n  )\n  where\n\n\nimport Prelude hiding (Either(..))\nimport Control.Monad (liftM)\nimport Data.Binary\n\n\n\n-- BINOP STUFF\n\n\nnewtype Precedence = Precedence Int\n  deriving (Eq, Ord)\n\n\ndata Associativity\n  = Left\n  | Non\n  | Right\n  deriving (Eq)\n\n\n\n-- BINARY\n\n\ninstance Binary Precedence where\n  get =\n    liftM Precedence get\n\n  put (Precedence n) =\n    put n\n\n\ninstance Binary Associativity where\n  get =\n    do  n <- getWord8\n        case n of\n          0 -> return Left\n          1 -> return Non\n          2 -> return Right\n          _ -> fail \"Error reading valid associativity from serialized string\"\n\n  put assoc =\n    putWord8 $\n      case assoc of\n        Left  -> 0\n        Non   -> 1\n        Right -> 2\n"
  },
  {
    "path": "compiler/src/AST/Utils/Shader.hs",
    "content": "{-# LANGUAGE EmptyDataDecls #-}\nmodule AST.Utils.Shader\n  ( Source\n  , Types(..)\n  , Type(..)\n  , fromChars\n  , toJsStringBuilder\n  )\n  where\n\n\nimport Control.Monad (liftM)\nimport Data.Binary (Binary, get, put)\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.ByteString.UTF8 as BS_UTF8\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\n\n\n\n-- SOURCE\n\n\nnewtype Source =\n  Source BS.ByteString\n\n\n\n-- TYPES\n\n\ndata Types =\n  Types\n    { _attribute :: Map.Map Name.Name Type\n    , _uniform :: Map.Map Name.Name Type\n    , _varying :: Map.Map Name.Name Type\n    }\n\n\ndata Type\n  = Int\n  | Float\n  | V2\n  | V3\n  | V4\n  | M4\n  | Texture\n\n\n\n-- TO BUILDER\n\n\ntoJsStringBuilder :: Source -> B.Builder\ntoJsStringBuilder (Source src) =\n  B.byteString src\n\n\n\n-- FROM CHARS\n\n\nfromChars :: [Char] -> Source\nfromChars chars =\n  Source (BS_UTF8.fromString (escape chars))\n\n\nescape :: [Char] -> [Char]\nescape chars =\n  case chars of\n    [] ->\n      []\n\n    c:cs\n      | c == '\\r' -> escape cs\n      | c == '\\n' -> '\\\\' : 'n'  : escape cs\n      | c == '\\\"' -> '\\\\' : '\"'  : escape cs\n      | c == '\\'' -> '\\\\' : '\\'' : escape cs\n      | c == '\\\\' -> '\\\\' : '\\\\' : escape cs\n      | otherwise -> c : escape cs\n\n\n\n-- BINARY\n\n\ninstance Binary Source where\n  get = liftM Source get\n  put (Source a) = put a\n"
  },
  {
    "path": "compiler/src/AST/Utils/Type.hs",
    "content": "module AST.Utils.Type\n  ( delambda\n  , dealias\n  , deepDealias\n  , iteratedDealias\n  )\n  where\n\n\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\n\nimport AST.Canonical (Type(..), AliasType(..), FieldType(..))\n\n\n\n-- DELAMBDA\n\n\ndelambda :: Type -> [Type]\ndelambda tipe =\n  case tipe of\n    TLambda arg result ->\n      arg : delambda result\n\n    _ ->\n      [tipe]\n\n\n\n-- DEALIAS\n\n\ndealias :: [(Name.Name, Type)] -> AliasType -> Type\ndealias args aliasType =\n  case aliasType of\n    Holey tipe ->\n      dealiasHelp (Map.fromList args) tipe\n\n    Filled tipe ->\n      tipe\n\n\ndealiasHelp :: Map.Map Name.Name Type -> Type -> Type\ndealiasHelp typeTable tipe =\n  case tipe of\n    TLambda a b ->\n      TLambda\n        (dealiasHelp typeTable a)\n        (dealiasHelp typeTable b)\n\n    TVar x ->\n      Map.findWithDefault tipe x typeTable\n\n    TRecord fields ext ->\n      TRecord (Map.map (dealiasField typeTable) fields) ext\n\n    TAlias home name args t' ->\n      TAlias home name (map (fmap (dealiasHelp typeTable)) args) t'\n\n    TType home name args ->\n      TType home name (map (dealiasHelp typeTable) args)\n\n    TUnit ->\n      TUnit\n\n    TTuple a b maybeC ->\n      TTuple\n        (dealiasHelp typeTable a)\n        (dealiasHelp typeTable b)\n        (fmap (dealiasHelp typeTable) maybeC)\n\n\ndealiasField :: Map.Map Name.Name Type -> FieldType -> FieldType\ndealiasField typeTable (FieldType index tipe) =\n  FieldType index (dealiasHelp typeTable tipe)\n\n\n\n-- DEEP DEALIAS\n\n\ndeepDealias :: Type -> Type\ndeepDealias tipe =\n  case tipe of\n    TLambda a b ->\n      TLambda (deepDealias a) (deepDealias b)\n\n    TVar _ ->\n      tipe\n\n    TRecord fields ext ->\n      TRecord (Map.map deepDealiasField fields) ext\n\n    TAlias _ _ args tipe' ->\n      deepDealias (dealias args tipe')\n\n    TType home name args ->\n      TType home name (map deepDealias args)\n\n    TUnit ->\n      TUnit\n\n    TTuple a b c ->\n      TTuple (deepDealias a) (deepDealias b) (fmap deepDealias c)\n\n\ndeepDealiasField :: FieldType -> FieldType\ndeepDealiasField (FieldType index tipe) =\n  FieldType index (deepDealias tipe)\n\n\n\n-- ITERATED DEALIAS\n\n\niteratedDealias :: Type -> Type\niteratedDealias tipe =\n  case tipe of\n    TAlias _ _ args realType ->\n      iteratedDealias (dealias args realType)\n\n    _ ->\n      tipe\n"
  },
  {
    "path": "compiler/src/Canonicalize/Effects.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Canonicalize.Effects\n  ( canonicalize\n  , checkPayload\n  )\n  where\n\nimport qualified Data.Foldable as F\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Source as Src\nimport qualified AST.Utils.Type as Type\nimport qualified Canonicalize.Environment as Env\nimport qualified Canonicalize.Type as Type\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Canonicalize as Error\nimport qualified Reporting.Result as Result\n\n\n\n-- RESULT\n\n\ntype Result i w a =\n  Result.Result i w Error.Error a\n\n\n\n-- CANONICALIZE\n\n\ncanonicalize\n  :: Env.Env\n  -> [A.Located Src.Value]\n  -> Map.Map Name.Name union\n  -> Src.Effects\n  -> Result i w Can.Effects\ncanonicalize env values unions effects =\n  case effects of\n    Src.NoEffects ->\n      Result.ok Can.NoEffects\n\n    Src.Ports ports ->\n      do  pairs <- traverse (canonicalizePort env) ports\n          return $ Can.Ports (Map.fromList pairs)\n\n    Src.Manager region manager ->\n      let dict = Map.fromList (map toNameRegion values) in\n      Can.Manager\n        <$> verifyManager region dict \"init\"\n        <*> verifyManager region dict \"onEffects\"\n        <*> verifyManager region dict \"onSelfMsg\"\n        <*>\n          case manager of\n            Src.Cmd cmdType ->\n              Can.Cmd\n                <$> verifyEffectType cmdType unions\n                <*  verifyManager region dict \"cmdMap\"\n\n            Src.Sub subType ->\n              Can.Sub\n                <$> verifyEffectType subType unions\n                <*  verifyManager region dict \"subMap\"\n\n            Src.Fx cmdType subType ->\n              Can.Fx\n                <$> verifyEffectType cmdType unions\n                <*> verifyEffectType subType unions\n                <*  verifyManager region dict \"cmdMap\"\n                <*  verifyManager region dict \"subMap\"\n\n\n\n-- CANONICALIZE PORT\n\n\ncanonicalizePort :: Env.Env -> Src.Port -> Result i w (Name.Name, Can.Port)\ncanonicalizePort env (Src.Port (A.At region portName) tipe) =\n  do  (Can.Forall freeVars ctipe) <- Type.toAnnotation env tipe\n      case reverse (Type.delambda (Type.deepDealias ctipe)) of\n        Can.TType home name [msg] : revArgs\n           | home == ModuleName.cmd && name == Name.cmd ->\n                case revArgs of\n                  [] ->\n                    Result.throw (Error.PortTypeInvalid region portName Error.CmdNoArg)\n\n                  [outgoingType] ->\n                    case msg of\n                      Can.TVar _ ->\n                        case checkPayload outgoingType of\n                          Right () ->\n                            Result.ok (portName, Can.Outgoing freeVars outgoingType ctipe)\n\n                          Left (badType, err) ->\n                            Result.throw (Error.PortPayloadInvalid region portName badType err)\n\n                      _ ->\n                        Result.throw (Error.PortTypeInvalid region portName Error.CmdBadMsg)\n\n                  _ ->\n                    Result.throw (Error.PortTypeInvalid region portName (Error.CmdExtraArgs (length revArgs)))\n\n            | home == ModuleName.sub && name == Name.sub ->\n                case revArgs of\n                  [Can.TLambda incomingType (Can.TVar msg1)] ->\n                    case msg of\n                      Can.TVar msg2 | msg1 == msg2 ->\n                        case checkPayload incomingType of\n                          Right () ->\n                            Result.ok (portName, Can.Incoming freeVars incomingType ctipe)\n\n                          Left (badType, err) ->\n                            Result.throw (Error.PortPayloadInvalid region portName badType err)\n\n                      _ ->\n                        Result.throw (Error.PortTypeInvalid region portName Error.SubBad)\n\n                  _ ->\n                    Result.throw (Error.PortTypeInvalid region portName Error.SubBad)\n\n        _ ->\n          Result.throw (Error.PortTypeInvalid region portName Error.NotCmdOrSub)\n\n\n\n-- VERIFY MANAGER\n\n\nverifyEffectType :: A.Located Name.Name -> Map.Map Name.Name a -> Result i w Name.Name\nverifyEffectType (A.At region name) unions =\n  if Map.member name unions then\n    Result.ok name\n  else\n    Result.throw (Error.EffectNotFound region name)\n\n\ntoNameRegion :: A.Located Src.Value -> (Name.Name, A.Region)\ntoNameRegion (A.At _ (Src.Value (A.At region name) _ _ _)) =\n  (name, region)\n\n\nverifyManager :: A.Region -> Map.Map Name.Name A.Region -> Name.Name -> Result i w A.Region\nverifyManager tagRegion values name =\n  case Map.lookup name values of\n    Just region ->\n      Result.ok region\n\n    Nothing ->\n      Result.throw (Error.EffectFunctionNotFound tagRegion name)\n\n\n\n-- CHECK PAYLOAD TYPES\n\n\ncheckPayload :: Can.Type -> Either (Can.Type, Error.InvalidPayload) ()\ncheckPayload tipe =\n  case tipe of\n    Can.TAlias _ _ args aliasedType ->\n      checkPayload (Type.dealias args aliasedType)\n\n    Can.TType home name args ->\n      case args of\n        []\n          | isJson home name -> Right ()\n          | isString home name -> Right ()\n          | isIntFloatBool home name -> Right ()\n\n        [arg]\n          | isList  home name -> checkPayload arg\n          | isMaybe home name -> checkPayload arg\n          | isArray home name -> checkPayload arg\n\n        _ ->\n          Left (tipe, Error.UnsupportedType name)\n\n    Can.TUnit ->\n        Right ()\n\n    Can.TTuple a b maybeC ->\n        do  checkPayload a\n            checkPayload b\n            case maybeC of\n              Nothing ->\n                Right ()\n\n              Just c ->\n                checkPayload c\n\n    Can.TVar name ->\n        Left (tipe, Error.TypeVariable name)\n\n    Can.TLambda _ _ ->\n        Left (tipe, Error.Function)\n\n    Can.TRecord _ (Just _) ->\n        Left (tipe, Error.ExtendedRecord)\n\n    Can.TRecord fields Nothing ->\n        F.traverse_ checkFieldPayload fields\n\n\ncheckFieldPayload :: Can.FieldType -> Either (Can.Type, Error.InvalidPayload) ()\ncheckFieldPayload (Can.FieldType _ tipe) =\n  checkPayload tipe\n\n\nisIntFloatBool :: ModuleName.Canonical -> Name.Name -> Bool\nisIntFloatBool home name =\n  home == ModuleName.basics\n  &&\n  (name == Name.int || name == Name.float || name == Name.bool)\n\n\nisString :: ModuleName.Canonical -> Name.Name -> Bool\nisString home name =\n  home == ModuleName.string\n  &&\n  name == Name.string\n\n\nisJson :: ModuleName.Canonical -> Name.Name -> Bool\nisJson home name =\n  home == ModuleName.jsonEncode\n  &&\n  name == Name.value\n\n\nisList :: ModuleName.Canonical -> Name.Name -> Bool\nisList home name =\n  home == ModuleName.list\n  &&\n  name == Name.list\n\n\nisMaybe :: ModuleName.Canonical -> Name.Name -> Bool\nisMaybe home name =\n  home == ModuleName.maybe\n  &&\n  name == Name.maybe\n\n\nisArray :: ModuleName.Canonical -> Name.Name -> Bool\nisArray home name =\n  home == ModuleName.array\n  &&\n  name == Name.array\n"
  },
  {
    "path": "compiler/src/Canonicalize/Environment/Dups.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Canonicalize.Environment.Dups\n  ( detect\n  , checkFields\n  , checkFields'\n  , Dict\n  , none\n  , one\n  , insert\n  , union\n  , unions\n  )\n  where\n\n\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\n\nimport qualified Data.OneOrMore as OneOrMore\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Canonicalize as Error\nimport qualified Reporting.Result as Result\n\n\n\n-- DUPLICATE TRACKER\n\n\ntype Dict value =\n  Map.Map Name.Name (OneOrMore.OneOrMore (Info value))\n\n\ndata Info value =\n  Info\n    { _region :: A.Region\n    , _value :: value\n    }\n\n\n\n-- DETECT\n\n\ntype ToError =\n  Name.Name -> A.Region -> A.Region -> Error.Error\n\n\ndetect :: ToError -> Dict a -> Result.Result i w Error.Error (Map.Map Name.Name a)\ndetect toError dict =\n  Map.traverseWithKey (detectHelp toError) dict\n\n\ndetectHelp :: ToError -> Name.Name -> OneOrMore.OneOrMore (Info a) -> Result.Result i w Error.Error a\ndetectHelp toError name values =\n  case values of\n    OneOrMore.One (Info _ value) ->\n      return value\n\n    OneOrMore.More left right ->\n      let\n        (Info r1 _, Info r2 _) =\n          OneOrMore.getFirstTwo left right\n      in\n      Result.throw (toError name r1 r2)\n\n\n\n-- CHECK FIELDS\n\n\ncheckFields :: [(A.Located Name.Name, a)] -> Result.Result i w Error.Error (Map.Map Name.Name a)\ncheckFields fields =\n  detect Error.DuplicateField (foldr addField none fields)\n\n\naddField :: (A.Located Name.Name, a) -> Dict a -> Dict a\naddField (A.At region name, value) dups =\n  Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dups\n\n\ncheckFields' :: (A.Region -> a -> b) -> [(A.Located Name.Name, a)] -> Result.Result i w Error.Error (Map.Map Name.Name b)\ncheckFields' toValue fields =\n  detect Error.DuplicateField (foldr (addField' toValue) none fields)\n\n\naddField' :: (A.Region -> a -> b) -> (A.Located Name.Name, a) -> Dict b -> Dict b\naddField' toValue (A.At region name, value) dups =\n  Map.insertWith OneOrMore.more name (OneOrMore.one (Info region (toValue region value))) dups\n\n\n\n-- BUILDING DICTIONARIES\n\n\nnone :: Dict a\nnone =\n  Map.empty\n\n\none :: Name.Name -> A.Region -> value -> Dict value\none name region value =\n  Map.singleton name (OneOrMore.one (Info region value))\n\n\ninsert :: Name.Name -> A.Region -> a -> Dict a -> Dict a\ninsert name region value dict =\n  Map.insertWith (\\new old -> OneOrMore.more old new) name (OneOrMore.one (Info region value)) dict\n\n\nunion :: Dict a -> Dict a -> Dict a\nunion a b =\n  Map.unionWith OneOrMore.more a b\n\n\nunions :: [Dict a] -> Dict a\nunions dicts =\n  Map.unionsWith OneOrMore.more dicts\n"
  },
  {
    "path": "compiler/src/Canonicalize/Environment/Foreign.hs",
    "content": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Canonicalize.Environment.Foreign\n  ( createInitialEnv\n  )\n  where\n\n\nimport Control.Monad (foldM)\nimport qualified Data.List as List\nimport qualified Data.Map.Strict as Map\nimport Data.Map.Strict ((!))\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Source as Src\nimport qualified Canonicalize.Environment as Env\nimport qualified Elm.Interface as I\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Canonicalize as Error\nimport qualified Reporting.Result as Result\n\n\n\n-- RESULT\n\n\ntype Result i w a =\n  Result.Result i w Error.Error a\n\n\ncreateInitialEnv :: ModuleName.Canonical -> Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Result i w Env.Env\ncreateInitialEnv home ifaces imports =\n  do  (State vs ts cs bs qvs qts qcs) <- foldM (addImport ifaces) emptyState (toSafeImports home imports)\n      Result.ok (Env.Env home (Map.map infoToVar vs) ts cs bs qvs qts qcs)\n\n\ninfoToVar :: Env.Info Can.Annotation -> Env.Var\ninfoToVar info =\n  case info of\n    Env.Specific home tipe -> Env.Foreign home tipe\n    Env.Ambiguous h hs     -> Env.Foreigns h hs\n\n\n\n-- STATE\n\n\ndata State =\n  State\n    { _vars :: Env.Exposed Can.Annotation\n    , _types :: Env.Exposed Env.Type\n    , _ctors :: Env.Exposed Env.Ctor\n    , _binops :: Env.Exposed Env.Binop\n    , _q_vars :: Env.Qualified Can.Annotation\n    , _q_types :: Env.Qualified Env.Type\n    , _q_ctors :: Env.Qualified Env.Ctor\n    }\n\n\nemptyState :: State\nemptyState =\n  State Map.empty emptyTypes Map.empty Map.empty Map.empty Map.empty Map.empty\n\n\nemptyTypes :: Env.Exposed Env.Type\nemptyTypes =\n  Map.singleton \"List\" (Env.Specific ModuleName.list (Env.Union 1 ModuleName.list))\n\n\n\n-- TO SAFE IMPORTS\n\n\ntoSafeImports :: ModuleName.Canonical -> [Src.Import] -> [Src.Import]\ntoSafeImports (ModuleName.Canonical pkg _) imports =\n  if Pkg.isKernel pkg\n  then filter isNormal imports\n  else imports\n\n\nisNormal :: Src.Import -> Bool\nisNormal (Src.Import (A.At _ name) maybeAlias _) =\n  if Name.isKernel name\n  then\n    case maybeAlias of\n      Nothing -> False\n      Just _ -> error \"kernel imports cannot use `as`\"\n  else\n    True\n\n\n\n-- ADD IMPORTS\n\n\naddImport :: Map.Map ModuleName.Raw I.Interface -> State -> Src.Import -> Result i w State\naddImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybeAlias exposing) =\n  let\n    (I.Interface pkg defs unions aliases binops) = ifaces ! name\n    !prefix = maybe name id maybeAlias\n    !home = ModuleName.Canonical pkg name\n\n    !rawTypeInfo =\n      Map.union\n        (Map.mapMaybeWithKey (unionToType home) unions)\n        (Map.mapMaybeWithKey (aliasToType home) aliases)\n\n    !vars = Map.map (Env.Specific home) defs\n    !types = Map.map (Env.Specific home . fst) rawTypeInfo\n    !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo\n\n    !qvs2 = addQualified prefix vars qvs\n    !qts2 = addQualified prefix types qts\n    !qcs2 = addQualified prefix ctors qcs\n  in\n  case exposing of\n    Src.Open ->\n      let\n        !vs2 = addExposed vs vars\n        !ts2 = addExposed ts types\n        !cs2 = addExposed cs ctors\n        !bs2 = addExposed bs (Map.mapWithKey (binopToBinop home) binops)\n      in\n      Result.ok (State vs2 ts2 cs2 bs2 qvs2 qts2 qcs2)\n\n    Src.Explicit exposedList ->\n      foldM\n        (addExposedValue home vars rawTypeInfo binops)\n        (State vs ts cs bs qvs2 qts2 qcs2)\n        exposedList\n\n\naddExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a\naddExposed =\n  Map.unionWith Env.mergeInfo\n\n\naddQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a\naddQualified prefix exposed qualified =\n  Map.insertWith addExposed prefix exposed qualified\n\n\n\n-- UNION\n\n\nunionToType :: ModuleName.Canonical -> Name.Name -> I.Union -> Maybe (Env.Type, Env.Exposed Env.Ctor)\nunionToType home name union =\n  unionToTypeHelp home name <$> I.toPublicUnion union\n\n\nunionToTypeHelp :: ModuleName.Canonical -> Name.Name -> Can.Union -> (Env.Type, Env.Exposed Env.Ctor)\nunionToTypeHelp home name union@(Can.Union vars ctors _ _) =\n  let\n    addCtor dict (Can.Ctor ctor index _ args) =\n      Map.insert ctor (Env.Specific home (Env.Ctor home name union index args)) dict\n  in\n  ( Env.Union (length vars) home\n  , List.foldl' addCtor Map.empty ctors\n  )\n\n\n\n-- ALIAS\n\n\naliasToType :: ModuleName.Canonical -> Name.Name -> I.Alias -> Maybe (Env.Type, Env.Exposed Env.Ctor)\naliasToType home name alias =\n  aliasToTypeHelp home name <$> I.toPublicAlias alias\n\n\naliasToTypeHelp :: ModuleName.Canonical -> Name.Name -> Can.Alias -> (Env.Type, Env.Exposed Env.Ctor)\naliasToTypeHelp home name (Can.Alias vars tipe) =\n  (\n    Env.Alias (length vars) home vars tipe\n  ,\n    case tipe of\n      Can.TRecord fields Nothing ->\n        let\n          avars = map (\\var -> (var, Can.TVar var)) vars\n          alias =\n            foldr\n              (\\(_,t1) t2 -> Can.TLambda t1 t2)\n              (Can.TAlias home name avars (Can.Filled tipe))\n              (Can.fieldsToList fields)\n        in\n        Map.singleton name (Env.Specific home (Env.RecordCtor home vars alias))\n\n      _ ->\n        Map.empty\n  )\n\n\n\n-- BINOP\n\n\nbinopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Env.Info Env.Binop\nbinopToBinop home op (I.Binop name annotation associativity precedence) =\n  Env.Specific home (Env.Binop op home name annotation associativity precedence)\n\n\n\n-- ADD EXPOSED VALUE\n\n\naddExposedValue\n  :: ModuleName.Canonical\n  -> Env.Exposed Can.Annotation\n  -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor)\n  -> Map.Map Name.Name I.Binop\n  -> State\n  -> Src.Exposed\n  -> Result i w State\naddExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =\n  case exposed of\n    Src.Lower (A.At region name) ->\n      case Map.lookup name vars of\n        Just info ->\n          Result.ok (State (Map.insertWith Env.mergeInfo name info vs) ts cs bs qvs qts qcs)\n\n        Nothing ->\n          Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))\n\n    Src.Upper (A.At region name) privacy ->\n      case privacy of\n        Src.Private ->\n          case Map.lookup name types of\n            Just (tipe, ctors) ->\n              case tipe of\n                Env.Union _ _ ->\n                  let\n                    !ts2 = Map.insert name (Env.Specific home tipe) ts\n                  in\n                  Result.ok (State vs ts2 cs bs qvs qts qcs)\n\n                Env.Alias _ _ _ _ ->\n                  let\n                    !ts2 = Map.insert name (Env.Specific home tipe) ts\n                    !cs2 = addExposed cs ctors\n                  in\n                  Result.ok (State vs ts2 cs2 bs qvs qts qcs)\n\n            Nothing ->\n              case checkForCtorMistake name types of\n                tipe:_ ->\n                  Result.throw $ Error.ImportCtorByName region name tipe\n\n                [] ->\n                  Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)\n\n        Src.Public dotDotRegion ->\n          case Map.lookup name types of\n            Just (tipe, ctors) ->\n              case tipe of\n                Env.Union _ _ ->\n                  let\n                    !ts2 = Map.insert name (Env.Specific home tipe) ts\n                    !cs2 = addExposed cs ctors\n                  in\n                  Result.ok (State vs ts2 cs2 bs qvs qts qcs)\n\n                Env.Alias _ _ _ _ ->\n                  Result.throw (Error.ImportOpenAlias dotDotRegion name)\n\n            Nothing ->\n              Result.throw (Error.ImportExposingNotFound region home name (Map.keys types))\n\n    Src.Operator region op ->\n      case Map.lookup op binops of\n        Just binop ->\n          let\n            !bs2 = Map.insert op (binopToBinop home op binop) bs\n          in\n          Result.ok (State vs ts cs bs2 qvs qts qcs)\n\n        Nothing ->\n          Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))\n\n\ncheckForCtorMistake :: Name.Name -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> [Name.Name]\ncheckForCtorMistake givenName types =\n    Map.foldr addMatches [] types\n  where\n    addMatches (_, exposedCtors) matches =\n      Map.foldrWithKey addMatch matches exposedCtors\n\n    addMatch ctorName info matches =\n      if ctorName /= givenName\n      then matches\n      else\n        case info of\n          Env.Specific _ (Env.Ctor _ tipeName _ _ _) ->\n            tipeName : matches\n\n          Env.Specific _ (Env.RecordCtor _ _ _) ->\n            matches\n\n          Env.Ambiguous _ _ ->\n            matches\n"
  },
  {
    "path": "compiler/src/Canonicalize/Environment/Local.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Canonicalize.Environment.Local\n  ( add\n  )\n  where\n\n\nimport Control.Monad (foldM)\nimport qualified Data.Graph as Graph\nimport qualified Data.List as List\nimport qualified Data.Map.Strict as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Source as Src\nimport qualified Canonicalize.Environment as Env\nimport qualified Canonicalize.Environment.Dups as Dups\nimport qualified Canonicalize.Type as Type\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Canonicalize as Error\nimport qualified Reporting.Result as Result\n\n\n\n-- RESULT\n\n\ntype Result i w a =\n  Result.Result i w Error.Error a\n\n\ntype Unions = Map.Map Name.Name Can.Union\ntype Aliases = Map.Map Name.Name Can.Alias\n\n\nadd :: Src.Module -> Env.Env -> Result i w (Env.Env, Unions, Aliases)\nadd module_ env =\n  addCtors module_ =<< addVars module_ =<< addTypes module_ env\n\n\n\n-- ADD VARS\n\n\naddVars :: Src.Module -> Env.Env -> Result i w Env.Env\naddVars module_ (Env.Env home vs ts cs bs qvs qts qcs) =\n  do  topLevelVars <- collectVars module_\n      let vs2 = Map.union topLevelVars vs\n      -- Use union to overwrite foreign stuff.\n      Result.ok $ Env.Env home vs2 ts cs bs qvs qts qcs\n\n\ncollectVars :: Src.Module -> Result i w (Map.Map Name.Name Env.Var)\ncollectVars (Src.Module _ _ _ _ values _ _ _ effects) =\n  let\n    addDecl dict (A.At _ (Src.Value (A.At region name) _ _ _)) =\n      Dups.insert name region (Env.TopLevel region) dict\n  in\n  Dups.detect Error.DuplicateDecl $\n    List.foldl' addDecl (toEffectDups effects) values\n\n\ntoEffectDups :: Src.Effects -> Dups.Dict Env.Var\ntoEffectDups effects =\n  case effects of\n    Src.NoEffects ->\n      Dups.none\n\n    Src.Ports ports ->\n      let\n        addPort dict (Src.Port (A.At region name) _) =\n          Dups.insert name region (Env.TopLevel region) dict\n      in\n      List.foldl' addPort Dups.none ports\n\n    Src.Manager _ manager ->\n      case manager of\n        Src.Cmd (A.At region _) ->\n          Dups.one \"command\" region (Env.TopLevel region)\n\n        Src.Sub (A.At region _) ->\n          Dups.one \"subscription\" region (Env.TopLevel region)\n\n        Src.Fx (A.At regionCmd _) (A.At regionSub _) ->\n          Dups.union\n            (Dups.one \"command\" regionCmd (Env.TopLevel regionCmd))\n            (Dups.one \"subscription\" regionSub (Env.TopLevel regionSub))\n\n\n\n-- ADD TYPES\n\n\naddTypes :: Src.Module -> Env.Env -> Result i w Env.Env\naddTypes (Src.Module _ _ _ _ _ unions aliases _ _) (Env.Env home vs ts cs bs qvs qts qcs) =\n  let\n    addAliasDups dups (A.At _ (Src.Alias (A.At region name) _ _)) = Dups.insert name region () dups\n    addUnionDups dups (A.At _ (Src.Union (A.At region name) _ _)) = Dups.insert name region () dups\n    typeNameDups =\n      List.foldl' addUnionDups (List.foldl' addAliasDups Dups.none aliases) unions\n  in\n  do  _ <- Dups.detect Error.DuplicateType typeNameDups\n      ts1 <- foldM (addUnion home) ts unions\n      addAliases aliases (Env.Env home vs ts1 cs bs qvs qts qcs)\n\n\naddUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> A.Located Src.Union -> Result i w (Env.Exposed Env.Type)\naddUnion home types union@(A.At _ (Src.Union (A.At _ name) _ _)) =\n  do  arity <- checkUnionFreeVars union\n      let one = Env.Specific home (Env.Union arity home)\n      Result.ok $ Map.insert name one types\n\n\n\n-- ADD TYPE ALIASES\n\n\naddAliases :: [A.Located Src.Alias] -> Env.Env -> Result i w Env.Env\naddAliases aliases env =\n  let\n    nodes = map toNode aliases\n    sccs = Graph.stronglyConnComp nodes\n  in\n  foldM addAlias env sccs\n\n\naddAlias :: Env.Env -> Graph.SCC (A.Located Src.Alias) -> Result i w Env.Env\naddAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =\n  case scc of\n    Graph.AcyclicSCC alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) ->\n      do  args <- checkAliasFreeVars alias\n          ctype <- Type.canonicalize env tipe\n          let one = Env.Specific home (Env.Alias (length args) home args ctype)\n          let ts1 = Map.insert name one ts\n          Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs\n\n    Graph.CyclicSCC [] ->\n      Result.ok env\n\n    Graph.CyclicSCC (alias@(A.At _ (Src.Alias (A.At region name1) _ tipe)) : others) ->\n      do  args <- checkAliasFreeVars alias\n          let toName (A.At _ (Src.Alias (A.At _ name) _ _)) = name\n          Result.throw (Error.RecursiveAlias region name1 args tipe (map toName others))\n\n\n\n-- DETECT TYPE ALIAS CYCLES\n\n\ntoNode :: A.Located Src.Alias -> (A.Located Src.Alias, Name.Name, [Name.Name])\ntoNode alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) =\n  ( alias, name, getEdges [] tipe )\n\n\ngetEdges :: [Name.Name] -> Src.Type -> [Name.Name]\ngetEdges edges (A.At _ tipe) =\n  case tipe of\n    Src.TLambda arg result ->\n      getEdges (getEdges edges arg) result\n\n    Src.TVar _ ->\n      edges\n\n    Src.TType _ name args ->\n      List.foldl' getEdges (name:edges) args\n\n    Src.TTypeQual _ _ _ args ->\n      List.foldl' getEdges edges args\n\n    Src.TRecord fields _ ->\n      List.foldl' (\\es (_,t) -> getEdges es t) edges fields\n\n    Src.TUnit ->\n      edges\n\n    Src.TTuple a b cs ->\n      List.foldl' getEdges (getEdges (getEdges edges a) b) cs\n\n\n\n-- CHECK FREE VARIABLES\n\n\ncheckUnionFreeVars :: A.Located Src.Union -> Result i w Int\ncheckUnionFreeVars (A.At unionRegion (Src.Union (A.At _ name) args ctors)) =\n  let\n    addArg (A.At region arg) dict =\n      Dups.insert arg region region dict\n\n    addCtorFreeVars (_, tipes) freeVars =\n      List.foldl' addFreeVars freeVars tipes\n  in\n  do  boundVars <- Dups.detect (Error.DuplicateUnionArg name) (foldr addArg Dups.none args)\n      let freeVars = foldr addCtorFreeVars Map.empty ctors\n      case Map.toList (Map.difference freeVars boundVars) of\n        [] ->\n          Result.ok (length args)\n\n        unbound:unbounds ->\n          Result.throw $\n            Error.TypeVarsUnboundInUnion unionRegion name (map A.toValue args) unbound unbounds\n\n\ncheckAliasFreeVars :: A.Located Src.Alias -> Result i w [Name.Name]\ncheckAliasFreeVars (A.At aliasRegion (Src.Alias (A.At _ name) args tipe)) =\n  let\n    addArg (A.At region arg) dict =\n      Dups.insert arg region region dict\n  in\n  do  boundVars <- Dups.detect (Error.DuplicateAliasArg name) (foldr addArg Dups.none args)\n      let freeVars = addFreeVars Map.empty tipe\n      let overlap = Map.size (Map.intersection boundVars freeVars)\n      if Map.size boundVars == overlap && Map.size freeVars == overlap\n        then Result.ok (map A.toValue args)\n        else\n          Result.throw $\n            Error.TypeVarsMessedUpInAlias aliasRegion name\n              (map A.toValue args)\n              (Map.toList (Map.difference boundVars freeVars))\n              (Map.toList (Map.difference freeVars boundVars))\n\n\naddFreeVars :: Map.Map Name.Name A.Region -> Src.Type -> Map.Map Name.Name A.Region\naddFreeVars freeVars (A.At region tipe) =\n  case tipe of\n    Src.TLambda arg result ->\n      addFreeVars (addFreeVars freeVars arg) result\n\n    Src.TVar name ->\n      Map.insert name region freeVars\n\n    Src.TType _ _ args ->\n      List.foldl' addFreeVars freeVars args\n\n    Src.TTypeQual _ _ _ args ->\n      List.foldl' addFreeVars freeVars args\n\n    Src.TRecord fields maybeExt ->\n      let\n        extFreeVars =\n          case maybeExt of\n            Nothing ->\n              freeVars\n\n            Just (A.At extRegion ext) ->\n              Map.insert ext extRegion freeVars\n      in\n      List.foldl' (\\fvs (_,t) -> addFreeVars fvs t) extFreeVars fields\n\n    Src.TUnit ->\n      freeVars\n\n    Src.TTuple a b cs ->\n      List.foldl' addFreeVars (addFreeVars (addFreeVars freeVars a) b) cs\n\n\n\n-- ADD CTORS\n\n\naddCtors :: Src.Module -> Env.Env -> Result i w (Env.Env, Unions, Aliases)\naddCtors (Src.Module _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts cs bs qvs qts qcs) =\n  do  unionInfo <- traverse (canonicalizeUnion env) unions\n      aliasInfo <- traverse (canonicalizeAlias env) aliases\n\n      ctors <-\n        Dups.detect Error.DuplicateCtor $\n          Dups.union\n            (Dups.unions (map snd unionInfo))\n            (Dups.unions (map snd aliasInfo))\n\n      let cs2 = Map.union ctors cs\n\n      Result.ok\n        ( Env.Env home vs ts cs2 bs qvs qts qcs\n        , Map.fromList (map fst unionInfo)\n        , Map.fromList (map fst aliasInfo)\n        )\n\n\ntype CtorDups = Dups.Dict (Env.Info Env.Ctor)\n\n\n\n-- CANONICALIZE ALIAS\n\n\ncanonicalizeAlias :: Env.Env -> A.Located Src.Alias -> Result i w ( (Name.Name, Can.Alias), CtorDups )\ncanonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Alias (A.At region name) args tipe)) =\n  do  let vars = map A.toValue args\n      ctipe <- Type.canonicalize env tipe\n      Result.ok\n        ( (name, Can.Alias vars ctipe)\n        ,\n          case ctipe of\n            Can.TRecord fields Nothing ->\n              Dups.one name region (Env.Specific home (toRecordCtor home name vars fields))\n\n            _ ->\n              Dups.none\n        )\n\ntoRecordCtor :: ModuleName.Canonical -> Name.Name -> [Name.Name] -> Map.Map Name.Name Can.FieldType -> Env.Ctor\ntoRecordCtor home name vars fields =\n  let\n    avars = map (\\var -> (var, Can.TVar var)) vars\n    alias =\n      foldr\n        (\\(_,t1) t2 -> Can.TLambda t1 t2)\n        (Can.TAlias home name avars (Can.Filled (Can.TRecord fields Nothing)))\n        (Can.fieldsToList fields)\n  in\n  Env.RecordCtor home vars alias\n\n\n\n-- CANONICALIZE UNION\n\n\ncanonicalizeUnion :: Env.Env -> A.Located Src.Union -> Result i w ( (Name.Name, Can.Union), CtorDups )\ncanonicalizeUnion env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Union (A.At _ name) avars ctors)) =\n  do  cctors <- Index.indexedTraverse (canonicalizeCtor env) ctors\n      let vars = map A.toValue avars\n      let alts = map A.toValue cctors\n      let union = Can.Union vars alts (length alts) (toOpts ctors)\n      Result.ok\n        ( (name, union)\n        , Dups.unions $ map (toCtor home name union) cctors\n        )\n\n\ncanonicalizeCtor :: Env.Env -> Index.ZeroBased -> (A.Located Name.Name, [Src.Type]) -> Result i w (A.Located Can.Ctor)\ncanonicalizeCtor env index (A.At region ctor, tipes) =\n  do  ctipes <- traverse (Type.canonicalize env) tipes\n      Result.ok $ A.At region $\n        Can.Ctor ctor index (length ctipes) ctipes\n\n\ntoOpts :: [(A.Located Name.Name, [Src.Type])] -> Can.CtorOpts\ntoOpts ctors =\n  case ctors of\n    [ (_,[_]) ] ->\n      Can.Unbox\n\n    _ ->\n      if all (null . snd) ctors then Can.Enum else Can.Normal\n\n\ntoCtor :: ModuleName.Canonical -> Name.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups\ntoCtor home typeName union (A.At region (Can.Ctor name index _ args)) =\n  Dups.one name region $ Env.Specific home $\n    Env.Ctor home typeName union index args\n"
  },
  {
    "path": "compiler/src/Canonicalize/Environment.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Canonicalize.Environment\n  ( Env(..)\n  , Exposed\n  , Qualified\n  , Info(..)\n  , mergeInfo\n  , Var(..)\n  , Type(..)\n  , Ctor(..)\n  , addLocals\n  , findType\n  , findTypeQual\n  , findCtor\n  , findCtorQual\n  , findBinop\n  , Binop(..)\n  )\n  where\n\n\nimport qualified Data.Map.Merge.Strict as Map\nimport qualified Data.Map.Strict as Map\nimport qualified Data.Name as Name\nimport qualified Data.OneOrMore as OneOrMore\n\nimport qualified AST.Utils.Binop as Binop\nimport qualified AST.Canonical as Can\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Canonicalize as Error\nimport qualified Reporting.Result as Result\n\n\n\n-- RESULT\n\n\ntype Result i w a =\n  Result.Result i w Error.Error a\n\n\n\n-- ENVIRONMENT\n\n\ndata Env =\n  Env\n    { _home :: ModuleName.Canonical\n    , _vars :: Map.Map Name.Name Var\n    , _types :: Exposed Type\n    , _ctors :: Exposed Ctor\n    , _binops :: Exposed Binop\n    , _q_vars :: Qualified Can.Annotation\n    , _q_types :: Qualified Type\n    , _q_ctors :: Qualified Ctor\n    }\n\n\ntype Exposed a =\n  Map.Map Name.Name (Info a)\n\n\ntype Qualified a =\n  Map.Map Name.Name (Map.Map Name.Name (Info a))\n\n\n\n-- INFO\n\n\ndata Info a\n  = Specific ModuleName.Canonical a\n  | Ambiguous ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)\n\n\nmergeInfo :: Info a -> Info a -> Info a\nmergeInfo info1 info2 =\n  case info1 of\n    Specific h1 _ ->\n      case info2 of\n        Specific h2 _    -> if h1 == h2 then info1 else Ambiguous h1 (OneOrMore.one h2)\n        Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more (OneOrMore.one h2) hs2)\n\n    Ambiguous h1 hs1 ->\n      case info2 of\n        Specific h2 _    -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.one h2))\n        Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.more (OneOrMore.one h2) hs2))\n\n\n\n-- VARIABLES\n\n\ndata Var\n  = Local A.Region\n  | TopLevel A.Region\n  | Foreign ModuleName.Canonical Can.Annotation\n  | Foreigns ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)\n\n\n\n-- TYPES\n\n\ndata Type\n  = Alias Int ModuleName.Canonical [Name.Name] Can.Type\n  | Union Int ModuleName.Canonical\n\n\n\n-- CTORS\n\n\ndata Ctor\n  = RecordCtor ModuleName.Canonical [Name.Name] Can.Type\n  | Ctor\n      { _c_home :: ModuleName.Canonical\n      , _c_type :: Name.Name\n      , _c_union :: Can.Union\n      , _c_index :: Index.ZeroBased\n      , _c_args :: [Can.Type]\n      }\n\n\n\n-- BINOPS\n\n\ndata Binop =\n  Binop\n    { _op :: Name.Name\n    , _op_home :: ModuleName.Canonical\n    , _op_name :: Name.Name\n    , _op_annotation :: Can.Annotation\n    , _op_associativity :: Binop.Associativity\n    , _op_precedence :: Binop.Precedence\n    }\n\n\n\n-- VARIABLE -- ADD LOCALS\n\n\naddLocals :: Map.Map Name.Name A.Region -> Env -> Result i w Env\naddLocals names (Env home vars ts cs bs qvs qts qcs) =\n  do  newVars <-\n        Map.mergeA\n          (Map.mapMissing addLocalLeft)\n          (Map.mapMissing (\\_ homes -> homes))\n          (Map.zipWithAMatched addLocalBoth)\n          names\n          vars\n\n      Result.ok (Env home newVars ts cs bs qvs qts qcs)\n\n\naddLocalLeft :: Name.Name -> A.Region -> Var\naddLocalLeft _ region =\n  Local region\n\n\naddLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var\naddLocalBoth name region var =\n  case var of\n    Foreign _ _ ->\n      Result.ok (Local region)\n\n    Foreigns _ _ ->\n      Result.ok (Local region)\n\n    Local parentRegion ->\n      Result.throw (Error.Shadowing name parentRegion region)\n\n    TopLevel parentRegion ->\n      Result.throw (Error.Shadowing name parentRegion region)\n\n\n\n\n-- FIND TYPE\n\n\nfindType :: A.Region -> Env -> Name.Name -> Result i w Type\nfindType region (Env _ _ ts _ _ _ qts _) name =\n  case Map.lookup name ts of\n    Just (Specific _ tipe) ->\n      Result.ok tipe\n\n    Just (Ambiguous h hs) ->\n      Result.throw (Error.AmbiguousType region Nothing name h hs)\n\n    Nothing ->\n      Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))\n\n\nfindTypeQual :: A.Region -> Env -> Name.Name -> Name.Name -> Result i w Type\nfindTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =\n  case Map.lookup prefix qts of\n    Just qualified ->\n      case Map.lookup name qualified of\n        Just (Specific _ tipe) ->\n          Result.ok tipe\n\n        Just (Ambiguous h hs) ->\n          Result.throw (Error.AmbiguousType region (Just prefix) name h hs)\n\n        Nothing ->\n          Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))\n\n    Nothing ->\n      Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))\n\n\n\n-- FIND CTOR\n\n\nfindCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor\nfindCtor region (Env _ _ _ cs _ _ _ qcs) name =\n  case Map.lookup name cs of\n    Just (Specific _ ctor) ->\n      Result.ok ctor\n\n    Just (Ambiguous h hs) ->\n      Result.throw (Error.AmbiguousVariant region Nothing name h hs)\n\n    Nothing ->\n      Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))\n\n\nfindCtorQual :: A.Region -> Env -> Name.Name -> Name.Name -> Result i w Ctor\nfindCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =\n  case Map.lookup prefix qcs of\n    Just qualified ->\n      case Map.lookup name qualified of\n        Just (Specific _ pattern) ->\n          Result.ok pattern\n\n        Just (Ambiguous h hs) ->\n          Result.throw (Error.AmbiguousVariant region (Just prefix) name h hs)\n\n        Nothing ->\n          Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))\n\n    Nothing ->\n      Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))\n\n\n\n-- FIND BINOP\n\n\nfindBinop :: A.Region -> Env -> Name.Name -> Result i w Binop\nfindBinop region (Env _ _ _ _ binops _ _ _) name =\n  case Map.lookup name binops of\n    Just (Specific _ binop) ->\n      Result.ok binop\n\n    Just (Ambiguous h hs) ->\n      Result.throw (Error.AmbiguousBinop region name h hs)\n\n    Nothing ->\n      Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))\n\n\n\n-- TO POSSIBLE NAMES\n\n\ntoPossibleNames :: Exposed a -> Qualified a -> Error.PossibleNames\ntoPossibleNames exposed qualified =\n  Error.PossibleNames (Map.keysSet exposed) (Map.map Map.keysSet qualified)\n"
  },
  {
    "path": "compiler/src/Canonicalize/Expression.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-x-partial #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Canonicalize.Expression\n  ( canonicalize\n  , FreeLocals\n  , Uses(..)\n  , verifyBindings\n  , gatherTypedArgs\n  )\n  where\n\n\nimport Control.Monad (foldM)\nimport qualified Data.Graph as Graph\nimport qualified Data.List as List\nimport qualified Data.Map.Strict as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Source as Src\nimport qualified AST.Utils.Binop as Binop\nimport qualified AST.Utils.Type as Type\nimport qualified Canonicalize.Environment as Env\nimport qualified Canonicalize.Environment.Dups as Dups\nimport qualified Canonicalize.Pattern as Pattern\nimport qualified Canonicalize.Type as Type\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Canonicalize as Error\nimport qualified Reporting.Result as Result\nimport qualified Reporting.Warning as W\n\n\n\n-- RESULTS\n\n\ntype Result i w a =\n  Result.Result i w Error.Error a\n\n\ntype FreeLocals =\n  Map.Map Name.Name Uses\n\n\ndata Uses =\n  Uses\n    { _direct :: {-# UNPACK #-} !Int\n    , _delayed :: {-# UNPACK #-} !Int\n    }\n\n\n\n-- CANONICALIZE\n\n\ncanonicalize :: Env.Env -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr\ncanonicalize env (A.At region expression) =\n  A.At region <$>\n  case expression of\n    Src.Str string ->\n      Result.ok (Can.Str string)\n\n    Src.Chr char ->\n      Result.ok (Can.Chr char)\n\n    Src.Int int ->\n      Result.ok (Can.Int int)\n\n    Src.Float float ->\n      Result.ok (Can.Float float)\n\n    Src.Var varType name ->\n      case varType of\n        Src.LowVar -> findVar region env name\n        Src.CapVar -> toVarCtor name <$> Env.findCtor region env name\n\n    Src.VarQual varType prefix name ->\n      case varType of\n        Src.LowVar -> findVarQual region env prefix name\n        Src.CapVar -> toVarCtor name <$> Env.findCtorQual region env prefix name\n\n    Src.List exprs ->\n      Can.List <$> traverse (canonicalize env) exprs\n\n    Src.Op op ->\n      do  (Env.Binop _ home name annotation _ _) <- Env.findBinop region env op\n          return (Can.VarOperator op home name annotation)\n\n    Src.Negate expr ->\n      Can.Negate <$> canonicalize env expr\n\n    Src.Binops ops final ->\n      A.toValue <$> canonicalizeBinops region env ops final\n\n    Src.Lambda srcArgs body ->\n      delayedUsage $\n      do  (args, bindings) <-\n            Pattern.verify Error.DPLambdaArgs $\n              traverse (Pattern.canonicalize env) srcArgs\n\n          newEnv <-\n            Env.addLocals bindings env\n\n          (cbody, freeLocals) <-\n            verifyBindings W.Pattern bindings (canonicalize newEnv body)\n\n          return (Can.Lambda args cbody, freeLocals)\n\n    Src.Call func args ->\n      Can.Call\n        <$> canonicalize env func\n        <*> traverse (canonicalize env) args\n\n    Src.If branches finally ->\n      Can.If\n        <$> traverse (canonicalizeIfBranch env) branches\n        <*> canonicalize env finally\n\n    Src.Let defs expr ->\n      A.toValue <$> canonicalizeLet region env defs expr\n\n    Src.Case expr branches ->\n      Can.Case\n        <$> canonicalize env expr\n        <*> traverse (canonicalizeCaseBranch env) branches\n\n    Src.Accessor field ->\n      Result.ok $ Can.Accessor field\n\n    Src.Access record field ->\n      Can.Access\n        <$> canonicalize env record\n        <*> Result.ok field\n\n    Src.Update (A.At reg name) fields ->\n      let\n        makeCanFields =\n          Dups.checkFields' (\\r t -> Can.FieldUpdate r <$> canonicalize env t) fields\n      in\n      Can.Update name\n        <$> (A.At reg <$> findVar reg env name)\n        <*> (sequenceA =<< makeCanFields)\n\n    Src.Record fields ->\n      do  fieldDict <- Dups.checkFields fields\n          Can.Record <$> traverse (canonicalize env) fieldDict\n\n    Src.Unit ->\n      Result.ok Can.Unit\n\n    Src.Tuple a b cs ->\n      Can.Tuple\n        <$> canonicalize env a\n        <*> canonicalize env b\n        <*> canonicalizeTupleExtras region env cs\n\n    Src.Shader src tipe ->\n        Result.ok (Can.Shader src tipe)\n\n\n\n-- CANONICALIZE TUPLE EXTRAS\n\n\ncanonicalizeTupleExtras :: A.Region -> Env.Env -> [Src.Expr] -> Result FreeLocals [W.Warning] (Maybe Can.Expr)\ncanonicalizeTupleExtras region env extras =\n  case extras of\n    [] ->\n      Result.ok Nothing\n\n    [three] ->\n      Just <$> canonicalize env three\n\n    _ ->\n      Result.throw (Error.TupleLargerThanThree region)\n\n\n\n-- CANONICALIZE IF BRANCH\n\n\ncanonicalizeIfBranch :: Env.Env -> (Src.Expr, Src.Expr) -> Result FreeLocals [W.Warning] (Can.Expr, Can.Expr)\ncanonicalizeIfBranch env (condition, branch) =\n  (,)\n    <$> canonicalize env condition\n    <*> canonicalize env branch\n\n\n\n-- CANONICALIZE CASE BRANCH\n\n\ncanonicalizeCaseBranch :: Env.Env -> (Src.Pattern, Src.Expr) -> Result FreeLocals [W.Warning] Can.CaseBranch\ncanonicalizeCaseBranch env (pattern, expr) =\n  directUsage $\n  do  (cpattern, bindings) <-\n        Pattern.verify Error.DPCaseBranch $\n          Pattern.canonicalize env pattern\n      newEnv <- Env.addLocals bindings env\n\n      (cexpr, freeLocals) <-\n        verifyBindings W.Pattern bindings (canonicalize newEnv expr)\n\n      return (Can.CaseBranch cpattern cexpr, freeLocals)\n\n\n\n-- CANONICALIZE BINOPS\n\n\ncanonicalizeBinops :: A.Region -> Env.Env -> [(Src.Expr, A.Located Name.Name)] -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr\ncanonicalizeBinops overallRegion env ops final =\n  let\n    canonicalizeHelp (expr, A.At region op) =\n      (,)\n        <$> canonicalize env expr\n        <*> Env.findBinop region env op\n  in\n  runBinopStepper overallRegion =<< (\n    More\n      <$> traverse canonicalizeHelp ops\n      <*> canonicalize env final\n  )\n\n\ndata Step\n  = Done Can.Expr\n  | More [(Can.Expr, Env.Binop)] Can.Expr\n  | Error Env.Binop Env.Binop\n\n\nrunBinopStepper :: A.Region -> Step -> Result FreeLocals w Can.Expr\nrunBinopStepper overallRegion step =\n  case step of\n    Done expr ->\n      Result.ok expr\n\n    More [] expr ->\n      Result.ok expr\n\n    More ( (expr, op) : rest ) final ->\n      runBinopStepper overallRegion $\n        toBinopStep (toBinop op expr) op rest final\n\n    Error (Env.Binop op1 _ _ _ _ _) (Env.Binop op2 _ _ _ _ _) ->\n      Result.throw (Error.Binop overallRegion op1 op2)\n\n\ntoBinopStep :: (Can.Expr -> Can.Expr) -> Env.Binop -> [(Can.Expr, Env.Binop)] -> Can.Expr -> Step\ntoBinopStep makeBinop rootOp@(Env.Binop _ _ _ _ rootAssociativity rootPrecedence) middle final =\n  case middle of\n    [] ->\n      Done (makeBinop final)\n\n    ( expr, op@(Env.Binop _ _ _ _ associativity precedence) ) : rest ->\n      if precedence < rootPrecedence then\n\n        More ((makeBinop expr, op) : rest) final\n\n      else if precedence > rootPrecedence then\n\n        case toBinopStep (toBinop op expr) op rest final of\n          Done newLast ->\n            Done (makeBinop newLast)\n\n          More newMiddle newLast ->\n            toBinopStep makeBinop rootOp newMiddle newLast\n\n          Error a b ->\n            Error a b\n\n      else\n\n        case (rootAssociativity, associativity) of\n          (Binop.Left, Binop.Left) ->\n            toBinopStep (\\right -> toBinop op (makeBinop expr) right) op rest final\n\n          (Binop.Right, Binop.Right) ->\n            toBinopStep (\\right -> makeBinop (toBinop op expr right)) op rest final\n\n          (_, _) ->\n            Error rootOp op\n\n\ntoBinop :: Env.Binop -> Can.Expr -> Can.Expr -> Can.Expr\ntoBinop (Env.Binop op home name annotation _ _) left right =\n  A.merge left right (Can.Binop op home name annotation left right)\n\n\n\n-- CANONICALIZE LET\n\n\ncanonicalizeLet :: A.Region -> Env.Env -> [A.Located Src.Def] -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr\ncanonicalizeLet letRegion env defs body =\n  directUsage $\n    do  bindings <-\n          Dups.detect (Error.DuplicatePattern Error.DPLetBinding) $\n            List.foldl' addBindings Dups.none defs\n\n        newEnv <- Env.addLocals bindings env\n\n        verifyBindings W.Def bindings $\n          do  nodes <- foldM (addDefNodes newEnv) [] defs\n              cbody <- canonicalize newEnv body\n              detectCycles letRegion (Graph.stronglyConnComp nodes) cbody\n\n\n\n-- ADD BINDINGS\n\n\naddBindings :: Dups.Dict A.Region -> A.Located Src.Def -> Dups.Dict A.Region\naddBindings bindings (A.At _ def) =\n  case def of\n    Src.Define (A.At region name) _ _ _ ->\n      Dups.insert name region region bindings\n\n    Src.Destruct pattern _ ->\n      addBindingsHelp bindings pattern\n\n\naddBindingsHelp :: Dups.Dict A.Region -> Src.Pattern -> Dups.Dict A.Region\naddBindingsHelp bindings (A.At region pattern) =\n  case pattern of\n    Src.PAnything ->\n      bindings\n\n    Src.PVar name ->\n      Dups.insert name region region bindings\n\n    Src.PRecord fields ->\n      let\n        addField dict (A.At fieldRegion name) =\n          Dups.insert name fieldRegion fieldRegion dict\n      in\n      List.foldl' addField bindings fields\n\n    Src.PUnit ->\n      bindings\n\n    Src.PTuple a b cs ->\n      List.foldl' addBindingsHelp bindings (a:b:cs)\n\n    Src.PCtor _ _ patterns ->\n      List.foldl' addBindingsHelp bindings patterns\n\n    Src.PCtorQual _ _ _ patterns ->\n      List.foldl' addBindingsHelp bindings patterns\n\n    Src.PList patterns ->\n      List.foldl' addBindingsHelp bindings patterns\n\n    Src.PCons hd tl ->\n      addBindingsHelp (addBindingsHelp bindings hd) tl\n\n    Src.PAlias aliasPattern (A.At nameRegion name) ->\n      Dups.insert name nameRegion nameRegion $\n        addBindingsHelp bindings aliasPattern\n\n    Src.PChr _ ->\n      bindings\n\n    Src.PStr _ ->\n      bindings\n\n    Src.PInt _ ->\n      bindings\n\n\n\n-- BUILD BINDINGS GRAPH\n\n\ntype Node =\n  (Binding, Name.Name, [Name.Name])\n\n\ndata Binding\n  = Define Can.Def\n  | Edge (A.Located Name.Name)\n  | Destruct Can.Pattern Can.Expr\n\n\naddDefNodes :: Env.Env -> [Node] -> A.Located Src.Def -> Result FreeLocals [W.Warning] [Node]\naddDefNodes env nodes (A.At _ def) =\n  case def of\n    Src.Define aname@(A.At _ name) srcArgs body maybeType ->\n      case maybeType of\n        Nothing ->\n          do  (args, argBindings) <-\n                Pattern.verify (Error.DPFuncArgs name) $\n                  traverse (Pattern.canonicalize env) srcArgs\n\n              newEnv <-\n                Env.addLocals argBindings env\n\n              (cbody, freeLocals) <-\n                verifyBindings W.Pattern argBindings (canonicalize newEnv body)\n\n              let cdef = Can.Def aname args cbody\n              let node = ( Define cdef, name, Map.keys freeLocals )\n              logLetLocals args freeLocals (node:nodes)\n\n        Just tipe ->\n          do  (Can.Forall freeVars ctipe) <- Type.toAnnotation env tipe\n              ((args, resultType), argBindings) <-\n                Pattern.verify (Error.DPFuncArgs name) $\n                  gatherTypedArgs env name srcArgs ctipe Index.first []\n\n              newEnv <-\n                Env.addLocals argBindings env\n\n              (cbody, freeLocals) <-\n                verifyBindings W.Pattern argBindings (canonicalize newEnv body)\n\n              let cdef = Can.TypedDef aname freeVars args cbody resultType\n              let node = ( Define cdef, name, Map.keys freeLocals )\n              logLetLocals args freeLocals (node:nodes)\n\n    Src.Destruct pattern body ->\n      do  (cpattern, _bindings) <-\n            Pattern.verify Error.DPDestruct $\n              Pattern.canonicalize env pattern\n\n          Result.Result $ \\fs ws bad good ->\n            case canonicalize env body of\n              Result.Result k ->\n                k Map.empty ws\n                  (\\freeLocals warnings errors ->\n                      bad (Map.unionWith combineUses freeLocals fs) warnings errors\n                  )\n                  (\\freeLocals warnings cbody ->\n                      let\n                        names = getPatternNames [] pattern\n                        name = Name.fromManyNames (map A.toValue names)\n                        node = ( Destruct cpattern cbody, name, Map.keys freeLocals )\n                      in\n                      good\n                        (Map.unionWith combineUses fs freeLocals)\n                        warnings\n                        (List.foldl' (addEdge [name]) (node:nodes) names)\n                  )\n\n\nlogLetLocals :: [arg] -> FreeLocals -> value -> Result FreeLocals w value\nlogLetLocals args letLocals value =\n  Result.Result $ \\freeLocals warnings _ good ->\n    good\n      ( Map.unionWith combineUses freeLocals $\n          case args of\n            [] -> letLocals\n            _ -> Map.map delayUse letLocals\n      )\n      warnings\n      value\n\n\naddEdge :: [Name.Name] -> [Node] -> A.Located Name.Name -> [Node]\naddEdge edges nodes aname@(A.At _ name) =\n  (Edge aname, name, edges) : nodes\n\n\ngetPatternNames :: [A.Located Name.Name] -> Src.Pattern ->  [A.Located Name.Name]\ngetPatternNames names (A.At region pattern) =\n  case pattern of\n    Src.PAnything            -> names\n    Src.PVar name            -> A.At region name : names\n    Src.PRecord fields       -> fields ++ names\n    Src.PAlias ptrn name     -> getPatternNames (name : names) ptrn\n    Src.PUnit                -> names\n    Src.PTuple a b cs        -> List.foldl' getPatternNames (getPatternNames (getPatternNames names a) b) cs\n    Src.PCtor _ _ args       -> List.foldl' getPatternNames names args\n    Src.PCtorQual _ _ _ args -> List.foldl' getPatternNames names args\n    Src.PList patterns       -> List.foldl' getPatternNames names patterns\n    Src.PCons hd tl          -> getPatternNames (getPatternNames names hd) tl\n    Src.PChr _               -> names\n    Src.PStr _               -> names\n    Src.PInt _               -> names\n\n\n\n-- GATHER TYPED ARGS\n\n\ngatherTypedArgs\n  :: Env.Env\n  -> Name.Name\n  -> [Src.Pattern]\n  -> Can.Type\n  -> Index.ZeroBased\n  -> [(Can.Pattern, Can.Type)]\n  -> Result Pattern.DupsDict w ([(Can.Pattern, Can.Type)], Can.Type)\ngatherTypedArgs env name srcArgs tipe index revTypedArgs =\n  case srcArgs of\n    [] ->\n      return (reverse revTypedArgs, tipe)\n\n    srcArg : otherSrcArgs ->\n      case Type.iteratedDealias tipe of\n        Can.TLambda argType resultType ->\n          do  arg <- Pattern.canonicalize env srcArg\n              gatherTypedArgs env name otherSrcArgs resultType (Index.next index) $\n                (arg, argType) : revTypedArgs\n\n        _ ->\n          let (A.At start _, A.At end _) = (head srcArgs, last srcArgs) in\n          Result.throw $\n            Error.AnnotationTooShort (A.mergeRegions start end) name index (length srcArgs)\n\n\n\n-- DETECT CYCLES\n\n\ndetectCycles :: A.Region -> [Graph.SCC Binding] -> Can.Expr -> Result i w Can.Expr\ndetectCycles letRegion sccs body =\n  case sccs of\n    [] ->\n      Result.ok body\n\n    scc : subSccs ->\n      case scc of\n        Graph.AcyclicSCC binding ->\n          case binding of\n            Define def ->\n              A.At letRegion . Can.Let def <$> detectCycles letRegion subSccs body\n\n            Edge _ ->\n              detectCycles letRegion subSccs body\n\n            Destruct pattern expr ->\n              A.At letRegion . Can.LetDestruct pattern expr <$> detectCycles letRegion subSccs body\n\n        Graph.CyclicSCC bindings ->\n          A.At letRegion <$>\n            (Can.LetRec\n              <$> checkCycle bindings []\n              <*> detectCycles letRegion subSccs body\n            )\n\n\ncheckCycle :: [Binding] -> [Can.Def] -> Result i w [Can.Def]\ncheckCycle bindings defs =\n  case bindings of\n    [] ->\n      Result.ok defs\n\n    binding : otherBindings ->\n      case binding of\n        Define def@(Can.Def name args _) ->\n          if null args then\n            Result.throw (Error.RecursiveLet name (toNames otherBindings defs))\n          else\n            checkCycle otherBindings (def:defs)\n\n        Define def@(Can.TypedDef name _ args _ _) ->\n          if null args then\n            Result.throw (Error.RecursiveLet name (toNames otherBindings defs))\n          else\n            checkCycle otherBindings (def:defs)\n\n        Edge name ->\n          Result.throw (Error.RecursiveLet name (toNames otherBindings defs))\n\n        Destruct _ _ ->\n          -- a Destruct cannot appear in a cycle without any Edge values\n          -- so we just keep going until we get to the edges\n          checkCycle otherBindings defs\n\n\ntoNames :: [Binding] -> [Can.Def] -> [Name.Name]\ntoNames bindings revDefs =\n  case bindings of\n    [] ->\n      reverse (map getDefName revDefs)\n\n    binding : otherBindings ->\n      case binding of\n        Define def         -> getDefName def : toNames otherBindings revDefs\n        Edge (A.At _ name) -> name : toNames otherBindings revDefs\n        Destruct _ _       -> toNames otherBindings revDefs\n\n\ngetDefName :: Can.Def -> Name.Name\ngetDefName def =\n  case def of\n    Can.Def (A.At _ name) _ _ ->\n      name\n\n    Can.TypedDef (A.At _ name) _ _ _ _ ->\n      name\n\n\n\n-- LOG VARIABLE USES\n\n\nlogVar :: Name.Name -> a -> Result FreeLocals w a\nlogVar name value =\n  Result.Result $ \\freeLocals warnings _ good ->\n    good (Map.insertWith combineUses name oneDirectUse freeLocals) warnings value\n\n\n{-# NOINLINE oneDirectUse #-}\noneDirectUse :: Uses\noneDirectUse =\n  Uses 1 0\n\n\ncombineUses :: Uses -> Uses -> Uses\ncombineUses (Uses a b) (Uses x y) =\n  Uses (a + x) (b + y)\n\n\ndelayUse :: Uses -> Uses\ndelayUse (Uses direct delayed) =\n  Uses 0 (direct + delayed)\n\n\n\n-- MANAGING BINDINGS\n\n\nverifyBindings\n  :: W.Context\n  -> Pattern.Bindings\n  -> Result FreeLocals [W.Warning] value\n  -> Result info [W.Warning] (value, FreeLocals)\nverifyBindings context bindings (Result.Result k) =\n  Result.Result $ \\info warnings bad good ->\n    k Map.empty warnings\n      (\\_ warnings1 err ->\n          bad info warnings1 err\n      )\n      (\\freeLocals warnings1 value ->\n          let\n            outerFreeLocals =\n              Map.difference freeLocals bindings\n\n            warnings2 =\n              -- NOTE: Uses Map.size for O(1) lookup. This means there is\n              -- no dictionary allocation unless a problem is detected.\n              if Map.size bindings + Map.size outerFreeLocals == Map.size freeLocals then\n                warnings1\n              else\n                Map.foldlWithKey (addUnusedWarning context) warnings1 $\n                  Map.difference bindings freeLocals\n          in\n          good info warnings2 (value, outerFreeLocals)\n      )\n\n\naddUnusedWarning :: W.Context -> [W.Warning] -> Name.Name -> A.Region -> [W.Warning]\naddUnusedWarning context warnings name region =\n  W.UnusedVariable region context name : warnings\n\n\ndirectUsage :: Result () w (expr, FreeLocals) -> Result FreeLocals w expr\ndirectUsage (Result.Result k) =\n  Result.Result $ \\freeLocals warnings bad good ->\n    k () warnings\n      (\\() ws es -> bad freeLocals ws es)\n      (\\() ws (value, newFreeLocals) ->\n          good (Map.unionWith combineUses freeLocals newFreeLocals) ws value\n      )\n\n\ndelayedUsage :: Result () w (expr, FreeLocals) -> Result FreeLocals w expr\ndelayedUsage (Result.Result k) =\n  Result.Result $ \\freeLocals warnings bad good ->\n    k () warnings\n      (\\() ws es -> bad freeLocals ws es)\n      (\\() ws (value, newFreeLocals) ->\n          let delayedLocals = Map.map delayUse newFreeLocals in\n          good (Map.unionWith combineUses freeLocals delayedLocals) ws value\n      )\n\n\n\n-- FIND VARIABLE\n\n\nfindVar :: A.Region -> Env.Env -> Name.Name -> Result FreeLocals w Can.Expr_\nfindVar region (Env.Env localHome vs _ _ _ qvs _ _) name =\n  case Map.lookup name vs of\n    Just var ->\n      case var of\n        Env.Local _ ->\n          logVar name (Can.VarLocal name)\n\n        Env.TopLevel _ ->\n          logVar name (Can.VarTopLevel localHome name)\n\n        Env.Foreign home annotation ->\n          Result.ok $\n            if home == ModuleName.debug then\n              Can.VarDebug localHome name annotation\n            else\n              Can.VarForeign home name annotation\n\n        Env.Foreigns h hs ->\n          Result.throw (Error.AmbiguousVar region Nothing name h hs)\n\n    Nothing ->\n      Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))\n\n\nfindVarQual :: A.Region -> Env.Env -> Name.Name -> Name.Name -> Result FreeLocals w Can.Expr_\nfindVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =\n  case Map.lookup prefix qvs of\n    Just qualified ->\n      case Map.lookup name qualified of\n        Just (Env.Specific home annotation) ->\n          Result.ok $\n            if home == ModuleName.debug then\n              Can.VarDebug localHome name annotation\n            else\n              Can.VarForeign home name annotation\n\n        Just (Env.Ambiguous h hs) ->\n          Result.throw (Error.AmbiguousVar region (Just prefix) name h hs)\n\n        Nothing ->\n          Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))\n\n    Nothing ->\n      if Name.isKernel prefix && Pkg.isKernel (ModuleName._package localHome) then\n        Result.ok $ Can.VarKernel (Name.getKernel prefix) name\n      else\n        Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))\n\n\ntoPossibleNames :: Map.Map Name.Name Env.Var -> Env.Qualified Can.Annotation -> Error.PossibleNames\ntoPossibleNames exposed qualified =\n  Error.PossibleNames (Map.keysSet exposed) (Map.map Map.keysSet qualified)\n\n\n\n-- FIND CTOR\n\n\ntoVarCtor :: Name.Name -> Env.Ctor -> Can.Expr_\ntoVarCtor name ctor =\n  case ctor of\n    Env.Ctor home typeName (Can.Union vars _ _ opts) index args ->\n      let\n        freeVars = Map.fromList (map (\\v -> (v, ())) vars)\n        result = Can.TType home typeName (map Can.TVar vars)\n        tipe = foldr Can.TLambda result args\n      in\n      Can.VarCtor opts home name index (Can.Forall freeVars tipe)\n\n    Env.RecordCtor home vars tipe ->\n      let\n        freeVars = Map.fromList (map (\\v -> (v, ())) vars)\n      in\n      Can.VarCtor Can.Normal home name Index.first (Can.Forall freeVars tipe)\n"
  },
  {
    "path": "compiler/src/Canonicalize/Module.hs",
    "content": "module Canonicalize.Module\n  ( canonicalize\n  )\n  where\n\n\nimport qualified Data.Graph as Graph\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Source as Src\nimport qualified Canonicalize.Effects as Effects\nimport qualified Canonicalize.Environment as Env\nimport qualified Canonicalize.Environment.Dups as Dups\nimport qualified Canonicalize.Environment.Foreign as Foreign\nimport qualified Canonicalize.Environment.Local as Local\nimport qualified Canonicalize.Expression as Expr\nimport qualified Canonicalize.Pattern as Pattern\nimport qualified Canonicalize.Type as Type\nimport qualified Data.Index as Index\nimport qualified Elm.Interface as I\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Canonicalize as Error\nimport qualified Reporting.Result as Result\nimport qualified Reporting.Warning as W\n\n\n\n-- RESULT\n\n\ntype Result i w a =\n  Result.Result i w Error.Error a\n\n\n\n-- MODULES\n\n\ncanonicalize :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Result i [W.Warning] Can.Module\ncanonicalize pkg ifaces modul@(Src.Module _ exports docs imports values _ _ binops effects) =\n  do  let home = ModuleName.Canonical pkg (Src.getName modul)\n      let cbinops = Map.fromList (map canonicalizeBinop binops)\n\n      (env, cunions, caliases) <-\n        Local.add modul =<<\n          Foreign.createInitialEnv home ifaces imports\n\n      cvalues <- canonicalizeValues env values\n      ceffects <- Effects.canonicalize env values cunions effects\n      cexports <- canonicalizeExports values cunions caliases cbinops ceffects exports\n\n      return $ Can.Module home cexports docs cvalues cunions caliases cbinops ceffects\n\n\n\n-- CANONICALIZE BINOP\n\n\ncanonicalizeBinop :: A.Located Src.Infix -> ( Name.Name, Can.Binop )\ncanonicalizeBinop (A.At _ (Src.Infix op associativity precedence func)) =\n  ( op, Can.Binop_ associativity precedence func )\n\n\n\n-- DECLARATIONS / CYCLE DETECTION\n--\n-- There are two phases of cycle detection:\n--\n-- 1. Detect cycles using ALL dependencies => needed for type inference\n-- 2. Detect cycles using DIRECT dependencies => nonterminating recursion\n--\n\n\ncanonicalizeValues :: Env.Env -> [A.Located Src.Value] -> Result i [W.Warning] Can.Decls\ncanonicalizeValues env values =\n  do  nodes <- traverse (toNodeOne env) values\n      detectCycles (Graph.stronglyConnComp nodes)\n\n\ndetectCycles :: [Graph.SCC NodeTwo] -> Result i w Can.Decls\ndetectCycles sccs =\n  case sccs of\n    [] ->\n      Result.ok Can.SaveTheEnvironment\n\n    scc : otherSccs ->\n      case scc of\n        Graph.AcyclicSCC (def, _, _) ->\n          Can.Declare def <$> detectCycles otherSccs\n\n        Graph.CyclicSCC subNodes ->\n          do  defs <- traverse detectBadCycles (Graph.stronglyConnComp subNodes)\n              case defs of\n                []   -> detectCycles otherSccs\n                d:ds -> Can.DeclareRec d ds <$> detectCycles otherSccs\n\n\ndetectBadCycles :: Graph.SCC Can.Def -> Result i w Can.Def\ndetectBadCycles scc =\n  case scc of\n    Graph.AcyclicSCC def ->\n      Result.ok def\n\n    Graph.CyclicSCC [] ->\n      error \"The definition of Data.Graph.SCC should not allow empty CyclicSCC!\"\n\n    Graph.CyclicSCC (def:defs) ->\n      let\n        (A.At region name) = extractDefName def\n        names = map (A.toValue . extractDefName) defs\n      in\n      Result.throw (Error.RecursiveDecl region name names)\n\n\nextractDefName :: Can.Def -> A.Located Name.Name\nextractDefName def =\n  case def of\n    Can.Def name _ _ -> name\n    Can.TypedDef name _ _ _ _ -> name\n\n\n\n-- DECLARATIONS / CYCLE DETECTION SETUP\n--\n-- toNodeOne and toNodeTwo set up nodes for the two cycle detection phases.\n--\n\n-- Phase one nodes track ALL dependencies.\n-- This allows us to find cyclic values for type inference.\ntype NodeOne =\n  (NodeTwo, Name.Name, [Name.Name])\n\n\n-- Phase two nodes track DIRECT dependencies.\n-- This allows us to detect cycles that definitely do not terminate.\ntype NodeTwo =\n  (Can.Def, Name.Name, [Name.Name])\n\n\ntoNodeOne :: Env.Env -> A.Located Src.Value -> Result i [W.Warning] NodeOne\ntoNodeOne env (A.At _ (Src.Value aname@(A.At _ name) srcArgs body maybeType)) =\n  case maybeType of\n    Nothing ->\n      do  (args, argBindings) <-\n            Pattern.verify (Error.DPFuncArgs name) $\n              traverse (Pattern.canonicalize env) srcArgs\n\n          newEnv <-\n            Env.addLocals argBindings env\n\n          (cbody, freeLocals) <-\n            Expr.verifyBindings W.Pattern argBindings (Expr.canonicalize newEnv body)\n\n          let def = Can.Def aname args cbody\n          return\n            ( toNodeTwo name srcArgs def freeLocals\n            , name\n            , Map.keys freeLocals\n            )\n\n    Just srcType ->\n      do  (Can.Forall freeVars tipe) <- Type.toAnnotation env srcType\n\n          ((args,resultType), argBindings) <-\n            Pattern.verify (Error.DPFuncArgs name) $\n              Expr.gatherTypedArgs env name srcArgs tipe Index.first []\n\n          newEnv <-\n            Env.addLocals argBindings env\n\n          (cbody, freeLocals) <-\n            Expr.verifyBindings W.Pattern argBindings (Expr.canonicalize newEnv body)\n\n          let def = Can.TypedDef aname freeVars args cbody resultType\n          return\n            ( toNodeTwo name srcArgs def freeLocals\n            , name\n            , Map.keys freeLocals\n            )\n\n\ntoNodeTwo :: Name.Name -> [arg] -> Can.Def -> Expr.FreeLocals -> NodeTwo\ntoNodeTwo name args def freeLocals =\n  case args of\n    [] ->\n      (def, name, Map.foldrWithKey addDirects [] freeLocals)\n\n    _ ->\n      (def, name, [])\n\n\naddDirects :: Name.Name -> Expr.Uses -> [Name.Name] -> [Name.Name]\naddDirects name (Expr.Uses directUses _) directDeps =\n  if directUses > 0 then\n    name:directDeps\n  else\n    directDeps\n\n\n\n-- CANONICALIZE EXPORTS\n\n\ncanonicalizeExports\n  :: [A.Located Src.Value]\n  -> Map.Map Name.Name union\n  -> Map.Map Name.Name alias\n  -> Map.Map Name.Name binop\n  -> Can.Effects\n  -> A.Located Src.Exposing\n  -> Result i w Can.Exports\ncanonicalizeExports values unions aliases binops effects (A.At region exposing) =\n  case exposing of\n    Src.Open ->\n      Result.ok (Can.ExportEverything region)\n\n    Src.Explicit exposeds ->\n      do  let names = Map.fromList (map valueToName values)\n          infos <- traverse (checkExposed names unions aliases binops effects) exposeds\n          Can.Export <$> Dups.detect Error.ExportDuplicate (Dups.unions infos)\n\n\nvalueToName :: A.Located Src.Value -> ( Name.Name, () )\nvalueToName (A.At _ (Src.Value (A.At _ name) _ _ _)) =\n  ( name, () )\n\n\ncheckExposed\n  :: Map.Map Name.Name value\n  -> Map.Map Name.Name union\n  -> Map.Map Name.Name alias\n  -> Map.Map Name.Name binop\n  -> Can.Effects\n  -> Src.Exposed\n  -> Result i w (Dups.Dict (A.Located Can.Export))\ncheckExposed values unions aliases binops effects exposed =\n  case exposed of\n    Src.Lower (A.At region name) ->\n      if Map.member name values then\n        ok name region Can.ExportValue\n      else\n        case checkPorts effects name of\n          Nothing ->\n            ok name region Can.ExportPort\n\n          Just ports ->\n            Result.throw $ Error.ExportNotFound region Error.BadVar name $\n              ports ++ Map.keys values\n\n    Src.Operator region name ->\n      if Map.member name binops then\n        ok name region Can.ExportBinop\n      else\n        Result.throw $ Error.ExportNotFound region Error.BadOp name $\n          Map.keys binops\n\n    Src.Upper (A.At region name) (Src.Public dotDotRegion) ->\n      if Map.member name unions then\n        ok name region Can.ExportUnionOpen\n      else if Map.member name aliases then\n        Result.throw $ Error.ExportOpenAlias dotDotRegion name\n      else\n        Result.throw $ Error.ExportNotFound region Error.BadType name $\n          Map.keys unions ++ Map.keys aliases\n\n    Src.Upper (A.At region name) Src.Private ->\n      if Map.member name unions then\n        ok name region Can.ExportUnionClosed\n      else if Map.member name aliases then\n        ok name region Can.ExportAlias\n      else\n        Result.throw $ Error.ExportNotFound region Error.BadType name $\n          Map.keys unions ++ Map.keys aliases\n\n\ncheckPorts :: Can.Effects -> Name.Name -> Maybe [Name.Name]\ncheckPorts effects name =\n  case effects of\n    Can.NoEffects ->\n      Just []\n\n    Can.Ports ports ->\n      if Map.member name ports then Nothing else Just (Map.keys ports)\n\n    Can.Manager _ _ _ _ ->\n      Just []\n\n\nok :: Name.Name -> A.Region -> Can.Export -> Result i w (Dups.Dict (A.Located Can.Export))\nok name region export =\n  Result.ok $ Dups.one name region (A.At region export)\n"
  },
  {
    "path": "compiler/src/Canonicalize/Pattern.hs",
    "content": "module Canonicalize.Pattern\n  ( verify\n  , Bindings\n  , DupsDict\n  , canonicalize\n  )\n  where\n\n\nimport qualified Data.List as List\nimport qualified Data.Map.Strict as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Source as Src\nimport qualified Canonicalize.Environment as Env\nimport qualified Canonicalize.Environment.Dups as Dups\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Canonicalize as Error\nimport qualified Reporting.Result as Result\n\n\n\n-- RESULTS\n\n\ntype Result i w a =\n  Result.Result i w Error.Error a\n\n\ntype Bindings =\n  Map.Map Name.Name A.Region\n\n\n\n-- VERIFY\n\n\nverify :: Error.DuplicatePatternContext -> Result DupsDict w a -> Result i w (a, Bindings)\nverify context (Result.Result k) =\n  Result.Result $ \\info warnings bad good ->\n    k Dups.none warnings\n      (\\_ warnings1 errors ->\n          bad info warnings1 errors\n      )\n      (\\bindings warnings1 value ->\n          case Dups.detect (Error.DuplicatePattern context) bindings of\n            Result.Result k1 ->\n              k1 () ()\n                (\\() () errs -> bad info warnings1 errs)\n                (\\() () dict -> good info warnings1 (value, dict))\n      )\n\n\n\n-- CANONICALIZE\n\n\ntype DupsDict =\n  Dups.Dict A.Region\n\n\ncanonicalize :: Env.Env -> Src.Pattern -> Result DupsDict w Can.Pattern\ncanonicalize env (A.At region pattern) =\n  A.At region <$>\n  case pattern of\n    Src.PAnything ->\n      Result.ok Can.PAnything\n\n    Src.PVar name ->\n      logVar name region (Can.PVar name)\n\n    Src.PRecord fields ->\n      logFields fields (Can.PRecord (map A.toValue fields))\n\n    Src.PUnit ->\n      Result.ok Can.PUnit\n\n    Src.PTuple a b cs ->\n      Can.PTuple\n        <$> canonicalize env a\n        <*> canonicalize env b\n        <*> canonicalizeTuple region env cs\n\n    Src.PCtor nameRegion name patterns ->\n      canonicalizeCtor env region name patterns =<< Env.findCtor nameRegion env name\n\n    Src.PCtorQual nameRegion home name patterns ->\n      canonicalizeCtor env region name patterns =<< Env.findCtorQual nameRegion env home name\n\n    Src.PList patterns ->\n      Can.PList <$> canonicalizeList env patterns\n\n    Src.PCons first rest ->\n      Can.PCons\n        <$> canonicalize env first\n        <*> canonicalize env rest\n\n    Src.PAlias ptrn (A.At reg name) ->\n      do  cpattern <- canonicalize env ptrn\n          logVar name reg (Can.PAlias cpattern name)\n\n    Src.PChr chr ->\n      Result.ok (Can.PChr chr)\n\n    Src.PStr str ->\n      Result.ok (Can.PStr str)\n\n    Src.PInt int ->\n      Result.ok (Can.PInt int)\n\n\ncanonicalizeCtor :: Env.Env -> A.Region -> Name.Name -> [Src.Pattern] -> Env.Ctor -> Result DupsDict w Can.Pattern_\ncanonicalizeCtor env region name patterns ctor =\n  case ctor of\n    Env.Ctor home tipe union index args ->\n      let\n        toCanonicalArg argIndex argPattern argTipe =\n          Can.PatternCtorArg argIndex argTipe <$> canonicalize env argPattern\n      in\n      do  verifiedList <- Index.indexedZipWithA toCanonicalArg patterns args\n          case verifiedList of\n            Index.LengthMatch cargs ->\n              if tipe == Name.bool && home == ModuleName.basics then\n                Result.ok (Can.PBool union (name == Name.true))\n              else\n                Result.ok (Can.PCtor home tipe union name index cargs)\n\n            Index.LengthMismatch actualLength expectedLength ->\n              Result.throw (Error.BadArity region Error.PatternArity name expectedLength actualLength)\n\n    Env.RecordCtor _ _ _ ->\n      Result.throw (Error.PatternHasRecordCtor region name)\n\n\ncanonicalizeTuple :: A.Region -> Env.Env -> [Src.Pattern] -> Result DupsDict w (Maybe Can.Pattern)\ncanonicalizeTuple tupleRegion env extras =\n  case extras of\n    [] ->\n      Result.ok Nothing\n\n    [three] ->\n      Just <$> canonicalize env three\n\n    _ ->\n      Result.throw $ Error.TupleLargerThanThree tupleRegion\n\n\ncanonicalizeList :: Env.Env -> [Src.Pattern] -> Result DupsDict w [Can.Pattern]\ncanonicalizeList env list =\n  case list of\n    [] ->\n      Result.ok []\n\n    pattern : otherPatterns ->\n      (:)\n        <$> canonicalize env pattern\n        <*> canonicalizeList env otherPatterns\n\n\n\n-- LOG BINDINGS\n\n\nlogVar :: Name.Name -> A.Region -> a -> Result DupsDict w a\nlogVar name region value =\n  Result.Result $ \\bindings warnings _ ok ->\n    ok (Dups.insert name region region bindings) warnings value\n\n\nlogFields :: [A.Located Name.Name] -> a -> Result DupsDict w a\nlogFields fields value =\n  let\n    addField dict (A.At region name) =\n      Dups.insert name region region dict\n  in\n  Result.Result $ \\bindings warnings _ ok ->\n    ok (List.foldl' addField bindings fields) warnings value\n"
  },
  {
    "path": "compiler/src/Canonicalize/Type.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Canonicalize.Type\n  ( toAnnotation\n  , canonicalize\n  )\n  where\n\n\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Source as Src\nimport qualified Canonicalize.Environment as Env\nimport qualified Canonicalize.Environment.Dups as Dups\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Canonicalize as Error\nimport qualified Reporting.Result as Result\n\n\n\n-- RESULT\n\n\ntype Result i w a =\n  Result.Result i w Error.Error a\n\n\n\n-- TO ANNOTATION\n\n\ntoAnnotation :: Env.Env -> Src.Type -> Result i w Can.Annotation\ntoAnnotation env srcType =\n  do  tipe <- canonicalize env srcType\n      Result.ok $ Can.Forall (addFreeVars Map.empty tipe) tipe\n\n\n\n-- CANONICALIZE TYPES\n\n\ncanonicalize :: Env.Env -> Src.Type -> Result i w Can.Type\ncanonicalize env (A.At typeRegion tipe) =\n  case tipe of\n    Src.TVar x ->\n        Result.ok (Can.TVar x)\n\n    Src.TType region name args ->\n        canonicalizeType env typeRegion name args =<<\n          Env.findType region env name\n\n    Src.TTypeQual region home name args ->\n        canonicalizeType env typeRegion name args =<<\n          Env.findTypeQual region env home name\n\n    Src.TLambda a b ->\n        Can.TLambda\n          <$> canonicalize env a\n          <*> canonicalize env b\n\n    Src.TRecord fields ext ->\n        do  cfields <- sequenceA =<< Dups.checkFields (canonicalizeFields env fields)\n            return $ Can.TRecord cfields (fmap A.toValue ext)\n\n    Src.TUnit ->\n        Result.ok Can.TUnit\n\n    Src.TTuple a b cs ->\n        Can.TTuple\n          <$> canonicalize env a\n          <*> canonicalize env b\n          <*>\n            case cs of\n              [] ->\n                Result.ok Nothing\n\n              [c] ->\n                Just <$> canonicalize env c\n\n              _ ->\n                Result.throw $ Error.TupleLargerThanThree typeRegion\n\n\ncanonicalizeFields :: Env.Env -> [(A.Located Name.Name, Src.Type)] -> [(A.Located Name.Name, Result i w Can.FieldType)]\ncanonicalizeFields env fields =\n  let\n    len = fromIntegral (length fields)\n    canonicalizeField index (name, srcType) =\n      (name, Can.FieldType index <$> canonicalize env srcType)\n  in\n  zipWith canonicalizeField [0..len] fields\n\n\n\n-- CANONICALIZE TYPE\n\n\ncanonicalizeType :: Env.Env -> A.Region -> Name.Name -> [Src.Type] -> Env.Type -> Result i w Can.Type\ncanonicalizeType env region name args info =\n  do  cargs <- traverse (canonicalize env) args\n      case info of\n        Env.Alias arity home argNames aliasedType ->\n          checkArity arity region name args $\n            Can.TAlias home name (zip argNames cargs) (Can.Holey aliasedType)\n\n        Env.Union arity home ->\n          checkArity arity region name args $\n            Can.TType home name cargs\n\n\ncheckArity :: Int -> A.Region -> Name.Name -> [A.Located arg] -> answer -> Result i w answer\ncheckArity expected region name args answer =\n  let actual = length args in\n  if expected == actual then\n    Result.ok answer\n  else\n    Result.throw (Error.BadArity region Error.TypeArity name expected actual)\n\n\n\n-- ADD FREE VARS\n\n\naddFreeVars :: Map.Map Name.Name () -> Can.Type -> Map.Map Name.Name ()\naddFreeVars freeVars tipe =\n  case tipe of\n    Can.TLambda arg result ->\n      addFreeVars (addFreeVars freeVars result) arg\n\n    Can.TVar var ->\n      Map.insert var () freeVars\n\n    Can.TType _ _ args ->\n      List.foldl' addFreeVars freeVars args\n\n    Can.TRecord fields Nothing ->\n      Map.foldl addFieldFreeVars freeVars fields\n\n    Can.TRecord fields (Just ext) ->\n      Map.foldl addFieldFreeVars (Map.insert ext () freeVars) fields\n\n    Can.TUnit ->\n      freeVars\n\n    Can.TTuple a b maybeC ->\n      case maybeC of\n        Nothing ->\n          addFreeVars (addFreeVars freeVars a) b\n\n        Just c ->\n          addFreeVars (addFreeVars (addFreeVars freeVars a) b) c\n\n    Can.TAlias _ _ args _ ->\n      List.foldl' (\\fvs (_,arg) -> addFreeVars fvs arg) freeVars args\n\n\naddFieldFreeVars :: Map.Map Name.Name () -> Can.FieldType -> Map.Map Name.Name ()\naddFieldFreeVars freeVars (Can.FieldType _ tipe) =\n  addFreeVars freeVars tipe\n"
  },
  {
    "path": "compiler/src/Compile.hs",
    "content": "{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}\nmodule Compile\n  ( Artifacts(..)\n  , compile\n  )\n  where\n\n\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Source as Src\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified Canonicalize.Module as Canonicalize\nimport qualified Elm.Interface as I\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Nitpick.PatternMatches as PatternMatches\nimport qualified Optimize.Module as Optimize\nimport qualified Reporting.Error as E\nimport qualified Reporting.Result as R\nimport qualified Reporting.Render.Type.Localizer as Localizer\nimport qualified Type.Constrain.Module as Type\nimport qualified Type.Solve as Type\n\nimport System.IO.Unsafe (unsafePerformIO)\n\n\n\n-- COMPILE\n\n\ndata Artifacts =\n  Artifacts\n    { _modul :: Can.Module\n    , _types :: Map.Map Name.Name Can.Annotation\n    , _graph :: Opt.LocalGraph\n    }\n\n\ncompile :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Either E.Error Artifacts\ncompile pkg ifaces modul =\n  do  canonical   <- canonicalize pkg ifaces modul\n      annotations <- typeCheck modul canonical\n      ()          <- nitpick canonical\n      objects     <- optimize modul annotations canonical\n      return (Artifacts canonical annotations objects)\n\n\n\n-- PHASES\n\n\ncanonicalize :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Either E.Error Can.Module\ncanonicalize pkg ifaces modul =\n  case snd $ R.run $ Canonicalize.canonicalize pkg ifaces modul of\n    Right canonical ->\n      Right canonical\n\n    Left errors ->\n      Left $ E.BadNames errors\n\n\ntypeCheck :: Src.Module -> Can.Module -> Either E.Error (Map.Map Name.Name Can.Annotation)\ntypeCheck modul canonical =\n  case unsafePerformIO (Type.run =<< Type.constrain canonical) of\n    Right annotations ->\n      Right annotations\n\n    Left errors ->\n      Left (E.BadTypes (Localizer.fromModule modul) errors)\n\n\nnitpick :: Can.Module -> Either E.Error ()\nnitpick canonical =\n  case PatternMatches.check canonical of\n    Right () ->\n      Right ()\n\n    Left errors ->\n      Left (E.BadPatterns errors)\n\n\noptimize :: Src.Module -> Map.Map Name.Name Can.Annotation -> Can.Module -> Either E.Error Opt.LocalGraph\noptimize modul annotations canonical =\n  case snd $ R.run $ Optimize.optimize annotations canonical of\n    Right localGraph ->\n      Right localGraph\n\n    Left errors ->\n      Left (E.BadMains (Localizer.fromModule modul) errors)\n"
  },
  {
    "path": "compiler/src/Data/Bag.hs",
    "content": "module Data.Bag\n  ( Bag(..)\n  , empty\n  , one\n  , append\n  , map\n  , toList\n  , fromList\n  )\n  where\n\n\nimport Prelude hiding (map)\nimport qualified Data.List as List\n\n\n\n-- BAGS\n\n\ndata Bag a\n  = Empty\n  | One a\n  | Two (Bag a) (Bag a)\n\n\n\n-- HELPERS\n\n\nempty :: Bag a\nempty =\n  Empty\n\n\none :: a -> Bag a\none =\n  One\n\n\nappend :: Bag a -> Bag a -> Bag a\nappend left right =\n  case (left, right) of\n    (other, Empty) ->\n      other\n\n    (Empty, other) ->\n      other\n\n    (_, _) ->\n      Two left right\n\n\n\n-- MAP\n\n\nmap :: (a -> b) -> Bag a -> Bag b\nmap func bag =\n  case bag of\n    Empty ->\n      Empty\n\n    One a ->\n      One (func a)\n\n    Two left right ->\n      Two (map func left) (map func right)\n\n\n\n-- TO LIST\n\n\ntoList :: Bag a -> [a]\ntoList bag =\n  toListHelp bag []\n\n\ntoListHelp :: Bag a -> [a] -> [a]\ntoListHelp bag list =\n  case bag of\n    Empty ->\n      list\n\n    One x ->\n      x : list\n\n    Two a b ->\n      toListHelp a (toListHelp b list)\n\n\n\n-- FROM LIST\n\n\nfromList :: (a -> b) -> [a] -> Bag b\nfromList func list =\n  case list of\n    [] ->\n      Empty\n\n    first : rest ->\n      List.foldl' (add func) (One (func first)) rest\n\n\nadd :: (a -> b) -> Bag b -> a -> Bag b\nadd func bag value =\n  Two (One (func value)) bag\n"
  },
  {
    "path": "compiler/src/Data/Index.hs",
    "content": "module Data.Index\n  ( ZeroBased\n  , first\n  , second\n  , third\n  , next\n  , toMachine\n  , toHuman\n  , indexedMap\n  , indexedTraverse\n  , indexedForA\n  , VerifiedList(..)\n  , indexedZipWith\n  , indexedZipWithA\n  )\n  where\n\n\nimport Control.Monad (liftM)\nimport Data.Binary\n\n\n\n-- ZERO BASED\n\n\nnewtype ZeroBased = ZeroBased Int\n  deriving (Eq, Ord)\n\n\nfirst :: ZeroBased\nfirst =\n  ZeroBased 0\n\n\nsecond :: ZeroBased\nsecond =\n  ZeroBased 1\n\n\nthird :: ZeroBased\nthird =\n  ZeroBased 2\n\n\n{-# INLINE next #-}\nnext :: ZeroBased -> ZeroBased\nnext (ZeroBased i) =\n  ZeroBased (i + 1)\n\n\n\n-- DESTRUCT\n\n\ntoMachine :: ZeroBased -> Int\ntoMachine (ZeroBased index) =\n  index\n\n\ntoHuman :: ZeroBased -> Int\ntoHuman (ZeroBased index) =\n  index + 1\n\n\n\n-- INDEXED MAP\n\n\n{-# INLINE indexedMap #-}\nindexedMap :: (ZeroBased -> a -> b) -> [a] -> [b]\nindexedMap func xs =\n  zipWith func (map ZeroBased [0 .. length xs]) xs\n\n\n{-# INLINE indexedTraverse #-}\nindexedTraverse :: (Applicative f) => (ZeroBased -> a -> f b) -> [a] -> f [b]\nindexedTraverse func xs =\n  sequenceA (indexedMap func xs)\n\n\n{-# INLINE indexedForA #-}\nindexedForA :: (Applicative f) => [a] -> (ZeroBased -> a -> f b) -> f [b]\nindexedForA xs func =\n  sequenceA (indexedMap func xs)\n\n\n\n-- VERIFIED/INDEXED ZIP\n\n\ndata VerifiedList a\n  = LengthMatch [a]\n  | LengthMismatch Int Int\n\n\nindexedZipWith :: (ZeroBased -> a -> b -> c) -> [a] -> [b] -> VerifiedList c\nindexedZipWith func listX listY =\n  indexedZipWithHelp func 0 listX listY []\n\n\nindexedZipWithHelp :: (ZeroBased -> a -> b -> c) -> Int -> [a] -> [b] -> [c] -> VerifiedList c\nindexedZipWithHelp func index listX listY revListZ =\n  case (listX, listY) of\n    ([], []) ->\n      LengthMatch (reverse revListZ)\n\n    (x:xs, y:ys) ->\n      indexedZipWithHelp func (index + 1) xs ys $\n        func (ZeroBased index) x y : revListZ\n\n    (_, _) ->\n      LengthMismatch (index + length listX) (index + length listY)\n\n\nindexedZipWithA :: (Applicative f) => (ZeroBased -> a -> b -> f c) -> [a] -> [b] -> f (VerifiedList c)\nindexedZipWithA func listX listY =\n  case indexedZipWith func listX listY of\n    LengthMatch xs ->\n      LengthMatch <$> sequenceA xs\n\n    LengthMismatch x y ->\n      pure (LengthMismatch x y)\n\n\n\n-- BINARY\n\n\ninstance Binary ZeroBased where\n  get = liftM ZeroBased get\n  put (ZeroBased n) = put n\n"
  },
  {
    "path": "compiler/src/Data/Map/Utils.hs",
    "content": "module Data.Map.Utils\n  ( fromKeys\n  , fromKeysA\n  , fromValues\n  , any\n  )\n  where\n\n\nimport Prelude hiding (any)\nimport qualified Data.Map as Map\nimport Data.Map.Internal (Map(..))\n\n\n\n-- FROM KEYS\n\n\nfromKeys :: (Ord k) => (k -> v) -> [k] -> Map.Map k v\nfromKeys toValue keys =\n  Map.fromList $ map (\\k -> (k, toValue k)) keys\n\n\nfromKeysA :: (Applicative f, Ord k) => (k -> f v) -> [k] -> f (Map.Map k v)\nfromKeysA toValue keys =\n  Map.fromList <$> traverse (\\k -> (,) k <$> toValue k) keys\n\n\nfromValues :: (Ord k) => (v -> k) -> [v] -> Map.Map k v\nfromValues toKey values =\n  Map.fromList $ map (\\v -> (toKey v, v)) values\n\n\n\n-- ANY\n\n\n{-# INLINE any #-}\nany :: (v -> Bool) -> Map.Map k v -> Bool\nany isGood = go\n  where\n    go Tip = False\n    go (Bin _ _ v l r) = isGood v || go l || go r\n"
  },
  {
    "path": "compiler/src/Data/Name.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n{-# LANGUAGE BangPatterns, EmptyDataDecls, FlexibleInstances, MagicHash, UnboxedTuples #-}\nmodule Data.Name\n  ( Name\n  --\n  , toChars\n  , toElmString\n  , toBuilder\n  --\n  , fromPtr\n  , fromChars\n  --\n  , getKernel\n  , hasDot\n  , splitDots\n  , isKernel\n  , isNumberType\n  , isComparableType\n  , isAppendableType\n  , isCompappendType\n  , fromVarIndex\n  , fromWords\n  , fromManyNames\n  , fromTypeVariable\n  , fromTypeVariableScheme\n  , sepBy\n  --\n  , int, float, bool, char, string\n  , maybe, result, list, array, dict, tuple, jsArray\n  , task, router, cmd, sub, platform, virtualDom\n  , shader, debug, debugger, bitwise, basics\n  , utils, negate, true, false, value\n  , node, program, _main, _Main, dollar, identity\n  , replModule, replValueToPrint\n  )\n  where\n\n\nimport Prelude hiding (length, maybe, negate)\nimport Control.Exception (assert)\nimport qualified Data.Binary as Binary\nimport qualified Data.ByteString.Builder.Internal as B\nimport qualified Data.Coerce as Coerce\nimport qualified Data.List as List\nimport qualified Data.String as Chars\nimport qualified Data.Utf8 as Utf8\nimport GHC.Exts (Int(I#), Ptr, isTrue#)\nimport GHC.ST (ST(ST), runST)\nimport GHC.Prim\nimport GHC.Word (Word8(W8#))\n\nimport qualified Elm.String as ES\n\n\n\n-- NAME\n\n\ntype Name =\n  Utf8.Utf8 ELM_NAME\n\n\ndata ELM_NAME\n\n\n\n-- INSTANCES\n\n\ninstance Chars.IsString (Utf8.Utf8 ELM_NAME) where\n  fromString = Utf8.fromChars\n\ninstance Binary.Binary (Utf8.Utf8 ELM_NAME) where\n  get = Utf8.getUnder256\n  put = Utf8.putUnder256\n\n\n\n-- TO\n\n\ntoChars :: Name -> [Char]\ntoChars =\n  Utf8.toChars\n\n\ntoElmString :: Name -> ES.String\ntoElmString =\n  Coerce.coerce\n\n\n{-# INLINE toBuilder #-}\ntoBuilder :: Name -> B.Builder\ntoBuilder =\n  Utf8.toBuilder\n\n\n\n-- FROM\n\n\nfromPtr :: Ptr Word8 -> Ptr Word8 -> Name\nfromPtr =\n  Utf8.fromPtr\n\n\nfromChars :: [Char] -> Name\nfromChars =\n  Utf8.fromChars\n\n\n\n-- HAS DOT\n\n\nhasDot :: Name -> Bool\nhasDot name =\n  Utf8.contains 0x2E {- . -} name\n\n\nsplitDots :: Name -> [Name]\nsplitDots name =\n  Utf8.split 0x2E {- . -} name\n\n\n\n-- GET KERNEL\n\n\ngetKernel :: Name -> Name\ngetKernel name@(Utf8.Utf8 ba#) =\n  assert (isKernel name)\n  (\n    runST\n    (\n      let\n        !size# = sizeofByteArray# ba# -# 11#\n      in\n      ST $ \\s ->\n        case newByteArray# size# s of\n          (# s, mba# #) ->\n            case copyByteArray# ba# 11# mba# 0# size# s of\n              s ->\n                case unsafeFreezeByteArray# mba# s of\n                  (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)\n    )\n  )\n\n\n\n-- STARTS WITH\n\n\nisKernel :: Name -> Bool\nisKernel = Utf8.startsWith prefix_kernel\n\nisNumberType :: Name -> Bool\nisNumberType = Utf8.startsWith prefix_number\n\nisComparableType :: Name -> Bool\nisComparableType = Utf8.startsWith prefix_comparable\n\nisAppendableType :: Name -> Bool\nisAppendableType = Utf8.startsWith prefix_appendable\n\nisCompappendType :: Name -> Bool\nisCompappendType = Utf8.startsWith prefix_compappend\n\n{-# NOINLINE prefix_kernel #-}\nprefix_kernel :: Name\nprefix_kernel = fromChars \"Elm.Kernel.\"\n\n{-# NOINLINE prefix_number #-}\nprefix_number :: Name\nprefix_number = fromChars \"number\"\n\n{-# NOINLINE prefix_comparable #-}\nprefix_comparable :: Name\nprefix_comparable = fromChars \"comparable\"\n\n{-# NOINLINE prefix_appendable #-}\nprefix_appendable :: Name\nprefix_appendable = fromChars \"appendable\"\n\n{-# NOINLINE prefix_compappend #-}\nprefix_compappend :: Name\nprefix_compappend = fromChars \"compappend\"\n\n\n\n-- FROM VAR INDEX\n\n\nfromVarIndex :: Int -> Name\nfromVarIndex n =\n  runST\n  (\n    do  let !size = 2 + getIndexSize n\n        mba <- newByteArray size\n        writeWord8 mba 0 0x5F {- _ -}\n        writeWord8 mba 1 0x76 {- v -}\n        writeDigitsAtEnd mba size n\n        freeze mba\n  )\n\n\n{-# INLINE getIndexSize #-}\ngetIndexSize :: Int -> Int\ngetIndexSize n\n  | n < 10  = 1\n  | n < 100 = 2\n  | True    = ceiling (logBase 10 (fromIntegral n + 1) :: Float)\n\n\n\nwriteDigitsAtEnd :: MBA s -> Int -> Int -> ST s ()\nwriteDigitsAtEnd !mba !oldOffset !n =\n  do  let (q,r) = quotRem n 10\n      let !newOffset = oldOffset - 1\n      writeWord8 mba newOffset (0x30 + fromIntegral r)\n      if q <= 0\n        then return ()\n        else writeDigitsAtEnd mba newOffset q\n\n\n\n-- FROM TYPE VARIABLE\n\n\nfromTypeVariable :: Name -> Int -> Name\nfromTypeVariable name@(Utf8.Utf8 ba#) index =\n  if index <= 0 then\n    name\n  else\n    let\n      len# = sizeofByteArray# ba#\n      end# = word8ToWord# (indexWord8Array# ba# (len# -# 1#))\n    in\n    if isTrue# (leWord# 0x30## end#) && isTrue# (leWord# end# 0x39##) then\n      runST\n      (\n        do  let !size = I# len# + 1 + getIndexSize index\n            mba <- newByteArray size\n            copyToMBA name mba\n            writeWord8 mba (I# len#) 0x5F {- _ -}\n            writeDigitsAtEnd mba size index\n            freeze mba\n      )\n    else\n      runST\n      (\n        do  let !size = I# len# + getIndexSize index\n            mba <- newByteArray size\n            copyToMBA name mba\n            writeDigitsAtEnd mba size index\n            freeze mba\n      )\n\n\n\n-- FROM TYPE VARIABLE SCHEME\n\n\nfromTypeVariableScheme :: Int -> Name\nfromTypeVariableScheme scheme =\n  runST\n  (\n    if scheme < 26 then\n      do  mba <- newByteArray 1\n          writeWord8 mba 0 (0x61 + fromIntegral scheme)\n          freeze mba\n    else\n      do  let (extra, letter) = quotRem scheme 26\n          let !size = 1 + getIndexSize extra\n          mba <- newByteArray size\n          writeWord8 mba 0 (0x61 + fromIntegral letter)\n          writeDigitsAtEnd mba size extra\n          freeze mba\n  )\n\n\n\n-- FROM MANY NAMES\n--\n-- Creating a unique name by combining all the subnames can create names\n-- longer than 256 bytes relatively easily. So instead, the first given name\n-- (e.g. foo) is prefixed chars that are valid in JS but not Elm (e.g. _M$foo)\n--\n-- This should be a unique name since 0.19 disallows shadowing. It would not\n-- be possible for multiple top-level cycles to include values with the same\n-- name, so the important thing is to make the cycle name distinct from the\n-- normal name. Same logic for destructuring patterns like (x,y)\n\n\nfromManyNames :: [Name] -> Name\nfromManyNames names =\n  case names of\n    [] ->\n      blank\n      -- NOTE: this case is needed for (let _ = Debug.log \"x\" x in ...)\n      -- but maybe unused patterns should be stripped out instead\n\n    Utf8.Utf8 ba# : _ ->\n      let\n        len# = sizeofByteArray# ba#\n      in\n      runST\n      (\n        ST $ \\s ->\n          case newByteArray# (len# +# 3#) s of\n            (# s, mba# #) ->\n              case writeWord8Array# mba# 0# (wordToWord8# 0x5F##) {-_-} s of\n                s ->\n                  case writeWord8Array# mba# 1# (wordToWord8# 0x4D##) {-M-} s of\n                    s ->\n                      case writeWord8Array# mba# 2# (wordToWord8# 0x24##) {-$-} s of\n                        s ->\n                          case copyByteArray# ba# 0# mba# 3# len# s of\n                            s ->\n                              case unsafeFreezeByteArray# mba# s of\n                                (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)\n      )\n\n\n{-# NOINLINE blank #-}\nblank :: Name\nblank =\n  fromWords [0x5F,0x4D,0x24] {-_M$-}\n\n\n\n-- FROM WORDS\n\n\nfromWords :: [Word8] -> Name\nfromWords words =\n  runST\n  (\n    do  mba <- newByteArray (List.length words)\n        writeWords mba 0 words\n        freeze mba\n  )\n\n\nwriteWords :: MBA s -> Int -> [Word8] -> ST s ()\nwriteWords !mba !i words =\n  case words of\n    [] ->\n      return ()\n\n    w:ws ->\n      do  writeWord8 mba i w\n          writeWords mba (i+1) ws\n\n\n\n-- SEP BY\n\n\nsepBy :: Word8 -> Name -> Name -> Name\nsepBy (W8# sep#) (Utf8.Utf8 ba1#) (Utf8.Utf8 ba2#) =\n  let\n    !len1# = sizeofByteArray# ba1#\n    !len2# = sizeofByteArray# ba2#\n  in\n  runST\n  (\n    ST $ \\s ->\n      case newByteArray# (len1# +# len2# +# 1#) s of\n        (# s, mba# #) ->\n          case copyByteArray# ba1# 0# mba# 0# len1# s of\n            s ->\n              case writeWord8Array# mba# len1# sep# s of\n                s ->\n                  case copyByteArray# ba2# 0# mba# (len1# +# 1#) len2# s of\n                    s ->\n                      case unsafeFreezeByteArray# mba# s of\n                        (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)\n  )\n\n\n\n-- PRIMITIVES\n\n\ndata MBA s =\n  MBA# (MutableByteArray# s)\n\n\n{-# INLINE newByteArray #-}\nnewByteArray :: Int -> ST s (MBA s)\nnewByteArray (I# len#) =\n  ST $ \\s ->\n    case newByteArray# len# s of\n      (# s, mba# #) -> (# s, MBA# mba# #)\n\n\n{-# INLINE freeze #-}\nfreeze :: MBA s -> ST s Name\nfreeze (MBA# mba#) =\n  ST $ \\s ->\n    case unsafeFreezeByteArray# mba# s of\n      (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)\n\n\n{-# INLINE writeWord8 #-}\nwriteWord8 :: MBA s -> Int -> Word8 -> ST s ()\nwriteWord8 (MBA# mba#) (I# offset#) (W8# w#) =\n  ST $ \\s ->\n    case writeWord8Array# mba# offset# w# s of\n      s -> (# s, () #)\n\n\n{-# INLINE copyToMBA #-}\ncopyToMBA :: Name -> MBA s -> ST s ()\ncopyToMBA (Utf8.Utf8 ba#) (MBA# mba#) =\n    ST $ \\s ->\n      case copyByteArray# ba# 0# mba# 0# (sizeofByteArray# ba#) s of\n        s -> (# s, () #)\n\n\n\n-- COMMON NAMES\n\n\n{-# NOINLINE int #-}\nint :: Name\nint = fromChars \"Int\"\n\n\n{-# NOINLINE float #-}\nfloat :: Name\nfloat = fromChars \"Float\"\n\n\n{-# NOINLINE bool #-}\nbool :: Name\nbool = fromChars \"Bool\"\n\n\n{-# NOINLINE char #-}\nchar :: Name\nchar = fromChars \"Char\"\n\n\n{-# NOINLINE string #-}\nstring :: Name\nstring = fromChars \"String\"\n\n\n{-# NOINLINE maybe #-}\nmaybe :: Name\nmaybe = fromChars \"Maybe\"\n\n\n{-# NOINLINE result #-}\nresult :: Name\nresult = fromChars \"Result\"\n\n\n{-# NOINLINE list #-}\nlist :: Name\nlist = fromChars \"List\"\n\n\n{-# NOINLINE array #-}\narray :: Name\narray = fromChars \"Array\"\n\n\n{-# NOINLINE dict #-}\ndict :: Name\ndict = fromChars \"Dict\"\n\n\n{-# NOINLINE tuple #-}\ntuple :: Name\ntuple = fromChars \"Tuple\"\n\n\n{-# NOINLINE jsArray #-}\njsArray :: Name\njsArray = fromChars \"JsArray\"\n\n\n{-# NOINLINE task #-}\ntask :: Name\ntask = fromChars \"Task\"\n\n\n{-# NOINLINE router #-}\nrouter :: Name\nrouter = fromChars \"Router\"\n\n\n{-# NOINLINE cmd #-}\ncmd :: Name\ncmd = fromChars \"Cmd\"\n\n\n{-# NOINLINE sub #-}\nsub :: Name\nsub = fromChars \"Sub\"\n\n\n{-# NOINLINE platform #-}\nplatform :: Name\nplatform = fromChars \"Platform\"\n\n\n{-# NOINLINE virtualDom #-}\nvirtualDom :: Name\nvirtualDom = fromChars \"VirtualDom\"\n\n\n{-# NOINLINE shader #-}\nshader :: Name\nshader = fromChars \"Shader\"\n\n\n{-# NOINLINE debug #-}\ndebug :: Name\ndebug = fromChars \"Debug\"\n\n\n{-# NOINLINE debugger #-}\ndebugger :: Name\ndebugger = fromChars \"Debugger\"\n\n\n{-# NOINLINE bitwise #-}\nbitwise :: Name\nbitwise = fromChars \"Bitwise\"\n\n\n{-# NOINLINE basics #-}\nbasics :: Name\nbasics = fromChars \"Basics\"\n\n\n{-# NOINLINE utils #-}\nutils :: Name\nutils = fromChars \"Utils\"\n\n\n{-# NOINLINE negate #-}\nnegate :: Name\nnegate = fromChars \"negate\"\n\n\n{-# NOINLINE true #-}\ntrue :: Name\ntrue = fromChars \"True\"\n\n\n{-# NOINLINE false #-}\nfalse :: Name\nfalse = fromChars \"False\"\n\n\n{-# NOINLINE value #-}\nvalue :: Name\nvalue = fromChars \"Value\"\n\n\n{-# NOINLINE node #-}\nnode :: Name\nnode = fromChars \"Node\"\n\n\n{-# NOINLINE program #-}\nprogram :: Name\nprogram = fromChars \"Program\"\n\n\n{-# NOINLINE _main #-}\n_main :: Name\n_main = fromChars \"main\"\n\n\n{-# NOINLINE _Main #-}\n_Main :: Name\n_Main = fromChars \"Main\"\n\n\n{-# NOINLINE dollar #-}\ndollar :: Name\ndollar = fromChars \"$\"\n\n\n{-# NOINLINE identity #-}\nidentity :: Name\nidentity = fromChars \"identity\"\n\n\n{-# NOINLINE replModule #-}\nreplModule :: Name\nreplModule = fromChars \"Elm_Repl\"\n\n\n{-# NOINLINE replValueToPrint #-}\nreplValueToPrint :: Name\nreplValueToPrint = fromChars \"repl_input_value_\"\n"
  },
  {
    "path": "compiler/src/Data/NonEmptyList.hs",
    "content": "module Data.NonEmptyList\n  ( List(..)\n  , singleton\n  , toList\n  , sortBy\n  )\n  where\n\n\nimport Control.Monad (liftM2)\nimport Data.Binary (Binary, get, put)\nimport qualified Data.List as List\n\n\n\n-- LIST\n\n\ndata List a =\n  List a [a]\n\n\nsingleton :: a -> List a\nsingleton a =\n  List a []\n\n\ntoList :: List a -> [a]\ntoList (List x xs) =\n  x:xs\n\n\n\n-- INSTANCES\n\n\ninstance Functor List where\n  fmap func (List x xs) = List (func x) (map func xs)\n\n\ninstance Traversable List where\n  traverse func (List x xs) = List <$> func x <*> traverse func xs\n\n\ninstance Foldable List where\n  foldr step state (List x xs) = step x (foldr step state xs)\n  foldl step state (List x xs) = foldl step (step state x) xs\n  foldl1 step      (List x xs) = foldl step x xs\n\n\n\n-- SORT BY\n\n\nsortBy :: (Ord b) => (a -> b) -> List a -> List a\nsortBy toRank (List x xs) =\n  let\n    comparison a b =\n      compare (toRank a) (toRank b)\n  in\n  case List.sortBy comparison xs of\n    [] ->\n      List x []\n\n    y:ys ->\n      case comparison x y of\n        LT -> List x (y:ys)\n        EQ -> List x (y:ys)\n        GT -> List y (List.insertBy comparison x ys)\n\n\n\n-- BINARY\n\n\ninstance (Binary a) => Binary (List a) where\n  put (List x xs) = put x >> put xs\n  get = liftM2 List get get\n"
  },
  {
    "path": "compiler/src/Data/OneOrMore.hs",
    "content": "module Data.OneOrMore\n  ( OneOrMore(..)\n  , one\n  , more\n  , map\n  , destruct\n  , getFirstTwo\n  )\n  where\n\n\nimport Prelude hiding (map)\n\n\n\n-- ONE OR MORE\n\n\ndata OneOrMore a\n  = One a\n  | More (OneOrMore a) (OneOrMore a)\n\n\none :: a -> OneOrMore a\none =\n  One\n\n\nmore :: OneOrMore a -> OneOrMore a -> OneOrMore a\nmore =\n  More\n\n\n\n-- MAP\n\n\nmap :: (a -> b) -> OneOrMore a -> OneOrMore b\nmap func oneOrMore =\n  case oneOrMore of\n    One value ->\n      One (func value)\n\n    More left right ->\n      More (map func left) (map func right)\n\n\n\n-- DESTRUCT\n\n\ndestruct :: (a -> [a] -> b) -> OneOrMore a -> b\ndestruct func oneOrMore =\n  destructLeft func oneOrMore []\n\n\ndestructLeft :: (a -> [a] -> b) -> OneOrMore a -> [a] -> b\ndestructLeft func oneOrMore xs =\n  case oneOrMore of\n    One x ->\n      func x xs\n\n    More a b ->\n      destructLeft func a (destructRight b xs)\n\n\ndestructRight :: OneOrMore a -> [a] -> [a]\ndestructRight oneOrMore xs =\n  case oneOrMore of\n    One x ->\n      x : xs\n\n    More a b ->\n      destructRight a (destructRight b xs)\n\n\n\n-- GET FIRST TWO\n\n\ngetFirstTwo :: OneOrMore a -> OneOrMore a -> (a,a)\ngetFirstTwo left right =\n  case left of\n    One x ->\n      (x, getFirstOne right)\n\n    More lleft lright ->\n      getFirstTwo lleft lright\n\n\ngetFirstOne :: OneOrMore a -> a\ngetFirstOne oneOrMore =\n  case oneOrMore of\n    One x ->\n      x\n\n    More left _ ->\n      getFirstOne left\n"
  },
  {
    "path": "compiler/src/Data/Utf8.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n{-# LANGUAGE BangPatterns, FlexibleInstances, MagicHash, UnboxedTuples #-}\nmodule Data.Utf8\n  ( Utf8(..)\n  , isEmpty\n  , empty\n  , size\n  , contains\n  , startsWith\n  , startsWithChar\n  , endsWithWord8\n  , split\n  , join\n  --\n  , getUnder256\n  , putUnder256\n  --\n  , getVeryLong\n  , putVeryLong\n  --\n  , toChars\n  , toBuilder\n  , toEscapedBuilder\n  --\n  , fromPtr\n  , fromSnippet\n  , fromChars\n  --\n  , MBA\n  , newByteArray\n  , copyFromPtr\n  , writeWord8\n  , freeze\n  )\n  where\n\n\nimport Prelude hiding (String, all, any, concat)\nimport Data.Binary (Get, get, getWord8, Put, put, putWord8)\nimport Data.Binary.Put (putBuilder)\nimport Data.Binary.Get.Internal (readN)\nimport Data.Bits ((.&.), shiftR)\nimport qualified Data.ByteString.Internal as B\nimport qualified Data.ByteString.Builder.Internal as B\nimport qualified Data.Char as Char\nimport qualified Data.List as List\nimport Foreign.ForeignPtr (touchForeignPtr)\nimport Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)\nimport Foreign.Ptr (minusPtr, plusPtr)\nimport GHC.Exts (Int(I#), Ptr(Ptr), Char(C#), isTrue#)\nimport GHC.IO\nimport GHC.ST (ST(ST), runST)\nimport GHC.Prim\nimport GHC.Word (Word8(W8#))\n\nimport qualified Parse.Primitives as P\n\n\n\n-- UTF-8\n\n\ndata Utf8 tipe =\n  Utf8 ByteArray#\n\n\n\n-- EMPTY\n\n\n{-# NOINLINE empty #-}\nempty :: Utf8 t\nempty =\n  runST (freeze =<< newByteArray 0)\n\n\nisEmpty :: Utf8 t -> Bool\nisEmpty (Utf8 ba#) =\n  isTrue# (sizeofByteArray# ba# ==# 0#)\n\n\n\n-- SIZE\n\n\nsize :: Utf8 t -> Int\nsize (Utf8 ba#) =\n  I# (sizeofByteArray# ba#)\n\n\n\n-- CONTAINS\n\n\ncontains :: Word8 -> Utf8 t -> Bool\ncontains (W8# word#) (Utf8 ba#) =\n  containsHelp word# ba# 0# (sizeofByteArray# ba#)\n\n\ncontainsHelp :: Word8# -> ByteArray# -> Int# -> Int# -> Bool\ncontainsHelp word# ba# !offset# len# =\n  if isTrue# (offset# <# len#) then\n    if isTrue# (eqWord8# word# (indexWord8Array# ba# offset#))\n      then True\n      else containsHelp word# ba# (offset# +# 1#) len#\n  else\n    False\n\n\n\n-- STARTS WITH\n\n\n{-# INLINE startsWith #-}\nstartsWith :: Utf8 t -> Utf8 t -> Bool\nstartsWith (Utf8 ba1#) (Utf8 ba2#) =\n  let\n    !len1# = sizeofByteArray# ba1#\n    !len2# = sizeofByteArray# ba2#\n  in\n  isTrue# (len1# <=# len2#)\n  &&\n  isTrue# (0# ==# compareByteArrays# ba1# 0# ba2# 0# len1#)\n\n\n\n-- STARTS WITH CHAR\n\n\nstartsWithChar :: (Char -> Bool) -> Utf8 t -> Bool\nstartsWithChar isGood bytes@(Utf8 ba#) =\n  if isEmpty bytes then\n    False\n  else\n    let\n      !w# = word8ToWord# (indexWord8Array# ba# 0#)\n      !char\n        | isTrue# (ltWord# w# 0xC0##) = C# (chr# (word2Int# w#))\n        | isTrue# (ltWord# w# 0xE0##) = chr2 ba# 0# w#\n        | isTrue# (ltWord# w# 0xF0##) = chr3 ba# 0# w#\n        | True                        = chr4 ba# 0# w#\n    in\n    isGood char\n\n\n\n-- ENDS WITH WORD\n\n\nendsWithWord8 :: Word8 -> Utf8 t -> Bool\nendsWithWord8 (W8# w#) (Utf8 ba#) =\n  let len# = sizeofByteArray# ba# in\n  isTrue# (len# ># 0#)\n  &&\n  isTrue# (eqWord8# w# (indexWord8Array# ba# (len# -# 1#)))\n\n\n\n-- SPLIT\n\n\nsplit :: Word8 -> Utf8 t -> [Utf8 t]\nsplit (W8# divider#) str@(Utf8 ba#) =\n  splitHelp str 0 (findDividers divider# ba# 0# (sizeofByteArray# ba#) [])\n\n\nsplitHelp :: Utf8 t -> Int -> [Int] -> [Utf8 t]\nsplitHelp str start offsets =\n  case offsets of\n    [] ->\n      [ unsafeSlice str start (size str) ]\n\n    offset : offsets ->\n      unsafeSlice str start offset : splitHelp str (offset + 1) offsets\n\n\nfindDividers :: Word8# -> ByteArray# -> Int# -> Int# -> [Int] -> [Int]\nfindDividers divider# ba# !offset# len# revOffsets =\n  if isTrue# (offset# <# len#) then\n    findDividers divider# ba# (offset# +# 1#) len# $\n      if isTrue# (eqWord8# divider# (indexWord8Array# ba# offset#))\n      then I# offset# : revOffsets\n      else revOffsets\n  else\n    reverse revOffsets\n\n\nunsafeSlice :: Utf8 t -> Int -> Int -> Utf8 t\nunsafeSlice str start end =\n  let !len = end - start in\n  if len == 0 then\n    empty\n  else\n    runST $\n    do  mba <- newByteArray len\n        copy str start mba 0 len\n        freeze mba\n\n\n\n-- JOIN\n\n\njoin :: Word8 -> [Utf8 t] -> Utf8 t\njoin sep strings =\n  case strings of\n    [] ->\n      empty\n\n    str:strs ->\n      runST $\n      do  let !len = List.foldl' (\\w s -> w + 1 + size s) (size str) strs\n          mba <- newByteArray len\n          joinHelp sep mba 0 str strs\n          freeze mba\n\n\njoinHelp :: Word8 -> MBA s -> Int -> Utf8 t -> [Utf8 t] -> ST s ()\njoinHelp sep mba offset str strings =\n  let\n    !len = size str\n  in\n  case strings of\n    [] ->\n      copy str 0 mba offset len\n\n    s:ss ->\n      do  copy str 0 mba offset len\n          let !dotOffset = offset + len\n          writeWord8 mba dotOffset sep\n          let !newOffset = dotOffset + 1\n          joinHelp sep mba newOffset s ss\n\n\n\n-- EQUAL\n\n\ninstance Eq (Utf8 t) where\n  (==) (Utf8 ba1#) (Utf8 ba2#) =\n    let\n      !len1# = sizeofByteArray# ba1#\n      !len2# = sizeofByteArray# ba2#\n    in\n    isTrue# (len1# ==# len2#)\n    &&\n    isTrue# (0# ==# compareByteArrays# ba1# 0# ba2# 0# len1#)\n\n\n\n-- COMPARE\n--\n-- TODO: is it fine to sort by length and only compare bytes on length ties?\n--\n\ninstance Ord (Utf8 t) where\n  compare (Utf8 ba1#) (Utf8 ba2#) =\n    let\n      !len1# = sizeofByteArray# ba1#\n      !len2# = sizeofByteArray# ba2#\n      !len#  = if isTrue# (len1# <# len2#) then len1# else len2#\n      !cmp#  = compareByteArrays# ba1# 0# ba2# 0# len#\n    in\n    case () of\n      _ | isTrue# (cmp# <# 0#)     -> LT\n        | isTrue# (cmp# ># 0#)     -> GT\n        | isTrue# (len1# <# len2#) -> LT\n        | isTrue# (len1# ># len2#) -> GT\n        | True                     -> EQ\n\n\n\n-- FROM STRING\n\n\nfromChars :: [Char] -> Utf8 t\nfromChars chars =\n  runST\n  (\n    do  mba <- newByteArray (sum (map getWidth chars))\n        writeChars mba 0 chars\n  )\n\n\nwriteChars :: MBA s -> Int -> [Char] -> ST s (Utf8 t)\nwriteChars !mba !offset chars =\n  case chars of\n    [] ->\n      freeze mba\n\n    char : chars\n      | n < 0x80 ->\n          do  writeWord8 mba (offset    ) (fromIntegral n)\n              writeChars mba (offset + 1) chars\n\n      | n < 0x800 ->\n          do  writeWord8 mba (offset    ) (fromIntegral ((shiftR n 6         ) + 0xC0))\n              writeWord8 mba (offset + 1) (fromIntegral ((       n   .&. 0x3F) + 0x80))\n              writeChars mba (offset + 2) chars\n\n      | n < 0x10000 ->\n          do  writeWord8 mba (offset    ) (fromIntegral ((shiftR n 12         ) + 0xE0))\n              writeWord8 mba (offset + 1) (fromIntegral ((shiftR n  6 .&. 0x3F) + 0x80))\n              writeWord8 mba (offset + 2) (fromIntegral ((       n    .&. 0x3F) + 0x80))\n              writeChars mba (offset + 3) chars\n\n      | otherwise ->\n          do  writeWord8 mba (offset    ) (fromIntegral ((shiftR n 18         ) + 0xF0))\n              writeWord8 mba (offset + 1) (fromIntegral ((shiftR n 12 .&. 0x3F) + 0x80))\n              writeWord8 mba (offset + 2) (fromIntegral ((shiftR n  6 .&. 0x3F) + 0x80))\n              writeWord8 mba (offset + 3) (fromIntegral ((       n    .&. 0x3F) + 0x80))\n              writeChars mba (offset + 4) chars\n\n      where\n        n = Char.ord char\n\n\n{-# INLINE getWidth #-}\ngetWidth :: Char -> Int\ngetWidth char\n  | code < 0x80    = 1\n  | code < 0x800   = 2\n  | code < 0x10000 = 3\n  | otherwise      = 4\n  where\n    code = Char.ord char\n\n\n\n-- TO CHARS\n\n\ntoChars :: Utf8 t -> [Char]\ntoChars (Utf8 ba#) =\n  toCharsHelp ba# 0# (sizeofByteArray# ba#)\n\n\ntoCharsHelp :: ByteArray# -> Int# -> Int# -> [Char]\ntoCharsHelp ba# offset# len# =\n  if isTrue# (offset# >=# len#) then\n    []\n  else\n    let\n      !w# = word8ToWord# (indexWord8Array# ba# offset#)\n      !(# char, width# #)\n        | isTrue# (ltWord# w# 0xC0##) = (# C# (chr# (word2Int# w#)), 1# #)\n        | isTrue# (ltWord# w# 0xE0##) = (# chr2 ba# offset# w#, 2# #)\n        | isTrue# (ltWord# w# 0xF0##) = (# chr3 ba# offset# w#, 3# #)\n        | True                        = (# chr4 ba# offset# w#, 4# #)\n\n      !newOffset# = offset# +# width#\n    in\n    char : toCharsHelp ba# newOffset# len#\n\n\n{-# INLINE chr2 #-}\nchr2 :: ByteArray# -> Int# -> Word# -> Char\nchr2 ba# offset# firstWord# =\n  let\n    !i1# = word2Int# firstWord#\n    !i2# = word2Int# (word8ToWord# (indexWord8Array# ba# (offset# +# 1#)))\n    !c1# = uncheckedIShiftL# (i1# -# 0xC0#) 6#\n    !c2# = i2# -# 0x80#\n  in\n  C# (chr# (c1# +# c2#))\n\n\n{-# INLINE chr3 #-}\nchr3 :: ByteArray# -> Int# -> Word# -> Char\nchr3 ba# offset# firstWord# =\n  let\n    !i1# = word2Int# firstWord#\n    !i2# = word2Int# (word8ToWord# (indexWord8Array# ba# (offset# +# 1#)))\n    !i3# = word2Int# (word8ToWord# (indexWord8Array# ba# (offset# +# 2#)))\n    !c1# = uncheckedIShiftL# (i1# -# 0xE0#) 12#\n    !c2# = uncheckedIShiftL# (i2# -# 0x80#) 6#\n    !c3# = i3# -# 0x80#\n  in\n  C# (chr# (c1# +# c2# +# c3#))\n\n\n{-# INLINE chr4 #-}\nchr4 :: ByteArray# -> Int# -> Word# -> Char\nchr4 ba# offset# firstWord# =\n  let\n    !i1# = word2Int# firstWord#\n    !i2# = word2Int# (word8ToWord# (indexWord8Array# ba# (offset# +# 1#)))\n    !i3# = word2Int# (word8ToWord# (indexWord8Array# ba# (offset# +# 2#)))\n    !i4# = word2Int# (word8ToWord# (indexWord8Array# ba# (offset# +# 3#)))\n    !c1# = uncheckedIShiftL# (i1# -# 0xF0#) 18#\n    !c2# = uncheckedIShiftL# (i2# -# 0x80#) 12#\n    !c3# = uncheckedIShiftL# (i3# -# 0x80#) 6#\n    !c4# = i4# -# 0x80#\n  in\n  C# (chr# (c1# +# c2# +# c3# +# c4#))\n\n\n\n-- TO BUILDER\n\n\n{-# INLINE toBuilder #-}\ntoBuilder :: Utf8 t -> B.Builder\ntoBuilder =\n  \\bytes -> B.builder (toBuilderHelp bytes)\n\n\n{-# INLINE toBuilderHelp #-}\ntoBuilderHelp :: Utf8 t -> B.BuildStep a -> B.BuildStep a\ntoBuilderHelp !bytes@(Utf8 ba#) k =\n    go 0 (I# (sizeofByteArray# ba#))\n  where\n    go !offset !end !(B.BufferRange bOffset bEnd) =\n      let\n        !bLen = minusPtr bEnd bOffset\n        !len = end - offset\n      in\n      if len <= bLen then\n        do  copyToPtr bytes offset bOffset len\n            let !br' = B.BufferRange (plusPtr bOffset len) bEnd\n            k br'\n      else\n        do  copyToPtr bytes offset bOffset bLen\n            let !offset' = offset + bLen\n            return $ B.bufferFull 1 bEnd (go offset' end)\n\n\n\n-- TO ESCAPED BUILDER\n\n\n{-# INLINE toEscapedBuilder #-}\ntoEscapedBuilder :: Word8 -> Word8 -> Utf8 t -> B.Builder\ntoEscapedBuilder before after =\n  \\name -> B.builder (toEscapedBuilderHelp before after name)\n\n\n{-# INLINE toEscapedBuilderHelp #-}\ntoEscapedBuilderHelp :: Word8 -> Word8 -> Utf8 t -> B.BuildStep a -> B.BuildStep a\ntoEscapedBuilderHelp before after !name@(Utf8 ba#) k =\n    go 0 (I# (sizeofByteArray# ba#))\n  where\n    go !offset !len !(B.BufferRange bOffset bEnd) =\n      let\n        !bLen = minusPtr bEnd bOffset\n      in\n      if len <= bLen then\n        do  -- PERF test if writing word-by-word is faster\n            copyToPtr name offset bOffset len\n            escape before after bOffset name offset len 0\n            let !newBufferRange = B.BufferRange (plusPtr bOffset len) bEnd\n            k newBufferRange\n      else\n        do  copyToPtr name offset bOffset bLen\n            escape before after bOffset name offset bLen 0\n            let !newOffset = offset + bLen\n            let !newLength = len - bLen\n            return $ B.bufferFull 1 bEnd (go newOffset newLength)\n\n\nescape :: Word8 -> Word8 -> Ptr a -> Utf8 t -> Int -> Int -> Int -> IO ()\nescape before@(W8# before#) after ptr name@(Utf8 ba#) offset@(I# offset#) len@(I# len#) i@(I# i#) =\n  if isTrue# (i# <# len#) then\n    if isTrue# (eqWord8# before# (indexWord8Array# ba# (offset# +# i#)))\n    then\n      do  writeWordToPtr ptr i after\n          escape before after ptr name offset len (i + 1)\n    else\n      do  escape before after ptr name offset len (i + 1)\n\n  else\n    return ()\n\n\n\n-- FROM PTR\n\n\nfromPtr :: Ptr Word8 -> Ptr Word8 -> Utf8 t\nfromPtr pos end =\n  unsafeDupablePerformIO (stToIO (\n    do  let !len = minusPtr end pos\n        mba <- newByteArray len\n        copyFromPtr pos mba 0 len\n        freeze mba\n  ))\n\n\n\n-- FROM SNIPPET\n\n\nfromSnippet :: P.Snippet -> Utf8 t\nfromSnippet (P.Snippet fptr off len _ _) =\n  unsafeDupablePerformIO (stToIO (\n    do  mba <- newByteArray len\n        let !pos = plusPtr (unsafeForeignPtrToPtr fptr) off\n        copyFromPtr pos mba 0 len\n        freeze mba\n  ))\n\n\n\n-- BINARY\n\n\nputUnder256 :: Utf8 t -> Put\nputUnder256 bytes =\n  do  putWord8 (fromIntegral (size bytes))\n      putBuilder (toBuilder bytes)\n\n\ngetUnder256 :: Get (Utf8 t)\ngetUnder256 =\n  do  word <- getWord8\n      let !n = fromIntegral word\n      readN n (copyFromByteString n)\n\n\nputVeryLong :: Utf8 t -> Put\nputVeryLong bytes =\n  do  put (size bytes)\n      putBuilder (toBuilder bytes)\n\n\ngetVeryLong :: Get (Utf8 t)\ngetVeryLong =\n  do  n <- get\n      if n > 0\n        then readN n (copyFromByteString n)\n        else return empty\n\n\n\n-- COPY FROM BYTESTRING\n\n\n{-# INLINE copyFromByteString #-}\ncopyFromByteString :: Int -> B.ByteString -> Utf8 t\ncopyFromByteString len (B.PS fptr offset _) =\n  unsafeDupablePerformIO\n  (\n    do  mba <- stToIO (newByteArray len)\n        stToIO (copyFromPtr (unsafeForeignPtrToPtr fptr `plusPtr` offset) mba 0 len)\n        touchForeignPtr fptr\n        stToIO (freeze mba)\n  )\n\n\n\n-- PRIMITIVES\n\n\ndata MBA s =\n  MBA# (MutableByteArray# s)\n\n\nnewByteArray :: Int -> ST s (MBA s) -- PERF see if newPinnedByteArray for len > 256 is positive\nnewByteArray (I# len#) =\n  ST $ \\s ->\n    case newByteArray# len# s of\n      (# s, mba# #) -> (# s, MBA# mba# #)\n\n\nfreeze :: MBA s -> ST s (Utf8 t)\nfreeze (MBA# mba#) =\n  ST $ \\s ->\n    case unsafeFreezeByteArray# mba# s of\n      (# s, ba# #) -> (# s, Utf8 ba# #)\n\n\ncopy :: Utf8 t -> Int -> MBA s -> Int -> Int -> ST s ()\ncopy (Utf8 ba#) (I# offset#) (MBA# mba#) (I# i#) (I# len#) =\n  ST $ \\s ->\n    case copyByteArray# ba# offset# mba# i# len# s of\n      s -> (# s, () #)\n\n\ncopyFromPtr :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()\ncopyFromPtr (Ptr src#) (MBA# mba#) (I# offset#) (I# len#) =\n  ST $ \\s ->\n    case copyAddrToByteArray# src# mba# offset# len# s of\n      s -> (# s, () #)\n\n\ncopyToPtr :: Utf8 t -> Int -> Ptr a -> Int -> IO ()\ncopyToPtr (Utf8 ba#) (I# offset#) (Ptr mba#) (I# len#) =\n  IO $ \\s ->\n    case copyByteArrayToAddr# ba# offset# mba# len# s of\n      s -> (# s, () #)\n\n\n{-# INLINE writeWord8 #-}\nwriteWord8 :: MBA s -> Int -> Word8 -> ST s ()\nwriteWord8 (MBA# mba#) (I# offset#) (W8# w#) =\n  ST $ \\s ->\n    case writeWord8Array# mba# offset# w# s of\n      s -> (# s, () #)\n\n\n{-# INLINE writeWordToPtr #-}\nwriteWordToPtr :: Ptr a -> Int -> Word8 -> IO ()\nwriteWordToPtr (Ptr addr#) (I# offset#) (W8# word#) =\n  IO $ \\s ->\n    case writeWord8OffAddr# addr# offset# word# s of\n      s -> (# s, () #)\n"
  },
  {
    "path": "compiler/src/Elm/Compiler/Imports.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Elm.Compiler.Imports\n  ( defaults\n  )\n  where\n\n\nimport qualified Data.Name as Name\n\nimport qualified AST.Source as Src\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Annotation as A\n\n\n\n-- DEFAULTS\n\n\ndefaults :: [Src.Import]\ndefaults =\n  [ import_ ModuleName.basics Nothing Src.Open\n  , import_ ModuleName.debug Nothing closed\n  , import_ ModuleName.list Nothing (operator \"::\")\n  , import_ ModuleName.maybe Nothing (typeOpen Name.maybe)\n  , import_ ModuleName.result Nothing (typeOpen Name.result)\n  , import_ ModuleName.string Nothing (typeClosed Name.string)\n  , import_ ModuleName.char Nothing (typeClosed Name.char)\n  , import_ ModuleName.tuple Nothing closed\n  , import_ ModuleName.platform Nothing (typeClosed Name.program)\n  , import_ ModuleName.cmd (Just Name.cmd) (typeClosed Name.cmd)\n  , import_ ModuleName.sub (Just Name.sub) (typeClosed Name.sub)\n  ]\n\n\nimport_ :: ModuleName.Canonical -> Maybe Name.Name -> Src.Exposing -> Src.Import\nimport_ (ModuleName.Canonical _ name) maybeAlias exposing =\n  Src.Import (A.At A.zero name) maybeAlias exposing\n\n\n\n-- EXPOSING\n\n\nclosed :: Src.Exposing\nclosed =\n  Src.Explicit []\n\n\ntypeOpen :: Name.Name -> Src.Exposing\ntypeOpen name =\n  Src.Explicit [ Src.Upper (A.At A.zero name) (Src.Public A.zero) ]\n\n\ntypeClosed :: Name.Name -> Src.Exposing\ntypeClosed name =\n  Src.Explicit [ Src.Upper (A.At A.zero name) Src.Private ]\n\n\noperator :: Name.Name -> Src.Exposing\noperator op =\n  Src.Explicit [ Src.Operator A.zero op ]\n"
  },
  {
    "path": "compiler/src/Elm/Compiler/Type/Extract.hs",
    "content": "{-# LANGUAGE BangPatterns, OverloadedStrings, Rank2Types #-}\nmodule Elm.Compiler.Type.Extract\n  ( fromAnnotation\n  , fromType\n  , Types(..)\n  , mergeMany\n  , merge\n  , fromInterface\n  , fromDependencyInterface\n  , fromMsg\n  )\n  where\n\n\nimport Data.Map ((!))\nimport qualified Data.Map as Map\nimport qualified Data.Maybe as Maybe\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified AST.Utils.Type as Type\nimport qualified Elm.Compiler.Type as T\nimport qualified Elm.Interface as I\nimport qualified Elm.ModuleName as ModuleName\n\n\n\n-- EXTRACTION\n\n\nfromAnnotation :: Can.Annotation -> T.Type\nfromAnnotation (Can.Forall _ astType) =\n  fromType astType\n\n\nfromType :: Can.Type -> T.Type\nfromType astType =\n  snd (run (extract astType))\n\n\nextract :: Can.Type -> Extractor T.Type\nextract astType =\n  case astType of\n    Can.TLambda arg result ->\n      T.Lambda\n        <$> extract arg\n        <*> extract result\n\n    Can.TVar x ->\n      pure (T.Var x)\n\n    Can.TType home name args ->\n      addUnion (Opt.Global home name) (T.Type (toPublicName home name))\n        <*> traverse extract args\n\n    Can.TRecord fields ext ->\n      do  efields <- traverse (traverse extract) (Can.fieldsToList fields)\n          pure (T.Record efields ext)\n\n    Can.TUnit ->\n      pure T.Unit\n\n    Can.TTuple a b maybeC ->\n      T.Tuple\n        <$> extract a\n        <*> extract b\n        <*> traverse extract (Maybe.maybeToList maybeC)\n\n    Can.TAlias home name args aliasType ->\n      do  addAlias (Opt.Global home name) ()\n          _ <- extract (Type.dealias args aliasType)\n          T.Type (toPublicName home name)\n            <$> traverse (extract . snd) args\n\n\ntoPublicName :: ModuleName.Canonical -> Name.Name -> Name.Name\ntoPublicName (ModuleName.Canonical _ home) name =\n  Name.sepBy 0x2E {- . -} home name\n\n\n\n-- TRANSITIVELY AVAILABLE TYPES\n\n\nnewtype Types =\n  Types (Map.Map ModuleName.Canonical Types_)\n  -- PERF profile Opt.Global representation\n  -- current representation needs less allocation\n  -- but maybe the lookup is much worse\n\n\ndata Types_ =\n  Types_\n    { _union_info :: Map.Map Name.Name Can.Union\n    , _alias_info :: Map.Map Name.Name Can.Alias\n    }\n\n\nmergeMany :: [Types] -> Types\nmergeMany listOfTypes =\n  case listOfTypes of\n    [] -> Types Map.empty\n    t:ts -> foldr merge t ts\n\n\nmerge :: Types -> Types -> Types\nmerge (Types types1) (Types types2) =\n  Types (Map.union types1 types2)\n\n\nfromInterface :: ModuleName.Raw -> I.Interface -> Types\nfromInterface name (I.Interface pkg _ unions aliases _) =\n  Types $ Map.singleton (ModuleName.Canonical pkg name) $\n    Types_ (Map.map I.extractUnion unions) (Map.map I.extractAlias aliases)\n\n\nfromDependencyInterface :: ModuleName.Canonical -> I.DependencyInterface -> Types\nfromDependencyInterface home di =\n  Types $ Map.singleton home $\n    case di of\n      I.Public (I.Interface _ _ unions aliases _) ->\n        Types_ (Map.map I.extractUnion unions) (Map.map I.extractAlias aliases)\n\n      I.Private _ unions aliases ->\n        Types_ unions aliases\n\n\n\n-- EXTRACT MODEL, MSG, AND ANY TRANSITIVE DEPENDENCIES\n\n\nfromMsg :: Types -> Can.Type -> T.DebugMetadata\nfromMsg types message =\n  let\n    (msgDeps, msgType) =\n      run (extract message)\n\n    (aliases, unions) =\n      extractTransitive types noDeps msgDeps\n  in\n  T.DebugMetadata msgType aliases unions\n\n\nextractTransitive :: Types -> Deps -> Deps -> ( [T.Alias], [T.Union] )\nextractTransitive types (Deps seenAliases seenUnions) (Deps nextAliases nextUnions) =\n  let\n    aliases = Set.difference nextAliases seenAliases\n    unions = Set.difference nextUnions seenUnions\n  in\n    if Set.null aliases && Set.null unions then\n      ( [], [] )\n\n    else\n      let\n        (newDeps, result) =\n          run $\n            (,)\n              <$> traverse (extractAlias types) (Set.toList aliases)\n              <*> traverse (extractUnion types) (Set.toList unions)\n\n        oldDeps =\n          Deps (Set.union seenAliases nextAliases) (Set.union seenUnions nextUnions)\n\n        remainingResult =\n          extractTransitive types oldDeps newDeps\n      in\n        mappend result remainingResult\n\n\nextractAlias :: Types -> Opt.Global -> Extractor T.Alias\nextractAlias (Types dict) (Opt.Global home name) =\n  let\n    (Can.Alias args aliasType) = _alias_info (dict ! home) ! name\n  in\n  T.Alias (toPublicName home name) args <$> extract aliasType\n\n\nextractUnion :: Types -> Opt.Global -> Extractor T.Union\nextractUnion (Types dict) (Opt.Global home name) =\n  if name == Name.list && home == ModuleName.list\n    then return $ T.Union (toPublicName home name) [\"a\"] []\n    else\n      let\n        pname = toPublicName home name\n        (Can.Union vars ctors _ _) = _union_info (dict ! home) ! name\n      in\n      T.Union pname vars <$> traverse extractCtor ctors\n\n\nextractCtor :: Can.Ctor -> Extractor (Name.Name, [T.Type])\nextractCtor (Can.Ctor ctor _ _ args) =\n  (,) ctor <$> traverse extract args\n\n\n\n-- DEPS\n\n\ndata Deps =\n  Deps\n    { _aliases :: Set.Set Opt.Global\n    , _unions :: Set.Set Opt.Global\n    }\n\n\n{-# NOINLINE noDeps #-}\nnoDeps :: Deps\nnoDeps =\n  Deps Set.empty Set.empty\n\n\n\n-- EXTRACTOR\n\n\nnewtype Extractor a =\n  Extractor (\n    forall result.\n      Set.Set Opt.Global\n      -> Set.Set Opt.Global\n      -> (Set.Set Opt.Global -> Set.Set Opt.Global -> a -> result)\n      -> result\n  )\n\n\nrun :: Extractor a -> (Deps, a)\nrun (Extractor k) =\n  k Set.empty Set.empty $ \\aliases unions value ->\n    ( Deps aliases unions, value )\n\n\naddAlias :: Opt.Global -> a -> Extractor a\naddAlias alias value =\n  Extractor $ \\aliases unions ok ->\n    ok (Set.insert alias aliases) unions value\n\n\naddUnion :: Opt.Global -> a -> Extractor a\naddUnion union value =\n  Extractor $ \\aliases unions ok ->\n    ok aliases (Set.insert union unions) value\n\n\ninstance Functor Extractor where\n  fmap func (Extractor k) =\n    Extractor $ \\aliases unions ok ->\n      let\n        ok1 a1 u1 value =\n          ok a1 u1 (func value)\n      in\n      k aliases unions ok1\n\n\ninstance Applicative Extractor where\n  pure value =\n    Extractor $ \\aliases unions ok ->\n      ok aliases unions value\n\n  (<*>) (Extractor kf) (Extractor kv) =\n    Extractor $ \\aliases unions ok ->\n      let\n        ok1 a1 u1 func =\n          let\n            ok2 a2 u2 value =\n              ok a2 u2 (func value)\n          in\n          kv a1 u1 ok2\n      in\n      kf aliases unions ok1\n\n\ninstance Monad Extractor where\n  return = pure\n\n  (>>=) (Extractor ka) callback =\n    Extractor $ \\aliases unions ok ->\n      let\n        ok1 a1 u1 value =\n          case callback value of\n            Extractor kb -> kb a1 u1 ok\n      in\n      ka aliases unions ok1\n"
  },
  {
    "path": "compiler/src/Elm/Compiler/Type.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Elm.Compiler.Type\n  ( Type(..)\n  , RT.Context(..)\n  , toDoc\n  , DebugMetadata(..)\n  , Alias(..)\n  , Union(..)\n  , encode\n  , decoder\n  , encodeMetadata\n  )\n  where\n\n\nimport qualified Data.Name as Name\n\nimport qualified AST.Source as Src\nimport qualified Json.Decode as D\nimport qualified Json.Encode as E\nimport Json.Encode ((==>))\nimport qualified Json.String as Json\nimport qualified Parse.Primitives as P\nimport qualified Parse.Type as Type\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Render.Type as RT\nimport qualified Reporting.Render.Type.Localizer as L\n\n\n\n-- TYPES\n\n\ndata Type\n  = Lambda Type Type\n  | Var Name.Name\n  | Type Name.Name [Type]\n  | Record [(Name.Name, Type)] (Maybe Name.Name)\n  | Unit\n  | Tuple Type Type [Type]\n\n\ndata DebugMetadata =\n  DebugMetadata\n    { _message :: Type\n    , _aliases :: [Alias]\n    , _unions :: [Union]\n    }\n\n\ndata Alias = Alias Name.Name [Name.Name] Type\ndata Union = Union Name.Name [Name.Name] [(Name.Name, [Type])]\n\n\n\n-- TO DOC\n\n\ntoDoc :: L.Localizer -> RT.Context -> Type -> D.Doc\ntoDoc localizer context tipe =\n  case tipe of\n    Lambda _ _ ->\n      let\n        a:b:cs =\n          map (toDoc localizer RT.Func) (collectLambdas tipe)\n      in\n      RT.lambda context a b cs\n\n    Var name ->\n      D.fromName name\n\n    Unit ->\n      \"()\"\n\n    Tuple a b cs ->\n      RT.tuple\n        (toDoc localizer RT.None a)\n        (toDoc localizer RT.None b)\n        (map (toDoc localizer RT.None) cs)\n\n    Type name args ->\n      RT.apply\n        context\n        (D.fromName name)\n        (map (toDoc localizer RT.App) args)\n\n    Record fields ext ->\n      RT.record\n        (map (entryToDoc localizer) fields)\n        (fmap D.fromName ext)\n\n\nentryToDoc :: L.Localizer -> (Name.Name, Type) -> (D.Doc, D.Doc)\nentryToDoc localizer (field, fieldType) =\n  ( D.fromName field, toDoc localizer RT.None fieldType )\n\n\ncollectLambdas :: Type -> [Type]\ncollectLambdas tipe =\n  case tipe of\n    Lambda arg body ->\n      arg : collectLambdas body\n\n    _ ->\n      [tipe]\n\n\n\n-- JSON for TYPE\n\n\nencode :: Type -> E.Value\nencode tipe =\n  E.chars $ D.toLine (toDoc L.empty RT.None tipe)\n\n\ndecoder :: D.Decoder () Type\ndecoder =\n  let\n    parser =\n      P.specialize (\\_ _ _ -> ()) (fromRawType . fst <$> Type.expression)\n  in\n  D.customString parser (\\_ _ -> ())\n\n\nfromRawType :: Src.Type -> Type\nfromRawType (A.At _ astType) =\n  case astType of\n    Src.TLambda t1 t2 ->\n        Lambda (fromRawType t1) (fromRawType t2)\n\n    Src.TVar x ->\n        Var x\n\n    Src.TUnit ->\n        Unit\n\n    Src.TTuple a b cs ->\n        Tuple\n          (fromRawType a)\n          (fromRawType b)\n          (map fromRawType cs)\n\n    Src.TType _ name args ->\n        Type name (map fromRawType args)\n\n    Src.TTypeQual _ _ name args ->\n        Type name (map fromRawType args)\n\n    Src.TRecord fields ext ->\n        let fromField (A.At _ field, tipe) = (field, fromRawType tipe) in\n        Record\n          (map fromField fields)\n          (fmap A.toValue ext)\n\n\n\n-- JSON for PROGRAM\n\n\nencodeMetadata :: DebugMetadata -> E.Value\nencodeMetadata (DebugMetadata msg aliases unions) =\n  E.object\n    [ \"message\" ==> encode msg\n    , \"aliases\" ==> E.object (map toTypeAliasField aliases)\n    , \"unions\" ==> E.object (map toCustomTypeField unions)\n    ]\n\n\ntoTypeAliasField :: Alias -> ( Json.String, E.Value )\ntoTypeAliasField (Alias name args tipe) =\n  ( Json.fromName name\n  , E.object\n      [ \"args\" ==> E.list E.name args\n      , \"type\" ==> encode tipe\n      ]\n  )\n\n\ntoCustomTypeField :: Union -> ( Json.String, E.Value )\ntoCustomTypeField (Union name args constructors) =\n  ( Json.fromName name\n  , E.object\n      [ \"args\" ==> E.list E.name args\n      , \"tags\" ==> E.object (map toVariantObject constructors)\n      ]\n  )\n\n\ntoVariantObject :: (Name.Name, [Type]) -> ( Json.String, E.Value )\ntoVariantObject (name, args) =\n  ( Json.fromName name, E.list encode args )\n"
  },
  {
    "path": "compiler/src/Elm/Constraint.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Elm.Constraint\n  ( Constraint\n  , exactly\n  , anything\n  , toChars\n  , satisfies\n  , check\n  , intersect\n  , goodElm\n  , defaultElm\n  , untilNextMajor\n  , untilNextMinor\n  , expand\n  --\n  , Error(..)\n  , decoder\n  , encode\n  )\n  where\n\n\nimport Control.Monad (liftM4)\nimport Data.Binary (Binary, get, put, getWord8, putWord8)\n\nimport qualified Elm.Version as V\nimport qualified Json.Decode as D\nimport qualified Json.Encode as E\nimport qualified Parse.Primitives as P\nimport Parse.Primitives (Row, Col)\n\n\n\n-- CONSTRAINTS\n\n\ndata Constraint\n    = Range V.Version Op Op V.Version\n    deriving (Eq)\n\n\ndata Op\n  = Less\n  | LessOrEqual\n  deriving (Eq)\n\n\n\n-- COMMON CONSTRAINTS\n\n\nexactly :: V.Version -> Constraint\nexactly version =\n  Range version LessOrEqual LessOrEqual version\n\n\nanything :: Constraint\nanything =\n  Range V.one LessOrEqual LessOrEqual V.max\n\n\n\n-- TO CHARS\n\n\ntoChars :: Constraint -> [Char]\ntoChars constraint =\n  case constraint of\n    Range lower lowerOp upperOp upper ->\n      V.toChars lower ++ opToChars lowerOp ++ \"v\" ++ opToChars upperOp ++ V.toChars upper\n\n\nopToChars :: Op -> [Char]\nopToChars op =\n  case op of\n    Less        -> \" < \"\n    LessOrEqual -> \" <= \"\n\n\n\n-- IS SATISFIED\n\n\nsatisfies :: Constraint -> V.Version -> Bool\nsatisfies constraint version =\n  case constraint of\n    Range lower lowerOp upperOp upper ->\n        isLess lowerOp lower version\n          &&\n        isLess upperOp version upper\n\n\nisLess :: (Ord a) => Op -> (a -> a -> Bool)\nisLess op =\n  case op of\n    Less ->\n      (<)\n\n    LessOrEqual ->\n      (<=)\n\n\ncheck :: Constraint -> V.Version -> Ordering\ncheck constraint version =\n  case constraint of\n    Range lower lowerOp upperOp upper ->\n      if not (isLess lowerOp lower version) then\n        LT\n\n      else if not (isLess upperOp version upper) then\n        GT\n\n      else\n        EQ\n\n\n\n-- INTERSECT\n\n\nintersect :: Constraint -> Constraint -> Maybe Constraint\nintersect (Range lo lop hop hi) (Range lo_ lop_ hop_ hi_) =\n  let\n    (newLo, newLop) =\n      case compare lo lo_ of\n        LT -> (lo_, lop_)\n        EQ -> (lo, if elem Less [lop,lop_] then Less else LessOrEqual)\n        GT -> (lo, lop)\n\n    (newHi, newHop) =\n      case compare hi hi_ of\n        LT -> (hi, hop)\n        EQ -> (hi, if elem Less [hop, hop_] then Less else LessOrEqual)\n        GT -> (hi_, hop_)\n  in\n    if newLo <= newHi then\n      Just (Range newLo newLop newHop newHi)\n    else\n      Nothing\n\n\n\n-- ELM CONSTRAINT\n\n\ngoodElm :: Constraint -> Bool\ngoodElm constraint =\n  satisfies constraint V.compiler\n\n\ndefaultElm :: Constraint\ndefaultElm =\n  if V._major V.compiler > 0\n    then untilNextMajor V.compiler\n    else untilNextMinor V.compiler\n\n\n\n-- CREATE CONSTRAINTS\n\n\nuntilNextMajor :: V.Version -> Constraint\nuntilNextMajor version =\n  Range version LessOrEqual Less (V.bumpMajor version)\n\n\nuntilNextMinor :: V.Version -> Constraint\nuntilNextMinor version =\n  Range version LessOrEqual Less (V.bumpMinor version)\n\n\nexpand :: Constraint -> V.Version -> Constraint\nexpand constraint@(Range lower lowerOp upperOp upper) version\n  | version < lower =\n      Range version LessOrEqual upperOp upper\n\n  | version > upper =\n      Range lower lowerOp Less (V.bumpMajor version)\n\n  | otherwise =\n      constraint\n\n\n\n-- JSON\n\n\nencode :: Constraint -> E.Value\nencode constraint =\n  E.chars (toChars constraint)\n\n\ndecoder :: D.Decoder Error Constraint\ndecoder =\n  D.customString parser BadFormat\n\n\n\n-- BINARY\n\n\ninstance Binary Constraint where\n  get = liftM4 Range get get get get\n  put (Range a b c d) = put a >> put b >> put c >> put d\n\n\ninstance Binary Op where\n  put op =\n    case op of\n      Less        -> putWord8 0\n      LessOrEqual -> putWord8 1\n\n  get =\n    do  n <- getWord8\n        case n of\n          0 -> return Less\n          1 -> return LessOrEqual\n          _ -> fail \"binary encoding of Op was corrupted\"\n\n\n\n-- PARSER\n\n\ndata Error\n  = BadFormat Row Col\n  | InvalidRange V.Version V.Version\n\n\nparser :: P.Parser Error Constraint\nparser =\n  do  lower <- parseVersion\n      P.word1 0x20 {- -} BadFormat\n      loOp <- parseOp\n      P.word1 0x20 {- -} BadFormat\n      P.word1 0x76 {-v-} BadFormat\n      P.word1 0x20 {- -} BadFormat\n      hiOp <- parseOp\n      P.word1 0x20 {- -} BadFormat\n      higher <- parseVersion\n      P.Parser $ \\state@(P.State _ _ _ _ row col) _ eok _ eerr ->\n        if lower < higher\n        then eok (Range lower loOp hiOp higher) state\n        else eerr row col (\\_ _ -> InvalidRange lower higher)\n\n\nparseVersion :: P.Parser Error V.Version\nparseVersion =\n  P.specialize (\\(r,c) _ _ -> BadFormat r c) V.parser\n\n\nparseOp :: P.Parser Error Op\nparseOp =\n  do  P.word1 0x3C {-<-} BadFormat\n      P.oneOfWithFallback\n        [ do  P.word1 0x3D {-=-} BadFormat\n              return LessOrEqual\n        ]\n        Less\n"
  },
  {
    "path": "compiler/src/Elm/Docs.hs",
    "content": "{-# LANGUAGE BangPatterns, MultiWayIf, OverloadedStrings, UnboxedTuples #-}\nmodule Elm.Docs\n  ( Documentation\n  , Module(..)\n  , fromModule\n  , Union(..)\n  , Alias(..)\n  , Value(..)\n  , Binop(..)\n  , Binop.Associativity(..)\n  , Binop.Precedence(..)\n  , Error(..)\n  , decoder\n  , encode\n  )\n  where\n\n\nimport qualified Data.Coerce as Coerce\nimport qualified Data.List as List\nimport Data.Map ((!))\nimport qualified Data.Map as Map\nimport qualified Data.Map.Merge.Strict as Map\nimport qualified Data.Name as Name\nimport qualified Data.NonEmptyList as NE\nimport qualified Data.OneOrMore as OneOrMore\nimport Data.Word (Word8)\nimport Foreign.Ptr (Ptr, plusPtr)\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Source as Src\nimport qualified AST.Utils.Binop as Binop\nimport qualified Elm.Compiler.Type as Type\nimport qualified Elm.Compiler.Type.Extract as Extract\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Json.Decode as D\nimport qualified Json.Encode as E\nimport Json.Encode ((==>))\nimport qualified Json.String as Json\nimport Parse.Primitives (Row, Col, word1)\nimport qualified Parse.Primitives as P\nimport qualified Parse.Space as Space\nimport qualified Parse.Symbol as Symbol\nimport qualified Parse.Variable as Var\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Docs as E\nimport qualified Reporting.Result as Result\n\n\n\n-- DOCUMENTATION\n\n\ntype Documentation =\n  Map.Map Name.Name Module\n\n\ndata Module =\n  Module\n    { _name :: Name.Name\n    , _comment :: Comment\n    , _unions :: Map.Map Name.Name Union\n    , _aliases :: Map.Map Name.Name Alias\n    , _values :: Map.Map Name.Name Value\n    , _binops :: Map.Map Name.Name Binop\n    }\n\ntype Comment = Json.String\n\ndata Alias = Alias Comment [Name.Name] Type.Type\ndata Union = Union Comment [Name.Name] [(Name.Name, [Type.Type])]\ndata Value = Value Comment Type.Type\ndata Binop = Binop Comment Type.Type Binop.Associativity Binop.Precedence\n\n\n\n-- JSON\n\n\nencode :: Documentation -> E.Value\nencode docs =\n  E.list encodeModule (Map.elems docs)\n\n\nencodeModule :: Module -> E.Value\nencodeModule (Module name comment unions aliases values binops) =\n  E.object $\n    [ \"name\" ==> ModuleName.encode name\n    , \"comment\" ==> E.string comment\n    , \"unions\" ==> E.list encodeUnion (Map.toList unions)\n    , \"aliases\" ==> E.list encodeAlias (Map.toList aliases)\n    , \"values\" ==> E.list encodeValue (Map.toList values)\n    , \"binops\" ==> E.list encodeBinop (Map.toList binops)\n    ]\n\n\ndata Error\n  = BadAssociativity\n  | BadModuleName\n  | BadType\n\n\ndecoder :: D.Decoder Error Documentation\ndecoder =\n  toDict <$> D.list moduleDecoder\n\n\ntoDict :: [Module] -> Documentation\ntoDict modules =\n  Map.fromList (map toDictHelp modules)\n\n\ntoDictHelp :: Module -> (Name.Name, Module)\ntoDictHelp modul@(Module name _ _ _ _ _) =\n  (name, modul)\n\n\nmoduleDecoder :: D.Decoder Error Module\nmoduleDecoder =\n  Module\n    <$> D.field \"name\" moduleNameDecoder\n    <*> D.field \"comment\" D.string\n    <*> D.field \"unions\" (dictDecoder union)\n    <*> D.field \"aliases\" (dictDecoder alias)\n    <*> D.field \"values\" (dictDecoder value)\n    <*> D.field \"binops\" (dictDecoder binop)\n\n\ndictDecoder :: D.Decoder Error a -> D.Decoder Error (Map.Map Name.Name a)\ndictDecoder entryDecoder =\n  Map.fromList <$> D.list (named entryDecoder)\n\n\nnamed :: D.Decoder Error a -> D.Decoder Error (Name.Name, a)\nnamed entryDecoder =\n  (,)\n    <$> D.field \"name\" nameDecoder\n    <*> entryDecoder\n\n\nnameDecoder :: D.Decoder e Name.Name\nnameDecoder =\n  fmap Coerce.coerce D.string\n\n\nmoduleNameDecoder :: D.Decoder Error ModuleName.Raw\nmoduleNameDecoder =\n  D.mapError (const BadModuleName) ModuleName.decoder\n\n\ntypeDecoder :: D.Decoder Error Type.Type\ntypeDecoder =\n  D.mapError (const BadType) Type.decoder\n\n\n\n-- UNION JSON\n\n\nencodeUnion :: (Name.Name, Union) -> E.Value\nencodeUnion (name, Union comment args cases) =\n  E.object\n    [ \"name\" ==> E.name name\n    , \"comment\" ==> E.string comment\n    , \"args\" ==> E.list E.name args\n    , \"cases\" ==> E.list encodeCase cases\n    ]\n\n\nunion :: D.Decoder Error Union\nunion =\n  Union\n    <$> D.field \"comment\" D.string\n    <*> D.field \"args\" (D.list nameDecoder)\n    <*> D.field \"cases\" (D.list caseDecoder)\n\n\nencodeCase :: ( Name.Name, [Type.Type] ) -> E.Value\nencodeCase ( tag, args ) =\n  E.list id [ E.name tag, E.list Type.encode args ]\n\n\ncaseDecoder :: D.Decoder Error ( Name.Name, [Type.Type] )\ncaseDecoder =\n  D.pair nameDecoder (D.list typeDecoder)\n\n\n\n-- ALIAS JSON\n\n\nencodeAlias :: (Name.Name, Alias) -> E.Value\nencodeAlias ( name, Alias comment args tipe) =\n  E.object\n    [ \"name\" ==> E.name name\n    , \"comment\" ==> E.string comment\n    , \"args\" ==> E.list E.name args\n    , \"type\" ==> Type.encode tipe\n    ]\n\n\nalias :: D.Decoder Error Alias\nalias =\n  Alias\n    <$> D.field \"comment\" D.string\n    <*> D.field \"args\" (D.list nameDecoder)\n    <*> D.field \"type\" typeDecoder\n\n\n\n-- VALUE JSON\n\n\nencodeValue :: (Name.Name, Value) -> E.Value\nencodeValue (name, Value comment tipe) =\n  E.object\n    [ \"name\" ==> E.name name\n    , \"comment\" ==> E.string comment\n    , \"type\" ==> Type.encode tipe\n    ]\n\n\nvalue :: D.Decoder Error Value\nvalue =\n  Value\n    <$> D.field \"comment\" D.string\n    <*> D.field \"type\" typeDecoder\n\n\n\n-- BINOP JSON\n\n\nencodeBinop :: (Name.Name, Binop) -> E.Value\nencodeBinop (name, Binop comment tipe assoc prec) =\n  E.object\n    [ \"name\" ==> E.name name\n    , \"comment\" ==> E.string comment\n    , \"type\" ==> Type.encode tipe\n    , \"associativity\" ==> encodeAssoc assoc\n    , \"precedence\" ==> encodePrec prec\n    ]\n\n\nbinop :: D.Decoder Error Binop\nbinop =\n  Binop\n    <$> D.field \"comment\" D.string\n    <*> D.field \"type\" typeDecoder\n    <*> D.field \"associativity\" assocDecoder\n    <*> D.field \"precedence\" precDecoder\n\n\n\n-- ASSOCIATIVITY JSON\n\n\nencodeAssoc :: Binop.Associativity -> E.Value\nencodeAssoc assoc =\n  case assoc of\n    Binop.Left  -> E.chars \"left\"\n    Binop.Non   -> E.chars \"non\"\n    Binop.Right -> E.chars \"right\"\n\n\nassocDecoder :: D.Decoder Error Binop.Associativity\nassocDecoder =\n  let\n    left  = Json.fromChars \"left\"\n    non   = Json.fromChars \"non\"\n    right = Json.fromChars \"right\"\n  in\n  do  str <- D.string\n      if  | str == left  -> return Binop.Left\n          | str == non   -> return Binop.Non\n          | str == right -> return Binop.Right\n          | otherwise    -> D.failure BadAssociativity\n\n\n\n-- PRECEDENCE JSON\n\n\nencodePrec :: Binop.Precedence -> E.Value\nencodePrec (Binop.Precedence n) =\n  E.int n\n\n\nprecDecoder :: D.Decoder Error Binop.Precedence\nprecDecoder =\n  Binop.Precedence <$> D.int\n\n\n\n-- FROM MODULE\n\n\nfromModule :: Can.Module -> Either E.Error Module\nfromModule modul@(Can.Module _ exports docs _ _ _ _ _) =\n  case exports of\n    Can.ExportEverything region ->\n      Left (E.ImplicitExposing region)\n\n    Can.Export exportDict ->\n      case docs of\n        Src.NoDocs region ->\n          Left (E.NoDocs region)\n\n        Src.YesDocs overview comments ->\n          do  names <- parseOverview overview\n              checkNames exportDict names\n              checkDefs exportDict overview (Map.fromList comments) modul\n\n\n\n-- PARSE OVERVIEW\n\n\nparseOverview :: Src.Comment -> Either E.Error [A.Located Name.Name]\nparseOverview (Src.Comment snippet) =\n  case P.fromSnippet (chompOverview []) E.BadEnd snippet of\n    Left err ->\n      Left (E.SyntaxProblem err)\n\n    Right names ->\n      Right names\n\n\ntype Parser a =\n  P.Parser E.SyntaxProblem a\n\n\nchompOverview :: [A.Located Name.Name] -> Parser [A.Located Name.Name]\nchompOverview names =\n  do  isDocs <- chompUntilDocs\n      if isDocs\n        then\n          do  Space.chomp E.Space\n              chompOverview =<< chompDocs names\n        else\n          return names\n\n\nchompDocs :: [A.Located Name.Name] -> Parser [A.Located Name.Name]\nchompDocs names =\n  do  name <-\n        P.addLocation $\n          P.oneOf E.Name\n            [ Var.lower E.Name\n            , Var.upper E.Name\n            , chompOperator\n            ]\n\n      Space.chomp E.Space\n\n      P.oneOfWithFallback\n        [ do  pos <- P.getPosition\n              Space.checkIndent pos E.Comma\n              word1 0x2C {-,-} E.Comma\n              Space.chomp E.Space\n              chompDocs (name:names)\n        ]\n        (name:names)\n\n\nchompOperator :: Parser Name.Name\nchompOperator =\n  do  word1 0x28 {-(-} E.Op\n      op <- Symbol.operator E.Op E.OpBad\n      word1 0x29 {-)-} E.Op\n      return op\n\n\n-- TODO add rule that @docs must be after newline in 0.20\n--\nchompUntilDocs :: Parser Bool\nchompUntilDocs =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ _ ->\n    let\n      (# isDocs, newPos, newRow, newCol #) = untilDocs pos end row col\n      !newState = P.State src newPos end indent newRow newCol\n    in\n    cok isDocs newState\n\n\nuntilDocs :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Bool, Ptr Word8, Row, Col #)\nuntilDocs pos end row col =\n  if pos >= end then\n    (# False, pos, row, col #)\n  else\n    let !word = P.unsafeIndex pos in\n    if word == 0x0A {-\\n-} then\n      untilDocs (plusPtr pos 1) end (row + 1) 1\n    else\n      let !pos5 = plusPtr pos 5 in\n      if pos5 <= end\n        && P.unsafeIndex (        pos  ) == 0x40 {-@-}\n        && P.unsafeIndex (plusPtr pos 1) == 0x64 {-d-}\n        && P.unsafeIndex (plusPtr pos 2) == 0x6F {-o-}\n        && P.unsafeIndex (plusPtr pos 3) == 0x63 {-c-}\n        && P.unsafeIndex (plusPtr pos 4) == 0x73 {-s-}\n        && Var.getInnerWidth pos5 end == 0\n      then\n        (# True, pos5, row, col + 5 #)\n      else\n        let !newPos = plusPtr pos (P.getCharWidth word) in\n        untilDocs newPos end row (col + 1)\n\n\n\n-- CHECK NAMES\n\n\ncheckNames :: Map.Map Name.Name (A.Located Can.Export) -> [A.Located Name.Name] -> Either E.Error ()\ncheckNames exports names =\n  let\n    docs       = List.foldl' addName Map.empty names\n    loneDoc    = Map.traverseMissing onlyInDocs\n    loneExport = Map.traverseMissing onlyInExports\n    checkBoth  = Map.zipWithAMatched (\\n _ r -> isUnique n r)\n  in\n  case Result.run (Map.mergeA loneExport loneDoc checkBoth exports docs) of\n    (_, Right _) -> Right ()\n    (_, Left es) -> Left (E.NameProblems (OneOrMore.destruct NE.List es))\n\n\ntype DocNameRegions =\n  Map.Map Name.Name (OneOrMore.OneOrMore A.Region)\n\n\naddName :: DocNameRegions -> A.Located Name.Name -> DocNameRegions\naddName dict (A.At region name) =\n  Map.insertWith OneOrMore.more name (OneOrMore.one region) dict\n\n\nisUnique :: Name.Name -> OneOrMore.OneOrMore A.Region -> Result.Result i w E.NameProblem A.Region\nisUnique name regions =\n  case regions of\n    OneOrMore.One region ->\n      Result.ok region\n\n    OneOrMore.More left right ->\n      let (r1, r2) = OneOrMore.getFirstTwo left right in\n      Result.throw (E.NameDuplicate name r1 r2)\n\n\nonlyInDocs :: Name.Name -> OneOrMore.OneOrMore A.Region -> Result.Result i w E.NameProblem a\nonlyInDocs name regions =\n  do  region <- isUnique name regions\n      Result.throw $ E.NameOnlyInDocs name region\n\n\nonlyInExports :: Name.Name -> A.Located Can.Export -> Result.Result i w E.NameProblem a\nonlyInExports name (A.At region _) =\n  Result.throw $ E.NameOnlyInExports name region\n\n\n\n-- CHECK DEFS\n\n\ncheckDefs :: Map.Map Name.Name (A.Located Can.Export) -> Src.Comment -> Map.Map Name.Name Src.Comment -> Can.Module -> Either E.Error Module\ncheckDefs exportDict overview comments (Can.Module name _ _ decls unions aliases infixes effects) =\n  let\n    types = gatherTypes decls Map.empty\n    info = Info comments types unions aliases infixes effects\n  in\n  case Result.run (Map.traverseWithKey (checkExport info) exportDict) of\n    (_, Left  problems ) -> Left  $ E.DefProblems (OneOrMore.destruct NE.List problems)\n    (_, Right inserters) -> Right $ foldr ($) (emptyModule name overview) inserters\n\n\nemptyModule :: ModuleName.Canonical -> Src.Comment -> Module\nemptyModule (ModuleName.Canonical _ name) (Src.Comment overview) =\n  Module name (Json.fromComment overview) Map.empty Map.empty Map.empty Map.empty\n\n\ndata Info =\n  Info\n    { _iComments :: Map.Map Name.Name Src.Comment\n    , _iValues   :: Map.Map Name.Name (Either A.Region Can.Type)\n    , _iUnions   :: Map.Map Name.Name Can.Union\n    , _iAliases  :: Map.Map Name.Name Can.Alias\n    , _iBinops   :: Map.Map Name.Name Can.Binop\n    , _iEffects  :: Can.Effects\n    }\n\n\ncheckExport :: Info -> Name.Name -> A.Located Can.Export -> Result.Result i w E.DefProblem (Module -> Module)\ncheckExport info name (A.At region export) =\n  case export of\n    Can.ExportValue ->\n      do  tipe <- getType name info\n          comment <- getComment region name info\n          Result.ok $ \\m ->\n            m { _values = Map.insert name (Value comment tipe) (_values m) }\n\n    Can.ExportBinop ->\n      do  let (Can.Binop_ assoc prec realName) = _iBinops info ! name\n          tipe <- getType realName info\n          comment <- getComment region realName info\n          Result.ok $ \\m ->\n            m { _binops = Map.insert name (Binop comment tipe assoc prec) (_binops m) }\n\n    Can.ExportAlias ->\n      do  let (Can.Alias tvars tipe) = _iAliases info ! name\n          comment <- getComment region name info\n          Result.ok $ \\m ->\n            m { _aliases = Map.insert name (Alias comment tvars (Extract.fromType tipe)) (_aliases m) }\n\n    Can.ExportUnionOpen ->\n      do  let (Can.Union tvars ctors _ _) = _iUnions info ! name\n          comment <- getComment region name info\n          Result.ok $ \\m ->\n            m { _unions = Map.insert name (Union comment tvars (map dector ctors)) (_unions m) }\n\n    Can.ExportUnionClosed ->\n      do  let (Can.Union tvars _ _ _) = _iUnions info ! name\n          comment <- getComment region name info\n          Result.ok $ \\m ->\n            m { _unions = Map.insert name (Union comment tvars []) (_unions m) }\n\n    Can.ExportPort ->\n      do  tipe <- getType name info\n          comment <- getComment region name info\n          Result.ok $ \\m ->\n            m { _values = Map.insert name (Value comment tipe) (_values m) }\n\n\ngetComment :: A.Region -> Name.Name -> Info -> Result.Result i w E.DefProblem Comment\ngetComment region name info =\n  case Map.lookup name (_iComments info) of\n    Nothing ->\n      Result.throw (E.NoComment name region)\n\n    Just (Src.Comment snippet) ->\n      Result.ok (Json.fromComment snippet)\n\n\ngetType :: Name.Name -> Info -> Result.Result i w E.DefProblem Type.Type\ngetType name info =\n  case _iValues info ! name of\n    Left region ->\n      Result.throw (E.NoAnnotation name region)\n\n    Right tipe ->\n      Result.ok (Extract.fromType tipe)\n\n\ndector :: Can.Ctor -> (Name.Name, [Type.Type])\ndector (Can.Ctor name _ _ args) =\n  ( name, map Extract.fromType args )\n\n\n\n-- GATHER TYPES\n\n\ntype Types =\n  Map.Map Name.Name (Either A.Region Can.Type)\n\n\ngatherTypes :: Can.Decls -> Types -> Types\ngatherTypes decls types =\n  case decls of\n    Can.Declare def subDecls ->\n      gatherTypes subDecls (addDef types def)\n\n    Can.DeclareRec def defs subDecls ->\n      gatherTypes subDecls (List.foldl' addDef (addDef types def) defs)\n\n    Can.SaveTheEnvironment ->\n      types\n\n\naddDef :: Types -> Can.Def -> Types\naddDef types def =\n  case def of\n    Can.Def (A.At region name) _ _ ->\n      Map.insert name (Left region) types\n\n    Can.TypedDef (A.At _ name) _ typedArgs _ resultType ->\n      let\n        tipe = foldr Can.TLambda resultType (map snd typedArgs)\n      in\n      Map.insert name (Right tipe) types\n"
  },
  {
    "path": "compiler/src/Elm/Float.hs",
    "content": "{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-}\nmodule Elm.Float\n  ( Float\n  , fromPtr\n  , toBuilder\n  )\n  where\n\n\nimport Prelude hiding (Float)\nimport Data.Binary (Binary, get, put)\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.Utf8 as Utf8\nimport Data.Word (Word8)\nimport Foreign.Ptr (Ptr)\n\n\n\n-- FLOATS\n\n\ntype Float =\n  Utf8.Utf8 ELM_FLOAT\n\n\ndata ELM_FLOAT\n\n\n\n-- HELPERS\n\n\nfromPtr :: Ptr Word8 -> Ptr Word8 -> Float\nfromPtr =\n  Utf8.fromPtr\n\n\n{-# INLINE toBuilder #-}\ntoBuilder :: Float -> B.Builder\ntoBuilder =\n  Utf8.toBuilder\n\n\n\n-- BINARY\n\n\ninstance Binary (Utf8.Utf8 ELM_FLOAT) where\n  get = Utf8.getUnder256\n  put = Utf8.putUnder256\n"
  },
  {
    "path": "compiler/src/Elm/Interface.hs",
    "content": "module Elm.Interface\n  ( Interface(..)\n  , Union(..)\n  , Alias(..)\n  , Binop(..)\n  , fromModule\n  , toPublicUnion\n  , toPublicAlias\n  , DependencyInterface(..)\n  , public\n  , private\n  , privatize\n  , extractUnion\n  , extractAlias\n  )\n  where\n\n\nimport Control.Monad (liftM, liftM3, liftM4, liftM5)\nimport Data.Binary\nimport Data.Map.Strict ((!))\nimport qualified Data.Map.Strict as Map\nimport qualified Data.Map.Merge.Strict as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Utils.Binop as Binop\nimport qualified Elm.Package as Pkg\nimport qualified Reporting.Annotation as A\n\n\n\n-- INTERFACE\n\n\ndata Interface =\n  Interface\n    { _home    :: Pkg.Name\n    , _values  :: Map.Map Name.Name Can.Annotation\n    , _unions  :: Map.Map Name.Name Union\n    , _aliases :: Map.Map Name.Name Alias\n    , _binops  :: Map.Map Name.Name Binop\n    }\n  deriving (Eq)\n\n\ndata Union\n  = OpenUnion Can.Union\n  | ClosedUnion Can.Union\n  | PrivateUnion Can.Union\n  deriving (Eq)\n\n\ndata Alias\n  = PublicAlias Can.Alias\n  | PrivateAlias Can.Alias\n  deriving (Eq)\n\n\ndata Binop =\n  Binop\n    { _op_name :: Name.Name\n    , _op_annotation :: Can.Annotation\n    , _op_associativity :: Binop.Associativity\n    , _op_precedence :: Binop.Precedence\n    }\n  deriving (Eq)\n\n\n\n-- FROM MODULE\n\n\nfromModule :: Pkg.Name -> Can.Module -> Map.Map Name.Name Can.Annotation -> Interface\nfromModule home (Can.Module _ exports _ _ unions aliases binops _) annotations =\n  Interface\n    { _home = home\n    , _values = restrict exports annotations\n    , _unions = restrictUnions exports unions\n    , _aliases = restrictAliases exports aliases\n    , _binops = restrict exports (Map.map (toOp annotations) binops)\n    }\n\n\nrestrict :: Can.Exports -> Map.Map Name.Name a -> Map.Map Name.Name a\nrestrict exports dict =\n  case exports of\n    Can.ExportEverything _ ->\n      dict\n\n    Can.Export explicitExports ->\n      Map.intersection dict explicitExports\n\n\ntoOp :: Map.Map Name.Name Can.Annotation -> Can.Binop -> Binop\ntoOp types (Can.Binop_ associativity precedence name) =\n  Binop name (types ! name) associativity precedence\n\n\nrestrictUnions :: Can.Exports -> Map.Map Name.Name Can.Union -> Map.Map Name.Name Union\nrestrictUnions exports unions =\n  case exports of\n    Can.ExportEverything _ ->\n      Map.map OpenUnion unions\n\n    Can.Export explicitExports ->\n        Map.merge onLeft onRight onBoth explicitExports unions\n      where\n        onLeft = Map.dropMissing\n        onRight = Map.mapMissing (\\_ union -> PrivateUnion union)\n        onBoth = Map.zipWithMatched $ \\_ (A.At _ export) union ->\n          case export of\n            Can.ExportUnionOpen -> OpenUnion union\n            Can.ExportUnionClosed -> ClosedUnion union\n            _ -> error \"impossible exports discovered in restrictUnions\"\n\n\nrestrictAliases :: Can.Exports -> Map.Map Name.Name Can.Alias -> Map.Map Name.Name Alias\nrestrictAliases exports aliases =\n  case exports of\n    Can.ExportEverything _ ->\n      Map.map PublicAlias aliases\n\n    Can.Export explicitExports ->\n        Map.merge onLeft onRight onBoth explicitExports aliases\n      where\n        onLeft = Map.dropMissing\n        onRight = Map.mapMissing (\\_ a -> PrivateAlias a)\n        onBoth = Map.zipWithMatched (\\_ _ a -> PublicAlias a)\n\n\n\n-- TO PUBLIC\n\n\ntoPublicUnion :: Union -> Maybe Can.Union\ntoPublicUnion iUnion =\n  case iUnion of\n    OpenUnion union                       -> Just union\n    ClosedUnion (Can.Union vars _ _ opts) -> Just (Can.Union vars [] 0 opts)\n    PrivateUnion _                        -> Nothing\n\n\ntoPublicAlias :: Alias -> Maybe Can.Alias\ntoPublicAlias iAlias =\n  case iAlias of\n    PublicAlias alias -> Just alias\n    PrivateAlias _    -> Nothing\n\n\n\n-- DEPENDENCY INTERFACE\n\n\ndata DependencyInterface\n  = Public Interface\n  | Private\n      Pkg.Name\n      (Map.Map Name.Name Can.Union)\n      (Map.Map Name.Name Can.Alias)\n\n\npublic :: Interface -> DependencyInterface\npublic =\n  Public\n\n\nprivate :: Interface -> DependencyInterface\nprivate (Interface pkg _ unions aliases _) =\n  Private pkg (Map.map extractUnion unions) (Map.map extractAlias aliases)\n\n\nextractUnion :: Union -> Can.Union\nextractUnion iUnion =\n  case iUnion of\n    OpenUnion union -> union\n    ClosedUnion union -> union\n    PrivateUnion union -> union\n\n\nextractAlias :: Alias -> Can.Alias\nextractAlias iAlias =\n  case iAlias of\n    PublicAlias alias -> alias\n    PrivateAlias alias -> alias\n\n\nprivatize :: DependencyInterface -> DependencyInterface\nprivatize di =\n  case di of\n    Public i -> private i\n    Private _ _ _ -> di\n\n\n\n-- BINARY\n\n\ninstance Binary Interface where\n  get = liftM5 Interface get get get get get\n  put (Interface a b c d e) = put a >> put b >> put c >> put d >> put e\n\n\ninstance Binary Union where\n  put union =\n    case union of\n      OpenUnion    u -> putWord8 0 >> put u\n      ClosedUnion  u -> putWord8 1 >> put u\n      PrivateUnion u -> putWord8 2 >> put u\n\n  get =\n    do  n <- getWord8\n        case n of\n          0 -> liftM OpenUnion get\n          1 -> liftM ClosedUnion get\n          2 -> liftM PrivateUnion get\n          _ -> fail \"binary encoding of Union was corrupted\"\n\n\ninstance Binary Alias where\n  put union =\n    case union of\n      PublicAlias  a -> putWord8 0 >> put a\n      PrivateAlias a -> putWord8 1 >> put a\n\n  get =\n    do  n <- getWord8\n        case n of\n          0 -> liftM PublicAlias get\n          1 -> liftM PrivateAlias get\n          _ -> fail \"binary encoding of Alias was corrupted\"\n\n\ninstance Binary Binop where\n  get =\n    liftM4 Binop get get get get\n\n  put (Binop a b c d) =\n    put a >> put b >> put c >> put d\n\n\ninstance Binary DependencyInterface where\n  put union =\n    case union of\n      Public  a     -> putWord8 0 >> put a\n      Private a b c -> putWord8 1 >> put a >> put b >> put c\n\n  get =\n    do  n <- getWord8\n        case n of\n          0 -> liftM  Public get\n          1 -> liftM3 Private get get get\n          _ -> fail \"binary encoding of DependencyInterface was corrupted\"\n"
  },
  {
    "path": "compiler/src/Elm/Kernel.hs",
    "content": "{-# LANGUAGE BangPatterns, EmptyDataDecls, OverloadedStrings, UnboxedTuples #-}\nmodule Elm.Kernel\n  ( Content(..)\n  , Chunk(..)\n  , fromByteString\n  , countFields\n  )\n  where\n\n\nimport Control.Monad (liftM, liftM2)\nimport Data.Binary (Binary, get, put, getWord8, putWord8)\nimport qualified Data.ByteString.Internal as B\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport Data.Word (Word8)\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr)\nimport Foreign.ForeignPtr (ForeignPtr)\nimport Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)\n\nimport qualified AST.Source as Src\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Parse.Module as Module\nimport qualified Parse.Space as Space\nimport qualified Parse.Variable as Var\nimport Parse.Primitives hiding (fromByteString)\nimport qualified Parse.Primitives as P\nimport qualified Reporting.Annotation as A\n\n\n\n-- CHUNK\n\n\ndata Chunk\n  = JS B.ByteString\n  | ElmVar ModuleName.Canonical Name.Name\n  | JsVar Name.Name Name.Name\n  | ElmField Name.Name\n  | JsField Int\n  | JsEnum Int\n  | Debug\n  | Prod\n\n\n\n-- COUNT FIELDS\n\n\ncountFields :: [Chunk] -> Map.Map Name.Name Int\ncountFields chunks =\n  foldr addField Map.empty chunks\n\n\naddField :: Chunk -> Map.Map Name.Name Int -> Map.Map Name.Name Int\naddField chunk fields =\n  case chunk of\n    JS _       -> fields\n    ElmVar _ _ -> fields\n    JsVar _ _  -> fields\n    ElmField f -> Map.insertWith (+) f 1 fields\n    JsField _  -> fields\n    JsEnum _   -> fields\n    Debug      -> fields\n    Prod       -> fields\n\n\n\n-- FROM FILE\n\n\ndata Content =\n  Content [Src.Import] [Chunk]\n\n\ntype Foreigns =\n  Map.Map ModuleName.Raw Pkg.Name\n\n\nfromByteString :: Pkg.Name -> Foreigns -> B.ByteString -> Maybe Content\nfromByteString pkg foreigns bytes =\n  case P.fromByteString (parser pkg foreigns) toError bytes of\n    Right content ->\n      Just content\n\n    Left () ->\n      Nothing\n\n\nparser :: Pkg.Name -> Foreigns -> Parser () Content\nparser pkg foreigns =\n  do  word2 0x2F 0x2A {-/*-} toError\n      Space.chomp ignoreError\n      Space.checkFreshLine toError\n      imports <- specialize ignoreError (Module.chompImports [])\n      word2 0x2A 0x2F {-*/-} toError\n      chunks <- parseChunks (toVarTable pkg foreigns imports) Map.empty Map.empty\n      return (Content imports chunks)\n\n\ntoError :: Row -> Col -> ()\ntoError _ _ =\n  ()\n\n\nignoreError :: a -> Row -> Col -> ()\nignoreError _ _ _ =\n  ()\n\n\n\n-- PARSE CHUNKS\n\n\nparseChunks :: VarTable -> Enums -> Fields -> Parser () [Chunk]\nparseChunks vtable enums fields =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr _ ->\n    let\n      (# chunks, newPos, newRow, newCol #) =\n        chompChunks vtable enums fields src pos end row col pos []\n    in\n    if newPos == end then\n      cok chunks (P.State src newPos end indent newRow newCol)\n    else\n      cerr row col toError\n\n\nchompChunks :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Row, Col #)\nchompChunks vs es fs src pos end row col lastPos revChunks =\n  if pos >= end then\n    let !js = toByteString src lastPos end in\n    (# reverse (JS js : revChunks), pos, row, col #)\n\n  else\n    let !word = unsafeIndex pos in\n    if word == 0x5F {-_-} then\n      let\n        !pos1 = plusPtr pos 1\n        !pos3 = plusPtr pos 3\n      in\n      if pos3 <= end && unsafeIndex pos1 == 0x5F {-_-} then\n        let !js = toByteString src lastPos pos in\n        chompTag vs es fs src pos3 end row (col + 3) (JS js : revChunks)\n      else\n        chompChunks vs es fs src pos1 end row (col + 1) lastPos revChunks\n\n    else if word == 0x0A {-\\n-} then\n      chompChunks vs es fs src (plusPtr pos 1) end (row + 1) 1 lastPos revChunks\n\n    else\n      let\n        !newPos = plusPtr pos (getCharWidth word)\n      in\n      chompChunks vs es fs src newPos end row (col + 1) lastPos revChunks\n\n\ntoByteString :: ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> B.ByteString\ntoByteString src pos end =\n  let\n    !off = minusPtr pos (unsafeForeignPtrToPtr src)\n    !len = minusPtr end pos\n  in\n  B.PS src off len\n\n\n\n-- relies on external checks in chompChunks\nchompTag :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> [Chunk] -> (# [Chunk], Ptr Word8, Row, Col #)\nchompTag vs es fs src pos end row col revChunks =\n  let\n    (# newPos, newCol #) = Var.chompInnerChars pos end col\n    !tagPos = plusPtr pos (-1)\n    !word = unsafeIndex tagPos\n  in\n  if word == 0x24 {-$-} then\n    let\n      !name = Name.fromPtr pos newPos\n    in\n    chompChunks vs es fs src newPos end row newCol newPos $\n      ElmField name : revChunks\n  else\n    let\n      !name = Name.fromPtr tagPos newPos\n    in\n    if 0x30 {-0-} <= word && word <= 0x39 {-9-} then\n      let\n        (enum, newEnums) =\n          lookupEnum (word - 0x30) name es\n      in\n      chompChunks vs newEnums fs src newPos end row newCol newPos $\n        JsEnum enum : revChunks\n\n    else if 0x61 {-a-} <= word && word <= 0x7A {-z-} then\n      let\n        (field, newFields) =\n          lookupField name fs\n      in\n      chompChunks vs es newFields src newPos end row newCol newPos $\n        JsField field : revChunks\n\n    else if name == \"DEBUG\" then\n      chompChunks vs es fs src newPos end row newCol newPos (Debug : revChunks)\n\n    else if name == \"PROD\" then\n      chompChunks vs es fs src newPos end row newCol newPos (Prod : revChunks)\n\n    else\n      case Map.lookup name vs of\n        Just chunk ->\n          chompChunks vs es fs src newPos end row newCol newPos (chunk : revChunks)\n\n        Nothing ->\n          (# revChunks, pos, row, col #)\n\n\n\n-- FIELDS\n\n\ntype Fields =\n  Map.Map Name.Name Int\n\n\nlookupField :: Name.Name -> Fields -> (Int, Fields)\nlookupField name fields =\n  case Map.lookup name fields of\n    Just n ->\n      ( n, fields )\n\n    Nothing ->\n      let n = Map.size fields in\n      ( n, Map.insert name n fields )\n\n\n\n-- ENUMS\n\n\ntype Enums =\n  Map.Map Word8 (Map.Map Name.Name Int)\n\n\nlookupEnum :: Word8 -> Name.Name -> Enums -> (Int, Enums)\nlookupEnum word var allEnums =\n  let\n    enums =\n      Map.findWithDefault Map.empty word allEnums\n  in\n    case Map.lookup var enums of\n      Just n ->\n        ( n, allEnums )\n\n      Nothing ->\n        let n = Map.size enums in\n        ( n, Map.insert word (Map.insert var n enums) allEnums )\n\n\n\n-- PROCESS IMPORTS\n\n\ntype VarTable =\n  Map.Map Name.Name Chunk\n\n\ntoVarTable :: Pkg.Name -> Foreigns -> [Src.Import] -> VarTable\ntoVarTable pkg foreigns imports =\n  List.foldl' (addImport pkg foreigns) Map.empty imports\n\n\naddImport :: Pkg.Name -> Foreigns -> VarTable -> Src.Import -> VarTable\naddImport pkg foreigns vtable (Src.Import (A.At _ importName) maybeAlias exposing) =\n  if Name.isKernel importName then\n    case maybeAlias of\n      Just _ ->\n        error (\"cannot use `as` with kernel import of: \" ++ Name.toChars importName)\n\n      Nothing ->\n        let\n          home = Name.getKernel importName\n          add table name =\n            Map.insert (Name.sepBy 0x5F {-_-} home name) (JsVar home name) table\n        in\n        List.foldl' add vtable (toNames exposing)\n\n  else\n    let\n      home = ModuleName.Canonical (Map.findWithDefault pkg importName foreigns) importName\n      prefix = toPrefix importName maybeAlias\n      add table name =\n        Map.insert (Name.sepBy 0x5F {-_-} prefix name) (ElmVar home name) table\n    in\n    List.foldl' add vtable (toNames exposing)\n\n\ntoPrefix :: Name.Name -> Maybe Name.Name -> Name.Name\ntoPrefix home maybeAlias =\n  case maybeAlias of\n    Just alias ->\n      alias\n\n    Nothing ->\n      if Name.hasDot home then\n        error (\"kernel imports with dots need an alias: \" ++ show (Name.toChars home))\n      else\n        home\n\n\ntoNames :: Src.Exposing -> [Name.Name]\ntoNames exposing =\n  case exposing of\n    Src.Open ->\n      error \"cannot have `exposing (..)` in kernel code.\"\n\n    Src.Explicit exposedList ->\n      map toName exposedList\n\n\ntoName :: Src.Exposed -> Name.Name\ntoName exposed =\n  case exposed of\n    Src.Lower (A.At _ name) ->\n      name\n\n    Src.Upper (A.At _ name) Src.Private ->\n      name\n\n    Src.Upper _ (Src.Public _) ->\n      error \"cannot have Maybe(..) syntax in kernel code header\"\n\n    Src.Operator _ _ ->\n      error \"cannot use binops in kernel code\"\n\n\n\n-- BINARY\n\n\ninstance Binary Chunk where\n  put chunk =\n    case chunk of\n      JS a       -> putWord8 0 >> put a\n      ElmVar a b -> putWord8 1 >> put a >> put b\n      JsVar a b  -> putWord8 2 >> put a >> put b\n      ElmField a -> putWord8 3 >> put a\n      JsField a  -> putWord8 4 >> put a\n      JsEnum a   -> putWord8 5 >> put a\n      Debug      -> putWord8 6\n      Prod       -> putWord8 7\n\n  get =\n    do  word <- getWord8\n        case word of\n          0 -> liftM  JS get\n          1 -> liftM2 ElmVar get get\n          2 -> liftM2 JsVar get get\n          3 -> liftM  ElmField get\n          4 -> liftM  JsField get\n          5 -> liftM  JsEnum get\n          6 -> return Debug\n          7 -> return Prod\n          _ -> error \"problem deserializing Elm.Kernel.Chunk\"\n"
  },
  {
    "path": "compiler/src/Elm/Licenses.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Elm.Licenses\n  ( License\n  , bsd3\n  , encode\n  , decoder\n  )\n  where\n\n\nimport qualified Data.Map as Map\nimport qualified Data.Utf8 as Utf8\n\nimport qualified Json.Decode as D\nimport qualified Json.Encode as E\nimport qualified Json.String as Json\nimport qualified Reporting.Suggest as Suggest\n\n\n\n-- LICENCES\n\n\nnewtype License =\n  License Json.String\n\n\nbsd3 :: License\nbsd3 =\n  License (Json.fromChars \"BSD-3-Clause\")\n\n\nencode :: License -> E.Value\nencode (License code) =\n  E.string code\n\n\ndecoder :: (Json.String -> [Json.String] -> e) -> D.Decoder e License\ndecoder toError =\n  do  str <- D.string\n      case check str of\n        Right license ->\n          return license\n\n        Left suggestions ->\n          D.failure (toError str suggestions)\n\n\n\n-- CHECK\n\n\ncheck :: Json.String -> Either [Json.String] License\ncheck givenCode =\n  if Map.member givenCode osiApprovedSpdxLicenses then\n    Right (License givenCode)\n\n  else\n    let\n      pairs =\n        map (\\code -> (code, Json.toChars code)) (Map.keys osiApprovedSpdxLicenses)\n        ++\n        Map.toList osiApprovedSpdxLicenses\n    in\n    Left $ map fst $ take 4 $\n      Suggest.sort (Utf8.toChars givenCode) snd pairs\n\n\n\n-- LIST OF LICENCES\n\n\n(==>) :: [Char] -> [Char] -> (Json.String, [Char])\n(==>) code fullName =\n  ( Json.fromChars code, fullName )\n\n\n--\n-- OSI approved licenses in SPDX format.\n-- <https://spdx.org/licenses/>\n--\nosiApprovedSpdxLicenses :: Map.Map Json.String [Char]\nosiApprovedSpdxLicenses =\n  Map.fromList\n    [ \"0BSD\" ==> \"BSD Zero Clause License\"\n    , \"AAL\" ==> \"Attribution Assurance License\"\n    , \"AFL-1.1\" ==> \"Academic Free License v1.1\"\n    , \"AFL-1.2\" ==> \"Academic Free License v1.2\"\n    , \"AFL-2.0\" ==> \"Academic Free License v2.0\"\n    , \"AFL-2.1\" ==> \"Academic Free License v2.1\"\n    , \"AFL-3.0\" ==> \"Academic Free License v3.0\"\n    , \"AGPL-3.0\" ==> \"GNU Affero General Public License v3.0\"\n    , \"Apache-1.1\" ==> \"Apache License 1.1\"\n    , \"Apache-2.0\" ==> \"Apache License 2.0\"\n    , \"APL-1.0\" ==> \"Adaptive Public License 1.0\"\n    , \"APSL-1.0\" ==> \"Apple Public Source License 1.0\"\n    , \"APSL-1.1\" ==> \"Apple Public Source License 1.1\"\n    , \"APSL-1.2\" ==> \"Apple Public Source License 1.2\"\n    , \"APSL-2.0\" ==> \"Apple Public Source License 2.0\"\n    , \"Artistic-1.0\" ==> \"Artistic License 1.0\"\n    , \"Artistic-1.0-cl8\" ==> \"Artistic License 1.0 w/clause 8\"\n    , \"Artistic-1.0-Perl\" ==> \"Artistic License 1.0 (Perl)\"\n    , \"Artistic-2.0\" ==> \"Artistic License 2.0\"\n    , \"BSD-2-Clause\" ==> \"BSD 2-clause \\\"Simplified\\\" License\"\n    , \"BSD-3-Clause\" ==> \"BSD 3-clause \\\"New\\\" or \\\"Revised\\\" License\"\n    , \"BSL-1.0\" ==> \"Boost Software License 1.0\"\n    , \"CATOSL-1.1\" ==> \"Computer Associates Trusted Open Source License 1.1\"\n    , \"CDDL-1.0\" ==> \"Common Development and Distribution License 1.0\"\n    , \"CECILL-2.1\" ==> \"CeCILL Free Software License Agreement v2.1\"\n    , \"CNRI-Python\" ==> \"CNRI Python License\"\n    , \"CPAL-1.0\" ==> \"Common Public Attribution License 1.0\"\n    , \"CPL-1.0\" ==> \"Common Public License 1.0\"\n    , \"CUA-OPL-1.0\" ==> \"CUA Office Public License v1.0\"\n    , \"ECL-1.0\" ==> \"Educational Community License v1.0\"\n    , \"ECL-2.0\" ==> \"Educational Community License v2.0\"\n    , \"EFL-1.0\" ==> \"Eiffel Forum License v1.0\"\n    , \"EFL-2.0\" ==> \"Eiffel Forum License v2.0\"\n    , \"Entessa\" ==> \"Entessa Public License v1.0\"\n    , \"EPL-1.0\" ==> \"Eclipse Public License 1.0\"\n    , \"EUDatagrid\" ==> \"EU DataGrid Software License\"\n    , \"EUPL-1.1\" ==> \"European Union Public License 1.1\"\n    , \"Fair\" ==> \"Fair License\"\n    , \"Frameworx-1.0\" ==> \"Frameworx Open License 1.0\"\n    , \"GPL-2.0\" ==> \"GNU General Public License v2.0 only\"\n    , \"GPL-3.0\" ==> \"GNU General Public License v3.0 only\"\n    , \"HPND\" ==> \"Historic Permission Notice and Disclaimer\"\n    , \"Intel\" ==> \"Intel Open Source License\"\n    , \"IPA\" ==> \"IPA Font License\"\n    , \"IPL-1.0\" ==> \"IBM Public License v1.0\"\n    , \"ISC\" ==> \"ISC License\"\n    , \"LGPL-2.0\" ==> \"GNU Library General Public License v2 only\"\n    , \"LGPL-2.1\" ==> \"GNU Lesser General Public License v2.1 only\"\n    , \"LGPL-3.0\" ==> \"GNU Lesser General Public License v3.0 only\"\n    , \"LiLiQ-P-1.1\" ==> \"Licence Libre du Québec – Permissive version 1.1\"\n    , \"LiLiQ-R-1.1\" ==> \"Licence Libre du Québec – Réciprocité version 1.1\"\n    , \"LiLiQ-Rplus-1.1\" ==> \"Licence Libre du Québec – Réciprocité forte version 1.1\"\n    , \"LPL-1.0\" ==> \"Lucent Public License Version 1.0\"\n    , \"LPL-1.02\" ==> \"Lucent Public License v1.02\"\n    , \"LPPL-1.3c\" ==> \"LaTeX Project Public License v1.3c\"\n    , \"MirOS\" ==> \"MirOS Licence\"\n    , \"MIT\" ==> \"MIT License\"\n    , \"Motosoto\" ==> \"Motosoto License\"\n    , \"MPL-1.0\" ==> \"Mozilla Public License 1.0\"\n    , \"MPL-1.1\" ==> \"Mozilla Public License 1.1\"\n    , \"MPL-2.0\" ==> \"Mozilla Public License 2.0\"\n    , \"MPL-2.0-no-copyleft-exception\" ==> \"Mozilla Public License 2.0 (no copyleft exception)\"\n    , \"MS-PL\" ==> \"Microsoft Public License\"\n    , \"MS-RL\" ==> \"Microsoft Reciprocal License\"\n    , \"Multics\" ==> \"Multics License\"\n    , \"NASA-1.3\" ==> \"NASA Open Source Agreement 1.3\"\n    , \"Naumen\" ==> \"Naumen Public License\"\n    , \"NCSA\" ==> \"University of Illinois/NCSA Open Source License\"\n    , \"NGPL\" ==> \"Nethack General Public License\"\n    , \"Nokia\" ==> \"Nokia Open Source License\"\n    , \"NPOSL-3.0\" ==> \"Non-Profit Open Software License 3.0\"\n    , \"NTP\" ==> \"NTP License\"\n    , \"OCLC-2.0\" ==> \"OCLC Research Public License 2.0\"\n    , \"OFL-1.1\" ==> \"SIL Open Font License 1.1\"\n    , \"OGTSL\" ==> \"Open Group Test Suite License\"\n    , \"OSET-PL-2.1\" ==> \"OSET Public License version 2.1\"\n    , \"OSL-1.0\" ==> \"Open Software License 1.0\"\n    , \"OSL-2.0\" ==> \"Open Software License 2.0\"\n    , \"OSL-2.1\" ==> \"Open Software License 2.1\"\n    , \"OSL-3.0\" ==> \"Open Software License 3.0\"\n    , \"PHP-3.0\" ==> \"PHP License v3.0\"\n    , \"PostgreSQL\" ==> \"PostgreSQL License\"\n    , \"Python-2.0\" ==> \"Python License 2.0\"\n    , \"QPL-1.0\" ==> \"Q Public License 1.0\"\n    , \"RPL-1.1\" ==> \"Reciprocal Public License 1.1\"\n    , \"RPL-1.5\" ==> \"Reciprocal Public License 1.5\"\n    , \"RPSL-1.0\" ==> \"RealNetworks Public Source License v1.0\"\n    , \"RSCPL\" ==> \"Ricoh Source Code Public License\"\n    , \"SimPL-2.0\" ==> \"Simple Public License 2.0\"\n    , \"SISSL\" ==> \"Sun Industry Standards Source License v1.1\"\n    , \"Sleepycat\" ==> \"Sleepycat License\"\n    , \"SPL-1.0\" ==> \"Sun Public License v1.0\"\n    , \"UPL-1.0\" ==> \"Universal Permissive License v1.0\"\n    , \"VSL-1.0\" ==> \"Vovida Software License v1.0\"\n    , \"W3C\" ==> \"W3C Software Notice and License (2002-12-31)\"\n    , \"Watcom-1.0\" ==> \"Sybase Open Watcom Public License 1.0\"\n    , \"Xnet\" ==> \"X.Net License\"\n    , \"Zlib\" ==> \"zlib License\"\n    , \"ZPL-2.0\" ==> \"Zope Public License 2.0\"\n    ]\n"
  },
  {
    "path": "compiler/src/Elm/Magnitude.hs",
    "content": "module Elm.Magnitude\n  ( Magnitude(..)\n  , toChars\n  )\n  where\n\n\n\n-- MAGNITUDE\n\n\ndata Magnitude\n  = PATCH\n  | MINOR\n  | MAJOR\n  deriving (Eq, Ord)\n\n\ntoChars :: Magnitude -> String\ntoChars magnitude =\n  case magnitude of\n    PATCH -> \"PATCH\"\n    MINOR -> \"MINOR\"\n    MAJOR -> \"MAJOR\"\n"
  },
  {
    "path": "compiler/src/Elm/ModuleName.hs",
    "content": "{-# LANGUAGE BangPatterns, OverloadedStrings, UnboxedTuples #-}\nmodule Elm.ModuleName\n  ( Raw\n  , toChars\n  , toFilePath\n  , toHyphenPath\n  --\n  , encode\n  , decoder\n  , parser\n  --\n  , Canonical(..)\n  , basics, char, string\n  , maybe, result, list, array, dict, tuple\n  , platform, cmd, sub\n  , debug\n  , virtualDom\n  , jsonDecode, jsonEncode\n  , webgl, texture, vector2, vector3, vector4, matrix4\n  )\n  where\n\n\nimport Control.Monad (liftM2)\nimport Data.Binary (Binary(..))\nimport qualified Data.Name as Name\nimport qualified Data.Utf8 as Utf8\nimport Data.Word (Word8)\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr)\nimport Prelude hiding (maybe)\nimport qualified System.FilePath as FP\n\nimport qualified Elm.Package as Pkg\nimport qualified Json.Decode as D\nimport qualified Json.Encode as E\nimport qualified Parse.Variable as Var\nimport qualified Parse.Primitives as P\nimport Parse.Primitives (Row, Col)\n\n\n\n-- RAW\n\n\ntype Raw = Name.Name\n\n\ntoChars :: Raw -> String\ntoChars =\n  Name.toChars\n\n\ntoFilePath :: Raw -> FilePath\ntoFilePath name =\n  map (\\c -> if c == '.' then FP.pathSeparator else c) (Name.toChars name)\n\n\ntoHyphenPath :: Raw -> FilePath\ntoHyphenPath name =\n  map (\\c -> if c == '.' then '-' else c) (Name.toChars name)\n\n\n\n-- JSON\n\n\nencode :: Raw -> E.Value\nencode =\n  E.name\n\n\ndecoder :: D.Decoder (Row, Col) Raw\ndecoder =\n  D.customString parser (,)\n\n\n\n-- PARSER\n\n\nparser :: P.Parser (Row, Col) Raw\nparser =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    let\n      (# isGood, newPos, newCol #) = chompStart pos end col\n    in\n    if isGood && minusPtr newPos pos < 256 then\n      let !newState = P.State src newPos end indent row newCol in\n      cok (Utf8.fromPtr pos newPos) newState\n\n    else if col == newCol then\n      eerr row newCol (,)\n\n    else\n      cerr row newCol (,)\n\n\nchompStart :: Ptr Word8 -> Ptr Word8 -> Col -> (# Bool, Ptr Word8, Col #)\nchompStart pos end col =\n  let\n    !width = Var.getUpperWidth pos end\n  in\n  if width == 0 then\n    (# False, pos, col #)\n  else\n    chompInner (plusPtr pos width) end (col + 1)\n\n\nchompInner :: Ptr Word8 -> Ptr Word8 -> Col -> (# Bool, Ptr Word8, Col #)\nchompInner pos end col =\n  if pos >= end then\n    (# True, pos, col #)\n  else\n    let\n      !word = P.unsafeIndex pos\n      !width = Var.getInnerWidthHelp pos end word\n    in\n    if width == 0 then\n      if word == 0x2E {-.-} then\n        chompStart (plusPtr pos 1) end (col + 1)\n      else\n        (# True, pos, col #)\n    else\n      chompInner (plusPtr pos width) end (col + 1)\n\n\n\n-- CANONICAL\n\n\ndata Canonical =\n  Canonical\n    { _package :: !Pkg.Name\n    , _module :: !Name.Name\n    }\n\n\n\n-- INSTANCES\n\n\ninstance Eq Canonical where\n  (==) (Canonical pkg1 name1) (Canonical pkg2 name2) =\n    name1 == name2 && pkg1 == pkg2\n\n\ninstance Ord Canonical where\n  compare (Canonical pkg1 name1) (Canonical pkg2 name2) =\n    case compare name1 name2 of\n      LT -> LT\n      EQ -> compare pkg1 pkg2\n      GT -> GT\n\n\ninstance Binary Canonical where\n  put (Canonical a b) = put a >> put b\n  get = liftM2 Canonical get get\n\n\n\n-- CORE\n\n\n{-# NOINLINE basics #-}\nbasics :: Canonical\nbasics = Canonical Pkg.core Name.basics\n\n\n{-# NOINLINE char #-}\nchar :: Canonical\nchar = Canonical Pkg.core Name.char\n\n\n{-# NOINLINE string #-}\nstring :: Canonical\nstring = Canonical Pkg.core Name.string\n\n\n{-# NOINLINE maybe #-}\nmaybe :: Canonical\nmaybe = Canonical Pkg.core Name.maybe\n\n\n{-# NOINLINE result #-}\nresult :: Canonical\nresult = Canonical Pkg.core Name.result\n\n\n{-# NOINLINE list #-}\nlist :: Canonical\nlist = Canonical Pkg.core Name.list\n\n\n{-# NOINLINE array #-}\narray :: Canonical\narray = Canonical Pkg.core Name.array\n\n\n{-# NOINLINE dict #-}\ndict :: Canonical\ndict = Canonical Pkg.core Name.dict\n\n\n{-# NOINLINE tuple #-}\ntuple :: Canonical\ntuple = Canonical Pkg.core Name.tuple\n\n\n{-# NOINLINE platform #-}\nplatform :: Canonical\nplatform = Canonical Pkg.core Name.platform\n\n\n{-# NOINLINE cmd #-}\ncmd :: Canonical\ncmd = Canonical Pkg.core \"Platform.Cmd\"\n\n\n{-# NOINLINE sub #-}\nsub :: Canonical\nsub = Canonical Pkg.core \"Platform.Sub\"\n\n\n{-# NOINLINE debug #-}\ndebug :: Canonical\ndebug = Canonical Pkg.core Name.debug\n\n\n\n-- HTML\n\n\n{-# NOINLINE virtualDom #-}\nvirtualDom :: Canonical\nvirtualDom = Canonical Pkg.virtualDom Name.virtualDom\n\n\n\n-- JSON\n\n\n{-# NOINLINE jsonDecode #-}\njsonDecode :: Canonical\njsonDecode = Canonical Pkg.json \"Json.Decode\"\n\n\n{-# NOINLINE jsonEncode #-}\njsonEncode :: Canonical\njsonEncode = Canonical Pkg.json \"Json.Encode\"\n\n\n\n-- WEBGL\n\n\n{-# NOINLINE webgl #-}\nwebgl :: Canonical\nwebgl = Canonical Pkg.webgl \"WebGL\"\n\n\n{-# NOINLINE texture #-}\ntexture :: Canonical\ntexture = Canonical Pkg.webgl \"WebGL.Texture\"\n\n\n{-# NOINLINE vector2 #-}\nvector2 :: Canonical\nvector2 = Canonical Pkg.linearAlgebra \"Math.Vector2\"\n\n\n{-# NOINLINE vector3 #-}\nvector3 :: Canonical\nvector3 = Canonical Pkg.linearAlgebra \"Math.Vector3\"\n\n\n{-# NOINLINE vector4 #-}\nvector4 :: Canonical\nvector4 = Canonical Pkg.linearAlgebra \"Math.Vector4\"\n\n\n{-# NOINLINE matrix4 #-}\nmatrix4 :: Canonical\nmatrix4 = Canonical Pkg.linearAlgebra \"Math.Matrix4\"\n"
  },
  {
    "path": "compiler/src/Elm/Package.hs",
    "content": "{-# LANGUAGE BangPatterns, EmptyDataDecls, FlexibleInstances, UnboxedTuples #-}\nmodule Elm.Package\n  ( Name(..)\n  , Author\n  , Project\n  , Canonical(..)\n  , isKernel\n  , toChars\n  , toUrl\n  , toFilePath\n  , toJsonString\n  --\n  , dummyName, kernel, core\n  , browser, virtualDom, html\n  , json, http, url\n  , webgl, linearAlgebra\n  --\n  , suggestions\n  , nearbyNames\n  --\n  , decoder\n  , encode\n  , keyDecoder\n  --\n  , parser\n  )\n  where\n\n\nimport Control.Monad (liftM2)\nimport Data.Binary (Binary, get, put)\nimport qualified Data.Coerce as Coerce\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport qualified Data.Utf8 as Utf8\nimport Data.Word (Word8)\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr)\nimport System.FilePath ((</>))\n\nimport qualified Elm.Version as V\nimport qualified Json.Decode as D\nimport qualified Json.Encode as E\nimport qualified Json.String as Json\nimport qualified Parse.Primitives as P\nimport Parse.Primitives (Row, Col)\nimport qualified Reporting.Suggest as Suggest\n\n\n\n-- PACKGE NAMES\n\n\ndata Name =\n  Name\n    { _author :: !Author\n    , _project :: !Project\n    }\n    deriving (Ord)\n\n\ntype Author = Utf8.Utf8 AUTHOR\ntype Project = Utf8.Utf8 PROJECT\n\ndata AUTHOR\ndata PROJECT\n\n\ndata Canonical =\n  Canonical\n    { _name :: !Name\n    , _version :: !V.Version\n    }\n    deriving (Ord)\n\n\n\n-- HELPERS\n\n\nisKernel :: Name -> Bool\nisKernel (Name author _) =\n  author == elm || author == elm_explorations\n\n\ntoChars :: Name -> String\ntoChars (Name author project) =\n  Utf8.toChars author <> \"/\" <> Utf8.toChars project\n\n\ntoUrl :: Name -> String\ntoUrl (Name author project) =\n  Utf8.toChars author ++ \"/\" ++ Utf8.toChars project\n\n\ntoFilePath :: Name -> FilePath\ntoFilePath (Name author project) =\n  Utf8.toChars author </> Utf8.toChars project\n\n\ntoJsonString :: Name -> Json.String\ntoJsonString (Name author project) =\n  Utf8.join 0x2F {-/-} [ Coerce.coerce author, Coerce.coerce project ]\n\n\n\n-- COMMON PACKAGE NAMES\n\n\ntoName :: Author -> [Char] -> Name\ntoName author project =\n  Name author (Utf8.fromChars project)\n\n\n{-# NOINLINE dummyName #-}\ndummyName :: Name\ndummyName =\n  toName (Utf8.fromChars \"author\") \"project\"\n\n\n{-# NOINLINE kernel #-}\nkernel :: Name\nkernel =\n  toName elm \"kernel\"\n\n\n{-# NOINLINE core #-}\ncore :: Name\ncore =\n  toName elm \"core\"\n\n\n{-# NOINLINE browser #-}\nbrowser :: Name\nbrowser =\n  toName elm \"browser\"\n\n\n{-# NOINLINE virtualDom #-}\nvirtualDom :: Name\nvirtualDom =\n  toName elm \"virtual-dom\"\n\n\n{-# NOINLINE html #-}\nhtml :: Name\nhtml =\n  toName elm \"html\"\n\n\n{-# NOINLINE json #-}\njson :: Name\njson =\n  toName elm \"json\"\n\n\n{-# NOINLINE http #-}\nhttp :: Name\nhttp =\n  toName elm \"http\"\n\n\n{-# NOINLINE url #-}\nurl :: Name\nurl =\n  toName elm \"url\"\n\n\n{-# NOINLINE webgl #-}\nwebgl :: Name\nwebgl =\n  toName elm_explorations \"webgl\"\n\n\n{-# NOINLINE linearAlgebra #-}\nlinearAlgebra :: Name\nlinearAlgebra =\n  toName elm_explorations \"linear-algebra\"\n\n\n{-# NOINLINE elm #-}\nelm :: Author\nelm =\n  Utf8.fromChars \"elm\"\n\n\n{-# NOINLINE elm_explorations #-}\nelm_explorations :: Author\nelm_explorations =\n  Utf8.fromChars \"elm-explorations\"\n\n\n\n-- PACKAGE SUGGESTIONS\n\n\nsuggestions :: Map.Map Name.Name Name\nsuggestions =\n  let\n    random = toName elm \"random\"\n    time = toName elm \"time\"\n    file = toName elm \"file\"\n  in\n  Map.fromList\n    [ \"Browser\" ==> browser\n    , \"File\" ==> file\n    , \"File.Download\" ==> file\n    , \"File.Select\" ==> file\n    , \"Html\" ==> html\n    , \"Html.Attributes\" ==> html\n    , \"Html.Events\" ==> html\n    , \"Http\" ==> http\n    , \"Json.Decode\" ==> json\n    , \"Json.Encode\" ==> json\n    , \"Random\" ==> random\n    , \"Time\" ==> time\n    , \"Url.Parser\" ==> url\n    , \"Url\" ==> url\n    ]\n\n\n(==>) :: [Char] -> Name -> (Name.Name, Name)\n(==>) moduleName package =\n  ( Utf8.fromChars moduleName, package )\n\n\n\n-- NEARBY NAMES\n\n\nnearbyNames :: Name -> [Name] -> [Name]\nnearbyNames (Name author1 project1) possibleNames =\n  let\n    authorDist = authorDistance (Utf8.toChars author1)\n    projectDist = projectDistance (Utf8.toChars project1)\n\n    nameDistance (Name author2 project2) =\n      authorDist author2 + projectDist project2\n  in\n  take 4 $ List.sortOn nameDistance possibleNames\n\n\nauthorDistance :: [Char] -> Author -> Int\nauthorDistance given possibility =\n  if possibility == elm || possibility == elm_explorations\n  then 0\n  else abs (Suggest.distance given (Utf8.toChars possibility))\n\n\nprojectDistance :: [Char] -> Project -> Int\nprojectDistance given possibility =\n  abs (Suggest.distance given (Utf8.toChars possibility))\n\n\n\n-- INSTANCES\n\n\ninstance Eq Name where\n  (==) (Name author1 project1) (Name author2 project2) =\n    project1 == project2 && author1 == author2\n\n\ninstance Eq Canonical where\n  (==) (Canonical package1 version1) (Canonical package2 version2) =\n    version1 == version2 && package1 == package2\n\n\n\n-- BINARY\n\n\ninstance Binary Name where -- PERF try storing as a Word16\n  get = liftM2 Name Utf8.getUnder256 Utf8.getUnder256\n  put (Name a b) = Utf8.putUnder256 a >> Utf8.putUnder256 b\n\n\ninstance Binary Canonical where\n  get = liftM2 Canonical get get\n  put (Canonical a b) = put a >> put b\n\n\n\n-- JSON\n\n\ndecoder :: D.Decoder (Row, Col) Name\ndecoder =\n  D.customString parser (,)\n\n\nencode :: Name -> E.Value\nencode name =\n  E.chars (toChars name)\n\n\nkeyDecoder :: (Row -> Col -> x) -> D.KeyDecoder x Name\nkeyDecoder toError =\n  let\n    keyParser =\n      P.specialize (\\(r,c) _ _ -> toError r c) parser\n  in\n  D.KeyDecoder keyParser toError\n\n\n\n-- PARSER\n\n\nparser :: P.Parser (Row, Col) Name\nparser =\n  do  author <- parseName isAlphaOrDigit isAlphaOrDigit\n      P.word1 0x2F {-/-} (,)\n      project <- parseName isLower isLowerOrDigit\n      return (Name author project)\n\n\nparseName :: (Word8 -> Bool) -> (Word8 -> Bool) -> P.Parser (Row, Col) (Utf8.Utf8 t)\nparseName isGoodStart isGoodInner =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    if pos >= end then\n      eerr row col (,)\n    else\n      let !word = P.unsafeIndex pos in\n      if not (isGoodStart word) then\n        eerr row col (,)\n      else\n        let\n          (# isGood, newPos #) = chompName isGoodInner (plusPtr pos 1) end False\n          !len = fromIntegral (minusPtr newPos pos)\n          !newCol = col + len\n        in\n        if isGood && len < 256 then\n          let !newState = P.State src newPos end indent row newCol in\n          cok (Utf8.fromPtr pos newPos) newState\n        else\n          cerr row newCol (,)\n\n\nisLower :: Word8 -> Bool\nisLower word =\n  0x61 {-a-} <= word && word <= 0x7A {-z-}\n\n\nisLowerOrDigit :: Word8 -> Bool\nisLowerOrDigit word =\n     0x61 {-a-} <= word && word <= 0x7A {-z-}\n  || 0x30 {-0-} <= word && word <= 0x39 {-9-}\n\n\nisAlphaOrDigit :: Word8 -> Bool\nisAlphaOrDigit word =\n     0x61 {-a-} <= word && word <= 0x7A {-z-}\n  || 0x41 {-A-} <= word && word <= 0x5A {-Z-}\n  || 0x30 {-0-} <= word && word <= 0x39 {-9-}\n\n\nchompName :: (Word8 -> Bool) -> Ptr Word8 -> Ptr Word8 -> Bool -> (# Bool, Ptr Word8 #)\nchompName isGoodChar pos end prevWasDash =\n  if pos >= end then\n    (# not prevWasDash, pos #)\n  else\n    let !word = P.unsafeIndex pos in\n    if isGoodChar word then\n      chompName isGoodChar (plusPtr pos 1) end False\n    else if word == 0x2D {---} then\n      if prevWasDash then\n        (# False, pos #)\n      else\n        chompName isGoodChar (plusPtr pos 1) end True\n    else\n      (# True, pos #)\n"
  },
  {
    "path": "compiler/src/Elm/String.hs",
    "content": "{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}\n{-# LANGUAGE BangPatterns, EmptyDataDecls, FlexibleInstances #-}\nmodule Elm.String\n  ( String\n  , toChars\n  , toBuilder\n  , Chunk(..)\n  , fromChunks\n  )\n  where\n\n\nimport Prelude hiding (String)\nimport Data.Binary (Binary, get, put)\nimport Data.Bits ((.&.), shiftR)\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.Utf8 as Utf8\nimport Data.Utf8 (MBA, newByteArray, copyFromPtr, freeze, writeWord8)\nimport GHC.Exts (RealWorld, Ptr)\nimport GHC.IO (stToIO, unsafeDupablePerformIO)\nimport GHC.ST (ST)\nimport GHC.Word (Word8)\n\n\n\n-- STRINGS\n\n\ntype String =\n  Utf8.Utf8 ELM_STRING\n\n\ndata ELM_STRING\n\n\n\n-- HELPERS\n\n\ntoChars :: String -> [Char]\ntoChars =\n  Utf8.toChars\n\n\n{-# INLINE toBuilder #-}\ntoBuilder :: String -> B.Builder\ntoBuilder =\n  Utf8.toBuilder\n\n\n\n-- FROM CHUNKS\n\n\ndata Chunk\n  = Slice (Ptr Word8) Int\n  | Escape Word8\n  | CodePoint Int\n\n\nfromChunks :: [Chunk] -> String\nfromChunks chunks =\n  unsafeDupablePerformIO (stToIO (\n    do  let !len = sum (map chunkToWidth chunks)\n        mba <- newByteArray len\n        writeChunks mba 0 chunks\n        freeze mba\n  ))\n\n\nchunkToWidth :: Chunk -> Int\nchunkToWidth chunk =\n  case chunk of\n    Slice _ len -> len\n    Escape _    -> 2\n    CodePoint c -> if c < 0xFFFF then 6 else 12\n\n\nwriteChunks :: MBA RealWorld -> Int -> [Chunk] -> ST RealWorld ()\nwriteChunks mba offset chunks =\n  case chunks of\n    [] ->\n      return ()\n\n    chunk : chunks ->\n      case chunk of\n        Slice ptr len ->\n          do  copyFromPtr ptr mba offset len\n              let !newOffset = offset + len\n              writeChunks mba newOffset chunks\n\n        Escape word ->\n          do  writeWord8 mba offset 0x5C {- \\ -}\n              writeWord8 mba (offset + 1) word\n              let !newOffset = offset + 2\n              writeChunks mba newOffset chunks\n\n        CodePoint code ->\n          if code < 0xFFFF then\n            do  writeCode mba offset code\n                let !newOffset = offset + 6\n                writeChunks mba newOffset chunks\n          else\n            do  let (hi,lo) = divMod (code - 0x10000) 0x400\n                writeCode mba (offset    ) (hi + 0xD800)\n                writeCode mba (offset + 6) (lo + 0xDC00)\n                let !newOffset = offset + 12\n                writeChunks mba newOffset chunks\n\n\nwriteCode :: MBA RealWorld -> Int -> Int -> ST RealWorld ()\nwriteCode mba offset code =\n  do  writeWord8 mba offset 0x5C {- \\ -}\n      writeWord8 mba (offset + 1) 0x75 {- u -}\n      writeHex mba (offset + 2) (shiftR code 12)\n      writeHex mba (offset + 3) (shiftR code 8)\n      writeHex mba (offset + 4) (shiftR code 4)\n      writeHex mba (offset + 5) code\n\n\nwriteHex :: MBA RealWorld -> Int -> Int -> ST RealWorld ()\nwriteHex mba !offset !bits =\n  do  let !n = fromIntegral bits .&. 0x0F\n      writeWord8 mba offset (if n < 10 then 0x30 + n else 0x37 + n)\n\n\n\n-- BINARY\n\n\ninstance Binary (Utf8.Utf8 ELM_STRING) where\n  get = Utf8.getVeryLong\n  put = Utf8.putVeryLong\n"
  },
  {
    "path": "compiler/src/Elm/Version.hs",
    "content": "{-# LANGUAGE BangPatterns, UnboxedTuples #-}\nmodule Elm.Version\n  ( Version(..)\n  , one\n  , max\n  , compiler\n  , bumpPatch\n  , bumpMinor\n  , bumpMajor\n  , toChars\n  --\n  , decoder\n  , encode\n  --\n  , parser\n  )\n  where\n\n\nimport Prelude hiding (max)\nimport Control.Monad (liftM3)\nimport Data.Binary (Binary, get, put, getWord8, putWord8)\nimport qualified Data.Version as Version\nimport Data.Word (Word8, Word16)\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr)\nimport qualified Paths_elm\n\nimport qualified Json.Decode as D\nimport qualified Json.Encode as E\nimport qualified Parse.Primitives as P\nimport Parse.Primitives (Row, Col)\n\n\n\n-- VERSION\n\n\ndata Version =\n  Version\n    { _major :: {-# UNPACK #-} !Word16\n    , _minor :: {-# UNPACK #-} !Word16\n    , _patch :: {-# UNPACK #-} !Word16\n    }\n    deriving (Eq, Ord)\n\n\none :: Version\none =\n  Version 1 0 0\n\n\nmax :: Version\nmax =\n  Version maxBound 0 0\n\n\ncompiler :: Version\ncompiler =\n  case map fromIntegral (Version.versionBranch Paths_elm.version) of\n    major : minor : patch : _ ->\n      Version major minor patch\n\n    [major, minor] ->\n      Version major minor 0\n\n    [major] ->\n      Version major 0 0\n\n    [] ->\n      error \"could not detect version of elm-compiler you are using\"\n\n\n\n-- BUMP\n\n\nbumpPatch :: Version -> Version\nbumpPatch (Version major minor patch) =\n  Version major minor (patch + 1)\n\n\nbumpMinor :: Version -> Version\nbumpMinor (Version major minor _patch) =\n  Version major (minor + 1) 0\n\n\nbumpMajor :: Version -> Version\nbumpMajor (Version major _minor _patch) =\n  Version (major + 1) 0 0\n\n\n\n-- TO CHARS\n\n\ntoChars :: Version -> [Char]\ntoChars (Version major minor patch) =\n  show major ++ '.' : show minor ++ '.' : show patch\n\n\n\n-- JSON\n\n\ndecoder :: D.Decoder (Row, Col) Version\ndecoder =\n  D.customString parser (,)\n\n\nencode :: Version -> E.Value\nencode version =\n  E.chars (toChars version)\n\n\n\n-- BINARY\n\n\ninstance Binary Version where\n  get =\n    do  word <- getWord8\n        if word == 255\n          then liftM3 Version get get get\n          else\n            do  minor <- getWord8\n                patch <- getWord8\n                return (Version (fromIntegral word) (fromIntegral minor) (fromIntegral patch))\n\n  put (Version major minor patch) =\n    if major < 255 && minor < 256 && patch < 256 then\n      do  putWord8 (fromIntegral major)\n          putWord8 (fromIntegral minor)\n          putWord8 (fromIntegral patch)\n    else\n      do  putWord8 255\n          put major\n          put minor\n          put patch\n\n\n\n-- PARSER\n\n\nparser :: P.Parser (Row, Col) Version\nparser =\n  do  major <- numberParser\n      P.word1 0x2E {-.-} (,)\n      minor <- numberParser\n      P.word1 0x2E {-.-} (,)\n      patch <- numberParser\n      return (Version major minor patch)\n\n\nnumberParser :: P.Parser (Row, Col) Word16\nnumberParser =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    if pos >= end then\n      eerr row col (,)\n    else\n      let !word = P.unsafeIndex pos in\n      if word == 0x30 {-0-} then\n\n        let\n          !newState = P.State src (plusPtr pos 1) end indent row (col + 1)\n        in\n        cok 0 newState\n\n      else if isDigit word then\n\n        let\n          (# total, newPos #) = chompWord16 (plusPtr pos 1) end (fromIntegral (word - 0x30))\n          !newState = P.State src newPos end indent row (col + fromIntegral (minusPtr newPos pos))\n        in\n        cok total newState\n\n      else\n        eerr row col (,)\n\n\nchompWord16 :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Word16, Ptr Word8 #)\nchompWord16 pos end total =\n  if pos >= end then\n    (# total, pos #)\n  else\n    let !word = P.unsafeIndex pos in\n    if isDigit word then\n      chompWord16 (plusPtr pos 1) end (10 * total + fromIntegral (word - 0x30))\n    else\n      (# total, pos #)\n\n\nisDigit :: Word8 -> Bool\nisDigit word =\n  0x30 {-0-} <= word && word <= 0x39 {-9-}\n"
  },
  {
    "path": "compiler/src/Generate/Html.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE QuasiQuotes #-}\nmodule Generate.Html\n  ( sandwich\n  )\n  where\n\n\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.Name as Name\nimport Text.RawString.QQ (r)\n\n\n\n-- SANDWICH\n\n\nsandwich :: Name.Name -> B.Builder -> B.Builder\nsandwich moduleName javascript =\n  let name = Name.toBuilder moduleName in\n  [r|<!DOCTYPE HTML>\n<html>\n<head>\n  <meta charset=\"UTF-8\">\n  <title>|] <> name <> [r|</title>\n  <style>body { padding: 0; margin: 0; }</style>\n</head>\n\n<body>\n\n<pre id=\"elm\"></pre>\n\n<script>\ntry {\n|] <> javascript <> [r|\n\n  var app = Elm.|] <> name <> [r|.init({ node: document.getElementById(\"elm\") });\n}\ncatch (e)\n{\n  // display initialization errors (e.g. bad flags, infinite recursion)\n  var header = document.createElement(\"h1\");\n  header.style.fontFamily = \"monospace\";\n  header.innerText = \"Initialization Error\";\n  var pre = document.getElementById(\"elm\");\n  document.body.insertBefore(header, pre);\n  pre.innerText = e;\n  throw e;\n}\n</script>\n\n</body>\n</html>|]\n"
  },
  {
    "path": "compiler/src/Generate/JavaScript/Builder.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Generate.JavaScript.Builder\n  ( stmtToBuilder\n  , exprToBuilder\n  , Expr(..), LValue(..)\n  , Stmt(..), Case(..)\n  , InfixOp(..), PrefixOp(..)\n  )\n  where\n\n-- Based on the language-ecmascript package.\n-- https://hackage.haskell.org/package/language-ecmascript\n-- They did the hard work of reading the spec to figure out\n-- how all the types should fit together.\n\nimport Prelude hiding (lines)\nimport qualified Data.List as List\nimport qualified Data.ByteString as BS\nimport Data.ByteString.Builder as B\nimport qualified Generate.JavaScript.Name as Name\nimport Generate.JavaScript.Name (Name)\nimport qualified Json.Encode as Json\n\n\n\n-- EXPRESSIONS\n\n\n-- NOTE: I tried making this create a B.Builder directly.\n--\n-- The hope was that it'd allocate less and speed things up, but it seemed\n-- to be neutral for perf.\n--\n-- The downside is that Generate.JavaScript.Expression inspects the\n-- structure of Expr and Stmt on some occassions to try to strip out\n-- unnecessary closures. I think these closures are already avoided\n-- by other logic in code gen these days, but I am not 100% certain.\n--\n-- For this to be worth it, I think it would be necessary to avoid\n-- returning tuples when generating expressions.\n--\ndata Expr\n  = String Builder\n  | Float Builder\n  | Int Int\n  | Bool Bool\n  | Null\n  | Json Json.Value\n  | Array [Expr]\n  | Object [(Name, Expr)]\n  | Ref Name\n  | Access Expr Name -- foo.bar\n  | Index  Expr Expr -- foo[bar]\n  | Prefix PrefixOp Expr\n  | Infix InfixOp Expr Expr\n  | If Expr Expr Expr\n  | Assign LValue Expr\n  | Call Expr [Expr]\n  | Function (Maybe Name) [Name] [Stmt]\n\n\ndata LValue\n  = LRef Name\n  | LDot Expr Name\n  | LBracket Expr Expr\n\n\n\n-- STATEMENTS\n\n\ndata Stmt\n  = Block [Stmt]\n  | EmptyStmt\n  | ExprStmt Expr\n  | IfStmt Expr Stmt Stmt\n  | Switch Expr [Case]\n  | While Expr Stmt\n  | Break (Maybe Name)\n  | Continue (Maybe Name)\n  | Labelled Name Stmt\n  | Try Stmt Name Stmt\n  | Throw Expr\n  | Return Expr\n  | Var Name Expr\n  | Vars [(Name, Expr)]\n  | FunctionStmt Name [Name] [Stmt]\n\n\ndata Case\n  = Case Expr [Stmt]\n  | Default [Stmt]\n\n\n\n-- OPERATORS\n\n\ndata InfixOp\n  = OpAdd -- +\n  | OpSub -- -\n  | OpMul -- *\n  | OpDiv -- /\n  | OpMod -- %\n  | OpEq -- ===\n  | OpNe -- !==\n  | OpLt -- <\n  | OpLe -- <=\n  | OpGt -- >\n  | OpGe -- >=\n  | OpAnd -- &&\n  | OpOr  -- ||\n  | OpBitwiseAnd -- &\n  | OpBitwiseXor -- ^\n  | OpBitwiseOr  -- |\n  | OpLShift     -- <<\n  | OpSpRShift   -- >>\n  | OpZfRShift   -- >>>\n\n\ndata PrefixOp\n  = PrefixNot        -- !\n  | PrefixNegate     -- -\n  | PrefixComplement -- ~\n\n\n\n-- ENCODE\n\n\nstmtToBuilder :: Stmt -> Builder\nstmtToBuilder stmts =\n  fromStmt levelZero stmts\n\n\nexprToBuilder :: Expr -> Builder\nexprToBuilder expr =\n  snd $ fromExpr levelZero Whatever expr\n\n\n\n-- INDENT LEVEL\n\n\ndata Level =\n  Level Builder Level\n\n\nlevelZero :: Level\nlevelZero =\n  Level mempty (makeLevel 1 (BS.replicate 16 0x09 {-\\t-}))\n\n\nmakeLevel :: Int -> BS.ByteString -> Level\nmakeLevel level oldTabs =\n  let\n    tabs =\n      if level <= BS.length oldTabs\n      then oldTabs\n      else BS.replicate (BS.length oldTabs * 2) 0x09 {-\\t-}\n  in\n  Level (B.byteString (BS.take level tabs)) (makeLevel (level + 1) tabs)\n\n\n\n-- HELPERS\n\n\ncommaSep :: [Builder] -> Builder\ncommaSep builders =\n  mconcat (List.intersperse \", \" builders)\n\n\ncommaNewlineSep :: Level -> [Builder] -> Builder\ncommaNewlineSep (Level _ (Level deeperIndent _)) builders =\n  mconcat (List.intersperse (\",\\n\" <> deeperIndent) builders)\n\n\n\n-- STATEMENTS\n\n\nfromStmtBlock :: Level -> [Stmt] -> Builder\nfromStmtBlock level stmts =\n  mconcat (map (fromStmt level) stmts)\n\n\nfromStmt :: Level -> Stmt -> Builder\nfromStmt level@(Level indent nextLevel) statement =\n  case statement of\n    Block stmts ->\n      fromStmtBlock level stmts\n\n    EmptyStmt ->\n      mempty\n\n    ExprStmt expr ->\n      indent <> snd (fromExpr level Whatever expr) <> \";\\n\"\n\n    IfStmt condition thenStmt elseStmt ->\n      mconcat\n        [ indent, \"if (\", snd (fromExpr level Whatever condition), \") {\\n\"\n        , fromStmt nextLevel thenStmt\n        , indent, \"} else {\\n\"\n        , fromStmt nextLevel elseStmt\n        , indent, \"}\\n\"\n        ]\n\n    Switch expr clauses ->\n      mconcat\n        [ indent, \"switch (\", snd (fromExpr level Whatever expr), \") {\\n\"\n        , mconcat (map (fromClause nextLevel) clauses)\n        , indent, \"}\\n\"\n        ]\n\n    While expr stmt ->\n      mconcat\n        [ indent, \"while (\", snd (fromExpr level Whatever expr), \") {\\n\"\n        , fromStmt nextLevel stmt\n        , indent, \"}\\n\"\n        ]\n\n    Break Nothing ->\n      indent <> \"break;\\n\"\n\n    Break (Just label) ->\n      indent <> \"break \" <> Name.toBuilder label <> \";\\n\"\n\n    Continue Nothing ->\n      indent <> \"continue;\\n\"\n\n    Continue (Just label) ->\n      indent <> \"continue \" <> Name.toBuilder label <> \";\\n\"\n\n    Labelled label stmt ->\n      mconcat\n        [ indent, Name.toBuilder label, \":\\n\"\n        , fromStmt level stmt\n        ]\n\n    Try tryStmt errorName catchStmt ->\n      mconcat\n        [ indent, \"try {\\n\"\n        , fromStmt nextLevel tryStmt\n        , indent, \"} catch (\", Name.toBuilder errorName, \") {\\n\"\n        , fromStmt nextLevel catchStmt\n        , indent, \"}\\n\"\n        ]\n\n    Throw expr ->\n      indent <> \"throw \" <> snd (fromExpr level Whatever expr) <> \";\"\n\n    Return expr ->\n      indent <> \"return \" <> snd (fromExpr level Whatever expr) <> \";\\n\"\n\n    Var name expr ->\n      indent <> \"var \" <> Name.toBuilder name <> \" = \" <> snd (fromExpr level Whatever expr) <> \";\\n\"\n\n    Vars [] ->\n      mempty\n\n    Vars vars ->\n      indent <> \"var \" <> commaNewlineSep level (map (varToBuilder level) vars) <> \";\\n\"\n\n    FunctionStmt name args stmts ->\n      indent <> \"function \" <> Name.toBuilder name <> \"(\" <> commaSep (map Name.toBuilder args) <> \") {\\n\"\n      <>\n          fromStmtBlock nextLevel stmts\n      <>\n      indent <> \"}\\n\"\n\n\n\n-- SWITCH CLAUSES\n\n\nfromClause :: Level -> Case -> Builder\nfromClause level@(Level indent nextLevel) clause =\n  case clause of\n    Case expr stmts ->\n      indent <> \"case \" <> snd (fromExpr level Whatever expr) <> \":\\n\"\n      <> fromStmtBlock nextLevel stmts\n\n    Default stmts ->\n      indent <> \"default:\\n\"\n      <> fromStmtBlock nextLevel stmts\n\n\n\n-- VAR DECLS\n\n\nvarToBuilder :: Level -> (Name, Expr) -> Builder\nvarToBuilder level (name, expr) =\n  Name.toBuilder name <> \" = \" <> snd (fromExpr level Whatever expr)\n\n\n\n-- EXPRESSIONS\n\n\ndata Lines = One | Many deriving (Eq)\n\n\nmerge :: Lines -> Lines -> Lines\nmerge a b =\n  if a == Many || b == Many then Many else One\n\n\nlinesMap :: (a -> (Lines, b)) -> [a] -> (Bool, [b])\nlinesMap func xs =\n  let\n    pairs = map func xs\n  in\n  ( any ((==) Many . fst) pairs\n  , map snd pairs\n  )\n\n\ndata Grouping = Atomic | Whatever\n\n\nparensFor :: Grouping -> Builder -> Builder\nparensFor grouping builder =\n  case grouping of\n    Atomic ->\n      \"(\" <> builder <> \")\"\n\n    Whatever ->\n      builder\n\n\nfromExpr :: Level -> Grouping -> Expr -> (Lines, Builder)\nfromExpr level@(Level indent nextLevel@(Level deeperIndent _)) grouping expression =\n  case expression of\n    String string ->\n      ( One, \"'\" <> string <> \"'\" )\n\n    Float float ->\n      ( One, float )\n\n    Int n ->\n      ( One, B.intDec n )\n\n    Bool bool ->\n      ( One, if bool then \"true\" else \"false\" )\n\n    Null ->\n      ( One, \"null\" )\n\n    Json json ->\n      ( One, Json.encodeUgly json )\n\n    Array exprs ->\n      (,) Many $\n        let\n          (anyMany, builders) = linesMap (fromExpr level Whatever) exprs\n        in\n        if anyMany then\n          \"[\\n\"\n          <> deeperIndent\n          <> commaNewlineSep level builders\n          <> \"\\n\" <> indent <> \"]\"\n        else\n          \"[\" <> commaSep builders <> \"]\"\n\n    Object fields ->\n      (,) Many $\n        let\n          (anyMany, builders) = linesMap (fromField nextLevel) fields\n        in\n        if anyMany then\n          \"{\\n\"\n          <> deeperIndent\n          <> commaNewlineSep level builders\n          <> \"\\n\" <> indent <> \"}\"\n        else\n          \"{\" <> commaSep builders <> \"}\"\n\n    Ref name ->\n      ( One, Name.toBuilder name )\n\n    Access expr field ->\n      makeDot level expr field\n\n    Index expr bracketedExpr ->\n      makeBracketed level expr bracketedExpr\n\n    Prefix op expr ->\n      let\n        (lines, builder) = fromExpr level Atomic expr\n      in\n      ( lines\n      , parensFor grouping (fromPrefix op <> builder)\n      )\n\n    Infix op leftExpr rightExpr ->\n      let\n        (leftLines , left ) = fromExpr level Atomic leftExpr\n        (rightLines, right) = fromExpr level Atomic rightExpr\n      in\n      ( merge leftLines rightLines\n      , parensFor grouping (left <> fromInfix op <> right)\n      )\n\n    If condExpr thenExpr elseExpr ->\n      let\n        condB = snd (fromExpr level Atomic condExpr)\n        thenB = snd (fromExpr level Atomic thenExpr)\n        elseB = snd (fromExpr level Atomic elseExpr)\n      in\n      ( Many\n      , parensFor grouping (condB <> \" ? \" <> thenB <> \" : \" <> elseB)\n      )\n\n    Assign lValue expr ->\n      let\n        (leftLines , left ) = fromLValue level lValue\n        (rightLines, right) = fromExpr level Whatever expr\n      in\n      ( merge leftLines rightLines\n      , parensFor grouping (left <> \" = \" <> right)\n      )\n\n    Call function args ->\n      (,) Many $\n        let\n          (_      , funcB) = fromExpr level Atomic function\n          (anyMany, argsB) = linesMap (fromExpr nextLevel Whatever) args\n        in\n        if anyMany then\n          funcB <> \"(\\n\" <> deeperIndent <> commaNewlineSep level argsB <> \")\"\n        else\n          funcB <> \"(\" <> commaSep argsB <> \")\"\n\n    Function maybeName args stmts ->\n      (,) Many $\n        \"function \" <> maybe mempty Name.toBuilder maybeName <> \"(\" <> commaSep (map Name.toBuilder args) <> \") {\\n\"\n        <>\n            fromStmtBlock nextLevel stmts\n        <>\n        indent <> \"}\"\n\n\n\n-- FIELDS\n\n\nfromField :: Level -> (Name, Expr) -> (Lines, Builder)\nfromField level (field, expr) =\n  let\n    (lines, builder) = fromExpr level Whatever expr\n  in\n  ( lines\n  , Name.toBuilder field <> \": \" <> builder\n  )\n\n\n\n-- VALUES\n\n\nfromLValue :: Level -> LValue -> (Lines, Builder)\nfromLValue level lValue =\n  case lValue of\n    LRef name ->\n      (One, Name.toBuilder name)\n\n    LDot expr field ->\n      makeDot level expr field\n\n    LBracket expr bracketedExpr ->\n      makeBracketed level expr bracketedExpr\n\n\nmakeDot :: Level -> Expr -> Name -> (Lines, Builder)\nmakeDot level expr field =\n  let\n    (lines, builder) = fromExpr level Atomic expr\n  in\n  (lines, builder <> \".\" <> Name.toBuilder field)\n\n\nmakeBracketed :: Level -> Expr -> Expr -> (Lines, Builder)\nmakeBracketed level expr bracketedExpr =\n  let\n    (lines         , builder         ) = fromExpr level Atomic expr\n    (bracketedLines, bracketedBuilder) = fromExpr level Whatever bracketedExpr\n  in\n  ( merge lines bracketedLines\n  , builder <> \"[\" <> bracketedBuilder <> \"]\"\n  )\n\n\n\n-- OPERATORS\n\n\nfromPrefix :: PrefixOp -> Builder\nfromPrefix op =\n  case op of\n    PrefixNot        -> \"!\"\n    PrefixNegate     -> \"-\"\n    PrefixComplement -> \"~\"\n\n\nfromInfix :: InfixOp -> Builder\nfromInfix op =\n  case op of\n    OpAdd        -> \" + \"\n    OpSub        -> \" - \"\n    OpMul        -> \" * \"\n    OpDiv        -> \" / \"\n    OpMod        -> \" % \"\n    OpEq         -> \" === \"\n    OpNe         -> \" !== \"\n    OpLt         -> \" < \"\n    OpLe         -> \" <= \"\n    OpGt         -> \" > \"\n    OpGe         -> \" >= \"\n    OpAnd        -> \" && \"\n    OpOr         -> \" || \"\n    OpBitwiseAnd -> \" & \"\n    OpBitwiseXor -> \" ^ \"\n    OpBitwiseOr  -> \" | \"\n    OpLShift     -> \" << \"\n    OpSpRShift   -> \" >> \"\n    OpZfRShift   -> \" >>> \"\n"
  },
  {
    "path": "compiler/src/Generate/JavaScript/Expression.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-x-partial #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Generate.JavaScript.Expression\n  ( generate\n  , generateCtor\n  , generateField\n  , generateTailDef\n  , generateMain\n  , Code\n  , codeToExpr\n  , codeToStmtList\n  )\n  where\n\n\nimport qualified Data.IntMap as IntMap\nimport qualified Data.List as List\nimport Data.Map ((!))\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\nimport qualified Data.Utf8 as Utf8\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified AST.Utils.Shader as Shader\nimport qualified Data.Index as Index\nimport qualified Elm.Compiler.Type as Type\nimport qualified Elm.Compiler.Type.Extract as Extract\nimport qualified Elm.Version as V\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Generate.JavaScript.Builder as JS\nimport qualified Generate.JavaScript.Name as JsName\nimport qualified Generate.Mode as Mode\nimport qualified Json.Encode as Encode\nimport Json.Encode ((==>))\nimport qualified Optimize.DecisionTree as DT\nimport qualified Reporting.Annotation as A\n\n\n\n-- EXPRESSIONS\n\n\ngenerateJsExpr :: Mode.Mode -> Opt.Expr -> JS.Expr\ngenerateJsExpr mode expression =\n  codeToExpr (generate mode expression)\n\n\ngenerate :: Mode.Mode -> Opt.Expr -> Code\ngenerate mode expression =\n  case expression of\n    Opt.Bool bool ->\n      JsExpr $ JS.Bool bool\n\n    Opt.Chr char ->\n      JsExpr $\n        case mode of\n          Mode.Dev _ ->\n            JS.Call toChar [ JS.String (Utf8.toBuilder char) ]\n\n          Mode.Prod _ ->\n            JS.String (Utf8.toBuilder char)\n\n    Opt.Str string ->\n      JsExpr $ JS.String (Utf8.toBuilder string)\n\n    Opt.Int int ->\n      JsExpr $ JS.Int int\n\n    Opt.Float float ->\n      JsExpr $ JS.Float (Utf8.toBuilder float)\n\n    Opt.VarLocal name ->\n      JsExpr $ JS.Ref (JsName.fromLocal name)\n\n    Opt.VarGlobal (Opt.Global home name) ->\n      JsExpr $ JS.Ref (JsName.fromGlobal home name)\n\n    Opt.VarEnum (Opt.Global home name) index ->\n      case mode of\n        Mode.Dev _ ->\n          JsExpr $ JS.Ref (JsName.fromGlobal home name)\n\n        Mode.Prod _ ->\n          JsExpr $ JS.Int (Index.toMachine index)\n\n    Opt.VarBox (Opt.Global home name) ->\n      JsExpr $ JS.Ref $\n        case mode of\n          Mode.Dev _ -> JsName.fromGlobal home name\n          Mode.Prod _ -> JsName.fromGlobal ModuleName.basics Name.identity\n\n    Opt.VarCycle home name ->\n      JsExpr $ JS.Call (JS.Ref (JsName.fromCycle home name)) []\n\n    Opt.VarDebug name home region unhandledValueName ->\n      JsExpr $ generateDebug name home region unhandledValueName\n\n    Opt.VarKernel home name ->\n      JsExpr $ JS.Ref (JsName.fromKernel home name)\n\n    Opt.List entries ->\n      case entries of\n        [] ->\n          JsExpr $ JS.Ref (JsName.fromKernel Name.list \"Nil\")\n\n        _ ->\n          JsExpr $\n            JS.Call\n              (JS.Ref (JsName.fromKernel Name.list \"fromArray\"))\n              [ JS.Array $ map (generateJsExpr mode) entries\n              ]\n\n    Opt.Function args body ->\n      generateFunction (map JsName.fromLocal args) (generate mode body)\n\n    Opt.Call func args ->\n      JsExpr $ generateCall mode func args\n\n    Opt.TailCall name args ->\n      JsBlock $ generateTailCall mode name args\n\n    Opt.If branches final ->\n      generateIf mode branches final\n\n    Opt.Let def body ->\n      JsBlock $\n        generateDef mode def : codeToStmtList (generate mode body)\n\n    Opt.Destruct (Opt.Destructor name path) body ->\n      let\n        pathDef = JS.Var (JsName.fromLocal name) (generatePath mode path)\n      in\n      JsBlock $ pathDef : codeToStmtList (generate mode body)\n\n    Opt.Case label root decider jumps ->\n      JsBlock $ generateCase mode label root decider jumps\n\n    Opt.Accessor field ->\n      JsExpr $ JS.Function Nothing [JsName.dollar]\n        [ JS.Return $\n            JS.Access (JS.Ref JsName.dollar) (generateField mode field)\n        ]\n\n    Opt.Access record field ->\n      JsExpr $ JS.Access (generateJsExpr mode record) (generateField mode field)\n\n    Opt.Update record fields ->\n      JsExpr $\n        JS.Call (JS.Ref (JsName.fromKernel Name.utils \"update\"))\n          [ generateJsExpr mode record\n          , generateRecord mode fields\n          ]\n\n    Opt.Record fields ->\n      JsExpr $ generateRecord mode fields\n\n    Opt.Unit ->\n      case mode of\n        Mode.Dev _ ->\n          JsExpr $ JS.Ref (JsName.fromKernel Name.utils \"Tuple0\")\n\n        Mode.Prod _ ->\n          JsExpr $ JS.Int 0\n\n    Opt.Tuple a b maybeC ->\n      JsExpr $\n        case maybeC of\n          Nothing ->\n            JS.Call (JS.Ref (JsName.fromKernel Name.utils \"Tuple2\"))\n              [ generateJsExpr mode a\n              , generateJsExpr mode b\n              ]\n\n          Just c ->\n            JS.Call (JS.Ref (JsName.fromKernel Name.utils \"Tuple3\"))\n              [ generateJsExpr mode a\n              , generateJsExpr mode b\n              , generateJsExpr mode c\n              ]\n\n    Opt.Shader src attributes uniforms ->\n      let\n        toTranlation field =\n          ( JsName.fromLocal field\n          , JS.String (JsName.toBuilder (generateField mode field))\n          )\n\n        toTranslationObject fields =\n          JS.Object (map toTranlation (Set.toList fields))\n      in\n      JsExpr $ JS.Object $\n        [ ( JsName.fromLocal \"src\", JS.String (Shader.toJsStringBuilder src) )\n        , ( JsName.fromLocal \"attributes\", toTranslationObject attributes )\n        , ( JsName.fromLocal \"uniforms\", toTranslationObject uniforms )\n        ]\n\n\n\n-- CODE CHUNKS\n\n\ndata Code\n    = JsExpr JS.Expr\n    | JsBlock [JS.Stmt]\n\n\ncodeToExpr :: Code -> JS.Expr\ncodeToExpr code =\n  case code of\n    JsExpr expr ->\n      expr\n\n    JsBlock [ JS.Return expr ] ->\n      expr\n\n    JsBlock stmts ->\n      JS.Call (JS.Function Nothing [] stmts) []\n\n\ncodeToStmtList :: Code -> [JS.Stmt]\ncodeToStmtList code =\n  case code of\n    JsExpr (JS.Call (JS.Function Nothing [] stmts) []) ->\n        stmts\n\n    JsExpr expr ->\n        [ JS.Return expr ]\n\n    JsBlock stmts ->\n        stmts\n\n\ncodeToStmt :: Code -> JS.Stmt\ncodeToStmt code =\n  case code of\n    JsExpr (JS.Call (JS.Function Nothing [] stmts) []) ->\n        JS.Block stmts\n\n    JsExpr expr ->\n        JS.Return expr\n\n    JsBlock [stmt] ->\n        stmt\n\n    JsBlock stmts ->\n        JS.Block stmts\n\n\n\n-- CHARS\n\n\n{-# NOINLINE toChar #-}\ntoChar :: JS.Expr\ntoChar =\n  JS.Ref (JsName.fromKernel Name.utils \"chr\")\n\n\n\n-- CTOR\n\n\ngenerateCtor :: Mode.Mode -> Opt.Global -> Index.ZeroBased -> Int -> Code\ngenerateCtor mode (Opt.Global home name) index arity =\n  let\n    argNames =\n      Index.indexedMap (\\i _ -> JsName.fromIndex i) [1 .. arity]\n\n    ctorTag =\n      case mode of\n        Mode.Dev _ -> JS.String (Name.toBuilder name)\n        Mode.Prod _ -> JS.Int (ctorToInt home name index)\n  in\n  generateFunction argNames $ JsExpr $ JS.Object $\n    (JsName.dollar, ctorTag) : map (\\n -> (n, JS.Ref n)) argNames\n\n\nctorToInt :: ModuleName.Canonical -> Name.Name -> Index.ZeroBased -> Int\nctorToInt home name index =\n  if home == ModuleName.dict && name == \"RBNode_elm_builtin\" || name == \"RBEmpty_elm_builtin\" then\n    0 - Index.toHuman index\n  else\n    Index.toMachine index\n\n\n\n-- RECORDS\n\n\ngenerateRecord :: Mode.Mode -> Map.Map Name.Name Opt.Expr -> JS.Expr\ngenerateRecord mode fields =\n  let\n    toPair (field, value) =\n      (generateField mode field, generateJsExpr mode value)\n  in\n  JS.Object (map toPair (Map.toList fields))\n\n\ngenerateField :: Mode.Mode -> Name.Name -> JsName.Name\ngenerateField mode name =\n  case mode of\n    Mode.Dev _ ->\n      JsName.fromLocal name\n\n    Mode.Prod fields ->\n      fields ! name\n\n\n\n\n-- DEBUG\n\n\ngenerateDebug :: Name.Name -> ModuleName.Canonical -> A.Region -> Maybe Name.Name -> JS.Expr\ngenerateDebug name (ModuleName.Canonical _ home) region unhandledValueName =\n  if name /= \"todo\" then\n    JS.Ref (JsName.fromGlobal ModuleName.debug name)\n  else\n    case unhandledValueName of\n      Nothing ->\n        JS.Call (JS.Ref (JsName.fromKernel Name.debug \"todo\")) $\n          [ JS.String (Name.toBuilder home)\n          , regionToJsExpr region\n          ]\n\n      Just valueName ->\n        JS.Call (JS.Ref (JsName.fromKernel Name.debug \"todoCase\")) $\n          [ JS.String (Name.toBuilder home)\n          , regionToJsExpr region\n          , JS.Ref (JsName.fromLocal valueName)\n          ]\n\n\nregionToJsExpr :: A.Region -> JS.Expr\nregionToJsExpr (A.Region start end) =\n  JS.Object\n    [ ( JsName.fromLocal \"start\", positionToJsExpr start )\n    , ( JsName.fromLocal \"end\", positionToJsExpr end )\n    ]\n\n\npositionToJsExpr :: A.Position -> JS.Expr\npositionToJsExpr (A.Position line column) =\n  JS.Object\n    [ ( JsName.fromLocal \"line\", JS.Int (fromIntegral line) )\n    , ( JsName.fromLocal \"column\", JS.Int (fromIntegral column) )\n    ]\n\n\n\n-- FUNCTION\n\n\ngenerateFunction :: [JsName.Name] -> Code -> Code\ngenerateFunction args body =\n  case IntMap.lookup (length args) funcHelpers of\n    Just helper ->\n      JsExpr $\n        JS.Call helper\n          [ JS.Function Nothing args $\n              codeToStmtList body\n          ]\n\n    Nothing ->\n      let\n        addArg arg code =\n          JsExpr $ JS.Function Nothing [arg] $\n            codeToStmtList code\n      in\n      foldr addArg body args\n\n\n{-# NOINLINE funcHelpers #-}\nfuncHelpers :: IntMap.IntMap JS.Expr\nfuncHelpers =\n  IntMap.fromList $\n    map (\\n -> (n, JS.Ref (JsName.makeF n))) [2..9]\n\n\n\n-- CALLS\n\n\ngenerateCall :: Mode.Mode -> Opt.Expr -> [Opt.Expr] -> JS.Expr\ngenerateCall mode func args =\n  case func of\n    Opt.VarGlobal global@(Opt.Global (ModuleName.Canonical pkg _) _) | pkg == Pkg.core ->\n      generateCoreCall mode global args\n\n    Opt.VarBox _ ->\n      case mode of\n        Mode.Dev _ ->\n          generateCallHelp mode func args\n\n        Mode.Prod _ ->\n          case args of\n            [arg] ->\n              generateJsExpr mode arg\n\n            _ ->\n              generateCallHelp mode func args\n\n    _ ->\n      generateCallHelp mode func args\n\n\ngenerateCallHelp :: Mode.Mode -> Opt.Expr -> [Opt.Expr] -> JS.Expr\ngenerateCallHelp mode func args =\n  generateNormalCall\n    (generateJsExpr mode func)\n    (map (generateJsExpr mode) args)\n\n\ngenerateGlobalCall :: ModuleName.Canonical -> Name.Name -> [JS.Expr] -> JS.Expr\ngenerateGlobalCall home name args =\n  generateNormalCall (JS.Ref (JsName.fromGlobal home name)) args\n\n\ngenerateNormalCall :: JS.Expr -> [JS.Expr] -> JS.Expr\ngenerateNormalCall func args =\n  case IntMap.lookup (length args) callHelpers of\n    Just helper ->\n      JS.Call helper (func:args)\n\n    Nothing ->\n      List.foldl' (\\f a -> JS.Call f [a]) func args\n\n\n{-# NOINLINE callHelpers #-}\ncallHelpers :: IntMap.IntMap JS.Expr\ncallHelpers =\n  IntMap.fromList $\n    map (\\n -> (n, JS.Ref (JsName.makeA n))) [2..9]\n\n\n\n-- CORE CALLS\n\n\ngenerateCoreCall :: Mode.Mode -> Opt.Global -> [Opt.Expr] -> JS.Expr\ngenerateCoreCall mode (Opt.Global home@(ModuleName.Canonical _ moduleName) name) args =\n  if moduleName == Name.basics then\n    generateBasicsCall mode home name args\n\n  else if moduleName == Name.bitwise then\n    generateBitwiseCall home name (map (generateJsExpr mode) args)\n\n  else if moduleName == Name.tuple then\n    generateTupleCall home name (map (generateJsExpr mode) args)\n\n  else if moduleName == Name.jsArray then\n    generateJsArrayCall home name (map (generateJsExpr mode) args)\n\n  else\n    generateGlobalCall home name (map (generateJsExpr mode) args)\n\n\ngenerateTupleCall :: ModuleName.Canonical -> Name.Name -> [JS.Expr] -> JS.Expr\ngenerateTupleCall home name args =\n  case args of\n    [value] ->\n      case name of\n        \"first\"  -> JS.Access value (JsName.fromLocal \"a\")\n        \"second\" -> JS.Access value (JsName.fromLocal \"b\")\n        _        -> generateGlobalCall home name args\n\n    _ ->\n      generateGlobalCall home name args\n\n\ngenerateJsArrayCall :: ModuleName.Canonical -> Name.Name -> [JS.Expr] -> JS.Expr\ngenerateJsArrayCall home name args =\n  case args of\n    [entry]        | name == \"singleton\" -> JS.Array [entry]\n    [index, array] | name == \"unsafeGet\" -> JS.Index array index\n    _                                    -> generateGlobalCall home name args\n\n\ngenerateBitwiseCall :: ModuleName.Canonical -> Name.Name -> [JS.Expr] -> JS.Expr\ngenerateBitwiseCall home name args =\n  case args of\n    [arg] ->\n      case name of\n        \"complement\" -> JS.Prefix JS.PrefixComplement arg\n        _            -> generateGlobalCall home name args\n\n    [left,right] ->\n      case name of\n        \"and\"            -> JS.Infix JS.OpBitwiseAnd left right\n        \"or\"             -> JS.Infix JS.OpBitwiseOr  left right\n        \"xor\"            -> JS.Infix JS.OpBitwiseXor left right\n        \"shiftLeftBy\"    -> JS.Infix JS.OpLShift     right left\n        \"shiftRightBy\"   -> JS.Infix JS.OpSpRShift   right left\n        \"shiftRightZfBy\" -> JS.Infix JS.OpZfRShift   right left\n        _                -> generateGlobalCall home name args\n\n    _ ->\n      generateGlobalCall home name args\n\n\ngenerateBasicsCall :: Mode.Mode -> ModuleName.Canonical -> Name.Name -> [Opt.Expr] -> JS.Expr\ngenerateBasicsCall mode home name args =\n  case args of\n    [elmArg] ->\n      let arg = generateJsExpr mode elmArg in\n      case name of\n        \"not\"      -> JS.Prefix JS.PrefixNot arg\n        \"negate\"   -> JS.Prefix JS.PrefixNegate arg\n        \"toFloat\"  -> arg\n        \"truncate\" -> JS.Infix JS.OpBitwiseOr arg (JS.Int 0)\n        _          -> generateGlobalCall home name [arg]\n\n    [elmLeft, elmRight] ->\n      case name of\n        -- NOTE: removed \"composeL\" and \"composeR\" because of this issue:\n        -- https://github.com/elm/compiler/issues/1722\n        \"append\"   -> append mode elmLeft elmRight\n        \"apL\"      -> generateJsExpr mode $ apply elmLeft elmRight\n        \"apR\"      -> generateJsExpr mode $ apply elmRight elmLeft\n        _ ->\n          let\n            left = generateJsExpr mode elmLeft\n            right = generateJsExpr mode elmRight\n          in\n          case name of\n            \"add\"  -> JS.Infix JS.OpAdd left right\n            \"sub\"  -> JS.Infix JS.OpSub left right\n            \"mul\"  -> JS.Infix JS.OpMul left right\n            \"fdiv\" -> JS.Infix JS.OpDiv left right\n            \"idiv\" -> JS.Infix JS.OpBitwiseOr (JS.Infix JS.OpDiv left right) (JS.Int 0)\n            \"eq\"   -> equal left right\n            \"neq\"  -> notEqual left right\n            \"lt\"   -> cmp JS.OpLt JS.OpLt   0  left right\n            \"gt\"   -> cmp JS.OpGt JS.OpGt   0  left right\n            \"le\"   -> cmp JS.OpLe JS.OpLt   1  left right\n            \"ge\"   -> cmp JS.OpGe JS.OpGt (-1) left right\n            \"or\"   -> JS.Infix JS.OpOr  left right\n            \"and\"  -> JS.Infix JS.OpAnd left right\n            \"xor\"  -> JS.Infix JS.OpNe  left right\n            \"remainderBy\" -> JS.Infix JS.OpMod right left\n            _      -> generateGlobalCall home name [left, right]\n\n    _ ->\n      generateGlobalCall home name (map (generateJsExpr mode) args)\n\n\nequal :: JS.Expr -> JS.Expr -> JS.Expr\nequal left right =\n  if isLiteral left || isLiteral right then\n    strictEq left right\n  else\n    JS.Call (JS.Ref (JsName.fromKernel Name.utils \"eq\")) [left, right]\n\n\nnotEqual :: JS.Expr -> JS.Expr -> JS.Expr\nnotEqual left right =\n  if isLiteral left || isLiteral right then\n    strictNEq left right\n  else\n    JS.Prefix JS.PrefixNot $\n      JS.Call (JS.Ref (JsName.fromKernel Name.utils \"eq\")) [left, right]\n\n\ncmp :: JS.InfixOp -> JS.InfixOp -> Int -> JS.Expr -> JS.Expr -> JS.Expr\ncmp idealOp backupOp backupInt left right =\n  if isLiteral left || isLiteral right then\n    JS.Infix idealOp left right\n  else\n    JS.Infix backupOp\n      (JS.Call (JS.Ref (JsName.fromKernel Name.utils \"cmp\")) [left, right])\n      (JS.Int backupInt)\n\n\nisLiteral :: JS.Expr -> Bool\nisLiteral expr =\n  case expr of\n    JS.String _ ->\n      True\n\n    JS.Float _ ->\n      True\n\n    JS.Int _ ->\n      True\n\n    JS.Bool _ ->\n      True\n\n    _ ->\n      False\n\n\napply :: Opt.Expr -> Opt.Expr -> Opt.Expr\napply func value =\n  case func of\n    Opt.Accessor field ->\n      Opt.Access value field\n\n    Opt.Call f args ->\n      Opt.Call f (args ++ [value])\n\n    _ ->\n      Opt.Call func [value]\n\n\nappend :: Mode.Mode -> Opt.Expr -> Opt.Expr -> JS.Expr\nappend mode left right =\n  let seqs = generateJsExpr mode left : toSeqs mode right in\n  if any isStringLiteral seqs then\n    foldr1 (JS.Infix JS.OpAdd) seqs\n  else\n    foldr1 jsAppend seqs\n\n\njsAppend :: JS.Expr -> JS.Expr -> JS.Expr\njsAppend a b =\n  JS.Call (JS.Ref (JsName.fromKernel Name.utils \"ap\")) [a, b]\n\n\ntoSeqs :: Mode.Mode -> Opt.Expr -> [JS.Expr]\ntoSeqs mode expr =\n  case expr of\n    Opt.Call (Opt.VarGlobal (Opt.Global home \"append\")) [left, right]\n      | home == ModuleName.basics ->\n          generateJsExpr mode left : toSeqs mode right\n\n    _ ->\n      [generateJsExpr mode expr]\n\n\nisStringLiteral :: JS.Expr -> Bool\nisStringLiteral expr =\n  case expr of\n    JS.String _ ->\n      True\n\n    _ ->\n      False\n\n\n\n-- SIMPLIFY INFIX OPERATORS\n\n\nstrictEq :: JS.Expr -> JS.Expr -> JS.Expr\nstrictEq left right =\n  case left of\n    JS.Int 0 ->\n      JS.Prefix JS.PrefixNot right\n\n    JS.Bool bool ->\n      if bool then right else JS.Prefix JS.PrefixNot right\n\n    _ ->\n      case right of\n        JS.Int 0 ->\n          JS.Prefix JS.PrefixNot left\n\n        JS.Bool bool ->\n          if bool then left else JS.Prefix JS.PrefixNot left\n\n        _ ->\n          JS.Infix JS.OpEq left right\n\n\nstrictNEq :: JS.Expr -> JS.Expr -> JS.Expr\nstrictNEq left right =\n  case left of\n    JS.Int 0 ->\n      JS.Prefix JS.PrefixNot (JS.Prefix JS.PrefixNot right)\n\n    JS.Bool bool ->\n      if bool then JS.Prefix JS.PrefixNot right else right\n\n    _ ->\n      case right of\n        JS.Int 0 ->\n          JS.Prefix JS.PrefixNot (JS.Prefix JS.PrefixNot left)\n\n        JS.Bool bool ->\n          if bool then JS.Prefix JS.PrefixNot left else left\n\n        _ ->\n          JS.Infix JS.OpNe left right\n\n\n\n-- TAIL CALL\n\n\n-- TODO check if JS minifiers collapse unnecessary temporary variables\n--\ngenerateTailCall :: Mode.Mode -> Name.Name -> [(Name.Name, Opt.Expr)] -> [JS.Stmt]\ngenerateTailCall mode name args =\n  let\n    toTempVars (argName, arg) =\n      ( JsName.makeTemp argName, generateJsExpr mode arg )\n\n    toRealVars (argName, _) =\n      JS.ExprStmt $\n        JS.Assign (JS.LRef (JsName.fromLocal argName)) (JS.Ref (JsName.makeTemp argName))\n  in\n  JS.Vars (map toTempVars args)\n  : map toRealVars args\n  ++ [ JS.Continue (Just (JsName.fromLocal name)) ]\n\n\n\n-- DEFINITIONS\n\n\ngenerateDef :: Mode.Mode -> Opt.Def -> JS.Stmt\ngenerateDef mode def =\n  case def of\n    Opt.Def name body ->\n      JS.Var (JsName.fromLocal name) (generateJsExpr mode body)\n\n    Opt.TailDef name argNames body ->\n      JS.Var (JsName.fromLocal name) (codeToExpr (generateTailDef mode name argNames body))\n\n\ngenerateTailDef :: Mode.Mode -> Name.Name -> [Name.Name] -> Opt.Expr -> Code\ngenerateTailDef mode name argNames body =\n  generateFunction (map JsName.fromLocal argNames) $ JsBlock $\n    [ JS.Labelled (JsName.fromLocal name) $\n        JS.While (JS.Bool True) $\n          codeToStmt $ generate mode body\n    ]\n\n\n\n-- PATHS\n\n\ngeneratePath :: Mode.Mode -> Opt.Path -> JS.Expr\ngeneratePath mode path =\n  case path of\n    Opt.Index index subPath ->\n      JS.Access (generatePath mode subPath) (JsName.fromIndex index)\n\n    Opt.Root name ->\n      JS.Ref (JsName.fromLocal name)\n\n    Opt.Field field subPath ->\n      JS.Access (generatePath mode subPath) (generateField mode field)\n\n    Opt.Unbox subPath ->\n      case mode of\n        Mode.Dev _ ->\n          JS.Access (generatePath mode subPath) (JsName.fromIndex Index.first)\n\n        Mode.Prod _ ->\n          generatePath mode subPath\n\n\n\n-- GENERATE IFS\n\n\ngenerateIf :: Mode.Mode -> [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> Code\ngenerateIf mode givenBranches givenFinal =\n  let\n    (branches, final) =\n      crushIfs givenBranches givenFinal\n\n    convertBranch (condition, expr) =\n      ( generateJsExpr mode condition\n      , generate mode expr\n      )\n\n    branchExprs = map convertBranch branches\n    finalCode = generate mode final\n  in\n  if isBlock finalCode || any (isBlock . snd) branchExprs then\n    JsBlock [ foldr addStmtIf (codeToStmt finalCode) branchExprs ]\n  else\n    JsExpr $ foldr addExprIf (codeToExpr finalCode) branchExprs\n\n\naddExprIf :: (JS.Expr, Code) -> JS.Expr -> JS.Expr\naddExprIf (condition, branch) final =\n  JS.If condition (codeToExpr branch) final\n\n\naddStmtIf :: (JS.Expr, Code) -> JS.Stmt -> JS.Stmt\naddStmtIf (condition, branch) final =\n  JS.IfStmt condition (codeToStmt branch) final\n\n\nisBlock :: Code -> Bool\nisBlock code =\n  case code of\n    JsBlock _ -> True\n    JsExpr _ -> False\n\n\ncrushIfs :: [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> ([(Opt.Expr, Opt.Expr)], Opt.Expr)\ncrushIfs branches final =\n  crushIfsHelp [] branches final\n\n\ncrushIfsHelp\n    :: [(Opt.Expr, Opt.Expr)]\n    -> [(Opt.Expr, Opt.Expr)]\n    -> Opt.Expr\n    -> ([(Opt.Expr, Opt.Expr)], Opt.Expr)\ncrushIfsHelp visitedBranches unvisitedBranches final =\n  case unvisitedBranches of\n    [] ->\n        case final of\n          Opt.If subBranches subFinal ->\n              crushIfsHelp visitedBranches subBranches subFinal\n\n          _ ->\n              (reverse visitedBranches, final)\n\n    visiting : unvisited ->\n        crushIfsHelp (visiting : visitedBranches) unvisited final\n\n\n\n-- CASE EXPRESSIONS\n\n\ngenerateCase :: Mode.Mode -> Name.Name -> Name.Name -> Opt.Decider Opt.Choice -> [(Int, Opt.Expr)] -> [JS.Stmt]\ngenerateCase mode label root decider jumps =\n  foldr (goto mode label) (generateDecider mode label root decider) jumps\n\n\ngoto :: Mode.Mode -> Name.Name -> (Int, Opt.Expr) -> [JS.Stmt] -> [JS.Stmt]\ngoto mode label (index, branch) stmts =\n  let\n    labeledDeciderStmt =\n      JS.Labelled\n        (JsName.makeLabel label index)\n        (JS.While (JS.Bool True) (JS.Block stmts))\n  in\n  labeledDeciderStmt : codeToStmtList (generate mode branch)\n\n\ngenerateDecider :: Mode.Mode -> Name.Name -> Name.Name -> Opt.Decider Opt.Choice -> [JS.Stmt]\ngenerateDecider mode label root decisionTree =\n  case decisionTree of\n    Opt.Leaf (Opt.Inline branch) ->\n      codeToStmtList (generate mode branch)\n\n    Opt.Leaf (Opt.Jump index) ->\n      [ JS.Break (Just (JsName.makeLabel label index)) ]\n\n    Opt.Chain testChain success failure ->\n      [ JS.IfStmt\n          (List.foldl1' (JS.Infix JS.OpAnd) (map (generateIfTest mode root) testChain))\n          (JS.Block $ generateDecider mode label root success)\n          (JS.Block $ generateDecider mode label root failure)\n      ]\n\n    Opt.FanOut path edges fallback ->\n      [ JS.Switch\n          (generateCaseTest mode root path (fst (head edges)))\n          ( foldr\n              (\\edge cases -> generateCaseBranch mode label root edge : cases)\n              [ JS.Default (generateDecider mode label root fallback) ]\n              edges\n          )\n      ]\n\n\ngenerateIfTest :: Mode.Mode -> Name.Name -> (DT.Path, DT.Test) -> JS.Expr\ngenerateIfTest mode root (path, test) =\n  let\n    value = pathToJsExpr mode root path\n  in\n  case test of\n    DT.IsCtor home name index _ opts ->\n      let\n        tag =\n          case mode of\n            Mode.Dev _ -> JS.Access value JsName.dollar\n            Mode.Prod _ ->\n              case opts of\n                Can.Normal -> JS.Access value JsName.dollar\n                Can.Enum   -> value\n                Can.Unbox  -> value\n      in\n      strictEq tag $\n        case mode of\n          Mode.Dev _ -> JS.String (Name.toBuilder name)\n          Mode.Prod _ -> JS.Int (ctorToInt home name index)\n\n    DT.IsBool True ->\n      value\n\n    DT.IsBool False ->\n      JS.Prefix JS.PrefixNot value\n\n    DT.IsInt int ->\n      strictEq value (JS.Int int)\n\n    DT.IsChr char ->\n      strictEq (JS.String (Utf8.toBuilder char)) $\n        case mode of\n          Mode.Dev _ -> JS.Call (JS.Access value (JsName.fromLocal \"valueOf\")) []\n          Mode.Prod _ -> value\n\n    DT.IsStr string ->\n      strictEq value (JS.String (Utf8.toBuilder string))\n\n    DT.IsCons ->\n      JS.Access value (JsName.fromLocal \"b\")\n\n    DT.IsNil ->\n      JS.Prefix JS.PrefixNot $\n        JS.Access value (JsName.fromLocal \"b\")\n\n    DT.IsTuple ->\n      error \"COMPILER BUG - there should never be tests on a tuple\"\n\n\n\ngenerateCaseBranch :: Mode.Mode -> Name.Name -> Name.Name -> (DT.Test, Opt.Decider Opt.Choice) -> JS.Case\ngenerateCaseBranch mode label root (test, subTree) =\n  JS.Case\n    (generateCaseValue mode test)\n    (generateDecider mode label root subTree)\n\n\ngenerateCaseValue :: Mode.Mode -> DT.Test -> JS.Expr\ngenerateCaseValue mode test =\n  case test of\n    DT.IsCtor home name index _ _ ->\n      case mode of\n        Mode.Dev _ -> JS.String (Name.toBuilder name)\n        Mode.Prod _ -> JS.Int (ctorToInt home name index)\n\n    DT.IsInt int ->\n      JS.Int int\n\n    DT.IsChr char ->\n      JS.String (Utf8.toBuilder char)\n\n    DT.IsStr string ->\n      JS.String (Utf8.toBuilder string)\n\n    DT.IsBool _ ->\n      error \"COMPILER BUG - there should never be three tests on a boolean\"\n\n    DT.IsCons ->\n      error \"COMPILER BUG - there should never be three tests on a list\"\n\n    DT.IsNil ->\n      error \"COMPILER BUG - there should never be three tests on a list\"\n\n    DT.IsTuple ->\n      error \"COMPILER BUG - there should never be three tests on a tuple\"\n\n\ngenerateCaseTest :: Mode.Mode -> Name.Name -> DT.Path -> DT.Test -> JS.Expr\ngenerateCaseTest mode root path exampleTest =\n  let\n    value = pathToJsExpr mode root path\n  in\n  case exampleTest of\n    DT.IsCtor home name _ _ opts ->\n      if name == Name.bool && home == ModuleName.basics then\n        value\n      else\n        case mode of\n          Mode.Dev _ ->\n            JS.Access value JsName.dollar\n\n          Mode.Prod _ ->\n            case opts of\n              Can.Normal ->\n                JS.Access value JsName.dollar\n\n              Can.Enum ->\n                value\n\n              Can.Unbox ->\n                value\n\n    DT.IsInt _ ->\n      value\n\n    DT.IsStr _ ->\n      value\n\n    DT.IsChr _ ->\n      case mode of\n        Mode.Dev _ ->\n          JS.Call (JS.Access value (JsName.fromLocal \"valueOf\")) []\n\n        Mode.Prod _ ->\n          value\n\n    DT.IsBool _ ->\n      error \"COMPILER BUG - there should never be three tests on a list\"\n\n    DT.IsCons ->\n      error \"COMPILER BUG - there should never be three tests on a list\"\n\n    DT.IsNil ->\n      error \"COMPILER BUG - there should never be three tests on a list\"\n\n    DT.IsTuple ->\n      error \"COMPILER BUG - there should never be three tests on a list\"\n\n\n\n-- PATTERN PATHS\n\n\npathToJsExpr :: Mode.Mode -> Name.Name -> DT.Path -> JS.Expr\npathToJsExpr mode root path =\n  case path of\n    DT.Index index subPath ->\n      JS.Access (pathToJsExpr mode root subPath) (JsName.fromIndex index)\n\n    DT.Unbox subPath ->\n      case mode of\n        Mode.Dev _ ->\n          JS.Access (pathToJsExpr mode root subPath) (JsName.fromIndex Index.first)\n\n        Mode.Prod _ ->\n          pathToJsExpr mode root subPath\n\n    DT.Empty ->\n      JS.Ref (JsName.fromLocal root)\n\n\n\n-- GENERATE MAIN\n\n\ngenerateMain :: Mode.Mode -> ModuleName.Canonical -> Opt.Main -> JS.Expr\ngenerateMain mode home main =\n  case main of\n    Opt.Static ->\n      JS.Ref (JsName.fromKernel Name.virtualDom \"init\")\n        # JS.Ref (JsName.fromGlobal home \"main\")\n        # JS.Int 0\n        # JS.Int 0\n\n    Opt.Dynamic msgType decoder ->\n      JS.Ref (JsName.fromGlobal home \"main\")\n        # generateJsExpr mode decoder\n        # toDebugMetadata mode msgType\n\n\n(#) :: JS.Expr -> JS.Expr -> JS.Expr\n(#) func arg =\n  JS.Call func [arg]\n\n\ntoDebugMetadata :: Mode.Mode -> Can.Type -> JS.Expr\ntoDebugMetadata mode msgType =\n  case mode of\n    Mode.Prod _ ->\n      JS.Int 0\n\n    Mode.Dev Nothing ->\n      JS.Int 0\n\n    Mode.Dev (Just interfaces) ->\n      JS.Json $ Encode.object $\n        [ \"versions\" ==> Encode.object [ \"elm\" ==> V.encode V.compiler ]\n        , \"types\"    ==> Type.encodeMetadata (Extract.fromMsg interfaces msgType)\n        ]\n"
  },
  {
    "path": "compiler/src/Generate/JavaScript/Functions.hs",
    "content": "{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}\nmodule Generate.JavaScript.Functions\n  ( functions\n  )\n  where\n\n\nimport qualified Data.ByteString.Builder as B\nimport Text.RawString.QQ (r)\n\n\n\n-- FUNCTIONS\n\n\nfunctions :: B.Builder\nfunctions = [r|\n\nfunction F(arity, fun, wrapper) {\n  wrapper.a = arity;\n  wrapper.f = fun;\n  return wrapper;\n}\n\nfunction F2(fun) {\n  return F(2, fun, function(a) { return function(b) { return fun(a,b); }; })\n}\nfunction F3(fun) {\n  return F(3, fun, function(a) {\n    return function(b) { return function(c) { return fun(a, b, c); }; };\n  });\n}\nfunction F4(fun) {\n  return F(4, fun, function(a) { return function(b) { return function(c) {\n    return function(d) { return fun(a, b, c, d); }; }; };\n  });\n}\nfunction F5(fun) {\n  return F(5, fun, function(a) { return function(b) { return function(c) {\n    return function(d) { return function(e) { return fun(a, b, c, d, e); }; }; }; };\n  });\n}\nfunction F6(fun) {\n  return F(6, fun, function(a) { return function(b) { return function(c) {\n    return function(d) { return function(e) { return function(f) {\n    return fun(a, b, c, d, e, f); }; }; }; }; };\n  });\n}\nfunction F7(fun) {\n  return F(7, fun, function(a) { return function(b) { return function(c) {\n    return function(d) { return function(e) { return function(f) {\n    return function(g) { return fun(a, b, c, d, e, f, g); }; }; }; }; }; };\n  });\n}\nfunction F8(fun) {\n  return F(8, fun, function(a) { return function(b) { return function(c) {\n    return function(d) { return function(e) { return function(f) {\n    return function(g) { return function(h) {\n    return fun(a, b, c, d, e, f, g, h); }; }; }; }; }; }; };\n  });\n}\nfunction F9(fun) {\n  return F(9, fun, function(a) { return function(b) { return function(c) {\n    return function(d) { return function(e) { return function(f) {\n    return function(g) { return function(h) { return function(i) {\n    return fun(a, b, c, d, e, f, g, h, i); }; }; }; }; }; }; }; };\n  });\n}\n\nfunction A2(fun, a, b) {\n  return fun.a === 2 ? fun.f(a, b) : fun(a)(b);\n}\nfunction A3(fun, a, b, c) {\n  return fun.a === 3 ? fun.f(a, b, c) : fun(a)(b)(c);\n}\nfunction A4(fun, a, b, c, d) {\n  return fun.a === 4 ? fun.f(a, b, c, d) : fun(a)(b)(c)(d);\n}\nfunction A5(fun, a, b, c, d, e) {\n  return fun.a === 5 ? fun.f(a, b, c, d, e) : fun(a)(b)(c)(d)(e);\n}\nfunction A6(fun, a, b, c, d, e, f) {\n  return fun.a === 6 ? fun.f(a, b, c, d, e, f) : fun(a)(b)(c)(d)(e)(f);\n}\nfunction A7(fun, a, b, c, d, e, f, g) {\n  return fun.a === 7 ? fun.f(a, b, c, d, e, f, g) : fun(a)(b)(c)(d)(e)(f)(g);\n}\nfunction A8(fun, a, b, c, d, e, f, g, h) {\n  return fun.a === 8 ? fun.f(a, b, c, d, e, f, g, h) : fun(a)(b)(c)(d)(e)(f)(g)(h);\n}\nfunction A9(fun, a, b, c, d, e, f, g, h, i) {\n  return fun.a === 9 ? fun.f(a, b, c, d, e, f, g, h, i) : fun(a)(b)(c)(d)(e)(f)(g)(h)(i);\n}\n\n|]\n"
  },
  {
    "path": "compiler/src/Generate/JavaScript/Name.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Generate.JavaScript.Name\n  ( Name\n  , toBuilder\n  , fromIndex\n  , fromInt\n  , fromLocal\n  , fromGlobal\n  , fromCycle\n  , fromKernel\n  , makeF\n  , makeA\n  , makeLabel\n  , makeTemp\n  , dollar\n  )\n  where\n\n\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\nimport qualified Data.Utf8 as Utf8\nimport Data.Word (Word8)\n\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\n\n\n\n-- NAME\n\n\nnewtype Name =\n  Name { toBuilder :: B.Builder }\n\n\n\n-- CONSTRUCTORS\n\n\nfromIndex :: Index.ZeroBased -> Name\nfromIndex index =\n  fromInt (Index.toMachine index)\n\n\nfromInt :: Int -> Name\nfromInt n =\n  Name (Name.toBuilder (intToAscii n))\n\n\nfromLocal :: Name.Name -> Name\nfromLocal name =\n  if Set.member name reservedNames then\n    Name (\"_\" <> Name.toBuilder name)\n  else\n    Name (Name.toBuilder name)\n\n\nfromGlobal :: ModuleName.Canonical -> Name.Name -> Name\nfromGlobal home name =\n  Name $ homeToBuilder home <> usd <> Name.toBuilder name\n\n\nfromCycle :: ModuleName.Canonical -> Name.Name -> Name\nfromCycle home name =\n  Name $ homeToBuilder home <> \"$cyclic$\" <> Name.toBuilder name\n\n\nfromKernel :: Name.Name -> Name.Name -> Name\nfromKernel home name =\n  Name (\"_\" <> Name.toBuilder home <> \"_\" <> Name.toBuilder name)\n\n\n{-# INLINE homeToBuilder #-}\nhomeToBuilder :: ModuleName.Canonical -> B.Builder\nhomeToBuilder (ModuleName.Canonical (Pkg.Name author project) home) =\n  usd <>\n  Utf8.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} author\n  <> usd <>\n  Utf8.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} project\n  <> usd <>\n  Utf8.toEscapedBuilder 0x2E {- . -} 0x24 {- $ -} home\n\n\n\n-- TEMPORARY NAMES\n\n\nmakeF :: Int -> Name\nmakeF n =\n  Name (\"F\" <> B.intDec n)\n\n\nmakeA :: Int -> Name\nmakeA n =\n  Name (\"A\" <> B.intDec n)\n\n\nmakeLabel :: Name.Name -> Int -> Name\nmakeLabel name index =\n  Name (Name.toBuilder name <> usd <> B.intDec index)\n\n\nmakeTemp :: Name.Name -> Name\nmakeTemp name =\n  Name (\"$temp$\" <> Name.toBuilder name)\n\n\ndollar :: Name\ndollar =\n  Name usd\n\n\nusd :: B.Builder\nusd =\n  Name.toBuilder Name.dollar\n\n\n\n-- RESERVED NAMES\n\n\n{-# NOINLINE reservedNames #-}\nreservedNames :: Set.Set Name.Name\nreservedNames =\n  Set.union jsReservedWords elmReservedWords\n\n\njsReservedWords :: Set.Set Name.Name\njsReservedWords =\n  Set.fromList\n    [ \"do\", \"if\", \"in\"\n    , \"NaN\", \"int\", \"for\", \"new\", \"try\", \"var\", \"let\"\n    , \"null\", \"true\", \"eval\", \"byte\", \"char\", \"goto\", \"long\", \"case\", \"else\", \"this\", \"void\", \"with\", \"enum\"\n    , \"false\", \"final\", \"float\", \"short\", \"break\", \"catch\", \"throw\", \"while\", \"class\", \"const\", \"super\", \"yield\"\n    , \"double\", \"native\", \"throws\", \"delete\", \"return\", \"switch\", \"typeof\", \"export\", \"import\", \"public\", \"static\"\n    , \"boolean\", \"default\", \"finally\", \"extends\", \"package\", \"private\"\n    , \"Infinity\", \"abstract\", \"volatile\", \"function\", \"continue\", \"debugger\", \"function\"\n    , \"undefined\", \"arguments\", \"transient\", \"interface\", \"protected\"\n    , \"instanceof\", \"implements\"\n    , \"synchronized\"\n    ]\n\n\nelmReservedWords :: Set.Set Name.Name\nelmReservedWords =\n  Set.fromList\n    [ \"F2\", \"F3\", \"F4\", \"F5\", \"F6\", \"F7\", \"F8\", \"F9\"\n    , \"A2\", \"A3\", \"A4\", \"A5\", \"A6\", \"A7\", \"A8\", \"A9\"\n    ]\n\n\n\n-- INT TO ASCII\n\n\nintToAscii :: Int -> Name.Name\nintToAscii n =\n  if n < 53 then -- skip $ as a standalone name\n    Name.fromWords [toByte n]\n\n  else\n    intToAsciiHelp 2 (numStartBytes * numInnerBytes) allBadFields (n - 53)\n\n\nintToAsciiHelp :: Int -> Int -> [BadFields] -> Int -> Name.Name\nintToAsciiHelp width blockSize badFields n =\n  case badFields of\n    [] ->\n      if n < blockSize then\n        unsafeIntToAscii width [] n\n      else\n        intToAsciiHelp (width + 1) (blockSize * numInnerBytes) [] (n - blockSize)\n\n    BadFields renamings : biggerBadFields ->\n      let availableSize = blockSize - Map.size renamings in\n      if n < availableSize then\n        let name = unsafeIntToAscii width [] n in\n        Map.findWithDefault name name renamings\n      else\n        intToAsciiHelp (width + 1) (blockSize * numInnerBytes) biggerBadFields (n - availableSize)\n\n\n\n-- UNSAFE INT TO ASCII\n\n\nunsafeIntToAscii :: Int -> [Word8] -> Int -> Name.Name\nunsafeIntToAscii width bytes n =\n  if width <= 1 then\n    Name.fromWords (toByte n : bytes)\n  else\n    let\n      (quotient, remainder) =\n        quotRem n numInnerBytes\n    in\n    unsafeIntToAscii (width - 1) (toByte remainder : bytes) quotient\n\n\n\n-- ASCII BYTES\n\n\nnumStartBytes :: Int\nnumStartBytes =\n  54\n\n\nnumInnerBytes :: Int\nnumInnerBytes =\n  64\n\n\ntoByte :: Int -> Word8\ntoByte n\n  | n < 26  = fromIntegral (97 + n     ) {- lower -}\n  | n < 52  = fromIntegral (65 + n - 26) {- upper -}\n  | n == 52 = 95 {- _ -}\n  | n == 53 = 36 {- $ -}\n  | n < 64  = fromIntegral (48 + n - 54) {- digit -}\n  | True    = error $ \"cannot convert int \" ++ show n ++ \" to ASCII\"\n\n\n\n-- BAD FIELDS\n\n\nnewtype BadFields =\n  BadFields { _renamings :: Renamings }\n\n\ntype Renamings =\n  Map.Map Name.Name Name.Name\n\n\nallBadFields :: [BadFields]\nallBadFields =\n  let\n    add keyword dict =\n      Map.alter (Just . addRenaming keyword) (Utf8.size keyword) dict\n  in\n    Map.elems $ Set.foldr add Map.empty jsReservedWords\n\n\naddRenaming :: Name.Name -> Maybe BadFields -> BadFields\naddRenaming keyword maybeBadFields =\n  let\n    width = Utf8.size keyword\n    maxName = numStartBytes * numInnerBytes ^ (width - 1) - 1\n  in\n  case maybeBadFields of\n    Nothing ->\n      BadFields $ Map.singleton keyword (unsafeIntToAscii width [] maxName)\n\n    Just (BadFields renamings) ->\n      BadFields $ Map.insert keyword (unsafeIntToAscii width [] (maxName - Map.size renamings)) renamings\n"
  },
  {
    "path": "compiler/src/Generate/JavaScript.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Generate.JavaScript\n  ( generate\n  , generateForRepl\n  , generateForReplEndpoint\n  )\n  where\n\n\nimport Prelude hiding (cycle, print)\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.List as List\nimport Data.Map ((!))\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\nimport qualified Data.Utf8 as Utf8\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified Data.Index as Index\nimport qualified Elm.Kernel as K\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Generate.JavaScript.Builder as JS\nimport qualified Generate.JavaScript.Expression as Expr\nimport qualified Generate.JavaScript.Functions as Functions\nimport qualified Generate.JavaScript.Name as JsName\nimport qualified Generate.Mode as Mode\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Render.Type as RT\nimport qualified Reporting.Render.Type.Localizer as L\n\n\n\n-- GENERATE\n\n\ntype Graph = Map.Map Opt.Global Opt.Node\ntype Mains = Map.Map ModuleName.Canonical Opt.Main\n\n\ngenerate :: Mode.Mode -> Opt.GlobalGraph -> Mains -> B.Builder\ngenerate mode (Opt.GlobalGraph graph _) mains =\n  let\n    state = Map.foldrWithKey (addMain mode graph) emptyState mains\n  in\n  \"(function(scope){\\n'use strict';\"\n  <> Functions.functions\n  <> perfNote mode\n  <> stateToBuilder state\n  <> toMainExports mode mains\n  <> \"}(this));\"\n\n\naddMain :: Mode.Mode -> Graph -> ModuleName.Canonical -> Opt.Main -> State -> State\naddMain mode graph home _ state =\n  addGlobal mode graph state (Opt.Global home \"main\")\n\n\nperfNote :: Mode.Mode -> B.Builder\nperfNote mode =\n  case mode of\n    Mode.Prod _ ->\n      \"\"\n\n    Mode.Dev Nothing ->\n      \"console.warn('Compiled in DEV mode. Follow the advice at \"\n      <> B.stringUtf8 (D.makeNakedLink \"optimize\")\n      <> \" for better performance and smaller assets.');\"\n\n    Mode.Dev (Just _) ->\n      \"console.warn('Compiled in DEBUG mode. Follow the advice at \"\n      <> B.stringUtf8 (D.makeNakedLink \"optimize\")\n      <> \" for better performance and smaller assets.');\"\n\n\n\n-- GENERATE FOR REPL\n\n\ngenerateForRepl :: Bool -> L.Localizer -> Opt.GlobalGraph -> ModuleName.Canonical -> Name.Name -> Can.Annotation -> B.Builder\ngenerateForRepl ansi localizer (Opt.GlobalGraph graph _) home name (Can.Forall _ tipe) =\n  let\n    mode = Mode.Dev Nothing\n    debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug \"toString\")\n    evalState = addGlobal mode graph debugState (Opt.Global home name)\n  in\n  \"process.on('uncaughtException', function(err) { process.stderr.write(err.toString() + '\\\\n'); process.exit(1); });\"\n  <> Functions.functions\n  <> stateToBuilder evalState\n  <> print ansi localizer home name tipe\n\n\nprint :: Bool -> L.Localizer -> ModuleName.Canonical -> Name.Name -> Can.Type -> B.Builder\nprint ansi localizer home name tipe =\n  let\n    value = JsName.toBuilder (JsName.fromGlobal home name)\n    toString = JsName.toBuilder (JsName.fromKernel Name.debug \"toAnsiString\")\n    tipeDoc = RT.canToDoc localizer RT.None tipe\n    bool = if ansi then \"true\" else \"false\"\n  in\n  \"var _value = \" <> toString <> \"(\" <> bool <> \", \" <> value <> \");\\n\\\n  \\var _type = \" <> B.stringUtf8 (show (D.toString tipeDoc)) <> \";\\n\\\n  \\function _print(t) { console.log(_value + (\" <> bool <> \" ? '\\x1b[90m' + t + '\\x1b[0m' : t)); }\\n\\\n  \\if (_value.length + 3 + _type.length >= 80 || _type.indexOf('\\\\n') >= 0) {\\n\\\n  \\    _print('\\\\n    : ' + _type.split('\\\\n').join('\\\\n      '));\\n\\\n  \\} else {\\n\\\n  \\    _print(' : ' + _type);\\n\\\n  \\}\\n\"\n\n\n\n-- GENERATE FOR REPL ENDPOINT\n\n\ngenerateForReplEndpoint :: L.Localizer -> Opt.GlobalGraph -> ModuleName.Canonical -> Maybe Name.Name -> Can.Annotation -> B.Builder\ngenerateForReplEndpoint localizer (Opt.GlobalGraph graph _) home maybeName (Can.Forall _ tipe) =\n  let\n    name = maybe Name.replValueToPrint id maybeName\n    mode = Mode.Dev Nothing\n    debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug \"toString\")\n    evalState = addGlobal mode graph debugState (Opt.Global home name)\n  in\n  Functions.functions\n  <> stateToBuilder evalState\n  <> postMessage localizer home maybeName tipe\n\n\npostMessage :: L.Localizer -> ModuleName.Canonical -> Maybe Name.Name -> Can.Type -> B.Builder\npostMessage localizer home maybeName tipe =\n  let\n    name = maybe Name.replValueToPrint id maybeName\n    value = JsName.toBuilder (JsName.fromGlobal home name)\n    toString = JsName.toBuilder (JsName.fromKernel Name.debug \"toAnsiString\")\n    tipeDoc = RT.canToDoc localizer RT.None tipe\n    toName n = \"\\\"\" <> Name.toBuilder n <> \"\\\"\"\n  in\n  \"self.postMessage({\\n\\\n  \\  name: \" <> maybe \"null\" toName maybeName <> \",\\n\\\n  \\  value: \" <> toString <> \"(true, \" <> value <> \"),\\n\\\n  \\  type: \" <> B.stringUtf8 (show (D.toString tipeDoc)) <> \"\\n\\\n  \\});\\n\"\n\n\n\n-- GRAPH TRAVERSAL STATE\n\n\ndata State =\n  State\n    { _revKernels :: [B.Builder]\n    , _revBuilders :: [B.Builder]\n    , _seenGlobals :: Set.Set Opt.Global\n    }\n\n\nemptyState :: State\nemptyState =\n  State mempty [] Set.empty\n\n\nstateToBuilder :: State -> B.Builder\nstateToBuilder (State revKernels revBuilders _) =\n  prependBuilders revKernels (prependBuilders revBuilders mempty)\n\n\nprependBuilders :: [B.Builder] -> B.Builder -> B.Builder\nprependBuilders revBuilders monolith =\n  List.foldl' (\\m b -> b <> m) monolith revBuilders\n\n\n\n-- ADD DEPENDENCIES\n\n\naddGlobal :: Mode.Mode -> Graph -> State -> Opt.Global -> State\naddGlobal mode graph state@(State revKernels builders seen) global =\n  if Set.member global seen then\n    state\n  else\n    addGlobalHelp mode graph global $\n      State revKernels builders (Set.insert global seen)\n\n\naddGlobalHelp :: Mode.Mode -> Graph -> Opt.Global -> State -> State\naddGlobalHelp mode graph global state =\n  let\n    addDeps deps someState =\n      Set.foldl' (addGlobal mode graph) someState deps\n  in\n  case graph ! global of\n    Opt.Define expr deps ->\n      addStmt (addDeps deps state) (\n        var global (Expr.generate mode expr)\n      )\n\n    Opt.DefineTailFunc argNames body deps ->\n      addStmt (addDeps deps state) (\n        let (Opt.Global _ name) = global in\n        var global (Expr.generateTailDef mode name argNames body)\n      )\n\n    Opt.Ctor index arity ->\n      addStmt state (\n        var global (Expr.generateCtor mode global index arity)\n      )\n\n    Opt.Link linkedGlobal ->\n      addGlobal mode graph state linkedGlobal\n\n    Opt.Cycle names values functions deps ->\n      addStmt (addDeps deps state) (\n        generateCycle mode global names values functions\n      )\n\n    Opt.Manager effectsType ->\n      generateManager mode graph global effectsType state\n\n    Opt.Kernel chunks deps ->\n      if isDebugger global && not (Mode.isDebug mode) then\n        state\n      else\n        addKernel (addDeps deps state) (generateKernel mode chunks)\n\n    Opt.Enum index ->\n      addStmt state (\n        generateEnum mode global index\n      )\n\n    Opt.Box ->\n      addStmt (addGlobal mode graph state identity) (\n        generateBox mode global\n      )\n\n    Opt.PortIncoming decoder deps ->\n      addStmt (addDeps deps state) (\n        generatePort mode global \"incomingPort\" decoder\n      )\n\n    Opt.PortOutgoing encoder deps ->\n      addStmt (addDeps deps state) (\n        generatePort mode global \"outgoingPort\" encoder\n      )\n\n\naddStmt :: State -> JS.Stmt -> State\naddStmt state stmt =\n  addBuilder state (JS.stmtToBuilder stmt)\n\n\naddBuilder :: State -> B.Builder -> State\naddBuilder (State revKernels revBuilders seen) builder =\n  State revKernels (builder:revBuilders) seen\n\n\naddKernel :: State -> B.Builder -> State\naddKernel (State revKernels revBuilders seen) kernel =\n  State (kernel:revKernels) revBuilders seen\n\n\nvar :: Opt.Global -> Expr.Code -> JS.Stmt\nvar (Opt.Global home name) code =\n  JS.Var (JsName.fromGlobal home name) (Expr.codeToExpr code)\n\n\nisDebugger :: Opt.Global -> Bool\nisDebugger (Opt.Global (ModuleName.Canonical _ home) _) =\n  home == Name.debugger\n\n\n\n-- GENERATE CYCLES\n\n\ngenerateCycle :: Mode.Mode -> Opt.Global -> [Name.Name] -> [(Name.Name, Opt.Expr)] -> [Opt.Def] -> JS.Stmt\ngenerateCycle mode (Opt.Global home _) names values functions =\n  JS.Block\n    [ JS.Block $ map (generateCycleFunc mode home) functions\n    , JS.Block $ map (generateSafeCycle mode home) values\n    , case map (generateRealCycle home) values of\n        [] ->\n          JS.EmptyStmt\n\n        realBlock@(_:_) ->\n            case mode of\n              Mode.Prod _ ->\n                JS.Block realBlock\n\n              Mode.Dev _ ->\n                JS.Try (JS.Block realBlock) JsName.dollar $ JS.Throw $ JS.String $\n                  \"Some top-level definitions from `\" <> Name.toBuilder (ModuleName._module home) <> \"` are causing infinite recursion:\\\\n\"\n                  <> drawCycle names\n                  <> \"\\\\n\\\\nThese errors are very tricky, so read \"\n                  <> B.stringUtf8 (D.makeNakedLink \"bad-recursion\")\n                  <> \" to learn how to fix it!\"\n    ]\n\n\ngenerateCycleFunc :: Mode.Mode -> ModuleName.Canonical -> Opt.Def -> JS.Stmt\ngenerateCycleFunc mode home def =\n  case def of\n    Opt.Def name expr ->\n      JS.Var (JsName.fromGlobal home name) (Expr.codeToExpr (Expr.generate mode expr))\n\n    Opt.TailDef name args expr ->\n      JS.Var (JsName.fromGlobal home name) (Expr.codeToExpr (Expr.generateTailDef mode name args expr))\n\n\ngenerateSafeCycle :: Mode.Mode -> ModuleName.Canonical -> (Name.Name, Opt.Expr) -> JS.Stmt\ngenerateSafeCycle mode home (name, expr) =\n  JS.FunctionStmt (JsName.fromCycle home name) [] $\n    Expr.codeToStmtList (Expr.generate mode expr)\n\n\ngenerateRealCycle :: ModuleName.Canonical -> (Name.Name, expr) -> JS.Stmt\ngenerateRealCycle home (name, _) =\n  let\n    safeName = JsName.fromCycle home name\n    realName = JsName.fromGlobal home name\n  in\n  JS.Block\n    [ JS.Var realName (JS.Call (JS.Ref safeName) [])\n    , JS.ExprStmt $ JS.Assign (JS.LRef safeName) $\n        JS.Function Nothing [] [ JS.Return (JS.Ref realName) ]\n    ]\n\n\ndrawCycle :: [Name.Name] -> B.Builder\ndrawCycle names =\n  let\n    topLine       = \"\\\\n  ┌─────┐\"\n    nameLine name = \"\\\\n  │    \" <> Name.toBuilder name\n    midLine       = \"\\\\n  │     ↓\"\n    bottomLine    = \"\\\\n  └─────┘\"\n  in\n  mconcat (topLine : List.intersperse midLine (map nameLine names) ++ [ bottomLine ])\n\n\n\n-- GENERATE KERNEL\n\n\ngenerateKernel :: Mode.Mode -> [K.Chunk] -> B.Builder\ngenerateKernel mode chunks =\n  List.foldr (addChunk mode) mempty chunks\n\n\naddChunk :: Mode.Mode -> K.Chunk -> B.Builder -> B.Builder\naddChunk mode chunk builder =\n  case chunk of\n    K.JS javascript ->\n      B.byteString javascript <> builder\n\n    K.ElmVar home name ->\n      JsName.toBuilder (JsName.fromGlobal home name) <> builder\n\n    K.JsVar home name ->\n      JsName.toBuilder (JsName.fromKernel home name) <> builder\n\n    K.ElmField name ->\n      JsName.toBuilder (Expr.generateField mode name) <> builder\n\n    K.JsField int ->\n      JsName.toBuilder (JsName.fromInt int) <> builder\n\n    K.JsEnum int ->\n      B.intDec int <> builder\n\n    K.Debug ->\n      case mode of\n        Mode.Dev _ ->\n          builder\n\n        Mode.Prod _ ->\n          \"_UNUSED\" <> builder\n\n    K.Prod ->\n      case mode of\n        Mode.Dev _ ->\n          \"_UNUSED\" <> builder\n\n        Mode.Prod _ ->\n          builder\n\n\n\n-- GENERATE ENUM\n\n\ngenerateEnum :: Mode.Mode -> Opt.Global -> Index.ZeroBased -> JS.Stmt\ngenerateEnum mode global@(Opt.Global home name) index =\n  JS.Var (JsName.fromGlobal home name) $\n    case mode of\n      Mode.Dev _ ->\n        Expr.codeToExpr (Expr.generateCtor mode global index 0)\n\n      Mode.Prod _ ->\n        JS.Int (Index.toMachine index)\n\n\n\n-- GENERATE BOX\n\n\ngenerateBox :: Mode.Mode -> Opt.Global -> JS.Stmt\ngenerateBox mode global@(Opt.Global home name) =\n  JS.Var (JsName.fromGlobal home name) $\n    case mode of\n      Mode.Dev _ ->\n        Expr.codeToExpr (Expr.generateCtor mode global Index.first 1)\n\n      Mode.Prod _ ->\n        JS.Ref (JsName.fromGlobal ModuleName.basics Name.identity)\n\n\n{-# NOINLINE identity #-}\nidentity :: Opt.Global\nidentity =\n  Opt.Global ModuleName.basics Name.identity\n\n\n\n-- GENERATE PORTS\n\n\ngeneratePort :: Mode.Mode -> Opt.Global -> Name.Name -> Opt.Expr -> JS.Stmt\ngeneratePort mode (Opt.Global home name) makePort converter =\n  JS.Var (JsName.fromGlobal home name) $\n    JS.Call (JS.Ref (JsName.fromKernel Name.platform makePort))\n      [ JS.String (Name.toBuilder name)\n      , Expr.codeToExpr (Expr.generate mode converter)\n      ]\n\n\n\n-- GENERATE MANAGER\n\n\ngenerateManager :: Mode.Mode -> Graph -> Opt.Global -> Opt.EffectsType -> State -> State\ngenerateManager mode graph (Opt.Global home@(ModuleName.Canonical _ moduleName) _) effectsType state =\n  let\n    managerLVar =\n      JS.LBracket\n        (JS.Ref (JsName.fromKernel Name.platform \"effectManagers\"))\n        (JS.String (Name.toBuilder moduleName))\n\n    (deps, args, stmts) =\n      generateManagerHelp home effectsType\n\n    createManager =\n      JS.ExprStmt $ JS.Assign managerLVar $\n        JS.Call (JS.Ref (JsName.fromKernel Name.platform \"createManager\")) args\n  in\n  addStmt (List.foldl' (addGlobal mode graph) state deps) $\n    JS.Block (createManager : stmts)\n\n\ngenerateLeaf :: ModuleName.Canonical -> Name.Name -> JS.Stmt\ngenerateLeaf home@(ModuleName.Canonical _ moduleName) name =\n  JS.Var (JsName.fromGlobal home name) $\n    JS.Call leaf [ JS.String (Name.toBuilder moduleName) ]\n\n\n\n{-# NOINLINE leaf #-}\nleaf :: JS.Expr\nleaf =\n  JS.Ref (JsName.fromKernel Name.platform \"leaf\")\n\n\ngenerateManagerHelp :: ModuleName.Canonical -> Opt.EffectsType -> ([Opt.Global], [JS.Expr], [JS.Stmt])\ngenerateManagerHelp home effectsType =\n  let\n    dep name = Opt.Global home name\n    ref name = JS.Ref (JsName.fromGlobal home name)\n  in\n  case effectsType of\n    Opt.Cmd ->\n      ( [ dep \"init\", dep \"onEffects\", dep \"onSelfMsg\", dep \"cmdMap\" ]\n      , [ ref \"init\", ref \"onEffects\", ref \"onSelfMsg\", ref \"cmdMap\" ]\n      , [ generateLeaf home \"command\" ]\n      )\n\n    Opt.Sub ->\n      ( [ dep \"init\", dep \"onEffects\", dep \"onSelfMsg\", dep \"subMap\" ]\n      , [ ref \"init\", ref \"onEffects\", ref \"onSelfMsg\", JS.Int 0, ref \"subMap\" ]\n      , [ generateLeaf home \"subscription\" ]\n      )\n\n    Opt.Fx ->\n      ( [ dep \"init\", dep \"onEffects\", dep \"onSelfMsg\", dep \"cmdMap\", dep \"subMap\" ]\n      , [ ref \"init\", ref \"onEffects\", ref \"onSelfMsg\", ref \"cmdMap\", ref \"subMap\" ]\n      , [ generateLeaf home \"command\"\n        , generateLeaf home \"subscription\"\n        ]\n      )\n\n\n\n-- MAIN EXPORTS\n\n\ntoMainExports :: Mode.Mode -> Mains -> B.Builder\ntoMainExports mode mains =\n  let\n    export = JsName.fromKernel Name.platform \"export\"\n    exports = generateExports mode (Map.foldrWithKey addToTrie emptyTrie mains)\n  in\n  JsName.toBuilder export <> \"(\" <> exports <> \");\"\n\n\ngenerateExports :: Mode.Mode -> Trie -> B.Builder\ngenerateExports mode (Trie maybeMain subs) =\n  let\n    starter end =\n      case maybeMain of\n        Nothing ->\n          \"{\"\n\n        Just (home, main) ->\n          \"{'init':\"\n          <> JS.exprToBuilder (Expr.generateMain mode home main)\n          <> end\n    in\n    case Map.toList subs of\n      [] ->\n        starter \"\" <> \"}\"\n\n      (name, subTrie) : otherSubTries ->\n        starter \",\" <>\n        \"'\" <> Utf8.toBuilder name <> \"':\"\n        <> generateExports mode subTrie\n        <> List.foldl' (addSubTrie mode) \"}\" otherSubTries\n\n\naddSubTrie :: Mode.Mode -> B.Builder -> (Name.Name, Trie) -> B.Builder\naddSubTrie mode end (name, trie) =\n  \",'\" <> Utf8.toBuilder name <> \"':\" <> generateExports mode trie <> end\n\n\n\n-- BUILD TRIES\n\n\ndata Trie =\n  Trie\n    { _main :: Maybe (ModuleName.Canonical, Opt.Main)\n    , _subs :: Map.Map Name.Name Trie\n    }\n\n\nemptyTrie :: Trie\nemptyTrie =\n  Trie Nothing Map.empty\n\n\naddToTrie :: ModuleName.Canonical -> Opt.Main -> Trie -> Trie\naddToTrie home@(ModuleName.Canonical _ moduleName) main trie =\n  merge trie $ segmentsToTrie home (Name.splitDots moduleName) main\n\n\nsegmentsToTrie :: ModuleName.Canonical -> [Name.Name] -> Opt.Main -> Trie\nsegmentsToTrie home segments main =\n  case segments of\n    [] ->\n      Trie (Just (home, main)) Map.empty\n\n    segment : otherSegments ->\n      Trie Nothing (Map.singleton segment (segmentsToTrie home otherSegments main))\n\n\nmerge :: Trie -> Trie -> Trie\nmerge (Trie main1 subs1) (Trie main2 subs2) =\n  Trie\n    (checkedMerge main1 main2)\n    (Map.unionWith merge subs1 subs2)\n\n\ncheckedMerge :: Maybe a -> Maybe a -> Maybe a\ncheckedMerge a b =\n  case (a, b) of\n    (Nothing, main) ->\n      main\n\n    (main, Nothing) ->\n      main\n\n    (Just _, Just _) ->\n      error \"cannot have two modules with the same name\"\n"
  },
  {
    "path": "compiler/src/Generate/Mode.hs",
    "content": "module Generate.Mode\n  ( Mode(..)\n  , isDebug\n  , ShortFieldNames\n  , shortenFieldNames\n  )\n  where\n\n\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Maybe as Maybe\nimport qualified Data.Name as Name\n\nimport qualified AST.Optimized as Opt\nimport qualified Elm.Compiler.Type.Extract as Extract\nimport qualified Generate.JavaScript.Name as JsName\n\n\n\n-- MODE\n\n\ndata Mode\n  = Dev (Maybe Extract.Types)\n  | Prod ShortFieldNames\n\n\nisDebug :: Mode -> Bool\nisDebug mode =\n  case mode of\n    Dev mi -> Maybe.isJust mi\n    Prod _ -> False\n\n\n\n-- SHORTEN FIELD NAMES\n\n\ntype ShortFieldNames =\n  Map.Map Name.Name JsName.Name\n\n\nshortenFieldNames :: Opt.GlobalGraph -> ShortFieldNames\nshortenFieldNames (Opt.GlobalGraph _ frequencies) =\n  Map.foldr addToShortNames Map.empty $\n    Map.foldrWithKey addToBuckets Map.empty frequencies\n\n\naddToBuckets :: Name.Name -> Int -> Map.Map Int [Name.Name] -> Map.Map Int [Name.Name]\naddToBuckets field frequency buckets =\n  Map.insertWith (++) frequency [field] buckets\n\n\naddToShortNames :: [Name.Name] -> ShortFieldNames -> ShortFieldNames\naddToShortNames fields shortNames =\n  List.foldl' addField shortNames fields\n\n\naddField :: ShortFieldNames -> Name.Name -> ShortFieldNames\naddField shortNames field =\n  let rename = JsName.fromInt (Map.size shortNames) in\n  Map.insert field rename shortNames\n"
  },
  {
    "path": "compiler/src/Json/Decode.hs",
    "content": "{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing #-}\n{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, UnboxedTuples #-}\nmodule Json.Decode\n  ( fromByteString\n  , Decoder\n  , string\n  , customString\n  , bool\n  , int\n  , list\n  , nonEmptyList\n  , pair\n  --\n  , KeyDecoder(..)\n  , dict\n  , pairs\n  , field\n  --\n  , oneOf\n  , failure\n  , mapError\n  --\n  , Error(..)\n  , Problem(..)\n  , DecodeExpectation(..)\n  , ParseError(..)\n  , StringProblem(..)\n  )\n  where\n\n\nimport qualified Data.ByteString.Internal as B\nimport qualified Data.Map as Map\nimport qualified Data.NonEmptyList as NE\nimport Data.Word (Word8)\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr)\nimport Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)\n\nimport qualified Json.String as Json\nimport qualified Parse.Keyword as K\nimport qualified Parse.Primitives as P\nimport Parse.Primitives (Row, Col)\nimport qualified Reporting.Annotation as A\n\n\n\n-- RUNNERS\n\n\nfromByteString :: Decoder x a -> B.ByteString -> Either (Error x) a\nfromByteString (Decoder decode) src =\n  case P.fromByteString pFile BadEnd src of\n    Right ast ->\n      decode ast Right (Left . DecodeProblem src)\n\n    Left problem ->\n      Left (ParseProblem src problem)\n\n\n\n-- DECODERS\n\n\nnewtype Decoder x a =\n  Decoder\n  (\n    forall b.\n      AST\n      -> (a -> b)\n      -> (Problem x -> b)\n      -> b\n  )\n\n\n\n-- ERRORS\n\n\ndata Error x\n  = DecodeProblem B.ByteString (Problem x)\n  | ParseProblem B.ByteString ParseError\n\n\n\n-- DECODE PROBLEMS\n\n\ndata Problem x\n  = Field B.ByteString (Problem x)\n  | Index Int (Problem x)\n  | OneOf (Problem x) [Problem x]\n  | Failure A.Region x\n  | Expecting A.Region DecodeExpectation\n\n\ndata DecodeExpectation\n  = TObject\n  | TArray\n  | TString\n  | TBool\n  | TInt\n  | TObjectWith B.ByteString\n  | TArrayPair Int\n\n\n\n-- INSTANCES\n\n\ninstance Functor (Decoder x) where\n  {-# INLINE fmap #-}\n  fmap func (Decoder decodeA) =\n    Decoder $ \\ast ok err ->\n      let\n        ok' a = ok (func a)\n      in\n      decodeA ast ok' err\n\n\ninstance Applicative (Decoder x) where\n  {-# INLINE pure #-}\n  pure a =\n    Decoder $ \\_ ok _ ->\n      ok a\n\n  {-# INLINE (<*>) #-}\n  (<*>) (Decoder decodeFunc) (Decoder decodeArg) =\n    Decoder $ \\ast ok err ->\n      let\n        okF func =\n          let\n            okA arg = ok (func arg)\n          in\n          decodeArg ast okA err\n      in\n      decodeFunc ast okF err\n\n\ninstance Monad (Decoder x) where\n  {-# INLINE (>>=) #-}\n  (>>=) (Decoder decodeA) callback =\n    Decoder $ \\ast ok err ->\n      let\n        ok' a =\n          case callback a of\n            Decoder decodeB -> decodeB ast ok err\n      in\n      decodeA ast ok' err\n\n\n\n-- STRINGS\n\n\nstring :: Decoder x Json.String\nstring =\n  Decoder $ \\(A.At region ast) ok err ->\n    case ast of\n      String snippet ->\n        ok (Json.fromSnippet snippet)\n\n      _ ->\n        err (Expecting region TString)\n\n\ncustomString :: P.Parser x a -> (Row -> Col -> x) -> Decoder x a\ncustomString parser toBadEnd =\n  Decoder $ \\(A.At region ast) ok err ->\n    case ast of\n      String snippet ->\n        case P.fromSnippet parser toBadEnd snippet of\n          Right a -> ok a\n          Left  x -> err (Failure region x)\n\n      _ ->\n        err (Expecting region TString)\n\n\n\n-- BOOL\n\n\nbool :: Decoder x Bool\nbool =\n  Decoder $ \\(A.At region ast) ok err ->\n    case ast of\n      TRUE ->\n        ok True\n\n      FALSE ->\n        ok False\n\n      _ ->\n        err (Expecting region TBool)\n\n\n\n-- INT\n\n\nint :: Decoder x Int\nint =\n  Decoder $ \\(A.At region ast) ok err ->\n    case ast of\n      Int n ->\n        ok n\n\n      _ ->\n        err (Expecting region TInt)\n\n\n\n-- LISTS\n\n\nlist :: Decoder x a -> Decoder x [a]\nlist decoder =\n  Decoder $ \\(A.At region ast) ok err ->\n    case ast of\n      Array asts ->\n        listHelp decoder ok err 0 asts []\n\n      _ ->\n        err (Expecting region TArray)\n\n\nlistHelp :: Decoder x a -> ([a] -> b) -> (Problem x -> b) -> Int -> [AST] -> [a] -> b\nlistHelp decoder@(Decoder decodeA) ok err !i asts revs =\n  case asts of\n    [] ->\n      ok (reverse revs)\n\n    ast:asts ->\n      let\n        ok' value = listHelp decoder ok err (i+1) asts (value:revs)\n        err' prob = err (Index i prob)\n      in\n      decodeA ast ok' err'\n\n\n\n-- NON-EMPTY LISTS\n\n\nnonEmptyList :: Decoder x a -> x -> Decoder x (NE.List a)\nnonEmptyList decoder x =\n  do  values <- list decoder\n      case values of\n        v:vs -> return (NE.List v vs)\n        []   -> failure x\n\n\n\n-- PAIR\n\n\npair :: Decoder x a -> Decoder x b -> Decoder x (a,b)\npair (Decoder decodeA) (Decoder decodeB) =\n  Decoder $ \\(A.At region ast) ok err ->\n    case ast of\n      Array vs ->\n        case vs of\n          [astA,astB] ->\n            let\n              err0 e = err (Index 0 e)\n              ok0 a =\n                let\n                  err1 e = err (Index 1 e)\n                  ok1 b = ok (a,b)\n                in\n                decodeB astB ok1 err1\n            in\n            decodeA astA ok0 err0\n\n          _ ->\n            err (Expecting region (TArrayPair (length vs)))\n\n      _ ->\n        err (Expecting region TArray)\n\n\n\n-- OBJECTS\n\n\ndata KeyDecoder x a =\n  KeyDecoder (P.Parser x a) (Row -> Col -> x)\n\n\ndict :: (Ord k) => KeyDecoder x k -> Decoder x a -> Decoder x (Map.Map k a)\ndict keyDecoder valueDecoder =\n  Map.fromList <$> pairs keyDecoder valueDecoder\n\n\npairs :: KeyDecoder x k -> Decoder x a -> Decoder x [(k, a)]\npairs keyDecoder valueDecoder =\n  Decoder $ \\(A.At region ast) ok err ->\n    case ast of\n      Object kvs ->\n        pairsHelp keyDecoder valueDecoder ok err kvs []\n\n      _ ->\n        err (Expecting region TObject)\n\n\npairsHelp :: KeyDecoder x k -> Decoder x a -> ([(k, a)] -> b) -> (Problem x -> b) -> [(P.Snippet, AST)] -> [(k, a)] -> b\npairsHelp keyDecoder@(KeyDecoder keyParser toBadEnd) valueDecoder@(Decoder decodeA) ok err kvs revs =\n  case kvs of\n    [] ->\n      ok (reverse revs)\n\n    (snippet, ast) : kvs ->\n      case P.fromSnippet keyParser toBadEnd snippet of\n        Left x ->\n          err (Failure (snippetToRegion snippet) x)\n\n        Right key ->\n          let\n            ok' value = pairsHelp keyDecoder valueDecoder ok err kvs ((key,value):revs)\n            err' prob =\n              let (P.Snippet fptr off len _ _) = snippet in\n              err (Field (B.PS fptr off len) prob)\n          in\n          decodeA ast ok' err'\n\n\nsnippetToRegion :: P.Snippet -> A.Region\nsnippetToRegion (P.Snippet _ _ len row col) =\n  A.Region (A.Position row col) (A.Position row (col + fromIntegral len))\n\n\n\n-- FIELDS\n\n\nfield :: B.ByteString -> Decoder x a -> Decoder x a\nfield key (Decoder decodeA) =\n  Decoder $ \\(A.At region ast) ok err ->\n    case ast of\n      Object kvs ->\n        case findField key kvs of\n          Just value ->\n            let\n              err' prob =\n                err (Field key prob)\n            in\n            decodeA value ok err'\n\n          Nothing ->\n            err (Expecting region (TObjectWith key))\n\n      _ ->\n        err (Expecting region TObject)\n\n\nfindField :: B.ByteString -> [(P.Snippet, AST)] -> Maybe AST\nfindField key pairs =\n  case pairs of\n    [] ->\n      Nothing\n\n    (P.Snippet fptr off len _ _, value) : remainingPairs ->\n      if key == B.PS fptr off len\n      then Just value\n      else findField key remainingPairs\n\n\n\n-- ONE OF\n\n\noneOf :: [Decoder x a] -> Decoder x a\noneOf decoders =\n  Decoder $ \\ast ok err ->\n    case decoders of\n      Decoder decodeA : decoders ->\n        let\n          err' e =\n            oneOfHelp ast ok err decoders e []\n        in\n        decodeA ast ok err'\n\n      [] ->\n        error \"Ran into (Json.Decode.oneOf [])\"\n\n\noneOfHelp :: AST -> (a -> b) -> (Problem x -> b) -> [Decoder x a] -> Problem x -> [Problem x] -> b\noneOfHelp ast ok err decoders p ps =\n  case decoders of\n    Decoder decodeA : decoders ->\n      let\n        err' p' =\n          oneOfHelp ast ok err decoders p' (p:ps)\n      in\n      decodeA ast ok err'\n\n    [] ->\n      err (oneOfError [] p ps)\n\n\noneOfError :: [Problem x] -> Problem x -> [Problem x] -> Problem x\noneOfError problems prob ps =\n  case ps of\n    [] ->\n      OneOf prob problems\n\n    p:ps ->\n      oneOfError (prob:problems) p ps\n\n\n\n-- FAILURE\n\n\nfailure :: x -> Decoder x a\nfailure x =\n  Decoder $ \\(A.At region _) _ err ->\n    err (Failure region x)\n\n\n\n-- ERRORS\n\n\nmapError :: (x -> y) -> Decoder x a -> Decoder y a\nmapError func (Decoder decodeA) =\n  Decoder $ \\ast ok err ->\n    let\n      err' prob = err (mapErrorHelp func prob)\n    in\n    decodeA ast ok err'\n\n\nmapErrorHelp :: (x -> y) -> Problem x -> Problem y\nmapErrorHelp func problem =\n  case problem of\n    Field k p     -> Field k (mapErrorHelp func p)\n    Index i p     -> Index i (mapErrorHelp func p)\n    OneOf p ps    -> OneOf (mapErrorHelp func p) (map (mapErrorHelp func) ps)\n    Failure r x   -> Failure r (func x)\n    Expecting r e -> Expecting r e\n\n\n\n-- AST\n\n\ntype AST =\n  A.Located AST_\n\n\ndata AST_\n  = Array [AST]\n  | Object [(P.Snippet, AST)]\n  | String P.Snippet\n  | Int Int\n  | TRUE\n  | FALSE\n  | NULL\n\n\n\n-- PARSE\n\n\ntype Parser a =\n  P.Parser ParseError a\n\n\ndata ParseError\n  = Start Row Col\n  | ObjectField Row Col\n  | ObjectColon Row Col\n  | ObjectEnd Row Col\n  | ArrayEnd Row Col\n  | StringProblem StringProblem Row Col\n  | NoLeadingZeros Row Col\n  | NoFloats Row Col\n  | BadEnd Row Col\n\n--  PIndex Int ParseError Row Col\n--  PField Json.String ParseError Row Col\n\n\ndata StringProblem\n  = BadStringEnd\n  | BadStringControlChar\n  | BadStringEscapeChar\n  | BadStringEscapeHex\n\n\n\n-- PARSE AST\n\n\npFile :: Parser AST\npFile =\n  do  spaces\n      value <- pValue\n      spaces\n      return value\n\n\npValue :: Parser AST\npValue =\n  P.addLocation $\n  P.oneOf Start\n    [ String <$> pString Start\n    , pObject\n    , pArray\n    , pInt\n    , K.k4 0x74 0x72 0x75 0x65      Start >> return TRUE\n    , K.k5 0x66 0x61 0x6C 0x73 0x65 Start >> return FALSE\n    , K.k4 0x6E 0x75 0x6C 0x6C      Start >> return NULL\n    ]\n\n\n\n-- OBJECT\n\n\npObject :: Parser AST_\npObject =\n  do  P.word1 0x7B {- { -} Start\n      spaces\n      P.oneOf ObjectField\n        [ do  entry <- pField\n              spaces\n              pObjectHelp [entry]\n        , do  P.word1 0x7D {-}-} ObjectEnd\n              return (Object [])\n        ]\n\n\npObjectHelp :: [(P.Snippet, AST)] -> Parser AST_\npObjectHelp revEntries =\n  P.oneOf ObjectEnd\n    [\n      do  P.word1 0x2C {-,-} ObjectEnd\n          spaces\n          entry <- pField\n          spaces\n          pObjectHelp (entry:revEntries)\n    ,\n      do  P.word1 0x7D {-}-} ObjectEnd\n          return (Object (reverse revEntries))\n    ]\n\n\npField :: Parser (P.Snippet, AST)\npField =\n  do  key <- pString ObjectField\n      spaces\n      P.word1 0x3A {-:-} ObjectColon\n      spaces\n      value <- pValue\n      return (key, value)\n\n\n\n-- ARRAY\n\n\npArray :: Parser AST_\npArray =\n  do  P.word1 0x5B {-[-} Start\n      spaces\n      P.oneOf Start\n        [ do  entry <- pValue\n              spaces\n              pArrayHelp 1 [entry]\n        , do  P.word1 0x5D {-]-} ArrayEnd\n              return (Array [])\n        ]\n\n\npArrayHelp :: Int -> [AST] -> Parser AST_\npArrayHelp !len revEntries =\n  P.oneOf ArrayEnd\n    [\n      do  P.word1 0x2C {-,-} ArrayEnd\n          spaces\n          entry <- pValue\n          spaces\n          pArrayHelp (len + 1) (entry:revEntries)\n    ,\n      do  P.word1 0x5D {-]-} ArrayEnd\n          return (Array (reverse revEntries))\n    ]\n\n\n\n-- STRING\n\n\npString :: (Row -> Col -> ParseError) -> Parser P.Snippet\npString start =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    if pos < end && P.unsafeIndex pos == 0x22 {-\"-} then\n\n      let\n        !pos1 = plusPtr pos 1\n        !col1 = col + 1\n\n        (# status, newPos, newRow, newCol #) =\n          pStringHelp pos1 end row col1\n      in\n      case status of\n        GoodString ->\n          let\n            !off = minusPtr pos1 (unsafeForeignPtrToPtr src)\n            !len = minusPtr newPos pos1 - 1\n            !snp = P.Snippet src off len row col1\n            !newState = P.State src newPos end indent newRow newCol\n          in\n          cok snp newState\n\n        BadString problem ->\n          cerr newRow newCol (StringProblem problem)\n\n    else\n      eerr row col start\n\n\ndata StringStatus\n  = GoodString\n  | BadString StringProblem\n\n\npStringHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# StringStatus, Ptr Word8, Row, Col #)\npStringHelp pos end row col =\n  if pos >= end then\n    (# BadString BadStringEnd, pos, row, col #)\n\n  else\n    case P.unsafeIndex pos of\n      0x22 {-\"-} ->\n        (# GoodString, plusPtr pos 1, row, col + 1 #)\n\n      0x0A {-\\n-} ->\n        (# BadString BadStringEnd, pos, row, col #)\n\n      0x5C {-\\-} ->\n        let !pos1 = plusPtr pos 1 in\n        if pos1 >= end then\n          (# BadString BadStringEnd, pos1, row + 1, col #)\n        else\n          case P.unsafeIndex pos1 of\n            0x22 {-\"-} -> pStringHelp (plusPtr pos 2) end row (col + 2)\n            0x5C {-\\-} -> pStringHelp (plusPtr pos 2) end row (col + 2)\n            0x2F {-/-} -> pStringHelp (plusPtr pos 2) end row (col + 2)\n            0x62 {-b-} -> pStringHelp (plusPtr pos 2) end row (col + 2)\n            0x66 {-f-} -> pStringHelp (plusPtr pos 2) end row (col + 2)\n            0x6E {-n-} -> pStringHelp (plusPtr pos 2) end row (col + 2)\n            0x72 {-r-} -> pStringHelp (plusPtr pos 2) end row (col + 2)\n            0x74 {-t-} -> pStringHelp (plusPtr pos 2) end row (col + 2)\n            0x75 {-u-} ->\n              let !pos6 = plusPtr pos 6 in\n              if pos6 <= end\n                && isHex (P.unsafeIndex (plusPtr pos 2))\n                && isHex (P.unsafeIndex (plusPtr pos 3))\n                && isHex (P.unsafeIndex (plusPtr pos 4))\n                && isHex (P.unsafeIndex (plusPtr pos 5))\n              then\n                pStringHelp pos6 end row (col + 6)\n              else\n                (# BadString BadStringEscapeHex, pos, row, col #)\n\n            _ ->\n              (# BadString BadStringEscapeChar, pos, row, col #)\n\n      word ->\n        if word < 0x20 then\n          (# BadString BadStringControlChar, pos, row, col #)\n        else\n          let !newPos = plusPtr pos (P.getCharWidth word) in\n          pStringHelp newPos end row (col + 1)\n\n\nisHex :: Word8 -> Bool\nisHex word =\n     0x30 {-0-} <= word && word <= 0x39 {-9-}\n  || 0x61 {-a-} <= word && word <= 0x66 {-f-}\n  || 0x41 {-A-} <= word && word <= 0x46 {-F-}\n\n\n\n-- SPACES\n\n\nspaces :: Parser ()\nspaces =\n  P.Parser $ \\state@(P.State src pos end indent row col) cok eok _ _ ->\n    let\n      (# newPos, newRow, newCol #) =\n        eatSpaces pos end row col\n    in\n    if pos == newPos then\n      eok () state\n    else\n      let\n        !newState =\n          P.State src newPos end indent newRow newCol\n      in\n      cok () newState\n\n\neatSpaces :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Ptr Word8, Row, Col #)\neatSpaces pos end row col =\n  if pos >= end then\n    (# pos, row, col #)\n\n  else\n    case P.unsafeIndex pos of\n      0x20 {-  -} -> eatSpaces (plusPtr pos 1) end row (col + 1)\n      0x09 {-\\t-} -> eatSpaces (plusPtr pos 1) end row (col + 1)\n      0x0A {-\\n-} -> eatSpaces (plusPtr pos 1) end (row + 1) 1\n      0x0D {-\\r-} -> eatSpaces (plusPtr pos 1) end row col\n      _ ->\n        (# pos, row, col #)\n\n\n\n-- INTS\n\n\npInt :: Parser AST_\npInt =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    if pos >= end then\n      eerr row col Start\n\n    else\n      let !word = P.unsafeIndex pos in\n      if not (isDecimalDigit word) then\n        eerr row col Start\n\n      else if word == 0x30 {-0-} then\n\n        let\n          !pos1 = plusPtr pos 1\n          !newState = P.State src pos1 end indent row (col + 1)\n        in\n        if pos1 < end then\n          let !word1 = P.unsafeIndex pos1 in\n          if isDecimalDigit word1 then\n            cerr row (col + 1) NoLeadingZeros\n          else if word1 == 0x2E {-.-} then\n            cerr row (col + 1) NoFloats\n          else\n            cok (Int 0) newState\n        else\n          cok (Int 0) newState\n\n      else\n        let\n          (# status, n, newPos #) =\n            chompInt (plusPtr pos 1) end (fromIntegral (word - 0x30 {-0-}))\n\n          !len = fromIntegral (minusPtr newPos pos)\n        in\n        case status of\n          GoodInt ->\n            let\n              !newState =\n                P.State src newPos end indent row (col + len)\n            in\n            cok (Int n) newState\n\n          BadIntEnd ->\n            cerr row (col + len) NoFloats\n\n\ndata IntStatus = GoodInt | BadIntEnd\n\n\nchompInt :: Ptr Word8 -> Ptr Word8 -> Int -> (# IntStatus, Int, Ptr Word8 #)\nchompInt pos end n =\n  if pos < end then\n    let !word = P.unsafeIndex pos in\n    if isDecimalDigit word then\n      let !m = 10 * n + fromIntegral (word - 0x30 {-0-}) in\n      chompInt (plusPtr pos 1) end m\n    else if word == 0x2E {-.-} || word == 0x65 {-e-} || word == 0x45 {-E-} then\n      (# BadIntEnd, n, pos #)\n    else\n      (# GoodInt, n, pos #)\n\n  else\n    (# GoodInt, n, pos #)\n\n\n{-# INLINE isDecimalDigit #-}\nisDecimalDigit :: Word8 -> Bool\nisDecimalDigit word =\n  word <= 0x39 {-9-} && word >= 0x30 {-0-}\n"
  },
  {
    "path": "compiler/src/Json/Encode.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Json.Encode\n  ( write\n  , encode\n  , writeUgly\n  , encodeUgly\n  , Value(..)\n  , array\n  , object\n  , string\n  , name\n  , chars\n  , bool\n  , int\n  , number\n  , null\n  , dict\n  , list\n  , (==>)\n  )\n  where\n\n\nimport Prelude hiding (null)\nimport Control.Arrow ((***))\nimport qualified Data.ByteString.Char8 as BSC\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.Map as Map\nimport qualified Data.Scientific as Sci\nimport qualified Data.Name as Name\nimport qualified Data.Utf8 as Utf8\n\nimport qualified File\nimport qualified Json.String as Json\n\n\n\n-- VALUES\n\n\ndata Value\n  = Array [Value]\n  | Object [(Json.String, Value)]\n  | String B.Builder\n  | Boolean Bool\n  | Integer Int\n  | Number Sci.Scientific\n  | Null\n\n\narray :: [Value] -> Value\narray =\n  Array\n\n\nobject :: [(Json.String, Value)] -> Value\nobject =\n  Object\n\n\nstring :: Json.String -> Value\nstring str =\n  String (B.char7 '\"' <> Json.toBuilder str <> B.char7 '\"')\n\n\nname :: Name.Name -> Value\nname nm =\n  String (B.char7 '\"' <> Name.toBuilder nm <> B.char7 '\"')\n\n\nbool :: Bool -> Value\nbool =\n  Boolean\n\n\nint :: Int -> Value\nint =\n  Integer\n\n\nnumber :: Sci.Scientific -> Value\nnumber =\n  Number\n\n\nnull :: Value\nnull =\n  Null\n\n\ndict :: (k -> Json.String) -> (v -> Value) -> Map.Map k v -> Value\ndict encodeKey encodeValue pairs =\n  Object $ map (encodeKey *** encodeValue) (Map.toList pairs)\n\n\nlist :: (a -> Value) -> [a] -> Value\nlist encodeEntry entries =\n  Array $ map encodeEntry entries\n\n\n\n-- CHARS\n\n\nchars :: [Char] -> Value -- PERF can this be done better? Look for examples.\nchars chrs =\n  String (B.char7 '\"' <> B.stringUtf8 (escape chrs) <> B.char7 '\"')\n\n\nescape :: [Char] -> [Char]\nescape chrs =\n  case chrs of\n    [] ->\n      []\n\n    c:cs\n      | c == '\\r' -> '\\\\' : 'r'  : escape cs\n      | c == '\\n' -> '\\\\' : 'n'  : escape cs\n      | c == '\\\"' -> '\\\\' : '\"'  : escape cs\n      | c == '\\\\' -> '\\\\' : '\\\\' : escape cs\n      | otherwise -> c : escape cs\n\n\n\n-- HELPERS\n\n\n(==>) :: [Char] -> value -> (Json.String, value)\n(==>) key value =\n  (Json.fromChars key, value)\n\n\n\n-- WRITE TO FILE\n\n\nwrite :: FilePath -> Value -> IO ()\nwrite path value =\n  File.writeBuilder path (encode value <> \"\\n\")\n\n\nwriteUgly :: FilePath -> Value -> IO ()\nwriteUgly path value =\n  File.writeBuilder path (encodeUgly value)\n\n\n\n-- ENCODE UGLY\n\n\nencodeUgly :: Value -> B.Builder\nencodeUgly value =\n  case value of\n    Array [] ->\n      B.string7 \"[]\"\n\n    Array (first : rest) ->\n      let\n        encodeEntry entry =\n          B.char7 ',' <> encodeUgly entry\n      in\n        B.char7 '[' <> encodeUgly first <> mconcat (map encodeEntry rest) <> B.char7 ']'\n\n    Object [] ->\n      B.string7 \"{}\"\n\n    Object (first : rest) ->\n      let\n        encodeEntry char (key, entry) =\n          B.char7 char <> B.char7 '\"' <> Utf8.toBuilder key <> B.string7 \"\\\":\" <> encodeUgly entry\n      in\n        encodeEntry '{' first <> mconcat (map (encodeEntry ',') rest) <> B.char7 '}'\n\n    String builder ->\n      builder\n\n    Boolean boolean ->\n      B.string7 (if boolean then \"true\" else \"false\")\n\n    Integer n ->\n      B.intDec n\n\n    Number scientific ->\n      B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)\n\n    Null ->\n      \"null\"\n\n\n\n-- ENCODE\n\n\nencode :: Value -> B.Builder\nencode value =\n  encodeHelp \"\" value\n\n\nencodeHelp :: BSC.ByteString -> Value -> B.Builder\nencodeHelp indent value =\n  case value of\n    Array [] ->\n      B.string7 \"[]\"\n\n    Array (first : rest) ->\n      encodeArray indent first rest\n\n    Object [] ->\n      B.string7 \"{}\"\n\n    Object (first : rest) ->\n      encodeObject indent first rest\n\n    String builder ->\n      builder\n\n    Boolean boolean ->\n      B.string7 (if boolean then \"true\" else \"false\")\n\n    Integer n ->\n      B.intDec n\n\n    Number scientific ->\n      B.string7 (Sci.formatScientific Sci.Generic Nothing scientific)\n\n    Null ->\n      \"null\"\n\n\n\n-- ENCODE ARRAY\n\n\nencodeArray :: BSC.ByteString -> Value -> [Value] -> B.Builder\nencodeArray =\n  encodeSequence arrayOpen arrayClose encodeHelp\n\n\narrayOpen :: B.Builder\narrayOpen =\n  B.string7 \"[\\n\"\n\n\narrayClose :: B.Builder\narrayClose =\n  B.char7 ']'\n\n\n\n-- ENCODE OBJECT\n\n\nencodeObject :: BSC.ByteString -> (Json.String, Value) -> [(Json.String, Value)] -> B.Builder\nencodeObject =\n  encodeSequence objectOpen objectClose encodeField\n\n\nobjectOpen :: B.Builder\nobjectOpen =\n  B.string7 \"{\\n\"\n\n\nobjectClose :: B.Builder\nobjectClose =\n  B.char7 '}'\n\n\nencodeField :: BSC.ByteString -> (Json.String, Value) -> B.Builder\nencodeField indent (key, value) =\n  B.char7 '\"' <> Utf8.toBuilder key <> B.string7 \"\\\": \" <> encodeHelp indent value\n\n\n\n-- ENCODE SEQUENCE\n\n\nencodeSequence :: B.Builder -> B.Builder -> (BSC.ByteString -> a -> B.Builder) -> BSC.ByteString -> a -> [a] -> B.Builder\nencodeSequence open close encodeEntry indent first rest =\n  let\n    newIndent =\n      indent <> \"    \"\n\n    newIndentBuilder =\n      B.byteString newIndent\n\n    closer =\n      newline <> B.byteString indent <> close\n\n    addValue field builder =\n      commaNewline\n      <> newIndentBuilder\n      <> encodeEntry newIndent field\n      <> builder\n  in\n    open\n    <> newIndentBuilder\n    <> encodeEntry newIndent first\n    <> foldr addValue closer rest\n\n\ncommaNewline :: B.Builder\ncommaNewline =\n  B.string7 \",\\n\"\n\n\nnewline :: B.Builder\nnewline =\n  B.char7 '\\n'\n"
  },
  {
    "path": "compiler/src/Json/String.hs",
    "content": "{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}\n{-# LANGUAGE BangPatterns, EmptyDataDecls #-}\nmodule Json.String\n  ( String\n  , isEmpty\n  --\n  , fromPtr\n  , fromName\n  , fromChars\n  , fromSnippet\n  , fromComment\n  --\n  , toChars\n  , toBuilder\n  )\n  where\n\n\nimport Prelude hiding (String)\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.Coerce as Coerce\nimport qualified Data.Name as Name\nimport qualified Data.Utf8 as Utf8\nimport Data.Utf8 (MBA, newByteArray, copyFromPtr, freeze, writeWord8)\nimport Data.Word (Word8)\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr)\nimport Foreign.ForeignPtr (withForeignPtr)\nimport GHC.Exts (RealWorld)\nimport GHC.IO (stToIO, unsafeDupablePerformIO, unsafePerformIO)\nimport GHC.ST (ST)\n\nimport qualified Parse.Primitives as P\n\n\n\n-- JSON STRINGS\n\n\n-- INVARIANT: any Json.String is appropriately escaped already\n-- PERF: is this the right representation for Json.String? Maybe ByteString instead?\n--\ntype String =\n  Utf8.Utf8 JSON_STRING\n\n\ndata JSON_STRING\n\n\nisEmpty :: String -> Bool\nisEmpty =\n  Utf8.isEmpty\n\n\n\n-- FROM\n\n\nfromPtr :: Ptr Word8 -> Ptr Word8 -> String\nfromPtr =\n  Utf8.fromPtr\n\n\nfromChars :: [Char] -> String\nfromChars =\n  Utf8.fromChars\n\n\nfromSnippet :: P.Snippet -> String\nfromSnippet =\n  Utf8.fromSnippet\n\n\nfromName :: Name.Name -> String\nfromName =\n  Coerce.coerce\n\n\n\n-- TO\n\n\ntoChars :: String -> [Char]\ntoChars =\n  Utf8.toChars\n\n\n{-# INLINE toBuilder #-}\ntoBuilder :: String -> B.Builder\ntoBuilder =\n  Utf8.toBuilder\n\n\n\n-- FROM COMMENT\n\n\nfromComment :: P.Snippet -> String\nfromComment (P.Snippet fptr off len _ _) =\n  unsafePerformIO $ withForeignPtr fptr $ \\ptr ->\n    let\n      !pos = plusPtr ptr off\n      !end = plusPtr pos len\n      !str = fromChunks (chompChunks pos end pos [])\n    in\n    return str\n\n\nchompChunks :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]\nchompChunks pos end start revChunks =\n  if pos >= end then\n    reverse (addSlice start end revChunks)\n  else\n    let\n      !word = P.unsafeIndex pos\n    in\n    case word of\n      0x0A {-\\n-} -> chompEscape 0x6E {-n-} pos end start revChunks\n      0x22 {-\"-}  -> chompEscape 0x22 {-\"-} pos end start revChunks\n      0x5C {-\\-}  -> chompEscape 0x5C {-\\-} pos end start revChunks\n      0x0D {-\\r-} ->\n        let\n          !newPos = plusPtr pos 1\n        in\n        chompChunks newPos end newPos (addSlice start pos revChunks)\n\n      _ ->\n        let\n          !width = P.getCharWidth word\n          !newPos = plusPtr pos width\n        in\n        chompChunks newPos end start revChunks\n\n\nchompEscape :: Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]\nchompEscape escape pos end start revChunks =\n  let\n    !pos1 = plusPtr pos 1\n  in\n  chompChunks pos1 end pos1 (Escape escape : addSlice start pos revChunks)\n\n\naddSlice :: Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]\naddSlice start end revChunks =\n  if start == end\n    then revChunks\n    else Slice start (minusPtr end start) : revChunks\n\n\n\n-- FROM CHUNKS\n\n\ndata Chunk\n  = Slice (Ptr Word8) Int\n  | Escape Word8\n\n\nfromChunks :: [Chunk] -> String\nfromChunks chunks =\n  unsafeDupablePerformIO (stToIO (\n    do  let !len = sum (map chunkToWidth chunks)\n        mba <- newByteArray len\n        writeChunks mba 0 chunks\n        freeze mba\n  ))\n\n\nchunkToWidth :: Chunk -> Int\nchunkToWidth chunk =\n  case chunk of\n    Slice _ len -> len\n    Escape _    -> 2\n\n\nwriteChunks :: MBA RealWorld -> Int -> [Chunk] -> ST RealWorld ()\nwriteChunks mba offset chunks =\n  case chunks of\n    [] ->\n      return ()\n\n    chunk : chunks ->\n      case chunk of\n        Slice ptr len ->\n          do  copyFromPtr ptr mba offset len\n              let !newOffset = offset + len\n              writeChunks mba newOffset chunks\n\n        Escape word ->\n          do  writeWord8 mba offset 0x5C {- \\ -}\n              writeWord8 mba (offset + 1) word\n              let !newOffset = offset + 2\n              writeChunks mba newOffset chunks\n"
  },
  {
    "path": "compiler/src/Nitpick/Debug.hs",
    "content": "module Nitpick.Debug\n  ( hasDebugUses\n  )\n  where\n\n\nimport qualified Data.Map.Utils as Map\n\nimport qualified AST.Optimized as Opt\n\n\n\n-- HAS DEBUG USES\n\n\nhasDebugUses :: Opt.LocalGraph -> Bool\nhasDebugUses (Opt.LocalGraph _ graph _) =\n  Map.any nodeHasDebug graph\n\n\nnodeHasDebug :: Opt.Node -> Bool\nnodeHasDebug node =\n  case node of\n    Opt.Define expr _           -> hasDebug expr\n    Opt.DefineTailFunc _ expr _ -> hasDebug expr\n    Opt.Ctor _ _                -> False\n    Opt.Enum _                  -> False\n    Opt.Box                     -> False\n    Opt.Link _                  -> False\n    Opt.Cycle _ vs fs _         -> any (hasDebug . snd) vs || any defHasDebug fs\n    Opt.Manager _               -> False\n    Opt.Kernel _ _              -> False\n    Opt.PortIncoming expr _     -> hasDebug expr\n    Opt.PortOutgoing expr _     -> hasDebug expr\n\n\nhasDebug :: Opt.Expr -> Bool\nhasDebug expression =\n  case expression of\n    Opt.Bool _           -> False\n    Opt.Chr _            -> False\n    Opt.Str _            -> False\n    Opt.Int _            -> False\n    Opt.Float _          -> False\n    Opt.VarLocal _       -> False\n    Opt.VarGlobal _      -> False\n    Opt.VarEnum _ _      -> False\n    Opt.VarBox _         -> False\n    Opt.VarCycle _ _     -> False\n    Opt.VarDebug _ _ _ _ -> True\n    Opt.VarKernel _ _    -> False\n    Opt.List exprs       -> any hasDebug exprs\n    Opt.Function _ expr  -> hasDebug expr\n    Opt.Call e es        -> hasDebug e || any hasDebug es\n    Opt.TailCall _ args  -> any (hasDebug . snd) args\n    Opt.If conds finally -> any (\\(c,e) -> hasDebug c || hasDebug e) conds || hasDebug finally\n    Opt.Let def body     -> defHasDebug def || hasDebug body\n    Opt.Destruct _ expr  -> hasDebug expr\n    Opt.Case _ _ d jumps -> deciderHasDebug d || any (hasDebug . snd) jumps\n    Opt.Accessor _       -> False\n    Opt.Access r _       -> hasDebug r\n    Opt.Update r fs      -> hasDebug r || any hasDebug fs\n    Opt.Record fs        -> any hasDebug fs\n    Opt.Unit             -> False\n    Opt.Tuple a b c      -> hasDebug a || hasDebug b || maybe False hasDebug c\n    Opt.Shader _ _ _     -> False\n\n\ndefHasDebug :: Opt.Def -> Bool\ndefHasDebug def =\n  case def of\n    Opt.Def _ expr       -> hasDebug expr\n    Opt.TailDef _ _ expr -> hasDebug expr\n\n\ndeciderHasDebug :: Opt.Decider Opt.Choice -> Bool\ndeciderHasDebug decider =\n  case decider of\n    Opt.Leaf (Opt.Inline expr)  -> hasDebug expr\n    Opt.Leaf (Opt.Jump _)       -> False\n    Opt.Chain _ success failure -> deciderHasDebug success || deciderHasDebug failure\n    Opt.FanOut _ tests fallback -> any (deciderHasDebug . snd) tests || deciderHasDebug fallback\n\n\n\n-- TODO: FIND GLOBALLY UNUSED DEFINITIONS?\n-- TODO: FIND PACKAGE USAGE STATS? (e.g. elm/core = 142, author/project = 2, etc.)\n"
  },
  {
    "path": "compiler/src/Nitpick/PatternMatches.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-x-partial #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Nitpick.PatternMatches\n  ( check\n  , Error(..)\n  , Context(..)\n  , Pattern(..)\n  , Literal(..)\n  )\n  where\n\n\n{- The algorithm used here comes from \"Warnings for Pattern Matching\"\nby Luc Maranget. Check it out for more information!\n\nhttp://moscova.inria.fr/~maranget/papers/warn/warn.pdf\n\n-}\n\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Maybe as Maybe\nimport qualified Data.Name as Name\nimport qualified Data.NonEmptyList as NE\n\nimport qualified AST.Canonical as Can\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.String as ES\nimport qualified Reporting.Annotation as A\n\n\n\n-- PATTERN\n\n\ndata Pattern\n  = Anything\n  | Literal Literal\n  | Ctor Can.Union Name.Name [Pattern]\n\n\ndata Literal\n  = Chr ES.String\n  | Str ES.String\n  | Int Int\n  deriving (Eq)\n\n\n\n-- CREATE SIMPLIFIED PATTERNS\n\n\nsimplify :: Can.Pattern -> Pattern\nsimplify (A.At _ pattern) =\n  case pattern of\n    Can.PAnything ->\n      Anything\n\n    Can.PVar _ ->\n      Anything\n\n    Can.PRecord _ ->\n      Anything\n\n    Can.PUnit ->\n      Ctor unit unitName []\n\n    Can.PTuple a b Nothing ->\n      Ctor pair pairName [ simplify a, simplify b ]\n\n    Can.PTuple a b (Just c) ->\n      Ctor triple tripleName [ simplify a, simplify b, simplify c ]\n\n    Can.PCtor _ _ union name _ args ->\n      Ctor union name $\n        map (\\(Can.PatternCtorArg _ _ arg) -> simplify arg) args\n\n    Can.PList entries ->\n      foldr cons nil entries\n\n    Can.PCons hd tl ->\n      cons hd (simplify tl)\n\n    Can.PAlias subPattern _ ->\n      simplify subPattern\n\n    Can.PInt int ->\n      Literal (Int int)\n\n    Can.PStr str ->\n      Literal (Str str)\n\n    Can.PChr chr ->\n      Literal (Chr chr)\n\n    Can.PBool union bool ->\n      Ctor union (if bool then Name.true else Name.false) []\n\n\ncons :: Can.Pattern -> Pattern -> Pattern\ncons hd tl =\n  Ctor list consName [ simplify hd, tl ]\n\n\n{-# NOINLINE nil #-}\nnil :: Pattern\nnil =\n  Ctor list nilName []\n\n\n\n-- BUILT-IN UNIONS\n\n\n{-# NOINLINE unit #-}\nunit :: Can.Union\nunit =\n  let\n    ctor =\n      Can.Ctor unitName Index.first 0 []\n  in\n  Can.Union [] [ ctor ] 1 Can.Normal\n\n\n{-# NOINLINE pair #-}\npair :: Can.Union\npair =\n  let\n    ctor =\n      Can.Ctor pairName Index.first 2 [Can.TVar \"a\", Can.TVar \"b\"]\n  in\n  Can.Union [\"a\",\"b\"] [ ctor ] 1 Can.Normal\n\n\n{-# NOINLINE triple #-}\ntriple :: Can.Union\ntriple =\n  let\n    ctor =\n      Can.Ctor tripleName Index.first 3 [Can.TVar \"a\", Can.TVar \"b\", Can.TVar \"c\"]\n  in\n  Can.Union [\"a\",\"b\",\"c\"] [ ctor ] 1 Can.Normal\n\n\n{-# NOINLINE list #-}\nlist :: Can.Union\nlist =\n  let\n    nilCtor =\n      Can.Ctor nilName Index.first 0 []\n\n    consCtor =\n      Can.Ctor consName Index.second 2\n        [ Can.TVar \"a\"\n        , Can.TType ModuleName.list Name.list [Can.TVar \"a\"]\n        ]\n  in\n  Can.Union [\"a\"] [ nilCtor, consCtor ] 2 Can.Normal\n\n\n{-# NOINLINE unitName #-}\nunitName :: Name.Name\nunitName = \"#0\"\n\n\n{-# NOINLINE pairName #-}\npairName :: Name.Name\npairName = \"#2\"\n\n\n{-# NOINLINE tripleName #-}\ntripleName :: Name.Name\ntripleName = \"#3\"\n\n\n{-# NOINLINE consName #-}\nconsName :: Name.Name\nconsName = \"::\"\n\n\n{-# NOINLINE nilName #-}\nnilName :: Name.Name\nnilName = \"[]\"\n\n\n\n-- ERROR\n\n\ndata Error\n  = Incomplete A.Region Context [Pattern]\n  | Redundant A.Region A.Region Int\n\n\ndata Context\n  = BadArg\n  | BadDestruct\n  | BadCase\n\n\n\n-- CHECK\n\n\ncheck :: Can.Module -> Either (NE.List Error) ()\ncheck (Can.Module _ _ _ decls _ _ _ _) =\n  case checkDecls decls [] of\n    [] ->\n      Right ()\n\n    e:es ->\n      Left (NE.List e es)\n\n\n\n-- CHECK DECLS\n\n\ncheckDecls :: Can.Decls -> [Error] -> [Error]\ncheckDecls decls errors =\n  case decls of\n    Can.Declare def subDecls ->\n      checkDef def $ checkDecls subDecls errors\n\n    Can.DeclareRec def defs subDecls ->\n      checkDef def (foldr checkDef (checkDecls subDecls errors) defs)\n\n    Can.SaveTheEnvironment ->\n      errors\n\n\n\n-- CHECK DEFS\n\n\ncheckDef :: Can.Def -> [Error] -> [Error]\ncheckDef def errors =\n  case def of\n    Can.Def _ args body ->\n      foldr checkArg (checkExpr body errors) args\n\n    Can.TypedDef _ _ args body _ ->\n      foldr checkTypedArg (checkExpr body errors) args\n\n\ncheckArg :: Can.Pattern -> [Error] -> [Error]\ncheckArg pattern@(A.At region _) errors =\n  checkPatterns region BadArg [pattern] errors\n\n\ncheckTypedArg :: (Can.Pattern, tipe) -> [Error] -> [Error]\ncheckTypedArg (pattern@(A.At region _), _) errors =\n  checkPatterns region BadArg [pattern] errors\n\n\n\n-- CHECK EXPRESSIONS\n\n\ncheckExpr :: Can.Expr -> [Error] -> [Error]\ncheckExpr (A.At region expression) errors =\n  case expression of\n    Can.VarLocal _ ->\n      errors\n\n    Can.VarTopLevel _ _ ->\n      errors\n\n    Can.VarKernel _ _ ->\n      errors\n\n    Can.VarForeign _ _ _ ->\n      errors\n\n    Can.VarCtor _ _ _ _ _ ->\n      errors\n\n    Can.VarDebug _ _ _ ->\n      errors\n\n    Can.VarOperator _ _ _ _ ->\n      errors\n\n    Can.Chr _ ->\n      errors\n\n    Can.Str _ ->\n      errors\n\n    Can.Int _ ->\n      errors\n\n    Can.Float _ ->\n      errors\n\n    Can.List entries ->\n      foldr checkExpr errors entries\n\n    Can.Negate expr ->\n      checkExpr expr errors\n\n    Can.Binop _ _ _ _ left right ->\n      checkExpr left $\n        checkExpr right errors\n\n    Can.Lambda args body ->\n      foldr checkArg (checkExpr body errors) args\n\n    Can.Call func args ->\n      checkExpr func $ foldr checkExpr errors args\n\n    Can.If branches finally ->\n      foldr checkIfBranch (checkExpr finally errors) branches\n\n    Can.Let def body ->\n      checkDef def $ checkExpr body errors\n\n    Can.LetRec defs body ->\n      foldr checkDef (checkExpr body errors) defs\n\n    Can.LetDestruct pattern@(A.At reg _) expr body ->\n      checkPatterns reg BadDestruct [pattern] $\n        checkExpr expr $ checkExpr body errors\n\n    Can.Case expr branches ->\n      checkExpr expr $ checkCases region branches errors\n\n    Can.Accessor _ ->\n      errors\n\n    Can.Access record _ ->\n      checkExpr record errors\n\n    Can.Update _ record fields ->\n      checkExpr record $ Map.foldr checkField errors fields\n\n    Can.Record fields ->\n      Map.foldr checkExpr errors fields\n\n    Can.Unit ->\n      errors\n\n    Can.Tuple a b maybeC ->\n      checkExpr a $\n        checkExpr b $\n          case maybeC of\n            Nothing ->\n              errors\n\n            Just c ->\n              checkExpr c errors\n\n    Can.Shader _ _ ->\n      errors\n\n\n\n-- CHECK FIELD\n\n\ncheckField :: Can.FieldUpdate -> [Error] -> [Error]\ncheckField (Can.FieldUpdate _ expr) errors =\n  checkExpr expr errors\n\n\n\n-- CHECK IF BRANCH\n\n\ncheckIfBranch :: (Can.Expr, Can.Expr) -> [Error] -> [Error]\ncheckIfBranch (condition, branch) errs =\n  checkExpr condition $ checkExpr branch errs\n\n\n\n-- CHECK CASE EXPRESSION\n\n\ncheckCases :: A.Region -> [Can.CaseBranch] -> [Error] -> [Error]\ncheckCases region branches errors =\n  let\n    (patterns, newErrors) =\n      foldr checkCaseBranch ([], errors) branches\n  in\n  checkPatterns region BadCase patterns newErrors\n\n\ncheckCaseBranch :: Can.CaseBranch -> ([Can.Pattern], [Error]) -> ([Can.Pattern], [Error])\ncheckCaseBranch (Can.CaseBranch pattern expr) (patterns, errors) =\n  ( pattern:patterns\n  , checkExpr expr errors\n  )\n\n\n\n-- CHECK PATTERNS\n\n\ncheckPatterns :: A.Region -> Context -> [Can.Pattern] -> [Error] -> [Error]\ncheckPatterns region context patterns errors =\n  case toNonRedundantRows region patterns of\n    Left err ->\n      err:errors\n\n    Right matrix ->\n      case isExhaustive matrix 1 of\n        [] ->\n          errors\n\n        badPatterns ->\n          Incomplete region context (map head badPatterns) : errors\n\n\n\n-- EXHAUSTIVE PATTERNS\n\n\n-- INVARIANTS:\n--\n--   The initial rows \"matrix\" are all of length 1\n--   The initial count of items per row \"n\" is also 1\n--   The resulting rows are examples of missing patterns\n--\nisExhaustive :: [[Pattern]] -> Int -> [[Pattern]]\nisExhaustive matrix n =\n  case matrix of\n    [] ->\n      [replicate n Anything]\n\n    _ ->\n      if n == 0 then\n        []\n      else\n      let\n        ctors = collectCtors matrix\n        numSeen = Map.size ctors\n      in\n      if numSeen == 0 then\n        (:) Anything\n          <$> isExhaustive (Maybe.mapMaybe specializeRowByAnything matrix) (n - 1)\n\n      else\n        let alts@(Can.Union _ altList numAlts _) = snd (Map.findMin ctors) in\n        if numSeen < numAlts then\n          (:)\n            <$> Maybe.mapMaybe (isMissing alts ctors) altList\n            <*> isExhaustive (Maybe.mapMaybe specializeRowByAnything matrix) (n - 1)\n\n        else\n          let\n            isAltExhaustive (Can.Ctor name _ arity _) =\n              recoverCtor alts name arity <$>\n              isExhaustive\n                (Maybe.mapMaybe (specializeRowByCtor name arity) matrix)\n                (arity + n - 1)\n          in\n          concatMap isAltExhaustive altList\n\n\nisMissing :: Can.Union -> Map.Map Name.Name a -> Can.Ctor -> Maybe Pattern\nisMissing union ctors (Can.Ctor name _ arity _) =\n  if Map.member name ctors then\n    Nothing\n  else\n    Just (Ctor union name (replicate arity Anything))\n\n\nrecoverCtor :: Can.Union -> Name.Name -> Int -> [Pattern] -> [Pattern]\nrecoverCtor union name arity patterns =\n  let\n    (args, rest) =\n      splitAt arity patterns\n  in\n  Ctor union name args : rest\n\n\n\n-- REDUNDANT PATTERNS\n\n\n-- INVARIANT: Produces a list of rows where (forall row. length row == 1)\ntoNonRedundantRows :: A.Region -> [Can.Pattern] -> Either Error [[Pattern]]\ntoNonRedundantRows region patterns =\n  toSimplifiedUsefulRows region [] patterns\n\n\n-- INVARIANT: Produces a list of rows where (forall row. length row == 1)\ntoSimplifiedUsefulRows :: A.Region -> [[Pattern]] -> [Can.Pattern] -> Either Error [[Pattern]]\ntoSimplifiedUsefulRows overallRegion checkedRows uncheckedPatterns =\n  case uncheckedPatterns of\n    [] ->\n      Right checkedRows\n\n    pattern@(A.At region _) : rest ->\n      let nextRow = [simplify pattern] in\n      if isUseful checkedRows nextRow then\n        toSimplifiedUsefulRows overallRegion (nextRow : checkedRows) rest\n      else\n        Left (Redundant overallRegion region (length checkedRows + 1))\n\n\n-- Check if a new row \"vector\" is useful given previous rows \"matrix\"\nisUseful :: [[Pattern]] -> [Pattern] -> Bool\nisUseful matrix vector =\n  case matrix of\n    [] ->\n      -- No rows are the same as the new vector! The vector is useful!\n      True\n\n    _ ->\n      case vector of\n        [] ->\n          -- There is nothing left in the new vector, but we still have\n          -- rows that match the same things. This is not a useful vector!\n          False\n\n        firstPattern : patterns ->\n          case firstPattern of\n            Ctor _ name args ->\n              -- keep checking rows that start with this Ctor or Anything\n              isUseful\n                (Maybe.mapMaybe (specializeRowByCtor name (length args)) matrix)\n                (args ++ patterns)\n\n            Anything ->\n              -- check if all alts appear in matrix\n              case isComplete matrix of\n                No ->\n                  -- This Anything is useful because some Ctors are missing.\n                  -- But what if a previous row has an Anything?\n                  -- If so, this one is not useful.\n                  isUseful (Maybe.mapMaybe specializeRowByAnything matrix) patterns\n\n                Yes alts ->\n                  -- All Ctors are covered, so this Anything is not needed for any\n                  -- of those. But what if some of those Ctors have subpatterns\n                  -- that make them less general? If so, this actually is useful!\n                  let\n                    isUsefulAlt (Can.Ctor name _ arity _) =\n                      isUseful\n                        (Maybe.mapMaybe (specializeRowByCtor name arity) matrix)\n                        (replicate arity Anything ++ patterns)\n                  in\n                    any isUsefulAlt alts\n\n            Literal literal ->\n              -- keep checking rows that start with this Literal or Anything\n              isUseful\n                (Maybe.mapMaybe (specializeRowByLiteral literal) matrix)\n                patterns\n\n\n-- INVARIANT: (length row == N) ==> (length result == arity + N - 1)\nspecializeRowByCtor :: Name.Name -> Int -> [Pattern] -> Maybe [Pattern]\nspecializeRowByCtor ctorName arity row =\n  case row of\n    Ctor _ name args : patterns ->\n      if name == ctorName then\n        Just (args ++ patterns)\n      else\n        Nothing\n\n    Anything : patterns ->\n      Just (replicate arity Anything ++ patterns)\n\n    Literal _ : _ ->\n      error $\n        \"Compiler bug! After type checking, constructors and literals\\\n        \\ should never align in pattern match exhaustiveness checks.\"\n\n    [] ->\n      error \"Compiler error! Empty matrices should not get specialized.\"\n\n\n-- INVARIANT: (length row == N) ==> (length result == N-1)\nspecializeRowByLiteral :: Literal -> [Pattern] -> Maybe [Pattern]\nspecializeRowByLiteral literal row =\n  case row of\n    Literal lit : patterns ->\n      if lit == literal then\n        Just patterns\n      else\n        Nothing\n\n    Anything : patterns ->\n      Just patterns\n\n    Ctor _ _ _ : _ ->\n      error $\n        \"Compiler bug! After type checking, constructors and literals\\\n        \\ should never align in pattern match exhaustiveness checks.\"\n\n    [] ->\n      error \"Compiler error! Empty matrices should not get specialized.\"\n\n\n-- INVARIANT: (length row == N) ==> (length result == N-1)\nspecializeRowByAnything :: [Pattern] -> Maybe [Pattern]\nspecializeRowByAnything row =\n  case row of\n    [] ->\n      Nothing\n\n    Ctor _ _ _ : _ ->\n      Nothing\n\n    Anything : patterns ->\n      Just patterns\n\n    Literal _ : _ ->\n      Nothing\n\n\n\n-- ALL CONSTRUCTORS ARE PRESENT?\n\n\ndata Complete\n  = Yes [Can.Ctor]\n  | No\n\n\nisComplete :: [[Pattern]] -> Complete\nisComplete matrix =\n  let\n    ctors = collectCtors matrix\n    numSeen = Map.size ctors\n  in\n    if numSeen == 0 then\n      No\n    else\n      let (Can.Union _ alts numAlts _) = snd (Map.findMin ctors) in\n      if numSeen == numAlts then Yes alts else No\n\n\n\n-- COLLECT CTORS\n\n\ncollectCtors :: [[Pattern]] -> Map.Map Name.Name Can.Union\ncollectCtors matrix =\n  List.foldl' collectCtorsHelp Map.empty matrix\n\n\ncollectCtorsHelp :: Map.Map Name.Name Can.Union -> [Pattern] -> Map.Map Name.Name Can.Union\ncollectCtorsHelp ctors row =\n  case row of\n    Ctor union name _ : _ ->\n      Map.insert name union ctors\n\n    _ ->\n      ctors\n"
  },
  {
    "path": "compiler/src/Optimize/Case.hs",
    "content": "module Optimize.Case\n  ( optimize\n  )\n  where\n\n\nimport Control.Arrow (second)\nimport qualified Data.Map as Map\nimport Data.Map ((!))\nimport qualified Data.Maybe as Maybe\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified Optimize.DecisionTree as DT\n\n\n\n-- OPTIMIZE A CASE EXPRESSION\n\n\noptimize :: Name.Name -> Name.Name -> [(Can.Pattern, Opt.Expr)] -> Opt.Expr\noptimize temp root optBranches =\n  let\n    (patterns, indexedBranches) =\n      unzip (zipWith indexify [0..] optBranches)\n\n    decider = treeToDecider (DT.compile patterns)\n    targetCounts = countTargets decider\n\n    (choices, maybeJumps) =\n        unzip (map (createChoices targetCounts) indexedBranches)\n  in\n  Opt.Case temp root\n    (insertChoices (Map.fromList choices) decider)\n    (Maybe.catMaybes maybeJumps)\n\n\nindexify :: Int -> (a,b) -> ((a,Int), (Int,b))\nindexify index (pattern, branch) =\n    ( (pattern, index)\n    , (index, branch)\n    )\n\n\n\n-- TREE TO DECIDER\n--\n-- Decision trees may have some redundancies, so we convert them to a Decider\n-- which has special constructs to avoid code duplication when possible.\n\n\ntreeToDecider :: DT.DecisionTree -> Opt.Decider Int\ntreeToDecider tree =\n  case tree of\n    DT.Match target ->\n        Opt.Leaf target\n\n    -- zero options\n    DT.Decision _ [] Nothing ->\n        error \"compiler bug, somehow created an empty decision tree\"\n\n    -- one option\n    DT.Decision _ [(_, subTree)] Nothing ->\n        treeToDecider subTree\n\n    DT.Decision _ [] (Just subTree) ->\n        treeToDecider subTree\n\n    -- two options\n    DT.Decision path [(test, successTree)] (Just failureTree) ->\n        toChain path test successTree failureTree\n\n    DT.Decision path [(test, successTree), (_, failureTree)] Nothing ->\n        toChain path test successTree failureTree\n\n    -- many options\n    DT.Decision path edges Nothing ->\n        let\n          (necessaryTests, fallback) =\n              (init edges, snd (last edges))\n        in\n          Opt.FanOut\n            path\n            (map (second treeToDecider) necessaryTests)\n            (treeToDecider fallback)\n\n    DT.Decision path edges (Just fallback) ->\n        Opt.FanOut path (map (second treeToDecider) edges) (treeToDecider fallback)\n\n\ntoChain :: DT.Path -> DT.Test -> DT.DecisionTree -> DT.DecisionTree -> Opt.Decider Int\ntoChain path test successTree failureTree =\n  let\n    failure =\n      treeToDecider failureTree\n  in\n    case treeToDecider successTree of\n      Opt.Chain testChain success subFailure | failure == subFailure ->\n          Opt.Chain ((path, test) : testChain) success failure\n\n      success ->\n          Opt.Chain [(path, test)] success failure\n\n\n\n-- INSERT CHOICES\n--\n-- If a target appears exactly once in a Decider, the corresponding expression\n-- can be inlined. Whether things are inlined or jumps is called a \"choice\".\n\n\ncountTargets :: Opt.Decider Int -> Map.Map Int Int\ncountTargets decisionTree =\n  case decisionTree of\n    Opt.Leaf target ->\n        Map.singleton target 1\n\n    Opt.Chain _ success failure ->\n        Map.unionWith (+) (countTargets success) (countTargets failure)\n\n    Opt.FanOut _ tests fallback ->\n        Map.unionsWith (+) (map countTargets (fallback : map snd tests))\n\n\ncreateChoices\n    :: Map.Map Int Int\n    -> (Int, Opt.Expr)\n    -> ( (Int, Opt.Choice), Maybe (Int, Opt.Expr) )\ncreateChoices targetCounts (target, branch) =\n    if targetCounts ! target == 1 then\n        ( (target, Opt.Inline branch)\n        , Nothing\n        )\n\n    else\n        ( (target, Opt.Jump target)\n        , Just (target, branch)\n        )\n\n\ninsertChoices\n    :: Map.Map Int Opt.Choice\n    -> Opt.Decider Int\n    -> Opt.Decider Opt.Choice\ninsertChoices choiceDict decider =\n  let\n    go =\n      insertChoices choiceDict\n  in\n    case decider of\n      Opt.Leaf target ->\n          Opt.Leaf (choiceDict ! target)\n\n      Opt.Chain testChain success failure ->\n          Opt.Chain testChain (go success) (go failure)\n\n      Opt.FanOut path tests fallback ->\n          Opt.FanOut path (map (second go) tests) (go fallback)\n\n"
  },
  {
    "path": "compiler/src/Optimize/DecisionTree.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-x-partial #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Optimize.DecisionTree\n  ( DecisionTree(..)\n  , compile\n  , Path(..)\n  , Test(..)\n  )\n  where\n\n\n{- To learn more about how this works, definitely read through:\n\n    \"When Do Match-Compilation Heuristics Matter?\"\n\nby Kevin Scott and Norman Ramsey. The rough idea is that we start with a simple\nlist of patterns and expressions, and then turn that into a \"decision tree\"\nthat requires as few tests as possible to make it to a leaf. Read the paper, it\nexplains this extraordinarily well! We are currently using the same heuristics\nas SML/NJ to get nice trees.\n-}\n\nimport Control.Arrow (second)\nimport Control.Monad (liftM, liftM2, liftM5)\nimport Data.Binary\nimport qualified Data.List as List\nimport qualified Data.Maybe as Maybe\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\n\nimport qualified AST.Canonical as Can\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.String as ES\nimport qualified Reporting.Annotation as A\n\n\n\n-- COMPILE CASES\n\n\n{-| Users of this module will mainly interact with this function. It takes\nsome normal branches and gives out a decision tree that has \"labels\" at all\nthe leafs and a dictionary that maps these \"labels\" to the code that should\nrun.\n\nIf 2 or more leaves point to the same label, we need to do some tricks in JS to\nmake that work nicely. When is JS getting goto?! ;) That is outside the scope\nof this module though.\n-}\ncompile :: [(Can.Pattern, Int)] -> DecisionTree\ncompile rawBranches =\n  let\n    format (pattern, index) =\n        Branch index [(Empty, pattern)]\n  in\n    toDecisionTree (map format rawBranches)\n\n\n\n-- DECISION TREES\n\n\ndata DecisionTree\n  = Match Int\n  | Decision\n      { _path :: Path\n      , _edges :: [(Test, DecisionTree)]\n      , _default :: Maybe DecisionTree\n      }\n  deriving (Eq)\n\n\ndata Test\n  = IsCtor ModuleName.Canonical Name.Name Index.ZeroBased Int Can.CtorOpts\n  | IsCons\n  | IsNil\n  | IsTuple\n  | IsInt Int\n  | IsChr ES.String\n  | IsStr ES.String\n  | IsBool Bool\n  deriving (Eq, Ord)\n\n\ndata Path\n  = Index Index.ZeroBased Path\n  | Unbox Path\n  | Empty\n  deriving (Eq)\n\n\n\n-- ACTUALLY BUILD DECISION TREES\n\n\ndata Branch =\n  Branch\n    { _goal :: Int\n    , _patterns :: [(Path, Can.Pattern)]\n    }\n\n\ntoDecisionTree :: [Branch] -> DecisionTree\ntoDecisionTree rawBranches =\n  let\n    branches =\n        map flattenPatterns rawBranches\n  in\n  case checkForMatch branches of\n    Just goal ->\n        Match goal\n\n    Nothing ->\n        let\n          path =\n              pickPath branches\n\n          (edges, fallback) =\n              gatherEdges branches path\n\n          decisionEdges =\n              map (second toDecisionTree) edges\n        in\n          case (decisionEdges, fallback) of\n            ([(_tag, decisionTree)], []) ->\n                decisionTree\n\n            (_, []) ->\n                Decision path decisionEdges Nothing\n\n            ([], _ : _) ->\n                toDecisionTree fallback\n\n            (_, _) ->\n                Decision path decisionEdges (Just (toDecisionTree fallback))\n\n\nisComplete :: [Test] -> Bool\nisComplete tests =\n  case head tests of\n    IsCtor _ _ _ numAlts _ ->\n      numAlts == length tests\n\n    IsCons ->\n      length tests == 2\n\n    IsNil ->\n      length tests == 2\n\n    IsTuple ->\n      True\n\n    IsChr _ ->\n      False\n\n    IsStr _ ->\n      False\n\n    IsInt _ ->\n      False\n\n    IsBool _ ->\n      length tests == 2\n\n\n\n-- FLATTEN PATTERNS\n\n\n{-| Flatten type aliases and use the VariantDict to figure out when a tag is\nthe only variant so we can skip doing any tests on it.\n-}\nflattenPatterns :: Branch -> Branch\nflattenPatterns (Branch goal pathPatterns) =\n  Branch goal (foldr flatten [] pathPatterns)\n\n\nflatten :: (Path, Can.Pattern) -> [(Path, Can.Pattern)] -> [(Path, Can.Pattern)]\nflatten pathPattern@(path, A.At region pattern) otherPathPatterns =\n  case pattern of\n    Can.PVar _ ->\n      pathPattern : otherPathPatterns\n\n    Can.PAnything ->\n      pathPattern : otherPathPatterns\n\n    Can.PCtor _ _ (Can.Union _ _ numAlts _) _ _ ctorArgs ->\n      if numAlts == 1 then\n        case map dearg ctorArgs of\n          [arg] ->\n            flatten (Unbox path, arg) otherPathPatterns\n\n          args ->\n            foldr flatten otherPathPatterns (subPositions path args)\n      else\n        pathPattern : otherPathPatterns\n\n    Can.PTuple a b maybeC ->\n      flatten (Index Index.first path, a) $\n      flatten (Index Index.second path, b) $\n        case maybeC of\n          Nothing ->\n            otherPathPatterns\n\n          Just c ->\n            flatten (Index Index.third path, c) otherPathPatterns\n\n    Can.PUnit ->\n      otherPathPatterns\n\n    Can.PAlias realPattern alias ->\n      flatten (path, realPattern) $\n        (path, A.At region (Can.PVar alias)) : otherPathPatterns\n\n    Can.PRecord _ ->\n      pathPattern : otherPathPatterns\n\n    Can.PList _ ->\n      pathPattern : otherPathPatterns\n\n    Can.PCons _ _ ->\n      pathPattern : otherPathPatterns\n\n    Can.PChr _ ->\n      pathPattern : otherPathPatterns\n\n    Can.PStr _ ->\n      pathPattern : otherPathPatterns\n\n    Can.PInt _ ->\n      pathPattern : otherPathPatterns\n\n    Can.PBool _ _ ->\n      pathPattern : otherPathPatterns\n\n\nsubPositions :: Path -> [Can.Pattern] -> [(Path, Can.Pattern)]\nsubPositions path patterns =\n  Index.indexedMap (\\index pattern -> (Index index path, pattern)) patterns\n\n\ndearg :: Can.PatternCtorArg -> Can.Pattern\ndearg (Can.PatternCtorArg _ _ pattern) =\n  pattern\n\n\n\n-- SUCCESSFULLY MATCH\n\n\n{-| If the first branch has no more \"decision points\" we can finally take that\npath. If that is the case we give the resulting label and a mapping from free\nvariables to \"how to get their value\". So a pattern like (Just (x,_)) will give\nus something like (\"x\" => value.0.0)\n-}\ncheckForMatch :: [Branch] -> Maybe Int\ncheckForMatch branches =\n  case branches of\n    Branch goal patterns : _ | all (not . needsTests . snd) patterns ->\n        Just goal\n\n    _ ->\n        Nothing\n\n\n\n-- GATHER OUTGOING EDGES\n\n\ngatherEdges :: [Branch] -> Path -> ([(Test, [Branch])], [Branch])\ngatherEdges branches path =\n  let\n    relevantTests =\n        testsAtPath path branches\n\n    allEdges =\n        map (edgesFor path branches) relevantTests\n\n    fallbacks =\n        if isComplete relevantTests then\n          []\n        else\n          filter (isIrrelevantTo path) branches\n  in\n    ( allEdges, fallbacks )\n\n\n\n-- FIND RELEVANT TESTS\n\n\ntestsAtPath :: Path -> [Branch] -> [Test]\ntestsAtPath selectedPath branches =\n  let\n    allTests =\n      Maybe.mapMaybe (testAtPath selectedPath) branches\n\n    skipVisited test curr@(uniqueTests, visitedTests) =\n        if Set.member test visitedTests then\n            curr\n        else\n            ( test : uniqueTests\n            , Set.insert test visitedTests\n            )\n  in\n  fst (foldr skipVisited ([], Set.empty) allTests)\n\n\ntestAtPath :: Path -> Branch -> Maybe Test\ntestAtPath selectedPath (Branch _ pathPatterns) =\n  case List.lookup selectedPath pathPatterns of\n    Nothing ->\n      Nothing\n\n    Just (A.At _ pattern) ->\n      case pattern of\n        Can.PCtor home _ (Can.Union _ _ numAlts opts) name index _ ->\n            Just (IsCtor home name index numAlts opts)\n\n        Can.PList ps ->\n            Just (case ps of { [] -> IsNil ; _ -> IsCons })\n\n        Can.PCons _ _ ->\n            Just IsCons\n\n        Can.PTuple _ _ _ ->\n            Just IsTuple\n\n        Can.PUnit ->\n            Just IsTuple\n\n        Can.PVar _ ->\n            Nothing\n\n        Can.PAnything ->\n            Nothing\n\n        Can.PInt int ->\n            Just (IsInt int)\n\n        Can.PStr str ->\n            Just (IsStr str)\n\n        Can.PChr chr ->\n            Just (IsChr chr)\n\n        Can.PBool _ bool ->\n            Just (IsBool bool)\n\n        Can.PRecord _ ->\n            Nothing\n\n        Can.PAlias _ _ ->\n            error \"aliases should never reach 'testAtPath' function\"\n\n\n\n-- BUILD EDGES\n\n\nedgesFor :: Path -> [Branch] -> Test -> (Test, [Branch])\nedgesFor path branches test =\n  ( test\n  , Maybe.mapMaybe (toRelevantBranch test path) branches\n  )\n\n\ntoRelevantBranch :: Test -> Path -> Branch -> Maybe Branch\ntoRelevantBranch test path branch@(Branch goal pathPatterns) =\n  case extract path pathPatterns of\n    Found start (A.At region pattern) end ->\n        case pattern of\n          Can.PCtor _ _ (Can.Union _ _ numAlts _) name _ ctorArgs ->\n              case test of\n                IsCtor _ testName _ _ _ | name == testName ->\n                  Just $ Branch goal $\n                    case map dearg ctorArgs of\n                      [arg] | numAlts == 1 ->\n                        start ++ [(Unbox path, arg)] ++ end\n\n                      args ->\n                        start ++ subPositions path args ++ end\n\n                _ ->\n                  Nothing\n\n          Can.PList [] ->\n              case test of\n                IsNil ->\n                  Just (Branch goal (start ++ end))\n\n                _ ->\n                  Nothing\n\n          Can.PList (hd:tl) ->\n              case test of\n                IsCons ->\n                  let tl' = A.At region (Can.PList tl) in\n                  Just (Branch goal (start ++ subPositions path [ hd, tl' ] ++ end))\n\n                _ ->\n                  Nothing\n\n          Can.PCons hd tl ->\n              case test of\n                IsCons ->\n                  Just (Branch goal (start ++ subPositions path [hd,tl] ++ end))\n\n                _ ->\n                  Nothing\n\n          Can.PChr chr ->\n              case test of\n                IsChr testChr | chr == testChr ->\n                  Just (Branch goal (start ++ end))\n                _ ->\n                  Nothing\n\n          Can.PStr str ->\n              case test of\n                IsStr testStr | str == testStr ->\n                  Just (Branch goal (start ++ end))\n\n                _ ->\n                  Nothing\n\n          Can.PInt int ->\n              case test of\n                IsInt testInt | int == testInt ->\n                  Just (Branch goal (start ++ end))\n\n                _ ->\n                  Nothing\n\n          Can.PBool _ bool ->\n              case test of\n                IsBool testBool | bool == testBool ->\n                  Just (Branch goal (start ++ end))\n\n                _ ->\n                  Nothing\n\n          Can.PUnit ->\n              Just (Branch goal (start ++ end))\n\n          Can.PTuple a b maybeC ->\n              Just (Branch goal (start ++ subPositions path (a : b : Maybe.maybeToList maybeC) ++ end))\n\n          Can.PVar _ ->\n              Just branch\n\n          Can.PAnything ->\n              Just branch\n\n          Can.PRecord _ ->\n              Just branch\n\n          Can.PAlias _ _ ->\n              Just branch\n\n    NotFound ->\n        Just branch\n\n\ndata Extract\n  = NotFound\n  | Found [(Path, Can.Pattern)] Can.Pattern [(Path, Can.Pattern)]\n\n\nextract :: Path -> [(Path, Can.Pattern)] -> Extract\nextract selectedPath pathPatterns =\n  case pathPatterns of\n    [] ->\n        NotFound\n\n    first@(path, pattern) : rest ->\n        if path == selectedPath then\n            Found [] pattern rest\n\n        else\n            case extract selectedPath rest of\n              NotFound ->\n                  NotFound\n\n              Found start foundPattern end ->\n                  Found (first : start) foundPattern end\n\n\n\n-- FIND IRRELEVANT BRANCHES\n\n\nisIrrelevantTo :: Path -> Branch -> Bool\nisIrrelevantTo selectedPath (Branch _ pathPatterns) =\n  case List.lookup selectedPath pathPatterns of\n    Nothing ->\n        True\n\n    Just pattern ->\n        not (needsTests pattern)\n\n\nneedsTests :: Can.Pattern -> Bool\nneedsTests (A.At _ pattern) =\n  case pattern of\n    Can.PVar _            -> False\n    Can.PAnything         -> False\n    Can.PRecord _         -> False\n    Can.PCtor _ _ _ _ _ _ -> True\n    Can.PList _           -> True\n    Can.PCons _ _         -> True\n    Can.PUnit             -> True\n    Can.PTuple _ _ _      -> True\n    Can.PChr _            -> True\n    Can.PStr _            -> True\n    Can.PInt _            -> True\n    Can.PBool _ _         -> True\n    Can.PAlias _ _ ->\n        error \"aliases should never reach 'isIrrelevantTo' function\"\n\n\n\n\n-- PICK A PATH\n\n\npickPath :: [Branch] -> Path\npickPath branches =\n  let\n    allPaths =\n      Maybe.mapMaybe isChoicePath (concatMap _patterns branches)\n  in\n    case bests (addWeights (smallDefaults branches) allPaths) of\n      [path] ->\n          path\n\n      tiedPaths ->\n          head (bests (addWeights (smallBranchingFactor branches) tiedPaths))\n\n\nisChoicePath :: (Path, Can.Pattern) -> Maybe Path\nisChoicePath (path, pattern) =\n  if needsTests pattern then\n      Just path\n  else\n      Nothing\n\n\naddWeights :: (Path -> Int) -> [Path] -> [(Path, Int)]\naddWeights toWeight paths =\n  map (\\path -> (path, toWeight path)) paths\n\n\nbests :: [(Path, Int)] -> [Path]\nbests allPaths =\n  case allPaths of\n    [] ->\n      error \"Cannot choose the best of zero paths. This should never happen.\"\n\n    (headPath, headWeight) : weightedPaths ->\n      let\n        gatherMinimum acc@(minWeight, paths) (path, weight) =\n          if weight == minWeight then\n            (minWeight, path : paths)\n\n          else if weight < minWeight then\n            (weight, [path])\n\n          else\n            acc\n      in\n        snd (List.foldl' gatherMinimum (headWeight, [headPath]) weightedPaths)\n\n\n\n-- PATH PICKING HEURISTICS\n\n\nsmallDefaults :: [Branch] -> Path -> Int\nsmallDefaults branches path =\n  length (filter (isIrrelevantTo path) branches)\n\n\nsmallBranchingFactor :: [Branch] -> Path -> Int\nsmallBranchingFactor branches path =\n  let\n    (edges, fallback) =\n      gatherEdges branches path\n  in\n    length edges + (if null fallback then 0 else 1)\n\n\n\n-- BINARY\n\n\ninstance Binary Test where\n  put test =\n    case test of\n      IsCtor a b c d e -> putWord8 0 >> put a >> put b >> put c >> put d >> put e\n      IsCons           -> putWord8 1\n      IsNil            -> putWord8 2\n      IsTuple          -> putWord8 3\n      IsChr a          -> putWord8 4 >> put a\n      IsStr a          -> putWord8 5 >> put a\n      IsInt a          -> putWord8 6 >> put a\n      IsBool a         -> putWord8 7 >> put a\n\n  get =\n    do  word <- getWord8\n        case word of\n          0 -> liftM5 IsCtor get get get get get\n          1 -> pure   IsCons\n          2 -> pure   IsNil\n          3 -> pure   IsTuple\n          4 -> liftM  IsChr get\n          5 -> liftM  IsStr get\n          6 -> liftM  IsInt get\n          7 -> liftM  IsBool get\n          _ -> fail \"problem getting DecisionTree.Test binary\"\n\n\ninstance Binary Path where\n  put path =\n    case path of\n      Index a b -> putWord8 0 >> put a >> put b\n      Unbox a   -> putWord8 1 >> put a\n      Empty     -> putWord8 2\n\n  get =\n    do  word <- getWord8\n        case word of\n          0 -> liftM2 Index get get\n          1 -> liftM Unbox get\n          2 -> pure Empty\n          _ -> fail \"problem getting DecisionTree.Path binary\"\n"
  },
  {
    "path": "compiler/src/Optimize/Expression.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Optimize.Expression\n  ( optimize\n  , destructArgs\n  , optimizePotentialTailCall\n  )\n  where\n\n\nimport Prelude hiding (cycle)\nimport Control.Monad (foldM)\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified AST.Utils.Shader as Shader\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Optimize.Case as Case\nimport qualified Optimize.Names as Names\nimport qualified Reporting.Annotation as A\n\n\n\n-- OPTIMIZE\n\n\ntype Cycle =\n  Set.Set Name.Name\n\n\noptimize :: Cycle -> Can.Expr -> Names.Tracker Opt.Expr\noptimize cycle (A.At region expression) =\n  case expression of\n    Can.VarLocal name ->\n      pure (Opt.VarLocal name)\n\n    Can.VarTopLevel home name ->\n      if Set.member name cycle then\n        pure (Opt.VarCycle home name)\n      else\n        Names.registerGlobal home name\n\n    Can.VarKernel home name ->\n      Names.registerKernel home (Opt.VarKernel home name)\n\n    Can.VarForeign home name _ ->\n      Names.registerGlobal home name\n\n    Can.VarCtor opts home name index _ ->\n      Names.registerCtor home name index opts\n\n    Can.VarDebug home name _ ->\n      Names.registerDebug name home region\n\n    Can.VarOperator _ home name _ ->\n      Names.registerGlobal home name\n\n    Can.Chr chr ->\n      Names.registerKernel Name.utils (Opt.Chr chr)\n\n    Can.Str str ->\n      pure (Opt.Str str)\n\n    Can.Int int ->\n      pure (Opt.Int int)\n\n    Can.Float float ->\n      pure (Opt.Float float)\n\n    Can.List entries ->\n      Names.registerKernel Name.list Opt.List\n        <*> traverse (optimize cycle) entries\n\n    Can.Negate expr ->\n      do  func <- Names.registerGlobal ModuleName.basics Name.negate\n          arg <- optimize cycle expr\n          pure $ Opt.Call func [arg]\n\n    Can.Binop _ home name _ left right ->\n      do  optFunc <- Names.registerGlobal home name\n          optLeft <- optimize cycle left\n          optRight <- optimize cycle right\n          return (Opt.Call optFunc [optLeft, optRight])\n\n    Can.Lambda args body ->\n      do  (argNames, destructors) <- destructArgs args\n          obody <- optimize cycle body\n          pure $ Opt.Function argNames (foldr Opt.Destruct obody destructors)\n\n    Can.Call func args ->\n      Opt.Call\n        <$> optimize cycle func\n        <*> traverse (optimize cycle) args\n\n    Can.If branches finally ->\n      let\n        optimizeBranch (condition, branch) =\n          (,)\n            <$> optimize cycle condition\n            <*> optimize cycle branch\n      in\n      Opt.If\n        <$> traverse optimizeBranch branches\n        <*> optimize cycle finally\n\n    Can.Let def body ->\n      optimizeDef cycle def =<< optimize cycle body\n\n    Can.LetRec defs body ->\n      case defs of\n        [def] ->\n          Opt.Let\n            <$> optimizePotentialTailCallDef cycle def\n            <*> optimize cycle body\n\n        _ ->\n          do  obody <- optimize cycle body\n              foldM (\\bod def -> optimizeDef cycle def bod) obody defs\n\n    Can.LetDestruct pattern expr body ->\n      do  (name, destructs) <- destruct pattern\n          oexpr <- optimize cycle expr\n          obody <- optimize cycle body\n          pure $\n            Opt.Let (Opt.Def name oexpr) (foldr Opt.Destruct obody destructs)\n\n    Can.Case expr branches ->\n      let\n        optimizeBranch root (Can.CaseBranch pattern branch) =\n          do  destructors <- destructCase root pattern\n              obranch <- optimize cycle branch\n              pure (pattern, foldr Opt.Destruct obranch destructors)\n      in\n      do  temp <- Names.generate\n          oexpr <- optimize cycle expr\n          case oexpr of\n            Opt.VarLocal root ->\n              Case.optimize temp root <$> traverse (optimizeBranch root) branches\n\n            _ ->\n              do  obranches <- traverse (optimizeBranch temp) branches\n                  return $ Opt.Let (Opt.Def temp oexpr) (Case.optimize temp temp obranches)\n\n    Can.Accessor field ->\n      Names.registerField field (Opt.Accessor field)\n\n    Can.Access record (A.At _ field) ->\n      do  optRecord <- optimize cycle record\n          Names.registerField field (Opt.Access optRecord field)\n\n    Can.Update _ record updates ->\n      Names.registerFieldDict updates Opt.Update\n        <*> optimize cycle record\n        <*> traverse (optimizeUpdate cycle) updates\n\n    Can.Record fields ->\n      Names.registerFieldDict fields Opt.Record\n        <*> traverse (optimize cycle) fields\n\n    Can.Unit ->\n      Names.registerKernel Name.utils Opt.Unit\n\n    Can.Tuple a b maybeC ->\n      Names.registerKernel Name.utils Opt.Tuple\n        <*> optimize cycle a\n        <*> optimize cycle b\n        <*> traverse (optimize cycle) maybeC\n\n    Can.Shader src (Shader.Types attributes uniforms _varyings) ->\n      pure (Opt.Shader src (Map.keysSet attributes) (Map.keysSet uniforms))\n\n\n\n-- UPDATE\n\n\noptimizeUpdate :: Cycle -> Can.FieldUpdate -> Names.Tracker Opt.Expr\noptimizeUpdate cycle (Can.FieldUpdate _ expr) =\n  optimize cycle expr\n\n\n\n-- DEFINITION\n\n\noptimizeDef :: Cycle -> Can.Def -> Opt.Expr -> Names.Tracker Opt.Expr\noptimizeDef cycle def body =\n  case def of\n    Can.Def (A.At _ name) args expr ->\n      optimizeDefHelp cycle name args expr body\n\n    Can.TypedDef (A.At _ name) _ typedArgs expr _ ->\n      optimizeDefHelp cycle name (map fst typedArgs) expr body\n\n\noptimizeDefHelp :: Cycle -> Name.Name -> [Can.Pattern] -> Can.Expr -> Opt.Expr -> Names.Tracker Opt.Expr\noptimizeDefHelp cycle name args expr body =\n  do  oexpr <- optimize cycle expr\n      case args of\n        [] ->\n          pure $ Opt.Let (Opt.Def name oexpr) body\n\n        _ ->\n          do  (argNames, destructors) <- destructArgs args\n              let ofunc = Opt.Function argNames (foldr Opt.Destruct oexpr destructors)\n              pure $ Opt.Let (Opt.Def name ofunc) body\n\n\n\n-- DESTRUCTURING\n\n\ndestructArgs :: [Can.Pattern] -> Names.Tracker ([Name.Name], [Opt.Destructor])\ndestructArgs args =\n  do  (argNames, destructorLists) <- unzip <$> traverse destruct args\n      return (argNames, concat destructorLists)\n\n\ndestructCase :: Name.Name -> Can.Pattern -> Names.Tracker [Opt.Destructor]\ndestructCase rootName pattern =\n  reverse <$> destructHelp (Opt.Root rootName) pattern []\n\n\ndestruct :: Can.Pattern -> Names.Tracker (Name.Name, [Opt.Destructor])\ndestruct pattern@(A.At _ ptrn) =\n  case ptrn of\n    Can.PVar name ->\n      pure (name, [])\n\n    Can.PAlias subPattern name ->\n      do  revDs <- destructHelp (Opt.Root name) subPattern []\n          pure (name, reverse revDs)\n\n    _ ->\n      do  name <- Names.generate\n          revDs <- destructHelp (Opt.Root name) pattern []\n          pure (name, reverse revDs)\n\n\ndestructHelp :: Opt.Path -> Can.Pattern -> [Opt.Destructor] -> Names.Tracker [Opt.Destructor]\ndestructHelp path (A.At region pattern) revDs =\n  case pattern of\n    Can.PAnything ->\n      pure revDs\n\n    Can.PVar name ->\n      pure (Opt.Destructor name path : revDs)\n\n    Can.PRecord fields ->\n      let\n        toDestruct name =\n          Opt.Destructor name (Opt.Field name path)\n      in\n      Names.registerFieldList fields (map toDestruct fields ++ revDs)\n\n    Can.PAlias subPattern name ->\n      destructHelp (Opt.Root name) subPattern $\n        Opt.Destructor name path : revDs\n\n    Can.PUnit ->\n      pure revDs\n\n    Can.PTuple a b Nothing ->\n      destructTwo path a b revDs\n\n    Can.PTuple a b (Just c) ->\n      case path of\n        Opt.Root _ ->\n          destructHelp (Opt.Index Index.third path) c =<<\n            destructHelp (Opt.Index Index.second path) b =<<\n              destructHelp (Opt.Index Index.first path) a revDs\n\n        _ ->\n          do  name <- Names.generate\n              let newRoot = Opt.Root name\n              destructHelp (Opt.Index Index.third newRoot) c =<<\n                destructHelp (Opt.Index Index.second newRoot) b =<<\n                  destructHelp (Opt.Index Index.first newRoot) a (Opt.Destructor name path : revDs)\n\n    Can.PList [] ->\n      pure revDs\n\n    Can.PList (hd:tl) ->\n      destructTwo path hd (A.At region (Can.PList tl)) revDs\n\n    Can.PCons hd tl ->\n      destructTwo path hd tl revDs\n\n    Can.PChr _ ->\n      pure revDs\n\n    Can.PStr _ ->\n      pure revDs\n\n    Can.PInt _ ->\n      pure revDs\n\n    Can.PBool _ _ ->\n      pure revDs\n\n    Can.PCtor _ _ (Can.Union _ _ _ opts) _ _ args ->\n      case args of\n        [Can.PatternCtorArg _ _ arg] ->\n          case opts of\n            Can.Normal -> destructHelp (Opt.Index Index.first path) arg revDs\n            Can.Unbox  -> destructHelp (Opt.Unbox path) arg revDs\n            Can.Enum   -> destructHelp (Opt.Index Index.first path) arg revDs\n\n        _ ->\n          case path of\n            Opt.Root _ ->\n              foldM (destructCtorArg path) revDs args\n\n            _ ->\n              do  name <- Names.generate\n                  foldM (destructCtorArg (Opt.Root name)) (Opt.Destructor name path : revDs) args\n\n\ndestructTwo :: Opt.Path -> Can.Pattern -> Can.Pattern -> [Opt.Destructor] -> Names.Tracker [Opt.Destructor]\ndestructTwo path a b revDs =\n  case path of\n    Opt.Root _ ->\n      destructHelp (Opt.Index Index.second path) b =<<\n        destructHelp (Opt.Index Index.first path) a revDs\n\n    _ ->\n      do  name <- Names.generate\n          let newRoot = Opt.Root name\n          destructHelp (Opt.Index Index.second newRoot) b =<<\n            destructHelp (Opt.Index Index.first newRoot) a (Opt.Destructor name path : revDs)\n\n\ndestructCtorArg :: Opt.Path -> [Opt.Destructor] -> Can.PatternCtorArg -> Names.Tracker [Opt.Destructor]\ndestructCtorArg path revDs (Can.PatternCtorArg index _ arg) =\n  destructHelp (Opt.Index index path) arg revDs\n\n\n\n-- TAIL CALL\n\n\noptimizePotentialTailCallDef :: Cycle -> Can.Def -> Names.Tracker Opt.Def\noptimizePotentialTailCallDef cycle def =\n  case def of\n    Can.Def (A.At _ name) args expr ->\n      optimizePotentialTailCall cycle name args expr\n\n    Can.TypedDef (A.At _ name) _ typedArgs expr _ ->\n      optimizePotentialTailCall cycle name (map fst typedArgs) expr\n\n\noptimizePotentialTailCall :: Cycle -> Name.Name -> [Can.Pattern] -> Can.Expr -> Names.Tracker Opt.Def\noptimizePotentialTailCall cycle name args expr =\n  do  (argNames, destructors) <- destructArgs args\n      toTailDef name argNames destructors <$>\n        optimizeTail cycle name argNames expr\n\n\noptimizeTail :: Cycle -> Name.Name -> [Name.Name] -> Can.Expr -> Names.Tracker Opt.Expr\noptimizeTail cycle rootName argNames locExpr@(A.At _ expression) =\n  case expression of\n    Can.Call func args ->\n      do  oargs <- traverse (optimize cycle) args\n\n          let isMatchingName =\n                case A.toValue func of\n                  Can.VarLocal      name -> rootName == name\n                  Can.VarTopLevel _ name -> rootName == name\n                  _                      -> False\n\n          if isMatchingName\n            then\n              case Index.indexedZipWith (\\_ a b -> (a,b)) argNames oargs of\n                Index.LengthMatch pairs ->\n                  pure $ Opt.TailCall rootName pairs\n\n                Index.LengthMismatch _ _ ->\n                  do  ofunc <- optimize cycle func\n                      pure $ Opt.Call ofunc oargs\n            else\n              do  ofunc <- optimize cycle func\n                  pure $ Opt.Call ofunc oargs\n\n    Can.If branches finally ->\n      let\n        optimizeBranch (condition, branch) =\n          (,)\n            <$> optimize cycle condition\n            <*> optimizeTail cycle rootName argNames branch\n      in\n      Opt.If\n        <$> traverse optimizeBranch branches\n        <*> optimizeTail cycle rootName argNames finally\n\n    Can.Let def body ->\n      optimizeDef cycle def =<< optimizeTail cycle rootName argNames body\n\n    Can.LetRec defs body ->\n      case defs of\n        [def] ->\n          Opt.Let\n            <$> optimizePotentialTailCallDef cycle def\n            <*> optimizeTail cycle rootName argNames body\n\n        _ ->\n          do  obody <- optimizeTail cycle rootName argNames body\n              foldM (\\bod def -> optimizeDef cycle def bod) obody defs\n\n    Can.LetDestruct pattern expr body ->\n      do  (dname, destructors) <- destruct pattern\n          oexpr <- optimize cycle expr\n          obody <- optimizeTail cycle rootName argNames body\n          pure $\n            Opt.Let (Opt.Def dname oexpr) (foldr Opt.Destruct obody destructors)\n\n    Can.Case expr branches ->\n      let\n        optimizeBranch root (Can.CaseBranch pattern branch) =\n          do  destructors <- destructCase root pattern\n              obranch <- optimizeTail cycle rootName argNames branch\n              pure (pattern, foldr Opt.Destruct obranch destructors)\n      in\n      do  temp <- Names.generate\n          oexpr <- optimize cycle expr\n          case oexpr of\n            Opt.VarLocal root ->\n              Case.optimize temp root <$> traverse (optimizeBranch root) branches\n\n            _ ->\n              do  obranches <- traverse (optimizeBranch temp) branches\n                  return $ Opt.Let (Opt.Def temp oexpr) (Case.optimize temp temp obranches)\n\n    _ ->\n      optimize cycle locExpr\n\n\n\n-- DETECT TAIL CALLS\n\n\ntoTailDef :: Name.Name -> [Name.Name] -> [Opt.Destructor] -> Opt.Expr -> Opt.Def\ntoTailDef name argNames destructors body =\n  if hasTailCall body then\n    Opt.TailDef name argNames (foldr Opt.Destruct body destructors)\n  else\n    Opt.Def name (Opt.Function argNames (foldr Opt.Destruct body destructors))\n\n\nhasTailCall :: Opt.Expr -> Bool\nhasTailCall expression =\n  case expression of\n    Opt.TailCall _ _ ->\n      True\n\n    Opt.If branches finally ->\n      hasTailCall finally || any (hasTailCall . snd) branches\n\n    Opt.Let _ body ->\n      hasTailCall body\n\n    Opt.Destruct _ body ->\n      hasTailCall body\n\n    Opt.Case _ _ decider jumps ->\n      decidecHasTailCall decider || any (hasTailCall . snd) jumps\n\n    _ ->\n      False\n\n\ndecidecHasTailCall :: Opt.Decider Opt.Choice -> Bool\ndecidecHasTailCall decider =\n  case decider of\n    Opt.Leaf choice ->\n      case choice of\n        Opt.Inline expr ->\n          hasTailCall expr\n\n        Opt.Jump _ ->\n          False\n\n    Opt.Chain _ success failure ->\n      decidecHasTailCall success || decidecHasTailCall failure\n\n    Opt.FanOut _ tests fallback ->\n      decidecHasTailCall fallback || any (decidecHasTailCall . snd) tests\n"
  },
  {
    "path": "compiler/src/Optimize/Module.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Optimize.Module\n  ( optimize\n  )\n  where\n\n\nimport Prelude hiding (cycle)\nimport Control.Monad (foldM)\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\nimport Data.Map ((!))\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified AST.Utils.Type as Type\nimport qualified Canonicalize.Effects as Effects\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Optimize.Expression as Expr\nimport qualified Optimize.Names as Names\nimport qualified Optimize.Port as Port\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Main as E\nimport qualified Reporting.Result as Result\nimport qualified Reporting.Warning as W\n\n\n\n-- OPTIMIZE\n\n\ntype Result i w a =\n  Result.Result i w E.Error a\n\n\ntype Annotations =\n  Map.Map Name.Name Can.Annotation\n\n\noptimize :: Annotations -> Can.Module -> Result i [W.Warning] Opt.LocalGraph\noptimize annotations (Can.Module home _ _ decls unions aliases _ effects) =\n  addDecls home annotations decls $\n    addEffects home effects $\n      addUnions home unions $\n        addAliases home aliases $\n          Opt.LocalGraph Nothing Map.empty Map.empty\n\n\n\n-- UNION\n\n\ntype Nodes =\n  Map.Map Opt.Global Opt.Node\n\n\naddUnions :: ModuleName.Canonical -> Map.Map Name.Name Can.Union -> Opt.LocalGraph -> Opt.LocalGraph\naddUnions home unions (Opt.LocalGraph main nodes fields) =\n  Opt.LocalGraph main (Map.foldr (addUnion home) nodes unions) fields\n\n\naddUnion :: ModuleName.Canonical -> Can.Union -> Nodes -> Nodes\naddUnion home (Can.Union _ ctors _ opts) nodes =\n  List.foldl' (addCtorNode home opts) nodes ctors\n\n\naddCtorNode :: ModuleName.Canonical -> Can.CtorOpts -> Nodes -> Can.Ctor -> Nodes\naddCtorNode home opts nodes (Can.Ctor name index numArgs _) =\n  let\n    node =\n      case opts of\n        Can.Normal -> Opt.Ctor index numArgs\n        Can.Unbox -> Opt.Box\n        Can.Enum -> Opt.Enum index\n  in\n  Map.insert (Opt.Global home name) node nodes\n\n\n\n-- ALIAS\n\n\naddAliases :: ModuleName.Canonical -> Map.Map Name.Name Can.Alias -> Opt.LocalGraph -> Opt.LocalGraph\naddAliases home aliases graph =\n  Map.foldrWithKey (addAlias home) graph aliases\n\n\naddAlias :: ModuleName.Canonical -> Name.Name -> Can.Alias -> Opt.LocalGraph -> Opt.LocalGraph\naddAlias home name (Can.Alias _ tipe) graph@(Opt.LocalGraph main nodes fieldCounts) =\n  case tipe of\n    Can.TRecord fields Nothing ->\n      let\n        function =\n          Opt.Function (map fst (Can.fieldsToList fields)) $ Opt.Record $\n            Map.mapWithKey (\\field _ -> Opt.VarLocal field) fields\n\n        node =\n          Opt.Define function Set.empty\n      in\n      Opt.LocalGraph\n        main\n        (Map.insert (Opt.Global home name) node nodes)\n        (Map.foldrWithKey addRecordCtorField fieldCounts fields)\n\n    _ ->\n      graph\n\n\naddRecordCtorField :: Name.Name -> Can.FieldType -> Map.Map Name.Name Int -> Map.Map Name.Name Int\naddRecordCtorField name _ fields =\n  Map.insertWith (+) name 1 fields\n\n\n\n-- ADD EFFECTS\n\n\naddEffects :: ModuleName.Canonical -> Can.Effects -> Opt.LocalGraph -> Opt.LocalGraph\naddEffects home effects graph@(Opt.LocalGraph main nodes fields) =\n  case effects of\n    Can.NoEffects ->\n      graph\n\n    Can.Ports ports ->\n      Map.foldrWithKey (addPort home) graph ports\n\n    Can.Manager _ _ _ manager ->\n      let\n        fx = Opt.Global home \"$fx$\"\n        cmd = Opt.Global home \"command\"\n        sub = Opt.Global home \"subscription\"\n        link = Opt.Link fx\n        newNodes =\n          case manager of\n            Can.Cmd _ ->\n              Map.insert cmd link $\n              Map.insert fx (Opt.Manager Opt.Cmd) nodes\n\n            Can.Sub _ ->\n              Map.insert sub link $\n              Map.insert fx (Opt.Manager Opt.Sub) nodes\n\n            Can.Fx _ _ ->\n              Map.insert cmd link $\n              Map.insert sub link $\n              Map.insert fx (Opt.Manager Opt.Fx) nodes\n      in\n      Opt.LocalGraph main newNodes fields\n\n\naddPort :: ModuleName.Canonical -> Name.Name -> Can.Port -> Opt.LocalGraph -> Opt.LocalGraph\naddPort home name port_ graph =\n  case port_ of\n    Can.Incoming _ payloadType _ ->\n      let\n        (deps, fields, decoder) = Names.run (Port.toDecoder payloadType)\n        node = Opt.PortIncoming decoder deps\n      in\n      addToGraph (Opt.Global home name) node fields graph\n\n    Can.Outgoing _ payloadType _ ->\n      let\n        (deps, fields, encoder) = Names.run (Port.toEncoder payloadType)\n        node = Opt.PortOutgoing encoder deps\n      in\n      addToGraph (Opt.Global home name) node fields graph\n\n\n\n-- HELPER\n\n\naddToGraph :: Opt.Global -> Opt.Node -> Map.Map Name.Name Int -> Opt.LocalGraph -> Opt.LocalGraph\naddToGraph name node fields (Opt.LocalGraph main nodes fieldCounts) =\n  Opt.LocalGraph\n    main\n    (Map.insert name node nodes)\n    (Map.unionWith (+) fields fieldCounts)\n\n\n\n-- ADD DECLS\n\n\naddDecls :: ModuleName.Canonical -> Annotations -> Can.Decls -> Opt.LocalGraph -> Result i [W.Warning] Opt.LocalGraph\naddDecls home annotations decls graph =\n  case decls of\n    Can.Declare def subDecls ->\n      addDecls home annotations subDecls =<< addDef home annotations def graph\n\n    Can.DeclareRec d ds subDecls ->\n      let defs = d:ds in\n      case findMain defs of\n        Nothing ->\n          addDecls home annotations subDecls (addRecDefs home defs graph)\n\n        Just region ->\n          Result.throw $ E.BadCycle region (defToName d) (map defToName ds)\n\n    Can.SaveTheEnvironment ->\n      Result.ok graph\n\n\nfindMain :: [Can.Def] -> Maybe A.Region\nfindMain defs =\n  case defs of\n    [] ->\n      Nothing\n\n    def:rest ->\n      case def of\n        Can.Def (A.At region name) _ _ ->\n          if name == Name._main then Just region else findMain rest\n\n        Can.TypedDef (A.At region name) _ _ _ _ ->\n          if name == Name._main then Just region else findMain rest\n\n\ndefToName :: Can.Def -> Name.Name\ndefToName def =\n  case def of\n    Can.Def (A.At _ name) _ _          -> name\n    Can.TypedDef (A.At _ name) _ _ _ _ -> name\n\n\n\n-- ADD DEFS\n\n\naddDef :: ModuleName.Canonical -> Annotations -> Can.Def -> Opt.LocalGraph -> Result i [W.Warning] Opt.LocalGraph\naddDef home annotations def graph =\n  case def of\n    Can.Def (A.At region name) args body ->\n      do  let (Can.Forall _ tipe) = annotations ! name\n          Result.warn $ W.MissingTypeAnnotation region name tipe\n          addDefHelp region annotations home name args body graph\n\n    Can.TypedDef (A.At region name) _ typedArgs body _ ->\n      addDefHelp region annotations home name (map fst typedArgs) body graph\n\n\naddDefHelp :: A.Region -> Annotations -> ModuleName.Canonical -> Name.Name -> [Can.Pattern] -> Can.Expr -> Opt.LocalGraph -> Result i w Opt.LocalGraph\naddDefHelp region annotations home name args body graph@(Opt.LocalGraph _ nodes fieldCounts) =\n  if name /= Name._main then\n    Result.ok (addDefNode home name args body Set.empty graph)\n  else\n    let\n      (Can.Forall _ tipe) = annotations ! name\n\n      addMain (deps, fields, main) =\n        addDefNode home name args body deps $\n          Opt.LocalGraph (Just main) nodes (Map.unionWith (+) fields fieldCounts)\n    in\n    case Type.deepDealias tipe of\n      Can.TType hm nm [_] | hm == ModuleName.virtualDom && nm == Name.node ->\n          Result.ok $ addMain $ Names.run $\n            Names.registerKernel Name.virtualDom Opt.Static\n\n      Can.TType hm nm [flags, _, message] | hm == ModuleName.platform && nm == Name.program ->\n          case Effects.checkPayload flags of\n            Right () ->\n              Result.ok $ addMain $ Names.run $\n                Opt.Dynamic message <$> Port.toFlagsDecoder flags\n\n            Left (subType, invalidPayload) ->\n              Result.throw (E.BadFlags region subType invalidPayload)\n\n      _ ->\n          Result.throw (E.BadType region tipe)\n\n\naddDefNode :: ModuleName.Canonical -> Name.Name -> [Can.Pattern] -> Can.Expr -> Set.Set Opt.Global -> Opt.LocalGraph -> Opt.LocalGraph\naddDefNode home name args body mainDeps graph =\n  let\n    (deps, fields, def) =\n      Names.run $\n        case args of\n          [] ->\n            Expr.optimize Set.empty body\n\n          _ ->\n            do  (argNames, destructors) <- Expr.destructArgs args\n                obody <- Expr.optimize Set.empty body\n                pure $ Opt.Function argNames $\n                  foldr Opt.Destruct obody destructors\n  in\n  addToGraph (Opt.Global home name) (Opt.Define def (Set.union deps mainDeps)) fields graph\n\n\n\n-- ADD RECURSIVE DEFS\n\n\ndata State =\n  State\n    { _values :: [(Name.Name, Opt.Expr)]\n    , _functions :: [Opt.Def]\n    }\n\n\naddRecDefs :: ModuleName.Canonical -> [Can.Def] -> Opt.LocalGraph -> Opt.LocalGraph\naddRecDefs home defs (Opt.LocalGraph main nodes fieldCounts) =\n  let\n    names = reverse (map toName defs)\n    cycleName = Opt.Global home (Name.fromManyNames names)\n    cycle = foldr addValueName Set.empty defs\n    links = foldr (addLink home (Opt.Link cycleName)) Map.empty defs\n\n    (deps, fields, State values funcs) =\n      Names.run $\n        foldM (addRecDef cycle) (State [] []) defs\n  in\n  Opt.LocalGraph\n    main\n    (Map.insert cycleName (Opt.Cycle names values funcs deps) (Map.union links nodes))\n    (Map.unionWith (+) fields fieldCounts)\n\n\ntoName :: Can.Def -> Name.Name\ntoName def =\n  case def of\n    Can.Def      (A.At _ name) _ _     -> name\n    Can.TypedDef (A.At _ name) _ _ _ _ -> name\n\n\naddValueName :: Can.Def -> Set.Set Name.Name -> Set.Set Name.Name\naddValueName def names =\n  case def of\n    Can.Def      (A.At _ name)   args _   -> if null args then Set.insert name names else names\n    Can.TypedDef (A.At _ name) _ args _ _ -> if null args then Set.insert name names else names\n\n\naddLink :: ModuleName.Canonical -> Opt.Node -> Can.Def -> Map.Map Opt.Global Opt.Node -> Map.Map Opt.Global Opt.Node\naddLink home link def links =\n  case def of\n    Can.Def (A.At _ name) _ _ ->\n      Map.insert (Opt.Global home name) link links\n\n    Can.TypedDef (A.At _ name) _ _ _ _ ->\n      Map.insert (Opt.Global home name) link links\n\n\n\n-- ADD RECURSIVE DEFS\n\n\naddRecDef :: Set.Set Name.Name -> State -> Can.Def -> Names.Tracker State\naddRecDef cycle state def =\n  case def of\n    Can.Def (A.At _ name) args body ->\n      addRecDefHelp cycle state name args body\n\n    Can.TypedDef (A.At _ name) _ args body _ ->\n      addRecDefHelp cycle state name (map fst args) body\n\n\naddRecDefHelp :: Set.Set Name.Name -> State -> Name.Name -> [Can.Pattern] -> Can.Expr -> Names.Tracker State\naddRecDefHelp cycle (State values funcs) name args body =\n  case args of\n    [] ->\n      do  obody <- Expr.optimize cycle body\n          pure $ State ((name, obody) : values) funcs\n\n    _:_ ->\n      do  odef <- Expr.optimizePotentialTailCall cycle name args body\n          pure $ State values (odef : funcs)\n"
  },
  {
    "path": "compiler/src/Optimize/Names.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE Rank2Types #-}\nmodule Optimize.Names\n  ( Tracker\n  , run\n  , generate\n  , registerKernel\n  , registerGlobal\n  , registerDebug\n  , registerCtor\n  , registerField\n  , registerFieldDict\n  , registerFieldList\n  )\n  where\n\n\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Annotation as A\n\n\n\n-- GENERATOR\n\n\nnewtype Tracker a =\n  Tracker (\n    forall r.\n      Int\n      -> Set.Set Opt.Global\n      -> Map.Map Name.Name Int\n      -> (Int -> Set.Set Opt.Global -> Map.Map Name.Name Int -> a -> r)\n      -> r\n  )\n\n\nrun :: Tracker a -> (Set.Set Opt.Global, Map.Map Name.Name Int, a)\nrun (Tracker k) =\n  k 0 Set.empty Map.empty\n    (\\_uid deps fields value -> (deps, fields, value))\n\n\ngenerate :: Tracker Name.Name\ngenerate =\n  Tracker $ \\uid deps fields ok ->\n    ok (uid + 1) deps fields (Name.fromVarIndex uid)\n\n\nregisterKernel :: Name.Name -> a -> Tracker a\nregisterKernel home value =\n  Tracker $ \\uid deps fields ok ->\n    ok uid (Set.insert (Opt.toKernelGlobal home) deps) fields value\n\n\nregisterGlobal :: ModuleName.Canonical -> Name.Name -> Tracker Opt.Expr\nregisterGlobal home name =\n  Tracker $ \\uid deps fields ok ->\n    let global = Opt.Global home name in\n    ok uid (Set.insert global deps) fields (Opt.VarGlobal global)\n\n\nregisterDebug :: Name.Name -> ModuleName.Canonical -> A.Region -> Tracker Opt.Expr\nregisterDebug name home region =\n  Tracker $ \\uid deps fields ok ->\n    let global = Opt.Global ModuleName.debug name in\n    ok uid (Set.insert global deps) fields (Opt.VarDebug name home region Nothing)\n\n\nregisterCtor :: ModuleName.Canonical -> Name.Name -> Index.ZeroBased -> Can.CtorOpts -> Tracker Opt.Expr\nregisterCtor home name index opts =\n  Tracker $ \\uid deps fields ok ->\n    let\n      global = Opt.Global home name\n      newDeps = Set.insert global deps\n    in\n    case opts of\n      Can.Normal ->\n        ok uid newDeps fields (Opt.VarGlobal global)\n\n      Can.Enum ->\n        ok uid newDeps fields $\n          case name of\n            \"True\"  | home == ModuleName.basics -> Opt.Bool True\n            \"False\" | home == ModuleName.basics -> Opt.Bool False\n            _ -> Opt.VarEnum global index\n\n      Can.Unbox ->\n        ok uid (Set.insert identity newDeps) fields (Opt.VarBox global)\n\n\nidentity :: Opt.Global\nidentity =\n  Opt.Global ModuleName.basics Name.identity\n\n\nregisterField :: Name.Name -> a -> Tracker a\nregisterField name value =\n  Tracker $ \\uid d fields ok ->\n    ok uid d (Map.insertWith (+) name 1 fields) value\n\n\nregisterFieldDict :: Map.Map Name.Name v -> a -> Tracker a\nregisterFieldDict newFields value =\n  Tracker $ \\uid d fields ok ->\n    ok uid d (Map.unionWith (+) fields (Map.map toOne newFields)) value\n\n\ntoOne :: a -> Int\ntoOne _ = 1\n\n\nregisterFieldList :: [Name.Name] -> a -> Tracker a\nregisterFieldList names value =\n  Tracker $ \\uid deps fields ok ->\n    ok uid deps (foldr addOne fields names) value\n\n\naddOne :: Name.Name -> Map.Map Name.Name Int -> Map.Map Name.Name Int\naddOne name fields =\n  Map.insertWith (+) name 1 fields\n\n\n\n-- INSTANCES\n\n\ninstance Functor Tracker where\n  fmap func (Tracker kv) =\n    Tracker $ \\n d f ok ->\n      let\n        ok1 n1 d1 f1 value =\n          ok n1 d1 f1 (func value)\n      in\n      kv n d f ok1\n\n\ninstance Applicative Tracker where\n  {-# INLINE pure #-}\n  pure value =\n    Tracker $ \\n d f ok -> ok n d f value\n\n  (<*>) (Tracker kf) (Tracker kv) =\n    Tracker $ \\n d f ok ->\n      let\n        ok1 n1 d1 f1 func =\n          let\n            ok2 n2 d2 f2 value =\n              ok n2 d2 f2 (func value)\n          in\n          kv n1 d1 f1 ok2\n      in\n      kf n d f ok1\n\n\ninstance Monad Tracker where\n  return = pure\n\n  (>>=) (Tracker k) callback =\n    Tracker $ \\n d f ok ->\n      let\n        ok1 n1 d1 f1 a =\n          case callback a of\n            Tracker kb -> kb n1 d1 f1 ok\n      in\n      k n d f ok1\n"
  },
  {
    "path": "compiler/src/Optimize/Port.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Optimize.Port\n  ( toEncoder\n  , toFlagsDecoder\n  , toDecoder\n  )\n  where\n\n\nimport Prelude hiding (maybe, null)\nimport Control.Monad (foldM)\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified AST.Utils.Type as Type\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Optimize.Names as Names\n\n\n\n-- ENCODE\n\n\ntoEncoder :: Can.Type -> Names.Tracker Opt.Expr\ntoEncoder tipe =\n  case tipe of\n    Can.TAlias _ _ args alias ->\n      toEncoder (Type.dealias args alias)\n\n    Can.TLambda _ _ ->\n      error \"toEncoder: function\"\n\n    Can.TVar _ ->\n      error \"toEncoder: type variable\"\n\n    Can.TUnit ->\n      Opt.Function [Name.dollar] <$> encode \"null\"\n\n    Can.TTuple a b c ->\n      encodeTuple a b c\n\n    Can.TType _ name args ->\n      case args of\n        []\n          | name == Name.float  -> encode \"float\"\n          | name == Name.int    -> encode \"int\"\n          | name == Name.bool   -> encode \"bool\"\n          | name == Name.string -> encode \"string\"\n          | name == Name.value  -> Names.registerGlobal ModuleName.basics Name.identity\n\n        [arg]\n          | name == Name.maybe -> encodeMaybe arg\n          | name == Name.list  -> encodeList arg\n          | name == Name.array -> encodeArray arg\n\n        _ ->\n          error \"toEncoder: bad custom type\"\n\n    Can.TRecord _ (Just _) ->\n      error \"toEncoder: bad record\"\n\n    Can.TRecord fields Nothing ->\n      let\n        encodeField (name, Can.FieldType _ fieldType) =\n          do  encoder <- toEncoder fieldType\n              let value = Opt.Call encoder [Opt.Access (Opt.VarLocal Name.dollar) name]\n              return $ Opt.Tuple (Opt.Str (Name.toElmString name)) value Nothing\n      in\n      do  object <- encode \"object\"\n          keyValuePairs <- traverse encodeField (Map.toList fields)\n          Names.registerFieldDict fields $\n            Opt.Function [Name.dollar] (Opt.Call object [Opt.List keyValuePairs])\n\n\n\n-- ENCODE HELPERS\n\n\nencodeMaybe :: Can.Type -> Names.Tracker Opt.Expr\nencodeMaybe tipe =\n  do  null <- encode \"null\"\n      encoder <- toEncoder tipe\n      destruct <- Names.registerGlobal ModuleName.maybe \"destruct\"\n      return $ Opt.Function [Name.dollar] $\n        Opt.Call destruct [ null, encoder, Opt.VarLocal Name.dollar ]\n\n\nencodeList :: Can.Type -> Names.Tracker Opt.Expr\nencodeList tipe =\n  do  list <- encode \"list\"\n      encoder <- toEncoder tipe\n      return $ Opt.Call list [ encoder ]\n\n\nencodeArray :: Can.Type -> Names.Tracker Opt.Expr\nencodeArray tipe =\n  do  array <- encode \"array\"\n      encoder <- toEncoder tipe\n      return $ Opt.Call array [ encoder ]\n\n\nencodeTuple :: Can.Type -> Can.Type -> Maybe Can.Type -> Names.Tracker Opt.Expr\nencodeTuple a b maybeC =\n  let\n    let_ arg index body =\n      Opt.Destruct (Opt.Destructor arg (Opt.Index index (Opt.Root Name.dollar))) body\n\n    encodeArg arg tipe =\n      do  encoder <- toEncoder tipe\n          return $ Opt.Call encoder [ Opt.VarLocal arg ]\n  in\n  do  list <- encode \"list\"\n      identity <- Names.registerGlobal ModuleName.basics Name.identity\n      arg1 <- encodeArg \"a\" a\n      arg2 <- encodeArg \"b\" b\n\n      case maybeC of\n        Nothing ->\n          return $ Opt.Function [Name.dollar] $\n            let_ \"a\" Index.first $\n            let_ \"b\" Index.second $\n              Opt.Call list [ identity, Opt.List [ arg1, arg2 ] ]\n\n        Just c ->\n          do  arg3 <- encodeArg \"c\" c\n              return $ Opt.Function [Name.dollar] $\n                let_ \"a\" Index.first $\n                let_ \"b\" Index.second $\n                let_ \"c\" Index.third $\n                  Opt.Call list [ identity, Opt.List [ arg1, arg2, arg3 ] ]\n\n\n\n-- FLAGS DECODER\n\n\ntoFlagsDecoder :: Can.Type -> Names.Tracker Opt.Expr\ntoFlagsDecoder tipe =\n  case tipe of\n    Can.TUnit ->\n      do  succeed <- decode \"succeed\"\n          return $ Opt.Call succeed [ Opt.Unit ]\n\n    _ ->\n      toDecoder tipe\n\n\n\n-- DECODE\n\n\ntoDecoder :: Can.Type -> Names.Tracker Opt.Expr\ntoDecoder tipe =\n  case tipe of\n    Can.TLambda _ _ ->\n      error \"functions should not be allowed through input ports\"\n\n    Can.TVar _ ->\n      error \"type variables should not be allowed through input ports\"\n\n    Can.TAlias _ _ args alias ->\n      toDecoder (Type.dealias args alias)\n\n    Can.TUnit ->\n      decodeTuple0\n\n    Can.TTuple a b c ->\n      decodeTuple a b c\n\n    Can.TType _ name args ->\n      case args of\n        []\n          | name == Name.float  -> decode \"float\"\n          | name == Name.int    -> decode \"int\"\n          | name == Name.bool   -> decode \"bool\"\n          | name == Name.string -> decode \"string\"\n          | name == Name.value  -> decode \"value\"\n\n        [arg]\n          | name == Name.maybe -> decodeMaybe arg\n          | name == Name.list  -> decodeList arg\n          | name == Name.array -> decodeArray arg\n\n        _ ->\n          error \"toDecoder: bad type\"\n\n    Can.TRecord _ (Just _) ->\n      error \"toDecoder: bad record\"\n\n    Can.TRecord fields Nothing ->\n      decodeRecord fields\n\n\n\n-- DECODE MAYBE\n\n\ndecodeMaybe :: Can.Type -> Names.Tracker Opt.Expr\ndecodeMaybe tipe =\n  do  nothing <- Names.registerGlobal ModuleName.maybe \"Nothing\"\n      just    <- Names.registerGlobal ModuleName.maybe \"Just\"\n\n      oneOf <- decode \"oneOf\"\n      null  <- decode \"null\"\n      map_  <- decode \"map\"\n\n      subDecoder <- toDecoder tipe\n\n      return $\n        Opt.Call oneOf\n          [ Opt.List\n              [ Opt.Call null [ nothing ]\n              , Opt.Call map_ [ just, subDecoder ]\n              ]\n          ]\n\n\n-- DECODE LIST\n\n\ndecodeList :: Can.Type -> Names.Tracker Opt.Expr\ndecodeList tipe =\n  do  list <- decode \"list\"\n      decoder <- toDecoder tipe\n      return $ Opt.Call list [ decoder ]\n\n\n\n-- DECODE ARRAY\n\n\ndecodeArray :: Can.Type -> Names.Tracker Opt.Expr\ndecodeArray tipe =\n  do  array <- decode \"array\"\n      decoder <- toDecoder tipe\n      return $ Opt.Call array [ decoder ]\n\n\n\n-- DECODE TUPLES\n\n\ndecodeTuple0 :: Names.Tracker Opt.Expr\ndecodeTuple0 =\n  do  null <- decode \"null\"\n      return (Opt.Call null [ Opt.Unit ])\n\n\ndecodeTuple :: Can.Type -> Can.Type -> Maybe Can.Type -> Names.Tracker Opt.Expr\ndecodeTuple a b maybeC =\n  do  succeed <- decode \"succeed\"\n      case maybeC of\n        Nothing ->\n          let tuple = Opt.Tuple (toLocal 0) (toLocal 1) Nothing in\n          indexAndThen 0 a =<<\n            indexAndThen 1 b (Opt.Call succeed [tuple])\n\n        Just c ->\n          let tuple = Opt.Tuple (toLocal 0) (toLocal 1) (Just (toLocal 2)) in\n          indexAndThen 0 a =<<\n            indexAndThen 1 b =<<\n              indexAndThen 2 c (Opt.Call succeed [tuple])\n\n\ntoLocal :: Int -> Opt.Expr\ntoLocal index =\n  Opt.VarLocal (Name.fromVarIndex index)\n\n\nindexAndThen :: Int -> Can.Type -> Opt.Expr -> Names.Tracker Opt.Expr\nindexAndThen i tipe decoder =\n  do  andThen <- decode \"andThen\"\n      index <- decode \"index\"\n      typeDecoder <- toDecoder tipe\n      return $\n        Opt.Call andThen\n          [ Opt.Function [Name.fromVarIndex i] decoder\n          , Opt.Call index [ Opt.Int i, typeDecoder ]\n          ]\n\n\n\n-- DECODE RECORDS\n\n\ndecodeRecord :: Map.Map Name.Name Can.FieldType -> Names.Tracker Opt.Expr\ndecodeRecord fields =\n  let\n    toFieldExpr name _ =\n      Opt.VarLocal name\n\n    record =\n      Opt.Record (Map.mapWithKey toFieldExpr fields)\n  in\n    do  succeed <- decode \"succeed\"\n        foldM fieldAndThen (Opt.Call succeed [record]) =<<\n          Names.registerFieldDict fields (Map.toList fields)\n\n\nfieldAndThen :: Opt.Expr -> (Name.Name, Can.FieldType) -> Names.Tracker Opt.Expr\nfieldAndThen decoder (key, Can.FieldType _ tipe) =\n  do  andThen <- decode \"andThen\"\n      field <- decode \"field\"\n      typeDecoder <- toDecoder tipe\n      return $\n        Opt.Call andThen\n          [ Opt.Function [key] decoder\n          , Opt.Call field [ Opt.Str (Name.toElmString key), typeDecoder ]\n          ]\n\n\n\n-- GLOBALS HELPERS\n\n\nencode :: Name.Name -> Names.Tracker Opt.Expr\nencode name =\n  Names.registerGlobal ModuleName.jsonEncode name\n\n\ndecode :: Name.Name -> Names.Tracker Opt.Expr\ndecode name =\n  Names.registerGlobal ModuleName.jsonDecode name\n"
  },
  {
    "path": "compiler/src/Parse/Declaration.hs",
    "content": "{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Parse.Declaration\n  ( Decl(..)\n  , declaration\n  , infix_\n  )\n  where\n\n\nimport qualified Data.Name as Name\n\nimport qualified AST.Source as Src\nimport qualified AST.Utils.Binop as Binop\nimport qualified Parse.Expression as Expr\nimport qualified Parse.Pattern as Pattern\nimport qualified Parse.Keyword as Keyword\nimport qualified Parse.Number as Number\nimport qualified Parse.Space as Space\nimport qualified Parse.Symbol as Symbol\nimport qualified Parse.Type as Type\nimport qualified Parse.Variable as Var\nimport Parse.Primitives hiding (State)\nimport qualified Parse.Primitives as P\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Syntax as E\n\n\n\n-- DECLARATION\n\n\ndata Decl\n  = Value (Maybe Src.Comment) (A.Located Src.Value)\n  | Union (Maybe Src.Comment) (A.Located Src.Union)\n  | Alias (Maybe Src.Comment) (A.Located Src.Alias)\n  | Port (Maybe Src.Comment) Src.Port\n\n\ndeclaration :: Space.Parser E.Decl Decl\ndeclaration =\n  do  maybeDocs <- chompDocComment\n      start <- getPosition\n      oneOf E.DeclStart\n        [ typeDecl maybeDocs start\n        , portDecl maybeDocs\n        , valueDecl maybeDocs start\n        ]\n\n\n\n-- DOC COMMENT\n\n\nchompDocComment :: Parser E.Decl (Maybe Src.Comment)\nchompDocComment =\n  oneOfWithFallback\n    [\n      do  docComment <- Space.docComment E.DeclStart E.DeclSpace\n          Space.chomp E.DeclSpace\n          Space.checkFreshLine E.DeclFreshLineAfterDocComment\n          return (Just docComment)\n    ]\n    Nothing\n\n\n\n-- DEFINITION and ANNOTATION\n\n\n{-# INLINE valueDecl #-}\nvalueDecl :: Maybe Src.Comment -> A.Position -> Space.Parser E.Decl Decl\nvalueDecl maybeDocs start =\n  do  name <- Var.lower E.DeclStart\n      end <- getPosition\n      specialize (E.DeclDef name) $\n        do  Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentEquals\n            oneOf E.DeclDefEquals\n              [\n                do  word1 0x3A {-:-} E.DeclDefEquals\n                    Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentType\n                    (tipe, _) <- specialize E.DeclDefType Type.expression\n                    Space.checkFreshLine E.DeclDefNameRepeat\n                    defName <- chompMatchingName name\n                    Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentEquals\n                    chompDefArgsAndBody maybeDocs start defName (Just tipe) []\n              ,\n                chompDefArgsAndBody maybeDocs start (A.at start end name) Nothing []\n              ]\n\n\nchompDefArgsAndBody :: Maybe Src.Comment -> A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> Space.Parser E.DeclDef Decl\nchompDefArgsAndBody maybeDocs start name tipe revArgs =\n  oneOf E.DeclDefEquals\n    [ do  arg <- specialize E.DeclDefArg Pattern.term\n          Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentEquals\n          chompDefArgsAndBody maybeDocs start name tipe (arg : revArgs)\n    , do  word1 0x3D {-=-} E.DeclDefEquals\n          Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentBody\n          (body, end) <- specialize E.DeclDefBody Expr.expression\n          let value = Src.Value name (reverse revArgs) body tipe\n          let avalue = A.at start end value\n          return (Value maybeDocs avalue, end)\n    ]\n\n\nchompMatchingName :: Name.Name -> Parser E.DeclDef (A.Located Name.Name)\nchompMatchingName expectedName =\n  let\n    (P.Parser parserL) = Var.lower E.DeclDefNameRepeat\n  in\n  P.Parser $ \\state@(P.State _ _ _ _ sr sc) cok eok cerr eerr ->\n    let\n      cokL name newState@(P.State _ _ _ _ er ec) =\n        if expectedName == name\n        then cok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState\n        else cerr sr sc (E.DeclDefNameMatch name)\n\n      eokL name newState@(P.State _ _ _ _ er ec) =\n        if expectedName == name\n        then eok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState\n        else eerr sr sc (E.DeclDefNameMatch name)\n    in\n    parserL state cokL eokL cerr eerr\n\n\n\n-- TYPE DECLARATIONS\n\n\n{-# INLINE typeDecl #-}\ntypeDecl :: Maybe Src.Comment -> A.Position -> Space.Parser E.Decl Decl\ntypeDecl maybeDocs start =\n  inContext E.DeclType (Keyword.type_ E.DeclStart) $\n    do  Space.chompAndCheckIndent E.DT_Space E.DT_IndentName\n        oneOf E.DT_Name\n          [\n            inContext E.DT_Alias (Keyword.alias_ E.DT_Name) $\n              do  Space.chompAndCheckIndent E.AliasSpace E.AliasIndentEquals\n                  (name, args) <- chompAliasNameToEquals\n                  (tipe, end) <- specialize E.AliasBody Type.expression\n                  let alias = A.at start end (Src.Alias name args tipe)\n                  return (Alias maybeDocs alias, end)\n          ,\n            specialize E.DT_Union $\n              do  (name, args) <- chompCustomNameToEquals\n                  (firstVariant, firstEnd) <- Type.variant\n                  (variants, end) <- chompVariants [firstVariant] firstEnd\n                  let union = A.at start end (Src.Union name args variants)\n                  return (Union maybeDocs union, end)\n          ]\n\n\n\n-- TYPE ALIASES\n\n\nchompAliasNameToEquals :: Parser E.TypeAlias (A.Located Name.Name, [A.Located Name.Name])\nchompAliasNameToEquals =\n  do  name <- addLocation (Var.upper E.AliasName)\n      Space.chompAndCheckIndent E.AliasSpace E.AliasIndentEquals\n      chompAliasNameToEqualsHelp name []\n\n\nchompAliasNameToEqualsHelp :: A.Located Name.Name -> [A.Located Name.Name] -> Parser E.TypeAlias (A.Located Name.Name, [A.Located Name.Name])\nchompAliasNameToEqualsHelp name args =\n  oneOf E.AliasEquals\n    [ do  arg <- addLocation (Var.lower E.AliasEquals)\n          Space.chompAndCheckIndent E.AliasSpace E.AliasIndentEquals\n          chompAliasNameToEqualsHelp name (arg:args)\n    , do  word1 0x3D {-=-} E.AliasEquals\n          Space.chompAndCheckIndent E.AliasSpace E.AliasIndentBody\n          return ( name, reverse args )\n    ]\n\n\n\n-- CUSTOM TYPES\n\n\nchompCustomNameToEquals :: Parser E.CustomType (A.Located Name.Name, [A.Located Name.Name])\nchompCustomNameToEquals =\n  do  name <- addLocation (Var.upper E.CT_Name)\n      Space.chompAndCheckIndent E.CT_Space E.CT_IndentEquals\n      chompCustomNameToEqualsHelp name []\n\n\nchompCustomNameToEqualsHelp :: A.Located Name.Name -> [A.Located Name.Name] -> Parser E.CustomType (A.Located Name.Name, [A.Located Name.Name])\nchompCustomNameToEqualsHelp name args =\n  oneOf E.CT_Equals\n    [ do  arg <- addLocation (Var.lower E.CT_Equals)\n          Space.chompAndCheckIndent E.CT_Space E.CT_IndentEquals\n          chompCustomNameToEqualsHelp name (arg:args)\n    , do  word1 0x3D {-=-} E.CT_Equals\n          Space.chompAndCheckIndent E.CT_Space E.CT_IndentAfterEquals\n          return ( name, reverse args )\n    ]\n\n\nchompVariants :: [(A.Located Name.Name, [Src.Type])] -> A.Position -> Space.Parser E.CustomType [(A.Located Name.Name, [Src.Type])]\nchompVariants variants end =\n  oneOfWithFallback\n    [ do  Space.checkIndent end E.CT_IndentBar\n          word1 0x7C {-|-} E.CT_Bar\n          Space.chompAndCheckIndent E.CT_Space E.CT_IndentAfterBar\n          (variant, newEnd) <- Type.variant\n          chompVariants (variant:variants) newEnd\n    ]\n    (reverse variants, end)\n\n\n\n-- PORT\n\n\n{-# INLINE portDecl #-}\nportDecl :: Maybe Src.Comment -> Space.Parser E.Decl Decl\nportDecl maybeDocs =\n  inContext E.Port (Keyword.port_ E.DeclStart) $\n    do  Space.chompAndCheckIndent E.PortSpace E.PortIndentName\n        name <- addLocation (Var.lower E.PortName)\n        Space.chompAndCheckIndent E.PortSpace E.PortIndentColon\n        word1 0x3A {-:-} E.PortColon\n        Space.chompAndCheckIndent E.PortSpace E.PortIndentType\n        (tipe, end) <- specialize E.PortType Type.expression\n        return\n          ( Port maybeDocs (Src.Port name tipe)\n          , end\n          )\n\n\n\n-- INFIX\n\n\n-- INVARIANT: always chomps to a freshline\n--\ninfix_ :: Parser E.Module (A.Located Src.Infix)\ninfix_ =\n  let\n    err = E.Infix\n    _err = \\_ -> E.Infix\n  in\n  do  start <- getPosition\n      Keyword.infix_ err\n      Space.chompAndCheckIndent _err err\n      associativity <-\n        oneOf err\n          [ Keyword.left_  err >> return Binop.Left\n          , Keyword.right_ err >> return Binop.Right\n          , Keyword.non_   err >> return Binop.Non\n          ]\n      Space.chompAndCheckIndent _err err\n      precedence <- Number.precedence err\n      Space.chompAndCheckIndent _err err\n      word1 0x28 {-(-} err\n      op <- Symbol.operator err _err\n      word1 0x29 {-)-} err\n      Space.chompAndCheckIndent _err err\n      word1 0x3D {-=-} err\n      Space.chompAndCheckIndent _err err\n      name <- Var.lower err\n      end <- getPosition\n      Space.chomp _err\n      Space.checkFreshLine err\n      return (A.at start end (Src.Infix op associativity precedence name))\n"
  },
  {
    "path": "compiler/src/Parse/Expression.hs",
    "content": "{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Parse.Expression\n  ( expression\n  )\n  where\n\n\nimport qualified Data.Name as Name\n\nimport qualified AST.Source as Src\nimport qualified Parse.Keyword as Keyword\nimport qualified Parse.Number as Number\nimport qualified Parse.Pattern as Pattern\nimport qualified Parse.Shader as Shader\nimport qualified Parse.Space as Space\nimport qualified Parse.Symbol as Symbol\nimport qualified Parse.Type as Type\nimport qualified Parse.String as String\nimport qualified Parse.Variable as Var\nimport Parse.Primitives hiding (State)\nimport qualified Parse.Primitives as P\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Syntax as E\n\n\n\n-- TERMS\n\n\nterm :: Parser E.Expr Src.Expr\nterm =\n  do  start <- getPosition\n      oneOf E.Start\n        [ variable start >>= accessible start\n        , string start\n        , number start\n        , Shader.shader start\n        , list start\n        , record start >>= accessible start\n        , tuple start >>= accessible start\n        , accessor start\n        , character start\n        ]\n\n\nstring :: A.Position -> Parser E.Expr Src.Expr\nstring start =\n  do  str <- String.string E.Start E.String\n      addEnd start (Src.Str str)\n\n\ncharacter :: A.Position -> Parser E.Expr Src.Expr\ncharacter start =\n  do  chr <- String.character E.Start E.Char\n      addEnd start (Src.Chr chr)\n\n\nnumber :: A.Position -> Parser E.Expr Src.Expr\nnumber start =\n  do  nmbr <- Number.number E.Start E.Number\n      addEnd start $\n        case nmbr of\n          Number.Int int -> Src.Int int\n          Number.Float float -> Src.Float float\n\n\naccessor :: A.Position -> Parser E.Expr Src.Expr\naccessor start =\n  do  word1 0x2E {-.-} E.Dot\n      field <- Var.lower E.Access\n      addEnd start (Src.Accessor field)\n\n\nvariable :: A.Position -> Parser E.Expr Src.Expr\nvariable start =\n  do  var <- Var.foreignAlpha E.Start\n      addEnd start var\n\n\naccessible :: A.Position -> Src.Expr -> Parser E.Expr Src.Expr\naccessible start expr =\n  oneOfWithFallback\n    [ do  word1 0x2E {-.-} E.Dot\n          pos <- getPosition\n          field <- Var.lower E.Access\n          end <- getPosition\n          accessible start $\n            A.at start end (Src.Access expr (A.at pos end field))\n    ]\n    expr\n\n\n\n-- LISTS\n\n\nlist :: A.Position -> Parser E.Expr Src.Expr\nlist start =\n  inContext E.List (word1 0x5B {-[-} E.Start) $\n    do  Space.chompAndCheckIndent E.ListSpace E.ListIndentOpen\n        oneOf E.ListOpen\n          [ do  (entry, end) <- specialize E.ListExpr expression\n                Space.checkIndent end E.ListIndentEnd\n                chompListEnd start [entry]\n          , do  word1 0x5D {-]-} E.ListOpen\n                addEnd start (Src.List [])\n          ]\n\n\nchompListEnd :: A.Position -> [Src.Expr] -> Parser E.List Src.Expr\nchompListEnd start entries =\n  oneOf E.ListEnd\n    [ do  word1 0x2C {-,-} E.ListEnd\n          Space.chompAndCheckIndent E.ListSpace E.ListIndentExpr\n          (entry, end) <- specialize E.ListExpr expression\n          Space.checkIndent end E.ListIndentEnd\n          chompListEnd start (entry:entries)\n    , do  word1 0x5D {-]-} E.ListEnd\n          addEnd start (Src.List (reverse entries))\n    ]\n\n\n\n-- TUPLES\n\n\ntuple :: A.Position -> Parser E.Expr Src.Expr\ntuple start@(A.Position row col) =\n  inContext E.Tuple (word1 0x28 {-(-} E.Start) $\n    do  before <- getPosition\n        Space.chompAndCheckIndent E.TupleSpace E.TupleIndentExpr1\n        after <- getPosition\n        if before /= after\n          then\n            do  (entry, end) <- specialize E.TupleExpr expression\n                Space.checkIndent end E.TupleIndentEnd\n                chompTupleEnd start entry []\n          else\n            oneOf E.TupleIndentExpr1\n              [\n                do  op <- Symbol.operator E.TupleIndentExpr1 E.TupleOperatorReserved\n                    if op == \"-\"\n                      then\n                        oneOf E.TupleOperatorClose\n                          [\n                            do  word1 0x29 {-)-} E.TupleOperatorClose\n                                addEnd start (Src.Op op)\n                          ,\n                            do  (entry, end) <-\n                                  specialize E.TupleExpr $\n                                    do  negatedExpr@(A.At (A.Region _ end) _) <- term\n                                        Space.chomp E.Space\n                                        let exprStart = A.Position row (col + 2)\n                                        let expr = A.at exprStart end (Src.Negate negatedExpr)\n                                        chompExprEnd exprStart (State [] expr [] end)\n                                Space.checkIndent end E.TupleIndentEnd\n                                chompTupleEnd start entry []\n                          ]\n                      else\n                        do  word1 0x29 {-)-} E.TupleOperatorClose\n                            addEnd start (Src.Op op)\n              ,\n                do  word1 0x29 {-)-} E.TupleIndentExpr1\n                    addEnd start Src.Unit\n              ,\n                do  (entry, end) <- specialize E.TupleExpr expression\n                    Space.checkIndent end E.TupleIndentEnd\n                    chompTupleEnd start entry []\n              ]\n\n\nchompTupleEnd :: A.Position -> Src.Expr -> [Src.Expr] -> Parser E.Tuple Src.Expr\nchompTupleEnd start firstExpr revExprs =\n  oneOf E.TupleEnd\n    [ do  word1 0x2C {-,-} E.TupleEnd\n          Space.chompAndCheckIndent E.TupleSpace E.TupleIndentExprN\n          (entry, end) <- specialize E.TupleExpr expression\n          Space.checkIndent end E.TupleIndentEnd\n          chompTupleEnd start firstExpr (entry : revExprs)\n    , do  word1 0x29 {-)-} E.TupleEnd\n          case reverse revExprs of\n            [] ->\n              return firstExpr\n\n            secondExpr : otherExprs ->\n              addEnd start (Src.Tuple firstExpr secondExpr otherExprs)\n    ]\n\n\n\n-- RECORDS\n\n\nrecord :: A.Position -> Parser E.Expr Src.Expr\nrecord start =\n  inContext E.Record (word1 0x7B {- { -} E.Start) $\n    do  Space.chompAndCheckIndent E.RecordSpace E.RecordIndentOpen\n        oneOf E.RecordOpen\n          [ do  word1 0x7D {-}-} E.RecordOpen\n                addEnd start (Src.Record [])\n          , do  starter <- addLocation (Var.lower E.RecordField)\n                Space.chompAndCheckIndent E.RecordSpace E.RecordIndentEquals\n                oneOf E.RecordEquals\n                  [ do  word1 0x7C {-|-} E.RecordEquals\n                        Space.chompAndCheckIndent E.RecordSpace E.RecordIndentField\n                        firstField <- chompField\n                        fields <- chompFields [firstField]\n                        addEnd start (Src.Update starter fields)\n                  , do  word1 0x3D {-=-} E.RecordEquals\n                        Space.chompAndCheckIndent E.RecordSpace E.RecordIndentExpr\n                        (value, end) <- specialize E.RecordExpr expression\n                        Space.checkIndent end E.RecordIndentEnd\n                        fields <- chompFields [(starter, value)]\n                        addEnd start (Src.Record fields)\n                  ]\n          ]\n\n\ntype Field = ( A.Located Name.Name, Src.Expr )\n\n\nchompFields :: [Field] -> Parser E.Record [Field]\nchompFields fields =\n  oneOf E.RecordEnd\n    [ do  word1 0x2C {-,-} E.RecordEnd\n          Space.chompAndCheckIndent E.RecordSpace E.RecordIndentField\n          f <- chompField\n          chompFields (f : fields)\n    , do  word1 0x7D {-}-} E.RecordEnd\n          return (reverse fields)\n    ]\n\n\nchompField :: Parser E.Record Field\nchompField =\n  do  key <- addLocation (Var.lower E.RecordField)\n      Space.chompAndCheckIndent E.RecordSpace E.RecordIndentEquals\n      word1 0x3D {-=-} E.RecordEquals\n      Space.chompAndCheckIndent E.RecordSpace E.RecordIndentExpr\n      (value, end) <- specialize E.RecordExpr expression\n      Space.checkIndent end E.RecordIndentEnd\n      return (key, value)\n\n\n\n-- EXPRESSIONS\n\n\nexpression :: Space.Parser E.Expr Src.Expr\nexpression =\n  do  start <- getPosition\n      oneOf E.Start\n        [ let_ start\n        , if_ start\n        , case_ start\n        , function start\n        , do  expr <- possiblyNegativeTerm start\n              end <- getPosition\n              Space.chomp E.Space\n              chompExprEnd start (State [] expr [] end)\n        ]\n\n\ndata State =\n  State\n    { _ops  :: ![(Src.Expr, A.Located Name.Name)]\n    , _expr :: !Src.Expr\n    , _args :: ![Src.Expr]\n    , _end  :: !A.Position\n    }\n\n\nchompExprEnd :: A.Position -> State -> Space.Parser E.Expr Src.Expr\nchompExprEnd start (State ops expr args end) =\n  oneOfWithFallback\n    [ -- argument\n      do  Space.checkIndent end E.Start\n          arg <- term\n          newEnd <- getPosition\n          Space.chomp E.Space\n          chompExprEnd start (State ops expr (arg:args) newEnd)\n\n    , -- operator\n      do  Space.checkIndent end E.Start\n          op@(A.At (A.Region opStart opEnd) opName) <- addLocation (Symbol.operator E.Start E.OperatorReserved)\n          Space.chompAndCheckIndent E.Space (E.IndentOperatorRight opName)\n          newStart <- getPosition\n          if \"-\" == opName && end /= opStart && opEnd == newStart\n            then\n              -- negative terms\n              do  negatedExpr <- term\n                  newEnd <- getPosition\n                  Space.chomp E.Space\n                  let arg = A.at opStart newEnd (Src.Negate negatedExpr)\n                  chompExprEnd start (State ops expr (arg:args) newEnd)\n            else\n              let err = E.OperatorRight opName in\n              oneOf err\n                [ -- term\n                  do  newExpr <- possiblyNegativeTerm newStart\n                      newEnd <- getPosition\n                      Space.chomp E.Space\n                      let newOps = (toCall expr args, op) : ops\n                      chompExprEnd start (State newOps newExpr [] newEnd)\n\n                , -- final term\n                  do  (newLast, newEnd) <-\n                        oneOf err\n                          [ let_ newStart\n                          , case_ newStart\n                          , if_ newStart\n                          , function newStart\n                          ]\n                      let newOps = (toCall expr args, op) : ops\n                      let finalExpr = Src.Binops (reverse newOps) newLast\n                      return ( A.at start newEnd finalExpr, newEnd )\n                ]\n\n    ]\n    -- done\n    (\n      case ops of\n        [] ->\n          ( toCall expr args\n          , end\n          )\n\n        _ ->\n          ( A.at start end (Src.Binops (reverse ops) (toCall expr args))\n          , end\n          )\n    )\n\n\npossiblyNegativeTerm :: A.Position -> Parser E.Expr Src.Expr\npossiblyNegativeTerm start =\n  oneOf E.Start\n    [ do  word1 0x2D {---} E.Start\n          expr <- term\n          addEnd start (Src.Negate expr)\n    , term\n    ]\n\n\ntoCall :: Src.Expr -> [Src.Expr] -> Src.Expr\ntoCall func revArgs =\n  case revArgs of\n    [] ->\n      func\n\n    lastArg : _ ->\n      A.merge func lastArg (Src.Call func (reverse revArgs))\n\n\n\n-- IF EXPRESSION\n\n\nif_ :: A.Position -> Space.Parser E.Expr Src.Expr\nif_ start =\n  inContext E.If (Keyword.if_ E.Start) $\n    chompIfEnd start []\n\n\nchompIfEnd :: A.Position -> [(Src.Expr, Src.Expr)] -> Space.Parser E.If Src.Expr\nchompIfEnd start branches =\n  do  Space.chompAndCheckIndent E.IfSpace E.IfIndentCondition\n      (condition, condEnd) <- specialize E.IfCondition expression\n      Space.checkIndent condEnd E.IfIndentThen\n      Keyword.then_ E.IfThen\n      Space.chompAndCheckIndent E.IfSpace E.IfIndentThenBranch\n      (thenBranch, thenEnd) <- specialize E.IfThenBranch expression\n      Space.checkIndent thenEnd E.IfIndentElse\n      Keyword.else_ E.IfElse\n      Space.chompAndCheckIndent E.IfSpace E.IfIndentElseBranch\n      let newBranches = (condition, thenBranch) : branches\n      oneOf E.IfElseBranchStart\n        [\n          do  Keyword.if_ E.IfElseBranchStart\n              chompIfEnd start newBranches\n        ,\n          do  (elseBranch, elseEnd) <- specialize E.IfElseBranch expression\n              let ifExpr = Src.If (reverse newBranches) elseBranch\n              return ( A.at start elseEnd ifExpr, elseEnd )\n        ]\n\n\n\n-- LAMBDA EXPRESSION\n\n\nfunction :: A.Position -> Space.Parser E.Expr Src.Expr\nfunction start =\n  inContext E.Func (word1 0x5C {-\\-} E.Start) $\n    do  Space.chompAndCheckIndent E.FuncSpace E.FuncIndentArg\n        arg <- specialize E.FuncArg Pattern.term\n        Space.chompAndCheckIndent E.FuncSpace E.FuncIndentArrow\n        revArgs <- chompArgs [arg]\n        Space.chompAndCheckIndent E.FuncSpace E.FuncIndentBody\n        (body, end) <- specialize E.FuncBody expression\n        let funcExpr = Src.Lambda (reverse revArgs) body\n        return (A.at start end funcExpr, end)\n\n\nchompArgs :: [Src.Pattern] -> Parser E.Func [Src.Pattern]\nchompArgs revArgs =\n  oneOf E.FuncArrow\n    [ do  arg <- specialize E.FuncArg Pattern.term\n          Space.chompAndCheckIndent E.FuncSpace E.FuncIndentArrow\n          chompArgs (arg:revArgs)\n    , do  word2 0x2D 0x3E {-->-} E.FuncArrow\n          return revArgs\n    ]\n\n\n\n-- CASE EXPRESSIONS\n\n\ncase_ :: A.Position -> Space.Parser E.Expr Src.Expr\ncase_ start =\n  inContext E.Case (Keyword.case_ E.Start) $\n    do  Space.chompAndCheckIndent E.CaseSpace E.CaseIndentExpr\n        (expr, exprEnd) <- specialize E.CaseExpr expression\n        Space.checkIndent exprEnd E.CaseIndentOf\n        Keyword.of_ E.CaseOf\n        Space.chompAndCheckIndent E.CaseSpace E.CaseIndentPattern\n        withIndent $\n          do  (firstBranch, firstEnd) <- chompBranch\n              (branches, end) <- chompCaseEnd [firstBranch] firstEnd\n              return\n                ( A.at start end (Src.Case expr branches)\n                , end\n                )\n\n\nchompBranch :: Space.Parser E.Case (Src.Pattern, Src.Expr)\nchompBranch =\n  do  (pattern, patternEnd) <- specialize E.CasePattern Pattern.expression\n      Space.checkIndent patternEnd E.CaseIndentArrow\n      word2 0x2D 0x3E {-->-} E.CaseArrow\n      Space.chompAndCheckIndent E.CaseSpace E.CaseIndentBranch\n      (branchExpr, end) <- specialize E.CaseBranch expression\n      return ( (pattern, branchExpr), end )\n\n\nchompCaseEnd :: [(Src.Pattern, Src.Expr)] -> A.Position -> Space.Parser E.Case [(Src.Pattern, Src.Expr)]\nchompCaseEnd branches end =\n  oneOfWithFallback\n    [ do  Space.checkAligned E.CasePatternAlignment\n          (branch, newEnd) <- chompBranch\n          chompCaseEnd (branch:branches) newEnd\n    ]\n    (reverse branches, end)\n\n\n\n-- LET EXPRESSION\n\n\nlet_ :: A.Position -> Space.Parser E.Expr Src.Expr\nlet_ start =\n  inContext E.Let (Keyword.let_ E.Start) $\n    do  (defs, defsEnd) <-\n          withBacksetIndent 3 $\n            do  Space.chompAndCheckIndent E.LetSpace E.LetIndentDef\n                withIndent $\n                  do  (def, end) <- chompLetDef\n                      chompLetDefs [def] end\n\n        Space.checkIndent defsEnd E.LetIndentIn\n        Keyword.in_ E.LetIn\n        Space.chompAndCheckIndent E.LetSpace E.LetIndentBody\n        (body, end) <- specialize E.LetBody expression\n        return\n          ( A.at start end (Src.Let defs body)\n          , end\n          )\n\n\nchompLetDefs :: [A.Located Src.Def] -> A.Position -> Space.Parser E.Let [A.Located Src.Def]\nchompLetDefs revDefs end =\n  oneOfWithFallback\n    [ do  Space.checkAligned E.LetDefAlignment\n          (def, newEnd) <- chompLetDef\n          chompLetDefs (def:revDefs) newEnd\n    ]\n    (reverse revDefs, end)\n\n\n\n-- LET DEFINITIONS\n\n\nchompLetDef :: Space.Parser E.Let (A.Located Src.Def)\nchompLetDef =\n  oneOf E.LetDefName\n    [ definition\n    , destructure\n    ]\n\n\n\n-- DEFINITION\n\n\ndefinition :: Space.Parser E.Let (A.Located Src.Def)\ndefinition =\n  do  aname@(A.At (A.Region start _) name) <- addLocation (Var.lower E.LetDefName)\n      specialize (E.LetDef name) $\n        do  Space.chompAndCheckIndent E.DefSpace E.DefIndentEquals\n            oneOf E.DefEquals\n              [\n                do  word1 0x3A {-:-} E.DefEquals\n                    Space.chompAndCheckIndent E.DefSpace E.DefIndentType\n                    (tipe, _) <- specialize E.DefType Type.expression\n                    Space.checkAligned E.DefAlignment\n                    defName <- chompMatchingName name\n                    Space.chompAndCheckIndent E.DefSpace E.DefIndentEquals\n                    chompDefArgsAndBody start defName (Just tipe) []\n              ,\n                chompDefArgsAndBody start aname Nothing []\n              ]\n\n\nchompDefArgsAndBody :: A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> Space.Parser E.Def (A.Located Src.Def)\nchompDefArgsAndBody start name tipe revArgs =\n  oneOf E.DefEquals\n    [ do  arg <- specialize E.DefArg Pattern.term\n          Space.chompAndCheckIndent E.DefSpace E.DefIndentEquals\n          chompDefArgsAndBody start name tipe (arg : revArgs)\n    , do  word1 0x3D {-=-} E.DefEquals\n          Space.chompAndCheckIndent E.DefSpace E.DefIndentBody\n          (body, end) <- specialize E.DefBody expression\n          return\n            ( A.at start end (Src.Define name (reverse revArgs) body tipe)\n            , end\n            )\n    ]\n\n\nchompMatchingName :: Name.Name -> Parser E.Def (A.Located Name.Name)\nchompMatchingName expectedName =\n  let\n    (P.Parser parserL) = Var.lower E.DefNameRepeat\n  in\n  P.Parser $ \\state@(P.State _ _ _ _ sr sc) cok eok cerr eerr ->\n    let\n      cokL name newState@(P.State _ _ _ _ er ec) =\n        if expectedName == name\n        then cok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState\n        else cerr sr sc (E.DefNameMatch name)\n\n      eokL name newState@(P.State _ _ _ _ er ec) =\n        if expectedName == name\n        then eok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState\n        else eerr sr sc (E.DefNameMatch name)\n    in\n    parserL state cokL eokL cerr eerr\n\n\n\n\n-- DESTRUCTURE\n\n\ndestructure :: Space.Parser E.Let (A.Located Src.Def)\ndestructure =\n  specialize E.LetDestruct $\n  do  start <- getPosition\n      pattern <- specialize E.DestructPattern Pattern.term\n      Space.chompAndCheckIndent E.DestructSpace E.DestructIndentEquals\n      word1 0x3D {-=-} E.DestructEquals\n      Space.chompAndCheckIndent E.DestructSpace E.DestructIndentBody\n      (expr, end) <- specialize E.DestructBody expression\n      return ( A.at start end (Src.Destruct pattern expr), end )\n"
  },
  {
    "path": "compiler/src/Parse/Keyword.hs",
    "content": "{-# LANGUAGE BangPatterns #-}\nmodule Parse.Keyword\n  ( type_, alias_, port_\n  , if_, then_, else_\n  , case_, of_\n  , let_, in_\n  , infix_, left_, right_, non_\n  , module_, import_, exposing_, as_\n  , effect_, where_, command_, subscription_\n  , k4, k5\n  )\n  where\n\n\nimport Foreign.Ptr (plusPtr)\nimport Data.Word (Word8)\n\nimport Parse.Primitives (Parser, Row, Col)\nimport qualified Parse.Variable as Var\nimport qualified Parse.Primitives as P\n\n\n\n-- DECLARATIONS\n\n\ntype_ :: (Row -> Col -> x) -> Parser x ()\ntype_ tx = k4 0x74 0x79 0x70 0x65 tx\n\nalias_ :: (Row -> Col -> x) -> Parser x ()\nalias_ tx = k5 0x61 0x6C 0x69 0x61 0x73 tx\n\nport_ :: (Row -> Col -> x) -> Parser x ()\nport_ tx = k4 0x70 0x6F 0x72 0x74 tx\n\n\n\n-- IF EXPRESSIONS\n\n\nif_ :: (Row -> Col -> x) -> Parser x ()\nif_ tx = k2 0x69 0x66 tx\n\nthen_ :: (Row -> Col -> x) -> Parser x ()\nthen_ tx = k4 0x74 0x68 0x65 0x6E tx\n\nelse_ :: (Row -> Col -> x) -> Parser x ()\nelse_ tx = k4 0x65 0x6C 0x73 0x65 tx\n\n\n\n-- CASE EXPRESSIONS\n\n\ncase_ :: (Row -> Col -> x) -> Parser x ()\ncase_ tx = k4 0x63 0x61 0x73 0x65 tx\n\nof_ :: (Row -> Col -> x) -> Parser x ()\nof_ tx = k2 0x6F 0x66 tx\n\n\n\n-- LET EXPRESSIONS\n\n\nlet_ :: (Row -> Col -> x) -> Parser x ()\nlet_ tx = k3 0x6C 0x65 0x74 tx\n\nin_ :: (Row -> Col -> x) -> Parser x ()\nin_ tx = k2 0x69 0x6E tx\n\n\n\n-- INFIXES\n\n\ninfix_ :: (Row -> Col -> x) -> Parser x ()\ninfix_ tx = k5 0x69 0x6E 0x66 0x69 0x78 tx\n\nleft_ :: (Row -> Col -> x) -> Parser x ()\nleft_ tx = k4 0x6C 0x65 0x66 0x74 tx\n\nright_ :: (Row -> Col -> x) -> Parser x ()\nright_ tx = k5 0x72 0x69 0x67 0x68 0x74 tx\n\nnon_ :: (Row -> Col -> x) -> Parser x ()\nnon_ tx = k3 0x6E 0x6F 0x6E tx\n\n\n\n-- IMPORTS\n\n\nmodule_ :: (Row -> Col -> x) -> Parser x ()\nmodule_ tx = k6 0x6D 0x6F 0x64 0x75 0x6C 0x65 tx\n\nimport_ :: (Row -> Col -> x) -> Parser x ()\nimport_ tx = k6 0x69 0x6D 0x70 0x6F 0x72 0x74 tx\n\nexposing_ :: (Row -> Col -> x) -> Parser x ()\nexposing_ tx = k8 0x65 0x78 0x70 0x6F 0x73 0x69 0x6E 0x67 tx\n\nas_ :: (Row -> Col -> x) -> Parser x ()\nas_ tx = k2 0x61 0x73 tx\n\n\n\n-- EFFECTS\n\n\neffect_ :: (Row -> Col -> x) -> Parser x ()\neffect_ tx = k6 0x65 0x66 0x66 0x65 0x63 0x74 tx\n\nwhere_ :: (Row -> Col -> x) -> Parser x ()\nwhere_ tx = k5 0x77 0x68 0x65 0x72 0x65 tx\n\ncommand_ :: (Row -> Col -> x) -> Parser x ()\ncommand_ tx = k7 0x63 0x6F 0x6D 0x6D 0x61 0x6E 0x64 tx\n\nsubscription_ :: (Row -> Col -> x) -> Parser x ()\nsubscription_ toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let !pos12 = plusPtr pos 12 in\n    if pos12 <= end\n      && P.unsafeIndex (        pos   ) == 0x73\n      && P.unsafeIndex (plusPtr pos  1) == 0x75\n      && P.unsafeIndex (plusPtr pos  2) == 0x62\n      && P.unsafeIndex (plusPtr pos  3) == 0x73\n      && P.unsafeIndex (plusPtr pos  4) == 0x63\n      && P.unsafeIndex (plusPtr pos  5) == 0x72\n      && P.unsafeIndex (plusPtr pos  6) == 0x69\n      && P.unsafeIndex (plusPtr pos  7) == 0x70\n      && P.unsafeIndex (plusPtr pos  8) == 0x74\n      && P.unsafeIndex (plusPtr pos  9) == 0x69\n      && P.unsafeIndex (plusPtr pos 10) == 0x6F\n      && P.unsafeIndex (plusPtr pos 11) == 0x6E\n      && Var.getInnerWidth pos12 end == 0\n    then\n      let !s = P.State src pos12 end indent row (col + 12) in cok () s\n    else\n      eerr row col toError\n\n\n\n-- KEYWORDS\n\n\nk2 :: Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()\nk2 w1 w2 toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let !pos2 = plusPtr pos 2 in\n    if pos2 <= end\n      && P.unsafeIndex (        pos  ) == w1\n      && P.unsafeIndex (plusPtr pos 1) == w2\n      && Var.getInnerWidth pos2 end == 0\n    then\n      let !s = P.State src pos2 end indent row (col + 2) in cok () s\n    else\n      eerr row col toError\n\n\nk3 :: Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()\nk3 w1 w2 w3 toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let !pos3 = plusPtr pos 3 in\n    if pos3 <= end\n      && P.unsafeIndex (        pos  ) == w1\n      && P.unsafeIndex (plusPtr pos 1) == w2\n      && P.unsafeIndex (plusPtr pos 2) == w3\n      && Var.getInnerWidth pos3 end == 0\n    then\n      let !s = P.State src pos3 end indent row (col + 3) in cok () s\n    else\n      eerr row col toError\n\n\nk4 :: Word8 -> Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()\nk4 w1 w2 w3 w4 toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let !pos4 = plusPtr pos 4 in\n    if pos4 <= end\n      && P.unsafeIndex (        pos  ) == w1\n      && P.unsafeIndex (plusPtr pos 1) == w2\n      && P.unsafeIndex (plusPtr pos 2) == w3\n      && P.unsafeIndex (plusPtr pos 3) == w4\n      && Var.getInnerWidth pos4 end == 0\n    then\n      let !s = P.State src pos4 end indent row (col + 4) in cok () s\n    else\n      eerr row col toError\n\n\nk5 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()\nk5 w1 w2 w3 w4 w5 toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let !pos5 = plusPtr pos 5 in\n    if pos5 <= end\n      && P.unsafeIndex (        pos  ) == w1\n      && P.unsafeIndex (plusPtr pos 1) == w2\n      && P.unsafeIndex (plusPtr pos 2) == w3\n      && P.unsafeIndex (plusPtr pos 3) == w4\n      && P.unsafeIndex (plusPtr pos 4) == w5\n      && Var.getInnerWidth pos5 end == 0\n    then\n      let !s = P.State src pos5 end indent row (col + 5) in cok () s\n    else\n      eerr row col toError\n\n\nk6 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()\nk6 w1 w2 w3 w4 w5 w6 toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let !pos6 = plusPtr pos 6 in\n    if pos6 <= end\n      && P.unsafeIndex (        pos  ) == w1\n      && P.unsafeIndex (plusPtr pos 1) == w2\n      && P.unsafeIndex (plusPtr pos 2) == w3\n      && P.unsafeIndex (plusPtr pos 3) == w4\n      && P.unsafeIndex (plusPtr pos 4) == w5\n      && P.unsafeIndex (plusPtr pos 5) == w6\n      && Var.getInnerWidth pos6 end == 0\n    then\n      let !s = P.State src pos6 end indent row (col + 6) in cok () s\n    else\n      eerr row col toError\n\n\nk7 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()\nk7 w1 w2 w3 w4 w5 w6 w7 toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let !pos7 = plusPtr pos 7 in\n    if pos7 <= end\n      && P.unsafeIndex (        pos  ) == w1\n      && P.unsafeIndex (plusPtr pos 1) == w2\n      && P.unsafeIndex (plusPtr pos 2) == w3\n      && P.unsafeIndex (plusPtr pos 3) == w4\n      && P.unsafeIndex (plusPtr pos 4) == w5\n      && P.unsafeIndex (plusPtr pos 5) == w6\n      && P.unsafeIndex (plusPtr pos 6) == w7\n      && Var.getInnerWidth pos7 end == 0\n    then\n      let !s = P.State src pos7 end indent row (col + 7) in cok () s\n    else\n      eerr row col toError\n\n\nk8 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()\nk8 w1 w2 w3 w4 w5 w6 w7 w8 toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let !pos8 = plusPtr pos 8 in\n    if pos8 <= end\n      && P.unsafeIndex (        pos  ) == w1\n      && P.unsafeIndex (plusPtr pos 1) == w2\n      && P.unsafeIndex (plusPtr pos 2) == w3\n      && P.unsafeIndex (plusPtr pos 3) == w4\n      && P.unsafeIndex (plusPtr pos 4) == w5\n      && P.unsafeIndex (plusPtr pos 5) == w6\n      && P.unsafeIndex (plusPtr pos 6) == w7\n      && P.unsafeIndex (plusPtr pos 7) == w8\n      && Var.getInnerWidth pos8 end == 0\n    then\n      let !s = P.State src pos8 end indent row (col + 8) in cok () s\n    else\n      eerr row col toError\n"
  },
  {
    "path": "compiler/src/Parse/Module.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Parse.Module\n  ( fromByteString\n  , ProjectType(..)\n  , isKernel\n  , chompImports\n  , chompImport\n  )\n  where\n\n\nimport qualified Data.ByteString as BS\nimport qualified Data.Name as Name\n\nimport qualified AST.Source as Src\nimport qualified Elm.Compiler.Imports as Imports\nimport qualified Elm.Package as Pkg\nimport qualified Parse.Declaration as Decl\nimport qualified Parse.Keyword as Keyword\nimport qualified Parse.Space as Space\nimport qualified Parse.Symbol as Symbol\nimport qualified Parse.Variable as Var\nimport qualified Parse.Primitives as P\nimport Parse.Primitives hiding (State, fromByteString)\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Syntax as E\n\n\n\n-- FROM BYTE STRING\n\n\nfromByteString :: ProjectType -> BS.ByteString -> Either E.Error Src.Module\nfromByteString projectType source =\n  case P.fromByteString (chompModule projectType) E.ModuleBadEnd source of\n    Right modul -> checkModule projectType modul\n    Left err    -> Left (E.ParseError err)\n\n\n\n-- PROJECT TYPE\n\n\ndata ProjectType\n  = Package Pkg.Name\n  | Application\n\n\nisCore :: ProjectType -> Bool\nisCore projectType =\n  case projectType of\n    Package pkg -> pkg == Pkg.core\n    Application -> False\n\n\nisKernel :: ProjectType -> Bool\nisKernel projectType =\n  case projectType of\n    Package pkg -> Pkg.isKernel pkg\n    Application -> False\n\n\n\n-- MODULE\n\n\ndata Module =\n  Module\n    { _header :: Maybe Header\n    , _imports :: [Src.Import]\n    , _infixes :: [A.Located Src.Infix]\n    , _decls :: [Decl.Decl]\n    }\n\n\nchompModule :: ProjectType -> Parser E.Module Module\nchompModule projectType =\n  do  header <- chompHeader\n      imports <- chompImports (if isCore projectType then [] else Imports.defaults)\n      infixes <- if isKernel projectType then chompInfixes [] else return []\n      decls <- specialize E.Declarations $ chompDecls []\n      return (Module header imports infixes decls)\n\n\n\n-- CHECK MODULE\n\n\ncheckModule :: ProjectType -> Module -> Either E.Error Src.Module\ncheckModule projectType (Module maybeHeader imports infixes decls) =\n  let\n    (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls\n  in\n  case maybeHeader of\n    Just (Header name effects exports docs) ->\n      Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes\n        <$> checkEffects projectType ports effects\n\n    Nothing ->\n      Right $\n        Src.Module Nothing (A.At A.one Src.Open) (Src.NoDocs A.one) imports values unions aliases infixes $\n          case ports of\n            [] -> Src.NoEffects\n            _:_ -> Src.Ports ports\n\n\ncheckEffects :: ProjectType -> [Src.Port] -> Effects -> Either E.Error Src.Effects\ncheckEffects projectType ports effects =\n  case effects of\n    NoEffects region ->\n      case ports of\n        [] ->\n          Right Src.NoEffects\n\n        Src.Port name _ : _ ->\n          case projectType of\n            Package _   -> Left (E.NoPortsInPackage name)\n            Application -> Left (E.UnexpectedPort region)\n\n    Ports region ->\n      case projectType of\n        Package _ ->\n          Left (E.NoPortModulesInPackage region)\n\n        Application ->\n          case ports of\n            []  -> Left (E.NoPorts region)\n            _:_ -> Right (Src.Ports ports)\n\n    Manager region manager ->\n      if isKernel projectType then\n        case ports of\n          []  -> Right (Src.Manager region manager)\n          _:_ -> Left (E.UnexpectedPort region)\n      else\n        Left (E.NoEffectsOutsideKernel region)\n\n\n\ncategorizeDecls :: [A.Located Src.Value] -> [A.Located Src.Union] -> [A.Located Src.Alias] -> [Src.Port] -> [Decl.Decl] -> ( [A.Located Src.Value], [A.Located Src.Union], [A.Located Src.Alias], [Src.Port] )\ncategorizeDecls values unions aliases ports decls =\n  case decls of\n    [] ->\n      (values, unions, aliases, ports)\n\n    decl:otherDecls ->\n      case decl of\n        Decl.Value _ value -> categorizeDecls (value:values) unions aliases ports otherDecls\n        Decl.Union _ union -> categorizeDecls values (union:unions) aliases ports otherDecls\n        Decl.Alias _ alias -> categorizeDecls values unions (alias:aliases) ports otherDecls\n        Decl.Port  _ port_ -> categorizeDecls values unions aliases (port_:ports) otherDecls\n\n\n\n-- TO DOCS\n\n\ntoDocs :: Either A.Region Src.Comment -> [Decl.Decl] -> Src.Docs\ntoDocs comment decls =\n  case comment of\n    Right overview ->\n      Src.YesDocs overview (getComments decls [])\n\n    Left region ->\n      Src.NoDocs region\n\n\ngetComments :: [Decl.Decl] -> [(Name.Name,Src.Comment)] -> [(Name.Name,Src.Comment)]\ngetComments decls comments =\n  case decls of\n    [] ->\n      comments\n\n    decl:otherDecls ->\n      case decl of\n        Decl.Value c (A.At _ (Src.Value n _ _ _)) -> getComments otherDecls (addComment c n comments)\n        Decl.Union c (A.At _ (Src.Union n _ _  )) -> getComments otherDecls (addComment c n comments)\n        Decl.Alias c (A.At _ (Src.Alias n _ _  )) -> getComments otherDecls (addComment c n comments)\n        Decl.Port  c         (Src.Port  n _    )  -> getComments otherDecls (addComment c n comments)\n\n\naddComment :: Maybe Src.Comment -> A.Located Name.Name -> [(Name.Name,Src.Comment)] -> [(Name.Name,Src.Comment)]\naddComment maybeComment (A.At _ name) comments =\n  case maybeComment of\n    Just comment -> (name, comment) : comments\n    Nothing      -> comments\n\n\n\n-- FRESH LINES\n\n\nfreshLine :: (Row -> Col -> E.Module) -> Parser E.Module ()\nfreshLine toFreshLineError =\n  do  Space.chomp E.ModuleSpace\n      Space.checkFreshLine toFreshLineError\n\n\n\n-- CHOMP DECLARATIONS\n\n\nchompDecls :: [Decl.Decl] -> Parser E.Decl [Decl.Decl]\nchompDecls decls =\n  do  (decl, _) <- Decl.declaration\n      oneOfWithFallback\n        [ do  Space.checkFreshLine E.DeclStart\n              chompDecls (decl:decls)\n        ]\n        (reverse (decl:decls))\n\n\nchompInfixes :: [A.Located Src.Infix] -> Parser E.Module [A.Located Src.Infix]\nchompInfixes infixes =\n  oneOfWithFallback\n    [ do  binop <- Decl.infix_\n          chompInfixes (binop:infixes)\n    ]\n    infixes\n\n\n\n-- MODULE DOC COMMENT\n\n\nchompModuleDocCommentSpace :: Parser E.Module (Either A.Region Src.Comment)\nchompModuleDocCommentSpace =\n  do  (A.At region ()) <- addLocation (freshLine E.FreshLine)\n      oneOfWithFallback\n        [\n          do  docComment <- Space.docComment E.ImportStart E.ModuleSpace\n              Space.chomp E.ModuleSpace\n              Space.checkFreshLine E.FreshLine\n              return (Right docComment)\n        ]\n        (Left region)\n\n\n\n-- HEADER\n\n\ndata Header =\n  Header (A.Located Name.Name) Effects (A.Located Src.Exposing) (Either A.Region Src.Comment)\n\n\ndata Effects\n  = NoEffects A.Region\n  | Ports A.Region\n  | Manager A.Region Src.Manager\n\n\nchompHeader :: Parser E.Module (Maybe Header)\nchompHeader =\n  do  freshLine E.FreshLine\n      start <- getPosition\n      oneOfWithFallback\n        [\n          -- module MyThing exposing (..)\n          do  Keyword.module_ E.ModuleProblem\n              effectEnd <- getPosition\n              Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem\n              name <- addLocation (Var.moduleName E.ModuleName)\n              Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem\n              Keyword.exposing_ E.ModuleProblem\n              Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem\n              exports <- addLocation (specialize E.ModuleExposing exposing)\n              comment <- chompModuleDocCommentSpace\n              return $ Just $\n                Header name (NoEffects (A.Region start effectEnd)) exports comment\n        ,\n          -- port module MyThing exposing (..)\n          do  Keyword.port_ E.PortModuleProblem\n              Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem\n              Keyword.module_ E.PortModuleProblem\n              effectEnd <- getPosition\n              Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem\n              name <- addLocation (Var.moduleName E.PortModuleName)\n              Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem\n              Keyword.exposing_ E.PortModuleProblem\n              Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem\n              exports <- addLocation (specialize E.PortModuleExposing exposing)\n              comment <- chompModuleDocCommentSpace\n              return $ Just $\n                Header name (Ports (A.Region start effectEnd)) exports comment\n        ,\n          -- effect module MyThing where { command = MyCmd } exposing (..)\n          do  Keyword.effect_ E.Effect\n              Space.chompAndCheckIndent E.ModuleSpace E.Effect\n              Keyword.module_ E.Effect\n              effectEnd <- getPosition\n              Space.chompAndCheckIndent E.ModuleSpace E.Effect\n              name <- addLocation (Var.moduleName E.ModuleName)\n              Space.chompAndCheckIndent E.ModuleSpace E.Effect\n              Keyword.where_ E.Effect\n              Space.chompAndCheckIndent E.ModuleSpace E.Effect\n              manager <- chompManager\n              Space.chompAndCheckIndent E.ModuleSpace E.Effect\n              Keyword.exposing_ E.Effect\n              Space.chompAndCheckIndent E.ModuleSpace E.Effect\n              exports <- addLocation (specialize (const E.Effect) exposing)\n              comment <- chompModuleDocCommentSpace\n              return $ Just $\n                Header name (Manager (A.Region start effectEnd) manager) exports comment\n        ]\n        -- default header\n        Nothing\n\n\nchompManager :: Parser E.Module Src.Manager\nchompManager =\n  do  word1 0x7B {- { -} E.Effect\n      spaces_em\n      oneOf E.Effect\n        [ do  cmd <- chompCommand\n              spaces_em\n              oneOf E.Effect\n                [ do  word1 0x7D {-}-} E.Effect\n                      spaces_em\n                      return (Src.Cmd cmd)\n                , do  word1 0x2C {-,-} E.Effect\n                      spaces_em\n                      sub <- chompSubscription\n                      spaces_em\n                      word1 0x7D {-}-} E.Effect\n                      spaces_em\n                      return (Src.Fx cmd sub)\n                ]\n        , do  sub <- chompSubscription\n              spaces_em\n              oneOf E.Effect\n                [ do  word1 0x7D {-}-} E.Effect\n                      spaces_em\n                      return (Src.Sub sub)\n                , do  word1 0x2C {-,-} E.Effect\n                      spaces_em\n                      cmd <- chompCommand\n                      spaces_em\n                      word1 0x7D {-}-} E.Effect\n                      spaces_em\n                      return (Src.Fx cmd sub)\n                ]\n        ]\n\n\nchompCommand :: Parser E.Module (A.Located Name.Name)\nchompCommand =\n  do  Keyword.command_ E.Effect\n      spaces_em\n      word1 0x3D {-=-} E.Effect\n      spaces_em\n      addLocation (Var.upper E.Effect)\n\n\nchompSubscription :: Parser E.Module (A.Located Name.Name)\nchompSubscription =\n  do  Keyword.subscription_ E.Effect\n      spaces_em\n      word1 0x3D {-=-} E.Effect\n      spaces_em\n      addLocation (Var.upper E.Effect)\n\n\nspaces_em :: Parser E.Module ()\nspaces_em =\n  Space.chompAndCheckIndent E.ModuleSpace E.Effect\n\n\n\n-- IMPORTS\n\n\nchompImports :: [Src.Import] -> Parser E.Module [Src.Import]\nchompImports is =\n  oneOfWithFallback\n    [ do  i <- chompImport\n          chompImports (i:is)\n    ]\n    (reverse is)\n\n\nchompImport :: Parser E.Module Src.Import\nchompImport =\n  do  Keyword.import_ E.ImportStart\n      Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentName\n      name@(A.At (A.Region _ end) _) <- addLocation (Var.moduleName E.ImportName)\n      Space.chomp E.ModuleSpace\n      oneOf E.ImportEnd\n        [ do  Space.checkFreshLine E.ImportEnd\n              return $ Src.Import name Nothing (Src.Explicit [])\n        , do  Space.checkIndent end E.ImportEnd\n              oneOf E.ImportAs\n                [ chompAs name\n                , chompExposing name Nothing\n                ]\n        ]\n\n\nchompAs :: A.Located Name.Name -> Parser E.Module Src.Import\nchompAs name =\n  do  Keyword.as_ E.ImportAs\n      Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias\n      alias <- Var.upper E.ImportAlias\n      end <- getPosition\n      Space.chomp E.ModuleSpace\n      oneOf E.ImportEnd\n        [ do  Space.checkFreshLine E.ImportEnd\n              return $ Src.Import name (Just alias) (Src.Explicit [])\n        , do  Space.checkIndent end E.ImportEnd\n              chompExposing name (Just alias)\n        ]\n\n\nchompExposing :: A.Located Name.Name -> Maybe Name.Name -> Parser E.Module Src.Import\nchompExposing name maybeAlias =\n  do  Keyword.exposing_ E.ImportExposing\n      Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentExposingList\n      exposed <- specialize E.ImportExposingList exposing\n      freshLine E.ImportEnd\n      return $ Src.Import name maybeAlias exposed\n\n\n\n-- LISTING\n\n\nexposing :: Parser E.Exposing Src.Exposing\nexposing =\n  do  word1 0x28 {-(-} E.ExposingStart\n      Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue\n      oneOf E.ExposingValue\n        [ do  word2 0x2E 0x2E {-..-} E.ExposingValue\n              Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd\n              word1 0x29 {-)-} E.ExposingEnd\n              return Src.Open\n        , do  exposed <- chompExposed\n              Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd\n              exposingHelp [exposed]\n        ]\n\n\nexposingHelp :: [Src.Exposed] -> Parser E.Exposing Src.Exposing\nexposingHelp revExposed =\n  oneOf E.ExposingEnd\n    [ do  word1 0x2C {-,-} E.ExposingEnd\n          Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue\n          exposed <- chompExposed\n          Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd\n          exposingHelp (exposed:revExposed)\n    , do  word1 0x29 {-)-} E.ExposingEnd\n          return (Src.Explicit (reverse revExposed))\n    ]\n\n\nchompExposed :: Parser E.Exposing Src.Exposed\nchompExposed =\n  do  start <- getPosition\n      oneOf E.ExposingValue\n        [ do  name <- Var.lower E.ExposingValue\n              end <- getPosition\n              return $ Src.Lower $ A.at start end name\n        , do  word1 0x28 {-(-} E.ExposingValue\n              op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved\n              word1 0x29 {-)-} E.ExposingOperatorRightParen\n              end <- getPosition\n              return $ Src.Operator (A.Region start end) op\n        , do  name <- Var.upper E.ExposingValue\n              end <- getPosition\n              Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd\n              Src.Upper (A.at start end name) <$> privacy\n        ]\n\n\nprivacy :: Parser E.Exposing Src.Privacy\nprivacy =\n  oneOfWithFallback\n    [ do  word1 0x28 {-(-} E.ExposingTypePrivacy\n          Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy\n          start <- getPosition\n          word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy\n          end <- getPosition\n          Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy\n          word1 0x29 {-)-} E.ExposingTypePrivacy\n          return $ Src.Public (A.Region start end)\n    ]\n    Src.Private\n"
  },
  {
    "path": "compiler/src/Parse/Number.hs",
    "content": "{-# LANGUAGE BangPatterns, UnboxedTuples #-}\nmodule Parse.Number\n  ( Number(..)\n  , number\n  , Outcome(..)\n  , chompInt\n  , chompHex\n  , precedence\n  )\n  where\n\n\nimport Data.Word (Word8)\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr)\n\nimport qualified AST.Utils.Binop as Binop\nimport qualified Elm.Float as EF\nimport Parse.Primitives (Parser, Row, Col)\nimport qualified Parse.Variable as Var\nimport qualified Parse.Primitives as P\nimport qualified Reporting.Error.Syntax as E\n\n\n\n-- HELPERS\n\n\nisDirtyEnd :: Ptr Word8 -> Ptr Word8 -> Word8 -> Bool\nisDirtyEnd pos end word =\n  Var.getInnerWidthHelp pos end word > 0\n\n\n{-# INLINE isDecimalDigit #-}\nisDecimalDigit :: Word8 -> Bool\nisDecimalDigit word =\n  word <= 0x39 {-9-} && word >= 0x30 {-0-}\n\n\n\n-- NUMBERS\n\n\ndata Number\n  = Int Int\n  | Float EF.Float\n\n\nnumber :: (Row -> Col -> x) -> (E.Number -> Row -> Col -> x) -> Parser x Number\nnumber toExpectation toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    if pos >= end then\n      eerr row col toExpectation\n\n    else\n      let !word = P.unsafeIndex pos in\n      if not (isDecimalDigit word) then\n        eerr row col toExpectation\n\n      else\n        let\n          outcome =\n            if word == 0x30 {-0-} then\n              chompZero (plusPtr pos 1) end\n            else\n              chompInt (plusPtr pos 1) end (fromIntegral (word - 0x30 {-0-}))\n        in\n          case outcome of\n            Err newPos problem ->\n              let\n                !newCol = col + fromIntegral (minusPtr newPos pos)\n              in\n              cerr row newCol (toError problem)\n\n            OkInt newPos n ->\n              let\n                !newCol = col + fromIntegral (minusPtr newPos pos)\n                !integer = Int n\n                !newState = P.State src newPos end indent row newCol\n              in\n              cok integer newState\n\n            OkFloat newPos ->\n              let\n                !newCol = col + fromIntegral (minusPtr newPos pos)\n                !copy = EF.fromPtr pos newPos\n                !float = Float copy\n                !newState = P.State src newPos end indent row newCol\n              in\n              cok float newState\n\n\n\n-- CHOMP OUTCOME\n\n\n-- first Int is newPos\n--\ndata Outcome\n  = Err (Ptr Word8) E.Number\n  | OkInt (Ptr Word8) Int\n  | OkFloat (Ptr Word8)\n\n\n\n-- CHOMP INT\n\n\nchompInt :: Ptr Word8 -> Ptr Word8 -> Int -> Outcome\nchompInt !pos end !n =\n  if pos >= end then\n\n    OkInt pos n\n\n  else\n\n    let\n      !word = P.unsafeIndex pos\n    in\n      if isDecimalDigit word then\n        chompInt (plusPtr pos 1) end (10 * n + fromIntegral (word - 0x30 {-0-}))\n\n      else if word == 0x2E {-.-} then\n        chompFraction pos end n\n\n      else if word == 0x65 {-e-} || word == 0x45 {-E-} then\n        chompExponent (plusPtr pos 1) end\n\n      else if isDirtyEnd pos end word then\n        Err pos E.NumberEnd\n\n      else\n        OkInt pos n\n\n\n\n-- CHOMP FRACTION\n\n\nchompFraction :: Ptr Word8 -> Ptr Word8 -> Int -> Outcome\nchompFraction pos end n =\n  let\n    !pos1 = plusPtr pos 1\n  in\n  if pos1 >= end then\n    Err pos (E.NumberDot n)\n\n  else if isDecimalDigit (P.unsafeIndex pos1) then\n    chompFractionHelp (plusPtr pos1 1) end\n\n  else\n    Err pos (E.NumberDot n)\n\n\nchompFractionHelp :: Ptr Word8 -> Ptr Word8 -> Outcome\nchompFractionHelp pos end =\n  if pos >= end then\n    OkFloat pos\n\n  else\n    let !word = P.unsafeIndex pos in\n    if isDecimalDigit word then\n      chompFractionHelp (plusPtr pos 1) end\n\n    else if word == 0x65 {-e-} || word == 0x45 {-E-} then\n      chompExponent (plusPtr pos 1) end\n\n    else if isDirtyEnd pos end word then\n      Err pos E.NumberEnd\n\n    else\n      OkFloat pos\n\n\n\n-- CHOMP EXPONENT\n\n\nchompExponent :: Ptr Word8 -> Ptr Word8 -> Outcome\nchompExponent pos end =\n  if pos >= end then\n    Err pos E.NumberEnd\n\n  else\n    let !word = P.unsafeIndex pos in\n    if isDecimalDigit word then\n      chompExponentHelp (plusPtr pos 1) end\n\n    else if word == 0x2B {-+-} || word == 0x2D {---} then\n\n      let !pos1 = plusPtr pos 1 in\n      if pos1 < end && isDecimalDigit (P.unsafeIndex pos1) then\n        chompExponentHelp (plusPtr pos 2) end\n      else\n        Err pos E.NumberEnd\n\n    else\n      Err pos E.NumberEnd\n\n\nchompExponentHelp :: Ptr Word8 -> Ptr Word8 -> Outcome\nchompExponentHelp pos end =\n  if pos >= end then\n    OkFloat pos\n\n  else if isDecimalDigit (P.unsafeIndex pos) then\n    chompExponentHelp (plusPtr pos 1) end\n\n  else\n    OkFloat pos\n\n\n\n-- CHOMP ZERO\n\n\nchompZero :: Ptr Word8 -> Ptr Word8 -> Outcome\nchompZero pos end =\n  if pos >= end then\n    OkInt pos 0\n\n  else\n    let !word = P.unsafeIndex pos in\n    if word == 0x78 {-x-} then\n      chompHexInt (plusPtr pos 1) end\n\n    else if word == 0x2E {-.-} then\n      chompFraction pos end 0\n\n    else if isDecimalDigit word then\n      Err pos E.NumberNoLeadingZero\n\n    else if isDirtyEnd pos end word then\n      Err pos E.NumberEnd\n\n    else\n      OkInt pos 0\n\n\nchompHexInt :: Ptr Word8 -> Ptr Word8 -> Outcome\nchompHexInt pos end =\n  let (# newPos, answer #) = chompHex pos end in\n  if answer < 0 then\n    Err newPos E.NumberHexDigit\n  else\n    OkInt newPos answer\n\n\n\n-- CHOMP HEX\n\n\n-- Return -1 if it has NO digits\n-- Return -2 if it has BAD digits\n\n{-# INLINE chompHex #-}\nchompHex :: Ptr Word8 -> Ptr Word8 -> (# Ptr Word8, Int #)\nchompHex pos end =\n  chompHexHelp pos end (-1) 0\n\n\nchompHexHelp :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> (# Ptr Word8, Int #)\nchompHexHelp pos end answer accumulator =\n  if pos >= end then\n    (# pos, answer #)\n  else\n    let\n      !newAnswer =\n        stepHex pos end (P.unsafeIndex pos) accumulator\n    in\n    if newAnswer < 0 then\n      (# pos, if newAnswer == -1 then answer else -2 #)\n    else\n      chompHexHelp (plusPtr pos 1) end newAnswer newAnswer\n\n\n{-# INLINE stepHex #-}\nstepHex :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> Int\nstepHex pos end word acc\n  | 0x30 {-0-} <= word && word <= 0x39 {-9-} = 16 * acc + fromIntegral (word - 0x30 {-0-})\n  | 0x61 {-a-} <= word && word <= 0x66 {-f-} = 16 * acc + 10 + fromIntegral (word - 0x61 {-a-})\n  | 0x41 {-A-} <= word && word <= 0x46 {-F-} = 16 * acc + 10 + fromIntegral (word - 0x41 {-A-})\n  | isDirtyEnd pos end word                  = -2\n  | True                                     = -1\n\n\n\n-- PRECEDENCE\n\n\nprecedence :: (Row -> Col -> x) -> Parser x Binop.Precedence\nprecedence toExpectation =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    if pos >= end then\n      eerr row col toExpectation\n\n    else\n      let !word = P.unsafeIndex pos in\n      if isDecimalDigit word then\n        cok\n          (Binop.Precedence (fromIntegral (word - 0x30 {-0-})))\n          (P.State src (plusPtr pos 1) end indent row (col + 1))\n\n      else\n        eerr row col toExpectation\n"
  },
  {
    "path": "compiler/src/Parse/Pattern.hs",
    "content": "{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}\n{-# LANGUAGE BangPatterns, UnboxedTuples, OverloadedStrings #-}\nmodule Parse.Pattern\n  ( term\n  , expression\n  )\n  where\n\n\nimport qualified Data.List as List\nimport qualified Data.Name as Name\nimport qualified Data.Utf8 as Utf8\nimport Foreign.Ptr (plusPtr)\n\nimport qualified AST.Source as Src\nimport qualified Parse.Keyword as Keyword\nimport qualified Parse.Number as Number\nimport qualified Parse.Space as Space\nimport qualified Parse.String as String\nimport qualified Parse.Variable as Var\nimport qualified Parse.Primitives as P\nimport Parse.Primitives (Parser, addLocation, addEnd, getPosition, inContext, oneOf, oneOfWithFallback, word1, word2)\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Syntax as E\n\n\n\n-- TERM\n\n\nterm :: Parser E.Pattern Src.Pattern\nterm =\n  do  start <- getPosition\n      oneOf E.PStart\n        [ record start\n        , tuple start\n        , list start\n        , termHelp start\n        ]\n\n\ntermHelp :: A.Position -> Parser E.Pattern Src.Pattern\ntermHelp start =\n  oneOf E.PStart\n    [\n      do  wildcard\n          addEnd start Src.PAnything\n    ,\n      do  name <- Var.lower E.PStart\n          addEnd start (Src.PVar name)\n    ,\n      do  upper <- Var.foreignUpper E.PStart\n          end <- getPosition\n          let region = A.Region start end\n          return $ A.at start end $\n            case upper of\n              Var.Unqualified name ->\n                Src.PCtor region name []\n\n              Var.Qualified home name ->\n                Src.PCtorQual region home name []\n    ,\n      do  number <- Number.number E.PStart E.PNumber\n          end <- getPosition\n          case number of\n            Number.Int int ->\n              return (A.at start end (Src.PInt int))\n\n            Number.Float float ->\n              P.Parser $ \\(P.State _ _ _ _ row col) _ _ cerr _ ->\n                let\n                  width = fromIntegral (Utf8.size float)\n                in\n                cerr row (col - width) (E.PFloat width)\n    ,\n      do  str <- String.string E.PStart E.PString\n          addEnd start (Src.PStr str)\n    ,\n      do  chr <- String.character E.PStart E.PChar\n          addEnd start (Src.PChr chr)\n    ]\n\n\n\n-- WILDCARD\n\n\nwildcard :: Parser E.Pattern ()\nwildcard =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    if pos == end || P.unsafeIndex pos /= 0x5F {- _ -} then\n      eerr row col E.PStart\n    else\n      let\n        !newPos = plusPtr pos 1\n        !newCol = col + 1\n      in\n      if Var.getInnerWidth newPos end > 0 then\n        let (# badPos, badCol #) = Var.chompInnerChars newPos end newCol in\n        cerr row col (E.PWildcardNotVar (Name.fromPtr pos badPos) (fromIntegral (badCol - col)))\n      else\n        let !newState = P.State src newPos end indent row newCol in\n        cok () newState\n\n\n\n-- RECORDS\n\n\nrecord :: A.Position -> Parser E.Pattern Src.Pattern\nrecord start =\n  inContext E.PRecord (word1 0x7B {- { -} E.PStart) $\n    do  Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentOpen\n        oneOf E.PRecordOpen\n          [ do  var <- addLocation (Var.lower E.PRecordField)\n                Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd\n                recordHelp start [var]\n          , do  word1 0x7D {-}-} E.PRecordEnd\n                addEnd start (Src.PRecord [])\n          ]\n\n\nrecordHelp :: A.Position -> [A.Located Name.Name] -> Parser E.PRecord Src.Pattern\nrecordHelp start vars =\n  oneOf E.PRecordEnd\n    [ do  word1 0x2C {-,-} E.PRecordEnd\n          Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentField\n          var <- addLocation (Var.lower E.PRecordField)\n          Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd\n          recordHelp start (var:vars)\n    , do  word1 0x7D {-}-} E.PRecordEnd\n          addEnd start (Src.PRecord (reverse vars))\n    ]\n\n\n\n-- TUPLES\n\n\ntuple :: A.Position -> Parser E.Pattern Src.Pattern\ntuple start =\n  inContext E.PTuple (word1 0x28 {-(-} E.PStart) $\n    do  Space.chompAndCheckIndent E.PTupleSpace E.PTupleIndentExpr1\n        oneOf E.PTupleOpen\n          [ do  (pattern, end) <- P.specialize E.PTupleExpr expression\n                Space.checkIndent end E.PTupleIndentEnd\n                tupleHelp start pattern []\n          , do  word1 0x29 {-)-} E.PTupleEnd\n                addEnd start Src.PUnit\n          ]\n\n\ntupleHelp :: A.Position -> Src.Pattern -> [Src.Pattern] -> Parser E.PTuple Src.Pattern\ntupleHelp start firstPattern revPatterns =\n  oneOf E.PTupleEnd\n    [ do  word1 0x2C {-,-} E.PTupleEnd\n          Space.chompAndCheckIndent E.PTupleSpace E.PTupleIndentExprN\n          (pattern, end) <- P.specialize E.PTupleExpr expression\n          Space.checkIndent end E.PTupleIndentEnd\n          tupleHelp start firstPattern (pattern : revPatterns)\n    , do  word1 0x29 {-)-} E.PTupleEnd\n          case reverse revPatterns of\n            [] ->\n              return firstPattern\n\n            secondPattern : otherPatterns ->\n              addEnd start (Src.PTuple firstPattern secondPattern otherPatterns)\n    ]\n\n\n\n-- LIST\n\n\nlist :: A.Position -> Parser E.Pattern Src.Pattern\nlist start =\n  inContext E.PList (word1 0x5B {-[-} E.PStart) $\n    do  Space.chompAndCheckIndent E.PListSpace E.PListIndentOpen\n        oneOf E.PListOpen\n          [ do  (pattern, end) <- P.specialize E.PListExpr expression\n                Space.checkIndent end E.PListIndentEnd\n                listHelp start [pattern]\n          , do  word1 0x5D {-]-} E.PListEnd\n                addEnd start (Src.PList [])\n          ]\n\n\nlistHelp :: A.Position -> [Src.Pattern] -> Parser E.PList Src.Pattern\nlistHelp start patterns =\n  oneOf E.PListEnd\n    [ do  word1 0x2C {-,-} E.PListEnd\n          Space.chompAndCheckIndent E.PListSpace E.PListIndentExpr\n          (pattern, end) <- P.specialize E.PListExpr expression\n          Space.checkIndent end E.PListIndentEnd\n          listHelp start (pattern:patterns)\n    , do  word1 0x5D {-]-} E.PListEnd\n          addEnd start (Src.PList (reverse patterns))\n    ]\n\n\n\n-- EXPRESSION\n\n\nexpression :: Space.Parser E.Pattern Src.Pattern\nexpression =\n  do  start <- getPosition\n      ePart <- exprPart\n      exprHelp start [] ePart\n\n\nexprHelp :: A.Position -> [Src.Pattern] -> (Src.Pattern, A.Position) -> Space.Parser E.Pattern Src.Pattern\nexprHelp start revPatterns (pattern, end) =\n  oneOfWithFallback\n    [ do  Space.checkIndent end E.PIndentStart\n          word2 0x3A 0x3A {-::-} E.PStart\n          Space.chompAndCheckIndent E.PSpace E.PIndentStart\n          ePart <- exprPart\n          exprHelp start (pattern:revPatterns) ePart\n    , do  Space.checkIndent end E.PIndentStart\n          Keyword.as_ E.PStart\n          Space.chompAndCheckIndent E.PSpace E.PIndentAlias\n          nameStart <- getPosition\n          name <- Var.lower E.PAlias\n          newEnd <- getPosition\n          Space.chomp E.PSpace\n          let alias = A.at nameStart newEnd name\n          return\n            ( A.at start newEnd (Src.PAlias (List.foldl' cons pattern revPatterns) alias)\n            , newEnd\n            )\n    ]\n    ( List.foldl' cons pattern revPatterns\n    , end\n    )\n\n\ncons :: Src.Pattern -> Src.Pattern -> Src.Pattern\ncons tl hd =\n  A.merge hd tl (Src.PCons hd tl)\n\n\n\n-- EXPRESSION PART\n\n\nexprPart :: Space.Parser E.Pattern Src.Pattern\nexprPart =\n  oneOf E.PStart\n    [\n      do  start <- getPosition\n          upper <- Var.foreignUpper E.PStart\n          end <- getPosition\n          exprTermHelp (A.Region start end) upper start []\n    ,\n      do  eterm@(A.At (A.Region _ end) _) <- term\n          Space.chomp E.PSpace\n          return (eterm, end)\n    ]\n\n\nexprTermHelp :: A.Region -> Var.Upper -> A.Position -> [Src.Pattern] -> Space.Parser E.Pattern Src.Pattern\nexprTermHelp region upper start revArgs =\n  do  end <- getPosition\n      Space.chomp E.PSpace\n      oneOfWithFallback\n        [ do  Space.checkIndent end E.PIndentStart\n              arg <- term\n              exprTermHelp region upper start (arg:revArgs)\n        ]\n        ( A.at start end $\n            case upper of\n              Var.Unqualified name ->\n                Src.PCtor region name (reverse revArgs)\n\n              Var.Qualified home name ->\n                Src.PCtorQual region home name (reverse revArgs)\n        , end\n        )\n"
  },
  {
    "path": "compiler/src/Parse/Primitives.hs",
    "content": "{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing #-}\n{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}\nmodule Parse.Primitives\n  ( fromByteString\n  , Parser(..)\n  , State(..)\n  , Row\n  , Col\n  , oneOf, oneOfWithFallback\n  , inContext, specialize\n  , getPosition, getCol, addLocation, addEnd\n  , getIndent, setIndent, withIndent, withBacksetIndent\n  , word1, word2\n  , unsafeIndex, isWord, getCharWidth\n  , Snippet(..)\n  , fromSnippet\n  )\n  where\n\n\nimport Prelude hiding (length)\nimport qualified Control.Applicative as Applicative (Applicative(..))\nimport qualified Data.ByteString.Internal as B\nimport Data.Word (Word8, Word16)\nimport Foreign.Ptr (Ptr, plusPtr)\nimport Foreign.Storable (peek)\nimport Foreign.ForeignPtr (ForeignPtr, touchForeignPtr)\nimport Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)\n\nimport qualified Reporting.Annotation as A\n\n\n\n-- PARSER\n\n\nnewtype Parser x a =\n  Parser (\n    forall b.\n      State\n      -> (a -> State -> b)                       -- consumed ok\n      -> (a -> State -> b)                       -- empty ok\n      -> (Row -> Col -> (Row -> Col -> x) -> b)  -- consumed err\n      -> (Row -> Col -> (Row -> Col -> x) -> b)  -- empty err\n      -> b\n  )\n\n\ndata State = -- PERF try taking some out to avoid allocation\n  State\n    { _src :: ForeignPtr Word8\n    , _pos :: !(Ptr Word8)\n    , _end :: !(Ptr Word8)\n    , _indent :: !Word16\n    , _row :: !Row\n    , _col :: !Col\n    }\n\n\ntype Row = Word16\ntype Col = Word16\n\n\n\n-- FUNCTOR\n\n\ninstance Functor (Parser x) where\n  {-# INLINE fmap #-}\n  fmap f (Parser parser) =\n    Parser $ \\state cok eok cerr eerr ->\n      let\n        cok' a s = cok (f a) s\n        eok' a s = eok (f a) s\n      in\n      parser state cok' eok' cerr eerr\n\n\n\n-- APPLICATIVE\n\n\ninstance Applicative.Applicative (Parser x) where\n  {-# INLINE pure #-}\n  pure value =\n    Parser $ \\state _ eok _ _ ->\n      eok value state\n\n  {-# INLINE (<*>) #-}\n  (<*>) (Parser parserFunc) (Parser parserArg) =\n    Parser $ \\state cok eok cerr eerr ->\n      let\n        cokF func s1 =\n          let\n            cokA arg s2 = cok (func arg) s2\n          in\n          parserArg s1 cokA cokA cerr cerr\n\n        eokF func s1 =\n          let\n            cokA arg s2 = cok (func arg) s2\n            eokA arg s2 = eok (func arg) s2\n          in\n          parserArg s1 cokA eokA cerr eerr\n      in\n      parserFunc state cokF eokF cerr eerr\n\n\n\n-- ONE OF\n\n\n{-# INLINE oneOf #-}\noneOf :: (Row -> Col -> x) -> [Parser x a] -> Parser x a\noneOf toError parsers =\n  Parser $ \\state cok eok cerr eerr ->\n    oneOfHelp state cok eok cerr eerr toError parsers\n\n\noneOfHelp\n  :: State\n  -> (a -> State -> b)\n  -> (a -> State -> b)\n  -> (Row -> Col -> (Row -> Col -> x) -> b)\n  -> (Row -> Col -> (Row -> Col -> x) -> b)\n  -> (Row -> Col -> x)\n  -> [Parser x a]\n  -> b\noneOfHelp state cok eok cerr eerr toError parsers =\n  case parsers of\n    Parser parser : parsers ->\n      let\n        eerr' _ _ _ =\n          oneOfHelp state cok eok cerr eerr toError parsers\n      in\n      parser state cok eok cerr eerr'\n\n    [] ->\n      let\n        (State _ _ _ _ row col) = state\n      in\n      eerr row col toError\n\n\n\n-- ONE OF WITH FALLBACK\n\n\n{-# INLINE oneOfWithFallback #-}\noneOfWithFallback :: [Parser x a] -> a -> Parser x a -- PERF is this function okay? Worried about allocation/laziness with fallback values.\noneOfWithFallback parsers fallback =\n  Parser $ \\state cok eok cerr _ ->\n    oowfHelp state cok eok cerr parsers fallback\n\n\noowfHelp\n  :: State\n  -> (a -> State -> b)\n  -> (a -> State -> b)\n  -> (Row -> Col -> (Row -> Col -> x) -> b)\n  -> [Parser x a]\n  -> a\n  -> b\noowfHelp state cok eok cerr parsers fallback =\n  case parsers of\n    [] ->\n      eok fallback state\n\n    Parser parser : parsers ->\n      let\n        eerr' _ _ _ =\n          oowfHelp state cok eok cerr parsers fallback\n      in\n      parser state cok eok cerr eerr'\n\n\n\n-- MONAD\n\n\ninstance Monad (Parser x) where\n  {-# INLINE (>>=) #-}\n  (Parser parserA) >>= callback =\n    Parser $ \\state cok eok cerr eerr ->\n      let\n        cok' a s =\n          case callback a of\n            Parser parserB -> parserB s cok cok cerr cerr\n\n        eok' a s =\n          case callback a of\n            Parser parserB -> parserB s cok eok cerr eerr\n      in\n      parserA state cok' eok' cerr eerr\n\n\n\n-- FROM BYTESTRING\n\n\nfromByteString :: Parser x a -> (Row -> Col -> x) -> B.ByteString -> Either x a\nfromByteString (Parser parser) toBadEnd (B.PS fptr offset length) =\n  B.accursedUnutterablePerformIO $\n    let\n      toOk' = toOk toBadEnd\n      !pos = plusPtr (unsafeForeignPtrToPtr fptr) offset\n      !end = plusPtr pos length\n      !result = parser (State fptr pos end 0 1 1) toOk' toOk' toErr toErr\n    in\n    do  touchForeignPtr fptr\n        return result\n\n\ntoOk :: (Row -> Col -> x) -> a -> State -> Either x a\ntoOk toBadEnd !a (State _ pos end _ row col) =\n  if pos == end\n  then Right a\n  else Left (toBadEnd row col)\n\n\ntoErr :: Row -> Col -> (Row -> Col -> x) -> Either x a\ntoErr row col toError =\n  Left (toError row col)\n\n\n\n-- FROM SNIPPET\n\n\ndata Snippet =\n  Snippet\n    { _fptr   :: ForeignPtr Word8\n    , _offset :: Int\n    , _length :: Int\n    , _offRow :: Row\n    , _offCol :: Col\n    }\n\n\nfromSnippet :: Parser x a -> (Row -> Col -> x) -> Snippet -> Either x a\nfromSnippet (Parser parser) toBadEnd (Snippet fptr offset length row col) =\n  B.accursedUnutterablePerformIO $\n    let\n      toOk' = toOk toBadEnd\n      !pos = plusPtr (unsafeForeignPtrToPtr fptr) offset\n      !end = plusPtr pos length\n      !result = parser (State fptr pos end 0 row col) toOk' toOk' toErr toErr\n    in\n    do  touchForeignPtr fptr\n        return result\n\n\n\n-- POSITION\n\n\ngetCol :: Parser x Word16\ngetCol =\n  Parser $ \\state@(State _ _ _ _ _ col) _ eok _ _ ->\n    eok col state\n\n\n{-# INLINE getPosition #-}\ngetPosition :: Parser x A.Position\ngetPosition =\n  Parser $ \\state@(State _ _ _ _ row col) _ eok _ _ ->\n    eok (A.Position row col) state\n\n\naddLocation :: Parser x a -> Parser x (A.Located a)\naddLocation (Parser parser) =\n  Parser $ \\state@(State _ _ _ _ sr sc) cok eok cerr eerr ->\n    let\n      cok' a s@(State _ _ _ _ er ec) = cok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) a) s\n      eok' a s@(State _ _ _ _ er ec) = eok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) a) s\n    in\n    parser state cok' eok' cerr eerr\n\n\naddEnd :: A.Position -> a -> Parser x (A.Located a)\naddEnd start value =\n  Parser $ \\state@(State _ _ _ _ row col) _ eok _ _ ->\n    eok (A.at start (A.Position row col) value) state\n\n\n\n-- INDENT\n\n\ngetIndent :: Parser x Word16\ngetIndent =\n  Parser $ \\state@(State _ _ _ indent _ _) _ eok _ _ ->\n    eok indent state\n\n\nsetIndent :: Word16 -> Parser x ()\nsetIndent indent =\n  Parser $ \\(State src pos end _ row col) _ eok _ _ ->\n    let\n      !newState = State src pos end indent row col\n    in\n    eok () newState\n\n\nwithIndent :: Parser x a -> Parser x a\nwithIndent (Parser parser) =\n  Parser $ \\(State src pos end oldIndent row col) cok eok cerr eerr ->\n    let\n      cok' a (State s p e _ r c) = cok a (State s p e oldIndent r c)\n      eok' a (State s p e _ r c) = eok a (State s p e oldIndent r c)\n    in\n    parser (State src pos end col row col) cok' eok' cerr eerr\n\n\nwithBacksetIndent :: Word16 -> Parser x a -> Parser x a\nwithBacksetIndent backset (Parser parser) =\n  Parser $ \\(State src pos end oldIndent row col) cok eok cerr eerr ->\n    let\n      cok' a (State s p e _ r c) = cok a (State s p e oldIndent r c)\n      eok' a (State s p e _ r c) = eok a (State s p e oldIndent r c)\n    in\n    parser (State src pos end (col - backset) row col) cok' eok' cerr eerr\n\n\n\n-- CONTEXT\n\n\ninContext :: (x -> Row -> Col -> y) -> Parser y start -> Parser x a -> Parser y a\ninContext addContext (Parser parserStart) (Parser parserA) =\n  Parser $ \\state@(State _ _ _ _ row col) cok eok cerr eerr ->\n    let\n      cerrA r c tx = cerr row col (addContext (tx r c))\n      eerrA r c tx = eerr row col (addContext (tx r c))\n\n      cokS _ s = parserA s cok cok cerrA cerrA\n      eokS _ s = parserA s cok eok cerrA eerrA\n    in\n    parserStart state cokS eokS cerr eerr\n\n\nspecialize :: (x -> Row -> Col -> y) -> Parser x a -> Parser y a\nspecialize addContext (Parser parser) =\n  Parser $ \\state@(State _ _ _ _ row col) cok eok cerr eerr ->\n    let\n      cerr' r c tx = cerr row col (addContext (tx r c))\n      eerr' r c tx = eerr row col (addContext (tx r c))\n    in\n    parser state cok eok cerr' eerr'\n\n\n\n-- SYMBOLS\n\n\nword1 :: Word8 -> (Row -> Col -> x) -> Parser x ()\nword1 word toError =\n  Parser $ \\(State src pos end indent row col) cok _ _ eerr ->\n    if pos < end && unsafeIndex pos == word then\n      let !newState = State src (plusPtr pos 1) end indent row (col + 1) in\n      cok () newState\n    else\n      eerr row col toError\n\n\nword2 :: Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()\nword2 w1 w2 toError =\n  Parser $ \\(State src pos end indent row col) cok _ _ eerr ->\n    let\n      !pos1 = plusPtr pos 1\n    in\n    if pos1 < end && unsafeIndex pos == w1 && unsafeIndex pos1 == w2 then\n      let !newState = State src (plusPtr pos 2) end indent row (col + 2) in\n      cok () newState\n    else\n      eerr row col toError\n\n\n\n-- LOW-LEVEL CHECKS\n\n\nunsafeIndex :: Ptr Word8 -> Word8\nunsafeIndex ptr =\n  B.accursedUnutterablePerformIO (peek ptr)\n\n\n{-# INLINE isWord #-}\nisWord :: Ptr Word8 -> Ptr Word8 -> Word8 -> Bool\nisWord pos end word =\n  pos < end && unsafeIndex pos == word\n\n\ngetCharWidth :: Word8 -> Int\ngetCharWidth word\n  | word < 0x80 = 1\n  | word < 0xc0 = error \"Need UTF-8 encoded input. Ran into unrecognized bits.\"\n  | word < 0xe0 = 2\n  | word < 0xf0 = 3\n  | word < 0xf8 = 4\n  | True        = error \"Need UTF-8 encoded input. Ran into unrecognized bits.\"\n"
  },
  {
    "path": "compiler/src/Parse/Shader.hs",
    "content": "{-# LANGUAGE BangPatterns, UnboxedTuples #-}\nmodule Parse.Shader\n  ( shader\n  )\n  where\n\n\nimport qualified Data.ByteString.Internal as B\nimport qualified Data.ByteString.UTF8 as BS_UTF8\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport Data.Word (Word8)\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr)\nimport Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)\nimport qualified Language.GLSL.Parser as GLP\nimport qualified Language.GLSL.Syntax as GLS\nimport qualified Text.Parsec as Parsec\nimport qualified Text.Parsec.Error as Parsec\n\nimport qualified AST.Source as Src\nimport qualified AST.Utils.Shader as Shader\nimport Parse.Primitives (Parser, Row, Col)\nimport qualified Parse.Primitives as P\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Syntax as E\n\n\n\n-- SHADER\n\n\nshader :: A.Position -> Parser E.Expr Src.Expr\nshader start@(A.Position row col) =\n  do  block <- parseBlock\n      shdr <- parseGlsl row col block\n      end <- P.getPosition\n      return (A.at start end (Src.Shader (Shader.fromChars block) shdr))\n\n\n\n-- BLOCK\n\n\nparseBlock :: Parser E.Expr [Char]\nparseBlock =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    let\n      !pos6 = plusPtr pos 6\n    in\n    if pos6 <= end\n      && P.unsafeIndex (        pos  ) == 0x5B {- [ -}\n      && P.unsafeIndex (plusPtr pos 1) == 0x67 {- g -}\n      && P.unsafeIndex (plusPtr pos 2) == 0x6C {- l -}\n      && P.unsafeIndex (plusPtr pos 3) == 0x73 {- s -}\n      && P.unsafeIndex (plusPtr pos 4) == 0x6C {- l -}\n      && P.unsafeIndex (plusPtr pos 5) == 0x7C {- | -}\n    then\n      let\n        (# status, newPos, newRow, newCol #) =\n          eatShader pos6 end row (col + 6)\n      in\n      case status of\n        Good ->\n          let\n            !off = minusPtr pos6 (unsafeForeignPtrToPtr src)\n            !len = minusPtr newPos pos6\n            !block = BS_UTF8.toString (B.PS src off len)\n            !newState = P.State src (plusPtr newPos 2) end indent newRow (newCol + 2)\n          in\n          cok block newState\n\n        Unending ->\n          cerr row col E.EndlessShader\n\n    else\n      eerr row col E.Start\n\n\ndata Status\n  = Good\n  | Unending\n\n\neatShader :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Status, Ptr Word8, Row, Col #)\neatShader pos end row col =\n  if pos >= end then\n    (# Unending, pos, row, col #)\n\n  else\n    let !word = P.unsafeIndex pos in\n    if word == 0x007C {- | -} && P.isWord (plusPtr pos 1) end 0x5D {- ] -} then\n      (# Good, pos, row, col #)\n\n    else if word == 0x0A {- \\n -} then\n      eatShader (plusPtr pos 1) end (row + 1) 1\n\n    else\n      let !newPos = plusPtr pos (P.getCharWidth word) in\n      eatShader newPos end row (col + 1)\n\n\n\n-- GLSL\n\n\nparseGlsl :: Row -> Col -> [Char] -> Parser E.Expr Shader.Types\nparseGlsl startRow startCol src =\n  case GLP.parse src of\n    Right (GLS.TranslationUnit decls) ->\n      return (foldr addInput emptyTypes (concatMap extractInputs decls))\n\n    Left err ->\n      let\n        pos = Parsec.errorPos err\n        row = fromIntegral (Parsec.sourceLine pos)\n        col = fromIntegral (Parsec.sourceColumn pos)\n        msg =\n          Parsec.showErrorMessages\n            \"or\"\n            \"unknown parse error\"\n            \"expecting\"\n            \"unexpected\"\n            \"end of input\"\n            (Parsec.errorMessages err)\n      in\n      if row == 1\n        then failure startRow (startCol + 6 + col) msg\n        else failure (startRow + row - 1) col msg\n\n\nfailure :: Row -> Col -> [Char] -> Parser E.Expr a\nfailure row col msg =\n  P.Parser $ \\(P.State _ _ _ _ _ _) _ _ cerr _ ->\n    cerr row col (E.ShaderProblem msg)\n\n\n\n-- INPUTS\n\n\nemptyTypes :: Shader.Types\nemptyTypes =\n  Shader.Types Map.empty Map.empty Map.empty\n\n\naddInput :: (GLS.StorageQualifier, Shader.Type, [Char]) -> Shader.Types -> Shader.Types\naddInput (qual, tipe, name) glDecls =\n  case qual of\n    GLS.Attribute -> glDecls { Shader._attribute = Map.insert (Name.fromChars name) tipe (Shader._attribute glDecls) }\n    GLS.Uniform   -> glDecls { Shader._uniform = Map.insert (Name.fromChars name) tipe (Shader._uniform glDecls) }\n    GLS.Varying   -> glDecls { Shader._varying = Map.insert (Name.fromChars name) tipe (Shader._varying glDecls) }\n    _             -> error \"Should never happen due to `extractInputs` function\"\n\n\nextractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, Shader.Type, [Char])]\nextractInputs decl =\n  case decl of\n    GLS.Declaration\n      (GLS.InitDeclaration\n         (GLS.TypeDeclarator\n            (GLS.FullType\n               (Just (GLS.TypeQualSto qual))\n               (GLS.TypeSpec _prec (GLS.TypeSpecNoPrecision tipe _mexpr1))))\n         [GLS.InitDecl name _mexpr2 _mexpr3]\n      ) ->\n        case elem qual [GLS.Attribute, GLS.Varying, GLS.Uniform] of\n          False -> []\n          True ->\n              case tipe of\n                GLS.Vec2 -> [(qual, Shader.V2, name)]\n                GLS.Vec3 -> [(qual, Shader.V3, name)]\n                GLS.Vec4 -> [(qual, Shader.V4, name)]\n                GLS.Mat4 -> [(qual, Shader.M4, name)]\n                GLS.Int -> [(qual, Shader.Int, name)]\n                GLS.Float -> [(qual, Shader.Float, name)]\n                GLS.Sampler2D -> [(qual, Shader.Texture, name)]\n                _ -> []\n    _ -> []\n\n\n"
  },
  {
    "path": "compiler/src/Parse/Space.hs",
    "content": "{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}\n{-# LANGUAGE BangPatterns, UnboxedTuples, OverloadedStrings #-}\nmodule Parse.Space\n  ( Parser\n  --\n  , chomp\n  , chompAndCheckIndent\n  --\n  , checkIndent\n  , checkAligned\n  , checkFreshLine\n  --\n  , docComment\n  )\n  where\n\n\nimport Data.Word (Word8, Word16)\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr)\nimport Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)\n\nimport qualified AST.Source as Src\nimport Parse.Primitives (Row, Col)\nimport qualified Parse.Primitives as P\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Syntax as E\n\n\n\n-- SPACE PARSING\n\n\ntype Parser x a =\n  P.Parser x (a, A.Position)\n\n\n\n-- CHOMP\n\n\nchomp :: (E.Space -> Row -> Col -> x) -> P.Parser x ()\nchomp toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr _ ->\n    let\n      (# status, newPos, newRow, newCol #) = eatSpaces pos end row col\n    in\n    case status of\n      Good ->\n        let\n          !newState = P.State src newPos end indent newRow newCol\n        in\n        cok () newState\n\n      HasTab               -> cerr newRow newCol (toError E.HasTab)\n      EndlessMultiComment  -> cerr newRow newCol (toError E.EndlessMultiComment)\n\n\n\n-- CHECKS -- to be called right after a `chomp`\n\n\ncheckIndent :: A.Position -> (Row -> Col -> x) -> P.Parser x ()\ncheckIndent (A.Position endRow endCol) toError =\n  P.Parser $ \\state@(P.State _ _ _ indent _ col) _ eok _ eerr ->\n    if col > indent && col > 1\n    then eok () state\n    else eerr endRow endCol toError\n\n\ncheckAligned :: (Word16 -> Row -> Col -> x) -> P.Parser x ()\ncheckAligned toError =\n  P.Parser $ \\state@(P.State _ _ _ indent row col) _ eok _ eerr ->\n    if col == indent\n    then eok () state\n    else eerr row col (toError indent)\n\n\ncheckFreshLine :: (Row -> Col -> x) -> P.Parser x ()\ncheckFreshLine toError =\n  P.Parser $ \\state@(P.State _ _ _ _ row col) _ eok _ eerr ->\n    if col == 1\n    then eok () state\n    else eerr row col toError\n\n\n\n-- CHOMP AND CHECK\n\n\nchompAndCheckIndent :: (E.Space -> Row -> Col -> x) -> (Row -> Col -> x) -> P.Parser x ()\nchompAndCheckIndent toSpaceError toIndentError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr _ ->\n    let\n      (# status, newPos, newRow, newCol #) = eatSpaces pos end row col\n    in\n    case status of\n      Good ->\n        if newCol > indent && newCol > 1\n        then\n\n          let\n            !newState = P.State src newPos end indent newRow newCol\n          in\n          cok () newState\n\n        else\n          cerr row col toIndentError\n\n      HasTab               -> cerr newRow newCol (toSpaceError E.HasTab)\n      EndlessMultiComment  -> cerr newRow newCol (toSpaceError E.EndlessMultiComment)\n\n\n\n-- EAT SPACES\n\n\ndata Status\n  = Good\n  | HasTab\n  | EndlessMultiComment\n\n\neatSpaces :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Status, Ptr Word8, Row, Col #)\neatSpaces pos end row col =\n  if pos >= end then\n    (# Good, pos, row, col #)\n\n  else\n    case P.unsafeIndex pos of\n      0x20 {-   -} ->\n        eatSpaces (plusPtr pos 1) end row (col + 1)\n\n      0x0A {- \\n -} ->\n        eatSpaces (plusPtr pos 1) end (row + 1) 1\n\n      0x7B {- { -} ->\n        eatMultiComment pos end row col\n\n      0x2D {- - -} ->\n        let !pos1 = plusPtr pos 1 in\n        if pos1 < end && P.unsafeIndex pos1 == 0x2D {- - -} then\n          eatLineComment (plusPtr pos 2) end row (col + 2)\n        else\n          (# Good, pos, row, col #)\n\n      0x0D {- \\r -} ->\n        eatSpaces (plusPtr pos 1) end row col\n\n      0x09 {- \\t -} ->\n        (# HasTab, pos, row, col #)\n\n      _ ->\n        (# Good, pos, row, col #)\n\n\n\n-- LINE COMMENTS\n\n\neatLineComment :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Status, Ptr Word8, Row, Col #)\neatLineComment pos end row col =\n  if pos >= end then\n    (# Good, pos, row, col #)\n\n  else\n    let !word = P.unsafeIndex pos in\n    if word == 0x0A {- \\n -} then\n      eatSpaces (plusPtr pos 1) end (row + 1) 1\n    else\n      let !newPos = plusPtr pos (P.getCharWidth word) in\n      eatLineComment newPos end row (col + 1)\n\n\n\n-- MULTI COMMENTS\n\n\neatMultiComment :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Status, Ptr Word8, Row, Col #)\neatMultiComment pos end row col =\n  let\n    !pos1 = plusPtr pos 1\n    !pos2 = plusPtr pos 2\n  in\n  if pos2 >= end then\n    (# Good, pos, row, col #)\n\n  else if P.unsafeIndex pos1 == 0x2D {- - -} then\n\n    if P.unsafeIndex pos2 == 0x7C {- | -} then\n      (# Good, pos, row, col #)\n    else\n      let\n        (# status, newPos, newRow, newCol #) =\n          eatMultiCommentHelp pos2 end row (col + 2) 1\n      in\n      case status of\n        MultiGood    -> eatSpaces newPos end newRow newCol\n        MultiTab     -> (# HasTab, newPos, newRow, newCol #)\n        MultiEndless -> (# EndlessMultiComment, pos, row, col #)\n\n  else\n    (# Good, pos, row, col #)\n\n\ndata MultiStatus\n  = MultiGood\n  | MultiTab\n  | MultiEndless\n\n\neatMultiCommentHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> (# MultiStatus, Ptr Word8, Row, Col #)\neatMultiCommentHelp pos end row col openComments =\n  if pos >= end then\n    (# MultiEndless, pos, row, col #)\n\n  else\n    let !word = P.unsafeIndex pos in\n    if word == 0x0A {- \\n -} then\n      eatMultiCommentHelp (plusPtr pos 1) end (row + 1) 1 openComments\n\n    else if word == 0x09 {- \\t -} then\n      (# MultiTab, pos, row, col #)\n\n    else if word == 0x2D {- - -} && P.isWord (plusPtr pos 1) end 0x7D {- } -} then\n      if openComments == 1 then\n        (# MultiGood, plusPtr pos 2, row, col + 2 #)\n      else\n        eatMultiCommentHelp (plusPtr pos 2) end row (col + 2) (openComments - 1)\n\n    else if word == 0x7B {- { -} && P.isWord (plusPtr pos 1) end 0x2D {- - -} then\n      eatMultiCommentHelp (plusPtr pos 2) end row (col + 2) (openComments + 1)\n\n    else\n      let !newPos = plusPtr pos (P.getCharWidth word) in\n      eatMultiCommentHelp newPos end row (col + 1) openComments\n\n\n\n-- DOCUMENTATION COMMENT\n\n\ndocComment :: (Row -> Col -> x) -> (E.Space -> Row -> Col -> x) -> P.Parser x Src.Comment\ndocComment toExpectation toSpaceError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    let\n      !pos3 = plusPtr pos 3\n    in\n    if pos3 <= end\n      && P.unsafeIndex (        pos  ) == 0x7B {- { -}\n      && P.unsafeIndex (plusPtr pos 1) == 0x2D {- - -}\n      && P.unsafeIndex (plusPtr pos 2) == 0x7C {- | -}\n    then\n      let\n        !col3 = col + 3\n\n        (# status, newPos, newRow, newCol #) =\n           eatMultiCommentHelp pos3 end row col3 1\n      in\n      case status of\n        MultiGood ->\n          let\n            !off = minusPtr pos3 (unsafeForeignPtrToPtr src)\n            !len = minusPtr newPos pos3 - 2\n            !snippet = P.Snippet src off len row col3\n            !comment = Src.Comment snippet\n            !newState = P.State src newPos end indent newRow newCol\n          in\n          cok comment newState\n\n        MultiTab -> cerr newRow newCol (toSpaceError E.HasTab)\n        MultiEndless -> cerr row col (toSpaceError E.EndlessMultiComment)\n    else\n      eerr row col toExpectation\n"
  },
  {
    "path": "compiler/src/Parse/String.hs",
    "content": "{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}\n{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}\nmodule Parse.String\n  ( string\n  , character\n  )\n  where\n\n\nimport qualified Data.Utf8 as Utf8\nimport Data.Word (Word8, Word16)\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr)\n\nimport qualified Elm.String as ES\nimport Parse.Primitives (Parser, Row, Col)\nimport qualified Parse.Number as Number\nimport qualified Parse.Primitives as P\nimport qualified Reporting.Error.Syntax as E\n\n\n\n-- CHARACTER\n\n\ncharacter :: (Row -> Col -> x) -> (E.Char -> Row -> Col -> x) -> Parser x ES.String\ncharacter toExpectation toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    if pos >= end || P.unsafeIndex pos /= 0x27 {- ' -} then\n      eerr row col toExpectation\n\n    else\n      case chompChar (plusPtr pos 1) end row (col + 1) 0 placeholder of\n        Good newPos newCol numChars mostRecent ->\n          if numChars /= 1 then\n            cerr row col (toError (E.CharNotString (fromIntegral (newCol - col))))\n          else\n            let\n              !newState = P.State src newPos end indent row newCol\n              !char = ES.fromChunks [mostRecent]\n            in\n            cok char newState\n\n        CharEndless newCol ->\n          cerr row newCol (toError E.CharEndless)\n\n        CharEscape r c escape ->\n          cerr r c (toError (E.CharEscape escape))\n\n\ndata CharResult\n  = Good (Ptr Word8) Col Word16 ES.Chunk\n  | CharEndless Col\n  | CharEscape Row Col E.Escape\n\n\nchompChar :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> ES.Chunk -> CharResult\nchompChar pos end row col numChars mostRecent =\n  if pos >= end then\n    CharEndless col\n\n  else\n    let\n      !word = P.unsafeIndex pos\n    in\n      if word == 0x27 {- ' -} then\n        Good (plusPtr pos 1) (col + 1) numChars mostRecent\n\n      else if word == 0x0A {- \\n -} then\n        CharEndless col\n\n      else if word == 0x22 {- \" -} then\n        chompChar (plusPtr pos 1) end row (col + 1) (numChars + 1) doubleQuote\n\n      else if word == 0x5C {- \\ -} then\n        case eatEscape (plusPtr pos 1) end row col of\n          EscapeNormal ->\n            chompChar (plusPtr pos 2) end row (col + 2) (numChars + 1) (ES.Slice pos 2)\n\n          EscapeUnicode delta code ->\n            chompChar (plusPtr pos delta) end row (col + fromIntegral delta) (numChars + 1) (ES.CodePoint code)\n\n          EscapeProblem r c badEscape ->\n            CharEscape r c badEscape\n\n          EscapeEndOfFile ->\n            CharEndless col\n\n      else\n        let\n          !width = P.getCharWidth word\n          !newPos = plusPtr pos width\n        in\n        chompChar newPos end row (col + 1) (numChars + 1) (ES.Slice pos width)\n\n\n\n-- STRINGS\n\n\nstring :: (Row -> Col -> x) -> (E.String -> Row -> Col -> x) -> Parser x ES.String\nstring toExpectation toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    if isDoubleQuote pos end then\n\n      let\n        !pos1 = plusPtr pos 1\n      in\n      case\n        if isDoubleQuote pos1 end then\n          let !pos2 = plusPtr pos 2 in\n          if isDoubleQuote pos2 end then\n            let\n              !pos3 = plusPtr pos 3\n              !col3 = col + 3\n            in\n            multiString pos3 end row col3 pos3 row col mempty\n          else\n            Ok pos2 row (col + 2) Utf8.empty\n        else\n          singleString pos1 end row (col + 1) pos1 mempty\n      of\n        Ok newPos newRow newCol utf8 ->\n          let\n            !newState =\n              P.State src newPos end indent newRow newCol\n          in\n          cok utf8 newState\n\n        Err r c x ->\n          cerr r c (toError x)\n\n    else\n      eerr row col toExpectation\n\n\n{-# INLINE isDoubleQuote #-}\nisDoubleQuote :: Ptr Word8 -> Ptr Word8 -> Bool\nisDoubleQuote pos end =\n  pos < end && P.unsafeIndex pos == 0x22 {- \" -}\n\n\ndata StringResult\n  = Ok (Ptr Word8) Row Col !ES.String\n  | Err Row Col E.String\n\n\nfinalize :: Ptr Word8 -> Ptr Word8 -> [ES.Chunk] -> ES.String\nfinalize start end revChunks =\n  ES.fromChunks $ reverse $\n    if start == end then\n      revChunks\n    else\n      ES.Slice start (minusPtr end start) : revChunks\n\n\naddEscape :: ES.Chunk -> Ptr Word8 -> Ptr Word8 -> [ES.Chunk] -> [ES.Chunk]\naddEscape chunk start end revChunks =\n  if start == end then\n    chunk : revChunks\n  else\n    chunk : ES.Slice start (minusPtr end start) : revChunks\n\n\n\n-- SINGLE STRINGS\n\n\nsingleString :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> [ES.Chunk] -> StringResult\nsingleString pos end row col initialPos revChunks =\n  if pos >= end then\n    Err row col E.StringEndless_Single\n\n  else\n    let\n      !word = P.unsafeIndex pos\n    in\n      if word == 0x22 {- \" -} then\n        Ok (plusPtr pos 1) row (col + 1) $\n          finalize initialPos pos revChunks\n\n      else if word == 0x0A {- \\n -} then\n        Err row col E.StringEndless_Single\n\n      else if word == 0x27 {- ' -} then\n        let !newPos = plusPtr pos 1 in\n        singleString newPos end row (col + 1) newPos $\n          addEscape singleQuote initialPos pos revChunks\n\n      else if word == 0x5C {- \\ -} then\n        case eatEscape (plusPtr pos 1) end row col of\n          EscapeNormal ->\n            singleString (plusPtr pos 2) end row (col + 2) initialPos revChunks\n\n          EscapeUnicode delta code ->\n            let !newPos = plusPtr pos delta in\n            singleString newPos end row (col + fromIntegral delta) newPos $\n              addEscape (ES.CodePoint code) initialPos pos revChunks\n\n          EscapeProblem r c x ->\n            Err r c (E.StringEscape x)\n\n          EscapeEndOfFile ->\n            Err row (col + 1) E.StringEndless_Single\n\n      else\n        let !newPos = plusPtr pos (P.getCharWidth word) in\n        singleString newPos end row (col + 1) initialPos revChunks\n\n\n\n-- MULTI STRINGS\n\n\nmultiString :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> Row -> Col -> [ES.Chunk] -> StringResult\nmultiString pos end row col initialPos sr sc revChunks =\n  if pos >= end then\n    Err sr sc E.StringEndless_Multi\n\n  else\n    let !word = P.unsafeIndex pos in\n    if word == 0x22 {- \" -} && isDoubleQuote (plusPtr pos 1) end && isDoubleQuote (plusPtr pos 2) end then\n      Ok (plusPtr pos 3) row (col + 3) $\n        finalize initialPos pos revChunks\n\n    else if word == 0x27 {- ' -} then\n      let !pos1 = plusPtr pos 1 in\n      multiString pos1 end row (col + 1) pos1 sr sc $\n        addEscape singleQuote initialPos pos revChunks\n\n    else if word == 0x0A {- \\n -} then\n      let !pos1 = plusPtr pos 1 in\n      multiString pos1 end (row + 1) 1 pos1 sr sc $\n        addEscape newline initialPos pos revChunks\n\n    else if word == 0x0D {- \\r -} then\n      let !pos1 = plusPtr pos 1 in\n      multiString pos1 end row col pos1 sr sc $\n        addEscape carriageReturn initialPos pos revChunks\n\n    else if word == 0x5C {- \\ -} then\n      case eatEscape (plusPtr pos 1) end row col of\n        EscapeNormal ->\n          multiString (plusPtr pos 2) end row (col + 2) initialPos sr sc revChunks\n\n        EscapeUnicode delta code ->\n          let !newPos = plusPtr pos delta in\n          multiString newPos end row (col + fromIntegral delta) newPos sr sc $\n            addEscape (ES.CodePoint code) initialPos pos revChunks\n\n        EscapeProblem r c x ->\n          Err r c (E.StringEscape x)\n\n        EscapeEndOfFile ->\n          Err sr sc E.StringEndless_Multi\n\n    else\n      let !newPos = plusPtr pos (P.getCharWidth word) in\n      multiString newPos end row (col + 1) initialPos sr sc revChunks\n\n\n\n-- ESCAPE CHARACTERS\n\n\ndata Escape\n  = EscapeNormal\n  | EscapeUnicode !Int !Int\n  | EscapeEndOfFile\n  | EscapeProblem Row Col E.Escape\n\n\neatEscape :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Escape\neatEscape pos end row col =\n  if pos >= end then\n    EscapeEndOfFile\n\n  else\n    case P.unsafeIndex pos of\n      0x6E {- n -} -> EscapeNormal\n      0x72 {- r -} -> EscapeNormal\n      0x74 {- t -} -> EscapeNormal\n      0x22 {- \" -} -> EscapeNormal\n      0x27 {- ' -} -> EscapeNormal\n      0x5C {- \\ -} -> EscapeNormal\n      0x75 {- u -} -> eatUnicode (plusPtr pos 1) end row col\n      _            -> EscapeProblem row col E.EscapeUnknown\n\n\neatUnicode :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Escape\neatUnicode pos end row col =\n  if pos >= end || P.unsafeIndex pos /= 0x7B {- { -} then\n    EscapeProblem row col (E.BadUnicodeFormat 2)\n  else\n    let\n      !digitPos = plusPtr pos 1\n      (# newPos, code #) = Number.chompHex digitPos end\n      !numDigits = minusPtr newPos digitPos\n    in\n    if newPos >= end || P.unsafeIndex newPos /= 0x7D {- } -} then\n      EscapeProblem row col $ E.BadUnicodeFormat (2 + fromIntegral (minusPtr newPos pos))\n\n    else if code < 0 || 0x10FFFF < code then\n      EscapeProblem row col $ E.BadUnicodeCode (3 + fromIntegral (minusPtr newPos pos))\n\n    else if numDigits < 4 || 6 < numDigits then\n      EscapeProblem row col $\n        E.BadUnicodeLength\n          (3 + fromIntegral (minusPtr newPos pos))\n          numDigits\n          code\n\n    else\n      EscapeUnicode (numDigits + 4) code\n\n\n{-# NOINLINE singleQuote #-}\nsingleQuote :: ES.Chunk\nsingleQuote =\n  ES.Escape 0x27 {-'-}\n\n\n{-# NOINLINE doubleQuote #-}\ndoubleQuote :: ES.Chunk\ndoubleQuote =\n  ES.Escape 0x22 {-\"-}\n\n\n{-# NOINLINE newline #-}\nnewline :: ES.Chunk\nnewline =\n  ES.Escape 0x6E {-n-}\n\n\n{-# NOINLINE carriageReturn #-}\ncarriageReturn :: ES.Chunk\ncarriageReturn =\n  ES.Escape 0x72 {-r-}\n\n\n{-# NOINLINE placeholder #-}\nplaceholder :: ES.Chunk\nplaceholder =\n  ES.CodePoint 0xFFFD {-replacement character-}\n"
  },
  {
    "path": "compiler/src/Parse/Symbol.hs",
    "content": "{-# LANGUAGE BangPatterns, OverloadedStrings #-}\nmodule Parse.Symbol\n  ( operator\n  , BadOperator(..)\n  , binopCharSet\n  )\n  where\n\n\nimport qualified Data.Char as Char\nimport qualified Data.IntSet as IntSet\nimport qualified Data.Name as Name\nimport qualified Data.Vector as Vector\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr)\nimport GHC.Word (Word8)\n\nimport Parse.Primitives (Parser, Row, Col)\nimport qualified Parse.Primitives as P\n\n\n\n-- OPERATOR\n\n\ndata BadOperator\n  = BadDot\n  | BadPipe\n  | BadArrow\n  | BadEquals\n  | BadHasType\n\n\noperator :: (Row -> Col -> x) -> (BadOperator -> Row -> Col -> x) -> Parser x Name.Name\noperator toExpectation toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    let !newPos = chompOps pos end in\n    if pos == newPos then\n      eerr row col toExpectation\n\n    else\n      case Name.fromPtr pos newPos of\n        \".\"  -> eerr row col (toError BadDot)\n        \"|\"  -> cerr row col (toError BadPipe)\n        \"->\" -> cerr row col (toError BadArrow)\n        \"=\"  -> cerr row col (toError BadEquals)\n        \":\"  -> cerr row col (toError BadHasType)\n        op   ->\n          let\n            !newCol = col + fromIntegral (minusPtr newPos pos)\n            !newState = P.State src newPos end indent row newCol\n          in\n          cok op newState\n\n\nchompOps :: Ptr Word8 -> Ptr Word8 -> Ptr Word8\nchompOps pos end =\n  if pos < end && isBinopCharHelp (P.unsafeIndex pos) then\n    chompOps (plusPtr pos 1) end\n  else\n    pos\n\n\n{-# INLINE isBinopCharHelp #-}\nisBinopCharHelp :: Word8 -> Bool\nisBinopCharHelp word =\n  word < 128 && Vector.unsafeIndex binopCharVector (fromIntegral word)\n\n\n{-# NOINLINE binopCharVector #-}\nbinopCharVector :: Vector.Vector Bool\nbinopCharVector =\n  Vector.generate 128 (\\i -> IntSet.member i binopCharSet)\n\n\n{-# NOINLINE binopCharSet #-}\nbinopCharSet :: IntSet.IntSet\nbinopCharSet =\n  IntSet.fromList (map Char.ord \"+-/*=.<>:&|^?%!\")\n"
  },
  {
    "path": "compiler/src/Parse/Type.hs",
    "content": "{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Parse.Type\n  ( expression\n  , variant\n  )\n  where\n\n\nimport qualified Data.Name as Name\n\nimport qualified AST.Source as Src\nimport Parse.Primitives (Parser, addLocation, addEnd, getPosition, inContext, specialize, oneOf, oneOfWithFallback, word1, word2)\nimport qualified Parse.Space as Space\nimport qualified Parse.Variable as Var\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Syntax as E\n\n\n\n-- TYPE TERMS\n\n\nterm :: Parser E.Type Src.Type\nterm =\n  do  start <- getPosition\n      oneOf E.TStart\n        [\n          -- types with no arguments (Int, Float, etc.)\n          do  upper <- Var.foreignUpper E.TStart\n              end <- getPosition\n              let region = A.Region start end\n              return $ A.At region $\n                case upper of\n                  Var.Unqualified name ->\n                    Src.TType region name []\n\n                  Var.Qualified home name ->\n                    Src.TTypeQual region home name []\n        ,\n          -- type variables\n          do  var <- Var.lower E.TStart\n              addEnd start (Src.TVar var)\n        ,\n          -- tuples\n          inContext E.TTuple (word1 0x28 {-(-} E.TStart) $\n            oneOf E.TTupleOpen\n              [ do  word1 0x29 {-)-} E.TTupleOpen\n                    addEnd start Src.TUnit\n              , do  Space.chompAndCheckIndent E.TTupleSpace E.TTupleIndentType1\n                    (tipe, end) <- specialize E.TTupleType expression\n                    Space.checkIndent end E.TTupleIndentEnd\n                    chompTupleEnd start tipe []\n              ]\n        ,\n          -- records\n          inContext E.TRecord (word1 0x7B {- { -} E.TStart) $\n            do  Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentOpen\n                oneOf E.TRecordOpen\n                  [ do  word1 0x7D {-}-} E.TRecordEnd\n                        addEnd start (Src.TRecord [] Nothing)\n                  , do  name <- addLocation (Var.lower E.TRecordField)\n                        Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentColon\n                        oneOf E.TRecordColon\n                          [ do  word1 0x7C {-|-} E.TRecordColon\n                                Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentField\n                                field <- chompField\n                                fields <- chompRecordEnd [field]\n                                addEnd start (Src.TRecord fields (Just name))\n                          , do  word1 0x3A {-:-} E.TRecordColon\n                                Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentType\n                                (tipe, end) <- specialize E.TRecordType expression\n                                Space.checkIndent end E.TRecordIndentEnd\n                                fields <- chompRecordEnd [(name, tipe)]\n                                addEnd start (Src.TRecord fields Nothing)\n                          ]\n                  ]\n        ]\n\n\n\n-- TYPE EXPRESSIONS\n\n\nexpression :: Space.Parser E.Type Src.Type\nexpression =\n  do  start <- getPosition\n      term1@(tipe1, end1) <-\n        oneOf E.TStart\n          [ app start\n          , do  eterm <- term\n                end <- getPosition\n                Space.chomp E.TSpace\n                return (eterm, end)\n          ]\n      oneOfWithFallback\n        [ do  Space.checkIndent end1 E.TIndentStart -- should never trigger\n              word2 0x2D 0x3E {-->-} E.TStart -- could just be another type instead\n              Space.chompAndCheckIndent E.TSpace E.TIndentStart\n              (tipe2, end2) <- expression\n              let tipe = A.at start end2 (Src.TLambda tipe1 tipe2)\n              return ( tipe, end2 )\n        ]\n        term1\n\n\n\n-- TYPE CONSTRUCTORS\n\n\napp :: A.Position -> Space.Parser E.Type Src.Type\napp start =\n  do  upper <- Var.foreignUpper E.TStart\n      upperEnd <- getPosition\n      Space.chomp E.TSpace\n      (args, end) <- chompArgs [] upperEnd\n\n      let region = A.Region start upperEnd\n      let tipe =\n            case upper of\n              Var.Unqualified name ->\n                Src.TType region name args\n\n              Var.Qualified home name ->\n                Src.TTypeQual region home name args\n\n      return ( A.at start end tipe, end )\n\n\nchompArgs :: [Src.Type] -> A.Position -> Space.Parser E.Type [Src.Type]\nchompArgs args end =\n  oneOfWithFallback\n    [ do  Space.checkIndent end E.TIndentStart\n          arg <- term\n          newEnd <- getPosition\n          Space.chomp E.TSpace\n          chompArgs (arg:args) newEnd\n    ]\n    (reverse args, end)\n\n\n\n-- TUPLES\n\n\nchompTupleEnd :: A.Position -> Src.Type -> [Src.Type] -> Parser E.TTuple Src.Type\nchompTupleEnd start firstType revTypes =\n  oneOf E.TTupleEnd\n    [ do  word1 0x2C {-,-} E.TTupleEnd\n          Space.chompAndCheckIndent E.TTupleSpace E.TTupleIndentTypeN\n          (tipe, end) <- specialize E.TTupleType expression\n          Space.checkIndent end E.TTupleIndentEnd\n          chompTupleEnd start firstType (tipe : revTypes)\n    , do  word1 0x29 {-)-} E.TTupleEnd\n          case reverse revTypes of\n            [] ->\n              return firstType\n\n            secondType : otherTypes ->\n              addEnd start (Src.TTuple firstType secondType otherTypes)\n    ]\n\n\n\n-- RECORD\n\n\ntype Field = ( A.Located Name.Name, Src.Type )\n\n\nchompRecordEnd :: [Field] -> Parser E.TRecord [Field]\nchompRecordEnd fields =\n  oneOf E.TRecordEnd\n    [ do  word1 0x2C {-,-} E.TRecordEnd\n          Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentField\n          field <- chompField\n          chompRecordEnd (field : fields)\n    , do  word1 0x7D {-}-} E.TRecordEnd\n          return (reverse fields)\n    ]\n\n\nchompField :: Parser E.TRecord Field\nchompField =\n  do  name <- addLocation (Var.lower E.TRecordField)\n      Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentColon\n      word1 0x3A {-:-} E.TRecordColon\n      Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentType\n      (tipe, end) <- specialize E.TRecordType expression\n      Space.checkIndent end E.TRecordIndentEnd\n      return (name, tipe)\n\n\n\n-- VARIANT\n\n\nvariant :: Space.Parser E.CustomType (A.Located Name.Name, [Src.Type])\nvariant =\n  do  name@(A.At (A.Region _ nameEnd) _) <- addLocation (Var.upper E.CT_Variant)\n      Space.chomp E.CT_Space\n      (args, end) <- specialize E.CT_VariantArg (chompArgs [] nameEnd)\n      return ( (name, args), end )\n"
  },
  {
    "path": "compiler/src/Parse/Variable.hs",
    "content": "{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}\nmodule Parse.Variable\n  ( lower\n  , upper\n  , moduleName\n  , Upper(..)\n  , foreignUpper\n  , foreignAlpha\n  , chompInnerChars\n  , getUpperWidth\n  , getInnerWidth\n  , getInnerWidthHelp\n  , reservedWords\n  )\n  where\n\n\nimport qualified Data.Char as Char\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\nimport Data.Word (Word8)\nimport Foreign.Ptr (Ptr, plusPtr)\nimport GHC.Exts (Char(C#), Int#, (+#), (-#), chr#, uncheckedIShiftL#, word2Int#, word8ToWord#)\nimport GHC.Word (Word8(W8#))\n\nimport qualified AST.Source as Src\nimport Parse.Primitives (Parser, Row, Col, unsafeIndex)\nimport qualified Parse.Primitives as P\n\n\n\n-- LOCAL UPPER\n\n\nupper :: (Row -> Col -> x) -> Parser x Name.Name\nupper toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let (# newPos, newCol #) = chompUpper pos end col in\n    if pos == newPos then\n      eerr row col toError\n    else\n      let !name = Name.fromPtr pos newPos in\n      cok name (P.State src newPos end indent row newCol)\n\n\n\n-- LOCAL LOWER\n\n\nlower :: (Row -> Col -> x) -> Parser x Name.Name\nlower toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let (# newPos, newCol #) = chompLower pos end col in\n    if pos == newPos then\n      eerr row col toError\n    else\n      let !name = Name.fromPtr pos newPos in\n      if Set.member name reservedWords then\n        eerr row col toError\n      else\n        let\n          !newState =\n            P.State src newPos end indent row newCol\n        in\n        cok name newState\n\n\n{-# NOINLINE reservedWords #-}\nreservedWords :: Set.Set Name.Name  -- PERF try using a trie instead\nreservedWords =\n  Set.fromList\n    [ \"if\", \"then\", \"else\"\n    , \"case\", \"of\"\n    , \"let\", \"in\"\n    , \"type\"\n    , \"module\", \"where\"\n    , \"import\", \"exposing\"\n    , \"as\"\n    , \"port\"\n    ]\n\n\n\n-- MODULE NAME\n\n\nmoduleName :: (Row -> Col -> x) -> Parser x Name.Name\nmoduleName toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ cerr eerr ->\n    let\n      (# pos1, col1 #) = chompUpper pos end col\n    in\n    if pos == pos1 then\n      eerr row col toError\n    else\n      let\n        (# status, newPos, newCol #) = moduleNameHelp pos1 end col1\n      in\n      case status of\n        Good ->\n          let\n            !name = Name.fromPtr pos newPos\n            !newState = P.State src newPos end indent row newCol\n          in\n          cok name newState\n\n        Bad ->\n          cerr row newCol toError\n\n\ndata ModuleNameStatus\n  = Good\n  | Bad\n\n\nmoduleNameHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# ModuleNameStatus, Ptr Word8, Col #)\nmoduleNameHelp pos end col =\n  if isDot pos end then\n    let\n      !pos1 = plusPtr pos 1\n      (# newPos, newCol #) = chompUpper pos1 end (col + 1)\n    in\n    if pos1 == newPos then\n      (# Bad, newPos, newCol #)\n    else\n      moduleNameHelp newPos end newCol\n\n  else\n    (# Good, pos, col #)\n\n\n\n-- FOREIGN UPPER\n\n\ndata Upper\n  = Unqualified Name.Name\n  | Qualified Name.Name Name.Name\n\n\nforeignUpper :: (Row -> Col -> x) -> Parser x Upper\nforeignUpper toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let (# upperStart, upperEnd, newCol #) = foreignUpperHelp pos end col in\n    if upperStart == upperEnd then\n      eerr row newCol toError\n    else\n      let\n        !newState = P.State src upperEnd end indent row newCol\n        !name = Name.fromPtr upperStart upperEnd\n        !upperName =\n          if upperStart == pos then\n            Unqualified name\n          else\n            let !home = Name.fromPtr pos (plusPtr upperStart (-1)) in\n            Qualified home name\n      in\n      cok upperName newState\n\n\nforeignUpperHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Ptr Word8, Col #)\nforeignUpperHelp pos end col =\n  let\n    (# newPos, newCol #) = chompUpper pos end col\n  in\n  if pos == newPos then\n    (# pos, pos, col #)\n\n  else if isDot newPos end then\n    foreignUpperHelp (plusPtr newPos 1) end (newCol + 1)\n\n  else\n    (# pos, newPos, newCol #)\n\n\n\n-- FOREIGN ALPHA\n\n\nforeignAlpha :: (Row -> Col -> x) -> Parser x Src.Expr_\nforeignAlpha toError =\n  P.Parser $ \\(P.State src pos end indent row col) cok _ _ eerr ->\n    let (# alphaStart, alphaEnd, newCol, varType #) = foreignAlphaHelp pos end col in\n    if alphaStart == alphaEnd then\n      eerr row newCol toError\n    else\n      let\n        !newState = P.State src alphaEnd end indent row newCol\n        !name = Name.fromPtr alphaStart alphaEnd\n      in\n      if alphaStart == pos then\n        if Set.member name reservedWords then\n          eerr row col toError\n        else\n          cok (Src.Var varType name) newState\n      else\n        let !home = Name.fromPtr pos (plusPtr alphaStart (-1)) in\n        cok (Src.VarQual varType home name) newState\n\n\nforeignAlphaHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Ptr Word8, Col, Src.VarType #)\nforeignAlphaHelp pos end col =\n  let\n    (# lowerPos, lowerCol #) = chompLower pos end col\n  in\n  if pos < lowerPos then\n    (# pos, lowerPos, lowerCol, Src.LowVar #)\n\n  else\n    let\n      (# upperPos, upperCol #) = chompUpper pos end col\n    in\n    if pos == upperPos then\n      (# pos, pos, col, Src.CapVar #)\n\n    else if isDot upperPos end then\n      foreignAlphaHelp (plusPtr upperPos 1) end (upperCol + 1)\n\n    else\n      (# pos, upperPos, upperCol, Src.CapVar #)\n\n\n\n---- CHAR CHOMPERS ----\n\n\n\n-- DOTS\n\n\n{-# INLINE isDot #-}\nisDot :: Ptr Word8 -> Ptr Word8 -> Bool\nisDot pos end =\n  pos < end && unsafeIndex pos == 0x2e {- . -}\n\n\n\n-- UPPER CHARS\n\n\nchompUpper :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Col #)\nchompUpper pos end col =\n  let !width = getUpperWidth pos end in\n  if width == 0 then\n    (# pos, col #)\n  else\n    chompInnerChars (plusPtr pos width) end (col + 1)\n\n\n{-# INLINE getUpperWidth #-}\ngetUpperWidth :: Ptr Word8 -> Ptr Word8 -> Int\ngetUpperWidth pos end =\n  if pos < end then\n    getUpperWidthHelp pos end (unsafeIndex pos)\n  else\n    0\n\n\n{-# INLINE getUpperWidthHelp #-}\ngetUpperWidthHelp :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int\ngetUpperWidthHelp pos _ word\n  | 0x41 {- A -} <= word && word <= 0x5A {- Z -} = 1\n  | word < 0xc0 = 0\n  | word < 0xe0 = if Char.isUpper (chr2 pos word) then 2 else 0\n  | word < 0xf0 = if Char.isUpper (chr3 pos word) then 3 else 0\n  | word < 0xf8 = if Char.isUpper (chr4 pos word) then 4 else 0\n  | True        = 0\n\n\n\n-- LOWER CHARS\n\n\nchompLower :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Col #)\nchompLower pos end col =\n  let !width = getLowerWidth pos end in\n  if width == 0 then\n    (# pos, col #)\n  else\n    chompInnerChars (plusPtr pos width) end (col + 1)\n\n\n{-# INLINE getLowerWidth #-}\ngetLowerWidth :: Ptr Word8 -> Ptr Word8 -> Int\ngetLowerWidth pos end =\n  if pos < end then\n    getLowerWidthHelp pos end (unsafeIndex pos)\n  else\n    0\n\n\n{-# INLINE getLowerWidthHelp #-}\ngetLowerWidthHelp :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int\ngetLowerWidthHelp pos _ word\n  | 0x61 {- a -} <= word && word <= 0x7A {- z -} = 1\n  | word < 0xc0 = 0\n  | word < 0xe0 = if Char.isLower (chr2 pos word) then 2 else 0\n  | word < 0xf0 = if Char.isLower (chr3 pos word) then 3 else 0\n  | word < 0xf8 = if Char.isLower (chr4 pos word) then 4 else 0\n  | True        = 0\n\n\n\n-- INNER CHARS\n\n\nchompInnerChars :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Col #)\nchompInnerChars !pos end !col =\n  let !width = getInnerWidth pos end in\n  if width == 0 then\n    (# pos, col #)\n  else\n    chompInnerChars (plusPtr pos width) end (col + 1)\n\n\ngetInnerWidth :: Ptr Word8 -> Ptr Word8 -> Int\ngetInnerWidth pos end =\n  if pos < end then\n    getInnerWidthHelp pos end (unsafeIndex pos)\n  else\n    0\n\n\n{-# INLINE getInnerWidthHelp #-}\ngetInnerWidthHelp :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int\ngetInnerWidthHelp pos _ word\n  | 0x61 {- a -} <= word && word <= 0x7A {- z -} = 1\n  | 0x41 {- A -} <= word && word <= 0x5A {- Z -} = 1\n  | 0x30 {- 0 -} <= word && word <= 0x39 {- 9 -} = 1\n  | word == 0x5F {- _ -} = 1\n  | word < 0xc0 = 0\n  | word < 0xe0 = if Char.isAlpha (chr2 pos word) then 2 else 0\n  | word < 0xf0 = if Char.isAlpha (chr3 pos word) then 3 else 0\n  | word < 0xf8 = if Char.isAlpha (chr4 pos word) then 4 else 0\n  | True        = 0\n\n\n\n-- EXTRACT CHARACTERS\n\n\n{-# INLINE chr2 #-}\nchr2 :: Ptr Word8 -> Word8 -> Char\nchr2 pos firstWord =\n  let\n    !i1# = unpack firstWord\n    !i2# = unpack (unsafeIndex (plusPtr pos 1))\n    !c1# = uncheckedIShiftL# (i1# -# 0xC0#) 6#\n    !c2# = i2# -# 0x80#\n  in\n  C# (chr# (c1# +# c2#))\n\n\n{-# INLINE chr3 #-}\nchr3 :: Ptr Word8 -> Word8 -> Char\nchr3 pos firstWord =\n  let\n    !i1# = unpack firstWord\n    !i2# = unpack (unsafeIndex (plusPtr pos 1))\n    !i3# = unpack (unsafeIndex (plusPtr pos 2))\n    !c1# = uncheckedIShiftL# (i1# -# 0xE0#) 12#\n    !c2# = uncheckedIShiftL# (i2# -# 0x80#) 6#\n    !c3# = i3# -# 0x80#\n  in\n  C# (chr# (c1# +# c2# +# c3#))\n\n\n{-# INLINE chr4 #-}\nchr4 :: Ptr Word8 -> Word8 -> Char\nchr4 pos firstWord =\n  let\n    !i1# = unpack firstWord\n    !i2# = unpack (unsafeIndex (plusPtr pos 1))\n    !i3# = unpack (unsafeIndex (plusPtr pos 2))\n    !i4# = unpack (unsafeIndex (plusPtr pos 3))\n    !c1# = uncheckedIShiftL# (i1# -# 0xF0#) 18#\n    !c2# = uncheckedIShiftL# (i2# -# 0x80#) 12#\n    !c3# = uncheckedIShiftL# (i3# -# 0x80#) 6#\n    !c4# = i4# -# 0x80#\n  in\n  C# (chr# (c1# +# c2# +# c3# +# c4#))\n\n\nunpack :: Word8 -> Int#\nunpack (W8# word#) =\n  word2Int# (word8ToWord# word#)\n"
  },
  {
    "path": "compiler/src/Reporting/Annotation.hs",
    "content": "module Reporting.Annotation\n  ( Located(..)\n  , Position(..)\n  , Region(..)\n  , traverse\n  , toValue\n  , merge\n  , at\n  , toRegion\n  , mergeRegions\n  , zero\n  , one\n  )\n  where\n\n\nimport Prelude hiding (traverse)\nimport Control.Monad (liftM2)\nimport Data.Binary (Binary, get, put)\nimport Data.Word (Word16)\n\n\n\n-- LOCATED\n\n\ndata Located a =\n  At Region a  -- PERF see if unpacking region is helpful\n\n\ninstance Functor Located where\n  fmap f (At region a) =\n    At region (f a)\n\n\ntraverse :: (Functor f) => (a -> f b) -> Located a -> f (Located b)\ntraverse func (At region value) =\n  At region <$> func value\n\n\ntoValue :: Located a -> a\ntoValue (At _ value) =\n  value\n\n\nmerge :: Located a -> Located b -> value -> Located value\nmerge (At r1 _) (At r2 _) value =\n  At (mergeRegions r1 r2) value\n\n\n\n-- POSITION\n\n\ndata Position =\n  Position\n    {-# UNPACK #-} !Word16\n    {-# UNPACK #-} !Word16\n  deriving (Eq)\n\n\nat :: Position -> Position -> a -> Located a\nat start end a =\n  At (Region start end) a\n\n\n\n-- REGION\n\n\ndata Region = Region Position Position\n  deriving (Eq)\n\n\ntoRegion :: Located a -> Region\ntoRegion (At region _) =\n  region\n\n\nmergeRegions :: Region -> Region -> Region\nmergeRegions (Region start _) (Region _ end) =\n  Region start end\n\n\nzero :: Region\nzero =\n  Region (Position 0 0) (Position 0 0)\n\n\none :: Region\none =\n  Region (Position 1 1) (Position 1 1)\n\n\ninstance Binary Region where\n  put (Region a b) = put a >> put b\n  get = liftM2 Region get get\n\n\ninstance Binary Position where\n  put (Position a b) = put a >> put b\n  get = liftM2 Position get get\n"
  },
  {
    "path": "compiler/src/Reporting/Doc.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Doc\n  ( P.Doc\n  , (P.<+>), (<>)\n  , P.align, P.cat, P.empty, P.fill, P.fillSep, P.hang\n  , P.hcat, P.hsep, P.indent, P.sep, P.vcat\n  , P.red, P.cyan, P.magenta, P.green, P.blue, P.black, P.yellow\n  , P.dullred, P.dullcyan, P.dullyellow\n  --\n  , fromChars\n  , fromName\n  , fromVersion\n  , fromPackage\n  , fromInt\n  --\n  , toAnsi\n  , toString\n  , toLine\n  --\n  , encode\n  --\n  , stack\n  , reflow\n  , commaSep\n  --\n  , toSimpleNote\n  , toFancyNote\n  , toSimpleHint\n  , toFancyHint\n  --\n  , link\n  , fancyLink\n  , reflowLink\n  , makeLink\n  , makeNakedLink\n  --\n  , args\n  , moreArgs\n  , ordinal\n  , intToOrdinal\n  , cycle\n  )\n  where\n\n\nimport Prelude hiding (cycle)\nimport qualified Data.List as List\nimport qualified Data.Name as Name\nimport qualified System.Console.ANSI.Types as Ansi\nimport qualified System.Info as Info\nimport System.IO (Handle)\nimport qualified Text.PrettyPrint.ANSI.Leijen as P\n\nimport qualified Data.Index as Index\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport Json.Encode ((==>))\nimport qualified Json.Encode as E\nimport qualified Json.String as Json\n\n\n\n-- FROM\n\n\nfromChars :: String -> P.Doc\nfromChars =\n  P.text\n\n\nfromName :: Name.Name -> P.Doc\nfromName name =\n  P.text (Name.toChars name)\n\n\nfromVersion :: V.Version -> P.Doc\nfromVersion vsn =\n  P.text (V.toChars vsn)\n\n\nfromPackage :: Pkg.Name -> P.Doc\nfromPackage pkg =\n  P.text (Pkg.toChars pkg)\n\n\nfromInt :: Int -> P.Doc\nfromInt n =\n  P.text (show n)\n\n\n\n-- TO STRING\n\n\ntoAnsi :: Handle -> P.Doc -> IO ()\ntoAnsi handle doc =\n  P.displayIO handle (P.renderPretty 1 80 doc)\n\n\ntoString :: P.Doc -> String\ntoString doc =\n  P.displayS (P.renderPretty 1 80 (P.plain doc)) \"\"\n\n\ntoLine :: P.Doc -> String\ntoLine doc =\n  P.displayS (P.renderPretty 1 (div maxBound 2) (P.plain doc)) \"\"\n\n\n\n-- FORMATTING\n\n\nstack :: [P.Doc] -> P.Doc\nstack docs =\n  P.vcat (List.intersperse \"\" docs)\n\n\nreflow :: String -> P.Doc\nreflow paragraph =\n  P.fillSep (map P.text (words paragraph))\n\n\ncommaSep :: P.Doc -> (P.Doc -> P.Doc) -> [P.Doc] -> [P.Doc]\ncommaSep conjunction addStyle names =\n  case names of\n    [name] ->\n      [ addStyle name ]\n\n    [name1,name2] ->\n      [ addStyle name1, conjunction, addStyle name2 ]\n\n    _ ->\n      map (\\name -> addStyle name <> \",\") (init names)\n      ++\n      [ conjunction\n      , addStyle (last names)\n      ]\n\n\n\n-- NOTES\n\n\ntoSimpleNote :: String -> P.Doc\ntoSimpleNote message =\n  toFancyNote (map P.text (words message))\n\n\ntoFancyNote :: [P.Doc] -> P.Doc\ntoFancyNote chunks =\n  P.fillSep (P.underline \"Note\" <> \":\" : chunks)\n\n\n\n-- HINTS\n\n\ntoSimpleHint :: String -> P.Doc\ntoSimpleHint message =\n  toFancyHint (map P.text (words message))\n\n\ntoFancyHint :: [P.Doc] -> P.Doc\ntoFancyHint chunks =\n  P.fillSep (P.underline \"Hint\" <> \":\" : chunks)\n\n\n\n-- LINKS\n\n\nlink :: String -> String -> String -> String -> P.Doc\nlink word before fileName after =\n  P.fillSep $\n    (P.underline (P.text word) <> \":\")\n    : map P.text (words before)\n    ++ P.text (makeLink fileName)\n    : map P.text (words after)\n\n\nfancyLink :: String -> [P.Doc] -> String -> [P.Doc] -> P.Doc\nfancyLink word before fileName after =\n  P.fillSep $\n    (P.underline (P.text word) <> \":\") : before ++ P.text (makeLink fileName) : after\n\n\nmakeLink :: [Char] -> [Char]\nmakeLink fileName =\n  \"<https://elm-lang.org/\" <> V.toChars V.compiler <> \"/\" <> fileName <> \">\"\n\n\nmakeNakedLink :: [Char] -> [Char]\nmakeNakedLink fileName =\n  \"https://elm-lang.org/\" <> V.toChars V.compiler <> \"/\" <> fileName\n\n\nreflowLink :: [Char] -> [Char] -> [Char] -> P.Doc\nreflowLink before fileName after =\n  P.fillSep $\n    map P.text (words before)\n    ++ P.text (makeLink fileName)\n    : map P.text (words after)\n\n\n\n-- HELPERS\n\n\nargs :: Int -> String\nargs n =\n  show n <> if n == 1 then \" argument\" else \" arguments\"\n\n\nmoreArgs :: Int -> String\nmoreArgs n =\n  show n <> \" more\" <> if n == 1 then \" argument\" else \" arguments\"\n\n\nordinal :: Index.ZeroBased -> String\nordinal index =\n  intToOrdinal (Index.toHuman index)\n\n\nintToOrdinal :: Int -> String\nintToOrdinal number =\n  let\n    remainder10 =\n      number `mod` 10\n\n    remainder100 =\n      number `mod` 100\n\n    ending\n      | remainder100 `elem` [11..13] = \"th\"\n      | remainder10 == 1             = \"st\"\n      | remainder10 == 2             = \"nd\"\n      | remainder10 == 3             = \"rd\"\n      | otherwise                    = \"th\"\n  in\n    show number <> ending\n\n\n\ncycle :: Int -> Name.Name -> [Name.Name] -> P.Doc\ncycle indent name names =\n  let\n    toLn n = cycleLn <> P.dullyellow (fromName n)\n  in\n  P.indent indent $ P.vcat $\n    cycleTop : List.intersperse cycleMid (toLn name : map toLn names) ++ [ cycleEnd ]\n\n\ncycleTop, cycleLn, cycleMid, cycleEnd :: P.Doc\ncycleTop = if isWindows then \"+-----+\" else \"┌─────┐\"\ncycleLn  = if isWindows then \"|    \"   else \"│    \"\ncycleMid = if isWindows then \"|     |\" else \"│     ↓\"\ncycleEnd = if isWindows then \"+-<---+\" else \"└─────┘\"\n\n\nisWindows :: Bool\nisWindows =\n  Info.os == \"mingw32\"\n\n\n\n-- JSON\n\n\nencode :: P.Doc -> E.Value\nencode doc =\n  E.array (toJsonHelp noStyle [] (P.renderPretty 1 80 doc))\n\n\ndata Style =\n  Style\n    { _bold :: Bool\n    , _underline :: Bool\n    , _color :: Maybe Color\n    }\n\n\nnoStyle :: Style\nnoStyle =\n  Style False False Nothing\n\n\ndata Color\n  = Red\n  | RED\n  | Magenta\n  | MAGENTA\n  | Yellow\n  | YELLOW\n  | Green\n  | GREEN\n  | Cyan\n  | CYAN\n  | Blue\n  | BLUE\n  | Black\n  | BLACK\n  | White\n  | WHITE\n\n\ntoJsonHelp :: Style -> [String] -> P.SimpleDoc -> [E.Value]\ntoJsonHelp style revChunks simpleDoc =\n  case simpleDoc of\n    P.SFail ->\n      error $\n        \"according to the main implementation, @SFail@ can not\\\n        \\ appear uncaught in a rendered @SimpleDoc@\"\n\n    P.SEmpty ->\n      [ encodeChunks style revChunks ]\n\n    P.SChar char rest ->\n      toJsonHelp style ([char] : revChunks) rest\n\n    P.SText _ string rest ->\n      toJsonHelp style (string : revChunks) rest\n\n    P.SLine indent rest ->\n      toJsonHelp style (replicate indent ' ' : \"\\n\" : revChunks) rest\n\n    P.SSGR sgrs rest ->\n      encodeChunks style revChunks : toJsonHelp (sgrToStyle sgrs style) [] rest\n\n\nsgrToStyle :: [Ansi.SGR] -> Style -> Style\nsgrToStyle sgrs style@(Style bold underline color) =\n  case sgrs of\n    [] ->\n      style\n\n    sgr : rest ->\n      sgrToStyle rest $\n        case sgr of\n          Ansi.Reset                         -> noStyle\n          Ansi.SetConsoleIntensity i         -> Style (isBold i) underline color\n          Ansi.SetItalicized _               -> style\n          Ansi.SetUnderlining u              -> Style bold (isUnderline u) color\n          Ansi.SetBlinkSpeed _               -> style\n          Ansi.SetVisible _                  -> style\n          Ansi.SetSwapForegroundBackground _ -> style\n          Ansi.SetColor l i c                -> Style bold underline (toColor l i c)\n          Ansi.SetRGBColor _ _               -> style\n          Ansi.SetPaletteColor _ _           -> style\n          Ansi.SetDefaultColor _             -> style\n\n\nisBold :: Ansi.ConsoleIntensity -> Bool\nisBold intensity =\n  case intensity of\n    Ansi.BoldIntensity -> True\n    Ansi.FaintIntensity -> False\n    Ansi.NormalIntensity -> False\n\n\nisUnderline :: Ansi.Underlining -> Bool\nisUnderline underlining =\n  case underlining of\n    Ansi.SingleUnderline -> True\n    Ansi.DoubleUnderline -> False\n    Ansi.NoUnderline -> False\n\n\ntoColor :: Ansi.ConsoleLayer -> Ansi.ColorIntensity -> Ansi.Color -> Maybe Color\ntoColor layer intensity color =\n  case layer of\n    Ansi.Background ->\n      Nothing\n\n    Ansi.Foreground ->\n      let\n        pick dull vivid =\n          case intensity of\n            Ansi.Dull -> dull\n            Ansi.Vivid -> vivid\n      in\n      Just $\n        case color of\n          Ansi.Red     -> pick Red     RED\n          Ansi.Magenta -> pick Magenta MAGENTA\n          Ansi.Yellow  -> pick Yellow  YELLOW\n          Ansi.Green   -> pick Green   GREEN\n          Ansi.Cyan    -> pick Cyan    CYAN\n          Ansi.Blue    -> pick Blue    BLUE\n          Ansi.White   -> pick White   WHITE\n          Ansi.Black   -> pick Black   BLACK\n\n\nencodeChunks :: Style -> [String] -> E.Value\nencodeChunks (Style bold underline color) revChunks =\n  let\n    chars = concat (reverse revChunks)\n  in\n  case color of\n    Nothing | not bold && not underline ->\n      E.chars chars\n\n    _ ->\n      E.object\n        [ \"bold\" ==> E.bool bold\n        , \"underline\" ==> E.bool underline\n        , \"color\" ==> maybe E.null encodeColor color\n        , \"string\" ==> E.chars chars\n        ]\n\n\nencodeColor :: Color -> E.Value\nencodeColor color =\n  E.string $ Json.fromChars $\n    case color of\n      Red -> \"red\"\n      RED -> \"RED\"\n      Magenta -> \"magenta\"\n      MAGENTA -> \"MAGENTA\"\n      Yellow -> \"yellow\"\n      YELLOW -> \"YELLOW\"\n      Green -> \"green\"\n      GREEN -> \"GREEN\"\n      Cyan -> \"cyan\"\n      CYAN -> \"CYAN\"\n      Blue -> \"blue\"\n      BLUE -> \"BLUE\"\n      Black -> \"black\"\n      BLACK -> \"BLACK\"\n      White -> \"white\"\n      WHITE -> \"WHITE\"\n"
  },
  {
    "path": "compiler/src/Reporting/Error/Canonicalize.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Error.Canonicalize\n  ( Error(..)\n  , BadArityContext(..)\n  , InvalidPayload(..)\n  , PortProblem(..)\n  , DuplicatePatternContext(..)\n  , PossibleNames(..)\n  , VarKind(..)\n  , toReport\n  )\n  where\n\n\nimport qualified Data.Char as Char\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport qualified Data.OneOrMore as OneOrMore\nimport qualified Data.Set as Set\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Source as Src\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport Reporting.Doc (Doc, (<+>))\nimport qualified Reporting.Render.Code as Code\nimport qualified Reporting.Render.Type as RT\nimport qualified Reporting.Report as Report\nimport qualified Reporting.Suggest as Suggest\n\n\n\n-- CANONICALIZATION ERRORS\n\n\ndata Error\n  = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int\n  | AmbiguousVar A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)\n  | AmbiguousType A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)\n  | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)\n  | AmbiguousBinop A.Region Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)\n  | BadArity A.Region BadArityContext Name.Name Int Int\n  | Binop A.Region Name.Name Name.Name\n  | DuplicateDecl Name.Name A.Region A.Region\n  | DuplicateType Name.Name A.Region A.Region\n  | DuplicateCtor Name.Name A.Region A.Region\n  | DuplicateBinop Name.Name A.Region A.Region\n  | DuplicateField Name.Name A.Region A.Region\n  | DuplicateAliasArg Name.Name Name.Name A.Region A.Region\n  | DuplicateUnionArg Name.Name Name.Name A.Region A.Region\n  | DuplicatePattern DuplicatePatternContext Name.Name A.Region A.Region\n  | EffectNotFound A.Region Name.Name\n  | EffectFunctionNotFound A.Region Name.Name\n  | ExportDuplicate Name.Name A.Region A.Region\n  | ExportNotFound A.Region VarKind Name.Name [Name.Name]\n  | ExportOpenAlias A.Region Name.Name\n  | ImportCtorByName A.Region Name.Name Name.Name\n  | ImportNotFound A.Region Name.Name [ModuleName.Canonical]\n  | ImportOpenAlias A.Region Name.Name\n  | ImportExposingNotFound A.Region ModuleName.Canonical Name.Name [Name.Name]\n  | NotFoundVar A.Region (Maybe Name.Name) Name.Name PossibleNames\n  | NotFoundType A.Region (Maybe Name.Name) Name.Name PossibleNames\n  | NotFoundVariant A.Region (Maybe Name.Name) Name.Name PossibleNames\n  | NotFoundBinop A.Region Name.Name (Set.Set Name.Name)\n  | PatternHasRecordCtor A.Region Name.Name\n  | PortPayloadInvalid A.Region Name.Name Can.Type InvalidPayload\n  | PortTypeInvalid A.Region Name.Name PortProblem\n  | RecursiveAlias A.Region Name.Name [Name.Name] Src.Type [Name.Name]\n  | RecursiveDecl A.Region Name.Name [Name.Name]\n  | RecursiveLet (A.Located Name.Name) [Name.Name]\n  | Shadowing Name.Name A.Region A.Region\n  | TupleLargerThanThree A.Region\n  | TypeVarsUnboundInUnion A.Region Name.Name [Name.Name] (Name.Name, A.Region) [(Name.Name, A.Region)]\n  | TypeVarsMessedUpInAlias A.Region Name.Name [Name.Name] [(Name.Name, A.Region)] [(Name.Name, A.Region)]\n\n\ndata BadArityContext\n  = TypeArity\n  | PatternArity\n\n\ndata DuplicatePatternContext\n  = DPLambdaArgs\n  | DPFuncArgs Name.Name\n  | DPCaseBranch\n  | DPLetBinding\n  | DPDestruct\n\n\ndata InvalidPayload\n  = ExtendedRecord\n  | Function\n  | TypeVariable Name.Name\n  | UnsupportedType Name.Name\n\n\ndata PortProblem\n  = CmdNoArg\n  | CmdExtraArgs Int\n  | CmdBadMsg\n  | SubBad\n  | NotCmdOrSub\n\n\ndata PossibleNames =\n  PossibleNames\n    { _locals :: Set.Set Name.Name\n    , _quals :: Map.Map Name.Name (Set.Set Name.Name)\n    }\n\n\n\n-- KIND\n\n\ndata VarKind\n  = BadOp\n  | BadVar\n  | BadPattern\n  | BadType\n\n\ntoKindInfo :: VarKind -> Name.Name -> ( Doc, Doc, Doc )\ntoKindInfo kind name =\n  case kind of\n    BadOp ->\n      ( \"an\", \"operator\", \"(\" <> D.fromName name <> \")\" )\n\n    BadVar ->\n      ( \"a\", \"value\", \"`\" <> D.fromName name <> \"`\" )\n\n    BadPattern ->\n      ( \"a\", \"pattern\", \"`\" <> D.fromName name <> \"`\" )\n\n    BadType ->\n      ( \"a\", \"type\", \"`\" <> D.fromName name <> \"`\" )\n\n\n\n-- TO REPORT\n\n\ntoReport :: Code.Source -> Error -> Report.Report\ntoReport source err =\n  case err of\n    AnnotationTooShort region name index leftovers ->\n      let\n        numTypeArgs = Index.toMachine index\n        numDefArgs = numTypeArgs + leftovers\n      in\n      Report.Report \"BAD TYPE ANNOTATION\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"The type annotation for `\" <> Name.toChars name <> \"` says it can accept \"\n              <> D.args numTypeArgs <> \", but the definition says it has \"\n              <> D.args numDefArgs <> \":\"\n          ,\n            D.reflow $\n              \"Is the type annotation missing something? Should some argument\"\n              <> (if leftovers == 1 then \"\" else \"s\")\n              <> \" be deleted? Maybe some parentheses are missing?\"\n          )\n\n    AmbiguousVar region maybePrefix name h hs ->\n      ambiguousName source region maybePrefix name h hs \"variable\"\n\n    AmbiguousType region maybePrefix name h hs ->\n      ambiguousName source region maybePrefix name h hs \"type\"\n\n    AmbiguousVariant region maybePrefix name h hs ->\n      ambiguousName source region maybePrefix name h hs \"variant\"\n\n    AmbiguousBinop region name h hs ->\n      ambiguousName source region Nothing name h hs \"operator\"\n\n    BadArity region badArityContext name expected actual ->\n      let\n        thing =\n          case badArityContext of\n            TypeArity    -> \"type\"\n            PatternArity -> \"variant\"\n      in\n      if actual < expected then\n        Report.Report \"TOO FEW ARGS\" region [] $\n          Code.toSnippet source region Nothing\n            (\n              D.reflow $\n                \"The `\" <> Name.toChars name <> \"` \" <> thing <> \" needs \"\n                <> D.args expected <> \", but I see \" <> show actual <> \" instead:\"\n            ,\n              D.reflow $\n                \"What is missing? Are some parentheses misplaced?\"\n            )\n\n      else\n        Report.Report \"TOO MANY ARGS\" region [] $\n          Code.toSnippet source region Nothing\n            (\n              D.reflow $\n                \"The `\" <> Name.toChars name <> \"` \" <> thing <> \" needs \"\n                <> D.args expected <> \", but I see \" <> show actual <> \" instead:\"\n            ,\n              if actual - expected == 1 then\n                \"Which is the extra one? Maybe some parentheses are missing?\"\n              else\n                \"Which are the extra ones? Maybe some parentheses are missing?\"\n            )\n\n    Binop region op1 op2 ->\n      Report.Report \"INFIX PROBLEM\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"You cannot mix (\" <> Name.toChars op1 <> \") and (\" <> Name.toChars op2 <> \") without parentheses.\"\n          ,\n            D.reflow\n              \"I do not know how to group these expressions. Add parentheses for me!\"\n          )\n\n    DuplicateDecl name r1 r2 ->\n      nameClash source r1 r2 $\n        \"This file has multiple `\" <> Name.toChars name <> \"` declarations.\"\n\n    DuplicateType name r1 r2 ->\n      nameClash source r1 r2 $\n        \"This file defines multiple `\" <> Name.toChars name <> \"` types.\"\n\n    DuplicateCtor name r1 r2 ->\n      nameClash source r1 r2 $\n        \"This file defines multiple `\" <> Name.toChars name <> \"` type constructors.\"\n\n    DuplicateBinop name r1 r2 ->\n      nameClash source r1 r2 $\n        \"This file defines multiple (\" <> Name.toChars name <> \") operators.\"\n\n    DuplicateField name r1 r2 ->\n      nameClash source r1 r2 $\n        \"This record has multiple `\" <> Name.toChars name <> \"` fields.\"\n\n    DuplicateAliasArg typeName name r1 r2 ->\n      nameClash source r1 r2 $\n        \"The `\" <> Name.toChars typeName <> \"` type alias has multiple `\" <> Name.toChars name <> \"` type variables.\"\n\n    DuplicateUnionArg typeName name r1 r2 ->\n      nameClash source r1 r2 $\n        \"The `\" <> Name.toChars typeName <> \"` type has multiple `\" <> Name.toChars name <> \"` type variables.\"\n\n    DuplicatePattern context name r1 r2 ->\n      nameClash source r1 r2 $\n        case context of\n          DPLambdaArgs ->\n            \"This anonymous function has multiple `\" <> Name.toChars name <> \"` arguments.\"\n\n          DPFuncArgs funcName ->\n            \"The `\" <> Name.toChars funcName <> \"` function has multiple `\" <> Name.toChars name <> \"` arguments.\"\n\n          DPCaseBranch ->\n            \"This `case` pattern has multiple `\" <> Name.toChars name <> \"` variables.\"\n\n          DPLetBinding ->\n            \"This `let` expression defines `\" <> Name.toChars name <> \"` more than once!\"\n\n          DPDestruct ->\n            \"This pattern contains multiple `\" <> Name.toChars name <> \"` variables.\"\n\n    EffectNotFound region name ->\n      Report.Report \"EFFECT PROBLEM\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"You have declared that `\" ++ Name.toChars name ++ \"` is an effect type:\"\n          ,\n            D.reflow $\n              \"But I cannot find a custom type named `\" ++ Name.toChars name ++ \"` in this file!\"\n          )\n\n    EffectFunctionNotFound region name ->\n      Report.Report \"EFFECT PROBLEM\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"This kind of effect module must define a `\" ++ Name.toChars name ++ \"` function.\"\n          ,\n            D.reflow $\n              \"But I cannot find `\" ++ Name.toChars name ++ \"` in this file!\"\n          )\n\n\n    ExportDuplicate name r1 r2 ->\n      let\n        messageThatEndsWithPunctuation =\n          \"You are trying to expose `\" <> Name.toChars name <> \"` multiple times!\"\n      in\n      Report.Report \"REDUNDANT EXPORT\" r2 [] $\n        Code.toPair source r1 r2\n          (\n            D.reflow messageThatEndsWithPunctuation\n          ,\n            \"Remove one of them and you should be all set!\"\n          )\n          (\n            D.reflow (messageThatEndsWithPunctuation <> \" Once here:\")\n          ,\n            \"And again right here:\"\n          ,\n            \"Remove one of them and you should be all set!\"\n          )\n\n    ExportNotFound region kind rawName possibleNames ->\n      let\n        suggestions =\n          map Name.toChars $ take 4 $\n            Suggest.sort (Name.toChars rawName) Name.toChars possibleNames\n      in\n      Report.Report \"UNKNOWN EXPORT\" region suggestions $\n        let (a, thing, name) = toKindInfo kind rawName in\n        D.stack\n          [ D.fillSep\n              [\"You\",\"are\",\"trying\",\"to\",\"expose\",a,thing,\"named\"\n              ,name,\"but\",\"I\",\"cannot\",\"find\",\"its\",\"definition.\"\n              ]\n          , case map D.fromChars suggestions of\n              [] ->\n                D.reflow $\n                  \"I do not see any super similar names in this file. Is the definition missing?\"\n\n              [alt] ->\n                D.fillSep [\"Maybe\",\"you\",\"want\",D.dullyellow alt,\"instead?\"]\n\n              alts ->\n                D.stack\n                  [ \"These names seem close though:\"\n                  , D.indent 4 $ D.vcat $ map D.dullyellow alts\n                  ]\n          ]\n\n    ExportOpenAlias region name ->\n      Report.Report \"BAD EXPORT\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"The (..) syntax is for exposing variants of a custom type. It cannot be used with a type alias like `\"\n              ++ Name.toChars name ++ \"` though.\"\n          ,\n            D.reflow $\n              \"Remove the (..) and you should be fine!\"\n          )\n\n    ImportCtorByName region ctor tipe ->\n      Report.Report \"BAD IMPORT\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"You are trying to import the `\" <> Name.toChars ctor\n              <> \"` variant by name:\"\n          ,\n            D.fillSep\n              [\"Try\",\"importing\",D.green (D.fromName tipe <> \"(..)\"),\"instead.\"\n              ,\"The\",\"dots\",\"mean\",\"“expose\",\"the\",D.fromName tipe,\"type\",\"and\"\n              ,\"all\",\"its\",\"variants\",\"so\",\"it\",\"gives\",\"you\",\"access\",\"to\"\n              , D.fromName ctor <> \".\"\n              ]\n          )\n\n    ImportNotFound region name _ ->\n      --\n      -- NOTE: this should always be detected by `builder`\n      -- So this error should never actually get printed out.\n      --\n      Report.Report \"UNKNOWN IMPORT\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I could not find a `\" <> Name.toChars name <> \"` module to import!\"\n          ,\n            mempty\n          )\n\n    ImportOpenAlias region name ->\n      Report.Report \"BAD IMPORT\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"The `\" <> Name.toChars name <> \"` type alias cannot be followed by (..) like this:\"\n          ,\n            D.reflow $\n              \"Remove the (..) and it should work.\"\n          )\n\n    ImportExposingNotFound region (ModuleName.Canonical _ home) value possibleNames ->\n      let\n        suggestions =\n          map Name.toChars $ take 4 $\n            Suggest.sort (Name.toChars home) Name.toChars possibleNames\n      in\n      Report.Report \"BAD IMPORT\" region suggestions $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"The `\" <> Name.toChars home\n              <> \"` module does not expose `\"\n              <> Name.toChars value <> \"`:\"\n          ,\n            case map D.fromChars suggestions of\n              [] ->\n                \"I cannot find any super similar exposed names. Maybe it is private?\"\n\n              [alt] ->\n                D.fillSep [\"Maybe\",\"you\",\"want\",D.dullyellow alt,\"instead?\"]\n\n              alts ->\n                D.stack\n                  [ \"These names seem close though:\"\n                  , D.indent 4 $ D.vcat $ map D.dullyellow alts\n                  ]\n          )\n\n    NotFoundVar region prefix name possibleNames ->\n      notFound source region prefix name \"variable\" possibleNames\n\n    NotFoundType region prefix name possibleNames ->\n      notFound source region prefix name \"type\" possibleNames\n\n    NotFoundVariant region prefix name possibleNames ->\n      notFound source region prefix name \"variant\" possibleNames\n\n    NotFoundBinop region op locals ->\n      if op == \"===\" then\n        Report.Report \"UNKNOWN OPERATOR\" region [\"==\"] $\n          Code.toSnippet source region Nothing\n            (\n              \"Elm does not have a (===) operator like JavaScript.\"\n            ,\n              \"Switch to (==) instead.\"\n            )\n\n      else if op == \"!=\" || op == \"!==\" then\n        Report.Report \"UNKNOWN OPERATOR\" region [\"/=\"] $\n          Code.toSnippet source region Nothing\n            (\n              D.reflow $\n                \"Elm uses a different name for the “not equal” operator:\"\n            ,\n              D.stack\n                [ D.reflow \"Switch to (/=) instead.\"\n                , D.toSimpleNote $\n                    \"Our (/=) operator is supposed to look like a real “not equal” sign (≠). I hope that history will remember (\"\n                    ++ Name.toChars op ++ \") as a weird and temporary choice.\"\n                ]\n            )\n\n      else if op == \"**\" then\n        Report.Report \"UNKNOWN OPERATOR\" region [\"^\",\"*\"] $\n          Code.toSnippet source region Nothing\n            (\n              D.reflow $\n                \"I do not recognize the (**) operator:\"\n            ,\n              D.reflow $\n                \"Switch to (^) for exponentiation. Or switch to (*) for multiplication.\"\n            )\n\n      else if op == \"%\" then\n        Report.Report \"UNKNOWN OPERATOR\" region [] $\n          Code.toSnippet source region Nothing\n            (\n              D.reflow $\n                \"Elm does not use (%) as the remainder operator:\"\n            ,\n              D.stack\n                [ D.reflow $\n                    \"If you want the behavior of (%) like in JavaScript, switch to:\\\n                    \\ <https://package.elm-lang.org/packages/elm/core/latest/Basics#remainderBy>\"\n                , D.reflow $\n                    \"If you want modular arithmetic like in math, switch to:\\\n                    \\ <https://package.elm-lang.org/packages/elm/core/latest/Basics#modBy>\"\n                , D.reflow $\n                    \"The difference is how things work when negative numbers are involved.\"\n                ]\n            )\n\n      else\n        let\n          suggestions =\n            map Name.toChars $ take 2 $\n              Suggest.sort (Name.toChars op) Name.toChars (Set.toList locals)\n\n          format altOp =\n            D.green $ \"(\" <> altOp <> \")\"\n        in\n        Report.Report \"UNKNOWN OPERATOR\" region suggestions $\n          Code.toSnippet source region Nothing\n            (\n              D.reflow $\n                \"I do not recognize the (\" ++ Name.toChars op ++ \") operator.\"\n            ,\n              D.fillSep $\n                [\"Is\",\"there\",\"an\",\"`import`\",\"and\",\"`exposing`\",\"entry\",\"for\",\"it?\"]\n                ++\n                  case map D.fromChars suggestions of\n                    [] ->\n                      []\n\n                    alts ->\n                      [\"Maybe\",\"you\",\"want\"] ++ D.commaSep \"or\" format alts ++ [\"instead?\"]\n            )\n\n    PatternHasRecordCtor region name ->\n      Report.Report \"BAD PATTERN\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"You can construct records by using `\" <> Name.toChars name\n              <> \"` as a function, but it is not available in pattern matching like this:\"\n          ,\n            D.reflow $\n              \"I recommend matching the record as a variable and unpacking it later.\"\n          )\n\n    PortPayloadInvalid region portName _badType invalidPayload ->\n      let\n        formatDetails (aBadKindOfThing, elaboration) =\n          Report.Report \"PORT ERROR\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                D.reflow $\n                  \"The `\" <> Name.toChars portName <> \"` port is trying to transmit \" <> aBadKindOfThing <> \":\"\n              ,\n                D.stack\n                  [ elaboration\n                  , D.link \"Hint\"\n                      \"Ports are not a traditional FFI, so if you have tons of annoying ports, definitely read\"\n                      \"ports\"\n                      \"to learn how they are meant to work. They require a different mindset!\"\n                  ]\n              )\n      in\n      formatDetails $\n        case invalidPayload of\n          ExtendedRecord ->\n            (\n              \"an extended record\"\n            ,\n              D.reflow $\n                \"But the exact shape of the record must be known at compile time. No type variables!\"\n            )\n\n          Function ->\n            (\n              \"a function\"\n            ,\n              D.reflow $\n                \"But functions cannot be sent in and out ports. If we allowed functions in from JS\\\n                \\ they may perform some side-effects. If we let functions out, they could produce\\\n                \\ incorrect results because Elm optimizations assume there are no side-effects.\"\n            )\n\n\n          TypeVariable name ->\n            (\n              \"an unspecified type\"\n            ,\n              D.reflow $\n                \"But type variables like `\" <> Name.toChars name <> \"` cannot flow through ports.\\\n                \\ I need to know exactly what type of data I am getting, so I can guarantee that\\\n                \\ unexpected data cannot sneak in and crash the Elm program.\"\n            )\n\n          UnsupportedType name ->\n            (\n              \"a `\" <> Name.toChars name <> \"` value\"\n            ,\n              D.stack\n                [ D.reflow $ \"I cannot handle that. The types that CAN flow in and out of Elm include:\"\n                , D.indent 4 $\n                    D.reflow $\n                      \"Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\\\n                      \\ tuples, records, and JSON values.\"\n                , D.reflow $\n                    \"Since JSON values can flow through, you can use JSON encoders and decoders\\\n                    \\ to allow other types through as well. More advanced users often just do\\\n                    \\ everything with encoders and decoders for more control and better errors.\"\n                ]\n            )\n\n    PortTypeInvalid region name portProblem ->\n      let\n        formatDetails (before, after) =\n          Report.Report \"BAD PORT\" region [] $\n            Code.toSnippet source region Nothing $\n              (\n                D.reflow before\n              ,\n                D.stack\n                  [ after\n                  , D.link \"Hint\" \"Read\" \"ports\"\n                      \"for more advice. For example, do not end up with one port per JS function!\"\n                  ]\n              )\n      in\n      formatDetails $\n        case portProblem of\n          CmdNoArg ->\n            (\n              \"The `\" <> Name.toChars name <> \"` port cannot be just a command.\"\n            ,\n              D.reflow $\n                \"It can be (() -> Cmd msg) if you just need to trigger a JavaScript\\\n                \\ function, but there is often a better way to set things up.\"\n            )\n\n          CmdExtraArgs n ->\n            (\n              \"The `\" <> Name.toChars name <> \"` port can only send ONE value out to JavaScript.\"\n            ,\n              let\n                theseItemsInSomething\n                  | n == 2 = \"both of these items into a tuple or record\"\n                  | n == 3 = \"these \" ++ show n ++ \" items into a tuple or record\"\n                  | True   = \"these \" ++ show n ++ \" items into a record\"\n              in\n              D.reflow $\n                \"You can put \" ++ theseItemsInSomething ++ \" to send them out though.\"\n            )\n\n          CmdBadMsg ->\n            (\n              \"The `\" <> Name.toChars name <> \"` port cannot send any messages to the `update` function.\"\n            ,\n              D.reflow $\n                \"It must produce a (Cmd msg) type. Notice the lower case `msg` type\\\n                \\ variable. The command will trigger some JS code, but it will not send\\\n                \\ anything particular back to Elm.\"\n            )\n\n          SubBad ->\n            ( \"There is something off about this `\" <> Name.toChars name <> \"` port declaration.\"\n            ,\n              D.stack\n                [ D.reflow $\n                    \"To receive messages from JavaScript, you need to define a port like this:\"\n                , D.indent 4 $ D.dullyellow $ D.fromChars $\n                    \"port \" <> Name.toChars name <> \" : (Int -> msg) -> Sub msg\"\n                , D.reflow $\n                    \"Now every time JS sends an `Int` to this port, it is converted to a `msg`.\\\n                    \\ And if you subscribe, those `msg` values will be piped into your `update`\\\n                    \\ function. The only thing you can customize here is the `Int` type.\"\n                ]\n            )\n\n          NotCmdOrSub ->\n            (\n              \"I am confused about the `\" <> Name.toChars name <> \"` port declaration.\"\n            ,\n              D.reflow $\n                \"Ports need to produce a command (Cmd) or a subscription (Sub) but\\\n                \\ this is neither. I do not know how to handle this.\"\n            )\n\n    RecursiveAlias region name args tipe others ->\n        aliasRecursionReport source region name args tipe others\n\n    RecursiveDecl region name names ->\n      let\n        makeTheory question details =\n          D.fillSep $ map (D.dullyellow . D.fromChars) (words question) ++ map D.fromChars (words details)\n      in\n      Report.Report \"CYCLIC DEFINITION\" region [] $\n        Code.toSnippet source region Nothing $\n          case names of\n            [] ->\n              (\n                D.reflow $\n                  \"The `\" <> Name.toChars name <> \"` value is defined directly in terms of itself, causing an infinite loop.\"\n              ,\n                D.stack\n                  [ makeTheory \"Are you trying to mutate a variable?\" $\n                      \"Elm does not have mutation, so when I see \" ++ Name.toChars name\n                      ++ \" defined in terms of \" ++ Name.toChars name\n                      ++ \", I treat it as a recursive definition. Try giving the new value a new name!\"\n                  , makeTheory \"Maybe you DO want a recursive value?\" $\n                      \"To define \" ++ Name.toChars name ++ \" we need to know what \" ++ Name.toChars name\n                      ++ \" is, so let’s expand it. Wait, but now we need to know what \" ++ Name.toChars name\n                      ++ \" is, so let’s expand it... This will keep going infinitely!\"\n                  , D.link \"Hint\"\n                      \"The root problem is often a typo in some variable name, but I recommend reading\"\n                      \"bad-recursion\"\n                      \"for more detailed advice, especially if you actually do need a recursive value.\"\n                  ]\n              )\n\n            _:_ ->\n              (\n                D.reflow $\n                  \"The `\" <> Name.toChars name <> \"` definition is causing a very tricky infinite loop.\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"The `\" <> Name.toChars name\n                      <> \"` value depends on itself through the following chain of definitions:\"\n                  , D.cycle 4 name names\n                  , D.link \"Hint\"\n                      \"The root problem is often a typo in some variable name, but I recommend reading\"\n                      \"bad-recursion\"\n                      \"for more detailed advice, especially if you actually do want mutually recursive values.\"\n                  ]\n              )\n\n    RecursiveLet (A.At region name) names ->\n      Report.Report \"CYCLIC VALUE\" region [] $\n        Code.toSnippet source region Nothing $\n          case names of\n            [] ->\n              let\n                makeTheory question details =\n                  D.fillSep $ map (D.dullyellow . D.fromChars) (words question) ++ map D.fromChars (words details)\n              in\n                (\n                  D.reflow $\n                    \"The `\" <> Name.toChars name <> \"` value is defined directly in terms of itself, causing an infinite loop.\"\n                ,\n                  D.stack\n                    [ makeTheory \"Are you trying to mutate a variable?\" $\n                        \"Elm does not have mutation, so when I see \" ++ Name.toChars name\n                        ++ \" defined in terms of \" ++ Name.toChars name\n                        ++ \", I treat it as a recursive definition. Try giving the new value a new name!\"\n                    , makeTheory \"Maybe you DO want a recursive value?\" $\n                        \"To define \" ++ Name.toChars name ++ \" we need to know what \" ++ Name.toChars name\n                        ++ \" is, so let’s expand it. Wait, but now we need to know what \" ++ Name.toChars name\n                        ++ \" is, so let’s expand it... This will keep going infinitely!\"\n                    , D.link \"Hint\"\n                        \"The root problem is often a typo in some variable name, but I recommend reading\"\n                        \"bad-recursion\"\n                        \"for more detailed advice, especially if you actually do need a recursive value.\"\n                    ]\n                )\n\n            _ ->\n                (\n                  D.reflow $\n                    \"I do not allow cyclic values in `let` expressions.\"\n                ,\n                  D.stack\n                    [ D.reflow $\n                        \"The `\" <> Name.toChars name\n                        <> \"` value depends on itself through the following chain of definitions:\"\n                    , D.cycle 4 name names\n                    , D.link \"Hint\"\n                        \"The root problem is often a typo in some variable name, but I recommend reading\"\n                        \"bad-recursion\"\n                        \"for more detailed advice, especially if you actually do want mutually recursive values.\"\n                    ]\n                )\n\n    Shadowing name r1 r2 ->\n      Report.Report \"SHADOWING\" r2 [] $\n        Code.toPair source r1 r2\n          ( \"These variables cannot have the same name:\"\n          , advice\n          )\n          ( D.reflow $ \"The name `\" <> Name.toChars name <> \"` is first defined here:\"\n          , \"But then it is defined AGAIN over here:\"\n          , advice\n          )\n      where\n        advice =\n          D.stack\n            [ D.reflow $\n                \"Think of a more helpful name for one of them and you should be all set!\"\n            , D.link \"Note\"\n                \"Linters advise against shadowing, so Elm makes “best practices” the default. Read\"\n                \"shadowing\"\n                \"for more details on this choice.\"\n            ]\n\n    TupleLargerThanThree region ->\n      Report.Report \"BAD TUPLE\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            \"I only accept tuples with two or three items. This has too many:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I recommend switching to records. Each item will be named, and you can use\\\n                  \\ the `point.x` syntax to access them.\"\n\n              , D.link \"Note\" \"Read\" \"tuples\"\n\n                  \"for more comprehensive advice on working with large chunks of data in Elm.\"\n              ]\n          )\n\n    TypeVarsUnboundInUnion unionRegion typeName allVars unbound unbounds ->\n      unboundTypeVars source unionRegion [\"type\"] typeName allVars unbound unbounds\n\n    TypeVarsMessedUpInAlias aliasRegion typeName allVars unusedVars unboundVars ->\n      case (unusedVars, unboundVars) of\n        (unused:unuseds, []) ->\n          let\n            backQuote name =\n              \"`\" <> D.fromName name <> \"`\"\n\n            allUnusedNames =\n              map fst unusedVars\n\n            (title, subRegion, overview, stuff) =\n              case unuseds of\n                [] ->\n                  (\"UNUSED TYPE VARIABLE\"\n                  , Just (snd unused)\n                  , [\"Type\",\"alias\",backQuote typeName,\"does\",\"not\",\"use\",\"the\"\n                    ,backQuote (fst unused),\"type\",\"variable.\"\n                    ]\n                  , [D.dullyellow (backQuote (fst unused))]\n                  )\n\n                _:_ ->\n                  ( \"UNUSED TYPE VARIABLES\"\n                  , Nothing\n                  , [\"Type\",\"variables\"]\n                    ++ D.commaSep \"and\" id (map D.fromName allUnusedNames)\n                    ++ [\"are\",\"unused\",\"in\",\"the\",backQuote typeName,\"definition.\"]\n                  , D.commaSep \"and\" D.dullyellow (map D.fromName allUnusedNames)\n                  )\n          in\n          Report.Report title aliasRegion [] $\n            Code.toSnippet source aliasRegion subRegion\n              (\n                D.fillSep overview\n              ,\n                D.stack\n                  [ D.fillSep $\n                      [\"I\",\"recommend\",\"removing\"] ++ stuff ++ [\"from\",\"the\",\"declaration,\",\"like\",\"this:\"]\n                  , D.indent 4 $ D.hsep $\n                      [\"type\",\"alias\",D.green (D.fromName typeName)]\n                      ++ map D.fromName (filter (`notElem` allUnusedNames) allVars)\n                      ++ [\"=\", \"...\"]\n                  , D.reflow $\n                      \"Why? Well, if I allowed `type alias Height a = Float` I would need to answer\\\n                      \\ some weird questions. Is `Height Bool` the same as `Float`? Is `Height Bool`\\\n                      \\ the same as `Height Int`? My solution is to not need to ask them!\"\n                  ]\n              )\n\n        ([], unbound:unbounds) ->\n          unboundTypeVars source aliasRegion [\"type\",\"alias\"] typeName allVars unbound unbounds\n\n        (_, _) ->\n          let\n            unused = map fst unusedVars\n            unbound = map fst unboundVars\n\n            theseAreUsed =\n              case unbound of\n                [x] ->\n                  [\"Type\",\"variable\",D.dullyellow (\"`\" <> D.fromName x <> \"`\"),\"appears\"\n                  ,\"in\",\"the\",\"definition,\",\"but\",\"I\",\"do\",\"not\",\"see\",\"it\",\"declared.\"\n                  ]\n\n                _ ->\n                  [\"Type\",\"variables\"]\n                  ++ D.commaSep \"and\" D.dullyellow (map D.fromName unbound)\n                  ++ [\"are\",\"used\",\"in\",\"the\",\"definition,\",\"but\",\"I\",\"do\",\"not\",\"see\",\"them\",\"declared.\"]\n\n            butTheseAreUnused =\n              case unused of\n                [x] ->\n                  [\"Likewise,\",\"type\",\"variable\"\n                  ,D.dullyellow (\"`\" <> D.fromName x <> \"`\")\n                  ,\"is\",\"delared,\",\"but\",\"not\",\"used.\"\n                  ]\n\n                _ ->\n                  [\"Likewise,\",\"type\",\"variables\"]\n                  ++ D.commaSep \"and\" D.dullyellow (map D.fromName unused)\n                  ++ [\"are\",\"delared,\",\"but\",\"not\",\"used.\"]\n\n          in\n          Report.Report \"TYPE VARIABLE PROBLEMS\" aliasRegion [] $\n            Code.toSnippet source aliasRegion Nothing\n              (\n                D.reflow $\n                  \"Type alias `\" <> Name.toChars typeName <> \"` has some type variable problems.\"\n              ,\n                D.stack\n                  [ D.fillSep $ theseAreUsed ++ butTheseAreUnused\n                  , D.reflow $\n                      \"My guess is that a definition like this will work better:\"\n                  , D.indent 4 $ D.hsep $\n                      [\"type\", \"alias\", D.fromName typeName]\n                      ++ map D.fromName (filter (`notElem` unused) allVars)\n                      ++ map (D.green . D.fromName) unbound\n                      ++ [\"=\", \"...\"]\n                  ]\n              )\n\n\n\n-- BAD TYPE VARIABLES\n\n\nunboundTypeVars :: Code.Source -> A.Region -> [D.Doc] -> Name.Name -> [Name.Name] -> (Name.Name, A.Region) -> [(Name.Name, A.Region)] -> Report.Report\nunboundTypeVars source declRegion tipe typeName allVars (unboundVar, varRegion) unboundVars =\n  let\n    backQuote name =\n      \"`\" <> D.fromName name <> \"`\"\n\n    (title, subRegion, overview) =\n      case map fst unboundVars of\n        [] ->\n          ( \"UNBOUND TYPE VARIABLE\"\n          , Just varRegion\n          , [\"The\",backQuote typeName]\n            ++ tipe\n            ++ [\"uses\",\"an\",\"unbound\",\"type\",\"variable\",D.dullyellow (backQuote unboundVar),\"in\",\"its\",\"definition:\"]\n          )\n\n        vars ->\n          ( \"UNBOUND TYPE VARIABLES\"\n          , Nothing\n          , [\"Type\",\"variables\"]\n            ++ D.commaSep \"and\" D.dullyellow (D.fromName unboundVar : map D.fromName vars)\n            ++ [\"are\",\"unbound\",\"in\",\"the\",backQuote typeName] ++ tipe ++ [\"definition:\"]\n          )\n  in\n  Report.Report title declRegion [] $\n    Code.toSnippet source declRegion subRegion\n      (\n        D.fillSep overview\n      ,\n        D.stack\n          [ D.reflow $\n              \"You probably need to change the declaration to something like this:\"\n          , D.indent 4 $ D.hsep $\n              tipe\n              ++ [D.fromName typeName]\n              ++ map D.fromName allVars\n              ++ map (D.green . D.fromName) (unboundVar : map fst unboundVars)\n              ++ [\"=\", \"...\"]\n          , D.reflow $\n              \"Why? Well, imagine one `\" ++ Name.toChars typeName ++ \"` where `\" ++ Name.toChars unboundVar ++\n              \"` is an Int and another where it is a Bool. When we explicitly list the type\\\n              \\ variables, the type checker can see that they are actually different types.\"\n          ]\n      )\n\n\n\n-- NAME CLASH\n\n\nnameClash :: Code.Source -> A.Region -> A.Region -> String -> Report.Report\nnameClash source r1 r2 messageThatEndsWithPunctuation =\n  Report.Report \"NAME CLASH\" r2 [] $\n    Code.toPair source r1 r2\n      (\n        D.reflow messageThatEndsWithPunctuation\n      ,\n        \"How can I know which one you want? Rename one of them!\"\n      )\n      (\n        D.reflow (messageThatEndsWithPunctuation <> \" One here:\")\n      ,\n        \"And another one here:\"\n      ,\n        \"How can I know which one you want? Rename one of them!\"\n      )\n\n\n\n-- AMBIGUOUS NAME\n\n\nambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> ModuleName.Canonical -> OneOrMore.OneOrMore ModuleName.Canonical -> String -> Report.Report\nambiguousName source region maybePrefix name h hs thing =\n  let\n    possibleHomes = List.sort (h : OneOrMore.destruct (:) hs)\n  in\n  Report.Report \"AMBIGUOUS NAME\" region [] $\n    Code.toSnippet source region Nothing $\n      case maybePrefix of\n        Nothing ->\n          let\n            homeToYellowDoc (ModuleName.Canonical _ home) =\n              D.dullyellow (D.fromName home <> \".\" <> D.fromName name)\n          in\n          (\n            D.reflow $ \"This usage of `\" ++ Name.toChars name ++ \"` is ambiguous:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"This name is exposed by \" ++ show (length possibleHomes) ++ \" of your imports, so I am not\\\n                  \\ sure which one to use:\"\n              , D.indent 4 $ D.vcat $ map homeToYellowDoc possibleHomes\n              , D.reflow $\n                  \"I recommend using qualified names for imported values. I also recommend having\\\n                  \\ at most one `exposing (..)` per file to make name clashes like this less common\\\n                  \\ in the long run.\"\n              , D.link \"Note\" \"Check out\" \"imports\" \"for more info on the import syntax.\"\n              ]\n          )\n\n        Just prefix ->\n          let\n            homeToYellowDoc (ModuleName.Canonical _ home) =\n              if prefix == home then\n                D.cyan \"import\" <+> D.fromName home\n              else\n                D.cyan \"import\" <+> D.fromName home <+> D.cyan \"as\" <+> D.fromName prefix\n\n            eitherOrAny =\n              if length possibleHomes == 2 then \"either\" else \"any\"\n          in\n          (\n            D.reflow $ \"This usage of `\" ++ toQualString prefix name ++ \"` is ambiguous.\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"It could refer to a \" ++ thing ++ \" from \"\n                  ++ eitherOrAny ++ \" of these imports:\"\n              , D.indent 4 $ D.vcat $ map homeToYellowDoc possibleHomes\n              , D.reflowLink \"Read\" \"imports\" \"to learn how to clarify which one you want.\"\n              ]\n          )\n\n\n\n-- NOT FOUND\n\n\nnotFound :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> String -> PossibleNames -> Report.Report\nnotFound source region maybePrefix name thing (PossibleNames locals quals) =\n  let\n    givenName =\n      maybe Name.toChars toQualString maybePrefix name\n\n    possibleNames =\n      let\n        addQuals prefix localSet allNames =\n          Set.foldr (\\x xs -> toQualString prefix x : xs) allNames localSet\n      in\n      Map.foldrWithKey addQuals (map Name.toChars (Set.toList locals)) quals\n\n    nearbyNames =\n      take 4 (Suggest.sort givenName id possibleNames)\n\n    toDetails noSuggestionDetails yesSuggestionDetails =\n      case nearbyNames of\n        [] ->\n          D.stack\n            [ D.reflow noSuggestionDetails\n            , D.link \"Hint\" \"Read\" \"imports\" \"to see how `import` declarations work in Elm.\"\n            ]\n\n        suggestions ->\n          D.stack\n            [ D.reflow yesSuggestionDetails\n            , D.indent 4 $ D.vcat $ map D.dullyellow $ map D.fromChars suggestions\n            , D.link \"Hint\" \"Read\" \"imports\" \"to see how `import` declarations work in Elm.\"\n            ]\n\n  in\n  Report.Report \"NAMING ERROR\" region nearbyNames $\n    Code.toSnippet source region Nothing\n      (\n        D.reflow $\n          \"I cannot find a `\" ++ givenName ++ \"` \" ++ thing ++ \":\"\n      ,\n        case maybePrefix of\n          Nothing ->\n            toDetails\n              \"Is there an `import` or `exposing` missing up top?\"\n              \"These names seem close though:\"\n\n          Just prefix ->\n            case Map.lookup prefix quals of\n              Nothing ->\n                toDetails\n                  (\"I cannot find a `\" ++ Name.toChars prefix ++ \"` module. Is there an `import` for it?\")\n                  (\"I cannot find a `\" ++ Name.toChars prefix ++ \"` import. These names seem close though:\")\n\n              Just _ ->\n                toDetails\n                  (\"The `\" ++ Name.toChars prefix ++ \"` module does not expose a `\" ++ Name.toChars name ++ \"` \" ++ thing ++ \".\")\n                  (\"The `\" ++ Name.toChars prefix ++ \"` module does not expose a `\" ++ Name.toChars name ++ \"` \" ++ thing ++ \". These names seem close though:\")\n      )\n\n\ntoQualString :: Name.Name -> Name.Name -> String\ntoQualString prefix name =\n  Name.toChars prefix ++ \".\" ++ Name.toChars name\n\n\n\n{-- VAR ERROR\n\n\nvarErrorToReport :: VarError -> Report.Report\nvarErrorToReport (VarError kind name problem suggestions) =\n  let\n    learnMore orMaybe =\n      D.reflow $\n        orMaybe <> \" `import` works different than you expect? Learn all about it here: \"\n        <> D.hintLink \"imports\"\n\n    namingError overview maybeStarter specializedSuggestions =\n      Report.reportDoc \"NAMING ERROR\" Nothing overview $\n        case D.maybeYouWant' maybeStarter specializedSuggestions of\n          Nothing ->\n            learnMore \"Maybe\"\n          Just doc ->\n            D.stack [ doc, learnMore \"Or maybe\" ]\n\n    specialNamingError specialHint =\n      Report.reportDoc \"NAMING ERROR\" Nothing (cannotFind kind name) (D.hsep specialHint)\n  in\n  case problem of\n    Ambiguous ->\n      namingError (ambiguous kind name) Nothing suggestions\n\n    UnknownQualifier qualifier localName ->\n      namingError\n        (cannotFind kind name)\n        (Just $ text $ \"No module called `\" <> qualifier <> \"` has been imported.\")\n        (map (\\modul -> modul <> \".\" <> localName) suggestions)\n\n    QualifiedUnknown qualifier localName ->\n      namingError\n        (cannotFind kind name)\n        (Just $ text $ \"`\" <> qualifier <> \"` does not expose `\" <> localName <> \"`.\")\n        (map (\\v -> qualifier <> \".\" <> v) suggestions)\n\n    ExposedUnknown ->\n      case name of\n        \"!=\"  -> specialNamingError (notEqualsHint name)\n        \"!==\" -> specialNamingError (notEqualsHint name)\n        \"===\" -> specialNamingError equalsHint\n        \"%\"   -> specialNamingError modHint\n        _     -> namingError (cannotFind kind name) Nothing suggestions\n\n\ncannotFind :: VarKind -> Text -> [Doc]\ncannotFind kind rawName =\n  let ( a, thing, name ) = toKindInfo kind rawName in\n  [ \"Cannot\", \"find\", a, thing, \"named\", D.dullyellow name <> \":\" ]\n\n\nambiguous :: VarKind -> Text -> [Doc]\nambiguous kind rawName =\n  let ( _a, thing, name ) = toKindInfo kind rawName in\n  [ \"This\", \"usage\", \"of\", \"the\", D.dullyellow name, thing, \"is\", \"ambiguous.\" ]\n\n\nnotEqualsHint :: Text -> [Doc]\nnotEqualsHint op =\n  [ \"Looking\", \"for\", \"the\", \"“not\", \"equal”\", \"operator?\", \"The\", \"traditional\"\n  , D.dullyellow $ text $ \"(\" <> op <> \")\"\n  , \"is\", \"replaced\", \"by\", D.green \"(/=)\", \"in\", \"Elm.\", \"It\", \"is\", \"meant\"\n  , \"to\", \"look\", \"like\", \"the\", \"“not\", \"equal”\", \"sign\", \"from\", \"math!\", \"(≠)\"\n  ]\n\n\nequalsHint :: [Doc]\nequalsHint =\n  [ \"A\", \"special\", D.dullyellow \"(===)\", \"operator\", \"is\", \"not\", \"needed\"\n  , \"in\", \"Elm.\", \"We\", \"use\", D.green \"(==)\", \"for\", \"everything!\"\n  ]\n\n\nmodHint :: [Doc]\nmodHint =\n  [ \"Rather\", \"than\", \"a\", D.dullyellow \"(%)\", \"operator,\"\n  , \"Elm\", \"has\", \"a\", D.green \"modBy\", \"function.\"\n  , \"Learn\", \"more\", \"here:\"\n  , \"<https://package.elm-lang.org/packages/elm/core/latest/Basics#modBy>\"\n  ]\n\n\n-}\n\n\n-- ARG MISMATCH\n\n\n_argMismatchReport :: Code.Source -> A.Region -> String -> Name.Name -> Int -> Int -> Report.Report\n_argMismatchReport source region kind name expected actual =\n  let\n    numArgs =\n      \"too \"\n      <> (if actual < expected then \"few\" else \"many\")\n      <> \" arguments\"\n  in\n    Report.Report (map Char.toUpper numArgs) region [] $\n      Code.toSnippet source region Nothing\n        (\n          D.reflow $\n            kind <> \" \" <> Name.toChars name <> \" has \" <> numArgs <> \".\"\n        ,\n          D.reflow $\n            \"Expecting \" <> show expected <> \", but got \" <> show actual <> \".\"\n        )\n\n\n\n-- BAD ALIAS RECURSION\n\n\naliasRecursionReport :: Code.Source -> A.Region -> Name.Name -> [Name.Name] -> Src.Type -> [Name.Name] -> Report.Report\naliasRecursionReport source region name args tipe others =\n  case others of\n    [] ->\n      Report.Report \"ALIAS PROBLEM\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            \"This type alias is recursive, forming an infinite type!\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"When I expand a recursive type alias, it just keeps getting bigger and bigger.\\\n                  \\ So dealiasing results in an infinitely large type! Try this instead:\"\n              , D.indent 4 $\n                  aliasToUnionDoc name args tipe\n              , D.link \"Hint\"\n                  \"This is kind of a subtle distinction. I suggested the naive fix, but I recommend reading\"\n                  \"recursive-alias\"\n                  \"for ideas on how to do better.\"\n              ]\n          )\n\n    _ ->\n      Report.Report \"ALIAS PROBLEM\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            \"This type alias is part of a mutually recursive set of type aliases.\"\n          ,\n            D.stack\n              [ \"It is part of this cycle of type aliases:\"\n              , D.cycle 4 name others\n              , D.reflow $\n                  \"You need to convert at least one of these type aliases into a `type`.\"\n              , D.link \"Note\" \"Read\" \"recursive-alias\"\n                  \"to learn why this `type` vs `type alias` distinction matters. It is subtle but important!\"\n              ]\n          )\n\n\naliasToUnionDoc :: Name.Name -> [Name.Name] -> Src.Type -> Doc\naliasToUnionDoc name args tipe =\n  D.vcat\n    [ D.dullyellow $\n        \"type\" <+> D.fromName name <+> (foldr (<+>) \"=\" (map D.fromName args))\n    , D.green $\n        D.indent 4 (D.fromName name)\n    , D.dullyellow $\n        D.indent 8 (RT.srcToDoc RT.App tipe)\n    ]\n"
  },
  {
    "path": "compiler/src/Reporting/Error/Docs.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Error.Docs\n  ( Error(..)\n  , SyntaxProblem(..)\n  , NameProblem(..)\n  , DefProblem(..)\n  , toReports\n  )\n  where\n\n\nimport qualified Data.Name as Name\nimport qualified Data.NonEmptyList as NE\n\nimport Parse.Primitives (Row, Col)\nimport Parse.Symbol (BadOperator(..))\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Render.Code as Code\nimport qualified Reporting.Error.Syntax as E\nimport qualified Reporting.Report as Report\n\n\n\ndata Error\n  = NoDocs A.Region\n  | ImplicitExposing A.Region\n  | SyntaxProblem SyntaxProblem\n  | NameProblems (NE.List NameProblem)\n  | DefProblems (NE.List DefProblem)\n\n\ndata SyntaxProblem\n  = Op Row Col\n  | OpBad BadOperator Row Col\n  | Name Row Col\n  | Space E.Space Row Col\n  | Comma Row Col\n  | BadEnd Row Col\n\n\ndata NameProblem\n  = NameDuplicate Name.Name A.Region A.Region\n  | NameOnlyInDocs Name.Name A.Region\n  | NameOnlyInExports Name.Name A.Region\n\n\ndata DefProblem\n  = NoComment Name.Name A.Region\n  | NoAnnotation Name.Name A.Region\n\n\n\n-- TO REPORTS\n\n\ntoReports :: Code.Source -> Error -> NE.List Report.Report\ntoReports source err =\n  case err of\n    NoDocs region ->\n      NE.singleton $\n      Report.Report \"NO DOCS\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"You must have a documentation comment between the module\\\n              \\ declaration and the imports.\"\n          ,\n            D.reflow\n              \"Learn more at <https://package.elm-lang.org/help/documentation-format>\"\n          )\n\n    ImplicitExposing region ->\n      NE.singleton $\n      Report.Report \"IMPLICIT EXPOSING\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I need you to be explicit about what this module exposes:\"\n          ,\n            D.reflow $\n              \"A great API usually hides some implementation details, so it is rare that\\\n              \\ everything in the file should be exposed. And requiring package authors\\\n              \\ to be explicit about this is a way of adding another quality check before\\\n              \\ code gets published. So as you write out the public API, ask yourself if\\\n              \\ it will be easy to understand as people read the documentation!\"\n          )\n\n    SyntaxProblem problem ->\n      NE.singleton $\n        toSyntaxProblemReport source problem\n\n    NameProblems problems ->\n      fmap (toNameProblemReport source) problems\n\n    DefProblems problems ->\n      fmap (toDefProblemReport source) problems\n\n\n\n-- SYNTAX PROBLEM\n\n\ntoSyntaxProblemReport :: Code.Source -> SyntaxProblem -> Report.Report\ntoSyntaxProblemReport source problem =\n  let\n    toSyntaxReport row col details =\n      let\n        region = toRegion row col\n      in\n      Report.Report \"PROBLEM IN DOCS\" region [] $\n        Code.toSnippet source region Nothing\n          ( D.reflow \"I was partway through parsing your module documentation, but I got stuck here:\"\n          , D.stack $\n              [ D.reflow details\n              , D.toSimpleHint $\n                  \"Read through <https://package.elm-lang.org/help/documentation-format> for\\\n                  \\ tips on how to write module documentation!\"\n              ]\n          )\n  in\n  case problem of\n    Op row col ->\n      toSyntaxReport row col $\n        \"I am trying to parse an operator like (+) or (*) but something is going wrong.\"\n\n    OpBad _ row col ->\n      toSyntaxReport row col $\n        \"I am trying to parse an operator like (+) or (*) but it looks like you are using\\\n        \\ a reserved symbol in this case.\"\n\n    Name row col ->\n      toSyntaxReport row col $\n        \"I was expecting to see the name of another exposed value from this module.\"\n\n    Space space row col ->\n      E.toSpaceReport source space row col\n\n    Comma row col ->\n      toSyntaxReport row col $\n        \"I was expecting to see a comma next.\"\n\n    BadEnd row col ->\n      toSyntaxReport row col $\n        \"I am not really sure what I am getting stuck on though.\"\n\n\ntoRegion :: Row -> Col -> A.Region\ntoRegion row col =\n  let\n    pos = A.Position row col\n  in\n  A.Region pos pos\n\n\n\n-- NAME PROBLEM\n\n\ntoNameProblemReport :: Code.Source -> NameProblem -> Report.Report\ntoNameProblemReport source problem =\n  case problem of\n    NameDuplicate name r1 r2 ->\n      Report.Report \"DUPLICATE DOCS\" r2 [] $\n        Code.toPair source r1 r2\n          (\n            D.reflow $\n              \"There can only be one `\" <> Name.toChars name\n              <> \"` in your module documentation, but it is listed twice:\"\n          ,\n            \"Remove one of them!\"\n          )\n          (\n            D.reflow $\n              \"There can only be one `\" <> Name.toChars name\n              <> \"` in your module documentation, but I see two. One here:\"\n          ,\n            \"And another one over here:\"\n          ,\n            \"Remove one of them!\"\n          )\n\n    NameOnlyInDocs name region ->\n      Report.Report \"DOCS MISTAKE\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I do not see `\" <> Name.toChars name\n              <> \"` in the `exposing` list, but it is in your module documentation:\"\n          ,\n            D.reflow $\n              \"Does it need to be added to the `exposing` list as well? Or maybe you removed `\"\n              <> Name.toChars name <> \"` and forgot to delete it here?\"\n          )\n\n    NameOnlyInExports name region ->\n      Report.Report \"DOCS MISTAKE\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I do not see `\" <> Name.toChars name\n              <> \"` in your module documentation, but it is in your `exposing` list:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Add a line like `@docs \" <> Name.toChars name\n                  <> \"` to your module documentation!\"\n              , D.link \"Note\" \"See\" \"docs\" \"for more guidance on writing high quality docs.\"\n              ]\n          )\n\n\n\n-- DEF PROBLEM\n\n\ntoDefProblemReport :: Code.Source -> DefProblem -> Report.Report\ntoDefProblemReport source problem =\n  case problem of\n    NoComment name region ->\n      Report.Report \"NO DOCS\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"The `\" <> Name.toChars name <> \"` definition does not have a documentation comment.\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Add documentation with nice examples of how to use it!\"\n              , D.link \"Note\" \"Read\" \"docs\" \"for more advice on writing great docs. There are a couple important tricks!\"\n              ]\n          )\n\n    NoAnnotation name region ->\n      Report.Report \"NO TYPE ANNOTATION\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"The `\" <> Name.toChars name <> \"` definition does not have a type annotation.\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I use the type variable names from your annotations when generating docs. So if\\\n                  \\ you say `Html msg` in your type annotation, I can use `msg` in the docs and make\\\n                  \\ them a bit clearer. So add an annotation and try to use nice type variables!\"\n              , D.link \"Note\" \"Read\" \"docs\" \"for more advice on writing great docs. There are a couple important tricks!\"\n              ]\n          )\n"
  },
  {
    "path": "compiler/src/Reporting/Error/Import.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Error.Import\n  ( Error(..)\n  , Problem(..)\n  , toReport\n  )\n  where\n\n\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\n\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Render.Code as Code\nimport qualified Reporting.Report as Report\nimport qualified Reporting.Suggest as Suggest\nimport qualified Reporting.Annotation as A\n\n\n\n-- ERROR\n\n\ndata Error =\n  Error\n    { _region :: A.Region\n    , _import :: ModuleName.Raw\n    , _unimported :: Set.Set ModuleName.Raw\n    , _problem :: Problem\n    }\n\n\ndata Problem\n  = NotFound\n  | Ambiguous FilePath [FilePath] Pkg.Name [Pkg.Name]\n  | AmbiguousLocal FilePath FilePath [FilePath]\n  | AmbiguousForeign Pkg.Name Pkg.Name [Pkg.Name]\n\n\n\n-- TO REPORT\n\n\ntoReport :: Code.Source -> Error -> Report.Report\ntoReport source (Error region name unimportedModules problem) =\n  case problem of\n    NotFound ->\n      Report.Report \"MODULE NOT FOUND\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"You are trying to import a `\" ++ ModuleName.toChars name ++ \"` module:\"\n          ,\n            D.stack\n              [\n                D.reflow $\n                  \"I checked the \\\"dependencies\\\" and \\\"source-directories\\\" listed in your elm.json,\\\n                  \\ but I cannot find it! Maybe it is a typo for one of these names?\"\n              ,\n                D.dullyellow $ D.indent 4 $ D.vcat $\n                  map D.fromName (toSuggestions name unimportedModules)\n              ,\n                case Map.lookup name Pkg.suggestions of\n                  Nothing ->\n                    D.toSimpleHint $\n                      \"If it is not a typo, check the \\\"dependencies\\\" and \\\"source-directories\\\"\\\n                      \\ of your elm.json to make sure all the packages you need are listed there!\"\n\n                  Just dependency ->\n                    D.toFancyHint\n                      [\"Maybe\",\"you\",\"want\",\"the\"\n                      ,\"`\" <> D.fromName name <> \"`\"\n                      ,\"module\",\"defined\",\"in\",\"the\"\n                      ,D.fromChars (Pkg.toChars dependency)\n                      ,\"package?\",\"Running\"\n                      ,D.green (D.fromChars (\"elm install \" ++ Pkg.toChars dependency))\n                      ,\"should\",\"make\",\"it\",\"available!\"\n                      ]\n              ]\n          )\n\n    Ambiguous path _ pkg _ ->\n      Report.Report \"AMBIGUOUS IMPORT\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"You are trying to import a `\" ++ ModuleName.toChars name ++ \"` module:\"\n          ,\n            D.stack\n              [\n                D.fillSep $\n                  [\"But\",\"I\",\"found\",\"multiple\",\"modules\",\"with\",\"that\",\"name.\",\"One\",\"in\",\"the\"\n                  ,D.dullyellow (D.fromChars (Pkg.toChars pkg))\n                  ,\"package,\",\"and\",\"another\",\"defined\",\"locally\",\"in\",\"the\"\n                  ,D.dullyellow (D.fromChars path)\n                  ,\"file.\",\"I\",\"do\",\"not\",\"have\",\"a\",\"way\",\"to\",\"choose\",\"between\",\"them.\"\n                  ]\n              ,\n                D.reflow $\n                  \"Try changing the name of the locally defined module to clear up the ambiguity?\"\n              ]\n          )\n\n    AmbiguousLocal path1 path2 paths ->\n      Report.Report \"AMBIGUOUS IMPORT\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"You are trying to import a `\" ++ ModuleName.toChars name ++ \"` module:\"\n          ,\n            D.stack\n              [\n                D.reflow $\n                  \"But I found multiple files in your \\\"source-directories\\\" with that name:\"\n              ,\n                D.dullyellow $ D.indent 4 $ D.vcat $\n                  map D.fromChars (path1:path2:paths)\n              ,\n                D.reflow $\n                  \"Change the module names to be distinct!\"\n              ]\n          )\n\n    AmbiguousForeign pkg1 pkg2 pkgs ->\n      Report.Report \"AMBIGUOUS IMPORT\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"You are trying to import a `\" ++ ModuleName.toChars name ++ \"` module:\"\n          ,\n            D.stack\n              [\n                D.reflow $\n                  \"But multiple packages in your \\\"dependencies\\\" that expose a module that name:\"\n              ,\n                D.dullyellow $ D.indent 4 $ D.vcat $\n                  map (D.fromChars . Pkg.toChars) (pkg1:pkg2:pkgs)\n              ,\n                D.reflow $\n                  \"There is no way to disambiguate in cases like this right now. Of the known name\\\n                  \\ clashes, they are usually for packages with similar purposes, so the current\\\n                  \\ recommendation is to pick just one of them.\"\n              , D.toSimpleNote $\n                  \"It seems possible to resolve this with new syntax in imports, but that is\\\n                  \\ more complicated than it sounds. Right now, our module names are tied to GitHub\\\n                  \\ repos, but we may want to get rid of that dependency for a variety of reasons.\\\n                  \\ That would in turn have implications for our package infrastructure, hosting\\\n                  \\ costs, and possibly on how package names are specified. The particular syntax\\\n                  \\ chosen seems like it would interact with all these factors in ways that are\\\n                  \\ difficult to predict, potentially leading to harder problems later on. So more\\\n                  \\ design work and planning is needed on these topics.\"\n              ]\n          )\n\n\n\ntoSuggestions :: ModuleName.Raw -> Set.Set ModuleName.Raw -> [ModuleName.Raw]\ntoSuggestions name unimportedModules =\n  take 4 $\n    Suggest.sort (ModuleName.toChars name) ModuleName.toChars (Set.toList unimportedModules)\n"
  },
  {
    "path": "compiler/src/Reporting/Error/Json.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Error.Json\n  ( toReport\n  , FailureToReport(..)\n  , Context(..)\n  , Reason(..)\n  )\n  where\n\n\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.UTF8 as BS_UTF8\nimport qualified Data.NonEmptyList as NE\n\nimport Json.Decode (Error(..), Problem(..), DecodeExpectation(..), ParseError(..), StringProblem(..))\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Exit.Help as Help\nimport qualified Reporting.Render.Code as Code\n\n\n\n-- TO REPORT\n\n\ntoReport :: FilePath -> FailureToReport x -> Error x -> Reason -> Help.Report\ntoReport path ftr err reason =\n  case err of\n    DecodeProblem bytes problem ->\n      problemToReport path ftr (Code.toSource bytes) CRoot problem reason\n\n    ParseProblem bytes parseError ->\n      parseErrorToReport path (Code.toSource bytes) parseError reason\n\n\nnewtype Reason =\n  ExplicitReason String\n\n\nbecause :: Reason -> String -> String\nbecause (ExplicitReason iNeedThings) problem =\n  iNeedThings ++ \" \" ++ problem\n\n\n\n-- PARSE ERROR TO REPORT\n\n\nparseErrorToReport :: FilePath -> Code.Source -> ParseError -> Reason -> Help.Report\nparseErrorToReport path source parseError reason =\n  let\n    toSnippet title row col (problem, details) =\n      let\n        pos = A.Position row col\n        surroundings = A.Region (A.Position (max 1 (row - 2)) 1) pos\n        region = A.Region pos pos\n      in\n      Help.jsonReport title (Just path) $\n        Code.toSnippet source surroundings (Just region)\n          ( D.reflow (because reason problem)\n          , details\n          )\n  in\n  case parseError of\n    Start row col ->\n      toSnippet \"EXPECTING A VALUE\" row col\n        (\n          \"I was expecting to see a JSON value next:\"\n        ,\n          D.stack\n            [ D.fillSep\n                [\"Try\",\"something\",\"like\",D.dullyellow \"\\\"this\\\"\",\"or\"\n                ,D.dullyellow \"42\",\"to\",\"move\",\"on\",\"to\",\"better\",\"hints!\"\n                ]\n            , D.toSimpleNote $\n                \"The JSON specification does not allow trailing commas, so you can sometimes\\\n                \\ get this error in arrays that have an extra comma at the end. In that case,\\\n                \\ remove that last comma or add another array entry after it!\"\n            ]\n        )\n\n    ObjectField row col ->\n      toSnippet \"EXTRA COMMA\" row col\n        (\n          \"I was partway through parsing a JSON object when I got stuck here:\"\n        ,\n          D.stack\n            [ D.fillSep\n                [\"I\",\"saw\",\"a\",\"comma\",\"right\",\"before\",\"I\",\"got\",\"stuck\",\"here,\"\n                ,\"so\",\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"field\",\"name\",\"like\"\n                ,D.dullyellow \"\\\"type\\\"\",\"or\",D.dullyellow \"\\\"dependencies\\\"\",\"next.\"\n                ]\n            , D.reflow $\n                \"This error is commonly caused by trailing commas in JSON objects. Those are\\\n                \\ actually disallowed by <https://json.org> so check the previous line for a\\\n                \\ trailing comma that may need to be deleted.\"\n            , objectNote\n            ]\n        )\n\n    ObjectColon row col ->\n      toSnippet \"EXPECTING COLON\" row col\n        (\n          \"I was partway through parsing a JSON object when I got stuck here:\"\n        ,\n          D.stack\n            [ D.reflow $ \"I was expecting to see a colon next.\"\n            , objectNote\n            ]\n        )\n\n    ObjectEnd row col ->\n      toSnippet \"UNFINISHED OBJECT\" row col\n        (\n          \"I was partway through parsing a JSON object when I got stuck here:\"\n        ,\n          D.stack\n            [ D.reflow $\n                \"I was expecting to see a comma or a closing curly brace next.\"\n            , D.reflow $\n                \"Is a comma missing on the previous line? Is an array missing a closing square\\\n                \\ bracket? It is often something tricky like that!\"\n            , objectNote\n            ]\n        )\n\n    ArrayEnd row col ->\n      toSnippet \"UNFINISHED ARRAY\" row col\n        (\n          \"I was partway through parsing a JSON array when I got stuck here:\"\n        ,\n          D.stack\n            [ D.reflow $ \"I was expecting to see a comma or a closing square bracket next.\"\n            , D.reflow $\n                \"Is a comma missing on the previous line? It is often something like that!\"\n            ]\n        )\n\n    StringProblem stringProblem row col ->\n      case stringProblem of\n        BadStringEnd ->\n          toSnippet \"ENDLESS STRING\" row col\n            (\n              \"I got to the end of the line without seeing the closing double quote:\"\n            ,\n              D.fillSep $\n                [\"Strings\",\"look\",\"like\",D.green \"\\\"this\\\"\",\"with\",\"double\"\n                ,\"quotes\",\"on\",\"each\",\"end.\",\"Is\",\"the\",\"closing\",\"double\"\n                ,\"quote\",\"missing\",\"in\",\"your\",\"code?\"\n                ]\n            )\n\n        BadStringControlChar ->\n          toSnippet \"UNEXPECTED CONTROL CHARACTER\" row col\n            (\n              \"I ran into a control character unexpectedly:\"\n            ,\n              D.reflow $\n                \"These are characters that represent tabs, backspaces, newlines, and\\\n                \\ a bunch of other invisible characters. They all come before 20 in the\\\n                \\ ASCII range, and they are disallowed by the JSON specificaiton. Maybe\\\n                \\ a copy/paste added one of these invisible characters to your JSON?\"\n            )\n\n        BadStringEscapeChar ->\n          toSnippet \"UNKNOWN ESCAPE\" row col\n            (\n              \"Backslashes always start escaped characters, but I do not recognize this one:\"\n            ,\n              D.stack\n                [ D.reflow $\n                    \"Valid escape characters include:\"\n                , D.dullyellow $ D.indent 4 $ D.vcat $\n                    [\"\\\\\\\"\",\"\\\\\\\\\",\"\\\\/\",\"\\\\b\",\"\\\\f\",\"\\\\n\",\"\\\\r\",\"\\\\t\",\"\\\\u003D\"]\n                , D.reflow $\n                    \"Do you want one of those instead? Maybe you need \\\\\\\\ to escape a backslash?\"\n                ]\n            )\n\n        BadStringEscapeHex ->\n          toSnippet \"BAD HEX ESCAPE\" row col\n            (\n              \"This is not a valid hex escape:\"\n            ,\n              D.fillSep $\n                [\"Valid\",\"hex\",\"escapes\",\"in\",\"JSON\",\"are\",\"between\"\n                ,D.green \"\\\\u0000\",\"and\",D.green \"\\\\uFFFF\"\n                ,\"and\",\"always\",\"have\",\"exactly\",\"four\",\"digits.\"\n                ]\n            )\n\n    NoLeadingZeros row col ->\n      toSnippet \"BAD NUMBER\" row col\n        (\n          \"Numbers cannot start with zeros like this:\"\n        ,\n          D.reflow $ \"Try deleting the leading zeros?\"\n        )\n\n    NoFloats row col ->\n      toSnippet \"UNEXPECTED NUMBER\" row col\n        (\n          \"I got stuck while trying to parse this number:\"\n        ,\n          D.reflow $\n            \"I do not accept floating point numbers like 3.1415 right now. That kind\\\n            \\ of JSON value is not needed for any of the uses that Elm has for now.\"\n        )\n\n    BadEnd row col ->\n      toSnippet \"JSON PROBLEM\" row col\n        (\n          \"I was partway through parsing some JSON when I got stuck here:\"\n        ,\n          D.reflow $\n            \"I am not really sure what is wrong. This sometimes means there is extra\\\n            \\ stuff after a valid JSON value?\"\n        )\n\n\nobjectNote :: D.Doc\nobjectNote =\n  D.stack\n    [ D.toSimpleNote $ \"Here is an example of a valid JSON object for reference:\"\n    , D.vcat\n        [ D.indent 4 $ \"{\"\n        , D.indent 6 $ D.dullyellow \"\\\"name\\\"\" <> \": \" <> D.dullyellow \"\\\"Tom\\\"\" <> \",\"\n        , D.indent 6 $ D.dullyellow \"\\\"age\\\"\" <> \": \" <> D.dullyellow \"42\"\n        , D.indent 4 $ \"}\"\n        ]\n    , D.reflow $\n        \"Notice that (1) the field names are in double quotes and (2) there is no\\\n        \\ trailing comma after the last entry. Both are strict requirements in JSON!\"\n    ]\n\n\n\n-- PROBLEM TO REPORT\n\n\ndata Context\n  = CRoot\n  | CField BS.ByteString Context\n  | CIndex Int Context\n\n\nproblemToReport :: FilePath -> FailureToReport x -> Code.Source -> Context -> Problem x -> Reason -> Help.Report\nproblemToReport path ftr source context problem reason =\n  case problem of\n    Field field prob ->\n      problemToReport path ftr source (CField field context) prob reason\n\n    Index index prob ->\n      problemToReport path ftr source (CIndex index context) prob reason\n\n    OneOf p ps ->\n      -- NOTE: only displays the deepest problem. This works well for the kind\n      -- of JSON used by Elm, but probably would not work well in general.\n      let\n        (NE.List prob _) = NE.sortBy (negate . getMaxDepth) (NE.List p ps)\n      in\n      problemToReport path ftr source context prob reason\n\n    Failure region x ->\n      _failureToReport ftr path source context region x\n\n    Expecting region expectation ->\n      expectationToReport path source context region expectation reason\n\n\ngetMaxDepth :: Problem x -> Int\ngetMaxDepth problem =\n  case problem of\n    Field _ prob  -> 1 + getMaxDepth prob\n    Index _ prob  -> 1 + getMaxDepth prob\n    OneOf p ps    -> maximum (getMaxDepth p : map getMaxDepth ps)\n    Failure _ _   -> 0\n    Expecting _ _ -> 0\n\n\nnewtype FailureToReport x =\n  FailureToReport { _failureToReport :: FilePath -> Code.Source -> Context -> A.Region -> x -> Help.Report }\n\n\nexpectationToReport :: FilePath -> Code.Source -> Context -> A.Region -> DecodeExpectation -> Reason -> Help.Report\nexpectationToReport path source context (A.Region start end) expectation reason =\n  let\n    (A.Position sr _) = start\n    (A.Position er _) = end\n\n    region =\n      if sr == er then region else A.Region start start\n\n    introduction =\n      case context of\n        CRoot ->\n          \"I ran into some trouble here:\"\n\n        CField field _ ->\n          \"I ran into trouble with the value of the \\\"\" ++ BS_UTF8.toString field ++ \"\\\" field:\"\n\n        CIndex index (CField field _) ->\n          \"When looking at the \\\"\" ++ BS_UTF8.toString field ++ \"\\\" field, I ran into trouble with the \"\n          ++ D.intToOrdinal index ++ \" entry:\"\n\n        CIndex index _ ->\n          \"I ran into trouble with the \" ++ D.intToOrdinal index ++ \" index of this array:\"\n\n    toSnippet title aThing =\n      Help.jsonReport title (Just path) $\n        Code.toSnippet source region Nothing\n          ( D.reflow (because reason introduction)\n          , D.fillSep $ [\"I\",\"was\",\"expecting\",\"to\",\"run\",\"into\"] ++ aThing\n          )\n  in\n  case expectation of\n    TObject ->\n      toSnippet \"EXPECTING OBJECT\" [\"an\", D.green \"OBJECT\" <> \".\"]\n\n    TArray ->\n      toSnippet \"EXPECTING ARRAY\" [\"an\", D.green \"ARRAY\" <> \".\"]\n\n    TString ->\n      toSnippet \"EXPECTING STRING\" [\"a\", D.green \"STRING\" <> \".\"]\n\n    TBool ->\n      toSnippet \"EXPECTING BOOL\" [\"a\", D.green \"BOOLEAN\" <> \".\"]\n\n    TInt ->\n      toSnippet \"EXPECTING INT\" [\"an\", D.green \"INT\" <> \".\"]\n\n    TObjectWith field ->\n      toSnippet \"MISSING FIELD\"\n        [\"an\",D.green \"OBJECT\",\"with\",\"a\"\n        ,D.green (\"\\\"\" <> D.fromChars (BS_UTF8.toString field) <> \"\\\"\")\n        ,\"field.\"\n        ]\n\n    TArrayPair len ->\n      toSnippet \"EXPECTING PAIR\"\n        [\"an\",D.green \"ARRAY\",\"with\",D.green \"TWO\",\"entries.\"\n        ,\"This\",\"array\",\"has\",D.fromInt len, if len == 1 then \"element.\" else \"elements.\"\n        ]\n"
  },
  {
    "path": "compiler/src/Reporting/Error/Main.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Error.Main\n  ( Error(..)\n  , toReport\n  )\n  where\n\n\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Error.Canonicalize as E\nimport qualified Reporting.Render.Code as Code\nimport qualified Reporting.Render.Type as RT\nimport qualified Reporting.Render.Type.Localizer as L\nimport qualified Reporting.Report as Report\n\n\n\n-- ERROR\n\n\ndata Error\n  = BadType A.Region Can.Type\n  | BadCycle A.Region Name.Name [Name.Name]\n  | BadFlags A.Region Can.Type E.InvalidPayload\n\n\n\n-- TO REPORT\n\n\ntoReport :: L.Localizer -> Code.Source -> Error -> Report.Report\ntoReport localizer source err =\n  case err of\n    BadType region tipe ->\n      Report.Report \"BAD MAIN TYPE\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            \"I cannot handle this type of `main` value:\"\n          ,\n            D.stack\n              [ \"The type of `main` value I am seeing is:\"\n              , D.indent 4 $ D.dullyellow $ RT.canToDoc localizer RT.None tipe\n              , D.reflow $\n                  \"I only know how to handle Html, Svg, and Programs\\\n                  \\ though. Modify `main` to be one of those types of values!\"\n              ]\n          )\n\n    BadCycle region name names ->\n      Report.Report \"BAD MAIN\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            \"A `main` definition cannot be defined in terms of itself.\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"It should be a boring value with no recursion. But\\\n                  \\ instead it is involved in this cycle of definitions:\"\n              , D.cycle 4 name names\n              ]\n          )\n\n    BadFlags region _badType invalidPayload ->\n      let\n        formatDetails (aBadKindOfThing, butThatIsNoGood) =\n          Report.Report \"BAD FLAGS\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                D.reflow $\n                  \"Your `main` program wants \" ++ aBadKindOfThing ++ \" from JavaScript.\"\n              ,\n                butThatIsNoGood\n              )\n      in\n      formatDetails $\n        case invalidPayload of\n          E.ExtendedRecord ->\n            (\n              \"an extended record\"\n            ,\n              D.reflow $\n                \"But the exact shape of the record must be known at compile time. No type variables!\"\n            )\n\n          E.Function ->\n            (\n              \"a function\"\n            ,\n              D.reflow $\n                \"But if I allowed functions from JS, it would be possible to sneak\\\n                \\ side-effects and runtime exceptions into Elm!\"\n            )\n\n          E.TypeVariable name ->\n            (\n              \"an unspecified type\"\n            ,\n              D.reflow $\n                \"But type variables like `\" ++ Name.toChars name ++ \"` cannot be given as flags.\\\n                \\ I need to know exactly what type of data I am getting, so I can guarantee that\\\n                \\ unexpected data cannot sneak in and crash the Elm program.\"\n            )\n\n          E.UnsupportedType name ->\n            (\n              \"a `\" ++ Name.toChars name ++ \"` value\"\n            ,\n              D.stack\n                [ D.reflow $ \"I cannot handle that. The types that CAN be in flags include:\"\n                , D.indent 4 $\n                    D.reflow $\n                      \"Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\\\n                      \\ tuples, records, and JSON values.\"\n                , D.reflow $\n                    \"Since JSON values can flow through, you can use JSON encoders and decoders\\\n                    \\ to allow other types through as well. More advanced users often just do\\\n                    \\ everything with encoders and decoders for more control and better errors.\"\n                ]\n            )\n"
  },
  {
    "path": "compiler/src/Reporting/Error/Pattern.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Error.Pattern\n  ( P.Error(..)\n  , toReport\n  )\n  where\n\nimport qualified Data.List as List\n\nimport qualified Elm.String as ES\nimport qualified Nitpick.PatternMatches as P\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Report as Report\nimport qualified Reporting.Render.Code as Code\n\n\n\n-- TO REPORT\n\n\ntoReport :: Code.Source -> P.Error -> Report.Report\ntoReport source err =\n  case err of\n    P.Redundant caseRegion patternRegion index ->\n      Report.Report \"REDUNDANT PATTERN\" patternRegion [] $\n        Code.toSnippet source caseRegion (Just patternRegion)\n          (\n            D.reflow $\n              \"The \" <> D.intToOrdinal index <> \" pattern is redundant:\"\n          ,\n            D.reflow $\n              \"Any value with this shape will be handled by a previous\\\n              \\ pattern, so it should be removed.\"\n          )\n\n    P.Incomplete region context unhandled ->\n      case context of\n        P.BadArg ->\n          Report.Report \"UNSAFE PATTERN\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                \"This pattern does not cover all possibilities:\"\n              ,\n                D.stack\n                  [ \"Other possibilities include:\"\n                  , unhandledPatternsToDocBlock unhandled\n                  , D.reflow $\n                      \"I would have to crash if I saw one of those! So rather than\\\n                      \\ pattern matching in function arguments, put a `case` in\\\n                      \\ the function body to account for all possibilities.\"\n                  ]\n              )\n\n        P.BadDestruct ->\n          Report.Report \"UNSAFE PATTERN\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                \"This pattern does not cover all possible values:\"\n              ,\n                D.stack\n                  [ \"Other possibilities include:\"\n                  , unhandledPatternsToDocBlock unhandled\n                  , D.reflow $\n                      \"I would have to crash if I saw one of those! You can use\\\n                      \\ `let` to deconstruct values only if there is ONE possibility.\\\n                      \\ Switch to a `case` expression to account for all possibilities.\"\n                  , D.toSimpleHint $\n                      \"Are you calling a function that definitely returns values\\\n                      \\ with a very specific shape? Try making the return type of\\\n                      \\ that function more specific!\"\n                  ]\n              )\n\n        P.BadCase ->\n          Report.Report \"MISSING PATTERNS\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                \"This `case` does not have branches for all possibilities:\"\n              ,\n                D.stack\n                  [ \"Missing possibilities include:\"\n                  , unhandledPatternsToDocBlock unhandled\n                  , D.reflow $\n                      \"I would have to crash if I saw one of those. Add branches for them!\"\n                  , D.link \"Hint\"\n                      \"If you want to write the code for each branch later, use `Debug.todo` as a placeholder. Read\"\n                      \"missing-patterns\"\n                      \"for more guidance on this workflow.\"\n                  ]\n              )\n\n\n\n-- PATTERN TO DOC\n\n\nunhandledPatternsToDocBlock :: [P.Pattern] -> D.Doc\nunhandledPatternsToDocBlock unhandledPatterns =\n  D.indent 4 $ D.dullyellow $ D.vcat $\n    map (patternToDoc Unambiguous) unhandledPatterns\n\n\ndata Context\n  = Arg\n  | Head\n  | Unambiguous\n  deriving (Eq)\n\n\npatternToDoc :: Context -> P.Pattern -> D.Doc\npatternToDoc context pattern =\n  case delist pattern [] of\n    NonList P.Anything ->\n      \"_\"\n\n    NonList (P.Literal literal) ->\n      case literal of\n        P.Chr chr ->\n          \"'\" <> D.fromChars (ES.toChars chr) <> \"'\"\n\n        P.Str str ->\n          \"\\\"\" <> D.fromChars (ES.toChars str) <> \"\\\"\"\n\n        P.Int int ->\n          D.fromInt int\n\n    NonList (P.Ctor _ \"#0\" []) ->\n      \"()\"\n\n    NonList (P.Ctor _ \"#2\" [a,b]) ->\n      \"( \" <> patternToDoc Unambiguous a <>\n      \", \" <> patternToDoc Unambiguous b <>\n      \" )\"\n\n    NonList (P.Ctor _ \"#3\" [a,b,c]) ->\n      \"( \" <> patternToDoc Unambiguous a <>\n      \", \" <> patternToDoc Unambiguous b <>\n      \", \" <> patternToDoc Unambiguous c <>\n      \" )\"\n\n    NonList (P.Ctor _ name args) ->\n      let\n        ctorDoc =\n          D.hsep (D.fromName name : map (patternToDoc Arg) args)\n      in\n      if context == Arg && length args > 0 then\n        \"(\" <> ctorDoc <> \")\"\n      else\n        ctorDoc\n\n    FiniteList [] ->\n      \"[]\"\n\n    FiniteList entries ->\n      let entryDocs = map (patternToDoc Unambiguous) entries in\n      \"[\" <> D.hcat (List.intersperse \",\" entryDocs) <> \"]\"\n\n    Conses conses finalPattern ->\n      let\n        consDoc =\n          foldr\n            (\\hd tl -> patternToDoc Head hd <> \" :: \" <> tl)\n            (patternToDoc Unambiguous finalPattern)\n            conses\n      in\n      if context == Unambiguous then\n        consDoc\n      else\n        \"(\" <> consDoc <> \")\"\n\n\ndata Structure\n  = FiniteList [P.Pattern]\n  | Conses [P.Pattern] P.Pattern\n  | NonList P.Pattern\n\n\ndelist :: P.Pattern -> [P.Pattern] -> Structure\ndelist pattern revEntries =\n  case pattern of\n    P.Ctor _ \"[]\" [] ->\n      FiniteList revEntries\n\n    P.Ctor _ \"::\" [hd,tl] ->\n      delist tl (hd:revEntries)\n\n    _ ->\n      case revEntries of\n        [] ->\n          NonList pattern\n\n        _ ->\n          Conses (reverse revEntries) pattern\n"
  },
  {
    "path": "compiler/src/Reporting/Error/Syntax.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Error.Syntax\n  ( Error(..)\n  , toReport\n  --\n  , Module(..)\n  , Exposing(..)\n  --\n  , Decl(..)\n  , DeclType(..)\n  , TypeAlias(..)\n  , CustomType(..)\n  , DeclDef(..)\n  , Port(..)\n  --\n  , Expr(..)\n  , Record(..)\n  , Tuple(..)\n  , List(..)\n  , Func(..)\n  , Case(..)\n  , If(..)\n  , Let(..)\n  , Def(..)\n  , Destruct(..)\n  --\n  , Pattern(..)\n  , PRecord(..)\n  , PTuple(..)\n  , PList(..)\n  --\n  , Type(..)\n  , TRecord(..)\n  , TTuple(..)\n  --\n  , Char(..)\n  , String(..)\n  , Escape(..)\n  , Number(..)\n  --\n  , Space(..)\n  , toSpaceReport\n  )\n  where\n\n\nimport Prelude hiding (Char, String)\nimport qualified Data.Char as Char\nimport qualified Data.Name as Name\nimport Data.Word (Word16)\nimport Numeric (showHex)\n\nimport qualified Elm.ModuleName as ModuleName\nimport Parse.Primitives (Row, Col)\nimport Parse.Symbol (BadOperator(..))\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Report as Report\nimport qualified Reporting.Render.Code as Code\n\n\n\n-- ALL SYNTAX ERRORS\n\n\ndata Error\n  = ModuleNameUnspecified ModuleName.Raw\n  | ModuleNameMismatch ModuleName.Raw (A.Located ModuleName.Raw)\n  | UnexpectedPort A.Region\n  | NoPorts A.Region\n  | NoPortsInPackage (A.Located Name.Name)\n  | NoPortModulesInPackage A.Region\n  | NoEffectsOutsideKernel A.Region\n  | ParseError Module\n\n\n\n-- MODULE\n\n\ndata Module\n  = ModuleSpace Space Row Col\n  | ModuleBadEnd Row Col\n  --\n  | ModuleProblem Row Col\n  | ModuleName Row Col\n  | ModuleExposing Exposing Row Col\n  --\n  | PortModuleProblem Row Col\n  | PortModuleName Row Col\n  | PortModuleExposing Exposing Row Col\n  --\n  | Effect Row Col\n  --\n  | FreshLine Row Col\n  --\n  | ImportStart Row Col\n  | ImportName Row Col\n  | ImportAs Row Col\n  | ImportAlias Row Col\n  | ImportExposing Row Col\n  | ImportExposingList Exposing Row Col\n  | ImportEnd Row Col -- different based on col=1 or if greater\n  --\n  | ImportIndentName Row Col\n  | ImportIndentAlias Row Col\n  | ImportIndentExposingList Row Col\n  --\n  | Infix Row Col\n  --\n  | Declarations Decl Row Col\n\n\ndata Exposing\n  = ExposingSpace Space Row Col\n  | ExposingStart Row Col\n  | ExposingValue Row Col\n  | ExposingOperator Row Col\n  | ExposingOperatorReserved BadOperator Row Col\n  | ExposingOperatorRightParen Row Col\n  | ExposingTypePrivacy Row Col\n  | ExposingEnd Row Col\n  --\n  | ExposingIndentEnd Row Col\n  | ExposingIndentValue Row Col\n\n\n\n-- DECLARATIONS\n\n\ndata Decl\n  = DeclStart Row Col\n  | DeclSpace Space Row Col\n  --\n  | Port Port Row Col\n  | DeclType DeclType Row Col\n  | DeclDef Name.Name DeclDef Row Col\n  --\n  | DeclFreshLineAfterDocComment Row Col\n\n\ndata DeclDef\n  = DeclDefSpace Space Row Col\n  | DeclDefEquals Row Col\n  | DeclDefType Type Row Col\n  | DeclDefArg Pattern Row Col\n  | DeclDefBody Expr Row Col\n  | DeclDefNameRepeat Row Col\n  | DeclDefNameMatch Name.Name Row Col\n  --\n  | DeclDefIndentType Row Col\n  | DeclDefIndentEquals Row Col\n  | DeclDefIndentBody Row Col\n\n\ndata Port\n  = PortSpace Space Row Col\n  | PortName Row Col\n  | PortColon Row Col\n  | PortType Type Row Col\n  | PortIndentName Row Col\n  | PortIndentColon Row Col\n  | PortIndentType Row Col\n\n\n\n-- TYPE DECLARATIONS\n\n\ndata DeclType\n  = DT_Space Space Row Col\n  | DT_Name Row Col\n  | DT_Alias TypeAlias Row Col\n  | DT_Union CustomType Row Col\n  --\n  | DT_IndentName Row Col\n\n\ndata TypeAlias\n  = AliasSpace Space Row Col\n  | AliasName Row Col\n  | AliasEquals Row Col\n  | AliasBody Type Row Col\n  --\n  | AliasIndentEquals Row Col\n  | AliasIndentBody Row Col\n\n\ndata CustomType\n  = CT_Space Space Row Col\n  | CT_Name Row Col\n  | CT_Equals Row Col\n  | CT_Bar Row Col\n  | CT_Variant Row Col\n  | CT_VariantArg Type Row Col\n  --\n  | CT_IndentEquals Row Col\n  | CT_IndentBar Row Col\n  | CT_IndentAfterBar Row Col\n  | CT_IndentAfterEquals Row Col\n\n\n\n-- EXPRESSIONS\n\n\ndata Expr\n  = Let Let Row Col\n  | Case Case Row Col\n  | If If Row Col\n  | List List Row Col\n  | Record Record Row Col\n  | Tuple Tuple Row Col\n  | Func Func Row Col\n  --\n  | Dot Row Col\n  | Access Row Col\n  | OperatorRight Name.Name Row Col\n  | OperatorReserved BadOperator Row Col\n  --\n  | Start Row Col\n  | Char Char Row Col\n  | String String Row Col\n  | Number Number Row Col\n  | Space Space Row Col\n  | EndlessShader Row Col\n  | ShaderProblem [Char.Char] Row Col\n  | IndentOperatorRight Name.Name Row Col\n\n\ndata Record\n  = RecordOpen Row Col\n  | RecordEnd Row Col\n  | RecordField Row Col\n  | RecordEquals Row Col\n  | RecordExpr Expr Row Col\n  | RecordSpace Space Row Col\n  --\n  | RecordIndentOpen Row Col\n  | RecordIndentEnd Row Col\n  | RecordIndentField Row Col\n  | RecordIndentEquals Row Col\n  | RecordIndentExpr Row Col\n\n\ndata Tuple\n  = TupleExpr Expr Row Col\n  | TupleSpace Space Row Col\n  | TupleEnd Row Col\n  | TupleOperatorClose Row Col\n  | TupleOperatorReserved BadOperator Row Col\n  --\n  | TupleIndentExpr1 Row Col\n  | TupleIndentExprN Row Col\n  | TupleIndentEnd Row Col\n\n\ndata List\n  = ListSpace Space Row Col\n  | ListOpen Row Col\n  | ListExpr Expr Row Col\n  | ListEnd Row Col\n  --\n  | ListIndentOpen Row Col\n  | ListIndentEnd Row Col\n  | ListIndentExpr Row Col\n\n\ndata Func\n  = FuncSpace Space Row Col\n  | FuncArg Pattern Row Col\n  | FuncBody Expr Row Col\n  | FuncArrow Row Col\n  --\n  | FuncIndentArg Row Col\n  | FuncIndentArrow Row Col\n  | FuncIndentBody Row Col\n\n\ndata Case\n  = CaseSpace Space Row Col\n  | CaseOf Row Col\n  | CasePattern Pattern Row Col\n  | CaseArrow Row Col\n  | CaseExpr Expr Row Col\n  | CaseBranch Expr Row Col\n  --\n  | CaseIndentOf Row Col\n  | CaseIndentExpr Row Col\n  | CaseIndentPattern Row Col\n  | CaseIndentArrow Row Col\n  | CaseIndentBranch Row Col\n  | CasePatternAlignment Word16 Row Col\n\n\ndata If\n  = IfSpace Space Row Col\n  | IfThen Row Col\n  | IfElse Row Col\n  | IfElseBranchStart Row Col\n  --\n  | IfCondition Expr Row Col\n  | IfThenBranch Expr Row Col\n  | IfElseBranch Expr Row Col\n  --\n  | IfIndentCondition Row Col\n  | IfIndentThen Row Col\n  | IfIndentThenBranch Row Col\n  | IfIndentElseBranch Row Col\n  | IfIndentElse Row Col\n\n\ndata Let\n  = LetSpace Space Row Col\n  | LetIn Row Col\n  | LetDefAlignment Word16 Row Col\n  | LetDefName Row Col\n  | LetDef Name.Name Def Row Col\n  | LetDestruct Destruct Row Col\n  | LetBody Expr Row Col\n  | LetIndentDef Row Col\n  | LetIndentIn Row Col\n  | LetIndentBody Row Col\n\n\ndata Def\n  = DefSpace Space Row Col\n  | DefType Type Row Col\n  | DefNameRepeat Row Col\n  | DefNameMatch Name.Name Row Col\n  | DefArg Pattern Row Col\n  | DefEquals Row Col\n  | DefBody Expr Row Col\n  | DefIndentEquals Row Col\n  | DefIndentType Row Col\n  | DefIndentBody Row Col\n  | DefAlignment Word16 Row Col\n\n\ndata Destruct\n  = DestructSpace Space Row Col\n  | DestructPattern Pattern Row Col\n  | DestructEquals Row Col\n  | DestructBody Expr Row Col\n  | DestructIndentEquals Row Col\n  | DestructIndentBody Row Col\n\n\n\n-- PATTERNS\n\n\ndata Pattern\n  = PRecord PRecord Row Col\n  | PTuple PTuple Row Col\n  | PList PList Row Col\n  --\n  | PStart Row Col\n  | PChar Char Row Col\n  | PString String Row Col\n  | PNumber Number Row Col\n  | PFloat Word16 Row Col\n  | PAlias Row Col\n  | PWildcardNotVar Name.Name Int Row Col\n  | PSpace Space Row Col\n  --\n  | PIndentStart Row Col\n  | PIndentAlias Row Col\n\n\ndata PRecord\n  = PRecordOpen Row Col\n  | PRecordEnd Row Col\n  | PRecordField Row Col\n  | PRecordSpace Space Row Col\n  --\n  | PRecordIndentOpen Row Col\n  | PRecordIndentEnd Row Col\n  | PRecordIndentField Row Col\n\n\ndata PTuple\n  = PTupleOpen Row Col\n  | PTupleEnd Row Col\n  | PTupleExpr Pattern Row Col\n  | PTupleSpace Space Row Col\n  --\n  | PTupleIndentEnd Row Col\n  | PTupleIndentExpr1 Row Col\n  | PTupleIndentExprN Row Col\n\n\ndata PList\n  = PListOpen Row Col\n  | PListEnd Row Col\n  | PListExpr Pattern Row Col\n  | PListSpace Space Row Col\n  --\n  | PListIndentOpen Row Col\n  | PListIndentEnd Row Col\n  | PListIndentExpr Row Col\n\n\n\n-- TYPES\n\n\ndata Type\n  = TRecord TRecord Row Col\n  | TTuple TTuple Row Col\n  --\n  | TStart Row Col\n  | TSpace Space Row Col\n  --\n  | TIndentStart Row Col\n\n\ndata TRecord\n  = TRecordOpen Row Col\n  | TRecordEnd Row Col\n  --\n  | TRecordField Row Col\n  | TRecordColon Row Col\n  | TRecordType Type Row Col\n  --\n  | TRecordSpace Space Row Col\n  --\n  | TRecordIndentOpen Row Col\n  | TRecordIndentField Row Col\n  | TRecordIndentColon Row Col\n  | TRecordIndentType Row Col\n  | TRecordIndentEnd Row Col\n\n\ndata TTuple\n  = TTupleOpen Row Col\n  | TTupleEnd Row Col\n  | TTupleType Type Row Col\n  | TTupleSpace Space Row Col\n  --\n  | TTupleIndentType1 Row Col\n  | TTupleIndentTypeN Row Col\n  | TTupleIndentEnd Row Col\n\n\n\n-- LITERALS\n\n\ndata Char\n  = CharEndless\n  | CharEscape Escape\n  | CharNotString Word16\n\n\ndata String\n  = StringEndless_Single\n  | StringEndless_Multi\n  | StringEscape Escape\n\n\ndata Escape\n  = EscapeUnknown\n  | BadUnicodeFormat Word16\n  | BadUnicodeCode Word16\n  | BadUnicodeLength Word16 Int Int\n\n\ndata Number\n  = NumberEnd\n  | NumberDot Int\n  | NumberHexDigit\n  | NumberNoLeadingZero\n\n\n\n-- MISC\n\n\ndata Space\n  = HasTab\n  | EndlessMultiComment\n\n\n\n-- TO REPORT\n\n\ntoReport :: Code.Source -> Error -> Report.Report\ntoReport source err =\n  case err of\n    ModuleNameUnspecified name ->\n      let\n        region = toRegion 1 1\n      in\n      Report.Report \"MODULE NAME MISSING\" region [] $\n        D.stack\n          [ D.reflow $\n              \"I need the module name to be declared at the top of this file, like this:\"\n          , D.indent 4 $ D.fillSep $\n              [ D.cyan \"module\", D.fromName name, D.cyan \"exposing\", \"(..)\" ]\n          , D.reflow $\n              \"Try adding that as the first line of your file!\"\n          , D.toSimpleNote $\n              \"It is best to replace (..) with an explicit list of types and\\\n              \\ functions you want to expose. When you know a value is only used\\\n              \\ within this module, you can refactor without worrying about uses\\\n              \\ elsewhere. Limiting exposed values can also speed up compilation\\\n              \\ because I can skip a bunch of work if I see that the exposed API\\\n              \\ has not changed.\"\n          ]\n\n    ModuleNameMismatch expectedName (A.At region actualName) ->\n      Report.Report \"MODULE NAME MISMATCH\" region [ModuleName.toChars expectedName] $\n        Code.toSnippet source region Nothing\n          (\n            \"It looks like this module name is out of sync:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I need it to match the file path, so I was expecting to see `\"\n                  ++ ModuleName.toChars expectedName\n                  ++ \"` here. Make the following change, and you should be all set!\"\n              , D.indent 4 $\n                  D.dullyellow (D.fromName actualName) <> \" -> \" <> D.green (D.fromName expectedName)\n              , D.toSimpleNote $\n                  \"I require that module names correspond to file paths. This makes it much\\\n                  \\ easier to explore unfamiliar codebases! So if you want to keep the current\\\n                  \\ module name, try renaming the file instead.\"\n              ]\n          )\n\n    UnexpectedPort region ->\n      Report.Report \"UNEXPECTED PORTS\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"You are declaring ports in a normal module.\"\n          ,\n            D.stack\n              [ D.fillSep\n                  [\"Switch\",\"this\",\"to\",\"say\",D.cyan \"port module\",\"instead,\"\n                  ,\"marking\",\"that\",\"this\",\"module\",\"contains\",\"port\",\"declarations.\"\n                  ]\n              , D.link \"Note\"\n                  \"Ports are not a traditional FFI for calling JS functions directly. They need a different mindset! Read\"\n                  \"ports\"\n                  \"to learn the syntax and how to use it effectively.\"\n              ]\n          )\n\n    NoPorts region ->\n      Report.Report \"NO PORTS\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"This module does not declare any ports, but it says it will:\"\n          ,\n            D.fillSep\n              [\"Switch\",\"this\",\"to\",D.cyan \"module\"\n              ,\"and\",\"you\",\"should\",\"be\",\"all\",\"set!\"\n              ]\n          )\n\n    NoPortsInPackage (A.At region _) ->\n      Report.Report \"PACKAGES CANNOT HAVE PORTS\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"Packages cannot declare any ports, so I am getting stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Remove this port declaration.\"\n              , noteForPortsInPackage\n              ]\n          )\n\n    NoPortModulesInPackage region ->\n      Report.Report \"PACKAGES CANNOT HAVE PORTS\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"Packages cannot declare any ports, so I am getting stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Remove\",\"the\",D.cyan \"port\",\"keyword\",\"and\",\"I\"\n                  ,\"should\",\"be\",\"able\",\"to\",\"continue.\"\n                  ]\n              , noteForPortsInPackage\n              ]\n          )\n\n    NoEffectsOutsideKernel region ->\n      Report.Report \"INVALID EFFECT MODULE\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"It is not possible to declare an `effect module` outside the @elm organization,\\\n              \\ so I am getting stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Switch to a normal module declaration.\"\n              , D.toSimpleNote $\n                  \"Effect modules are designed to allow certain core functionality to be\\\n                  \\ defined separately from the compiler. So the @elm organization has access to\\\n                  \\ this so that certain changes, extensions, and fixes can be introduced without\\\n                  \\ needing to release new Elm binaries. For example, we want to make it possible\\\n                  \\ to test effects, but this may require changes to the design of effect modules.\\\n                  \\ By only having them defined in the @elm organization, that kind of design work\\\n                  \\ can proceed much more smoothly.\"\n              ]\n          )\n\n    ParseError modul ->\n      toParseErrorReport source modul\n\n\nnoteForPortsInPackage :: D.Doc\nnoteForPortsInPackage =\n  D.stack\n    [ D.toSimpleNote $\n        \"One of the major goals of the package ecosystem is to be completely written\\\n        \\ in Elm. This means when you install an Elm package, you can be sure you are safe\\\n        \\ from security issues on install and that you are not going to get any runtime\\\n        \\ exceptions coming from your new dependency. This design also sets the ecosystem\\\n        \\ up to target other platforms more easily (like mobile phones, WebAssembly, etc.)\\\n        \\ since no community code explicitly depends on JavaScript even existing.\"\n    , D.reflow $\n        \"Given that overall goal, allowing ports in packages would lead to some pretty\\\n        \\ surprising behavior. If ports were allowed in packages, you could install a\\\n        \\ package but not realize that it brings in an indirect dependency that defines a\\\n        \\ port. Now you have a program that does not work and the fix is to realize that\\\n        \\ some JavaScript needs to be added for a dependency you did not even know about.\\\n        \\ That would be extremely frustrating! \\\"So why not allow the package author to\\\n        \\ include the necessary JS code as well?\\\" Now we are back in conflict with our\\\n        \\ overall goal to keep all community packages free from runtime exceptions.\"\n    ]\n\n\ntoParseErrorReport :: Code.Source -> Module -> Report.Report\ntoParseErrorReport source modul =\n  case modul of\n    ModuleSpace space row col ->\n      toSpaceReport source space row col\n\n    ModuleBadEnd row col ->\n      if col == 1\n      then toDeclStartReport source row col\n      else toWeirdEndReport source row col\n\n    ModuleProblem row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED MODULE DECLARATION\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I am parsing an `module` declaration, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Here are some examples of valid `module` declarations:\"\n              , D.indent 4 $ D.vcat $\n                  [ D.fillSep [D.cyan \"module\",\"Main\",D.cyan \"exposing\",\"(..)\"]\n                  , D.fillSep [D.cyan \"module\",\"Dict\",D.cyan \"exposing\",\"(Dict, empty, get)\"]\n                  ]\n              , D.reflow $\n                  \"I generally recommend using an explicit exposing list. I can skip compiling a bunch\\\n                  \\ of files when the public interface of a module stays the same, so exposing fewer\\\n                  \\ values can help improve compile times!\"\n              ]\n          )\n\n    ModuleName row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"EXPECTING MODULE NAME\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I was parsing an `module` declaration until I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see the module name next, like in these examples:\"\n              , D.indent 4 $ D.vcat $\n                  [ D.fillSep [D.cyan \"module\",\"Dict\",D.cyan \"exposing\",\"(..)\"]\n                  , D.fillSep [D.cyan \"module\",\"Maybe\",D.cyan \"exposing\",\"(..)\"]\n                  , D.fillSep [D.cyan \"module\",\"Html.Attributes\",D.cyan \"exposing\",\"(..)\"]\n                  , D.fillSep [D.cyan \"module\",\"Json.Decode\",D.cyan \"exposing\",\"(..)\"]\n                  ]\n              , D.reflow $\n                  \"Notice that the module names all start with capital letters. That is required!\"\n              ]\n          )\n\n    ModuleExposing exposing row col ->\n      toExposingReport source exposing row col\n\n    PortModuleProblem row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PORT MODULE DECLARATION\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I am parsing an `port module` declaration, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Here are some examples of valid `port module` declarations:\"\n              , D.indent 4 $ D.vcat $\n                  [ D.fillSep [D.cyan \"port\",D.cyan \"module\",\"WebSockets\",D.cyan \"exposing\",\"(send, listen, keepAlive)\"]\n                  , D.fillSep [D.cyan \"port\",D.cyan \"module\",\"Maps\",D.cyan \"exposing\",\"(Location, goto)\"]\n                  ]\n              , D.link \"Note\" \"Read\" \"ports\" \"for more help.\"\n              ]\n          )\n\n    PortModuleName row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"EXPECTING MODULE NAME\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I was parsing an `module` declaration until I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see the module name next, like in these examples:\"\n              , D.indent 4 $ D.vcat $\n                  [ D.fillSep [D.cyan \"port\",D.cyan \"module\",\"WebSockets\",D.cyan \"exposing\",\"(send, listen, keepAlive)\"]\n                  , D.fillSep [D.cyan \"port\",D.cyan \"module\",\"Maps\",D.cyan \"exposing\",\"(Location, goto)\"]\n                  ]\n              , D.reflow $\n                  \"Notice that the module names start with capital letters. That is required!\"\n              ]\n          )\n\n    PortModuleExposing exposing row col ->\n      toExposingReport source exposing row col\n\n    Effect row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"BAD MODULE DECLARATION\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I cannot parse this module declaration:\"\n          ,\n            D.reflow $\n              \"This type of module is reserved for the @elm organization. It is used to\\\n              \\ define certain effects, avoiding building them into the compiler.\"\n          )\n\n    FreshLine row col ->\n      let\n        region = toRegion row col\n\n        toBadFirstLineReport keyword =\n          Report.Report \"TOO MUCH INDENTATION\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                D.reflow $\n                  \"This `\" ++ keyword ++ \"` should not have any spaces before it:\"\n              ,\n                D.reflow $\n                  \"Delete the spaces before `\" ++ keyword ++ \"` until there are none left!\"\n              )\n\n      in\n      case Code.whatIsNext source row col of\n        Code.Keyword \"module\" -> toBadFirstLineReport \"module\"\n        Code.Keyword \"import\" -> toBadFirstLineReport \"import\"\n        Code.Keyword \"type\" -> toBadFirstLineReport \"type\"\n        Code.Keyword \"port\" -> toBadFirstLineReport \"port\"\n        _ ->\n          Report.Report \"SYNTAX PROBLEM\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                D.reflow $\n                  \"I got stuck here:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I am not sure what is going on, but I recommend starting an Elm\\\n                      \\ file with the following lines:\"\n                  , D.indent 4 $ D.vcat $\n                      [ D.fillSep [D.cyan \"import\",\"Html\"]\n                      , \"\"\n                      , \"main =\"\n                      , \"  Html.text \" <> D.dullyellow \"\\\"Hello!\\\"\"\n                      ]\n                  , D.reflow $\n                      \"You should be able to copy those lines directly into your file. Check out the\\\n                      \\ examples at <https://elm-lang.org/examples> for more help getting started!\"\n                  , D.toSimpleNote $\n                      \"This can also happen when something is indented too much!\"\n                  ]\n              )\n\n    ImportStart row col ->\n      toImportReport source row col\n\n    ImportName row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"EXPECTING IMPORT NAME\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I was parsing an `import` until I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see a module name next, like in these examples:\"\n              , D.indent 4 $ D.vcat $\n                  [ D.fillSep [D.cyan \"import\",\"Dict\"]\n                  , D.fillSep [D.cyan \"import\",\"Maybe\"]\n                  , D.fillSep [D.cyan \"import\",\"Html.Attributes\",D.cyan \"as\",\"A\"]\n                  , D.fillSep [D.cyan \"import\",\"Json.Decode\",D.cyan \"exposing\",\"(..)\"]\n                  ]\n              , D.reflow $\n                  \"Notice that the module names all start with capital letters. That is required!\"\n              , D.reflowLink \"Read\" \"imports\" \"to learn more.\"\n              ]\n          )\n\n    ImportAs row col ->\n      toImportReport source row col\n\n    ImportAlias row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"EXPECTING IMPORT ALIAS\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I was parsing an `import` until I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see an alias next, like in these examples:\"\n              , D.indent 4 $ D.vcat $\n                  [ D.fillSep [D.cyan \"import\",\"Html.Attributes\",D.cyan \"as\",\"Attr\"]\n                  , D.fillSep [D.cyan \"import\",\"WebGL.Texture\",D.cyan \"as\",\"Texture\"]\n                  , D.fillSep [D.cyan \"import\",\"Json.Decode\",D.cyan \"as\",\"D\"]\n                  ]\n              , D.reflow $\n                  \"Notice that the alias always starts with a capital letter. That is required!\"\n              , D.reflowLink \"Read\" \"imports\" \"to learn more.\"\n              ]\n          )\n\n    ImportExposing row col ->\n      toImportReport source row col\n\n    ImportExposingList exposing row col ->\n      toExposingReport source exposing row col\n\n    ImportEnd row col ->\n      toImportReport source row col\n\n    ImportIndentName row col ->\n      toImportReport source row col\n\n    ImportIndentAlias row col ->\n      toImportReport source row col\n\n    ImportIndentExposingList row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED IMPORT\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I was parsing an `import` until I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see the list of exposed values next. For example, here\\\n                  \\ are two ways to expose values from the `Html` module:\"\n              , D.indent 4 $ D.vcat $\n                  [ D.fillSep [D.cyan \"import\",\"Html\",D.cyan \"exposing\",\"(..)\"]\n                  , D.fillSep [D.cyan \"import\",\"Html\",D.cyan \"exposing\",\"(Html, div, text)\"]\n                  ]\n              , D.reflow $\n                  \"I generally recommend the second style. It is more explicit, making it\\\n                  \\ much easier to figure out where values are coming from in large projects!\"\n              ]\n          )\n\n    Infix row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"BAD INFIX\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"Something went wrong in this infix operator declaration:\"\n          ,\n            D.reflow $\n              \"This feature is used by the @elm organization to define the\\\n              \\ languages built-in operators.\"\n          )\n\n    Declarations decl _ _ ->\n      toDeclarationsReport source decl\n\n\n\n-- WEIRD END\n\n\ntoWeirdEndReport :: Code.Source -> Row -> Col -> Report.Report\ntoWeirdEndReport source row col =\n  case Code.whatIsNext source row col of\n    Code.Keyword keyword ->\n      let\n        region = toKeywordRegion row col keyword\n      in\n      Report.Report \"RESERVED WORD\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I got stuck on this reserved word:\"\n          ,\n            D.reflow $\n              \"The name `\" ++ keyword ++ \"` is reserved, so try using a different name?\"\n          )\n\n    Code.Operator op ->\n      let\n        region = toKeywordRegion row col op\n      in\n      Report.Report \"UNEXPECTED SYMBOL\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I ran into an unexpected symbol:\"\n          ,\n            D.reflow $\n              \"I was not expecting to see a \" ++ op ++ \" here. Try deleting it? Maybe\\\n              \\ I can give a better hint from there?\"\n          )\n\n    Code.Close term bracket ->\n      let\n        region = toRegion row col\n      in\n      Report.Report (\"UNEXPECTED \" ++ map Char.toUpper term) region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I ran into an unexpected \" ++ term ++ \":\"\n          ,\n            D.reflow $\n              \"This \" ++ bracket : \" does not match up with an earlier open \" ++ term ++ \". Try deleting it?\"\n          )\n\n    Code.Lower c cs ->\n      let\n        region = toKeywordRegion row col (c:cs)\n      in\n      Report.Report \"UNEXPECTED NAME\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I got stuck on this name:\"\n          ,\n            D.reflow $\n              \"It is confusing me a lot! Normally I can give fairly specific hints, but\\\n              \\ something is really tripping me up this time.\"\n          )\n\n    Code.Upper c cs ->\n      let\n        region = toKeywordRegion row col (c:cs)\n      in\n      Report.Report \"UNEXPECTED NAME\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I got stuck on this name:\"\n          ,\n            D.reflow $\n              \"It is confusing me a lot! Normally I can give fairly specific hints, but\\\n              \\ something is really tripping me up this time.\"\n          )\n\n    Code.Other maybeChar ->\n      let\n        region = toRegion row col\n      in\n      case maybeChar of\n        Just ';' ->\n          Report.Report \"UNEXPECTED SEMICOLON\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                D.reflow $\n                  \"I got stuck on this semicolon:\"\n              ,\n                D.stack\n                  [ D.reflow $ \"Try removing it?\"\n                  , D.toSimpleNote $\n                      \"Some languages require semicolons at the end of each statement. These are\\\n                      \\ often called C-like languages, and they usually share a lot of language design\\\n                      \\ choices. (E.g. side-effects, for loops, etc.) Elm manages effects with commands\\\n                      \\ and subscriptions instead, so there is no special syntax for \\\"statements\\\" and\\\n                      \\ therefore no need to use semicolons to separate them. I think this will make\\\n                      \\ more sense as you work through <https://guide.elm-lang.org> though!\"\n                  ]\n              )\n\n        Just ',' ->\n          Report.Report \"UNEXPECTED COMMA\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                D.reflow $\n                  \"I got stuck on this comma:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I do not think I am parsing a list or tuple right now. Try deleting the comma?\"\n                  , D.toSimpleNote $\n                      \"If this is supposed to be part of a list, the problem may be a bit earlier.\\\n                      \\ Perhaps the opening [ is missing? Or perhaps some value in the list has an extra\\\n                      \\ closing ] that is making me think the list ended earlier? The same kinds of\\\n                      \\ things could be going wrong if this is supposed to be a tuple.\"\n                  ]\n              )\n\n        Just '`' ->\n          Report.Report \"UNEXPECTED CHARACTER\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                D.reflow $\n                  \"I got stuck on this character:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"It is not used for anything in Elm syntax. It is used for multi-line strings in\\\n                      \\ some languages though, so if you want a string that spans multiple lines, you\\\n                      \\ can use Elm's multi-line string syntax like this:\"\n                  , D.dullyellow $ D.indent 4 $ D.vcat $\n                      [ \"\\\"\\\"\\\"\"\n                      , \"# Multi-line Strings\"\n                      , \"\"\n                      , \"- start with triple double quotes\"\n                      , \"- write whatever you want\"\n                      , \"- no need to escape newlines or double quotes\"\n                      , \"- end with triple double quotes\"\n                      , \"\\\"\\\"\\\"\"\n                      ]\n                  , D.reflow $\n                      \"Otherwise I do not know what is going on! Try removing the character?\"\n                  ]\n              )\n\n        Just '$' ->\n          Report.Report \"UNEXPECTED SYMBOL\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                D.reflow $\n                  \"I got stuck on this dollar sign:\"\n              ,\n                D.reflow $\n                  \"It is not used for anything in Elm syntax. Are you coming from a language where\\\n                  \\ dollar signs can be used in variable names? If so, try a name that (1) starts\\\n                  \\ with a letter and (2) only contains letters, numbers, and underscores.\"\n              )\n\n        Just c | elem c ['#','@','!','%','~'] ->\n          Report.Report \"UNEXPECTED SYMBOL\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                D.reflow $\n                  \"I got stuck on this symbol:\"\n              ,\n                D.reflow $\n                  \"It is not used for anything in Elm syntax. Try removing it?\"\n              )\n\n        _ ->\n          Report.Report \"SYNTAX PROBLEM\" region [] $\n            Code.toSnippet source region Nothing\n              (\n                D.reflow $\n                  \"I got stuck here:\"\n              ,\n                D.reflow $\n                  \"Whatever I am running into is confusing me a lot! Normally I can give fairly\\\n                  \\ specific hints, but something is really tripping me up this time.\"\n              )\n\n\n\n-- IMPORTS\n\n\ntoImportReport :: Code.Source -> Row -> Col -> Report.Report\ntoImportReport source row col =\n  let\n    region = toRegion row col\n  in\n  Report.Report \"UNFINISHED IMPORT\" region [] $\n    Code.toSnippet source region Nothing\n      (\n        D.reflow $\n          \"I am partway through parsing an import, but I got stuck here:\"\n      ,\n        D.stack\n          [ D.reflow $\n              \"Here are some examples of valid `import` declarations:\"\n          , D.indent 4 $ D.vcat $\n              [ D.fillSep [D.cyan \"import\",\"Html\"]\n              , D.fillSep [D.cyan \"import\",\"Html\",D.cyan \"as\",\"H\"]\n              , D.fillSep [D.cyan \"import\",\"Html\",D.cyan \"as\",\"H\",D.cyan \"exposing\",\"(..)\"]\n              , D.fillSep [D.cyan \"import\",\"Html\",D.cyan \"exposing\",\"(Html, div, text)\"]\n              ]\n          , D.reflow $\n              \"You are probably trying to import a different module, but try to make it look like one of these examples!\"\n          , D.reflowLink \"Read\" \"imports\" \"to learn more.\"\n          ]\n      )\n\n\n\n-- EXPOSING\n\n\ntoExposingReport :: Code.Source -> Exposing -> Row -> Col -> Report.Report\ntoExposingReport source exposing startRow startCol =\n  case exposing of\n    ExposingSpace space row col ->\n      toSpaceReport source space row col\n\n    ExposingStart row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"PROBLEM IN EXPOSING\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I want to parse exposed values, but I am getting stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Exposed\",\"values\",\"are\",\"always\",\"surrounded\",\"by\",\"parentheses.\"\n                  ,\"So\",\"try\",\"adding\",\"a\",D.green \"(\",\"here?\"\n                  ]\n              , D.toSimpleNote \"Here are some valid examples of `exposing` for reference:\"\n              , D.indent 4 $ D.vcat $\n                  [ D.fillSep [D.cyan \"import\",\"Html\",D.cyan \"exposing\",\"(..)\"]\n                  , D.fillSep [D.cyan \"import\",\"Html\",D.cyan \"exposing\",\"(Html, div, text)\"]\n                  ]\n              , D.reflow $\n                  \"If you are getting tripped up, you can just expose everything for now. It should\\\n                  \\ get easier to make an explicit exposing list as you see more examples in the wild.\"\n              ]\n          )\n\n    ExposingValue row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I got stuck on this reserved word:\"\n              ,\n                D.reflow $\n                  \"It looks like you are trying to expose `\" ++ keyword ++ \"` but that is a reserved word. Is there a typo?\"\n              )\n\n        Code.Operator op ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col op\n          in\n          Report.Report \"UNEXPECTED SYMBOL\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I got stuck on this symbol:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"If you are trying to expose an operator, add parentheses around it like this:\"\n                  , D.indent 4 $ D.dullyellow (D.fromChars op) <> \" -> \" <> D.green (\"(\" <> D.fromChars op <> \")\")\n                  ]\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"PROBLEM IN EXPOSING\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I got stuck while parsing these exposed values:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I do not have an exact recommendation, so here are some valid examples\\\n                      \\ of `exposing` for reference:\"\n                  , D.indent 4 $ D.vcat $\n                      [ D.fillSep [D.cyan \"import\",\"Html\",D.cyan \"exposing\",\"(..)\"]\n                      , D.fillSep [D.cyan \"import\",\"Basics\",D.cyan \"exposing\",\"(Int, Float, Bool(..), (+), not, sqrt)\"]\n                      ]\n                  , D.reflow $\n                      \"These examples show how to expose types, variants, operators, and functions. Everything\\\n                      \\ should be some permutation of these examples, just with different names.\"\n                  ]\n              )\n\n    ExposingOperator row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"PROBLEM IN EXPOSING\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw an open parenthesis, so I was expecting an operator next:\"\n          ,\n            D.fillSep $\n              [\"It\",\"is\",\"possible\",\"to\",\"expose\",\"operators,\",\"so\",\"I\",\"was\",\"expecting\"\n              ,\"to\",\"see\",\"something\",\"like\",D.dullyellow \"(+)\",\"or\",D.dullyellow \"(|=)\"\n              ,\"or\",D.dullyellow \"(||)\",\"after\",\"I\",\"saw\",\"that\",\"open\",\"parenthesis.\"\n              ]\n          )\n\n    ExposingOperatorReserved op row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"RESERVED SYMBOL\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I cannot expose this as an operator:\"\n          ,\n            case op of\n              BadDot -> D.reflow \"Try getting rid of this entry? Maybe I can give you a better hint after that?\"\n              BadPipe -> D.fillSep [\"Maybe\",\"you\",\"want\",D.dullyellow \"(||)\",\"instead?\"]\n              BadArrow -> D.reflow \"Try getting rid of this entry? Maybe I can give you a better hint after that?\"\n              BadEquals -> D.fillSep [\"Maybe\",\"you\",\"want\",D.dullyellow \"(==)\",\"instead?\"]\n              BadHasType -> D.fillSep [\"Maybe\",\"you\",\"want\",D.dullyellow \"(::)\",\"instead?\"]\n          )\n\n    ExposingOperatorRightParen row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"PROBLEM IN EXPOSING\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"It looks like you are exposing an operator, but I got stuck here:\"\n          ,\n            D.fillSep $\n              [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"the\",\"closing\",\"parenthesis\",\"immediately\"\n              ,\"after\",\"the\",\"operator.\",\"Try\",\"adding\",\"a\",D.green \")\",\"right\",\"here?\"\n              ]\n          )\n\n    ExposingEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED EXPOSING\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was partway through parsing exposed values, but I got stuck here:\"\n          ,\n            D.reflow $\n              \"Maybe there is a comma missing before this?\"\n          )\n\n    ExposingTypePrivacy row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"PROBLEM EXPOSING CUSTOM TYPE VARIANTS\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"It looks like you are trying to expose the variants of a custom type:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"You\",\"need\",\"to\",\"write\",\"something\",\"like\"\n                  ,D.dullyellow \"Status(..)\",\"or\",D.dullyellow \"Entity(..)\"\n                  ,\"though.\",\"It\",\"is\",\"all\",\"or\",\"nothing,\",\"otherwise\",\"`case`\"\n                  ,\"expressions\",\"could\",\"miss\",\"a\",\"variant\",\"and\",\"crash!\"\n                  ]\n              , D.toSimpleNote $\n                  \"It is often best to keep the variants hidden! If someone pattern matches on\\\n                  \\ the variants, it is a MAJOR change if any new variants are added. Suddenly\\\n                  \\ their `case` expressions do not cover all variants! So if you do not need\\\n                  \\ people to pattern match, keep the variants hidden and expose functions to\\\n                  \\ construct values of this type. This way you can add new variants as a MINOR change!\"\n              ]\n          )\n\n    ExposingIndentEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED EXPOSING\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was partway through parsing exposed values, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"a\",\"closing\",\"parenthesis.\"\n                  ,\"Try\",\"adding\",\"a\",D.green \")\",\"right\",\"here?\"\n                  ]\n              , D.toSimpleNote $\n                  \"I can get confused when there is not enough indentation, so if you already\\\n                  \\ have a closing parenthesis, it probably just needs some spaces in front of it.\"\n              ]\n          )\n\n    ExposingIndentValue row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED EXPOSING\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was partway through parsing exposed values, but I got stuck here:\"\n          ,\n            D.reflow $\n              \"I was expecting another value to expose.\"\n          )\n\n\n\n-- SPACES\n\n\ntoSpaceReport :: Code.Source -> Space -> Row -> Col -> Report.Report\ntoSpaceReport source space row col =\n  case space of\n    HasTab ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"NO TABS\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I ran into a tab, but tabs are not allowed in Elm files.\"\n          ,\n            D.reflow $\n              \"Replace the tab with spaces.\"\n          )\n\n    EndlessMultiComment ->\n      let\n        region = toWiderRegion row col 2\n      in\n      Report.Report \"ENDLESS COMMENT\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I cannot find the end of this multi-line comment:\"\n          ,\n            D.stack -- \"{-\"\n              [ D.reflow \"Add a -} somewhere after this to end the comment.\"\n              , D.toSimpleHint\n                  \"Multi-line comments can be nested in Elm, so {- {- -} -} is a comment\\\n                  \\ that happens to contain another comment. Like parentheses and curly braces,\\\n                  \\ the start and end markers must always be balanced. Maybe that is the problem?\"\n              ]\n          )\n\n\n\n-- DECLARATIONS\n\n\ntoRegion :: Row -> Col -> A.Region\ntoRegion row col =\n  let\n    pos = A.Position row col\n  in\n  A.Region pos pos\n\n\ntoWiderRegion :: Row -> Col -> Word16 -> A.Region\ntoWiderRegion row col extra =\n  A.Region\n    (A.Position row col)\n    (A.Position row (col + extra))\n\n\ntoKeywordRegion :: Row -> Col -> [Char.Char] -> A.Region\ntoKeywordRegion row col keyword =\n  A.Region\n    (A.Position row col)\n    (A.Position row (col + fromIntegral (length keyword)))\n\n\ntoDeclarationsReport :: Code.Source -> Decl -> Report.Report\ntoDeclarationsReport source decl =\n  case decl of\n    DeclStart row col ->\n      toDeclStartReport source row col\n\n    DeclSpace space row col ->\n      toSpaceReport source space row col\n\n    Port port_ row col ->\n      toPortReport source port_ row col\n\n    DeclType declType row col ->\n      toDeclTypeReport source declType row col\n\n    DeclDef name declDef row col ->\n      toDeclDefReport source name declDef row col\n\n    DeclFreshLineAfterDocComment row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"EXPECTING DECLARATION\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I just saw a doc comment, but then I got stuck here:\"\n          ,\n            D.reflow $\n              \"I was expecting to see the corresponding declaration next, starting on a fresh\\\n              \\ line with no indentation.\"\n          )\n\n\ntoDeclStartReport :: Code.Source -> Row -> Col -> Report.Report\ntoDeclStartReport source row col =\n  case Code.whatIsNext source row col of\n    Code.Close term bracket ->\n      let\n        region = toRegion row col\n      in\n      Report.Report (\"STRAY \" ++ map Char.toUpper term) region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I was not expecting to see a \" ++ term ++ \" here:\"\n          , D.reflow $\n              \"This \" ++ bracket : \" does not match up with an earlier open \" ++ term ++ \". Try deleting it?\"\n          )\n\n    Code.Keyword keyword ->\n      let\n        region = toKeywordRegion row col keyword\n      in\n      Report.Report \"RESERVED WORD\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I was not expecting to run into the `\" ++ keyword ++ \"` keyword here:\"\n          ,\n            case keyword of\n              \"import\" ->\n                D.reflow $\n                  \"It is reserved for declaring imports at the top of your module. If you want\\\n                  \\ another import, try moving it up top with the other imports. If you want to\\\n                  \\ define a value or function, try changing the name to something else!\"\n\n              \"case\" ->\n                D.stack\n                  [ D.reflow $\n                      \"It is reserved for writing `case` expressions. Try using a different name?\"\n                  , D.toSimpleNote $\n                      \"If you are trying to write a `case` expression, it needs to be part of a\\\n                      \\ definition. So you could write something like this instead:\"\n                  , D.indent 4 $ D.vcat $\n                      [ D.indent 0 $ D.fillSep [\"getWidth\",\"maybeWidth\",\"=\"]\n                      , D.indent 2 $ D.fillSep [D.cyan \"case\",\"maybeWidth\",D.cyan \"of\"]\n                      , D.indent 4 $ D.fillSep [D.blue \"Just\",\"width\",\"->\"]\n                      , D.indent 6 $ D.fillSep [\"width\",\"+\",D.dullyellow \"200\"]\n                      , \"\"\n                      , D.indent 4 $ D.fillSep [D.blue \"Nothing\",\"->\"]\n                      , D.indent 6 $ D.fillSep [D.dullyellow \"400\"]\n                      ]\n                  , D.reflow $\n                      \"This defines a `getWidth` function that you can use elsewhere in your program.\"\n                  ]\n\n              \"if\" ->\n                D.stack\n                  [ D.reflow $\n                      \"It is reserved for writing `if` expressions. Try using a different name?\"\n                  , D.toSimpleNote $\n                      \"If you are trying to write an `if` expression, it needs to be part of a\\\n                      \\ definition. So you could write something like this instead:\"\n                  , D.indent 4 $ D.vcat $\n                      [ \"greet name =\"\n                      , D.fillSep $\n                          [\" \"\n                          ,D.cyan \"if\",\"name\",\"==\",D.dullyellow \"\\\"Abraham Lincoln\\\"\"\n                          ,D.cyan \"then\",D.dullyellow \"\\\"Greetings Mr. President.\\\"\"\n                          ,D.cyan \"else\",D.dullyellow \"\\\"Hey!\\\"\"\n                          ]\n                      ]\n                  , D.reflow $\n                      \"This defines a `reviewPowerLevel` function that you can use elsewhere in your program.\"\n                  ]\n\n              _ ->\n                D.reflow $\n                  \"It is a reserved word. Try changing the name to something else?\"\n          )\n\n    Code.Upper c cs ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"UNEXPECTED CAPITAL LETTER\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"Declarations always start with a lower-case letter, so I am getting stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Try\",\"a\",\"name\",\"like\"\n                  ,D.green (D.fromChars (Char.toLower c : cs))\n                  ,\"instead?\"\n                  ]\n              , D.toSimpleNote $\n                  \"Here are a couple valid declarations for reference:\"\n              , D.indent 4 $ D.vcat $\n                  [ \"greet : String -> String\"\n                  , \"greet name =\"\n                  , \"  \" <> D.dullyellow \"\\\"Hello \\\"\" <> \" ++ name ++ \" <> D.dullyellow \"\\\"!\\\"\"\n                  , \"\"\n                  , D.cyan \"type\" <> \" User = Anonymous | LoggedIn String\"\n                  ]\n              , D.reflow $\n                  \"Notice that they always start with a lower-case letter. Capitalization matters!\"\n              ]\n          )\n\n    Code.Other (Just char) | elem char ['(', '{', '[', '+', '-', '*', '/', '^', '&', '|', '\"', '\\'', '!', '@', '#', '$', '%'] ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"UNEXPECTED SYMBOL\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I am getting stuck because this line starts with the \" ++ [char] ++ \" symbol:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"When a line has no spaces at the beginning, I expect it to be a declaration like one of these:\"\n              , D.indent 4 $ D.vcat $\n                  [ \"greet : String -> String\"\n                  , \"greet name =\"\n                  , \"  \" <> D.dullyellow \"\\\"Hello \\\"\" <> \" ++ name ++ \" <> D.dullyellow \"\\\"!\\\"\"\n                  , \"\"\n                  , D.cyan \"type\" <> \" User = Anonymous | LoggedIn String\"\n                  ]\n              , D.reflow $\n                  \"If this is not supposed to be a declaration, try adding some spaces before it?\"\n              ]\n          )\n\n    _ ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"WEIRD DECLARATION\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I am trying to parse a declaration, but I am getting stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"When a line has no spaces at the beginning, I expect it to be a declaration like one of these:\"\n              , D.indent 4 $ D.vcat $\n                  [ \"greet : String -> String\"\n                  , \"greet name =\"\n                  , \"  \" <> D.dullyellow \"\\\"Hello \\\"\" <> \" ++ name ++ \" <> D.dullyellow \"\\\"!\\\"\"\n                  , \"\"\n                  , D.cyan \"type\" <> \" User = Anonymous | LoggedIn String\"\n                  ]\n              , D.reflow $\n                  \"Try to make your declaration look like one of those? Or if this is not\\\n                  \\ supposed to be a declaration, try adding some spaces before it?\"\n              ]\n          )\n\n\n-- PORT\n\n\ntoPortReport :: Code.Source -> Port -> Row -> Col -> Report.Report\ntoPortReport source port_ startRow startCol =\n  case port_ of\n    PortSpace space row col ->\n      toSpaceReport source space row col\n\n    PortName row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I cannot handle ports with names like this:\"\n              ,\n                D.reflow $\n                  \"You are trying to make a port named `\" ++ keyword\n                  ++ \"` but that is a reserved word. Try using some other name?\"\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"PORT PROBLEM\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I just saw the start of a `port` declaration, but then I got stuck here:\"\n              ,\n                D.stack\n                  [ D.fillSep\n                      [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"name\",\"like\"\n                      ,D.dullyellow \"send\",\"or\",D.dullyellow \"receive\",\"next.\"\n                      ,\"Something\",\"that\",\"starts\",\"with\",\"a\",\"lower-case\",\"letter.\"\n                      ]\n                  , portNote\n                  ]\n              )\n\n    PortColon row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"PORT PROBLEM\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw the start of a `port` declaration, but then I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see a colon next. And then a type that tells me\\\n                  \\ what type of values are going to flow through.\"\n              , portNote\n              ]\n          )\n\n    PortType tipe row col ->\n      toTypeReport source TC_Port tipe row col\n\n    PortIndentName row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PORT\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw the start of a `port` declaration, but then I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"name\",\"like\"\n                  ,D.dullyellow \"send\",\"or\",D.dullyellow \"receive\",\"next.\"\n                  ,\"Something\",\"that\",\"starts\",\"with\",\"a\",\"lower-case\",\"letter.\"\n                  ]\n              , portNote\n              ]\n          )\n\n    PortIndentColon row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PORT\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw the start of a `port` declaration, but then I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see a colon next. And then a type that tells me\\\n                  \\ what type of values are going to flow through.\"\n              , portNote\n              ]\n          )\n\n    PortIndentType row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PORT\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw the start of a `port` declaration, but then I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see a type next. Here are examples of outgoing and\\\n                  \\ incoming ports for reference:\"\n              , D.indent 4 $ D.vcat $\n                  [ D.fillSep [D.cyan \"port\",\"send\",\":\",\"String -> Cmd msg\"]\n                  , D.fillSep [D.cyan \"port\",\"receive\",\":\",\"(String -> msg) -> Sub msg\"]\n                  ]\n              , D.reflow $\n                  \"The first line defines a `send` port so you can send strings out to JavaScript.\\\n                  \\ Maybe you send them on a WebSocket or put them into IndexedDB. The second line\\\n                  \\ defines a `receive` port so you can receive strings from JavaScript. Maybe you\\\n                  \\ get receive messages when new WebSocket messages come in or when an entry in\\\n                  \\ IndexedDB changes for some external reason.\"\n              ]\n          )\n\n\nportNote :: D.Doc\nportNote =\n  D.stack\n    [ D.toSimpleNote $\n        \"Here are some example `port` declarations for reference:\"\n    , D.indent 4 $ D.vcat $\n        [ D.fillSep [D.cyan \"port\",\"send\",\":\",\"String -> Cmd msg\"]\n        , D.fillSep [D.cyan \"port\",\"receive\",\":\",\"(String -> msg) -> Sub msg\"]\n        ]\n    , D.reflow $\n        \"The first line defines a `send` port so you can send strings out to JavaScript.\\\n        \\ Maybe you send them on a WebSocket or put them into IndexedDB. The second line\\\n        \\ defines a `receive` port so you can receive strings from JavaScript. Maybe you\\\n        \\ get receive messages when new WebSocket messages come in or when the IndexedDB\\\n        \\ is changed for some external reason.\"\n    ]\n\n\n\n-- DECL TYPE\n\n\ntoDeclTypeReport :: Code.Source -> DeclType -> Row -> Col -> Report.Report\ntoDeclTypeReport source declType startRow startCol =\n  case declType of\n    DT_Space space row col ->\n      toSpaceReport source space row col\n\n    DT_Name row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"EXPECTING TYPE NAME\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I think I am parsing a type declaration, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"a\",\"name\",\"like\",D.dullyellow \"Status\",\"or\",D.dullyellow \"Style\"\n                  ,\"next.\",\"Just\",\"make\",\"sure\",\"it\",\"is\",\"a\",\"name\",\"that\",\"starts\",\"with\",\"a\",\"capital\",\"letter!\"\n                  ]\n              , customTypeNote\n              ]\n          )\n\n    DT_Alias typeAlias row col ->\n      toTypeAliasReport source typeAlias row col\n\n    DT_Union customType row col ->\n      toCustomTypeReport source customType row col\n\n    DT_IndentName row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"EXPECTING TYPE NAME\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I think I am parsing a type declaration, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"a\",\"name\",\"like\",D.dullyellow \"Status\",\"or\",D.dullyellow \"Style\"\n                  ,\"next.\",\"Just\",\"make\",\"sure\",\"it\",\"is\",\"a\",\"name\",\"that\",\"starts\",\"with\",\"a\",\"capital\",\"letter!\"\n                  ]\n              , customTypeNote\n              ]\n          )\n\n\ntoTypeAliasReport :: Code.Source -> TypeAlias -> Row -> Col -> Report.Report\ntoTypeAliasReport source typeAlias startRow startCol =\n  case typeAlias of\n    AliasSpace space row col ->\n      toSpaceReport source space row col\n\n    AliasName row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"EXPECTING TYPE ALIAS NAME\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a type alias, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"a\",\"name\",\"like\",D.dullyellow \"Person\",\"or\",D.dullyellow \"Point\"\n                  ,\"next.\",\"Just\",\"make\",\"sure\",\"it\",\"is\",\"a\",\"name\",\"that\",\"starts\",\"with\",\"a\",\"capital\",\"letter!\"\n                  ]\n              , typeAliasNote\n              ]\n          )\n\n    AliasEquals row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I ran into a reserved word unexpectedly while parsing this type alias:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"It looks like you are trying use `\" ++ keyword\n                      ++ \"` as a type variable, but it is a reserved word. Try using a different name?\"\n                  , typeAliasNote\n                  ]\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"PROBLEM IN TYPE ALIAS\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a type alias, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I was expecting to see a type variable or an equals sign next.\"\n                  , typeAliasNote\n                  ]\n              )\n\n    AliasBody tipe row col ->\n      toTypeReport source TC_TypeAlias tipe row col\n\n    AliasIndentEquals row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED TYPE ALIAS\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a type alias, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see a type variable or an equals sign next.\"\n              , typeAliasNote\n              ]\n          )\n\n    AliasIndentBody row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED TYPE ALIAS\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a type alias, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"type\",\"next.\",\"Something\",\"as\",\"simple\"\n                  ,\"as\",D.dullyellow \"Int\",\"or\",D.dullyellow \"Float\",\"would\",\"work!\"\n                  ]\n              , typeAliasNote\n              ]\n          )\n\n\ntypeAliasNote :: D.Doc\ntypeAliasNote =\n  D.stack\n    [ D.toSimpleNote $\n        \"Here is an example of a valid `type alias` for reference:\"\n    , D.vcat $\n        [ D.indent 4 $ D.fillSep [D.cyan \"type\",D.cyan \"alias\",\"Person\",\"=\"]\n        , D.indent 6 $ D.vcat $\n             [\"{ name : String\"\n             ,\", age : Int\"\n             ,\", height : Float\"\n             ,\"}\"\n             ]\n        ]\n    , D.reflow $\n        \"This would let us use `Person` as a shorthand for that record type. Using this\\\n        \\ shorthand makes type annotations much easier to read, and makes changing code\\\n        \\ easier if you decide later that there is more to a person than age and height!\"\n    ]\n\n\ntoCustomTypeReport :: Code.Source -> CustomType -> Row -> Col -> Report.Report\ntoCustomTypeReport source customType startRow startCol =\n  case customType of\n    CT_Space space row col ->\n      toSpaceReport source space row col\n\n    CT_Name row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"EXPECTING TYPE NAME\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I think I am parsing a type declaration, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"a\",\"name\",\"like\",D.dullyellow \"Status\",\"or\",D.dullyellow \"Style\"\n                  ,\"next.\",\"Just\",\"make\",\"sure\",\"it\",\"is\",\"a\",\"name\",\"that\",\"starts\",\"with\",\"a\",\"capital\",\"letter!\"\n                  ]\n              , customTypeNote\n              ]\n          )\n\n    CT_Equals row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I ran into a reserved word unexpectedly while parsing this custom type:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"It looks like you are trying use `\" ++ keyword\n                      ++ \"` as a type variable, but it is a reserved word. Try using a different name?\"\n                  , customTypeNote\n                  ]\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"PROBLEM IN CUSTOM TYPE\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a custom type, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I was expecting to see a type variable or an equals sign next.\"\n                  , customTypeNote\n                  ]\n              )\n\n    CT_Bar row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"PROBLEM IN CUSTOM TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a custom type, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see a vertical bar like | next.\"\n              , customTypeNote\n              ]\n          )\n\n    CT_Variant row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"PROBLEM IN CUSTOM TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a custom type, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"variant\",\"name\",\"next.\"\n                  ,\"Something\",\"like\",D.dullyellow \"Success\",\"or\",D.dullyellow \"Sandwich\" <> \".\"\n                  ,\"Any\",\"name\",\"that\",\"starts\",\"with\",\"a\",\"capital\",\"letter\",\"really!\"\n                  ]\n              , customTypeNote\n              ]\n          )\n\n    CT_VariantArg tipe row col ->\n      toTypeReport source TC_CustomType tipe row col\n\n    CT_IndentEquals row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED CUSTOM TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a custom type, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see a type variable or an equals sign next.\"\n              , customTypeNote\n              ]\n          )\n\n    CT_IndentBar row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED CUSTOM TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a custom type, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see a vertical bar like | next.\"\n              , customTypeNote\n              ]\n          )\n\n    CT_IndentAfterBar row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED CUSTOM TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a custom type, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I just saw a vertical bar, so I was expecting to see another variant defined next.\"\n              , customTypeNote\n              ]\n          )\n\n    CT_IndentAfterEquals row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED CUSTOM TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a custom type, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I just saw an equals sign, so I was expecting to see the first variant defined next.\"\n              , customTypeNote\n              ]\n          )\n\n\ncustomTypeNote :: D.Doc\ncustomTypeNote =\n  D.stack\n    [ D.toSimpleNote $\n        \"Here is an example of a valid `type` declaration for reference:\"\n    , D.vcat $\n        [ D.indent 4 $ D.fillSep [D.cyan \"type\",\"Status\"]\n        , D.indent 6 $ D.fillSep [\"=\",\"Failure\"]\n        , D.indent 6 $ D.fillSep [\"|\",\"Waiting\"]\n        , D.indent 6 $ D.fillSep [\"|\",\"Success\",\"String\"]\n        ]\n    , D.reflow $\n        \"This defines a new `Status` type with three variants. This could be useful if\\\n        \\ we are waiting for an HTTP request. Maybe we start with `Waiting` and then\\\n        \\ switch to `Failure` or `Success \\\"message from server\\\"` depending on how\\\n        \\ things go. Notice that the Success variant has some associated data, allowing\\\n        \\ us to store a String if the request goes well!\"\n    ]\n\n\n\n-- DECL DEF\n\n\ntoDeclDefReport :: Code.Source -> Name.Name -> DeclDef -> Row -> Col -> Report.Report\ntoDeclDefReport source name declDef startRow startCol =\n  case declDef of\n    DeclDefSpace space row col ->\n      toSpaceReport source space row col\n\n    DeclDefEquals row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.fillSep\n                  [\"The\",\"name\"\n                  ,\"`\" <> D.cyan (D.fromChars keyword) <> \"`\"\n                  ,\"is\",\"reserved\",\"in\",\"Elm,\",\"so\",\"it\",\"cannot\"\n                  ,\"be\",\"used\",\"as\",\"an\",\"argument\",\"here:\"\n                  ]\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"Try renaming it to something else.\"\n                  , case keyword of\n                      \"as\" ->\n                        D.toFancyNote\n                          [\"This\",\"keyword\",\"is\",\"reserved\",\"for\",\"pattern\",\"matches\",\"like\"\n                          ,\"((x,y)\",D.cyan \"as\",\"point)\",\"where\",\"you\",\"want\",\"to\",\"name\",\"a\",\"tuple\",\"and\"\n                          ,\"the\",\"values\",\"it\",\"contains.\"\n                          ]\n\n                      _ ->\n                        D.toSimpleNote $\n                          \"The `\" ++ keyword ++ \"` keyword has a special meaning in Elm, so it can only be used in certain situations.\"\n                  ]\n              )\n\n        Code.Operator \"->\" ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toWiderRegion row col 2\n          in\n          Report.Report \"MISSING COLON?\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was not expecting to see an arrow here:\"\n              ,\n                D.stack\n                  [ D.fillSep\n                      [\"This\",\"usually\",\"means\",\"a\",D.green \":\",\"is\",\"missing\",\"a\",\"bit\",\"earlier\",\"in\"\n                      ,\"a\",\"type\",\"annotation.\",\"It\",\"could\",\"be\",\"something\",\"else\",\"though,\",\"so\"\n                      ,\"here\",\"is\",\"a\",\"valid\",\"definition\",\"for\",\"reference:\"\n                      ]\n                  , D.indent 4 $ D.vcat $\n                      [ \"greet : String -> String\"\n                      , \"greet name =\"\n                      , \"  \" <> D.dullyellow \"\\\"Hello \\\"\" <> \" ++ name ++ \" <> D.dullyellow \"\\\"!\\\"\"\n                      ]\n                  , D.reflow $\n                      \"Try to use that format with your `\" ++ Name.toChars name ++ \"` definition!\"\n                  ]\n              )\n\n        Code.Operator op ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col op\n          in\n          Report.Report \"UNEXPECTED SYMBOL\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was not expecting to see this symbol here:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I am not sure what is going wrong exactly, so here is a valid\\\n                      \\ definition (with an optional type annotation) for reference:\"\n                  , D.indent 4 $ D.vcat $\n                      [ \"greet : String -> String\"\n                      , \"greet name =\"\n                      , \"  \" <> D.dullyellow \"\\\"Hello \\\"\" <> \" ++ name ++ \" <> D.dullyellow \"\\\"!\\\"\"\n                      ]\n                  , D.reflow $\n                      \"Try to use that format with your `\" ++ Name.toChars name ++ \"` definition!\"\n                  ]\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"PROBLEM IN DEFINITION\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I got stuck while parsing the `\" ++ Name.toChars name ++ \"` definition:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I am not sure what is going wrong exactly, so here is a valid\\\n                      \\ definition (with an optional type annotation) for reference:\"\n                  , D.indent 4 $ D.vcat $\n                      [ \"greet : String -> String\"\n                      , \"greet name =\"\n                      , \"  \" <> D.dullyellow \"\\\"Hello \\\"\" <> \" ++ name ++ \" <> D.dullyellow \"\\\"!\\\"\"\n                      ]\n                  , D.reflow $\n                      \"Try to use that format!\"\n                  ]\n              )\n\n    DeclDefType tipe row col ->\n      toTypeReport source (TC_Annotation name) tipe row col\n\n    DeclDefArg pattern row col ->\n      toPatternReport source PArg pattern row col\n\n    DeclDefBody expr row col ->\n      toExprReport source (InDef name startRow startCol) expr row col\n\n    DeclDefNameRepeat row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"EXPECTING DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw the type annotation for `\" ++ Name.toChars name\n              ++ \"` so I was expecting to see its definition here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Type annotations always appear directly above the relevant\\\n                  \\ definition, without anything else in between. (Not even doc comments!)\"\n              , declDefNote\n              ]\n          )\n\n    DeclDefNameMatch defName row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"NAME MISMATCH\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw a type annotation for `\" ++ Name.toChars name ++ \"`, but it is followed by a definition for `\" ++ Name.toChars defName ++ \"`:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"These names do not match! Is there a typo?\"\n              , D.indent 4 $ D.fillSep $\n                  [D.dullyellow (D.fromName defName),\"->\",D.green (D.fromName name)]\n              ]\n          )\n\n    DeclDefIndentType row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck while parsing the `\" ++ Name.toChars name ++ \"` type annotation:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I just saw a colon, so I am expecting to see a type next.\"\n              , declDefNote\n              ]\n          )\n\n    DeclDefIndentEquals row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck while parsing the `\" ++ Name.toChars name ++ \"` definition:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see an argument or an equals sign next.\"\n              , declDefNote\n              ]\n          )\n\n    DeclDefIndentBody row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck while parsing the `\" ++ Name.toChars name ++ \"` definition:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see an expression next. What is it equal to?\"\n              , declDefNote\n              ]\n          )\n\n\ndeclDefNote :: D.Doc\ndeclDefNote =\n  D.stack\n    [ D.reflow $\n        \"Here is a valid definition (with a type annotation) for reference:\"\n    , D.indent 4 $ D.vcat $\n        [ \"greet : String -> String\"\n        , \"greet name =\"\n        , \"  \" <> D.dullyellow \"\\\"Hello \\\"\" <> \" ++ name ++ \" <> D.dullyellow \"\\\"!\\\"\"\n        ]\n    , D.reflow $\n        \"The top line (called a \\\"type annotation\\\") is optional. You can leave it off\\\n        \\ if you want. As you get more comfortable with Elm and as your project grows,\\\n        \\ it becomes more and more valuable to add them though! They work great as\\\n        \\ compiler-verified documentation, and they often improve error messages!\"\n    ]\n\n\n\n-- CONTEXT\n\n\ndata Context\n  = InNode Node Row Col Context\n  | InDef Name.Name Row Col\n  | InDestruct Row Col\n\n\ndata Node\n  = NRecord\n  | NParens\n  | NList\n  | NFunc\n  | NCond\n  | NThen\n  | NElse\n  | NCase\n  | NBranch\n  deriving (Eq)\n\n\ngetDefName :: Context -> Maybe Name.Name\ngetDefName context =\n  case context of\n    InDestruct _ _ -> Nothing\n    InDef name _ _ -> Just name\n    InNode _ _ _ c -> getDefName c\n\n\nisWithin :: Node -> Context -> Bool\nisWithin desiredNode context =\n  case context of\n    InDestruct _ _          -> False\n    InDef _ _ _             -> False\n    InNode actualNode _ _ _ -> desiredNode == actualNode\n\n\n\n-- EXPR REPORTS\n\n\ntoExprReport :: Code.Source -> Context -> Expr -> Row -> Col -> Report.Report\ntoExprReport source context expr startRow startCol =\n  case expr of\n    Let let_ row col ->\n      toLetReport source context let_ row col\n\n    Case case_ row col ->\n      toCaseReport source context case_ row col\n\n    If if_ row col ->\n      toIfReport source context if_ row col\n\n    List list row col ->\n      toListReport source context list row col\n\n    Record record row col ->\n      toRecordReport source context record row col\n\n    Tuple tuple row col ->\n      toTupleReport source context tuple row col\n\n    Func func row col ->\n      toFuncReport source context func row col\n\n    Dot row col ->\n      let region = toRegion row col in\n      Report.Report \"EXPECTING RECORD ACCESSOR\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I was expecting to see a record accessor here:\"\n          ,\n            D.fillSep\n              [\"Something\",\"like\",D.dullyellow\".name\",\"or\",D.dullyellow\".price\"\n              ,\"that\",\"accesses\",\"a\",\"value\",\"from\",\"a\",\"record.\"\n              ]\n          )\n\n    Access row col ->\n      let region = toRegion row col in\n      Report.Report \"EXPECTING RECORD ACCESSOR\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I am trying to parse a record accessor here:\"\n          ,\n            D.stack\n              [\n                D.fillSep\n                  [\"Something\",\"like\",D.dullyellow\".name\",\"or\",D.dullyellow\".price\"\n                  ,\"that\",\"accesses\",\"a\",\"value\",\"from\",\"a\",\"record.\"\n                  ]\n              ,\n                D.toSimpleNote $\n                  \"Record field names must start with a lower case letter!\"\n              ]\n          )\n\n    OperatorRight op row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n        isMath = elem op [\"-\",\"+\",\"*\",\"/\",\"^\"]\n      in\n      Report.Report \"MISSING EXPRESSION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n                \"I just saw a \" ++ Name.toChars op ++ \" \"\n                ++ (if isMath then \"sign\" else \"operator\")\n                ++ \", so I am getting stuck here:\"\n          ,\n            if isMath then\n              D.fillSep\n                [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"an\",\"expression\",\"next.\"\n                ,\"Something\",\"like\",D.dullyellow \"42\",\"or\",D.dullyellow \"1000\"\n                ,\"that\",\"makes\",\"sense\",\"with\",\"a\",D.fromName op,\"sign.\"\n                ]\n            else if op == \"&&\" || op == \"||\" then\n              D.fillSep\n                [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"an\",\"expression\",\"next.\"\n                ,\"Something\",\"like\",D.dullyellow \"True\",\"or\",D.dullyellow \"False\"\n                ,\"that\",\"makes\",\"sense\",\"with\",\"boolean\",\"logic.\"\n                ]\n            else if op == \"|>\" then\n              D.reflow $\n                \"I was expecting to see a function next.\"\n            else if op == \"<|\" then\n              D.reflow $\n                \"I was expecting to see an argument next.\"\n            else\n              D.reflow $\n                \"I was expecting to see an expression next.\"\n          )\n\n    OperatorReserved operator row col ->\n      toOperatorReport source context operator row col\n\n    Start row col ->\n      let\n        (contextRow, contextCol, aThing) =\n          case context of\n            InDestruct r c       -> (r, c, \"a definition\")\n            InDef name r c       -> (r, c, \"the `\" ++ Name.toChars name ++ \"` definition\")\n            InNode NRecord r c _ -> (r, c, \"a record\")\n            InNode NParens r c _ -> (r, c, \"some parentheses\")\n            InNode NList   r c _ -> (r, c, \"a list\")\n            InNode NFunc   r c _ -> (r, c, \"an anonymous function\")\n            InNode NCond   r c _ -> (r, c, \"an `if` expression\")\n            InNode NThen   r c _ -> (r, c, \"an `if` expression\")\n            InNode NElse   r c _ -> (r, c, \"an `if` expression\")\n            InNode NCase   r c _ -> (r, c, \"a `case` expression\")\n            InNode NBranch r c _ -> (r, c, \"a `case` expression\")\n\n        surroundings = A.Region (A.Position contextRow contextCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"MISSING EXPRESSION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing \" ++ aThing ++ \", but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"an\",\"expression\",\"like\"\n                  ,D.dullyellow \"42\",\"or\",D.dullyellow\"\\\"hello\\\"\" <> \".\"\n                  ,\"Once\",\"there\",\"is\",\"something\",\"there,\",\"I\",\"can\",\"probably\"\n                  ,\"give\",\"a\",\"more\",\"specific\",\"hint!\"\n                  ]\n              , D.toSimpleNote $\n                  \"This can also happen if I run into reserved words like `let` or `as` unexpectedly.\\\n                  \\ Or if I run into operators in unexpected spots. Point is, there are a\\\n                  \\ couple ways I can get confused and give sort of weird advice!\"\n              ]\n          )\n\n    Char char row col ->\n      toCharReport source char row col\n\n    String string row col ->\n      toStringReport source string row col\n\n    Number number row col ->\n      toNumberReport source number row col\n\n    Space space row col ->\n      toSpaceReport source space row col\n\n    EndlessShader row col ->\n      let\n        region = toWiderRegion row col 6\n      in\n      Report.Report \"ENDLESS SHADER\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow \"I cannot find the end of this shader:\"\n          ,\n            D.reflow \"Add a |] somewhere after this to end the shader.\"\n          )\n\n    ShaderProblem problem row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"SHADER PROBLEM\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I ran into a problem while parsing this GLSL block.\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I use a 3rd party GLSL parser for now, and I did my best to extract their error message:\"\n              , D.indent 4 $ D.vcat $\n                  map D.fromChars (filter (/=\"\") (lines problem))\n              ]\n          )\n\n    IndentOperatorRight op row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"MISSING EXPRESSION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was expecting to see an expression after this \" ++ Name.toChars op ++ \" operator:\"\n          ,\n            D.stack\n              [\n                D.fillSep $\n                  [\"You\",\"can\",\"just\",\"put\",\"anything\",\"for\",\"now,\",\"like\"\n                  ,D.dullyellow \"42\",\"or\",D.dullyellow\"\\\"hello\\\"\" <> \".\"\n                  ,\"Once\",\"there\",\"is\",\"something\",\"there,\",\"I\",\"can\",\"probably\"\n                  ,\"give\",\"a\",\"more\",\"specific\",\"hint!\"\n                  ]\n              ,\n                D.toSimpleNote $\n                  \"I may be getting confused by your indentation? The easiest way to make sure\\\n                  \\ this is not an indentation problem is to put the expression on the right of\\\n                  \\ the \" ++ Name.toChars op ++ \" operator on the same line.\"\n              ]\n          )\n\n\n\n-- CHAR\n\n\ntoCharReport :: Code.Source -> Char -> Row -> Col -> Report.Report\ntoCharReport source char row col =\n  case char of\n    CharEndless ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"MISSING SINGLE QUOTE\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I thought I was parsing a character, but I got to the end of\\\n              \\ the line without seeing the closing single quote:\"\n          ,\n            D.reflow $\n              \"Add a closing single quote here!\"\n          )\n\n    CharEscape escape ->\n      toEscapeReport source escape row col\n\n    CharNotString width ->\n      let\n        region = toWiderRegion row col width\n      in\n      Report.Report \"NEEDS DOUBLE QUOTES\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            \"The following string uses single quotes:\"\n          ,\n            D.stack\n              [ \"Please switch to double quotes instead:\"\n              , D.indent 4 $\n                  D.dullyellow \"'this'\" <> \" => \" <> D.green \"\\\"this\\\"\"\n              , D.toSimpleNote $\n                  \"Elm uses double quotes for strings like \\\"hello\\\", whereas it uses single\\\n                  \\ quotes for individual characters like 'a' and 'ø'. This distinction helps with\\\n                  \\ code like (String.any (\\\\c -> c == 'X') \\\"90210\\\") where you are inspecting\\\n                  \\ individual characters.\"\n              ]\n          )\n\n\n\n-- STRING\n\n\ntoStringReport :: Code.Source -> String -> Row -> Col -> Report.Report\ntoStringReport source string row col =\n  case string of\n    StringEndless_Single ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"ENDLESS STRING\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I got to the end of the line without seeing the closing double quote:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Strings\",\"look\",\"like\",D.green \"\\\"this\\\"\",\"with\",\"double\"\n                  ,\"quotes\",\"on\",\"each\",\"end.\",\"Is\",\"the\",\"closing\",\"double\"\n                  ,\"quote\",\"missing\",\"in\",\"your\",\"code?\"\n                  ]\n              , D.toSimpleNote $\n                  \"For a string that spans multiple lines, you can use the multi-line string\\\n                  \\ syntax like this:\"\n              , D.dullyellow $ D.indent 4 $ D.vcat $\n                  [ \"\\\"\\\"\\\"\"\n                  , \"# Multi-line Strings\"\n                  , \"\"\n                  , \"- start with triple double quotes\"\n                  , \"- write whatever you want\"\n                  , \"- no need to escape newlines or double quotes\"\n                  , \"- end with triple double quotes\"\n                  , \"\\\"\\\"\\\"\"\n                  ]\n              ]\n          )\n\n    StringEndless_Multi ->\n      let\n        region = toWiderRegion row col 3\n      in\n      Report.Report \"ENDLESS STRING\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I cannot find the end of this multi-line string:\"\n          ,\n            D.stack\n              [ D.reflow \"Add a \\\"\\\"\\\" somewhere after this to end the string.\"\n              , D.toSimpleNote $\n                  \"Here is a valid multi-line string for reference:\"\n              , D.dullyellow $ D.indent 4 $ D.vcat $\n                  [ \"\\\"\\\"\\\"\"\n                  , \"# Multi-line Strings\"\n                  , \"\"\n                  , \"- start with triple double quotes\"\n                  , \"- write whatever you want\"\n                  , \"- no need to escape newlines or double quotes\"\n                  , \"- end with triple double quotes\"\n                  , \"\\\"\\\"\\\"\"\n                  ]\n              ]\n          )\n\n    StringEscape escape ->\n      toEscapeReport source escape row col\n\n\n\n-- ESCAPES\n\n\ntoEscapeReport :: Code.Source -> Escape -> Row -> Col -> Report.Report\ntoEscapeReport source escape row col =\n  case escape of\n    EscapeUnknown ->\n      let\n        region = toWiderRegion row col 2\n      in\n      Report.Report \"UNKNOWN ESCAPE\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"Backslashes always start escaped characters, but I do not recognize this one:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Valid escape characters include:\"\n              , D.dullyellow $ D.indent 4 $ D.vcat $\n                    [ \"\\\\n\"\n                    , \"\\\\r\"\n                    , \"\\\\t\"\n                    , \"\\\\\\\"\"\n                    , \"\\\\\\'\"\n                    , \"\\\\\\\\\"\n                    , \"\\\\u{003D}\"\n                    ]\n              , D.reflow $\n                  \"Do you want one of those instead? Maybe you need \\\\\\\\ to escape a backslash?\"\n              , D.toSimpleNote $\n                  \"The last style lets encode ANY character by its Unicode code\\\n                  \\ point. That means \\\\u{0009} and \\\\t are the same. You can use\\\n                  \\ that style for anything not covered by the other six escapes!\"\n              ]\n          )\n\n    BadUnicodeFormat width ->\n      let\n        region = toWiderRegion row col width\n      in\n      Report.Report \"BAD UNICODE ESCAPE\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I ran into an invalid Unicode escape:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Here are some examples of valid Unicode escapes:\"\n              , D.dullyellow $ D.indent 4 $ D.vcat $\n                  [ \"\\\\u{0041}\"\n                  , \"\\\\u{03BB}\"\n                  , \"\\\\u{6728}\"\n                  , \"\\\\u{1F60A}\"\n                  ]\n              , D.reflow $\n                  \"Notice that the code point is always surrounded by curly braces.\\\n                  \\ Maybe you are missing the opening or closing curly brace?\"\n              ]\n            )\n    BadUnicodeCode width ->\n      let\n        region = toWiderRegion row col width\n      in\n      Report.Report \"BAD UNICODE ESCAPE\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"This is not a valid code point:\"\n          ,\n            D.reflow $\n              \"The valid code points are between 0 and 10FFFF inclusive.\"\n          )\n\n    BadUnicodeLength width numDigits badCode ->\n      let\n        region = toWiderRegion row col width\n      in\n      Report.Report \"BAD UNICODE ESCAPE\" region [] $\n        Code.toSnippet source region Nothing $\n          if numDigits < 4 then\n            (\n              D.reflow $\n                \"Every code point needs at least four digits:\"\n            ,\n              let\n                goodCode = replicate (4 - numDigits) '0' ++ map Char.toUpper (showHex badCode \"\")\n                suggestion = \"\\\\u{\" <> D.fromChars goodCode <> \"}\"\n              in\n              D.fillSep [\"Try\",D.green suggestion,\"instead?\"]\n            )\n\n          else\n            (\n              D.reflow $\n                \"This code point has too many digits:\"\n            ,\n              D.fillSep $\n                [\"Valid\",\"code\",\"points\",\"are\",\"between\"\n                ,D.green \"\\\\u{0000}\",\"and\",D.green \"\\\\u{10FFFF}\" <> \",\"\n                ,\"so\",\"try\",\"trimming\",\"any\",\"leading\",\"zeros\",\"until\"\n                ,\"you\",\"have\",\"between\",\"four\",\"and\",\"six\",\"digits.\"\n                ]\n            )\n\n\n\n-- NUMBERS\n\n\ntoNumberReport :: Code.Source -> Number -> Row -> Col -> Report.Report\ntoNumberReport source number row col =\n  let\n    region = toRegion row col\n  in\n  case number of\n    NumberEnd ->\n      Report.Report \"WEIRD NUMBER\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I thought I was reading a number, but I ran into some weird stuff here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I recognize numbers in the following formats:\"\n              , D.indent 4 $ D.vcat [ \"42\", \"3.14\", \"6.022e23\", \"0x002B\" ]\n              , D.reflow $\n                  \"So is there a way to write it like one of those?\"\n              ]\n          )\n\n    NumberDot int ->\n      Report.Report \"WEIRD NUMBER\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"Numbers cannot end with a dot like this:\"\n          ,\n            D.fillSep\n              [\"Switching\",\"to\",D.green (D.fromChars (show int))\n              ,\"or\",D.green (D.fromChars (show int ++ \".0\"))\n              ,\"will\",\"work\",\"though!\"\n              ]\n          )\n\n    NumberHexDigit ->\n      Report.Report \"WEIRD HEXIDECIMAL\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I thought I was reading a hexidecimal number until I got here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Valid hexidecimal digits include 0123456789abcdefABCDEF, so I can\\\n                  \\ only recognize things like this:\"\n              , D.indent 4 $ D.vcat [ \"0x2B\", \"0x002B\", \"0x00ffb3\" ]\n              ]\n          )\n\n    NumberNoLeadingZero ->\n      Report.Report \"LEADING ZEROS\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I do not accept numbers with leading zeros:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Just delete the leading zeros and it should work!\"\n              , D.toSimpleNote $\n                  \"Some languages let you to specify octal numbers by adding a leading zero.\\\n                  \\ So in C, writing 0111 is the same as writing 73. Some people are used to\\\n                  \\ that, but others probably want it to equal 111. Either path is going to\\\n                  \\ surprise people from certain backgrounds, so Elm tries to avoid this whole\\\n                  \\ situation.\"\n              ]\n          )\n\n\n\n-- OPERATORS\n\n\ntoOperatorReport :: Code.Source -> Context -> BadOperator -> Row -> Col -> Report.Report\ntoOperatorReport source context operator row col =\n  case operator of\n    BadDot ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"UNEXPECTED SYMBOL\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            \"I was not expecting this dot:\"\n          ,\n            D.reflow $\n              \"Dots are for record access and decimal points, so\\\n              \\ they cannot float around on their own. Maybe\\\n              \\ there is some extra whitespace?\"\n          )\n\n    BadPipe ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"UNEXPECTED SYMBOL\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I was not expecting this vertical bar:\"\n          ,\n            D.reflow $\n              \"Vertical bars should only appear in custom type declarations. Maybe you want || instead?\"\n          )\n\n    BadArrow ->\n      let\n        region = toWiderRegion row col 2\n      in\n      Report.Report \"UNEXPECTED ARROW\" region [] $\n        Code.toSnippet source region Nothing $\n          if isWithin NCase context then\n            (\n              D.reflow $\n                \"I am parsing a `case` expression right now, but this arrow is confusing me:\"\n            ,\n              D.stack\n                [ D.reflow \"Maybe the `of` keyword is missing on a previous line?\"\n                , noteForCaseError\n                ]\n            )\n\n          else if isWithin NBranch context then\n            (\n              D.reflow $\n                \"I am parsing a `case` expression right now, but this arrow is confusing me:\"\n            ,\n              D.stack\n                [ D.reflow $\n                    \"It makes sense to see arrows around here, so I suspect it is something earlier. Maybe this pattern is indented a bit farther than the previous patterns?\"\n                , noteForCaseIndentError\n                ]\n            )\n\n          else\n            (\n              D.reflow $\n                \"I was partway through parsing an expression when I got stuck on this arrow:\"\n            ,\n              D.stack\n                [ \"Arrows should only appear in `case` expressions and anonymous functions.\\n\\\n                  \\Maybe it was supposed to be a > sign instead?\"\n                , D.toSimpleNote $\n                    \"The syntax for anonymous functions is (\\\\x -> x + 1) so the arguments all appear\\\n                    \\ after the backslash and before the arrow. Maybe a backslash is missing earlier?\"\n                ]\n            )\n\n    BadEquals ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"UNEXPECTED EQUALS\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I was not expecting to see this equals sign:\"\n          ,\n            D.stack\n              [\n                D.reflow \"Maybe you want == instead? To check if two values are equal?\"\n              ,\n                D.toSimpleNote $\n                  if isWithin NRecord context then\n                    \"Records look like { x = 3, y = 4 } with the equals sign right\\\n                    \\ after the field name. So maybe you forgot a comma?\"\n                  else\n                    case getDefName context of\n                      Nothing ->\n                        \"I may be getting confused by your indentation. I need all definitions to be indented\\\n                        \\ exactly the same amount, so if this is meant to be a new definition, it may have too\\\n                        \\ many spaces in front of it.\"\n\n                      Just name ->\n                        \"I may be getting confused by your indentation. I think I am still parsing the `\"\n                        ++ Name.toChars name ++ \"` definition. Is this supposed to be part of a definition\\\n                        \\ after that? If so, the problem may be a bit before the equals sign. I need all\\\n                        \\ definitions to be indented exactly the same amount, so the problem may be that\\\n                        \\ this new definition has too many spaces in front of it.\"\n              ]\n          )\n\n    BadHasType ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"UNEXPECTED SYMBOL\" region [] $\n        Code.toSnippet source region Nothing $\n          (\n            D.reflow $\n              \"I was not expecting to run into the \\\"has type\\\" symbol here:\"\n          ,\n            case getDefName context of\n              Nothing ->\n                D.fillSep\n                  [\"Maybe\",\"you\",\"want\",D.green \"::\",\"instead?\"\n                  ,\"To\",\"put\",\"something\",\"on\",\"the\",\"front\",\"of\",\"a\",\"list?\"\n                  ]\n\n              Just name ->\n                D.stack\n                  [\n                    D.fillSep\n                      [\"Maybe\",\"you\",\"want\",D.green \"::\",\"instead?\"\n                      ,\"To\",\"put\",\"something\",\"on\",\"the\",\"front\",\"of\",\"a\",\"list?\"\n                      ]\n                  , D.toSimpleNote $\n                      \"The single colon is reserved for type annotations and record types, but I think\\\n                      \\ I am parsing the definition of `\" ++ Name.toChars name ++ \"` right now.\"\n                  ,\n                    D.toSimpleNote $\n                      \"I may be getting confused by your indentation. Is this supposed to be part of\\\n                      \\ a type annotation AFTER the `\" ++ Name.toChars name ++ \"` definition? If so,\\\n                      \\ the problem may be a bit before the \\\"has type\\\" symbol. I need all definitions to\\\n                      \\ be exactly aligned (with exactly the same indentation) so the problem may be that\\\n                      \\ this new definition is indented a bit too much.\"\n                  ]\n          )\n\n\n\n-- CASE\n\n\ntoLetReport :: Code.Source -> Context -> Let -> Row -> Col -> Report.Report\ntoLetReport source context let_ startRow startCol =\n  case let_ of\n    LetSpace space row col ->\n      toSpaceReport source space row col\n\n    LetIn row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"LET PROBLEM\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was partway through parsing a `let` expression, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Based\",\"on\",\"the\",\"indentation,\",\"I\",\"was\",\"expecting\",\"to\",\"see\",\"the\",D.cyan \"in\"\n                  ,\"keyword\",\"next.\",\"Is\",\"there\",\"a\",\"typo?\"\n                  ]\n              , D.toSimpleNote $\n                  \"This can also happen if you are trying to define another value within the `let` but\\\n                  \\ it is not indented enough. Make sure each definition has exactly the same amount of\\\n                  \\ spaces before it. They should line up exactly!\"\n              ]\n          )\n\n    LetDefAlignment _ row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"LET PROBLEM\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was partway through parsing a `let` expression, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Based\",\"on\",\"the\",\"indentation,\",\"I\",\"was\",\"expecting\",\"to\",\"see\",\"the\",D.cyan \"in\"\n                  ,\"keyword\",\"next.\",\"Is\",\"there\",\"a\",\"typo?\"\n                  ]\n              , D.toSimpleNote $\n                  \"This can also happen if you are trying to define another value within the `let` but\\\n                  \\ it is not indented enough. Make sure each definition has exactly the same amount of\\\n                  \\ spaces before it. They should line up exactly!\"\n              ]\n          )\n\n    LetDefName row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was partway through parsing a `let` expression, but I got stuck here:\"\n              ,\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` as a variable name, but\\\n                  \\ it is a reserved word! Try using a different name instead.\"\n              )\n\n        _ ->\n          toUnfinishLetReport source row col startRow startCol $\n            D.reflow $\n              \"I was expecting the name of a definition next.\"\n\n    LetDef name def row col ->\n      toLetDefReport source name def row col\n\n    LetDestruct destruct row col ->\n      toLetDestructReport source destruct row col\n\n    LetBody expr row col ->\n      toExprReport source context expr row col\n\n    LetIndentDef row col ->\n      toUnfinishLetReport source row col startRow startCol $\n        D.reflow $\n          \"I was expecting a value to be defined here.\"\n\n    LetIndentIn row col ->\n      toUnfinishLetReport source row col startRow startCol $\n        D.fillSep $\n          [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"the\",D.cyan \"in\",\"keyword\",\"next.\"\n          ,\"Or\",\"maybe\",\"more\",\"of\",\"that\",\"expression?\"\n          ]\n\n    LetIndentBody row col ->\n      toUnfinishLetReport source row col startRow startCol $\n        D.reflow $\n          \"I was expecting an expression next. Tell me what should happen with the value you just defined!\"\n\n\ntoUnfinishLetReport :: Code.Source -> Row -> Col -> Row -> Col -> D.Doc -> Report.Report\ntoUnfinishLetReport source row col startRow startCol message =\n  let\n    surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n    region = toRegion row col\n  in\n  Report.Report \"UNFINISHED LET\" region [] $\n    Code.toSnippet source surroundings (Just region)\n      (\n        D.reflow $\n          \"I was partway through parsing a `let` expression, but I got stuck here:\"\n      ,\n        D.stack\n          [ message\n          , D.toSimpleNote $\n              \"Here is an example with a valid `let` expression for reference:\"\n          , D.indent 4 $ D.vcat $\n              [ D.indent 0 $ D.fillSep [\"viewPerson\",\"person\",\"=\"]\n              , D.indent 2 $ D.fillSep [D.cyan \"let\"]\n              , D.indent 4 $ D.fillSep [\"fullName\",\"=\"]\n              , D.indent 6 $ D.fillSep [\"person.firstName\",\"++\",D.dullyellow \"\\\" \\\"\",\"++\",\"person.lastName\"]\n              , D.indent 2 $ D.fillSep [D.cyan \"in\"]\n              , D.indent 2 $ D.fillSep [\"div\",\"[]\",\"[\",\"text\",\"fullName\",\"]\"]\n              ]\n          , D.reflow $\n              \"Here we defined a `viewPerson` function that turns a person into some HTML. We use\\\n              \\ a `let` expression to define the `fullName` we want to show. Notice the indentation! The\\\n              \\ `fullName` is indented more than the `let` keyword, and the actual value of `fullName` is\\\n              \\ indented a bit more than that. That is important!\"\n          ]\n      )\n\n\ntoLetDefReport :: Code.Source -> Name.Name -> Def -> Row -> Col -> Report.Report\ntoLetDefReport source name def startRow startCol =\n  case def of\n    DefSpace space row col ->\n      toSpaceReport source space row col\n\n    DefType tipe row col ->\n      toTypeReport source (TC_Annotation name) tipe row col\n\n    DefNameRepeat row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"EXPECTING DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw the type annotation for `\" ++ Name.toChars name\n              ++ \"` so I was expecting to see its definition here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Type annotations always appear directly above the relevant\\\n                  \\ definition, without anything else in between.\"\n              , defNote\n              ]\n          )\n\n    DefNameMatch defName row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"NAME MISMATCH\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw a type annotation for `\" ++ Name.toChars name ++ \"`, but it is followed by a definition for `\" ++ Name.toChars defName ++ \"`:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"These names do not match! Is there a typo?\"\n              , D.indent 4 $ D.fillSep $\n                  [D.dullyellow (D.fromName defName),\"->\",D.green (D.fromName name)]\n              ]\n          )\n\n    DefArg pattern row col ->\n      toPatternReport source PArg pattern row col\n\n    DefEquals row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.fillSep\n                  [\"The\",\"name\"\n                  ,\"`\" <> D.cyan (D.fromChars keyword) <> \"`\"\n                  ,\"is\",\"reserved\",\"in\",\"Elm,\",\"so\",\"it\",\"cannot\"\n                  ,\"be\",\"used\",\"as\",\"an\",\"argument\",\"here:\"\n                  ]\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"Try renaming it to something else.\"\n                  , case keyword of\n                      \"as\" ->\n                        D.toFancyNote\n                          [\"This\",\"keyword\",\"is\",\"reserved\",\"for\",\"pattern\",\"matches\",\"like\"\n                          ,\"((x,y)\",D.cyan \"as\",\"point)\",\"where\",\"you\",\"want\",\"to\",\"name\",\"a\",\"tuple\",\"and\"\n                          ,\"the\",\"values\",\"it\",\"contains.\"\n                          ]\n\n                      _ ->\n                        D.toSimpleNote $\n                          \"The `\" ++ keyword ++ \"` keyword has a special meaning in Elm, so it can only be used in certain situations.\"\n                  ]\n              )\n\n        Code.Operator \"->\" ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toWiderRegion row col 2\n          in\n          Report.Report \"MISSING COLON?\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was not expecting to see an arrow here:\"\n              ,\n                D.stack\n                  [ D.fillSep\n                      [\"This\",\"usually\",\"means\",\"a\",D.green \":\",\"is\",\"missing\",\"a\",\"bit\",\"earlier\",\"in\"\n                      ,\"a\",\"type\",\"annotation.\",\"It\",\"could\",\"be\",\"something\",\"else\",\"though,\",\"so\"\n                      ,\"here\",\"is\",\"a\",\"valid\",\"definition\",\"for\",\"reference:\"\n                      ]\n                  , D.indent 4 $ D.vcat $\n                      [ \"greet : String -> String\"\n                      , \"greet name =\"\n                      , \"  \" <> D.dullyellow \"\\\"Hello \\\"\" <> \" ++ name ++ \" <> D.dullyellow \"\\\"!\\\"\"\n                      ]\n                  , D.reflow $\n                      \"Try to use that format with your `\" ++ Name.toChars name ++ \"` definition!\"\n                  ]\n              )\n\n        Code.Operator op ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col op\n          in\n          Report.Report \"UNEXPECTED SYMBOL\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was not expecting to see this symbol here:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I am not sure what is going wrong exactly, so here is a valid\\\n                      \\ definition (with an optional type annotation) for reference:\"\n                  , D.indent 4 $ D.vcat $\n                      [ \"greet : String -> String\"\n                      , \"greet name =\"\n                      , \"  \" <> D.dullyellow \"\\\"Hello \\\"\" <> \" ++ name ++ \" <> D.dullyellow \"\\\"!\\\"\"\n                      ]\n                  , D.reflow $\n                      \"Try to use that format with your `\" ++ Name.toChars name ++ \"` definition!\"\n                  ]\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"PROBLEM IN DEFINITION\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I got stuck while parsing the `\" ++ Name.toChars name ++ \"` definition:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I am not sure what is going wrong exactly, so here is a valid\\\n                      \\ definition (with an optional type annotation) for reference:\"\n                  , D.indent 4 $ D.vcat $\n                      [ \"greet : String -> String\"\n                      , \"greet name =\"\n                      , \"  \" <> D.dullyellow \"\\\"Hello \\\"\" <> \" ++ name ++ \" <> D.dullyellow \"\\\"!\\\"\"\n                      ]\n                  , D.reflow $\n                      \"Try to use that format!\"\n                  ]\n              )\n\n    DefBody expr row col ->\n      toExprReport source (InDef name startRow startCol) expr row col\n\n    DefIndentEquals row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck while parsing the `\" ++ Name.toChars name ++ \"` definition:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see an argument or an equals sign next.\"\n              , defNote\n              ]\n          )\n\n    DefIndentType row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck while parsing the `\" ++ Name.toChars name ++ \"` type annotation:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I just saw a colon, so I am expecting to see a type next.\"\n              , defNote\n              ]\n          )\n\n    DefIndentBody row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck while parsing the `\" ++ Name.toChars name ++ \"` definition:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see an expression next. What is it equal to?\"\n              , declDefNote\n              ]\n          )\n\n    DefAlignment indent row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n        offset = indent - col\n      in\n      Report.Report \"PROBLEM IN DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck while parsing the `\" ++ Name.toChars name ++ \"` definition:\"\n          ,\n            D.reflow $\n              \"I just saw a type annotation indented \" ++ show indent ++ \" spaces, so I was\\\n              \\ expecting to see the corresponding definition next with the exact same amount\\\n              \\ of indentation. It looks like this line needs \"\n              ++ show offset ++ \" more \" ++ (if offset == 1 then \"space\" else \"spaces\") ++ \"?\"\n          )\n\n\n\ndefNote :: D.Doc\ndefNote =\n  D.stack\n    [ D.reflow $\n        \"Here is a valid definition (with a type annotation) for reference:\"\n    , D.indent 4 $ D.vcat $\n        [ \"greet : String -> String\"\n        , \"greet name =\"\n        , \"  \" <> D.dullyellow \"\\\"Hello \\\"\" <> \" ++ name ++ \" <> D.dullyellow \"\\\"!\\\"\"\n        ]\n    , D.reflow $\n        \"The top line (called a \\\"type annotation\\\") is optional. You can leave it off\\\n        \\ if you want. As you get more comfortable with Elm and as your project grows,\\\n        \\ it becomes more and more valuable to add them though! They work great as\\\n        \\ compiler-verified documentation, and they often improve error messages!\"\n    ]\n\n\ntoLetDestructReport :: Code.Source -> Destruct -> Row -> Col -> Report.Report\ntoLetDestructReport source destruct startRow startCol =\n  case destruct of\n    DestructSpace space row col ->\n      toSpaceReport source space row col\n\n    DestructPattern pattern row col ->\n      toPatternReport source PLet pattern row col\n\n    DestructEquals row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"PROBLEM IN DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck trying to parse this definition:\"\n          ,\n            case Code.whatIsNext source row col of\n              Code.Operator \":\" ->\n                D.stack\n                  [ D.reflow $\n                      \"I was expecting to see an equals sign next, followed by an expression\\\n                      \\ telling me what to compute.\"\n                  , D.toSimpleNote $\n                      \"It looks like you may be trying to write a type annotation? It is not\\\n                      \\ possible to add type annotations on destructuring definitions like this.\\\n                      \\ You can assign a name to the overall structure, put a type annotation on\\\n                      \\ that, and then destructure separately though.\"\n                  ]\n\n              _ ->\n                D.reflow $\n                  \"I was expecting to see an equals sign next, followed by an expression\\\n                  \\ telling me what to compute.\"\n          )\n\n    DestructBody expr row col ->\n      toExprReport source (InDestruct startRow startCol) expr row col\n\n    DestructIndentEquals row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck trying to parse this definition:\"\n          ,\n            D.reflow $\n              \"I was expecting to see an equals sign next, followed by an expression\\\n              \\ telling me what to compute.\"\n          )\n\n    DestructIndentBody row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED DEFINITION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck while parsing this definition:\"\n          ,\n            D.reflow $\n              \"I was expecting to see an expression next. What is it equal to?\"\n          )\n\n\n\n-- CASE\n\n\ntoCaseReport :: Code.Source -> Context -> Case -> Row -> Col -> Report.Report\ntoCaseReport source context case_ startRow startCol =\n  case case_ of\n    CaseSpace space row col ->\n      toSpaceReport source space row col\n\n    CaseOf row col ->\n      toUnfinishCaseReport source row col startRow startCol $\n        D.fillSep [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"the\",D.dullyellow \"of\",\"keyword\",\"next.\"]\n\n    CasePattern pattern row col ->\n      toPatternReport source PCase pattern row col\n\n    CaseArrow row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a `case` expression, but I got stuck here:\"\n              ,\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` in one of your\\\n                  \\ patterns, but it is a reserved word. Try using a different name?\"\n              )\n\n        Code.Operator \":\" ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNEXPECTED OPERATOR\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a `case` expression, but I got stuck here:\"\n              ,\n                D.fillSep $\n                  [\"I\",\"am\",\"seeing\",D.dullyellow \":\",\"but\",\"maybe\",\"you\",\"want\",D.green \"::\",\"instead?\"\n                  ,\"For\",\"pattern\",\"matching\",\"on\",\"lists?\"\n                  ]\n              )\n\n        Code.Operator \"=\" ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNEXPECTED OPERATOR\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a `case` expression, but I got stuck here:\"\n              ,\n                D.fillSep $\n                  [\"I\",\"am\",\"seeing\",D.dullyellow \"=\",\"but\",\"maybe\",\"you\",\"want\",D.green \"->\",\"instead?\"\n                  ]\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"MISSING ARROW\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a `case` expression, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.reflow \"I was expecting to see an arrow next.\"\n                  , noteForCaseIndentError\n                  ]\n              )\n\n    CaseExpr expr row col ->\n      toExprReport source (InNode NCase startRow startCol context) expr row col\n\n    CaseBranch expr row col ->\n      toExprReport source (InNode NBranch startRow startCol context) expr row col\n\n    CaseIndentOf row col ->\n      toUnfinishCaseReport source row col startRow startCol $\n        D.fillSep [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"the\",D.dullyellow \"of\",\"keyword\",\"next.\"]\n\n    CaseIndentExpr row col ->\n      toUnfinishCaseReport source row col startRow startCol $\n        D.reflow \"I was expecting to see a expression next.\"\n\n    CaseIndentPattern row col ->\n      toUnfinishCaseReport source row col startRow startCol $\n        D.reflow \"I was expecting to see a pattern next.\"\n\n    CaseIndentArrow row col ->\n      toUnfinishCaseReport source row col startRow startCol $\n        D.fillSep\n          [\"I\",\"just\",\"saw\",\"a\",\"pattern,\",\"so\",\"I\",\"was\",\"expecting\"\n          ,\"to\",\"see\",\"a\",D.dullyellow \"->\",\"next.\"\n          ]\n\n    CaseIndentBranch row col ->\n      toUnfinishCaseReport source row col startRow startCol $\n        D.reflow $\n          \"I was expecting to see an expression next. What should I do when\\\n          \\ I run into this particular pattern?\"\n\n    CasePatternAlignment indent row col ->\n      toUnfinishCaseReport source row col startRow startCol $\n        D.reflow $\n          \"I suspect this is a pattern that is not indented far enough? (\" ++ show indent ++ \" spaces)\"\n\n\ntoUnfinishCaseReport :: Code.Source -> Row -> Col -> Row -> Col -> D.Doc -> Report.Report\ntoUnfinishCaseReport source row col startRow startCol message =\n  let\n    surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n    region = toRegion row col\n  in\n  Report.Report \"UNFINISHED CASE\" region [] $\n    Code.toSnippet source surroundings (Just region)\n      (\n        D.reflow $\n          \"I was partway through parsing a `case` expression, but I got stuck here:\"\n      ,\n        D.stack\n          [ message\n          , noteForCaseError\n          ]\n      )\n\n\nnoteForCaseError :: D.Doc\nnoteForCaseError =\n  D.stack\n    [ D.toSimpleNote $\n        \"Here is an example of a valid `case` expression for reference.\"\n    , D.vcat $\n        [ D.indent 4 $ D.fillSep [D.cyan \"case\",\"maybeWidth\",D.cyan \"of\"]\n        , D.indent 6 $ D.fillSep [D.blue \"Just\",\"width\",\"->\"]\n        , D.indent 8 $ D.fillSep [\"width\",\"+\",D.dullyellow \"200\"]\n        , \"\"\n        , D.indent 6 $ D.fillSep [D.blue \"Nothing\",\"->\"]\n        , D.indent 8 $ D.fillSep [D.dullyellow \"400\"]\n        ]\n    , D.reflow $\n        \"Notice the indentation. Each pattern is aligned, and each branch is indented\\\n        \\ a bit more than the corresponding pattern. That is important!\"\n    ]\n\n\nnoteForCaseIndentError :: D.Doc\nnoteForCaseIndentError =\n  D.stack\n    [ D.toSimpleNote $\n        \"Sometimes I get confused by indentation, so try to make your `case` look\\\n        \\ something like this:\"\n    , D.vcat $\n        [ D.indent 4 $ D.fillSep [D.cyan \"case\",\"maybeWidth\",D.cyan \"of\"]\n        , D.indent 6 $ D.fillSep [D.blue \"Just\",\"width\",\"->\"]\n        , D.indent 8 $ D.fillSep [\"width\",\"+\",D.dullyellow \"200\"]\n        , \"\"\n        , D.indent 6 $ D.fillSep [D.blue \"Nothing\",\"->\"]\n        , D.indent 8 $ D.fillSep [D.dullyellow \"400\"]\n        ]\n    , D.reflow $\n        \"Notice the indentation! Patterns are aligned with each other. Same indentation.\\\n        \\ The expressions after each arrow are all indented a bit more than the patterns.\\\n        \\ That is important!\"\n    ]\n\n\n\n-- IF\n\n\ntoIfReport :: Code.Source -> Context -> If -> Row -> Col -> Report.Report\ntoIfReport source context if_ startRow startCol =\n  case if_ of\n    IfSpace space row col ->\n      toSpaceReport source space row col\n\n    IfThen row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED IF\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was expecting to see more of this `if` expression, but I got stuck here:\"\n          ,\n            D.fillSep $\n              [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"the\",D.cyan \"then\",\"keyword\",\"next.\"\n              ]\n          )\n\n    IfElse row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED IF\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was expecting to see more of this `if` expression, but I got stuck here:\"\n          ,\n            D.fillSep $\n              [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"the\",D.cyan \"else\",\"keyword\",\"next.\"\n              ]\n          )\n\n    IfElseBranchStart row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED IF\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw the start of an `else` branch, but then I got stuck here:\"\n          ,\n            D.reflow $\n              \"I was expecting to see an expression next. Maybe it is not filled in yet?\"\n          )\n\n    IfCondition expr row col ->\n      toExprReport source (InNode NCond startRow startCol context) expr row col\n\n    IfThenBranch expr row col ->\n      toExprReport source (InNode NThen startRow startCol context) expr row col\n\n    IfElseBranch expr row col ->\n      toExprReport source (InNode NElse startRow startCol context) expr row col\n\n    IfIndentCondition row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED IF\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was expecting to see more of this `if` expression, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"an\",\"expression\",\"like\",D.dullyellow \"x < 0\"\n                  ,\"that\",\"evaluates\",\"to\",\"True\",\"or\",\"False.\"\n                  ]\n              , D.toSimpleNote $\n                  \"I can be confused by indentation. Maybe something is not indented enough?\"\n              ]\n          )\n\n    IfIndentThen row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED IF\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was expecting to see more of this `if` expression, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"the\",D.cyan \"then\",\"keyword\",\"next.\"\n                  ]\n              , D.toSimpleNote $\n                  \"I can be confused by indentation. Maybe something is not indented enough?\"\n              ]\n          )\n\n    IfIndentThenBranch row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED IF\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck after the start of this `then` branch:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see an expression next. Maybe it is not filled in yet?\"\n              , D.toSimpleNote $\n                  \"I can be confused by indentation, so if the `then` branch is already\\\n                  \\ present, it may not be indented enough for me to recognize it.\"\n              ]\n          )\n\n    IfIndentElseBranch row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED IF\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I got stuck after the start of this `else` branch:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see an expression next. Maybe it is not filled in yet?\"\n              , D.toSimpleNote $\n                  \"I can be confused by indentation, so if the `else` branch is already\\\n                  \\ present, it may not be indented enough for me to recognize it.\"\n              ]\n          )\n\n    IfIndentElse row col ->\n      case Code.nextLineStartsWithKeyword \"else\" source row of\n        Just (elseRow, elseCol) ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position elseRow elseCol)\n            region = toWiderRegion elseRow elseCol 4\n          in\n          Report.Report \"WEIRD ELSE BRANCH\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was partway through an `if` expression when I got stuck here:\"\n              ,\n                D.fillSep $\n                  [\"I\",\"think\",\"this\",D.cyan \"else\",\"keyword\",\"needs\",\"to\",\"be\",\"indented\",\"more.\"\n                  ,\"Try\",\"adding\",\"some\",\"spaces\",\"before\",\"it.\"\n                  ]\n              )\n\n        Nothing ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNFINISHED IF\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was expecting to see an `else` branch after this:\"\n              ,\n                D.stack\n                  [ D.fillSep\n                      [\"I\",\"know\",\"what\",\"to\",\"do\",\"when\",\"the\",\"condition\",\"is\",\"True,\"\n                      ,\"but\",\"what\",\"happens\",\"when\",\"it\",\"is\",\"False?\"\n                      ,\"Add\",\"an\",D.cyan \"else\",\"branch\",\"to\",\"handle\",\"that\",\"scenario!\"\n                      ]\n                  ]\n              )\n\n\n\n-- RECORD\n\n\ntoRecordReport :: Code.Source -> Context -> Record -> Row -> Col -> Report.Report\ntoRecordReport source context record startRow startCol =\n  case record of\n    RecordOpen row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I just started parsing a record, but I got stuck on this field name:\"\n              ,\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` as a field name, but \\\n                  \\ that is a reserved word. Try using a different name!\"\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"PROBLEM IN RECORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I just started parsing a record, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.fillSep\n                      [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"record\",\"field\",\"defined\",\"next,\"\n                      ,\"so\",\"I\",\"am\",\"looking\",\"for\",\"a\",\"name\",\"like\"\n                      ,D.dullyellow \"userName\",\"or\",D.dullyellow \"plantHeight\" <> \".\"\n                      ]\n                  , D.toSimpleNote $\n                      \"Field names must start with a lower-case letter. After that, you can use\\\n                      \\ any sequence of letters, numbers, and underscores.\"\n                  , noteForRecordError\n                  ]\n              )\n\n    RecordEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"PROBLEM IN RECORD\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a record, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"closing\",\"curly\",\"brace\",\"before\",\"this,\"\n                  ,\"so\",\"try\",\"adding\",\"a\",D.dullyellow \"}\",\"and\",\"see\",\"if\",\"that\",\"helps?\"\n                  ]\n              , D.toSimpleNote $\n                  \"When I get stuck like this, it usually means that there is a missing parenthesis\\\n                  \\ or bracket somewhere earlier. It could also be a stray keyword or operator.\"\n              ]\n          )\n\n    RecordField row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a record, but I got stuck on this field name:\"\n              ,\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` as a field name, but \\\n                  \\ that is a reserved word. Try using a different name!\"\n              )\n\n        Code.Other (Just ',') ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"EXTRA COMMA\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a record, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I am seeing two commas in a row. This is the second one!\"\n                  , D.reflow $\n                      \"Just delete one of the commas and you should be all set!\"\n                  , noteForRecordError\n                  ]\n              )\n\n        Code.Close _ '}' ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"EXTRA COMMA\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a record, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"Trailing commas are not allowed in records. Try deleting the comma that appears\\\n                      \\ before this closing curly brace.\"\n                  , noteForRecordError\n                  ]\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"PROBLEM IN RECORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a record, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.fillSep\n                      [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"another\",\"record\",\"field\",\"defined\",\"next,\"\n                      ,\"so\",\"I\",\"am\",\"looking\",\"for\",\"a\",\"name\",\"like\"\n                      ,D.dullyellow \"userName\",\"or\",D.dullyellow \"plantHeight\" <> \".\"\n                      ]\n                  , D.toSimpleNote $\n                      \"Field names must start with a lower-case letter. After that, you can use\\\n                      \\ any sequence of letters, numbers, and underscores.\"\n                  , noteForRecordError\n                  ]\n              )\n\n    RecordEquals row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"PROBLEM IN RECORD\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a record, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"just\",\"saw\",\"a\",\"field\",\"name,\",\"so\",\"I\",\"was\",\"expecting\",\"to\",\"see\"\n                  ,\"an\",\"equals\",\"sign\",\"next.\",\"So\",\"try\",\"putting\",\"an\",D.green \"=\",\"sign\",\"here?\"\n                  ]\n              , noteForRecordError\n              ]\n          )\n\n    RecordExpr expr row col ->\n      toExprReport source (InNode NRecord startRow startCol context) expr row col\n\n    RecordSpace space row col ->\n      toSpaceReport source space row col\n\n    RecordIndentOpen row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED RECORD\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw the opening curly brace of a record, but then I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"am\",\"expecting\",\"a\",\"record\",\"like\",D.dullyellow \"{ x = 3, y = 4 }\",\"here.\"\n                  ,\"Try\",\"defining\",\"some\",\"fields\",\"of\",\"your\",\"own?\"\n                  ]\n              , noteForRecordIndentError\n              ]\n          )\n\n    RecordIndentEnd row col ->\n      case Code.nextLineStartsWithCloseCurly source row of\n        Just (curlyRow, curlyCol) ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position curlyRow curlyCol)\n            region = toRegion curlyRow curlyCol\n          in\n          Report.Report \"NEED MORE INDENTATION\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was partway through parsing a record, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I need this curly brace to be indented more. Try adding some spaces before it!\"\n                  , noteForRecordError\n                  ]\n              )\n\n        Nothing ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNFINISHED RECORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was partway through parsing a record, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.fillSep $\n                      [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"closing\",\"curly\",\"brace\",\"next.\"\n                      ,\"Try\",\"putting\",\"a\",D.green \"}\",\"next\",\"and\",\"see\",\"if\",\"that\",\"helps?\"\n                      ]\n                  , noteForRecordIndentError\n                  ]\n              )\n\n    RecordIndentField row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED RECORD\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a record, but I got stuck after that last comma:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Trailing commas are not allowed in records, so the fix may be to\\\n                  \\ delete that last comma? Or maybe you were in the middle of defining\\\n                  \\ an additional field?\"\n              , noteForRecordError\n              ]\n          )\n\n    RecordIndentEquals row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED RECORD\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a record. I just saw a record\\\n              \\ field, so I was expecting to see an equals sign next:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Try\",\"putting\",\"an\",D.green \"=\",\"followed\",\"by\",\"an\",\"expression?\"\n                  ]\n              , noteForRecordIndentError\n              ]\n          )\n\n    RecordIndentExpr row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED RECORD\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a record, and I was expecting to run into an expression next:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Try\",\"putting\",\"something\",\"like\"\n                  ,D.dullyellow \"42\",\"or\",D.dullyellow\"\\\"hello\\\"\",\"for\",\"now?\"\n                  ]\n              , noteForRecordIndentError\n              ]\n          )\n\n\nnoteForRecordError :: D.Doc\nnoteForRecordError =\n  D.stack $\n    [ D.toSimpleNote\n        \"If you are trying to define a record across multiple lines, I recommend using this format:\"\n    , D.indent 4 $ D.vcat $\n        [ \"{ name = \" <> D.dullyellow \"\\\"Alice\\\"\"\n        , \", age = \" <> D.dullyellow \"42\"\n        , \", height = \" <> D.dullyellow \"1.75\"\n        , \"}\"\n        ]\n    , D.reflow $\n        \"Notice that each line starts with some indentation. Usually two or four spaces.\\\n        \\ This is the stylistic convention in the Elm ecosystem.\"\n    ]\n\n\nnoteForRecordIndentError :: D.Doc\nnoteForRecordIndentError =\n  D.stack\n    [ D.toSimpleNote\n        \"I may be confused by indentation. For example, if you are trying to define\\\n        \\ a record across multiple lines, I recommend using this format:\"\n    , D.indent 4 $ D.vcat $\n        [ \"{ name = \" <> D.dullyellow \"\\\"Alice\\\"\"\n        , \", age = \" <> D.dullyellow \"42\"\n        , \", height = \" <> D.dullyellow \"1.75\"\n        , \"}\"\n        ]\n    , D.reflow $\n        \"Notice that each line starts with some indentation. Usually two or four spaces.\\\n        \\ This is the stylistic convention in the Elm ecosystem!\"\n    ]\n\n\n\n-- TUPLE\n\n\ntoTupleReport :: Code.Source -> Context -> Tuple -> Row -> Col -> Report.Report\ntoTupleReport source context tuple startRow startCol =\n  case tuple of\n    TupleExpr expr row col ->\n      toExprReport source (InNode NParens startRow startCol context) expr row col\n\n    TupleSpace space row col ->\n      toSpaceReport source space row col\n\n    TupleEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PARENTHESES\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was expecting to see a closing parentheses next, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep [\"Try\",\"adding\",\"a\",D.dullyellow \")\",\"to\",\"see\",\"if\",\"that\",\"helps?\"]\n              , D.toSimpleNote $\n                  \"I can get stuck when I run into keywords, operators, parentheses, or brackets\\\n                  \\ unexpectedly. So there may be some earlier syntax trouble (like extra parenthesis\\\n                  \\ or missing brackets) that is confusing me.\"\n              ]\n          )\n\n    TupleOperatorClose row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED OPERATOR FUNCTION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow \"I was expecting a closing parenthesis here:\"\n          ,\n            D.stack\n              [ D.fillSep [\"Try\",\"adding\",\"a\",D.dullyellow \")\",\"to\",\"see\",\"if\",\"that\",\"helps!\"]\n              , D.toSimpleNote $\n                  \"I think I am parsing an operator function right now, so I am expecting to see\\\n                  \\ something like (+) or (&&) where an operator is surrounded by parentheses with\\\n                  \\ no extra spaces.\"\n              ]\n          )\n\n    TupleOperatorReserved operator row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNEXPECTED SYMBOL\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I ran into an unexpected symbol here:\"\n          ,\n            D.fillSep $\n              case operator of\n                BadDot -> [\"Maybe\",\"you\",\"wanted\",\"a\",\"record\",\"accessor\",\"like\",D.dullyellow \".x\",\"or\",D.dullyellow \".name\",\"instead?\"]\n                BadPipe -> [\"Try\",D.dullyellow \"(||)\",\"instead?\",\"To\",\"turn\",\"boolean\",\"OR\",\"into\",\"a\",\"function?\"]\n                BadArrow -> [\"Maybe\",\"you\",\"wanted\",D.dullyellow \"(>)\",\"or\",D.dullyellow \"(>=)\",\"instead?\"]\n                BadEquals -> [\"Try\",D.dullyellow \"(==)\",\"instead?\",\"To\",\"make\",\"a\",\"function\",\"that\",\"checks\",\"equality?\"]\n                BadHasType -> [\"Try\",D.dullyellow \"(::)\",\"instead?\",\"To\",\"add\",\"values\",\"to\",\"the\",\"front\",\"of\",\"lists?\"]\n          )\n\n    TupleIndentExpr1 row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PARENTHESES\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw an open parenthesis, so I was expecting to see an expression next.\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Something\",\"like\",D.dullyellow \"(4 + 5)\",\"or\"\n                  ,D.dullyellow \"(String.reverse \\\"desserts\\\")\" <> \".\"\n                  ,\"Anything\",\"where\",\"you\",\"are\",\"putting\",\"parentheses\",\"around\",\"normal\",\"expressions.\"\n                  ]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation in cases like this, so\\\n                  \\ maybe you have an expression but it is not indented enough?\"\n              ]\n          )\n\n    TupleIndentExprN row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED TUPLE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I think I am in the middle of parsing a tuple. I just saw a comma, so I was expecting to see an expression next.\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"A\",\"tuple\",\"looks\",\"like\",D.dullyellow \"(3,4)\",\"or\"\n                  ,D.dullyellow \"(\\\"Tom\\\",42)\" <> \",\"\n                  ,\"so\",\"I\",\"think\",\"there\",\"is\",\"an\",\"expression\",\"missing\",\"here?\"\n                  ]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation in cases like this, so\\\n                  \\ maybe you have an expression but it is not indented enough?\"\n              ]\n          )\n\n    TupleIndentEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PARENTHESES\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was expecting to see a closing parenthesis next:\"\n          ,\n            D.stack\n              [ D.fillSep [\"Try\",\"adding\",\"a\",D.dullyellow \")\",\"to\",\"see\",\"if\",\"that\",\"helps!\"]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation in cases like this, so\\\n                  \\ maybe you have a closing parenthesis but it is not indented enough?\"\n              ]\n          )\n\n\ntoListReport :: Code.Source -> Context -> List -> Row -> Col -> Report.Report\ntoListReport source context list startRow startCol =\n  case list of\n    ListSpace space row col ->\n      toSpaceReport source space row col\n\n    ListOpen row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED LIST\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a list, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"closing\",\"square\",\"bracket\",\"before\",\"this,\"\n                  ,\"so\",\"try\",\"adding\",\"a\",D.dullyellow \"]\",\"and\",\"see\",\"if\",\"that\",\"helps?\"\n                  ]\n              , D.toSimpleNote $\n                  \"When I get stuck like this, it usually means that there is a missing parenthesis\\\n                  \\ or bracket somewhere earlier. It could also be a stray keyword or operator.\"\n              ]\n          )\n\n    ListExpr expr row col ->\n      case expr of\n        Start r c ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position r c)\n            region = toRegion r c\n          in\n          Report.Report \"UNFINISHED LIST\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was expecting to see another list entry after that last comma:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"Trailing commas are not allowed in lists, so the fix may be to delete the comma?\"\n                  , D.toSimpleNote\n                      \"I recommend using the following format for lists that span multiple lines:\"\n                  , D.indent 4 $ D.vcat $\n                      [ \"[ \" <> D.dullyellow \"\\\"Alice\\\"\"\n                      , \", \" <> D.dullyellow \"\\\"Bob\\\"\"\n                      , \", \" <> D.dullyellow \"\\\"Chuck\\\"\"\n                      , \"]\"\n                      ]\n                  , D.reflow $\n                      \"Notice that each line starts with some indentation. Usually two or four spaces.\\\n                      \\ This is the stylistic convention in the Elm ecosystem.\"\n                  ]\n              )\n\n        _ ->\n          toExprReport source (InNode NList startRow startCol context) expr row col\n\n    ListEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED LIST\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a list, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"closing\",\"square\",\"bracket\",\"before\",\"this,\"\n                  ,\"so\",\"try\",\"adding\",\"a\",D.dullyellow \"]\",\"and\",\"see\",\"if\",\"that\",\"helps?\"\n                  ]\n              , D.toSimpleNote $\n                  \"When I get stuck like this, it usually means that there is a missing parenthesis\\\n                  \\ or bracket somewhere earlier. It could also be a stray keyword or operator.\"\n              ]\n          )\n\n    ListIndentOpen row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED LIST\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I cannot find the end of this list:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"You\",\"could\",\"change\",\"it\",\"to\",\"something\",\"like\"\n                  ,D.dullyellow \"[3,4,5]\"\n                  ,\"or\",\"even\",\"just\"\n                  ,D.dullyellow \"[]\" <> \".\"\n                  ,\"Anything\",\"where\",\"there\",\"is\",\"an\",\"open\",\"and\",\"close\",\"square\",\"brace,\"\n                  ,\"and\",\"where\",\"the\",\"elements\",\"of\",\"the\",\"list\",\"are\",\"separated\",\"by\",\"commas.\"\n                  ]\n              , D.toSimpleNote\n                  \"I may be confused by indentation. For example, if you are trying to define\\\n                  \\ a list across multiple lines, I recommend using this format:\"\n              , D.indent 4 $ D.vcat $\n                  [ \"[ \" <> D.dullyellow \"\\\"Alice\\\"\"\n                  , \", \" <> D.dullyellow \"\\\"Bob\\\"\"\n                  , \", \" <> D.dullyellow \"\\\"Chuck\\\"\"\n                  , \"]\"\n                  ]\n              , D.reflow $\n                  \"Notice that each line starts with some indentation. Usually two or four spaces.\\\n                  \\ This is the stylistic convention in the Elm ecosystem.\"\n              ]\n          )\n\n    ListIndentEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED LIST\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I cannot find the end of this list:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"You\",\"can\",\"just\",\"add\",\"a\",\"closing\",D.dullyellow \"]\"\n                  ,\"right\",\"here,\",\"and\",\"I\",\"will\",\"be\",\"all\",\"set!\"\n                  ]\n              , D.toSimpleNote\n                  \"I may be confused by indentation. For example, if you are trying to define\\\n                  \\ a list across multiple lines, I recommend using this format:\"\n              , D.indent 4 $ D.vcat $\n                  [ \"[ \" <> D.dullyellow \"\\\"Alice\\\"\"\n                  , \", \" <> D.dullyellow \"\\\"Bob\\\"\"\n                  , \", \" <> D.dullyellow \"\\\"Chuck\\\"\"\n                  , \"]\"\n                  ]\n              , D.reflow $\n                  \"Notice that each line starts with some indentation. Usually two or four spaces.\\\n                  \\ This is the stylistic convention in the Elm ecosystem.\"\n              ]\n          )\n\n    ListIndentExpr row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED LIST\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was expecting to see another list entry after this comma:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Trailing commas are not allowed in lists, so the fix may be to delete the comma?\"\n              , D.toSimpleNote\n                  \"I recommend using the following format for lists that span multiple lines:\"\n              , D.indent 4 $ D.vcat $\n                  [ \"[ \" <> D.dullyellow \"\\\"Alice\\\"\"\n                  , \", \" <> D.dullyellow \"\\\"Bob\\\"\"\n                  , \", \" <> D.dullyellow \"\\\"Chuck\\\"\"\n                  , \"]\"\n                  ]\n              , D.reflow $\n                  \"Notice that each line starts with some indentation. Usually two or four spaces.\\\n                  \\ This is the stylistic convention in the Elm ecosystem.\"\n              ]\n          )\n\n\ntoFuncReport :: Code.Source -> Context -> Func -> Row -> Col -> Report.Report\ntoFuncReport source context func startRow startCol =\n  case func of\n    FuncSpace space row col ->\n      toSpaceReport source space row col\n\n    FuncArg pattern row col ->\n      toPatternReport source PArg pattern row col\n\n    FuncBody expr row col ->\n      toExprReport source (InNode NFunc startRow startCol context) expr row col\n\n    FuncArrow row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was parsing an anonymous function, but I got stuck here:\"\n              ,\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` as an argument, but\\\n                  \\ it is a reserved word in this language. Try using a different argument name!\"\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNFINISHED ANONYMOUS FUNCTION\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I just saw the beginning of an anonymous function, so I was expecting to see an arrow next:\"\n              ,\n                D.fillSep $\n                  [\"The\",\"syntax\",\"for\",\"anonymous\",\"functions\",\"is\"\n                  ,D.dullyellow \"(\\\\x -> x + 1)\"\n                  ,\"so\",\"I\",\"am\",\"missing\",\"the\",\"arrow\",\"and\",\"the\",\"body\",\"of\",\"the\",\"function.\"\n                  ]\n              )\n\n    FuncIndentArg row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"MISSING ARGUMENT\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw the beginning of an anonymous function, so I was expecting to see an argument next:\"\n          ,\n            D.stack\n              [ D.fillSep\n                  [\"Something\",\"like\",D.dullyellow\"x\",\"or\",D.dullyellow \"name\" <> \".\"\n                  ,\"Anything\",\"that\",\"starts\",\"with\",\"a\",\"lower\",\"case\",\"letter!\"\n                  ]\n              , D.toSimpleNote $\n                  \"The syntax for anonymous functions is (\\\\x -> x + 1) where the backslash\\\n                  \\ is meant to look a bit like a lambda if you squint. This visual pun seemed\\\n                  \\ like a better idea at the time!\"\n              ]\n          )\n\n    FuncIndentArrow row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED ANONYMOUS FUNCTION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw the beginning of an anonymous function, so I was expecting to see an arrow next:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"The\",\"syntax\",\"for\",\"anonymous\",\"functions\",\"is\"\n                  ,D.dullyellow \"(\\\\x -> x + 1)\"\n                  ,\"so\",\"I\",\"am\",\"missing\",\"the\",\"arrow\",\"and\",\"the\",\"body\",\"of\",\"the\",\"function.\"\n                  ]\n              , D.toSimpleNote $\n                  \"It is possible that I am confused about indetation! I generally recommend\\\n                  \\ switching to named functions if the definition cannot fit inline nicely, so\\\n                  \\ either (1) try to fit the whole anonymous function on one line or (2) break\\\n                  \\ the whole thing out into a named function. Things tend to be clearer that way!\"\n              ]\n          )\n\n    FuncIndentBody row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED ANONYMOUS FUNCTION\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was expecting to see the body of your anonymous function next:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"The\",\"syntax\",\"for\",\"anonymous\",\"functions\",\"is\"\n                  ,D.dullyellow \"(\\\\x -> x + 1)\"\n                  ,\"so\",\"I\",\"am\",\"missing\",\"all\",\"the\",\"stuff\",\"after\",\"the\",\"arrow!\"\n                  ]\n              , D.toSimpleNote $\n                  \"It is possible that I am confused about indetation! I generally recommend\\\n                  \\ switching to named functions if the definition cannot fit inline nicely, so\\\n                  \\ either (1) try to fit the whole anonymous function on one line or (2) break\\\n                  \\ the whole thing out into a named function. Things tend to be clearer that way!\"\n              ]\n          )\n\n\n\n-- PATTERN\n\n\ndata PContext\n  = PCase\n  | PArg\n  | PLet\n\n\ntoPatternReport :: Code.Source -> PContext -> Pattern -> Row -> Col -> Report.Report\ntoPatternReport source context pattern startRow startCol =\n  case pattern of\n    PRecord record row col ->\n      toPRecordReport source record row col\n\n    PTuple tuple row col ->\n      toPTupleReport source context tuple row col\n\n    PList list row col ->\n      toPListReport source context list row col\n\n    PStart row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n            inThisThing =\n              case context of\n                PArg  -> \"as an argument\"\n                PCase -> \"in this pattern\"\n                PLet  -> \"in this pattern\"\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` \" ++ inThisThing ++ \":\"\n              ,\n                D.reflow $\n                  \"This is a reserved word! Try using some other name?\"\n              )\n\n        Code.Operator \"-\" ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNEXPECTED SYMBOL\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I ran into a minus sign unexpectedly in this pattern:\"\n              ,\n                D.reflow $\n                  \"It is not possible to pattern match on negative numbers at this\\\n                  \\ time. Try using an `if` expression for that sort of thing for now.\"\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"PROBLEM IN PATTERN\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I wanted to parse a pattern next, but I got stuck here:\"\n              ,\n                D.fillSep $\n                  [\"I\",\"am\",\"not\",\"sure\",\"why\",\"I\",\"am\",\"getting\",\"stuck\",\"exactly.\"\n                  ,\"I\",\"just\",\"know\",\"that\",\"I\",\"want\",\"a\",\"pattern\",\"next.\"\n                  ,\"Something\",\"as\",\"simple\",\"as\"\n                  ,D.dullyellow \"maybeHeight\",\"or\",D.dullyellow \"result\"\n                  ,\"would\",\"work!\"\n                  ]\n              )\n\n    PChar char row col ->\n      toCharReport source char row col\n\n    PString string row col ->\n      toStringReport source string row col\n\n    PNumber number row col ->\n      toNumberReport source number row col\n\n    PFloat width row col ->\n      let\n        region = toWiderRegion row col width\n      in\n      Report.Report \"UNEXPECTED PATTERN\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"I cannot pattern match with floating point numbers:\"\n          ,\n            D.fillSep $\n              [\"Equality\",\"on\",\"floats\",\"can\",\"be\",\"unreliable,\",\"so\",\"you\",\"usually\",\"want\"\n              ,\"to\",\"check\",\"that\",\"they\",\"are\",\"nearby\",\"with\",\"some\",\"sort\",\"of\"\n              ,D.dullyellow \"(abs (actual - expected) < 0.001)\",\"check.\"\n              ]\n          )\n\n    PAlias row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PATTERN\" region [] $\n        Code.toSnippet source region Nothing $\n          (\n            D.reflow $\n              \"I was expecting to see a variable name after the `as` keyword:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"The\",\"`as`\",\"keyword\",\"lets\",\"you\",\"write\",\"patterns\",\"like\"\n                  ,\"((\" <> D.dullyellow \"x\" <> \",\" <> D.dullyellow \"y\" <> \") \" <> D.cyan \"as\" <> D.dullyellow \" point\" <> \")\"\n                  ,\"so\",\"you\",\"can\",\"refer\",\"to\",\"individual\",\"parts\",\"of\",\"the\",\"tuple\",\"with\"\n                  ,D.dullyellow \"x\",\"and\",D.dullyellow \"y\",\"or\",\"you\",\"refer\",\"to\",\"the\",\"whole\"\n                  ,\"thing\",\"with\",D.dullyellow \"point\" <> \".\"\n                  ]\n              , D.reflow $\n                  \"So I was expecting to see a variable name after the `as` keyword here. Sometimes\\\n                  \\ people just want to use `as` as a variable name though. Try using a different name\\\n                  \\ in that case!\"\n              ]\n          )\n\n    PWildcardNotVar name width row col ->\n      let\n        region = toWiderRegion row col (fromIntegral width)\n        examples =\n          case dropWhile (=='_') (Name.toChars name) of\n            [] -> [D.dullyellow \"x\",\"or\",D.dullyellow \"age\"]\n            c:cs -> [D.dullyellow (D.fromChars (Char.toLower c : cs))]\n      in\n      Report.Report \"UNEXPECTED NAME\" region [] $\n        Code.toSnippet source region Nothing $\n          (\n            D.reflow $\n              \"Variable names cannot start with underscores like this:\"\n          ,\n            D.fillSep $\n              [\"You\",\"can\",\"either\",\"have\",\"an\",\"underscore\",\"like\",D.dullyellow \"_\",\"to\"\n              ,\"ignore\",\"the\",\"value,\",\"or\",\"you\",\"can\",\"have\",\"a\",\"name\",\"like\"\n              ] ++ examples ++ [\"to\",\"use\",\"the\",\"matched\",\"value.\" ]\n          )\n\n    PSpace space row col ->\n      toSpaceReport source space row col\n\n    PIndentStart row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PATTERN\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I wanted to parse a pattern next, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"am\",\"not\",\"sure\",\"why\",\"I\",\"am\",\"getting\",\"stuck\",\"exactly.\"\n                  ,\"I\",\"just\",\"know\",\"that\",\"I\",\"want\",\"a\",\"pattern\",\"next.\"\n                  ,\"Something\",\"as\",\"simple\",\"as\"\n                  ,D.dullyellow \"maybeHeight\",\"or\",D.dullyellow \"result\"\n                  ,\"would\",\"work!\"\n                  ]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation. If you think there is a pattern next, maybe\\\n                  \\ it needs to be indented a bit more?\"\n              ]\n          )\n\n    PIndentAlias row col ->\n      let\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PATTERN\" region [] $\n        Code.toSnippet source region Nothing $\n          (\n            D.reflow $\n              \"I was expecting to see a variable name after the `as` keyword:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"The\",\"`as`\",\"keyword\",\"lets\",\"you\",\"write\",\"patterns\",\"like\"\n                  ,\"((\" <> D.dullyellow \"x\" <> \",\" <> D.dullyellow \"y\" <> \") \" <> D.cyan \"as\" <> D.dullyellow \" point\" <> \")\"\n                  ,\"so\",\"you\",\"can\",\"refer\",\"to\",\"individual\",\"parts\",\"of\",\"the\",\"tuple\",\"with\"\n                  ,D.dullyellow \"x\",\"and\",D.dullyellow \"y\",\"or\",\"you\",\"refer\",\"to\",\"the\",\"whole\"\n                  ,\"thing\",\"with\",D.dullyellow \"point.\"\n                  ]\n              , D.reflow $\n                  \"So I was expecting to see a variable name after the `as` keyword here. Sometimes\\\n                  \\ people just want to use `as` as a variable name though. Try using a different name\\\n                  \\ in that case!\"\n              ]\n          )\n\n\ntoPRecordReport :: Code.Source -> PRecord -> Row -> Col -> Report.Report\ntoPRecordReport source record startRow startCol =\n  case record of\n    PRecordOpen row col ->\n      toUnfinishRecordPatternReport source row col startRow startCol $\n        D.reflow \"I was expecting to see a field name next.\"\n\n    PRecordEnd row col ->\n      toUnfinishRecordPatternReport source row col startRow startCol $\n        D.fillSep\n          [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"closing\",\"curly\",\"brace\",\"next.\"\n          ,\"Try\",\"adding\",\"a\",D.dullyellow \"}\",\"here?\"\n          ]\n\n    PRecordField row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was not expecting to see `\" ++ keyword ++ \"` as a record field name:\"\n              ,\n                D.reflow $\n                  \"This is a reserved word, not available for variable names. Try another name!\"\n              )\n\n        _ ->\n          toUnfinishRecordPatternReport source row col startRow startCol $\n            D.reflow \"I was expecting to see a field name next.\"\n\n    PRecordSpace space row col ->\n      toSpaceReport source space row col\n\n    PRecordIndentOpen row col ->\n      toUnfinishRecordPatternReport source row col startRow startCol $\n        D.reflow \"I was expecting to see a field name next.\"\n\n    PRecordIndentEnd row col ->\n      toUnfinishRecordPatternReport source row col startRow startCol $\n        D.fillSep\n          [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"closing\",\"curly\",\"brace\",\"next.\"\n          ,\"Try\",\"adding\",\"a\",D.dullyellow \"}\",\"here?\"\n          ]\n\n    PRecordIndentField row col ->\n      toUnfinishRecordPatternReport source row col startRow startCol $\n        D.reflow \"I was expecting to see a field name next.\"\n\n\ntoUnfinishRecordPatternReport :: Code.Source -> Row -> Col -> Row -> Col -> D.Doc -> Report.Report\ntoUnfinishRecordPatternReport source row col startRow startCol message =\n  let\n    surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n    region = toRegion row col\n  in\n  Report.Report \"UNFINISHED RECORD PATTERN\" region [] $\n    Code.toSnippet source surroundings (Just region)\n      (\n        D.reflow $\n          \"I was partway through parsing a record pattern, but I got stuck here:\"\n      ,\n        D.stack\n          [ message\n          , D.toFancyHint $\n              [\"A\",\"record\",\"pattern\",\"looks\",\"like\",D.dullyellow \"{x,y}\",\"or\",D.dullyellow \"{name,age}\"\n              ,\"where\",\"you\",\"list\",\"the\",\"field\",\"names\",\"you\",\"want\",\"to\",\"access.\"\n              ]\n          ]\n      )\n\n\n\ntoPTupleReport :: Code.Source -> PContext -> PTuple -> Row -> Col -> Report.Report\ntoPTupleReport source context tuple startRow startCol =\n  case tuple of\n    PTupleOpen row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` as a variable name:\"\n              ,\n                D.reflow $\n                  \"This is a reserved word! Try using some other name?\"\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNFINISHED PARENTHESES\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I just saw an open parenthesis, but I got stuck here:\"\n              ,\n                D.fillSep\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"pattern\",\"next.\"\n                  ,\"Maybe\",\"it\",\"will\",\"end\",\"up\",\"being\",\"something\"\n                  ,\"like\",D.dullyellow \"(x,y)\",\"or\",D.dullyellow \"(name, _)\" <> \"?\"\n                  ]\n              )\n\n    PTupleEnd row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region) $\n              (\n                D.reflow $\n                  \"I ran into a reserved word in this pattern:\"\n              ,\n                D.reflow $\n                  \"The `\" ++ keyword ++ \"` keyword is reserved. Try using a different name instead!\"\n              )\n\n        Code.Operator op ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col op\n          in\n          Report.Report \"UNEXPECTED SYMBOL\" region [] $\n            Code.toSnippet source surroundings (Just region) $\n              (\n                D.reflow $\n                  \"I ran into the \" ++ op ++ \" symbol unexpectedly in this pattern:\"\n              ,\n                D.reflow $\n                  \"Only the :: symbol that works in patterns. It is useful if you\\\n                  \\ are pattern matching on lists, trying to get the first element\\\n                  \\ off the front. Did you want that instead?\"\n              )\n\n        Code.Close term bracket ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report (\"STRAY \" ++ map Char.toUpper term) region [] $\n            Code.toSnippet source surroundings (Just region) $\n              (\n                D.reflow $\n                  \"I ran into a an unexpected \" ++ term ++ \" in this pattern:\"\n              ,\n                D.reflow $\n                  \"This \" ++ bracket : \" does not match up with an earlier open \" ++ term ++ \". Try deleting it?\"\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNFINISHED PARENTHESES\" region [] $\n            Code.toSnippet source surroundings (Just region) $\n              (\n                D.reflow $\n                  \"I was partway through parsing a pattern, but I got stuck here:\"\n              ,\n                D.fillSep\n                  [\"I\",\"was\",\"expecting\",\"a\",\"closing\",\"parenthesis\",\"next,\",\"so\"\n                  ,\"try\",\"adding\",\"a\",D.dullyellow \")\",\"to\",\"see\",\"if\",\"that\",\"helps?\"\n                  ]\n              )\n\n    PTupleExpr pattern row col ->\n      toPatternReport source context pattern row col\n\n    PTupleSpace space row col ->\n      toSpaceReport source space row col\n\n    PTupleIndentEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PARENTHESES\" region [] $\n        Code.toSnippet source surroundings (Just region) $\n          (\n            D.reflow $\n              \"I was expecting a closing parenthesis next:\"\n          ,\n            D.stack\n              [ D.fillSep [\"Try\",\"adding\",\"a\",D.dullyellow \")\",\"to\",\"see\",\"if\",\"that\",\"helps?\"]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation in cases like this, so\\\n                  \\ maybe you have a closing parenthesis but it is not indented enough?\"\n              ]\n          )\n\n    PTupleIndentExpr1 row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PARENTHESES\" region [] $\n        Code.toSnippet source surroundings (Just region) $\n          (\n            D.reflow $\n              \"I just saw an open parenthesis, but then I got stuck here:\"\n          ,\n            D.fillSep\n              [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"pattern\",\"next.\"\n              ,\"Maybe\",\"it\",\"will\",\"end\",\"up\",\"being\",\"something\"\n              ,\"like\",D.dullyellow \"(x,y)\",\"or\",D.dullyellow \"(name, _)\" <> \"?\"\n              ]\n          )\n\n    PTupleIndentExprN row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED TUPLE PATTERN\" region [] $\n        Code.toSnippet source surroundings (Just region) $\n          (\n            D.reflow $\n              \"I am partway through parsing a tuple pattern, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"pattern\",\"next.\"\n                  ,\"I\",\"am\",\"expecting\",\"the\",\"final\",\"result\",\"to\",\"be\",\"something\"\n                  ,\"like\",D.dullyellow \"(x,y)\",\"or\",D.dullyellow \"(name, _)\" <> \".\"\n                  ]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation in cases like this, so the problem\\\n                  \\ may be that the next part is not indented enough?\"\n              ]\n          )\n\n\ntoPListReport :: Code.Source -> PContext -> PList -> Row -> Col -> Report.Report\ntoPListReport source context list startRow startCol =\n  case list of\n    PListOpen row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` to name an element of a list:\"\n              ,\n                D.reflow $\n                  \"This is a reserved word though! Try using some other name?\"\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNFINISHED LIST PATTERN\" region [] $\n            Code.toSnippet source surroundings (Just region) $\n              (\n                D.reflow $\n                  \"I just saw an open square bracket, but then I got stuck here:\"\n              ,\n                D.fillSep [\"Try\",\"adding\",\"a\",D.dullyellow \"]\",\"to\",\"see\",\"if\",\"that\",\"helps?\"]\n              )\n\n    PListEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED LIST PATTERN\" region [] $\n        Code.toSnippet source surroundings (Just region) $\n          (\n            D.reflow $\n              \"I was expecting a closing square bracket to end this list pattern:\"\n          ,\n            D.fillSep [\"Try\",\"adding\",\"a\",D.dullyellow \"]\",\"to\",\"see\",\"if\",\"that\",\"helps?\"]\n          )\n\n    PListExpr pattern row col ->\n      toPatternReport source context pattern row col\n\n    PListSpace space row col ->\n      toSpaceReport source space row col\n\n    PListIndentOpen row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED LIST PATTERN\" region [] $\n        Code.toSnippet source surroundings (Just region) $\n          (\n            D.reflow $\n              \"I just saw an open square bracket, but then I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep [\"Try\",\"adding\",\"a\",D.dullyellow \"]\",\"to\",\"see\",\"if\",\"that\",\"helps?\"]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation in cases like this, so\\\n                  \\ maybe there is something next, but it is not indented enough?\"\n              ]\n          )\n\n    PListIndentEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED LIST PATTERN\" region [] $\n        Code.toSnippet source surroundings (Just region) $\n          (\n            D.reflow $\n              \"I was expecting a closing square bracket to end this list pattern:\"\n          ,\n            D.stack\n              [ D.fillSep [\"Try\",\"adding\",\"a\",D.dullyellow \"]\",\"to\",\"see\",\"if\",\"that\",\"helps?\"]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation in cases like this, so\\\n                  \\ maybe you have a closing square bracket but it is not indented enough?\"\n              ]\n          )\n\n    PListIndentExpr row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED LIST PATTERN\" region [] $\n        Code.toSnippet source surroundings (Just region) $\n          (\n            D.reflow $\n              \"I am partway through parsing a list pattern, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"I was expecting to see another pattern next. Maybe a variable name.\"\n              , D.toSimpleNote $\n                  \"I can get confused by indentation in cases like this, so\\\n                  \\ maybe there is more to this pattern but it is not indented enough?\"\n              ]\n          )\n\n\n\n-- TYPES\n\n\ndata TContext\n  = TC_Annotation Name.Name\n  | TC_CustomType\n  | TC_TypeAlias\n  | TC_Port\n\n\ntoTypeReport :: Code.Source -> TContext -> Type -> Row -> Col -> Report.Report\ntoTypeReport source context tipe startRow startCol =\n  case tipe of\n    TRecord record row col ->\n      toTRecordReport source context record row col\n\n    TTuple tuple row col ->\n      toTTupleReport source context tuple row col\n\n    TStart row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was expecting to see a type next, but I got stuck on this reserved word:\"\n              ,\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` as a type variable, but \\\n                  \\ it is a reserved word. Try using a different name!\"\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n\n            thing =\n              case context of\n                TC_Annotation _ -> \"type annotation\"\n                TC_CustomType -> \"custom type\"\n                TC_TypeAlias -> \"type alias\"\n                TC_Port -> \"port\"\n\n            something =\n              case context of\n                TC_Annotation name -> \"the `\" ++ Name.toChars name ++ \"` type annotation\"\n                TC_CustomType -> \"a custom type\"\n                TC_TypeAlias -> \"a type alias\"\n                TC_Port -> \"a port\"\n          in\n          Report.Report (\"PROBLEM IN \" ++ map Char.toUpper thing) region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was partway through parsing \" ++ something ++ \", but I got stuck here:\"\n              ,\n                D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"type\",\"next.\"\n                  ,\"Try\",\"putting\",D.dullyellow \"Int\",\"or\",D.dullyellow \"String\",\"for\",\"now?\"\n                  ]\n              )\n\n    TSpace space row col ->\n      toSpaceReport source space row col\n\n    TIndentStart row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n\n        thing =\n          case context of\n            TC_Annotation _ -> \"type annotation\"\n            TC_CustomType -> \"custom type\"\n            TC_TypeAlias -> \"type alias\"\n            TC_Port -> \"port\"\n      in\n      Report.Report (\"UNFINISHED \" ++ map Char.toUpper thing) region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was partway through parsing a \" ++ thing ++ \", but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"type\",\"next.\"\n                  ,\"Try\",\"putting\",D.dullyellow \"Int\",\"or\",D.dullyellow \"String\",\"for\",\"now?\"\n                  ]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation. If you think there is already a type\\\n                  \\ next, maybe it is not indented enough?\"\n              ]\n          )\n\n\ntoTRecordReport :: Code.Source -> TContext -> TRecord -> Row -> Col -> Report.Report\ntoTRecordReport source context record startRow startCol =\n  case record of\n    TRecordOpen row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I just started parsing a record type, but I got stuck on this field name:\"\n              ,\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` as a field name, but \\\n                  \\ that is a reserved word. Try using a different name!\"\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNFINISHED RECORD TYPE\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I just started parsing a record type, but I got stuck here:\"\n              ,\n                D.fillSep\n                  [\"Record\",\"types\",\"look\",\"like\",D.dullyellow \"{ name : String, age : Int },\"\n                  ,\"so\",\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"field\",\"name\",\"next.\"\n                  ]\n              )\n\n    TRecordEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED RECORD TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a record type, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep\n                  [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"closing\",\"curly\",\"brace\",\"before\",\"this,\"\n                  ,\"so\",\"try\",\"adding\",\"a\",D.dullyellow \"}\",\"and\",\"see\",\"if\",\"that\",\"helps?\"\n                  ]\n              , D.toSimpleNote $\n                  \"When I get stuck like this, it usually means that there is a missing parenthesis\\\n                  \\ or bracket somewhere earlier. It could also be a stray keyword or operator.\"\n              ]\n          )\n\n    TRecordField row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a record type, but I got stuck on this field name:\"\n              ,\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` as a field name, but \\\n                  \\ that is a reserved word. Try using a different name!\"\n              )\n\n        Code.Other (Just ',') ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"EXTRA COMMA\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a record type, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I am seeing two commas in a row. This is the second one!\"\n                  , D.reflow $\n                      \"Just delete one of the commas and you should be all set!\"\n                  , noteForRecordTypeError\n                  ]\n              )\n\n        Code.Close _ '}' ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"EXTRA COMMA\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a record type, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"Trailing commas are not allowed in record types. Try deleting the comma that\\\n                      \\ appears before this closing curly brace.\"\n                  , noteForRecordTypeError\n                  ]\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"PROBLEM IN RECORD TYPE\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I am partway through parsing a record type, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.fillSep\n                      [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"another\",\"record\",\"field\",\"defined\",\"next,\"\n                      ,\"so\",\"I\",\"am\",\"looking\",\"for\",\"a\",\"name\",\"like\"\n                      ,D.dullyellow \"userName\",\"or\",D.dullyellow \"plantHeight\" <> \".\"\n                      ]\n                  , noteForRecordTypeError\n                  ]\n              )\n\n    TRecordColon row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED RECORD TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a record type, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"just\",\"saw\",\"a\",\"field\",\"name,\",\"so\",\"I\",\"was\",\"expecting\",\"to\",\"see\"\n                  ,\"a\",\"colon\",\"next.\",\"So\",\"try\",\"putting\",\"an\",D.green \":\",\"sign\",\"here?\"\n                  ]\n              , noteForRecordTypeError\n              ]\n          )\n\n    TRecordType tipe row col ->\n      toTypeReport source context tipe row col\n\n    TRecordSpace space row col ->\n      toSpaceReport source space row col\n\n    TRecordIndentOpen row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED RECORD TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw the opening curly brace of a record type, but then I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"I\",\"am\",\"expecting\",\"a\",\"record\",\"like\",D.dullyellow \"{ name : String, age : Int }\",\"here.\"\n                  ,\"Try\",\"defining\",\"some\",\"fields\",\"of\",\"your\",\"own?\"\n                  ]\n              , noteForRecordTypeIndentError\n              ]\n          )\n\n    TRecordIndentEnd row col ->\n      case Code.nextLineStartsWithCloseCurly source row of\n        Just (curlyRow, curlyCol) ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position curlyRow curlyCol)\n            region = toRegion curlyRow curlyCol\n          in\n          Report.Report \"NEED MORE INDENTATION\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was partway through parsing a record type, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.reflow $\n                      \"I need this curly brace to be indented more. Try adding some spaces before it!\"\n                  , noteForRecordTypeError\n                  ]\n              )\n\n        Nothing ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNFINISHED RECORD TYPE\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I was partway through parsing a record type, but I got stuck here:\"\n              ,\n                D.stack\n                  [ D.fillSep $\n                      [\"I\",\"was\",\"expecting\",\"to\",\"see\",\"a\",\"closing\",\"curly\",\"brace\",\"next.\"\n                      ,\"Try\",\"putting\",\"a\",D.green \"}\",\"next\",\"and\",\"see\",\"if\",\"that\",\"helps?\"\n                      ]\n                  , noteForRecordTypeIndentError\n                  ]\n              )\n\n    TRecordIndentField row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED RECORD TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a record type, but I got stuck after that last comma:\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Trailing commas are not allowed in record types, so the fix may be to\\\n                  \\ delete that last comma? Or maybe you were in the middle of defining\\\n                  \\ an additional field?\"\n              , noteForRecordTypeIndentError\n              ]\n          )\n\n    TRecordIndentColon row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED RECORD TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a record type. I just saw a record\\\n              \\ field, so I was expecting to see a colon next:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Try\",\"putting\",\"an\",D.green \":\",\"followed\",\"by\",\"a\",\"type?\"\n                  ]\n              , noteForRecordTypeIndentError\n              ]\n          )\n\n    TRecordIndentType row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED RECORD TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I am partway through parsing a record type, and I was expecting to run into a type next:\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Try\",\"putting\",\"something\",\"like\"\n                  ,D.dullyellow \"Int\",\"or\",D.dullyellow \"String\",\"for\",\"now?\"\n                  ]\n              , noteForRecordTypeIndentError\n              ]\n          )\n\n\nnoteForRecordTypeError :: D.Doc\nnoteForRecordTypeError =\n  D.stack $\n    [ D.toSimpleNote\n        \"If you are trying to define a record type across multiple lines, I recommend using this format:\"\n    , D.indent 4 $ D.vcat $\n        [ \"{ name : String\"\n        , \", age : Int\"\n        , \", height : Float\"\n        , \"}\"\n        ]\n    , D.reflow $\n        \"Notice that each line starts with some indentation. Usually two or four spaces.\\\n        \\ This is the stylistic convention in the Elm ecosystem.\"\n    ]\n\n\nnoteForRecordTypeIndentError :: D.Doc\nnoteForRecordTypeIndentError =\n  D.stack $\n    [ D.toSimpleNote\n        \"I may be confused by indentation. For example, if you are trying to define\\\n        \\ a record type across multiple lines, I recommend using this format:\"\n    , D.indent 4 $ D.vcat $\n        [ \"{ name : String\"\n        , \", age : Int\"\n        , \", height : Float\"\n        , \"}\"\n        ]\n    , D.reflow $\n        \"Notice that each line starts with some indentation. Usually two or four spaces.\\\n        \\ This is the stylistic convention in the Elm ecosystem.\"\n    ]\n\n\ntoTTupleReport :: Code.Source -> TContext -> TTuple -> Row -> Col -> Report.Report\ntoTTupleReport source context tuple startRow startCol =\n  case tuple of\n    TTupleOpen row col ->\n      case Code.whatIsNext source row col of\n        Code.Keyword keyword ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toKeywordRegion row col keyword\n          in\n          Report.Report \"RESERVED WORD\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I ran into a reserved word unexpectedly:\"\n              ,\n                D.reflow $\n                  \"It looks like you are trying to use `\" ++ keyword ++ \"` as a variable name, but \\\n                  \\ it is a reserved word. Try using a different name!\"\n              )\n\n        _ ->\n          let\n            surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n            region = toRegion row col\n          in\n          Report.Report \"UNFINISHED PARENTHESES\" region [] $\n            Code.toSnippet source surroundings (Just region)\n              (\n                D.reflow $\n                  \"I just saw an open parenthesis, so I was expecting to see a type next.\"\n              ,\n                D.fillSep $\n                  [\"Something\",\"like\",D.dullyellow \"(Maybe Int)\",\"or\"\n                  ,D.dullyellow \"(List Person)\" <> \".\"\n                  ,\"Anything\",\"where\",\"you\",\"are\",\"putting\",\"parentheses\",\"around\",\"normal\",\"types.\"\n                  ]\n              )\n\n    TTupleEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PARENTHESES\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was expecting to see a closing parenthesis next, but I got stuck here:\"\n          ,\n            D.stack\n              [ D.fillSep [\"Try\",\"adding\",\"a\",D.dullyellow \")\",\"to\",\"see\",\"if\",\"that\",\"helps?\"]\n              , D.toSimpleNote $\n                  \"I can get stuck when I run into keywords, operators, parentheses, or brackets\\\n                  \\ unexpectedly. So there may be some earlier syntax trouble (like extra parenthesis\\\n                  \\ or missing brackets) that is confusing me.\"\n              ]\n          )\n\n    TTupleType tipe row col ->\n      toTypeReport source context tipe row col\n\n    TTupleSpace space row col ->\n      toSpaceReport source space row col\n\n    TTupleIndentType1 row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PARENTHESES\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I just saw an open parenthesis, so I was expecting to see a type next.\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"Something\",\"like\",D.dullyellow \"(Maybe Int)\",\"or\"\n                  ,D.dullyellow \"(List Person)\" <> \".\"\n                  ,\"Anything\",\"where\",\"you\",\"are\",\"putting\",\"parentheses\",\"around\",\"normal\",\"types.\"\n                  ]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation in cases like this, so\\\n                  \\ maybe you have a type but it is not indented enough?\"\n              ]\n          )\n\n    TTupleIndentTypeN row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED TUPLE TYPE\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I think I am in the middle of parsing a tuple type. I just saw a comma, so I was expecting to see a type next.\"\n          ,\n            D.stack\n              [ D.fillSep $\n                  [\"A\",\"tuple\",\"type\",\"looks\",\"like\",D.dullyellow \"(Float,Float)\",\"or\"\n                  ,D.dullyellow \"(String,Int)\" <> \",\"\n                  ,\"so\",\"I\",\"think\",\"there\",\"is\",\"a\",\"type\",\"missing\",\"here?\"\n                  ]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation in cases like this, so\\\n                  \\ maybe you have an expression but it is not indented enough?\"\n              ]\n          )\n\n    TTupleIndentEnd row col ->\n      let\n        surroundings = A.Region (A.Position startRow startCol) (A.Position row col)\n        region = toRegion row col\n      in\n      Report.Report \"UNFINISHED PARENTHESES\" region [] $\n        Code.toSnippet source surroundings (Just region)\n          (\n            D.reflow $\n              \"I was expecting to see a closing parenthesis next:\"\n          ,\n            D.stack\n              [ D.fillSep [\"Try\",\"adding\",\"a\",D.dullyellow \")\",\"to\",\"see\",\"if\",\"that\",\"helps!\"]\n              , D.toSimpleNote $\n                  \"I can get confused by indentation in cases like this, so\\\n                  \\ maybe you have a closing parenthesis but it is not indented enough?\"\n              ]\n          )\n"
  },
  {
    "path": "compiler/src/Reporting/Error/Type.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Error.Type\n  ( Error(..)\n  -- expectations\n  , Expected(..)\n  , Context(..)\n  , SubContext(..)\n  , MaybeName(..)\n  , Category(..)\n  , PExpected(..)\n  , PContext(..)\n  , PCategory(..)\n  , typeReplace\n  , ptypeReplace\n  -- make reports\n  , toReport\n  )\n  where\n\n\nimport Prelude hiding (round)\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified Data.Index as Index\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Render.Code as Code\nimport qualified Reporting.Render.Type as RT\nimport qualified Reporting.Render.Type.Localizer as L\nimport qualified Reporting.Report as Report\nimport qualified Reporting.Suggest as Suggest\nimport qualified Type.Error as T\n\n\n\n-- ERRORS\n\n\ndata Error\n  = BadExpr A.Region Category T.Type (Expected T.Type)\n  | BadPattern A.Region PCategory T.Type (PExpected T.Type)\n  | InfiniteType A.Region Name.Name T.Type\n\n\n\n-- EXPRESSION EXPECTATIONS\n\n\ndata Expected tipe\n  = NoExpectation tipe\n  | FromContext A.Region Context tipe\n  | FromAnnotation Name.Name Int SubContext tipe\n\n\ndata Context\n  = ListEntry Index.ZeroBased\n  | Negate\n  | OpLeft Name.Name\n  | OpRight Name.Name\n  | IfCondition\n  | IfBranch Index.ZeroBased\n  | CaseBranch Index.ZeroBased\n  | CallArity MaybeName Int\n  | CallArg MaybeName Index.ZeroBased\n  | RecordAccess A.Region (Maybe Name.Name) A.Region Name.Name\n  | RecordUpdateKeys Name.Name (Map.Map Name.Name Can.FieldUpdate)\n  | RecordUpdateValue Name.Name\n  | Destructure\n\n\ndata SubContext\n  = TypedIfBranch Index.ZeroBased\n  | TypedCaseBranch Index.ZeroBased\n  | TypedBody\n\n\ndata MaybeName\n  = FuncName Name.Name\n  | CtorName Name.Name\n  | OpName Name.Name\n  | NoName\n\n\ndata Category\n  = List\n  | Number\n  | Float\n  | String\n  | Char\n  | If\n  | Case\n  | CallResult MaybeName\n  | Lambda\n  | Accessor Name.Name\n  | Access Name.Name\n  | Record\n  | Tuple\n  | Unit\n  | Shader\n  | Effects\n  | Local Name.Name\n  | Foreign Name.Name\n\n\n\n-- PATTERN EXPECTATIONS\n\n\ndata PExpected tipe\n  = PNoExpectation tipe\n  | PFromContext A.Region PContext tipe\n\n\ndata PContext\n  = PTypedArg Name.Name Index.ZeroBased\n  | PCaseMatch Index.ZeroBased\n  | PCtorArg Name.Name Index.ZeroBased\n  | PListEntry Index.ZeroBased\n  | PTail\n\n\ndata PCategory\n  = PRecord\n  | PUnit\n  | PTuple\n  | PList\n  | PCtor Name.Name\n  | PInt\n  | PStr\n  | PChr\n  | PBool\n\n\n\n-- HELPERS\n\n\ntypeReplace :: Expected a -> b -> Expected b\ntypeReplace expectation tipe =\n  case expectation of\n    NoExpectation _ ->\n      NoExpectation tipe\n\n    FromContext region context _ ->\n      FromContext region context tipe\n\n    FromAnnotation name arity context _ ->\n      FromAnnotation name arity context tipe\n\n\nptypeReplace :: PExpected a -> b -> PExpected b\nptypeReplace expectation tipe =\n  case expectation of\n    PNoExpectation _ ->\n      PNoExpectation tipe\n\n    PFromContext region context _ ->\n      PFromContext region context tipe\n\n\n\n-- TO REPORT\n\n\ntoReport :: Code.Source -> L.Localizer -> Error -> Report.Report\ntoReport source localizer err =\n  case err of\n    BadExpr region category actualType expected ->\n      toExprReport source localizer region category actualType expected\n\n    BadPattern region category tipe expected ->\n      toPatternReport source localizer region category tipe expected\n\n    InfiniteType region name overallType ->\n      toInfiniteReport source localizer region name overallType\n\n\n\n-- TO PATTERN REPORT\n\n\ntoPatternReport :: Code.Source -> L.Localizer -> A.Region -> PCategory -> T.Type -> PExpected T.Type -> Report.Report\ntoPatternReport source localizer patternRegion category tipe expected =\n  Report.Report \"TYPE MISMATCH\" patternRegion [] $\n  case expected of\n    PNoExpectation expectedType ->\n      Code.toSnippet source patternRegion Nothing $\n        ( \"This pattern is being used in an unexpected way:\"\n        , patternTypeComparison localizer tipe expectedType\n            (addPatternCategory \"It is\" category)\n            \"But it needs to match:\"\n            []\n        )\n\n    PFromContext region context expectedType ->\n      Code.toSnippet source region (Just patternRegion) $\n        case context of\n          PTypedArg name index ->\n            ( D.reflow $\n                \"The \" <> D.ordinal index <> \" argument to `\" <> Name.toChars name <> \"` is weird.\"\n            , patternTypeComparison localizer tipe expectedType\n                (addPatternCategory \"The argument is a pattern that matches\" category)\n                ( \"But the type annotation on `\" <> Name.toChars name\n                  <> \"` says the \" <> D.ordinal index <> \" argument should be:\"\n                )\n                []\n            )\n\n          PCaseMatch index ->\n            if index == Index.first then\n              (\n                D.reflow $\n                  \"The 1st pattern in this `case` causing a mismatch:\"\n              ,\n                patternTypeComparison localizer tipe expectedType\n                  (addPatternCategory \"The first pattern is trying to match\" category)\n                  \"But the expression between `case` and `of` is:\"\n                  [ D.reflow $\n                      \"These can never match! Is the pattern the problem? Or is it the expression?\"\n                  ]\n              )\n            else\n              ( D.reflow $\n                  \"The \" <> D.ordinal index <> \" pattern in this `case` does not match the previous ones.\"\n              , patternTypeComparison localizer tipe expectedType\n                  (addPatternCategory (\"The \" <> D.ordinal index <> \" pattern is trying to match\") category)\n                  \"But all the previous patterns match:\"\n                  [ D.link \"Note\"\n                      \"A `case` expression can only handle one type of value, so you may want to use\"\n                      \"custom-types\"\n                      \"to handle “mixing” types.\"\n                  ]\n              )\n\n          PCtorArg name index ->\n            ( D.reflow $\n                \"The \" <> D.ordinal index <> \" argument to `\" <> Name.toChars name <> \"` is weird.\"\n            , patternTypeComparison localizer tipe expectedType\n                (addPatternCategory \"It is trying to match\" category)\n                ( \"But `\" <> Name.toChars name <> \"` needs its \"\n                  <> D.ordinal index <> \" argument to be:\"\n                )\n                []\n            )\n\n          PListEntry index ->\n            ( D.reflow $\n                \"The \" <> D.ordinal index <> \" pattern in this list does not match all the previous ones:\"\n            , patternTypeComparison localizer tipe expectedType\n                (addPatternCategory (\"The \" <> D.ordinal index <> \" pattern is trying to match\") category)\n                \"But all the previous patterns in the list are:\"\n                [ D.link \"Hint\"\n                    \"Everything in a list must be the same type of value. This way, we never\\\n                    \\ run into unexpected values partway through a List.map, List.foldl, etc. Read\"\n                    \"custom-types\"\n                    \"to learn how to “mix” types.\"\n                ]\n            )\n\n          PTail ->\n            ( D.reflow $\n                \"The pattern after (::) is causing issues.\"\n            , patternTypeComparison localizer tipe expectedType\n                (addPatternCategory \"The pattern after (::) is trying to match\" category)\n                \"But it needs to match lists like this:\"\n                []\n            )\n\n\n\n-- PATTERN HELPERS\n\n\npatternTypeComparison :: L.Localizer -> T.Type -> T.Type -> String -> String -> [D.Doc] -> D.Doc\npatternTypeComparison localizer actual expected iAmSeeing insteadOf contextHints =\n  let\n    (actualDoc, expectedDoc, problems) =\n      T.toComparison localizer actual expected\n  in\n  D.stack $\n    [ D.reflow iAmSeeing\n    , D.indent 4 actualDoc\n    , D.reflow insteadOf\n    , D.indent 4 expectedDoc\n    ]\n    ++ problemsToHint problems\n    ++ contextHints\n\n\naddPatternCategory :: String -> PCategory -> String\naddPatternCategory iAmTryingToMatch category =\n  iAmTryingToMatch <>\n    case category of\n      PRecord -> \" record values of type:\"\n      PUnit -> \" unit values:\"\n      PTuple -> \" tuples of type:\"\n      PList -> \" lists of type:\"\n      PCtor name -> \" `\" <> Name.toChars name <> \"` values of type:\"\n      PInt -> \" integers:\"\n      PStr -> \" strings:\"\n      PChr -> \" characters:\"\n      PBool -> \" booleans:\"\n\n\n\n-- EXPR HELPERS\n\n\ntypeComparison :: L.Localizer -> T.Type -> T.Type -> String -> String -> [D.Doc] -> D.Doc\ntypeComparison localizer actual expected iAmSeeing insteadOf contextHints =\n  let\n    (actualDoc, expectedDoc, problems) =\n      T.toComparison localizer actual expected\n  in\n  D.stack $\n    [ D.reflow iAmSeeing\n    , D.indent 4 actualDoc\n    , D.reflow insteadOf\n    , D.indent 4 expectedDoc\n    ]\n    ++ contextHints\n    ++ problemsToHint problems\n\n\nloneType :: L.Localizer -> T.Type -> T.Type -> D.Doc -> [D.Doc] -> D.Doc\nloneType localizer actual expected iAmSeeing furtherDetails =\n  let\n    (actualDoc, _, problems) =\n      T.toComparison localizer actual expected\n  in\n  D.stack $\n    [ iAmSeeing\n    , D.indent 4 actualDoc\n    ]\n    ++ furtherDetails\n    ++ problemsToHint problems\n\n\naddCategory :: String -> Category -> String\naddCategory thisIs category =\n  case category of\n    Local name -> \"This `\" <> Name.toChars name <> \"` value is a:\"\n    Foreign name -> \"This `\" <> Name.toChars name <> \"` value is a:\"\n    Access field -> \"The value at .\" <> Name.toChars field <> \" is a:\"\n    Accessor field -> \"This .\" <> Name.toChars field <> \" field access function has type:\"\n    If -> \"This `if` expression produces:\"\n    Case -> \"This `case` expression produces:\"\n    List -> thisIs <> \" a list of type:\"\n    Number -> thisIs <> \" a number of type:\"\n    Float -> thisIs <> \" a float of type:\"\n    String -> thisIs <> \" a string of type:\"\n    Char -> thisIs <> \" a character of type:\"\n    Lambda -> thisIs <> \" an anonymous function of type:\"\n    Record -> thisIs <> \" a record of type:\"\n    Tuple -> thisIs <> \" a tuple of type:\"\n    Unit -> thisIs <> \" a unit value:\"\n    Shader -> thisIs <> \" a GLSL shader of type:\"\n    Effects -> thisIs <> \" a thing for CORE LIBRARIES ONLY.\"\n    CallResult maybeName ->\n      case maybeName of\n        NoName -> thisIs <> \":\"\n        FuncName name -> \"This `\" <> Name.toChars name <> \"` call produces:\"\n        CtorName name -> \"This `\" <> Name.toChars name <> \"` call produces:\"\n        OpName _ -> thisIs <> \":\"\n\n\nproblemsToHint :: [T.Problem] -> [D.Doc]\nproblemsToHint problems =\n  case problems of\n    [] ->\n      []\n\n    problem : _ ->\n      problemToHint problem\n\n\nproblemToHint :: T.Problem -> [D.Doc]\nproblemToHint problem =\n  case problem of\n    T.IntFloat ->\n      [ D.fancyLink \"Note\" [\"Read\"] \"implicit-casts\"\n          [\"to\",\"learn\",\"why\",\"Elm\",\"does\",\"not\",\"implicitly\",\"convert\"\n          ,\"Ints\",\"to\",\"Floats.\",\"Use\",D.green \"toFloat\",\"and\"\n          ,D.green \"round\",\"to\",\"do\",\"explicit\",\"conversions.\"\n          ]\n      ]\n\n    T.StringFromInt ->\n      [ D.toFancyHint\n          [\"Want\",\"to\",\"convert\",\"an\",\"Int\",\"into\",\"a\",\"String?\"\n          ,\"Use\",\"the\",D.green \"String.fromInt\",\"function!\"\n          ]\n      ]\n\n    T.StringFromFloat ->\n      [ D.toFancyHint\n          [\"Want\",\"to\",\"convert\",\"a\",\"Float\",\"into\",\"a\",\"String?\"\n          ,\"Use\",\"the\",D.green \"String.fromFloat\",\"function!\"\n          ]\n      ]\n\n    T.StringToInt ->\n      [ D.toFancyHint\n          [\"Want\",\"to\",\"convert\",\"a\",\"String\",\"into\",\"an\",\"Int?\"\n          ,\"Use\",\"the\",D.green \"String.toInt\",\"function!\"\n          ]\n      ]\n\n    T.StringToFloat ->\n      [ D.toFancyHint\n          [\"Want\",\"to\",\"convert\",\"a\",\"String\",\"into\",\"a\",\"Float?\"\n          ,\"Use\",\"the\",D.green \"String.toFloat\",\"function!\"\n          ]\n      ]\n\n    T.AnythingToBool ->\n      [ D.toSimpleHint $\n          \"Elm does not have “truthiness” such that ints and strings and lists\\\n          \\ are automatically converted to booleans. Do that conversion explicitly!\"\n      ]\n\n    T.AnythingFromMaybe ->\n      [ D.toFancyHint\n          [\"Use\",D.green \"Maybe.withDefault\",\"to\",\"handle\",\"possible\",\"errors.\"\n          ,\"Longer\",\"term,\",\"it\",\"is\",\"usually\",\"better\",\"to\",\"write\",\"out\",\"the\"\n          ,\"full\",\"`case`\",\"though!\"\n          ]\n      ]\n\n    T.ArityMismatch x y ->\n      [ D.toSimpleHint $\n          if x < y then\n            \"It looks like it takes too few arguments. I was expecting \" ++ show (y - x) ++ \" more.\"\n          else\n            \"It looks like it takes too many arguments. I see \" ++ show (x - y) ++ \" extra.\"\n      ]\n\n    T.BadFlexSuper direction super _ tipe ->\n      case tipe of\n        T.Lambda _ _ _   -> badFlexSuper direction super tipe\n        T.Infinite       -> []\n        T.Error          -> []\n        T.FlexVar _      -> []\n        T.FlexSuper s _  -> badFlexFlexSuper super s\n        T.RigidVar y     -> badRigidVar y (toASuperThing super)\n        T.RigidSuper s _ -> badRigidSuper s (toASuperThing super)\n        T.Type _ _ _     -> badFlexSuper direction super tipe\n        T.Record _ _     -> badFlexSuper direction super tipe\n        T.Unit           -> badFlexSuper direction super tipe\n        T.Tuple _ _ _    -> badFlexSuper direction super tipe\n        T.Alias _ _ _ _  -> badFlexSuper direction super tipe\n\n    T.BadRigidVar x tipe ->\n      case tipe of\n        T.Lambda _ _ _   -> badRigidVar x \"a function\"\n        T.Infinite       -> []\n        T.Error          -> []\n        T.FlexVar _      -> []\n        T.FlexSuper s _  -> badRigidVar x (toASuperThing s)\n        T.RigidVar y     -> badDoubleRigid x y\n        T.RigidSuper _ y -> badDoubleRigid x y\n        T.Type _ n _     -> badRigidVar x (\"a `\" ++ Name.toChars n ++ \"` value\")\n        T.Record _ _     -> badRigidVar x \"a record\"\n        T.Unit           -> badRigidVar x \"a unit value\"\n        T.Tuple _ _ _    -> badRigidVar x \"a tuple\"\n        T.Alias _ n _ _  -> badRigidVar x (\"a `\" ++ Name.toChars n ++ \"` value\")\n\n    T.BadRigidSuper super x tipe ->\n      case tipe of\n        T.Lambda _ _ _   -> badRigidSuper super \"a function\"\n        T.Infinite       -> []\n        T.Error          -> []\n        T.FlexVar _      -> []\n        T.FlexSuper s _  -> badRigidSuper super (toASuperThing s)\n        T.RigidVar y     -> badDoubleRigid x y\n        T.RigidSuper _ y -> badDoubleRigid x y\n        T.Type _ n _     -> badRigidSuper super (\"a `\" ++ Name.toChars n ++ \"` value\")\n        T.Record _ _     -> badRigidSuper super \"a record\"\n        T.Unit           -> badRigidSuper super \"a unit value\"\n        T.Tuple _ _ _    -> badRigidSuper super \"a tuple\"\n        T.Alias _ n _ _  -> badRigidSuper super (\"a `\" ++ Name.toChars n ++ \"` value\")\n\n    T.FieldsMissing fields ->\n      case map (D.green . D.fromName) fields of\n        [] ->\n          []\n\n        [f1] ->\n          [ D.toFancyHint [\"Looks\",\"like\",\"the\",f1,\"field\",\"is\",\"missing.\"]\n          ]\n\n        fieldDocs ->\n          [ D.toFancyHint $\n              [\"Looks\",\"like\",\"fields\"] ++ D.commaSep \"and\" id fieldDocs ++ [\"are\",\"missing.\"]\n          ]\n\n\n    T.FieldTypo typo possibilities ->\n      case Suggest.sort (Name.toChars typo) Name.toChars possibilities of\n        [] ->\n          []\n\n        nearest:_ ->\n          [ D.toFancyHint $\n              [\"Seems\",\"like\",\"a\",\"record\",\"field\",\"typo.\",\"Maybe\"\n              ,D.dullyellow (D.fromName typo),\"should\",\"be\"\n              ,D.green (D.fromName nearest) <> \"?\"\n              ]\n          , D.toSimpleHint\n              \"Can more type annotations be added? Type annotations always help me give\\\n              \\ more specific messages, and I think they could help a lot in this case!\"\n          ]\n\n\n\n-- BAD RIGID HINTS\n\n\nbadRigidVar :: Name.Name -> String -> [D.Doc]\nbadRigidVar name aThing =\n  [ D.toSimpleHint $\n      \"Your type annotation uses type variable `\" ++ Name.toChars name ++\n      \"` which means ANY type of value can flow through, but your code is saying it specifically wants \"\n      ++ aThing ++ \". Maybe change your type annotation to\\\n      \\ be more specific? Maybe change the code to be more general?\"\n  , D.reflowLink \"Read\" \"type-annotations\" \"for more advice!\"\n  ]\n\n\nbadDoubleRigid :: Name.Name -> Name.Name -> [D.Doc]\nbadDoubleRigid x y =\n  [ D.toSimpleHint $\n      \"Your type annotation uses `\" ++ Name.toChars x ++ \"` and `\" ++ Name.toChars y ++\n      \"` as separate type variables. Your code seems to be saying they are the\\\n      \\ same though. Maybe they should be the same in your type annotation?\\\n      \\ Maybe your code uses them in a weird way?\"\n  , D.reflowLink \"Read\" \"type-annotations\" \"for more advice!\"\n  ]\n\n\ntoASuperThing :: T.Super -> String\ntoASuperThing super =\n  case super of\n    T.Number     -> \"a `number` value\"\n    T.Comparable -> \"a `comparable` value\"\n    T.CompAppend -> \"a `compappend` value\"\n    T.Appendable -> \"an `appendable` value\"\n\n\n\n-- BAD SUPER HINTS\n\n\nbadFlexSuper :: T.Direction -> T.Super -> T.Type -> [D.Doc]\nbadFlexSuper direction super tipe =\n  case super of\n    T.Comparable ->\n      case tipe of\n        T.Record _ _ ->\n          [ D.link \"Hint\"\n              \"I do not know how to compare records. I can only compare ints, floats,\\\n              \\ chars, strings, lists of comparable values, and tuples of comparable values.\\\n              \\ Check out\" \"comparing-records\" \"for ideas on how to proceed.\"\n          ]\n\n        T.Type _ name _ ->\n          [ D.toSimpleHint $\n              \"I do not know how to compare `\" ++ Name.toChars name ++ \"` values. I can only\\\n              \\ compare ints, floats, chars, strings, lists of comparable values, and tuples\\\n              \\ of comparable values.\"\n          , D.reflowLink\n              \"Check out\" \"comparing-custom-types\" \"for ideas on how to proceed.\"\n          ]\n\n        _ ->\n          [ D.toSimpleHint $\n              \"I only know how to compare ints, floats, chars, strings, lists of\\\n              \\ comparable values, and tuples of comparable values.\"\n          ]\n\n    T.Appendable ->\n      [ D.toSimpleHint \"I only know how to append strings and lists.\"\n      ]\n\n    T.CompAppend ->\n      [ D.toSimpleHint \"Only strings and lists are both comparable and appendable.\"\n      ]\n\n    T.Number ->\n      case tipe of\n        T.Type home name _ | T.isString home name ->\n          case direction of\n            T.Have ->\n              [ D.toFancyHint [\"Try\",\"using\",D.green \"String.fromInt\",\"to\",\"convert\",\"it\",\"to\",\"a\",\"string?\"]\n              ]\n\n            T.Need ->\n              [ D.toFancyHint [\"Try\",\"using\",D.green \"String.toInt\",\"to\",\"convert\",\"it\",\"to\",\"an\",\"integer?\"]\n              ]\n\n        _ ->\n          [ D.toFancyHint [\"Only\",D.green \"Int\",\"and\",D.green \"Float\",\"values\",\"work\",\"as\",\"numbers.\"]\n          ]\n\n\nbadRigidSuper :: T.Super -> String -> [D.Doc]\nbadRigidSuper super aThing =\n  let\n    (superType, manyThings) =\n      case super of\n        T.Number -> (\"number\", \"ints AND floats\")\n        T.Comparable -> (\"comparable\", \"ints, floats, chars, strings, lists, and tuples\")\n        T.Appendable -> (\"appendable\", \"strings AND lists\")\n        T.CompAppend -> (\"compappend\", \"strings AND lists\")\n  in\n  [ D.toSimpleHint $\n      \"The `\" ++ superType ++ \"` in your type annotation is saying that \"\n      ++ manyThings ++ \" can flow through, but your code is saying it specifically wants \"\n      ++ aThing ++ \". Maybe change your type annotation to\\\n      \\ be more specific? Maybe change the code to be more general?\"\n  , D.reflowLink \"Read\" \"type-annotations\" \"for more advice!\"\n  ]\n\n\nbadFlexFlexSuper :: T.Super -> T.Super -> [D.Doc]\nbadFlexFlexSuper s1 s2 =\n  let\n    likeThis super =\n      case super of\n        T.Number -> \"a number\"\n        T.Comparable -> \"comparable\"\n        T.CompAppend -> \"a compappend\"\n        T.Appendable -> \"appendable\"\n  in\n    [ D.toSimpleHint $\n        \"There are no values in Elm that are both \"\n        ++ likeThis s1 ++ \" and \" ++ likeThis s2 ++ \".\"\n    ]\n\n\n\n-- TO EXPR REPORT\n\n\ntoExprReport :: Code.Source -> L.Localizer -> A.Region -> Category -> T.Type -> Expected T.Type -> Report.Report\ntoExprReport source localizer exprRegion category tipe expected =\n  case expected of\n    NoExpectation expectedType ->\n      Report.Report \"TYPE MISMATCH\" exprRegion [] $\n        Code.toSnippet source exprRegion Nothing\n          ( \"This expression is being used in an unexpected way:\"\n          , typeComparison localizer tipe expectedType\n              (addCategory \"It is\" category)\n              \"But you are trying to use it as:\"\n              []\n          )\n\n    FromAnnotation name _arity subContext expectedType ->\n      let\n        thing =\n          case subContext of\n            TypedIfBranch index   -> D.ordinal index <> \" branch of this `if` expression:\"\n            TypedCaseBranch index -> D.ordinal index <> \" branch of this `case` expression:\"\n            TypedBody             -> \"body of the `\" <> Name.toChars name <> \"` definition:\"\n\n        itIs =\n          case subContext of\n            TypedIfBranch index   -> \"The \" <> D.ordinal index <> \" branch is\"\n            TypedCaseBranch index -> \"The \" <> D.ordinal index <> \" branch is\"\n            TypedBody             -> \"The body is\"\n      in\n      Report.Report \"TYPE MISMATCH\" exprRegion [] $\n        Code.toSnippet source exprRegion Nothing $\n          ( D.reflow (\"Something is off with the \" <> thing)\n          , typeComparison localizer tipe expectedType\n              (addCategory itIs category)\n              (\"But the type annotation on `\" <> Name.toChars name <> \"` says it should be:\")\n              []\n          )\n\n    FromContext region context expectedType ->\n      let\n        mismatch (maybeHighlight, problem, thisIs, insteadOf, furtherDetails) =\n          Report.Report \"TYPE MISMATCH\" exprRegion [] $\n            Code.toSnippet source region maybeHighlight\n              ( D.reflow problem\n              , typeComparison localizer tipe expectedType (addCategory thisIs category) insteadOf furtherDetails\n              )\n\n        badType (maybeHighlight, problem, thisIs, furtherDetails) =\n          Report.Report \"TYPE MISMATCH\" exprRegion [] $\n            Code.toSnippet source region maybeHighlight\n              ( D.reflow problem\n              , loneType localizer tipe expectedType (D.reflow (addCategory thisIs category)) furtherDetails\n              )\n\n        custom maybeHighlight docPair =\n          Report.Report \"TYPE MISMATCH\" exprRegion [] $\n            Code.toSnippet source region maybeHighlight docPair\n      in\n      case context of\n        ListEntry index ->\n          let ith = D.ordinal index in\n          mismatch\n          ( Just exprRegion\n          , \"The \" <> ith <> \" element of this list does not match all the previous elements:\"\n          , \"The \" <> ith <> \" element is\"\n          , \"But all the previous elements in the list are:\"\n          , [ D.link \"Hint\"\n                \"Everything in a list must be the same type of value. This way, we never\\\n                \\ run into unexpected values partway through a List.map, List.foldl, etc. Read\"\n                \"custom-types\"\n                \"to learn how to “mix” types.\"\n            ]\n          )\n\n        Negate ->\n          badType\n          ( Just exprRegion\n          , \"I do not know how to negate this type of value:\"\n          , \"It is\"\n          , [ D.fillSep\n                [\"But\",\"I\",\"only\",\"now\",\"how\",\"to\",\"negate\"\n                ,D.dullyellow \"Int\",\"and\",D.dullyellow \"Float\",\"values.\"\n                ]\n            ]\n          )\n\n        OpLeft op ->\n          custom (Just exprRegion) $\n            opLeftToDocs localizer category op tipe expectedType\n\n        OpRight op ->\n          case opRightToDocs localizer category op tipe expectedType of\n            EmphBoth details ->\n              custom Nothing details\n\n            EmphRight details ->\n              custom (Just exprRegion) details\n\n        IfCondition ->\n          badType\n          ( Just exprRegion\n          , \"This `if` condition does not evaluate to a boolean value, True or False.\"\n          , \"It is\"\n          , [ D.fillSep [\"But\",\"I\",\"need\",\"this\",\"`if`\",\"condition\",\"to\",\"be\",\"a\",D.dullyellow \"Bool\",\"value.\"]\n            ]\n          )\n\n        IfBranch index ->\n          let ith = D.ordinal index in\n          mismatch\n          ( Just exprRegion\n          , \"The \" <> ith <> \" branch of this `if` does not match all the previous branches:\"\n          , \"The \" <> ith <> \" branch is\"\n          , \"But all the previous branches result in:\"\n          , [ D.link \"Hint\"\n                \"All branches in an `if` must produce the same type of values. This way, no\\\n                \\ matter which branch we take, the result is always a consistent shape. Read\"\n                \"custom-types\"\n                \"to learn how to “mix” types.\"\n            ]\n          )\n\n        CaseBranch index ->\n          let ith = D.ordinal index in\n          mismatch\n          ( Just exprRegion\n          , \"The \" <> ith <> \" branch of this `case` does not match all the previous branches:\"\n          , \"The \" <> ith <> \" branch is\"\n          , \"But all the previous branches result in:\"\n          , [ D.link \"Hint\"\n                \"All branches in a `case` must produce the same type of values. This way, no\\\n                \\ matter which branch we take, the result is always a consistent shape. Read\"\n                \"custom-types\"\n                \"to learn how to “mix” types.\"\n            ]\n          )\n\n        CallArity maybeFuncName numGivenArgs ->\n          Report.Report \"TOO MANY ARGS\" exprRegion [] $\n          Code.toSnippet source region (Just exprRegion) $\n          case countArgs tipe of\n            0 ->\n              let\n                thisValue =\n                  case maybeFuncName of\n                    NoName        -> \"This value\"\n                    FuncName name -> \"The `\" <> Name.toChars name <> \"` value\"\n                    CtorName name -> \"The `\" <> Name.toChars name <> \"` value\"\n                    OpName op     -> \"The (\" <> Name.toChars op <> \") operator\"\n              in\n              ( D.reflow $ thisValue <> \" is not a function, but it was given \" <> D.args numGivenArgs <> \".\"\n              , D.reflow $ \"Are there any missing commas? Or missing parentheses?\"\n              )\n\n            n ->\n              let\n                thisFunction =\n                  case maybeFuncName of\n                    NoName        -> \"This function\"\n                    FuncName name -> \"The `\" <> Name.toChars name <> \"` function\"\n                    CtorName name -> \"The `\" <> Name.toChars name <> \"` constructor\"\n                    OpName op     -> \"The (\" <> Name.toChars op <> \") operator\"\n              in\n              ( D.reflow $ thisFunction <> \" expects \" <> D.args n <> \", but it got \" <> show numGivenArgs <> \" instead.\"\n              , D.reflow $ \"Are there any missing commas? Or missing parentheses?\"\n              )\n\n        CallArg maybeFuncName index ->\n          let\n            ith = D.ordinal index\n\n            thisFunction =\n              case maybeFuncName of\n                NoName        -> \"this function\"\n                FuncName name -> \"`\" <> Name.toChars name <> \"`\"\n                CtorName name -> \"`\" <> Name.toChars name <> \"`\"\n                OpName op     -> \"(\" <> Name.toChars op <> \")\"\n          in\n          mismatch\n          ( Just exprRegion\n          , \"The \" <> ith <> \" argument to \" <> thisFunction <> \" is not what I expect:\"\n          , \"This argument is\"\n          , \"But \" <> thisFunction <> \" needs the \" <> ith <> \" argument to be:\"\n          ,\n            if Index.toHuman index == 1 then\n              []\n            else\n              [ D.toSimpleHint $\n                 \"I always figure out the argument types from left to right. If an argument\\\n                  \\ is acceptable, I assume it is “correct” and move on. So the problem may\\\n                  \\ actually be in one of the previous arguments!\"\n              ]\n          )\n\n        RecordAccess recordRegion maybeName fieldRegion field ->\n          case T.iteratedDealias tipe of\n            T.Record fields ext ->\n              custom (Just fieldRegion)\n                ( D.reflow $\n                    \"This \"\n                    <> maybe \"\" (\\n -> \"`\" <> Name.toChars n <> \"`\") maybeName\n                    <> \" record does not have a `\" <> Name.toChars field <> \"` field:\"\n                , case Suggest.sort (Name.toChars field) (Name.toChars . fst) (Map.toList fields) of\n                    [] ->\n                      D.reflow \"In fact, it is a record with NO fields!\"\n\n                    f:fs ->\n                      D.stack\n                        [ D.reflow $\n                            \"This is usually a typo. Here are the \"\n                            <> maybe \"\" (\\n -> \"`\" <> Name.toChars n <> \"`\") maybeName\n                            <> \" fields that are most similar:\"\n                        , toNearbyRecord localizer f fs ext\n                        , D.fillSep\n                            [\"So\",\"maybe\",D.dullyellow (D.fromName field)\n                            ,\"should\",\"be\",D.green (D.fromName (fst f)) <> \"?\"\n                            ]\n                        ]\n                )\n\n            _ ->\n              badType\n              ( Just recordRegion\n              , \"This is not a record, so it has no fields to access!\"\n              , \"It is\"\n              , [ D.fillSep\n                    [\"But\",\"I\",\"need\",\"a\",\"record\",\"with\",\"a\"\n                    ,D.dullyellow (D.fromName field),\"field!\"\n                    ]\n                ]\n              )\n\n        RecordUpdateKeys record expectedFields ->\n          case T.iteratedDealias tipe of\n            T.Record actualFields ext ->\n              case Map.lookupMin (Map.difference expectedFields actualFields) of\n                Nothing ->\n                  mismatch\n                  ( Nothing\n                  , \"Something is off with this record update:\"\n                  , \"The `\" <> Name.toChars record <> \"` record is\"\n                  , \"But this update needs it to be compatable with:\"\n                  , [ D.reflow\n                        \"Do you mind creating an <http://sscce.org/> that produces this error message and\\\n                        \\ sharing it at <https://github.com/elm/error-message-catalog/issues> so we\\\n                        \\ can try to give better advice here?\"\n                    ]\n                  )\n\n                Just (field, Can.FieldUpdate fieldRegion _) ->\n                  let\n                    rStr = \"`\" <> Name.toChars record <> \"`\"\n                    fStr = \"`\" <> Name.toChars field <> \"`\"\n                  in\n                  custom (Just fieldRegion)\n                    ( D.reflow $\n                        \"The \" <> rStr <> \" record does not have a \" <> fStr <> \" field:\"\n                    , case Suggest.sort (Name.toChars field) (Name.toChars . fst) (Map.toList actualFields) of\n                        [] ->\n                          D.reflow $ \"In fact, \" <> rStr <> \" is a record with NO fields!\"\n\n                        f:fs ->\n                          D.stack\n                            [ D.reflow $\n                                \"This is usually a typo. Here are the \" <> rStr <> \" fields that are most similar:\"\n                            , toNearbyRecord localizer f fs ext\n                            , D.fillSep\n                                [\"So\",\"maybe\",D.dullyellow (D.fromName field)\n                                ,\"should\",\"be\",D.green (D.fromName (fst f)) <> \"?\"\n                                ]\n                            ]\n                    )\n\n            _ ->\n              badType\n              ( Just exprRegion\n              , \"This is not a record, so it has no fields to update!\"\n              , \"It is\"\n              , [ D.reflow $ \"But I need a record!\"\n                ]\n              )\n\n        RecordUpdateValue field ->\n          mismatch\n          ( Just exprRegion\n          , \"I cannot update the `\" <> Name.toChars field <> \"` field like this:\"\n          , \"You are trying to update `\" <> Name.toChars field <> \"` to be\"\n          , \"But it should be:\"\n          , [ D.toSimpleNote\n                \"The record update syntax does not allow you to change the type of fields.\\\n                \\ You can achieve that with record constructors or the record literal syntax.\"\n            ]\n          )\n\n        Destructure ->\n          mismatch\n          ( Nothing\n          , \"This definition is causing issues:\"\n          , \"You are defining\"\n          , \"But then trying to destructure it as:\"\n          , []\n          )\n\n\n\n-- HELPERS\n\n\ncountArgs :: T.Type -> Int\ncountArgs tipe =\n  case tipe of\n    T.Lambda _ _ stuff ->\n      1 + length stuff\n\n    _ ->\n      0\n\n\n\n-- FIELD NAME HELPERS\n\n\ntoNearbyRecord :: L.Localizer -> (Name.Name, T.Type) -> [(Name.Name, T.Type)] -> T.Extension -> D.Doc\ntoNearbyRecord localizer f fs ext =\n  D.indent 4 $\n    if length fs <= 3 then\n      RT.vrecord (map (fieldToDocs localizer) (f:fs)) (extToDoc ext)\n    else\n      RT.vrecordSnippet (fieldToDocs localizer f) (map (fieldToDocs localizer) (take 3 fs))\n\n\nfieldToDocs :: L.Localizer -> (Name.Name, T.Type) -> (D.Doc, D.Doc)\nfieldToDocs localizer (name, tipe) =\n  ( D.fromName name\n  , T.toDoc localizer RT.None tipe\n  )\n\n\nextToDoc :: T.Extension -> Maybe D.Doc\nextToDoc ext =\n  case ext of\n    T.Closed      -> Nothing\n    T.FlexOpen  x -> Just (D.fromName x)\n    T.RigidOpen x -> Just (D.fromName x)\n\n\n\n-- OP LEFT\n\n\nopLeftToDocs :: L.Localizer -> Category -> Name.Name -> T.Type -> T.Type -> (D.Doc, D.Doc)\nopLeftToDocs localizer category op tipe expected =\n  case op of\n    \"+\"\n      | isString tipe -> badStringAdd\n      | isList tipe   -> badListAdd localizer category \"left\" tipe expected\n      | otherwise     -> badMath localizer category \"Addition\" \"left\" \"+\" tipe expected []\n\n    \"*\"\n      | isList tipe  -> badListMul localizer category \"left\" tipe expected\n      | otherwise    -> badMath localizer category \"Multiplication\" \"left\" \"*\" tipe expected []\n\n    \"-\"  -> badMath localizer category \"Subtraction\" \"left\" \"-\" tipe expected []\n    \"^\"  -> badMath localizer category \"Exponentiation\" \"left\" \"^\" tipe expected []\n    \"/\"  -> badFDiv localizer \"left\" tipe expected\n    \"//\" -> badIDiv localizer \"left\" tipe expected\n    \"&&\" -> badBool localizer \"&&\" \"left\" tipe expected\n    \"||\" -> badBool localizer \"||\" \"left\" tipe expected\n    \"<\"  -> badCompLeft localizer category \"<\" \"left\" tipe expected\n    \">\"  -> badCompLeft localizer category \">\" \"left\" tipe expected\n    \"<=\" -> badCompLeft localizer category \"<=\" \"left\" tipe expected\n    \">=\" -> badCompLeft localizer category \">=\" \"left\" tipe expected\n\n    \"++\" -> badAppendLeft localizer category tipe expected\n\n    \"<|\" ->\n      ( \"The left side of (<|) needs to be a function so I can pipe arguments to it!\"\n      , loneType localizer tipe expected\n          (D.reflow (addCategory \"I am seeing\" category))\n          [ D.reflow $ \"This needs to be some kind of function though!\"\n          ]\n      )\n\n    _ ->\n      ( D.reflow $\n          \"The left argument of (\" <> Name.toChars op <> \") is causing problems:\"\n      , typeComparison localizer tipe expected\n          (addCategory \"The left argument is\" category)\n          (\"But (\" <> Name.toChars op <> \") needs the left argument to be:\")\n          []\n      )\n\n\n\n-- OP RIGHT\n\n\ndata RightDocs\n  = EmphBoth (D.Doc, D.Doc)\n  | EmphRight (D.Doc, D.Doc)\n\n\nopRightToDocs :: L.Localizer -> Category -> Name.Name -> T.Type -> T.Type -> RightDocs\nopRightToDocs localizer category op tipe expected =\n  case op of\n    \"+\"\n      | isFloat expected && isInt tipe -> badCast op FloatInt\n      | isInt expected && isFloat tipe -> badCast op IntFloat\n      | isString tipe -> EmphRight $ badStringAdd\n      | isList tipe   -> EmphRight $ badListAdd localizer category \"right\" tipe expected\n      | otherwise     -> EmphRight $ badMath localizer category \"Addition\" \"right\" \"+\" tipe expected []\n\n    \"*\"\n      | isFloat expected && isInt tipe -> badCast op FloatInt\n      | isInt expected && isFloat tipe -> badCast op IntFloat\n      | isList tipe -> EmphRight $ badListMul localizer category \"right\" tipe expected\n      | otherwise   -> EmphRight $ badMath localizer category \"Multiplication\" \"right\" \"*\" tipe expected []\n\n    \"-\"\n      | isFloat expected && isInt tipe -> badCast op FloatInt\n      | isInt expected && isFloat tipe -> badCast op IntFloat\n      | otherwise ->\n          EmphRight $ badMath localizer category \"Subtraction\" \"right\" \"-\" tipe expected []\n\n    \"^\"\n      | isFloat expected && isInt tipe -> badCast op FloatInt\n      | isInt expected && isFloat tipe -> badCast op IntFloat\n      | otherwise ->\n          EmphRight $ badMath localizer category \"Exponentiation\" \"right\" \"^\" tipe expected []\n\n    \"/\"  -> EmphRight $ badFDiv localizer \"right\" tipe expected\n    \"//\" -> EmphRight $ badIDiv localizer \"right\" tipe expected\n    \"&&\" -> EmphRight $ badBool localizer \"&&\" \"right\" tipe expected\n    \"||\" -> EmphRight $ badBool localizer \"||\" \"right\" tipe expected\n    \"<\"  -> badCompRight localizer \"<\" tipe expected\n    \">\"  -> badCompRight localizer \">\" tipe expected\n    \"<=\" -> badCompRight localizer \"<=\" tipe expected\n    \">=\" -> badCompRight localizer \">=\" tipe expected\n    \"==\" -> badEquality localizer \"==\" tipe expected\n    \"/=\" -> badEquality localizer \"/=\" tipe expected\n\n    \"::\" -> badConsRight localizer category tipe expected\n    \"++\" -> badAppendRight localizer category tipe expected\n\n    \"<|\" ->\n      EmphRight\n        ( D.reflow $ \"I cannot send this through the (<|) pipe:\"\n        , typeComparison localizer tipe expected\n            \"The argument is:\"\n            \"But (<|) is piping it to a function that expects:\"\n            []\n        )\n\n    \"|>\" ->\n      case (tipe, expected) of\n        (T.Lambda expectedArgType _ _, T.Lambda argType _ _) ->\n          EmphRight\n            ( D.reflow $ \"This function cannot handle the argument sent through the (|>) pipe:\"\n            , typeComparison localizer argType expectedArgType\n                \"The argument is:\"\n                \"But (|>) is piping it to a function that expects:\"\n                []\n            )\n\n        _ ->\n          EmphRight\n            ( D.reflow $ \"The right side of (|>) needs to be a function so I can pipe arguments to it!\"\n            , loneType localizer tipe expected\n                (D.reflow (addCategory \"But instead of a function, I am seeing\" category))\n                []\n            )\n\n    _ ->\n      badOpRightFallback localizer category op tipe expected\n\n\nbadOpRightFallback :: L.Localizer -> Category -> Name.Name -> T.Type -> T.Type -> RightDocs\nbadOpRightFallback localizer category op tipe expected =\n  EmphRight\n    ( D.reflow $\n        \"The right argument of (\" <> Name.toChars op <> \") is causing problems.\"\n    , typeComparison localizer tipe expected\n        (addCategory \"The right argument is\" category)\n        (\"But (\" <> Name.toChars op <> \") needs the right argument to be:\")\n        [ D.toSimpleHint $\n            \"With operators like (\" ++ Name.toChars op ++ \") I always check the left\\\n            \\ side first. If it seems fine, I assume it is correct and check the right\\\n            \\ side. So the problem may be in how the left and right arguments interact!\"\n        ]\n    )\n\n\nisInt :: T.Type -> Bool\nisInt tipe =\n  case tipe of\n    T.Type home name [] ->\n      T.isInt home name\n\n    _ ->\n      False\n\n\nisFloat :: T.Type -> Bool\nisFloat tipe =\n  case tipe of\n    T.Type home name [] ->\n      T.isFloat home name\n\n    _ ->\n      False\n\n\nisString :: T.Type -> Bool\nisString tipe =\n  case tipe of\n    T.Type home name [] ->\n      T.isString home name\n\n    _ ->\n      False\n\n\nisList :: T.Type -> Bool\nisList tipe =\n  case tipe of\n    T.Type home name [_] ->\n      T.isList home name\n\n    _ ->\n      False\n\n\n\n-- BAD CONS\n\n\nbadConsRight :: L.Localizer -> Category -> T.Type -> T.Type -> RightDocs\nbadConsRight localizer category tipe expected =\n  case tipe of\n    T.Type home1 name1 [actualElement] | T.isList home1 name1 ->\n      case expected of\n        T.Type home2 name2 [expectedElement] | T.isList home2 name2 ->\n          EmphBoth\n            ( D.reflow \"I am having trouble with this (::) operator:\"\n            , typeComparison localizer expectedElement actualElement\n                \"The left side of (::) is:\"\n                \"But you are trying to put that into a list filled with:\"\n                ( case expectedElement of\n                    T.Type home name [_] | T.isList home name ->\n                      [ D.toSimpleHint\n                          \"Are you trying to append two lists? The (++) operator\\\n                          \\ appends lists, whereas the (::) operator is only for\\\n                          \\ adding ONE element to a list.\"\n                      ]\n\n                    _ ->\n                      [ D.reflow\n                          \"Lists need ALL elements to be the same type though.\"\n                      ]\n                )\n            )\n\n        _ ->\n          badOpRightFallback localizer category \"::\" tipe expected\n\n    _ ->\n      EmphRight\n        ( D.reflow \"The (::) operator can only add elements onto lists.\"\n        , loneType localizer tipe expected\n            (D.reflow (addCategory \"The right side is\" category))\n            [D.fillSep [\"But\",\"(::)\",\"needs\",\"a\",D.dullyellow \"List\",\"on\",\"the\",\"right.\"]\n            ]\n        )\n\n\n\n-- BAD APPEND\n\n\ndata AppendType\n  = ANumber D.Doc D.Doc\n  | AString\n  | AList\n  | AOther\n\n\ntoAppendType :: T.Type -> AppendType\ntoAppendType tipe =\n  case tipe of\n    T.Type home name _\n      | T.isInt    home name -> ANumber \"Int\" \"String.fromInt\"\n      | T.isFloat  home name -> ANumber \"Float\" \"String.fromFloat\"\n      | T.isString home name -> AString\n      | T.isList   home name -> AList\n\n    T.FlexSuper T.Number _ -> ANumber \"number\" \"String.fromInt\"\n\n    _ -> AOther\n\n\nbadAppendLeft :: L.Localizer -> Category -> T.Type -> T.Type -> (D.Doc, D.Doc)\nbadAppendLeft localizer category tipe expected =\n  case toAppendType tipe of\n    ANumber thing stringFromThing ->\n      ( D.fillSep\n          [\"The\",\"(++)\",\"operator\",\"can\",\"append\",\"List\",\"and\",\"String\"\n          ,\"values,\",\"but\",\"not\",D.dullyellow thing,\"values\",\"like\",\"this:\"\n          ]\n      , D.fillSep\n          [\"Try\",\"using\",D.green stringFromThing,\"to\",\"turn\",\"it\",\"into\",\"a\",\"string?\"\n          ,\"Or\",\"put\",\"it\",\"in\",\"[]\",\"to\",\"make\",\"it\",\"a\",\"list?\"\n          ,\"Or\",\"switch\",\"to\",\"the\",\"(::)\",\"operator?\"\n          ]\n      )\n\n    _ ->\n      ( D.reflow $\n          \"The (++) operator cannot append this type of value:\"\n      , loneType localizer tipe expected\n          (D.reflow (addCategory \"I am seeing\" category))\n          [ D.fillSep\n              [\"But\",\"the\",\"(++)\",\"operator\",\"is\",\"only\",\"for\",\"appending\"\n              ,D.dullyellow \"List\",\"and\",D.dullyellow \"String\",\"values.\"\n              ,\"Maybe\",\"put\",\"this\",\"value\",\"in\",\"[]\",\"to\",\"make\",\"it\",\"a\",\"list?\"\n              ]\n          ]\n      )\n\n\nbadAppendRight :: L.Localizer -> Category -> T.Type -> T.Type -> RightDocs\nbadAppendRight localizer category tipe expected =\n  case (toAppendType expected, toAppendType tipe) of\n    (AString, ANumber thing stringFromThing) ->\n      EmphRight\n        ( D.fillSep\n            [\"I\",\"thought\",\"I\",\"was\",\"appending\",D.dullyellow \"String\",\"values\",\"here,\"\n            ,\"not\",D.dullyellow thing,\"values\",\"like\",\"this:\"\n            ]\n        , D.fillSep\n            [\"Try\",\"using\",D.green stringFromThing,\"to\",\"turn\",\"it\",\"into\",\"a\",\"string?\"]\n        )\n\n    (AList, ANumber thing _) ->\n      EmphRight\n        ( D.fillSep\n            [\"I\",\"thought\",\"I\",\"was\",\"appending\",D.dullyellow \"List\",\"values\",\"here,\"\n            ,\"not\",D.dullyellow thing,\"values\",\"like\",\"this:\"\n            ]\n        , D.reflow \"Try putting it in [] to make it a list?\"\n        )\n\n    (AString, AList) ->\n      EmphBoth\n        ( D.reflow $\n            \"The (++) operator needs the same type of value on both sides:\"\n        , D.fillSep\n            [\"I\",\"see\",\"a\",D.dullyellow \"String\",\"on\",\"the\",\"left\",\"and\",\"a\"\n            ,D.dullyellow \"List\",\"on\",\"the\",\"right.\",\"Which\",\"should\",\"it\",\"be?\"\n            ,\"Does\",\"the\",\"string\",\"need\",\"[]\",\"around\",\"it\",\"to\",\"become\",\"a\",\"list?\"\n            ]\n        )\n\n    (AList, AString) ->\n      EmphBoth\n        ( D.reflow $\n            \"The (++) operator needs the same type of value on both sides:\"\n        , D.fillSep\n            [\"I\",\"see\",\"a\",D.dullyellow \"List\",\"on\",\"the\",\"left\",\"and\",\"a\"\n            ,D.dullyellow \"String\",\"on\",\"the\",\"right.\",\"Which\",\"should\",\"it\",\"be?\"\n            ,\"Does\",\"the\",\"string\",\"need\",\"[]\",\"around\",\"it\",\"to\",\"become\",\"a\",\"list?\"\n            ]\n        )\n\n    (_,_) ->\n      EmphBoth\n        ( D.reflow $\n            \"The (++) operator cannot append these two values:\"\n        , typeComparison localizer expected tipe\n            \"I already figured out that the left side of (++) is:\"\n            (addCategory \"But this clashes with the right side, which is\" category)\n            []\n        )\n\n\n\n-- BAD MATH\n\n\ndata ThisThenThat = FloatInt | IntFloat\n\n\nbadCast :: Name.Name -> ThisThenThat -> RightDocs\nbadCast op thisThenThat =\n  EmphBoth\n    ( D.reflow $\n        \"I need both sides of (\" <> Name.toChars op <> \") to be the exact same type. Both Int or both Float.\"\n    , let\n        anInt = [\"an\", D.dullyellow \"Int\"]\n        aFloat = [\"a\", D.dullyellow \"Float\"]\n        toFloat = D.green \"toFloat\"\n        round = D.green \"round\"\n      in\n      case thisThenThat of\n        FloatInt ->\n          badCastHelp aFloat anInt round toFloat\n\n        IntFloat ->\n          badCastHelp anInt aFloat toFloat round\n    )\n\n\nbadCastHelp :: [D.Doc] -> [D.Doc] -> D.Doc -> D.Doc -> D.Doc\nbadCastHelp anInt aFloat toFloat round =\n  D.stack\n    [ D.fillSep $\n        [\"But\",\"I\",\"see\"]\n        ++ anInt\n        ++ [\"on\",\"the\",\"left\",\"and\"]\n        ++ aFloat\n        ++ [\"on\",\"the\",\"right.\"]\n    , D.fillSep\n        [\"Use\",toFloat,\"on\",\"the\",\"left\",\"(or\",round,\"on\"\n        ,\"the\",\"right)\",\"to\",\"make\",\"both\",\"sides\",\"match!\"\n        ]\n    , D.link \"Note\" \"Read\" \"implicit-casts\" \"to learn why Elm does not implicitly convert Ints to Floats.\"\n    ]\n\n\nbadStringAdd :: (D.Doc, D.Doc)\nbadStringAdd =\n  (\n    D.fillSep [\"I\",\"cannot\",\"do\",\"addition\",\"with\",D.dullyellow \"String\",\"values\",\"like\",\"this\",\"one:\"]\n  ,\n    D.stack\n      [ D.fillSep\n          [\"The\",\"(+)\",\"operator\",\"only\",\"works\",\"with\",D.dullyellow \"Int\",\"and\",D.dullyellow \"Float\",\"values.\"\n          ]\n      , D.toFancyHint\n          [\"Switch\",\"to\",\"the\",D.green \"(++)\",\"operator\",\"to\",\"append\",\"strings!\"\n          ]\n      ]\n  )\n\n\nbadListAdd :: L.Localizer -> Category -> String -> T.Type -> T.Type -> (D.Doc, D.Doc)\nbadListAdd localizer category direction tipe expected =\n  (\n    \"I cannot do addition with lists:\"\n  ,\n    loneType localizer tipe expected\n      (D.reflow (addCategory (\"The \" <> direction <> \" side of (+) is\") category))\n      [ D.fillSep\n          [\"But\",\"(+)\",\"only\",\"works\",\"with\",D.dullyellow \"Int\",\"and\",D.dullyellow \"Float\",\"values.\"\n          ]\n      , D.toFancyHint\n          [\"Switch\",\"to\",\"the\",D.green \"(++)\",\"operator\",\"to\",\"append\",\"lists!\"\n          ]\n      ]\n  )\n\n\nbadListMul :: L.Localizer -> Category -> String -> T.Type -> T.Type -> (D.Doc, D.Doc)\nbadListMul localizer category direction tipe expected =\n  badMath localizer category \"Multiplication\" direction \"*\" tipe expected\n    [\n      D.toFancyHint\n        [ \"Maybe\", \"you\", \"want\"\n        , D.green \"List.repeat\"\n        , \"to\", \"build\",\"a\",\"list\",\"of\",\"repeated\",\"values?\"\n        ]\n    ]\n\n\nbadMath :: L.Localizer -> Category -> String -> String -> String -> T.Type -> T.Type -> [D.Doc] -> (D.Doc, D.Doc)\nbadMath localizer category operation direction op tipe expected otherHints =\n  (\n    D.reflow $\n      operation ++ \" does not work with this value:\"\n  ,\n    loneType localizer tipe expected\n      (D.reflow (addCategory (\"The \" <> direction <> \" side of (\" <> op <> \") is\") category))\n      ( [ D.fillSep\n            [\"But\",\"(\" <> D.fromChars op <> \")\",\"only\",\"works\",\"with\"\n            ,D.dullyellow \"Int\",\"and\",D.dullyellow \"Float\",\"values.\"\n            ]\n        ]\n        ++ otherHints\n      )\n  )\n\n\nbadFDiv :: L.Localizer -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc)\nbadFDiv localizer direction tipe expected =\n  (\n    D.reflow $\n      \"The (/) operator is specifically for floating-point division:\"\n  ,\n    if isInt tipe then\n      D.stack\n        [ D.fillSep\n            [\"The\",direction,\"side\",\"of\",\"(/)\",\"must\",\"be\",\"a\"\n            ,D.dullyellow \"Float\" <> \",\"\n            ,\"but\",\"I\",\"am\",\"seeing\",\"an\",D.dullyellow \"Int\" <> \".\"\n            ,\"I\",\"recommend:\"\n            ]\n        , D.vcat\n            [ D.green \"toFloat\" <> \" for explicit conversions     \" <> D.black \"(toFloat 5 / 2) == 2.5\"\n            , D.green \"(//)   \" <> \" for integer division         \" <> D.black \"(5 // 2)        == 2\"\n            ]\n        , D.link \"Note\" \"Read\" \"implicit-casts\" \"to learn why Elm does not implicitly convert Ints to Floats.\"\n        ]\n\n    else\n      loneType localizer tipe expected\n        (D.fillSep\n          [\"The\",direction,\"side\",\"of\",\"(/)\",\"must\",\"be\",\"a\"\n          ,D.dullyellow \"Float\" <> \",\",\"but\",\"instead\",\"I\",\"am\",\"seeing:\"\n          ]\n        )\n        []\n  )\n\n\nbadIDiv :: L.Localizer -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc)\nbadIDiv localizer direction tipe expected =\n  (\n    D.reflow $\n      \"The (//) operator is specifically for integer division:\"\n  ,\n    if isFloat tipe then\n      D.stack\n        [ D.fillSep\n            [\"The\",direction,\"side\",\"of\",\"(//)\",\"must\",\"be\",\"an\"\n            ,D.dullyellow \"Int\" <> \",\"\n            ,\"but\",\"I\",\"am\",\"seeing\",\"a\",D.dullyellow \"Float\" <> \".\"\n            ,\"I\",\"recommend\",\"doing\",\"the\",\"conversion\",\"explicitly\"\n            ,\"with\",\"one\",\"of\",\"these\",\"functions:\"\n            ]\n        , D.vcat\n            [ D.green \"round\" <> \" 3.5     == 4\"\n            , D.green \"floor\" <> \" 3.5     == 3\"\n            , D.green \"ceiling\" <> \" 3.5   == 4\"\n            , D.green \"truncate\" <> \" 3.5  == 3\"\n            ]\n        , D.link \"Note\" \"Read\" \"implicit-casts\" \"to learn why Elm does not implicitly convert Ints to Floats.\"\n        ]\n    else\n      loneType localizer tipe expected\n        ( D.fillSep\n            [\"The\",direction,\"side\",\"of\",\"(//)\",\"must\",\"be\",\"an\"\n            ,D.dullyellow \"Int\" <> \",\",\"but\",\"instead\",\"I\",\"am\",\"seeing:\"\n            ]\n        )\n        []\n  )\n\n\n\n-- BAD BOOLS\n\n\nbadBool :: L.Localizer -> D.Doc -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc)\nbadBool localizer op direction tipe expected =\n  (\n    D.reflow $\n      \"I am struggling with this boolean operation:\"\n  ,\n    loneType localizer tipe expected\n      ( D.fillSep\n          [\"Both\",\"sides\",\"of\",\"(\" <> op <> \")\",\"must\",\"be\"\n          ,D.dullyellow \"Bool\",\"values,\",\"but\",\"the\",direction,\"side\",\"is:\"\n          ]\n      )\n      []\n  )\n\n\n\n-- BAD COMPARISON\n\n\nbadCompLeft :: L.Localizer -> Category -> String -> String -> T.Type -> T.Type -> (D.Doc, D.Doc)\nbadCompLeft localizer category op direction tipe expected =\n  (\n    D.reflow $\n      \"I cannot do a comparison with this value:\"\n  ,\n    loneType localizer tipe expected\n      (D.reflow (addCategory (\"The \" <> direction <> \" side of (\" <> op <> \") is\") category))\n      [ D.fillSep\n          [\"But\",\"(\" <> D.fromChars op <> \")\",\"only\",\"works\",\"on\"\n          ,D.dullyellow \"Int\" <> \",\"\n          ,D.dullyellow \"Float\" <> \",\"\n          ,D.dullyellow \"Char\" <> \",\"\n          ,\"and\"\n          ,D.dullyellow \"String\"\n          ,\"values.\",\"It\",\"can\",\"work\",\"on\",\"lists\",\"and\",\"tuples\"\n          ,\"of\",\"comparable\",\"values\",\"as\",\"well,\",\"but\",\"it\",\"is\"\n          ,\"usually\",\"better\",\"to\",\"find\",\"a\",\"different\",\"path.\"\n          ]\n      ]\n  )\n\n\nbadCompRight :: L.Localizer -> String -> T.Type -> T.Type -> RightDocs\nbadCompRight localizer op tipe expected =\n  EmphBoth\n    (\n      D.reflow $\n        \"I need both sides of (\" <> op <> \") to be the same type:\"\n    ,\n      typeComparison localizer expected tipe\n        (\"The left side of (\" <> op <> \") is:\")\n        \"But the right side is:\"\n        [ D.reflow $\n            \"I cannot compare different types though! Which side of (\" <> op <> \") is the problem?\"\n        ]\n    )\n\n\n\n-- BAD EQUALITY\n\n\nbadEquality :: L.Localizer -> String -> T.Type -> T.Type -> RightDocs\nbadEquality localizer op tipe expected =\n  EmphBoth\n    (\n      D.reflow $\n        \"I need both sides of (\" <> op <> \") to be the same type:\"\n    ,\n      typeComparison localizer expected tipe\n        (\"The left side of (\" <> op <> \") is:\")\n        \"But the right side is:\"\n        [ if isFloat tipe || isFloat expected then\n            D.toSimpleNote $\n              \"Equality on floats is not 100% reliable due to the design of IEEE 754. I\\\n              \\ recommend a check like (abs (x - y) < 0.0001) instead.\"\n          else\n            D.reflow  \"Different types can never be equal though! Which side is messed up?\"\n        ]\n    )\n\n\n\n-- INFINITE TYPES\n\n\ntoInfiniteReport :: Code.Source -> L.Localizer -> A.Region -> Name.Name -> T.Type -> Report.Report\ntoInfiniteReport source localizer region name overallType =\n  Report.Report \"INFINITE TYPE\" region [] $\n    Code.toSnippet source region Nothing\n      (\n        D.reflow $\n          \"I am inferring a weird self-referential type for \" <> Name.toChars name <> \":\"\n      ,\n        D.stack\n          [ D.reflow $\n              \"Here is my best effort at writing down the type. You will see ∞ for\\\n              \\ parts of the type that repeat something already printed out infinitely.\"\n          , D.indent 4 (D.dullyellow (T.toDoc localizer RT.None overallType))\n          , D.reflowLink\n              \"Staring at this type is usually not so helpful, so I recommend reading the hints at\"\n              \"infinite-type\"\n              \"to get unstuck!\"\n          ]\n      )\n"
  },
  {
    "path": "compiler/src/Reporting/Error.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Error\n  ( Module(..)\n  , Error(..)\n  , toDoc\n  , toJson\n  )\n  where\n\n\nimport qualified Data.ByteString as B\nimport qualified Data.NonEmptyList as NE\nimport qualified Data.OneOrMore as OneOrMore\nimport qualified System.FilePath as FP\n\nimport qualified Elm.ModuleName as ModuleName\nimport qualified File\nimport qualified Json.Encode as E\nimport Json.Encode ((==>))\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Error.Canonicalize as Canonicalize\nimport qualified Reporting.Error.Docs as Docs\nimport qualified Reporting.Error.Import as Import\nimport qualified Reporting.Error.Main as Main\nimport qualified Reporting.Error.Pattern as Pattern\nimport qualified Reporting.Error.Syntax as Syntax\nimport qualified Reporting.Error.Type as Type\nimport qualified Reporting.Render.Code as Code\nimport qualified Reporting.Render.Type.Localizer as L\nimport qualified Reporting.Report as Report\n\n\n\n-- MODULE\n\n\ndata Module =\n  Module\n    { _name :: ModuleName.Raw\n    , _absolutePath :: FilePath\n    , _modificationTime :: File.Time\n    , _source :: B.ByteString\n    , _error :: Error\n    }\n\n\n\n-- ERRORS\n\n\ndata Error\n  = BadSyntax Syntax.Error\n  | BadImports (NE.List Import.Error)\n  | BadNames (OneOrMore.OneOrMore Canonicalize.Error)\n  | BadTypes L.Localizer (NE.List Type.Error)\n  | BadMains L.Localizer (OneOrMore.OneOrMore Main.Error)\n  | BadPatterns (NE.List Pattern.Error)\n  | BadDocs Docs.Error\n\n\n\n-- TO REPORT\n\n\ntoReports :: Code.Source -> Error -> NE.List Report.Report\ntoReports source err =\n  case err of\n    BadSyntax syntaxError ->\n      NE.List (Syntax.toReport source syntaxError) []\n\n    BadImports errs ->\n      fmap (Import.toReport source) errs\n\n    BadNames errs ->\n      fmap (Canonicalize.toReport source) (OneOrMore.destruct NE.List errs)\n\n    BadTypes localizer errs ->\n      fmap (Type.toReport source localizer) errs\n\n    BadMains localizer errs ->\n      fmap (Main.toReport localizer source) (OneOrMore.destruct NE.List errs)\n\n    BadPatterns errs ->\n      fmap (Pattern.toReport source) errs\n\n    BadDocs docsErr ->\n      Docs.toReports source docsErr\n\n\n\n-- TO DOC\n\n\ntoDoc :: FilePath -> Module -> [Module] -> D.Doc\ntoDoc root err errs =\n  let\n    (NE.List m ms) = NE.sortBy _modificationTime (NE.List err errs)\n  in\n  D.vcat (toDocHelp root m ms)\n\n\ntoDocHelp :: FilePath -> Module -> [Module] -> [D.Doc]\ntoDocHelp root module1 modules =\n  case modules of\n    [] ->\n      [moduleToDoc root module1\n      ,\"\"\n      ]\n\n    module2 : otherModules ->\n      moduleToDoc root module1\n      : toSeparator module1 module2\n      : toDocHelp root module2 otherModules\n\n\ntoSeparator :: Module -> Module -> D.Doc\ntoSeparator beforeModule afterModule =\n  let\n    before = ModuleName.toChars (_name beforeModule) ++ \"  ↑    \"\n    after  = \"    ↓  \" ++  ModuleName.toChars (_name afterModule)\n  in\n    D.dullred $ D.vcat $\n      [ D.indent (80 - length before) (D.fromChars before)\n      , \"====o======================================================================o====\"\n      , D.fromChars after\n      , \"\"\n      , \"\"\n      ]\n\n\n\n-- MODULE TO DOC\n\n\nmoduleToDoc :: FilePath -> Module -> D.Doc\nmoduleToDoc root (Module _ absolutePath _ source err) =\n  let\n    reports =\n      toReports (Code.toSource source) err\n\n    relativePath =\n      FP.makeRelative root absolutePath\n  in\n  D.vcat $ map (reportToDoc relativePath) (NE.toList reports)\n\n\nreportToDoc :: FilePath -> Report.Report -> D.Doc\nreportToDoc relativePath (Report.Report title _ _ message) =\n  D.vcat\n    [ toMessageBar title relativePath\n    , \"\"\n    , message\n    , \"\"\n    ]\n\n\ntoMessageBar :: String -> FilePath -> D.Doc\ntoMessageBar title filePath =\n  let\n    usedSpace =\n      4 + length title + 1 + length filePath\n  in\n    D.dullcyan $ D.fromChars $\n      \"-- \" ++ title\n      ++ \" \" ++ replicate (max 1 (80 - usedSpace)) '-'\n      ++ \" \" ++ filePath\n\n\n\n-- TO JSON\n\n\ntoJson :: Module -> E.Value\ntoJson (Module name path _ source err) =\n  let\n    reports =\n      toReports (Code.toSource source) err\n  in\n  E.object\n    [ \"path\" ==> E.chars path\n    , \"name\" ==> E.name name\n    , \"problems\" ==> E.array (map reportToJson (NE.toList reports))\n    ]\n\n\nreportToJson :: Report.Report -> E.Value\nreportToJson (Report.Report title region _sgstns message) =\n  E.object\n    [ \"title\" ==> E.chars title\n    , \"region\" ==> encodeRegion region\n    , \"message\" ==> D.encode message\n    ]\n\n\nencodeRegion :: A.Region -> E.Value\nencodeRegion (A.Region (A.Position sr sc) (A.Position er ec)) =\n  E.object\n    [ \"start\" ==>\n          E.object\n            [ \"line\" ==> E.int (fromIntegral sr)\n            , \"column\" ==> E.int (fromIntegral sc)\n            ]\n    , \"end\" ==>\n          E.object\n            [ \"line\" ==> E.int (fromIntegral er)\n            , \"column\" ==> E.int (fromIntegral ec)\n            ]\n    ]\n"
  },
  {
    "path": "compiler/src/Reporting/Render/Code.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Render.Code\n  ( Source\n  , toSource\n  , toSnippet\n  , toPair\n  , Next(..)\n  , whatIsNext\n  , nextLineStartsWithKeyword\n  , nextLineStartsWithCloseCurly\n  )\n  where\n\n\nimport qualified Data.ByteString as B\nimport qualified Data.ByteString.UTF8 as UTF8_BS\nimport qualified Data.Char as Char\nimport qualified Data.IntSet as IntSet\nimport qualified Data.List as List\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\nimport Data.Word (Word16)\n\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport Reporting.Doc (Doc)\nimport Parse.Primitives (Row, Col)\nimport Parse.Symbol (binopCharSet)\nimport Parse.Variable (reservedWords)\n\n\n\n-- CODE\n\n\nnewtype Source =\n  Source [(Word16, String)]\n\n\ntoSource :: B.ByteString -> Source\ntoSource source =\n  Source $ zip [1..] $\n    lines (UTF8_BS.toString source) ++ [\"\"]\n\n\n\n-- CODE FORMATTING\n\n\ntoSnippet :: Source -> A.Region -> Maybe A.Region -> (D.Doc, D.Doc) -> D.Doc\ntoSnippet source region highlight (preHint, postHint) =\n  D.vcat\n    [ preHint\n    , \"\"\n    , render source region highlight\n    , postHint\n    ]\n\n\ntoPair :: Source -> A.Region -> A.Region -> (D.Doc, D.Doc) -> (D.Doc, D.Doc, D.Doc) -> D.Doc\ntoPair source r1 r2 (oneStart, oneEnd) (twoStart, twoMiddle, twoEnd) =\n  case renderPair source r1 r2 of\n    OneLine codeDocs ->\n      D.vcat\n        [ oneStart\n        , \"\"\n        , codeDocs\n        , oneEnd\n        ]\n\n    TwoChunks code1 code2 ->\n      D.vcat\n        [ twoStart\n        , \"\"\n        , code1\n        , twoMiddle\n        , \"\"\n        , code2\n        , twoEnd\n        ]\n\n\n\n-- RENDER SNIPPET\n\n\n(|>) :: a -> (a -> b) -> b\n(|>) a f =\n  f a\n\n\nrender :: Source -> A.Region -> Maybe A.Region -> Doc\nrender (Source sourceLines) region@(A.Region (A.Position startLine _) (A.Position endLine _)) maybeSubRegion =\n  let\n    relevantLines =\n      sourceLines\n        |> drop (fromIntegral (startLine - 1))\n        |> take (fromIntegral (1 + endLine - startLine))\n\n    width =\n      length (show (fst (last relevantLines)))\n\n    smallerRegion =\n      maybe region id maybeSubRegion\n  in\n    case makeUnderline width endLine smallerRegion of\n      Nothing ->\n        drawLines True width smallerRegion relevantLines D.empty\n\n      Just underline ->\n        drawLines False width smallerRegion relevantLines underline\n\n\nmakeUnderline :: Int -> Word16 -> A.Region -> Maybe Doc\nmakeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end c2)) =\n  if start /= end || end < realEndLine then\n    Nothing\n\n  else\n    let\n      spaces = replicate (fromIntegral c1 + width + 1) ' '\n      zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'\n    in\n      Just (D.fromChars spaces <> D.red (D.fromChars zigzag))\n\n\ndrawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc\ndrawLines addZigZag width (A.Region (A.Position startLine _) (A.Position endLine _)) sourceLines finalLine =\n  D.vcat $\n    map (drawLine addZigZag width startLine endLine) sourceLines\n    ++ [finalLine]\n\n\ndrawLine :: Bool -> Int -> Word16 -> Word16 -> (Word16, String) -> Doc\ndrawLine addZigZag width startLine endLine (n, line) =\n  addLineNumber addZigZag width startLine endLine n (D.fromChars line)\n\n\naddLineNumber :: Bool -> Int -> Word16 -> Word16 -> Word16 -> Doc -> Doc\naddLineNumber addZigZag width start end n line =\n  let\n    number =\n      show n\n\n    lineNumber =\n      replicate (width - length number) ' ' ++ number ++ \"|\"\n\n    spacer =\n      if addZigZag && start <= n && n <= end then\n        D.red \">\"\n      else\n        \" \"\n  in\n    D.fromChars lineNumber <> spacer <> line\n\n\n\n-- RENDER PAIR\n\n\ndata CodePair\n  = OneLine Doc\n  | TwoChunks Doc Doc\n\n\nrenderPair :: Source -> A.Region -> A.Region -> CodePair\nrenderPair source@(Source sourceLines) region1 region2 =\n  let\n    (A.Region (A.Position startRow1 startCol1) (A.Position endRow1 endCol1)) = region1\n    (A.Region (A.Position startRow2 startCol2) (A.Position endRow2 endCol2)) = region2\n  in\n  if startRow1 == endRow1 && endRow1 == startRow2 && startRow2 == endRow2 then\n    let\n      lineNumber = show startRow1\n      spaces1 = replicate (fromIntegral startCol1 + length lineNumber + 1) ' '\n      zigzag1 = replicate (fromIntegral (endCol1 - startCol1)) '^'\n      spaces2 = replicate (fromIntegral (startCol2 - endCol1)) ' '\n      zigzag2 = replicate (fromIntegral (endCol2 - startCol2)) '^'\n\n      (Just line) = List.lookup startRow1 sourceLines\n    in\n    OneLine $\n      D.vcat\n        [ D.fromChars lineNumber <> \"| \" <> D.fromChars line\n        , D.fromChars spaces1 <> D.red (D.fromChars zigzag1) <>\n          D.fromChars spaces2 <> D.red (D.fromChars zigzag2)\n        ]\n\n  else\n    TwoChunks\n      (render source region1 Nothing)\n      (render source region2 Nothing)\n\n\n\n-- WHAT IS NEXT?\n\n\ndata Next\n  = Keyword [Char]\n  | Operator [Char]\n  | Close [Char] Char\n  | Upper Char [Char]\n  | Lower Char [Char]\n  | Other (Maybe Char)\n\n\nwhatIsNext :: Source -> Row -> Col -> Next\nwhatIsNext (Source sourceLines) row col =\n  case List.lookup row sourceLines of\n    Nothing ->\n      Other Nothing\n\n    Just line ->\n      case drop (fromIntegral col - 1) line of\n        [] ->\n          Other Nothing\n\n        c:cs\n          | Char.isUpper c -> Upper c (takeWhile isInner cs)\n          | Char.isLower c -> detectKeywords c cs\n          | isSymbol c     -> Operator (c : takeWhile isSymbol cs)\n          | c == ')'       -> Close \"parenthesis\" ')'\n          | c == ']'       -> Close \"square bracket\" ']'\n          | c == '}'       -> Close \"curly brace\" '}'\n          | otherwise      -> Other (Just c)\n\n\ndetectKeywords :: Char -> [Char] -> Next\ndetectKeywords c rest =\n  let\n    cs = takeWhile isInner rest\n    name = c : cs\n  in\n  if Set.member (Name.fromChars name) reservedWords\n  then Keyword name\n  else Lower c name\n\n\nisInner :: Char -> Bool\nisInner char =\n  Char.isAlphaNum char || char == '_'\n\n\nisSymbol :: Char -> Bool\nisSymbol char =\n  IntSet.member (Char.ord char) binopCharSet\n\n\nstartsWithKeyword :: [Char] -> [Char] -> Bool\nstartsWithKeyword restOfLine keyword =\n  List.isPrefixOf keyword restOfLine\n  &&\n  case drop (length keyword) restOfLine of\n    [] ->\n      True\n\n    c:_ ->\n      not (isInner c)\n\n\nnextLineStartsWithKeyword :: [Char] -> Source -> Row -> Maybe (Row, Col)\nnextLineStartsWithKeyword keyword (Source sourceLines) row =\n  case List.lookup (row + 1) sourceLines of\n    Nothing ->\n      Nothing\n\n    Just line ->\n      if startsWithKeyword (dropWhile (==' ') line) keyword then\n        Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))\n      else\n        Nothing\n\n\nnextLineStartsWithCloseCurly :: Source -> Row -> Maybe (Row, Col)\nnextLineStartsWithCloseCurly (Source sourceLines) row =\n  case List.lookup (row + 1) sourceLines of\n    Nothing ->\n      Nothing\n\n    Just line ->\n      case dropWhile (==' ') line of\n        '}':_ ->\n          Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))\n\n        _ ->\n          Nothing\n"
  },
  {
    "path": "compiler/src/Reporting/Render/Type/Localizer.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Render.Type.Localizer\n  ( Localizer\n  , toDoc\n  , toChars\n  , empty\n  , fromNames\n  , fromModule\n  )\n  where\n\n\nimport qualified Data.Map as Map\nimport qualified Data.Name as Name\nimport qualified Data.Set as Set\n\nimport qualified AST.Source as Src\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Annotation as A\n\n\n\n-- LOCALIZER\n\n\nnewtype Localizer =\n  Localizer (Map.Map Name.Name Import)\n\n\ndata Import =\n  Import\n    { _alias :: Maybe Name.Name\n    , _exposing :: Exposing\n    }\n\n\ndata Exposing\n  = All\n  | Only (Set.Set Name.Name)\n\n\nempty :: Localizer\nempty =\n  Localizer Map.empty\n\n\n\n-- LOCALIZE\n\n\ntoDoc :: Localizer -> ModuleName.Canonical -> Name.Name -> D.Doc\ntoDoc localizer home name =\n  D.fromChars (toChars localizer home name)\n\n\ntoChars :: Localizer -> ModuleName.Canonical -> Name.Name -> String\ntoChars (Localizer localizer) moduleName@(ModuleName.Canonical _ home) name =\n  case Map.lookup home localizer of\n    Nothing ->\n      Name.toChars home <> \".\" <> Name.toChars name\n\n    Just (Import alias exposing) ->\n      case exposing of\n        All ->\n          Name.toChars name\n\n        Only set ->\n          if Set.member name set then\n            Name.toChars name\n          else if name == Name.list && moduleName == ModuleName.list then\n            \"List\"\n          else\n            Name.toChars (maybe home id alias) <> \".\" <> Name.toChars name\n\n\n\n-- FROM NAMES\n\n\nfromNames :: Map.Map Name.Name a -> Localizer\nfromNames names =\n  Localizer $ Map.map (\\_ -> Import Nothing All) names\n\n\n\n-- FROM MODULE\n\n\nfromModule :: Src.Module -> Localizer\nfromModule modul@(Src.Module _ _ _ imports _ _ _ _ _) =\n  Localizer $ Map.fromList $\n    (Src.getName modul, Import Nothing All) : map toPair imports\n\n\ntoPair :: Src.Import -> (Name.Name, Import)\ntoPair (Src.Import (A.At _ name) alias exposing) =\n  ( name\n  , Import alias (toExposing exposing)\n  )\n\n\ntoExposing :: Src.Exposing -> Exposing\ntoExposing exposing =\n  case exposing of\n    Src.Open ->\n      All\n\n    Src.Explicit exposedList ->\n      Only (foldr addType Set.empty exposedList)\n\n\naddType :: Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name\naddType exposed types =\n  case exposed of\n    Src.Lower _               -> types\n    Src.Upper (A.At _ name) _ -> Set.insert name types\n    Src.Operator _ _          -> types\n"
  },
  {
    "path": "compiler/src/Reporting/Render/Type.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Render.Type\n  ( Context(..)\n  , lambda\n  , apply\n  , tuple\n  , record\n  , vrecordSnippet\n  , vrecord\n  , srcToDoc\n  , canToDoc\n  )\n  where\n\n\nimport qualified Data.Maybe as Maybe\nimport qualified Data.Name as Name\n\nimport qualified AST.Source as Src\nimport qualified AST.Canonical as Can\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport Reporting.Doc (Doc, (<+>))\nimport qualified Reporting.Render.Type.Localizer as L\n\n\n\n-- TO DOC\n\n\ndata Context\n  = None\n  | Func\n  | App\n\n\nlambda :: Context -> Doc -> Doc -> [Doc] -> Doc\nlambda context arg1 arg2 args =\n  let\n    lambdaDoc =\n      D.align $ D.sep (arg1 : map (\"->\" <+>) (arg2:args))\n  in\n  case context of\n    None -> lambdaDoc\n    Func -> D.cat [ \"(\", lambdaDoc, \")\" ]\n    App  -> D.cat [ \"(\", lambdaDoc, \")\" ]\n\n\napply :: Context -> Doc -> [Doc] -> Doc\napply context name args =\n  case args of\n    [] ->\n      name\n\n    _:_ ->\n      let\n        applyDoc =\n          D.hang 4 (D.sep (name : args))\n      in\n      case context of\n        App  -> D.cat [ \"(\", applyDoc, \")\" ]\n        Func -> applyDoc\n        None -> applyDoc\n\n\ntuple :: Doc -> Doc -> [Doc] -> Doc\ntuple a b cs =\n  let\n    entries =\n      zipWith (<+>) (\"(\" : repeat \",\") (a:b:cs)\n  in\n  D.align $ D.sep [ D.cat entries, \")\" ]\n\n\nrecord :: [(Doc, Doc)] -> Maybe Doc -> Doc\nrecord entries maybeExt =\n  case (map entryToDoc entries, maybeExt) of\n    ([], Nothing) ->\n        \"{}\"\n\n    (fields, Nothing) ->\n        D.align $ D.sep $\n          [ D.cat (zipWith (<+>) (\"{\" : repeat \",\") fields)\n          , \"}\"\n          ]\n\n    (fields, Just ext) ->\n        D.align $ D.sep $\n          [ D.hang 4 $ D.sep $\n              [ \"{\" <+> ext\n              , D.cat (zipWith (<+>) (\"|\" : repeat \",\") fields)\n              ]\n          , \"}\"\n          ]\n\n\nentryToDoc :: (Doc, Doc) -> Doc\nentryToDoc (fieldName, fieldType) =\n  D.hang 4 (D.sep [ fieldName <+> \":\", fieldType ])\n\n\nvrecordSnippet :: (Doc, Doc) -> [(Doc, Doc)] -> Doc\nvrecordSnippet entry entries =\n  let\n    field  = \"{\" <+> entryToDoc entry\n    fields = zipWith (<+>) (repeat \",\") (map entryToDoc entries ++ [\"...\"])\n  in\n  D.vcat (field : fields ++ [\"}\"])\n\n\nvrecord :: [(Doc, Doc)] -> Maybe Doc -> Doc\nvrecord entries maybeExt =\n  case (map entryToDoc entries, maybeExt) of\n    ([], Nothing) ->\n      \"{}\"\n\n    (fields, Nothing) ->\n      D.vcat $\n        zipWith (<+>) (\"{\" : repeat \",\") fields ++ [\"}\"]\n\n    (fields, Just ext) ->\n      D.vcat\n        [ D.hang 4 $ D.vcat $\n            [ \"{\" <+> ext\n            , D.cat (zipWith (<+>) (\"|\" : repeat \",\") fields)\n            ]\n        , \"}\"\n        ]\n\n\n\n-- SOURCE TYPE TO DOC\n\n\nsrcToDoc :: Context -> Src.Type -> Doc\nsrcToDoc context (A.At _ tipe) =\n  case tipe of\n    Src.TLambda arg1 result ->\n      let\n        (arg2, rest) = collectSrcArgs result\n      in\n      lambda context\n        (srcToDoc Func arg1)\n        (srcToDoc Func arg2)\n        (map (srcToDoc Func) rest)\n\n    Src.TVar name ->\n      D.fromName name\n\n    Src.TType _ name args ->\n      apply context\n        (D.fromName name)\n        (map (srcToDoc App) args)\n\n    Src.TTypeQual _ home name args ->\n      apply context\n        (D.fromName home <> \".\" <> D.fromName name)\n        (map (srcToDoc App) args)\n\n    Src.TRecord fields ext ->\n      record\n        (map srcFieldToDocs fields)\n        (fmap (D.fromName . A.toValue) ext)\n\n    Src.TUnit ->\n      \"()\"\n\n    Src.TTuple a b cs ->\n      tuple\n        (srcToDoc None a)\n        (srcToDoc None b)\n        (map (srcToDoc None) cs)\n\n\nsrcFieldToDocs :: (A.Located Name.Name, Src.Type) -> (Doc, Doc)\nsrcFieldToDocs (A.At _ fieldName, fieldType) =\n  ( D.fromName fieldName\n  , srcToDoc None fieldType\n  )\n\n\ncollectSrcArgs :: Src.Type -> (Src.Type, [Src.Type])\ncollectSrcArgs tipe =\n  case tipe of\n    A.At _ (Src.TLambda a result) ->\n      let\n        (b, cs) = collectSrcArgs result\n      in\n      (a, b:cs)\n\n    _ ->\n      (tipe, [])\n\n\n\n-- CANONICAL TYPE TO DOC\n\n\ncanToDoc :: L.Localizer -> Context -> Can.Type -> Doc\ncanToDoc localizer context tipe =\n  case tipe of\n    Can.TLambda arg1 result ->\n      let\n        (arg2, rest) = collectArgs result\n      in\n      lambda context\n        (canToDoc localizer Func arg1)\n        (canToDoc localizer Func arg2)\n        (map (canToDoc localizer Func) rest)\n\n    Can.TVar name ->\n      D.fromName name\n\n    Can.TType home name args ->\n      apply context\n        (L.toDoc localizer home name)\n        (map (canToDoc localizer App) args)\n\n    Can.TRecord fields ext ->\n      record\n        (map (canFieldToDoc localizer) (Can.fieldsToList fields))\n        (fmap D.fromName ext)\n\n    Can.TUnit ->\n      \"()\"\n\n    Can.TTuple a b maybeC ->\n      tuple\n        (canToDoc localizer None a)\n        (canToDoc localizer None b)\n        (map (canToDoc localizer None) (Maybe.maybeToList maybeC))\n\n    Can.TAlias home name args _ ->\n      apply context\n        (L.toDoc localizer home name)\n        (map (canToDoc localizer App . snd) args)\n\n\ncanFieldToDoc :: L.Localizer -> (Name.Name, Can.Type) -> (Doc, Doc)\ncanFieldToDoc localizer (name, tipe) =\n  ( D.fromName name\n  , canToDoc localizer None tipe\n  )\n\n\ncollectArgs :: Can.Type -> (Can.Type, [Can.Type])\ncollectArgs tipe =\n  case tipe of\n    Can.TLambda a rest ->\n      let\n        (b, cs) = collectArgs rest\n      in\n      (a, b:cs)\n\n    _ ->\n      (tipe, [])\n"
  },
  {
    "path": "compiler/src/Reporting/Report.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Report\n    ( Report(..)\n    )\n    where\n\n\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\n\n\n\n-- BUILD REPORTS\n\n\ndata Report =\n  Report\n    { _title :: String\n    , _region :: A.Region\n    , _sgstns :: [String]\n    , _message :: D.Doc\n    }\n"
  },
  {
    "path": "compiler/src/Reporting/Result.hs",
    "content": "{-# LANGUAGE Rank2Types #-}\nmodule Reporting.Result\n  ( Result(..)\n  , run\n  , ok\n  , warn\n  , throw\n  , mapError\n  )\n  where\n\n\nimport qualified Data.OneOrMore as OneOrMore\nimport qualified Reporting.Warning as Warning\n\n\n\n-- RESULT\n\n\nnewtype Result info warnings error a =\n  Result (\n    forall result.\n      info\n      -> warnings\n      -> (info -> warnings -> OneOrMore.OneOrMore error -> result)\n      -> (info -> warnings -> a -> result)\n      -> result\n  )\n\n\nrun :: Result () [w] e a -> ([w], Either (OneOrMore.OneOrMore e) a)\nrun (Result k) =\n  k () []\n    (\\() w e -> (reverse w, Left e))\n    (\\() w a -> (reverse w, Right a))\n\n\n\n-- HELPERS\n\n\nok :: a -> Result i w e a\nok a =\n  Result $ \\i w _ good ->\n    good i w a\n\n\nwarn :: Warning.Warning -> Result i [Warning.Warning] e ()\nwarn warning =\n  Result $ \\i warnings _ good ->\n    good i (warning:warnings) ()\n\n\nthrow :: e -> Result i w e a\nthrow e =\n  Result $ \\i w bad _ ->\n    bad i w (OneOrMore.one e)\n\n\nmapError :: (e -> e') -> Result i w e a -> Result i w e' a\nmapError func (Result k) =\n  Result $ \\i w bad good ->\n    let\n      bad1 i1 w1 e1 =\n        bad i1 w1 (OneOrMore.map func e1)\n    in\n    k i w bad1 good\n\n\n\n-- FANCY INSTANCE STUFF\n\n\ninstance Functor (Result i w e) where\n  fmap func (Result k) =\n    Result $ \\i w bad good ->\n      let\n        good1 i1 w1 value =\n          good i1 w1 (func value)\n      in\n      k i w bad good1\n\n\ninstance Applicative (Result i w e) where\n  pure = ok\n\n  (<*>) (Result kf) (Result kv) =\n    Result $ \\i w bad good ->\n      let\n        bad1 i1 w1 e1 =\n          let\n            bad2 i2 w2 e2 = bad i2 w2 (OneOrMore.more e1 e2)\n            good2 i2 w2 _value = bad i2 w2 e1\n          in\n          kv i1 w1 bad2 good2\n\n        good1 i1 w1 func =\n          let\n            bad2 i2 w2 e2 = bad i2 w2 e2\n            good2 i2 w2 value = good i2 w2 (func value)\n          in\n          kv i1 w1 bad2 good2\n      in\n      kf i w bad1 good1\n\n  (*>) (Result ka) (Result kb) =\n    Result $ \\i w bad good ->\n      let\n        good1 i1 w1 _ =\n          kb i1 w1 bad good\n      in\n      ka i w bad good1\n\n\ninstance Monad (Result i w e) where\n  (>>=) (Result ka) callback =\n    Result $ \\i w bad good ->\n      let\n        good1 i1 w1 a =\n          case callback a of\n            Result kb -> kb i1 w1 bad good\n      in\n      ka i w bad good1\n\n  -- PERF add INLINE to these?\n"
  },
  {
    "path": "compiler/src/Reporting/Suggest.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Suggest\n  ( distance\n  , sort\n  , rank\n  )\n  where\n\n\nimport qualified Data.Char as Char\nimport qualified Data.List as List\nimport qualified Text.EditDistance as Dist\n\n\n\n-- DISTANCE\n\n\ndistance :: String -> String -> Int\ndistance x y =\n  Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y\n\n\n\n-- SORT\n\n\nsort :: String -> (a -> String) -> [a] -> [a]\nsort target toString values =\n  List.sortOn (distance (toLower target) . toLower . toString) values\n\n\ntoLower :: String -> String\ntoLower string =\n  map Char.toLower string\n\n\n\n-- RANK\n\n\nrank :: String -> (a -> String) -> [a] -> [(Int,a)]\nrank target toString values =\n  let\n    toRank v =\n      distance (toLower target) (toLower (toString v))\n\n    addRank v =\n      (toRank v, v)\n  in\n  List.sortOn fst (map addRank values)\n"
  },
  {
    "path": "compiler/src/Reporting/Warning.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Reporting.Warning\n  ( Warning(..)\n  , Context(..)\n  , toReport\n  )\n  where\n\n\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Utils.Type as Type\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Report as Report\nimport qualified Reporting.Render.Code as Code\nimport qualified Reporting.Render.Type as RT\nimport qualified Reporting.Render.Type.Localizer as L\n\n\n\n-- ALL POSSIBLE WARNINGS\n\n\ndata Warning\n  = UnusedImport A.Region Name.Name\n  | UnusedVariable A.Region Context Name.Name\n  | MissingTypeAnnotation A.Region Name.Name Can.Type\n\n\ndata Context = Def | Pattern\n\n\n\n-- TO REPORT\n\n\ntoReport :: L.Localizer -> Code.Source -> Warning -> Report.Report\ntoReport localizer source warning =\n  case warning of\n    UnusedImport region moduleName ->\n      Report.Report \"unused import\" region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"Nothing from the `\" <> Name.toChars moduleName <> \"` module is used in this file.\"\n          ,\n            \"I recommend removing unused imports.\"\n          )\n\n    UnusedVariable region context name ->\n      let title = defOrPat context \"unused definition\" \"unused variable\" in\n      Report.Report title region [] $\n        Code.toSnippet source region Nothing\n          (\n            D.reflow $\n              \"You are not using `\" <> Name.toChars name <> \"` anywhere.\"\n          ,\n            D.stack\n              [ D.reflow $\n                  \"Is there a typo? Maybe you intended to use `\" <> Name.toChars name\n                  <> \"` somewhere but typed another name instead?\"\n              , D.reflow $\n                  defOrPat context\n                    ( \"If you are sure there is no typo, remove the definition.\\\n                      \\ This way future readers will not have to wonder why it is there!\"\n                    )\n                    ( \"If you are sure there is no typo, replace `\" <> Name.toChars name\n                      <> \"` with _ so future readers will not have to wonder why it is there!\"\n                    )\n              ]\n          )\n\n    MissingTypeAnnotation region name inferredType ->\n        Report.Report \"missing type annotation\" region [] $\n          Code.toSnippet source region Nothing\n            (\n              D.reflow $\n                case Type.deepDealias inferredType of\n                  Can.TLambda _ _ ->\n                    \"The `\" <> Name.toChars name <> \"` function has no type annotation.\"\n\n                  _ ->\n                    \"The `\" <> Name.toChars name <> \"` definition has no type annotation.\"\n            ,\n              D.stack\n                [ \"I inferred the type annotation myself though! You can copy it into your code:\"\n                , D.green $ D.hang 4 $ D.sep $\n                    [ D.fromName name <> \" :\"\n                    , RT.canToDoc localizer RT.None inferredType\n                    ]\n                ]\n            )\n\n\ndefOrPat :: Context -> a -> a -> a\ndefOrPat context def pat =\n  case context of\n    Def -> def\n    Pattern -> pat\n\n"
  },
  {
    "path": "compiler/src/Type/Constrain/Expression.hs",
    "content": "module Type.Constrain.Expression\n  ( constrain\n  , constrainDef\n  , constrainRecursiveDefs\n  )\n  where\n\n\nimport qualified Data.Map.Strict as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Utils.Shader as Shader\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Type as E\nimport Reporting.Error.Type (Expected(..), Context(..), SubContext(..), MaybeName(..), Category(..), PExpected(..), PContext(..))\nimport qualified Type.Constrain.Pattern as Pattern\nimport qualified Type.Instantiate as Instantiate\nimport Type.Type as Type hiding (Descriptor(..))\n\n\n\n-- CONSTRAIN\n\n\n-- As we step past type annotations, the free type variables are added to\n-- the \"rigid type variables\" dict. Allowing sharing of rigid variables\n-- between nested type annotations.\n--\n-- So if you have a top-level type annotation like (func : a -> b) the RTV\n-- dictionary will hold variables for `a` and `b`\n--\ntype RTV =\n  Map.Map Name.Name Type\n\n\nconstrain :: RTV -> Can.Expr -> Expected Type -> IO Constraint\nconstrain rtv (A.At region expression) expected =\n  case expression of\n    Can.VarLocal name ->\n      return (CLocal region name expected)\n\n    Can.VarTopLevel _ name ->\n      return (CLocal region name expected)\n\n    Can.VarKernel _ _ ->\n      return CTrue\n\n    Can.VarForeign _ name annotation ->\n      return $ CForeign region name annotation expected\n\n    Can.VarCtor _ _ name _ annotation ->\n      return $ CForeign region name annotation expected\n\n    Can.VarDebug _ name annotation ->\n      return $ CForeign region name annotation expected\n\n    Can.VarOperator op _ _ annotation ->\n      return $ CForeign region op annotation expected\n\n    Can.Str _ ->\n      return $ CEqual region String Type.string expected\n\n    Can.Chr _ ->\n      return $ CEqual region Char Type.char expected\n\n    Can.Int _ ->\n      do  var <- mkFlexNumber\n          return $ exists [var] $ CEqual region E.Number (VarN var) expected\n\n    Can.Float _ ->\n      return $ CEqual region Float Type.float expected\n\n    Can.List elements ->\n      constrainList rtv region elements expected\n\n    Can.Negate expr ->\n      do  numberVar <- mkFlexNumber\n          let numberType = VarN numberVar\n          numberCon <- constrain rtv expr (FromContext region Negate numberType)\n          let negateCon = CEqual region E.Number numberType expected\n          return $ exists [numberVar] $ CAnd [ numberCon, negateCon ]\n\n    Can.Binop op _ _ annotation leftExpr rightExpr ->\n      constrainBinop rtv region op annotation leftExpr rightExpr expected\n\n    Can.Lambda args body ->\n      constrainLambda rtv region args body expected\n\n    Can.Call func args ->\n      constrainCall rtv region func args expected\n\n    Can.If branches finally ->\n      constrainIf rtv region branches finally expected\n\n    Can.Case expr branches ->\n      constrainCase rtv region expr branches expected\n\n    Can.Let def body ->\n      constrainDef rtv def\n      =<< constrain rtv body expected\n\n    Can.LetRec defs body ->\n      constrainRecursiveDefs rtv defs\n      =<< constrain rtv body expected\n\n    Can.LetDestruct pattern expr body ->\n      constrainDestruct rtv region pattern expr\n      =<< constrain rtv body expected\n\n    Can.Accessor field ->\n      do  extVar <- mkFlexVar\n          fieldVar <- mkFlexVar\n          let extType = VarN extVar\n          let fieldType = VarN fieldVar\n          let recordType = RecordN (Map.singleton field fieldType) extType\n          return $ exists [ fieldVar, extVar ] $\n            CEqual region (Accessor field) (FunN recordType fieldType) expected\n\n    Can.Access expr (A.At accessRegion field) ->\n      do  extVar <- mkFlexVar\n          fieldVar <- mkFlexVar\n          let extType = VarN extVar\n          let fieldType = VarN fieldVar\n          let recordType = RecordN (Map.singleton field fieldType) extType\n\n          let context = RecordAccess (A.toRegion expr) (getAccessName expr) accessRegion field\n          recordCon <- constrain rtv expr (FromContext region context recordType)\n\n          return $ exists [ fieldVar, extVar ] $\n            CAnd\n              [ recordCon\n              , CEqual region (Access field) fieldType expected\n              ]\n\n    Can.Update name expr fields ->\n      constrainUpdate rtv region name expr fields expected\n\n    Can.Record fields ->\n      constrainRecord rtv region fields expected\n\n    Can.Unit ->\n      return $ CEqual region Unit UnitN expected\n\n    Can.Tuple a b maybeC ->\n      constrainTuple rtv region a b maybeC expected\n\n    Can.Shader _src types ->\n      constrainShader region types expected\n\n\n\n-- CONSTRAIN LAMBDA\n\n\nconstrainLambda :: RTV -> A.Region -> [Can.Pattern] -> Can.Expr -> Expected Type -> IO Constraint\nconstrainLambda rtv region args body expected =\n  do  (Args vars tipe resultType (Pattern.State headers pvars revCons)) <-\n        constrainArgs args\n\n      bodyCon <-\n        constrain rtv body (NoExpectation resultType)\n\n      return $ exists vars $\n        CAnd\n          [ CLet\n              { _rigidVars = []\n              , _flexVars = pvars\n              , _header = headers\n              , _headerCon = CAnd (reverse revCons)\n              , _bodyCon = bodyCon\n              }\n          , CEqual region Lambda tipe expected\n          ]\n\n\n\n-- CONSTRAIN CALL\n\n\nconstrainCall :: RTV -> A.Region -> Can.Expr -> [Can.Expr] -> Expected Type -> IO Constraint\nconstrainCall rtv region func@(A.At funcRegion _) args expected =\n  do  let maybeName = getName func\n\n      funcVar <- mkFlexVar\n      resultVar <- mkFlexVar\n      let funcType = VarN funcVar\n      let resultType = VarN resultVar\n\n      funcCon <- constrain rtv func (NoExpectation funcType)\n\n      (argVars, argTypes, argCons) <-\n        unzip3 <$> Index.indexedTraverse (constrainArg rtv region maybeName) args\n\n      let arityType = foldr FunN resultType argTypes\n      let category = CallResult maybeName\n\n      return $ exists (funcVar:resultVar:argVars) $\n        CAnd\n          [ funcCon\n          , CEqual funcRegion category funcType (FromContext region (CallArity maybeName (length args)) arityType)\n          , CAnd argCons\n          , CEqual region category resultType expected\n          ]\n\n\nconstrainArg :: RTV -> A.Region -> MaybeName -> Index.ZeroBased -> Can.Expr -> IO (Variable, Type, Constraint)\nconstrainArg rtv region maybeName index arg =\n  do  argVar <- mkFlexVar\n      let argType = VarN argVar\n      argCon <- constrain rtv arg (FromContext region (CallArg maybeName index) argType)\n      return (argVar, argType, argCon)\n\n\ngetName :: Can.Expr -> MaybeName\ngetName (A.At _ expr) =\n  case expr of\n    Can.VarLocal name        -> FuncName name\n    Can.VarTopLevel _ name   -> FuncName name\n    Can.VarForeign _ name _  -> FuncName name\n    Can.VarCtor _ _ name _ _ -> CtorName name\n    Can.VarOperator op _ _ _ -> OpName op\n    Can.VarKernel _ name     -> FuncName name\n    _                        -> NoName\n\n\ngetAccessName :: Can.Expr -> Maybe Name.Name\ngetAccessName (A.At _ expr) =\n  case expr of\n    Can.VarLocal name       -> Just name\n    Can.VarTopLevel _ name  -> Just name\n    Can.VarForeign _ name _ -> Just name\n    _                       -> Nothing\n\n\n\n-- CONSTRAIN BINOP\n\n\nconstrainBinop :: RTV -> A.Region -> Name.Name -> Can.Annotation -> Can.Expr -> Can.Expr -> Expected Type -> IO Constraint\nconstrainBinop rtv region op annotation leftExpr rightExpr expected =\n  do  leftVar <- mkFlexVar\n      rightVar <- mkFlexVar\n      answerVar <- mkFlexVar\n      let leftType = VarN leftVar\n      let rightType = VarN rightVar\n      let answerType = VarN answerVar\n      let binopType = leftType ==> rightType ==> answerType\n\n      let opCon = CForeign region op annotation (NoExpectation binopType)\n\n      leftCon <- constrain rtv leftExpr (FromContext region (OpLeft op) leftType)\n      rightCon <- constrain rtv rightExpr (FromContext region (OpRight op) rightType)\n\n      return $ exists [ leftVar, rightVar, answerVar ] $\n        CAnd\n          [ opCon\n          , leftCon\n          , rightCon\n          , CEqual region (CallResult (OpName op)) answerType expected\n          ]\n\n\n\n-- CONSTRAIN LISTS\n\n\nconstrainList :: RTV -> A.Region -> [Can.Expr] -> Expected Type -> IO Constraint\nconstrainList rtv region entries expected =\n  do  entryVar <- mkFlexVar\n      let entryType = VarN entryVar\n      let listType = AppN ModuleName.list Name.list [entryType]\n\n      entryCons <-\n        Index.indexedTraverse (constrainListEntry rtv region entryType) entries\n\n      return $ exists [entryVar] $\n        CAnd\n          [ CAnd entryCons\n          , CEqual region List listType expected\n          ]\n\n\nconstrainListEntry :: RTV -> A.Region -> Type -> Index.ZeroBased -> Can.Expr -> IO Constraint\nconstrainListEntry rtv region tipe index expr =\n  constrain rtv expr (FromContext region (ListEntry index) tipe)\n\n\n\n-- CONSTRAIN IF EXPRESSIONS\n\n\nconstrainIf :: RTV -> A.Region -> [(Can.Expr, Can.Expr)] -> Can.Expr -> Expected Type -> IO Constraint\nconstrainIf rtv region branches final expected =\n  do  let boolExpect = FromContext region IfCondition Type.bool\n      let (conditions, exprs) = foldr (\\(c,e) (cs,es) -> (c:cs,e:es)) ([],[final]) branches\n\n      condCons <-\n        traverse (\\c -> constrain rtv c boolExpect) conditions\n\n      case expected of\n        FromAnnotation name arity _ tipe ->\n          do  branchCons <- Index.indexedForA exprs $ \\index expr ->\n                constrain rtv expr (FromAnnotation name arity (TypedIfBranch index) tipe)\n              return $\n                CAnd\n                  [ CAnd condCons\n                  , CAnd branchCons\n                  ]\n\n        _ ->\n          do  branchVar <- mkFlexVar\n              let branchType = VarN branchVar\n\n              branchCons <- Index.indexedForA exprs $ \\index expr ->\n                constrain rtv expr (FromContext region (IfBranch index) branchType)\n\n              return $ exists [branchVar] $\n                CAnd\n                  [ CAnd condCons\n                  , CAnd branchCons\n                  , CEqual region If branchType expected\n                  ]\n\n\n\n-- CONSTRAIN CASE EXPRESSIONS\n\n\nconstrainCase :: RTV -> A.Region -> Can.Expr -> [Can.CaseBranch] -> Expected Type -> IO Constraint\nconstrainCase rtv region expr branches expected =\n  do  ptrnVar <- mkFlexVar\n      let ptrnType = VarN ptrnVar\n      exprCon <- constrain rtv expr (NoExpectation ptrnType)\n\n      case expected of\n        FromAnnotation name arity _ tipe ->\n          do  branchCons <- Index.indexedForA branches $ \\index branch ->\n                constrainCaseBranch rtv branch\n                  (PFromContext region (PCaseMatch index) ptrnType)\n                  (FromAnnotation name arity (TypedCaseBranch index) tipe)\n\n              return $ exists [ptrnVar] $ CAnd (exprCon:branchCons)\n\n        _ ->\n          do  branchVar <- mkFlexVar\n              let branchType = VarN branchVar\n\n              branchCons <- Index.indexedForA branches $ \\index branch ->\n                constrainCaseBranch rtv branch\n                  (PFromContext region (PCaseMatch index) ptrnType)\n                  (FromContext region (CaseBranch index) branchType)\n\n              return $ exists [ptrnVar,branchVar] $\n                CAnd\n                  [ exprCon\n                  , CAnd branchCons\n                  , CEqual region Case branchType expected\n                  ]\n\n\nconstrainCaseBranch :: RTV -> Can.CaseBranch -> PExpected Type -> Expected Type -> IO Constraint\nconstrainCaseBranch rtv (Can.CaseBranch pattern expr) pExpect bExpect =\n  do  (Pattern.State headers pvars revCons) <-\n        Pattern.add pattern pExpect Pattern.emptyState\n\n      CLet [] pvars headers (CAnd (reverse revCons))\n        <$> constrain rtv expr bExpect\n\n\n\n-- CONSTRAIN RECORD\n\n\nconstrainRecord :: RTV -> A.Region -> Map.Map Name.Name Can.Expr -> Expected Type -> IO Constraint\nconstrainRecord rtv region fields expected =\n  do  dict <- traverse (constrainField rtv) fields\n\n      let getType (_, t, _) = t\n      let recordType = RecordN (Map.map getType dict) EmptyRecordN\n      let recordCon = CEqual region Record recordType expected\n\n      let vars = Map.foldr (\\(v,_,_) vs -> v:vs) [] dict\n      let cons = Map.foldr (\\(_,_,c) cs -> c:cs) [recordCon] dict\n\n      return $ exists vars (CAnd cons)\n\n\nconstrainField :: RTV -> Can.Expr -> IO (Variable, Type, Constraint)\nconstrainField rtv expr =\n  do  var <- mkFlexVar\n      let tipe = VarN var\n      con <- constrain rtv expr (NoExpectation tipe)\n      return (var, tipe, con)\n\n\n\n-- CONSTRAIN RECORD UPDATE\n\n\nconstrainUpdate :: RTV -> A.Region -> Name.Name -> Can.Expr -> Map.Map Name.Name Can.FieldUpdate -> Expected Type -> IO Constraint\nconstrainUpdate rtv region name expr fields expected =\n  do  extVar <- mkFlexVar\n      fieldDict <- Map.traverseWithKey (constrainUpdateField rtv region) fields\n\n      recordVar <- mkFlexVar\n      let recordType = VarN recordVar\n      let fieldsType = RecordN (Map.map (\\(_,t,_) -> t) fieldDict) (VarN extVar)\n\n      -- NOTE: fieldsType is separate so that Error propagates better\n      let fieldsCon = CEqual region Record recordType (NoExpectation fieldsType)\n      let recordCon = CEqual region Record recordType expected\n\n      let vars = Map.foldr (\\(v,_,_) vs -> v:vs) [recordVar,extVar] fieldDict\n      let cons = Map.foldr (\\(_,_,c) cs -> c:cs) [recordCon] fieldDict\n\n      con <- constrain rtv expr (FromContext region (RecordUpdateKeys name fields) recordType)\n\n      return $ exists vars $ CAnd (fieldsCon:con:cons)\n\n\nconstrainUpdateField :: RTV -> A.Region -> Name.Name -> Can.FieldUpdate -> IO (Variable, Type, Constraint)\nconstrainUpdateField rtv region field (Can.FieldUpdate _ expr) =\n  do  var <- mkFlexVar\n      let tipe = VarN var\n      con <- constrain rtv expr (FromContext region (RecordUpdateValue field) tipe)\n      return (var, tipe, con)\n\n\n\n-- CONSTRAIN TUPLE\n\n\nconstrainTuple :: RTV -> A.Region -> Can.Expr -> Can.Expr -> Maybe Can.Expr -> Expected Type -> IO Constraint\nconstrainTuple rtv region a b maybeC expected =\n  do  aVar <- mkFlexVar\n      bVar <- mkFlexVar\n      let aType = VarN aVar\n      let bType = VarN bVar\n\n      aCon <- constrain rtv a (NoExpectation aType)\n      bCon <- constrain rtv b (NoExpectation bType)\n\n      case maybeC of\n        Nothing ->\n          do  let tupleType = TupleN aType bType Nothing\n              let tupleCon = CEqual region Tuple tupleType expected\n              return $ exists [ aVar, bVar ] $ CAnd [ aCon, bCon, tupleCon ]\n\n        Just c ->\n          do  cVar <- mkFlexVar\n              let cType = VarN cVar\n\n              cCon <- constrain rtv c (NoExpectation cType)\n\n              let tupleType = TupleN aType bType (Just cType)\n              let tupleCon = CEqual region Tuple tupleType expected\n\n              return $ exists [ aVar, bVar, cVar ] $ CAnd [ aCon, bCon, cCon, tupleCon ]\n\n\n\n-- CONSTRAIN SHADER\n\n\nconstrainShader :: A.Region -> Shader.Types -> Expected Type -> IO Constraint\nconstrainShader region (Shader.Types attributes uniforms varyings) expected =\n  do  attrVar <- mkFlexVar\n      unifVar <- mkFlexVar\n      let attrType = VarN attrVar\n      let unifType = VarN unifVar\n\n      let shaderType =\n            AppN ModuleName.webgl Name.shader\n              [ toShaderRecord attributes attrType\n              , toShaderRecord uniforms unifType\n              , toShaderRecord varyings EmptyRecordN\n              ]\n\n      return $ exists [ attrVar, unifVar ] $\n        CEqual region Shader shaderType expected\n\n\ntoShaderRecord :: Map.Map Name.Name Shader.Type -> Type -> Type\ntoShaderRecord types baseRecType =\n  if Map.null types then\n    baseRecType\n  else\n    RecordN (Map.map glToType types) baseRecType\n\n\nglToType :: Shader.Type -> Type\nglToType glType =\n  case glType of\n    Shader.V2 -> Type.vec2\n    Shader.V3 -> Type.vec3\n    Shader.V4 -> Type.vec4\n    Shader.M4 -> Type.mat4\n    Shader.Int -> Type.int\n    Shader.Float -> Type.float\n    Shader.Texture -> Type.texture\n\n\n\n-- CONSTRAIN DESTRUCTURES\n\n\nconstrainDestruct :: RTV -> A.Region -> Can.Pattern -> Can.Expr -> Constraint -> IO Constraint\nconstrainDestruct rtv region pattern expr bodyCon =\n  do  patternVar <- mkFlexVar\n      let patternType = VarN patternVar\n\n      (Pattern.State headers pvars revCons) <-\n        Pattern.add pattern (PNoExpectation patternType) Pattern.emptyState\n\n      exprCon <-\n        constrain rtv expr (FromContext region Destructure patternType)\n\n      return $ CLet [] (patternVar:pvars) headers (CAnd (reverse (exprCon:revCons))) bodyCon\n\n\n\n-- CONSTRAIN DEF\n\n\nconstrainDef :: RTV -> Can.Def -> Constraint -> IO Constraint\nconstrainDef rtv def bodyCon =\n  case def of\n    Can.Def (A.At region name) args expr ->\n      do  (Args vars tipe resultType (Pattern.State headers pvars revCons)) <-\n            constrainArgs args\n\n          exprCon <-\n            constrain rtv expr (NoExpectation resultType)\n\n          return $\n            CLet\n              { _rigidVars = []\n              , _flexVars = vars\n              , _header = Map.singleton name (A.At region tipe)\n              , _headerCon =\n                  CLet\n                    { _rigidVars = []\n                    , _flexVars = pvars\n                    , _header = headers\n                    , _headerCon = CAnd (reverse revCons)\n                    , _bodyCon = exprCon\n                    }\n              , _bodyCon = bodyCon\n              }\n\n    Can.TypedDef (A.At region name) freeVars typedArgs expr srcResultType ->\n      do  let newNames = Map.difference freeVars rtv\n          newRigids <- Map.traverseWithKey (\\n _ -> nameToRigid n) newNames\n          let newRtv = Map.union rtv (Map.map VarN newRigids)\n\n          (TypedArgs tipe resultType (Pattern.State headers pvars revCons)) <-\n            constrainTypedArgs newRtv name typedArgs srcResultType\n\n          let expected = FromAnnotation name (length typedArgs) TypedBody resultType\n          exprCon <-\n            constrain newRtv expr expected\n\n          return $\n            CLet\n              { _rigidVars = Map.elems newRigids\n              , _flexVars = []\n              , _header = Map.singleton name (A.At region tipe)\n              , _headerCon =\n                  CLet\n                    { _rigidVars = []\n                    , _flexVars = pvars\n                    , _header = headers\n                    , _headerCon = CAnd (reverse revCons)\n                    , _bodyCon = exprCon\n                    }\n              , _bodyCon = bodyCon\n              }\n\n\n\n-- CONSTRAIN RECURSIVE DEFS\n\n\ndata Info =\n  Info\n    { _vars :: [Variable]\n    , _cons :: [Constraint]\n    , _headers :: Map.Map Name.Name (A.Located Type)\n    }\n\n\n{-# NOINLINE emptyInfo #-}\nemptyInfo :: Info\nemptyInfo =\n  Info [] [] Map.empty\n\n\nconstrainRecursiveDefs :: RTV -> [Can.Def] -> Constraint -> IO Constraint\nconstrainRecursiveDefs rtv defs bodyCon =\n  recDefsHelp rtv defs bodyCon emptyInfo emptyInfo\n\n\nrecDefsHelp :: RTV -> [Can.Def] -> Constraint -> Info -> Info -> IO Constraint\nrecDefsHelp rtv defs bodyCon rigidInfo flexInfo =\n  case defs of\n    [] ->\n      do  let (Info rigidVars rigidCons rigidHeaders) = rigidInfo\n          let (Info flexVars  flexCons  flexHeaders ) = flexInfo\n          return $\n            CLet rigidVars [] rigidHeaders CTrue $\n              CLet [] flexVars flexHeaders (CLet [] [] flexHeaders CTrue (CAnd flexCons)) $\n                CAnd [ CAnd rigidCons, bodyCon ]\n\n    def : otherDefs ->\n      case def of\n        Can.Def (A.At region name) args expr ->\n          do  let (Info flexVars flexCons flexHeaders) = flexInfo\n\n              (Args newFlexVars tipe resultType (Pattern.State headers pvars revCons)) <-\n                argsHelp args (Pattern.State Map.empty flexVars [])\n\n              exprCon <-\n                constrain rtv expr (NoExpectation resultType)\n\n              let defCon =\n                    CLet\n                      { _rigidVars = []\n                      , _flexVars = pvars\n                      , _header = headers\n                      , _headerCon = CAnd (reverse revCons)\n                      , _bodyCon = exprCon\n                      }\n\n              recDefsHelp rtv otherDefs bodyCon rigidInfo $\n                Info\n                  { _vars = newFlexVars\n                  , _cons = defCon : flexCons\n                  , _headers = Map.insert name (A.At region tipe) flexHeaders\n                  }\n\n        Can.TypedDef (A.At region name) freeVars typedArgs expr srcResultType ->\n          do  let newNames = Map.difference freeVars rtv\n              newRigids <- Map.traverseWithKey (\\n _ -> nameToRigid n) newNames\n              let newRtv = Map.union rtv (Map.map VarN newRigids)\n\n              (TypedArgs tipe resultType (Pattern.State headers pvars revCons)) <-\n                constrainTypedArgs newRtv name typedArgs srcResultType\n\n              exprCon <-\n                constrain newRtv expr $\n                  FromAnnotation name (length typedArgs) TypedBody resultType\n\n              let defCon =\n                    CLet\n                      { _rigidVars = []\n                      , _flexVars = pvars\n                      , _header = headers\n                      , _headerCon = CAnd (reverse revCons)\n                      , _bodyCon = exprCon\n                      }\n\n              let (Info rigidVars rigidCons rigidHeaders) = rigidInfo\n              recDefsHelp rtv otherDefs bodyCon\n                ( Info\n                    { _vars = Map.foldr (:) rigidVars newRigids\n                    , _cons = CLet (Map.elems newRigids) [] Map.empty defCon CTrue : rigidCons\n                    , _headers = Map.insert name (A.At region tipe) rigidHeaders\n                    }\n                )\n                flexInfo\n\n\n\n-- CONSTRAIN ARGS\n\n\ndata Args =\n  Args\n    { _a_vars :: [Variable]\n    , _a_type :: Type\n    , _a_result :: Type\n    , _a_state :: Pattern.State\n    }\n\n\nconstrainArgs :: [Can.Pattern] -> IO Args\nconstrainArgs args =\n  argsHelp args Pattern.emptyState\n\n\nargsHelp :: [Can.Pattern] -> Pattern.State -> IO Args\nargsHelp args state =\n  case args of\n    [] ->\n      do  resultVar <- mkFlexVar\n          let resultType = VarN resultVar\n          return $ Args [resultVar] resultType resultType state\n\n    pattern : otherArgs ->\n      do  argVar <- mkFlexVar\n          let argType = VarN argVar\n\n          (Args vars tipe result newState) <-\n            argsHelp otherArgs =<<\n              Pattern.add pattern (PNoExpectation argType) state\n\n          return (Args (argVar:vars) (FunN argType tipe) result newState)\n\n\n\n-- CONSTRAIN TYPED ARGS\n\n\ndata TypedArgs =\n  TypedArgs\n    { _t_type :: Type\n    , _t_result :: Type\n    , _t_state :: Pattern.State\n    }\n\n\nconstrainTypedArgs :: Map.Map Name.Name Type -> Name.Name -> [(Can.Pattern, Can.Type)] -> Can.Type -> IO TypedArgs\nconstrainTypedArgs rtv name args srcResultType =\n  typedArgsHelp rtv name Index.first args srcResultType Pattern.emptyState\n\n\ntypedArgsHelp :: Map.Map Name.Name Type -> Name.Name -> Index.ZeroBased -> [(Can.Pattern, Can.Type)] -> Can.Type -> Pattern.State -> IO TypedArgs\ntypedArgsHelp rtv name index args srcResultType state =\n  case args of\n    [] ->\n      do  resultType <- Instantiate.fromSrcType rtv srcResultType\n          return $ TypedArgs resultType resultType state\n\n    (pattern@(A.At region _), srcType) : otherArgs ->\n      do  argType <- Instantiate.fromSrcType rtv srcType\n          let expected = PFromContext region (PTypedArg name index) argType\n\n          (TypedArgs tipe resultType newState) <-\n            typedArgsHelp rtv name (Index.next index) otherArgs srcResultType =<<\n              Pattern.add pattern expected state\n\n          return (TypedArgs (FunN argType tipe) resultType newState)\n"
  },
  {
    "path": "compiler/src/Type/Constrain/Module.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Type.Constrain.Module\n  ( constrain\n  )\n  where\n\n\nimport qualified Data.Map.Strict as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Type as E\nimport qualified Type.Constrain.Expression as Expr\nimport qualified Type.Instantiate as Instantiate\nimport Type.Type (Type(..), Constraint(..), (==>), mkFlexVar, nameToRigid, never)\n\n\n\n-- CONSTRAIN\n\n\nconstrain :: Can.Module -> IO Constraint\nconstrain (Can.Module home _ _ decls _ _ _ effects) =\n  case effects of\n    Can.NoEffects ->\n      constrainDecls decls CSaveTheEnvironment\n\n    Can.Ports ports ->\n      Map.foldrWithKey letPort (constrainDecls decls CSaveTheEnvironment) ports\n\n    Can.Manager r0 r1 r2 manager ->\n      case manager of\n        Can.Cmd cmdName ->\n          letCmd home cmdName =<<\n            constrainDecls decls =<< constrainEffects home r0 r1 r2 manager\n\n        Can.Sub subName ->\n          letSub home subName =<<\n            constrainDecls decls =<< constrainEffects home r0 r1 r2 manager\n\n        Can.Fx cmdName subName ->\n          letCmd home cmdName =<<\n          letSub home subName =<<\n            constrainDecls decls =<< constrainEffects home r0 r1 r2 manager\n\n\n\n-- CONSTRAIN DECLARATIONS\n\n\nconstrainDecls :: Can.Decls -> Constraint -> IO Constraint\nconstrainDecls decls finalConstraint =\n  case decls of\n    Can.Declare def otherDecls ->\n      Expr.constrainDef Map.empty def =<< constrainDecls otherDecls finalConstraint\n\n    Can.DeclareRec def defs otherDecls ->\n      Expr.constrainRecursiveDefs Map.empty (def:defs) =<< constrainDecls otherDecls finalConstraint\n\n    Can.SaveTheEnvironment ->\n      return finalConstraint\n\n\n\n-- PORT HELPERS\n\n\nletPort :: Name.Name -> Can.Port -> IO Constraint -> IO Constraint\nletPort name port_ makeConstraint =\n  case port_ of\n    Can.Incoming freeVars _ srcType ->\n      do  vars <- Map.traverseWithKey (\\k _ -> nameToRigid k) freeVars\n          tipe <- Instantiate.fromSrcType (Map.map VarN vars) srcType\n          let header = Map.singleton name (A.At A.zero tipe)\n          CLet (Map.elems vars) [] header CTrue <$> makeConstraint\n\n    Can.Outgoing freeVars _ srcType ->\n      do  vars <- Map.traverseWithKey (\\k _ -> nameToRigid k) freeVars\n          tipe <- Instantiate.fromSrcType (Map.map VarN vars) srcType\n          let header = Map.singleton name (A.At A.zero tipe)\n          CLet (Map.elems vars) [] header CTrue <$> makeConstraint\n\n\n\n-- EFFECT MANAGER HELPERS\n\n\nletCmd :: ModuleName.Canonical -> Name.Name -> Constraint -> IO Constraint\nletCmd home tipe constraint =\n  do  msgVar <- mkFlexVar\n      let msg = VarN msgVar\n      let cmdType = FunN (AppN home tipe [msg]) (AppN ModuleName.cmd Name.cmd [msg])\n      let header = Map.singleton \"command\" (A.At A.zero cmdType)\n      return $ CLet [msgVar] [] header CTrue constraint\n\n\nletSub :: ModuleName.Canonical -> Name.Name -> Constraint -> IO Constraint\nletSub home tipe constraint =\n  do  msgVar <- mkFlexVar\n      let msg = VarN msgVar\n      let subType = FunN (AppN home tipe [msg]) (AppN ModuleName.sub Name.sub [msg])\n      let header = Map.singleton \"subscription\" (A.At A.zero subType)\n      return $ CLet [msgVar] [] header CTrue constraint\n\n\nconstrainEffects :: ModuleName.Canonical -> A.Region -> A.Region -> A.Region -> Can.Manager -> IO Constraint\nconstrainEffects home r0 r1 r2 manager =\n  do  s0 <- mkFlexVar\n      s1 <- mkFlexVar\n      s2 <- mkFlexVar\n      m1 <- mkFlexVar\n      m2 <- mkFlexVar\n      sm1 <- mkFlexVar\n      sm2 <- mkFlexVar\n\n      let state0 = VarN s0\n      let state1 = VarN s1\n      let state2 = VarN s2\n      let msg1 = VarN m1\n      let msg2 = VarN m2\n      let self1 = VarN sm1\n      let self2 = VarN sm2\n\n      let onSelfMsg = router msg2 self2 ==> self2 ==> state2 ==> task state2\n      let onEffects =\n            case manager of\n              Can.Cmd cmd    -> router msg1 self1 ==> effectList home cmd msg1 ==> state1 ==> task state1\n              Can.Sub sub    -> router msg1 self1 ==> effectList home sub msg1 ==> state1 ==> task state1\n              Can.Fx cmd sub -> router msg1 self1 ==> effectList home cmd msg1 ==> effectList home sub msg1 ==> state1 ==> task state1\n\n      let effectCons =\n            CAnd\n              [ CLocal r0 \"init\" (E.NoExpectation (task state0))\n              , CLocal r1 \"onEffects\" (E.NoExpectation onEffects)\n              , CLocal r2 \"onSelfMsg\" (E.NoExpectation onSelfMsg)\n              , CEqual r1 E.Effects state0 (E.NoExpectation state1)\n              , CEqual r2 E.Effects state0 (E.NoExpectation state2)\n              , CEqual r2 E.Effects self1 (E.NoExpectation self2)\n              ]\n\n      CLet [] [s0,s1,s2,m1,m2,sm1,sm2] Map.empty effectCons <$>\n        case manager of\n          Can.Cmd cmd ->\n            checkMap \"cmdMap\" home cmd CSaveTheEnvironment\n\n          Can.Sub sub ->\n            checkMap \"subMap\" home sub CSaveTheEnvironment\n\n          Can.Fx cmd sub ->\n            checkMap \"cmdMap\" home cmd =<<\n              checkMap \"subMap\" home sub CSaveTheEnvironment\n\n\neffectList :: ModuleName.Canonical -> Name.Name -> Type -> Type\neffectList home name msg =\n  AppN ModuleName.list Name.list [AppN home name [msg]]\n\n\ntask :: Type -> Type\ntask answer =\n  AppN ModuleName.platform Name.task [ never, answer ]\n\n\nrouter :: Type -> Type -> Type\nrouter msg self =\n  AppN ModuleName.platform Name.router [ msg, self ]\n\n\ncheckMap :: Name.Name -> ModuleName.Canonical -> Name.Name -> Constraint -> IO Constraint\ncheckMap name home tipe constraint =\n  do  a <- mkFlexVar\n      b <- mkFlexVar\n      let mapType = toMapType home tipe (VarN a) (VarN b)\n      let mapCon = CLocal A.zero name (E.NoExpectation mapType)\n      return $ CLet [a,b] [] Map.empty mapCon constraint\n\n\ntoMapType :: ModuleName.Canonical -> Name.Name -> Type -> Type -> Type\ntoMapType home tipe a b =\n  (a ==> b) ==> AppN home tipe [a] ==> AppN home tipe [b]\n"
  },
  {
    "path": "compiler/src/Type/Constrain/Pattern.hs",
    "content": "module Type.Constrain.Pattern\n  ( State(..)\n  , emptyState\n  , add\n  )\n  where\n\n\nimport Control.Arrow (second)\nimport Control.Monad (foldM)\nimport qualified Data.Map.Strict as Map\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport qualified Data.Index as Index\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Type as E\nimport qualified Type.Instantiate as Instantiate\nimport Type.Type as T\n\n\n\n-- ACTUALLY ADD CONSTRAINTS\n\n\n-- The constraints are stored in reverse order so that adding a new\n-- constraint is O(1) and we can reverse it at some later time.\n--\ndata State =\n  State\n    { _headers :: Header\n    , _vars :: [Variable]\n    , _revCons :: [Constraint]\n    }\n\n\ntype Header = Map.Map Name.Name (A.Located Type)\n\n\nadd :: Can.Pattern -> E.PExpected Type -> State -> IO State\nadd (A.At region pattern) expectation state =\n  case pattern of\n    Can.PAnything ->\n      return state\n\n    Can.PVar name ->\n      return $ addToHeaders region name expectation state\n\n    Can.PAlias realPattern name ->\n      add realPattern expectation $\n        addToHeaders region name expectation state\n\n    Can.PUnit ->\n      do  let (State headers vars revCons) = state\n          let unitCon = CPattern region E.PUnit UnitN expectation\n          return $ State headers vars (unitCon:revCons)\n\n    Can.PTuple a b maybeC ->\n      addTuple region a b maybeC expectation state\n\n    Can.PCtor home typeName (Can.Union typeVars _ _ _) ctorName _ args ->\n      addCtor region home typeName typeVars ctorName args expectation state\n\n    Can.PList patterns ->\n      do  entryVar <- mkFlexVar\n          let entryType = VarN entryVar\n          let listType = AppN ModuleName.list Name.list [entryType]\n\n          (State headers vars revCons) <-\n            foldM (addEntry region entryType) state (Index.indexedMap (,) patterns)\n\n          let listCon = CPattern region E.PList listType expectation\n          return $ State headers (entryVar:vars) (listCon:revCons)\n\n    Can.PCons headPattern tailPattern ->\n      do  entryVar <- mkFlexVar\n          let entryType = VarN entryVar\n          let listType = AppN ModuleName.list Name.list [entryType]\n\n          let headExpectation = E.PNoExpectation entryType\n          let tailExpectation = E.PFromContext region E.PTail listType\n\n          (State headers vars revCons) <-\n            add headPattern headExpectation =<<\n              add tailPattern tailExpectation state\n\n          let listCon = CPattern region E.PList listType expectation\n          return $ State headers (entryVar:vars) (listCon : revCons)\n\n    Can.PRecord fields ->\n      do  extVar <- mkFlexVar\n          let extType = VarN extVar\n\n          fieldVars <- traverse (\\field -> (,) field <$> mkFlexVar) fields\n          let fieldTypes = Map.fromList (map (fmap VarN) fieldVars)\n          let recordType = RecordN fieldTypes extType\n\n          let (State headers vars revCons) = state\n          let recordCon = CPattern region E.PRecord recordType expectation\n          return $\n            State\n              { _headers = Map.union headers (Map.map (A.At region) fieldTypes)\n              , _vars = map snd fieldVars ++ extVar : vars\n              , _revCons = recordCon : revCons\n              }\n\n    Can.PInt _ ->\n      do  let (State headers vars revCons) = state\n          let intCon = CPattern region E.PInt T.int expectation\n          return $ State headers vars (intCon:revCons)\n\n    Can.PStr _ ->\n      do  let (State headers vars revCons) = state\n          let strCon = CPattern region E.PStr T.string expectation\n          return $ State headers vars (strCon:revCons)\n\n    Can.PChr _ ->\n      do  let (State headers vars revCons) = state\n          let chrCon = CPattern region E.PChr T.char expectation\n          return $ State headers vars (chrCon:revCons)\n\n    Can.PBool _ _ ->\n      do  let (State headers vars revCons) = state\n          let boolCon = CPattern region E.PBool T.bool expectation\n          return $ State headers vars (boolCon:revCons)\n\n\n\n-- STATE HELPERS\n\n\n{-# NOINLINE emptyState #-}\nemptyState :: State\nemptyState =\n  State Map.empty [] []\n\n\naddToHeaders :: A.Region -> Name.Name -> E.PExpected Type -> State -> State\naddToHeaders region name expectation (State headers vars revCons) =\n  let\n    tipe = getType expectation\n    newHeaders = Map.insert name (A.At region tipe) headers\n  in\n  State newHeaders vars revCons\n\n\ngetType :: E.PExpected Type -> Type\ngetType expectation =\n  case expectation of\n    E.PNoExpectation tipe -> tipe\n    E.PFromContext _ _ tipe -> tipe\n\n\n\n-- CONSTRAIN LIST\n\n\naddEntry :: A.Region -> Type -> State -> (Index.ZeroBased, Can.Pattern) -> IO State\naddEntry listRegion tipe state (index, pattern) =\n  let\n    expectation =\n      E.PFromContext listRegion (E.PListEntry index) tipe\n  in\n  add pattern expectation state\n\n\n\n-- CONSTRAIN TUPLE\n\n\naddTuple :: A.Region -> Can.Pattern -> Can.Pattern -> Maybe Can.Pattern -> E.PExpected Type -> State -> IO State\naddTuple region a b maybeC expectation state =\n  do  aVar <- mkFlexVar\n      bVar <- mkFlexVar\n      let aType = VarN aVar\n      let bType = VarN bVar\n\n      case maybeC of\n        Nothing ->\n          do  (State headers vars revCons) <-\n                simpleAdd b bType =<<\n                  simpleAdd a aType state\n\n              let tupleCon = CPattern region E.PTuple (TupleN aType bType Nothing) expectation\n\n              return $ State headers (aVar:bVar:vars) (tupleCon:revCons)\n\n        Just c ->\n          do  cVar <- mkFlexVar\n              let cType = VarN cVar\n\n              (State headers vars revCons) <-\n                simpleAdd c cType =<<\n                  simpleAdd b bType =<<\n                    simpleAdd a aType state\n\n              let tupleCon = CPattern region E.PTuple (TupleN aType bType (Just cType)) expectation\n\n              return $ State headers (aVar:bVar:cVar:vars) (tupleCon:revCons)\n\n\nsimpleAdd :: Can.Pattern -> Type -> State -> IO State\nsimpleAdd pattern patternType state =\n  add pattern (E.PNoExpectation patternType) state\n\n\n\n-- CONSTRAIN CONSTRUCTORS\n\n\naddCtor :: A.Region -> ModuleName.Canonical -> Name.Name -> [Name.Name] -> Name.Name -> [Can.PatternCtorArg] -> E.PExpected Type -> State -> IO State\naddCtor region home typeName typeVarNames ctorName args expectation state =\n  do  varPairs <- traverse (\\var -> (,) var <$> nameToFlex var) typeVarNames\n      let typePairs = map (second VarN) varPairs\n      let freeVarDict = Map.fromList typePairs\n\n      (State headers vars revCons) <-\n        foldM (addCtorArg region ctorName freeVarDict) state args\n\n      let ctorType = AppN home typeName (map snd typePairs)\n      let ctorCon = CPattern region (E.PCtor ctorName) ctorType expectation\n\n      return $\n        State\n          { _headers = headers\n          , _vars = map snd varPairs ++ vars\n          , _revCons = ctorCon : revCons\n          }\n\n\naddCtorArg :: A.Region -> Name.Name -> Map.Map Name.Name Type -> State -> Can.PatternCtorArg -> IO State\naddCtorArg region ctorName freeVarDict state (Can.PatternCtorArg index srcType pattern) =\n  do  tipe <- Instantiate.fromSrcType freeVarDict srcType\n      let expectation = E.PFromContext region (E.PCtorArg ctorName index) tipe\n      add pattern expectation state\n"
  },
  {
    "path": "compiler/src/Type/Error.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-x-partial #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Type.Error\n  ( Type(..)\n  , Super(..)\n  , Extension(..)\n  , iteratedDealias\n  , toDoc\n  , Problem(..)\n  , Direction(..)\n  , toComparison\n  , isInt\n  , isFloat\n  , isString\n  , isChar\n  , isList\n  )\n  where\n\n\nimport qualified Data.Map as Map\nimport qualified Data.Maybe as Maybe\nimport qualified Data.Name as Name\n\nimport qualified Data.Bag as Bag\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Render.Type as RT\nimport qualified Reporting.Render.Type.Localizer as L\n\n\n\n-- ERROR TYPES\n\n\ndata Type\n  = Lambda Type Type [Type]\n  | Infinite\n  | Error\n  | FlexVar Name.Name\n  | FlexSuper Super Name.Name\n  | RigidVar Name.Name\n  | RigidSuper Super Name.Name\n  | Type ModuleName.Canonical Name.Name [Type]\n  | Record (Map.Map Name.Name Type) Extension\n  | Unit\n  | Tuple Type Type (Maybe Type)\n  | Alias ModuleName.Canonical Name.Name [(Name.Name, Type)] Type\n\n\ndata Super\n  = Number\n  | Comparable\n  | Appendable\n  | CompAppend\n  deriving (Eq)\n\n\ndata Extension\n  = Closed\n  | FlexOpen Name.Name\n  | RigidOpen Name.Name\n\n\niteratedDealias :: Type -> Type\niteratedDealias tipe =\n  case tipe of\n    Alias _ _ _ real ->\n      iteratedDealias real\n\n    _ ->\n      tipe\n\n\n\n-- TO DOC\n\n\ntoDoc :: L.Localizer -> RT.Context -> Type -> D.Doc\ntoDoc localizer ctx tipe =\n  case tipe of\n    Lambda a b cs ->\n      RT.lambda ctx\n        (toDoc localizer RT.Func a)\n        (toDoc localizer RT.Func b)\n        (map (toDoc localizer RT.Func) cs)\n\n    Infinite ->\n      \"∞\"\n\n    Error ->\n      \"?\"\n\n    FlexVar name ->\n      D.fromName name\n\n    FlexSuper _ name ->\n      D.fromName name\n\n    RigidVar name ->\n      D.fromName name\n\n    RigidSuper _ name ->\n      D.fromName name\n\n    Type home name args ->\n      RT.apply ctx\n        (L.toDoc localizer home name)\n        (map (toDoc localizer RT.App) args)\n\n    Record fields ext ->\n      RT.record (fieldsToDocs localizer fields) (extToDoc ext)\n\n    Unit ->\n      \"()\"\n\n    Tuple a b maybeC ->\n      RT.tuple\n        (toDoc localizer RT.None a)\n        (toDoc localizer RT.None b)\n        (map (toDoc localizer RT.None) (Maybe.maybeToList maybeC))\n\n    Alias home name args _ ->\n      aliasToDoc localizer ctx home name args\n\n\naliasToDoc :: L.Localizer -> RT.Context -> ModuleName.Canonical -> Name.Name -> [(Name.Name, Type)] -> D.Doc\naliasToDoc localizer ctx home name args =\n  RT.apply ctx\n    (L.toDoc localizer home name)\n    (map (toDoc localizer RT.App . snd) args)\n\n\nfieldsToDocs :: L.Localizer -> Map.Map Name.Name Type -> [(D.Doc, D.Doc)]\nfieldsToDocs localizer fields =\n  Map.foldrWithKey (addField localizer) [] fields\n\n\naddField :: L.Localizer -> Name.Name -> Type -> [(D.Doc, D.Doc)] -> [(D.Doc, D.Doc)]\naddField localizer fieldName fieldType docs =\n  let\n    f = D.fromName fieldName\n    t = toDoc localizer RT.None fieldType\n  in\n  (f,t) : docs\n\n\nextToDoc :: Extension -> Maybe D.Doc\nextToDoc ext =\n  case ext of\n    Closed -> Nothing\n    FlexOpen x -> Just (D.fromName x)\n    RigidOpen x -> Just (D.fromName x)\n\n\n\n-- DIFF\n\n\ndata Diff a =\n  Diff a a Status\n\n\ndata Status\n  = Similar\n  | Different (Bag.Bag Problem)\n\n\ndata Problem\n  = IntFloat\n  | StringFromInt\n  | StringFromFloat\n  | StringToInt\n  | StringToFloat\n  | AnythingToBool\n  | AnythingFromMaybe\n  | ArityMismatch Int Int\n  | BadFlexSuper Direction Super Name.Name Type\n  | BadRigidVar Name.Name Type\n  | BadRigidSuper Super Name.Name Type\n  | FieldTypo Name.Name [Name.Name]\n  | FieldsMissing [Name.Name]\n\n\ndata Direction = Have | Need\n\n\ninstance Functor Diff where\n  fmap func (Diff a b status) =\n    Diff (func a) (func b) status\n\n\ninstance Applicative Diff where\n  pure a =\n    Diff a a Similar\n\n  (<*>) (Diff aFunc bFunc status1) (Diff aArg bArg status2) =\n    Diff (aFunc aArg) (bFunc bArg) (merge status1 status2)\n\n\nmerge :: Status -> Status -> Status\nmerge status1 status2 =\n  case status1 of\n    Similar ->\n      status2\n\n    Different problems1 ->\n      case status2 of\n        Similar ->\n          status1\n\n        Different problems2 ->\n          Different (Bag.append problems1 problems2)\n\n\n\n-- COMPARISON\n\n\ntoComparison :: L.Localizer -> Type -> Type -> (D.Doc, D.Doc, [Problem])\ntoComparison localizer tipe1 tipe2 =\n  case toDiff localizer RT.None tipe1 tipe2 of\n    Diff doc1 doc2 Similar ->\n      (doc1, doc2, [])\n\n    Diff doc1 doc2 (Different problems) ->\n      (doc1, doc2, Bag.toList problems)\n\n\ntoDiff :: L.Localizer -> RT.Context -> Type -> Type -> Diff D.Doc\ntoDiff localizer ctx tipe1 tipe2 =\n  case (tipe1, tipe2) of\n    (Unit    , Unit    ) -> same localizer ctx tipe1\n    (Error   , Error   ) -> same localizer ctx tipe1\n    (Infinite, Infinite) -> same localizer ctx tipe1\n\n    (FlexVar      x, FlexVar      y) | x == y -> same localizer ctx tipe1\n    (FlexSuper _  x, FlexSuper _  y) | x == y -> same localizer ctx tipe1\n    (RigidVar     x, RigidVar     y) | x == y -> same localizer ctx tipe1\n    (RigidSuper _ x, RigidSuper _ y) | x == y -> same localizer ctx tipe1\n\n    (FlexVar _, _        ) -> similar localizer ctx tipe1 tipe2\n    (_        , FlexVar _) -> similar localizer ctx tipe1 tipe2\n\n    (FlexSuper s _, t            ) | isSuper s t -> similar localizer ctx tipe1 tipe2\n    (t            , FlexSuper s _) | isSuper s t -> similar localizer ctx tipe1 tipe2\n\n    (Lambda a b cs, Lambda x y zs) ->\n      if length cs == length zs then\n        RT.lambda ctx\n          <$> toDiff localizer RT.Func a x\n          <*> toDiff localizer RT.Func b y\n          <*> sequenceA (zipWith (toDiff localizer RT.Func) cs zs)\n      else\n        let f = toDoc localizer RT.Func in\n        different\n          (D.dullyellow (RT.lambda ctx (f a) (f b) (map f cs)))\n          (D.dullyellow (RT.lambda ctx (f x) (f y) (map f zs)))\n          (Bag.one (ArityMismatch (2 + length cs) (2 + length zs)))\n\n    (Tuple a b Nothing, Tuple x y Nothing) ->\n      RT.tuple\n        <$> toDiff localizer RT.None a x\n        <*> toDiff localizer RT.None b y\n        <*> pure []\n\n    (Tuple a b (Just c), Tuple x y (Just z)) ->\n      RT.tuple\n        <$> toDiff localizer RT.None a x\n        <*> toDiff localizer RT.None b y\n        <*> ((:[]) <$> toDiff localizer RT.None c z)\n\n    (Record fields1 ext1, Record fields2 ext2) ->\n      diffRecord localizer fields1 ext1 fields2 ext2\n\n    (Type home1 name1 args1, Type home2 name2 args2) | home1 == home2 && name1 == name2 ->\n      RT.apply ctx (L.toDoc localizer home1 name1)\n        <$> sequenceA (zipWith (toDiff localizer RT.App) args1 args2)\n\n    (Alias home1 name1 args1 _, Alias home2 name2 args2 _) | home1 == home2 && name1 == name2 ->\n      RT.apply ctx (L.toDoc localizer home1 name1)\n        <$> sequenceA (zipWith (toDiff localizer RT.App) (map snd args1) (map snd args2))\n\n    -- start trying to find specific problems\n\n    (Type home1 name1 args1, Type home2 name2 args2) | L.toChars localizer home1 name1 == L.toChars localizer home2 name2 ->\n      different\n        (nameClashToDoc ctx localizer home1 name1 args1)\n        (nameClashToDoc ctx localizer home2 name2 args2)\n        Bag.empty\n\n    (Type home name [t1], t2) | isMaybe home name && isSimilar (toDiff localizer ctx t1 t2) ->\n      different\n        (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [toDoc localizer RT.App t1])\n        (toDoc localizer ctx t2)\n        (Bag.one AnythingFromMaybe)\n\n    (t1, Type home name [t2]) | isList home name && isSimilar (toDiff localizer ctx t1 t2) ->\n      different\n        (toDoc localizer ctx t1)\n        (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [toDoc localizer RT.App t2])\n        Bag.empty\n\n    (Alias home1 name1 args1 t1, t2) ->\n      case diffAliasedRecord localizer t1 t2 of\n        Just (Diff _ doc2 status) ->\n          Diff (D.dullyellow (aliasToDoc localizer ctx home1 name1 args1)) doc2 status\n\n        Nothing ->\n          case t2 of\n            Type home2 name2 args2 | L.toChars localizer home1 name1 == L.toChars localizer home2 name2 ->\n              different\n                (nameClashToDoc ctx localizer home1 name1 (map snd args1))\n                (nameClashToDoc ctx localizer home2 name2 args2)\n                Bag.empty\n\n            _ ->\n              different\n                (D.dullyellow (toDoc localizer ctx tipe1))\n                (D.dullyellow (toDoc localizer ctx tipe2))\n                Bag.empty\n\n    (t1, Alias home2 name2 args2 t2) ->\n      case diffAliasedRecord localizer t1 t2 of\n        Just (Diff doc1 _ status) ->\n          Diff doc1 (D.dullyellow (aliasToDoc localizer ctx home2 name2 args2)) status\n\n        Nothing ->\n          case t1 of\n            Type home1 name1 args1 | L.toChars localizer home1 name1 == L.toChars localizer home2 name2 ->\n              different\n                (nameClashToDoc ctx localizer home1 name1 args1)\n                (nameClashToDoc ctx localizer home2 name2 (map snd args2))\n                Bag.empty\n\n            _ ->\n              different\n                (D.dullyellow (toDoc localizer ctx tipe1))\n                (D.dullyellow (toDoc localizer ctx tipe2))\n                Bag.empty\n\n    pair ->\n      let\n        doc1 = D.dullyellow (toDoc localizer ctx tipe1)\n        doc2 = D.dullyellow (toDoc localizer ctx tipe2)\n      in\n      different doc1 doc2 $\n        case pair of\n          (RigidVar     x, other) -> Bag.one $ BadRigidVar x other\n          (FlexSuper  s x, other) -> Bag.one $ BadFlexSuper Have s x other\n          (RigidSuper s x, other) -> Bag.one $ BadRigidSuper s x other\n          (other, RigidVar     x) -> Bag.one $ BadRigidVar x other\n          (other, FlexSuper  s x) -> Bag.one $ BadFlexSuper Need s x other\n          (other, RigidSuper s x) -> Bag.one $ BadRigidSuper s x other\n\n          (Type home1 name1 [], Type home2 name2 [])\n            | isInt   home1 name1 && isFloat  home2 name2 -> Bag.one IntFloat\n            | isFloat home1 name1 && isInt    home2 name2 -> Bag.one IntFloat\n            | isInt   home1 name1 && isString home2 name2 -> Bag.one StringFromInt\n            | isFloat home1 name1 && isString home2 name2 -> Bag.one StringFromFloat\n            | isString home1 name1 && isInt   home2 name2 -> Bag.one StringToInt\n            | isString home1 name1 && isFloat home2 name2 -> Bag.one StringToFloat\n            | isBool home2 name2 -> Bag.one AnythingToBool\n\n          (_, _) ->\n            Bag.empty\n\n\n\n-- DIFF HELPERS\n\n\nsame :: L.Localizer -> RT.Context -> Type -> Diff D.Doc\nsame localizer ctx tipe =\n  let\n    doc = toDoc localizer ctx tipe\n  in\n  Diff doc doc Similar\n\n\nsimilar :: L.Localizer -> RT.Context -> Type -> Type -> Diff D.Doc\nsimilar localizer ctx t1 t2 =\n  Diff (toDoc localizer ctx t1) (toDoc localizer ctx t2) Similar\n\n\ndifferent :: a -> a -> Bag.Bag Problem -> Diff a\ndifferent a b problems =\n  Diff a b (Different problems)\n\n\nisSimilar :: Diff a -> Bool\nisSimilar (Diff _ _ status) =\n  case status of\n    Similar -> True\n    Different _ -> False\n\n\n\n-- IS TYPE?\n\n\nisBool :: ModuleName.Canonical -> Name.Name -> Bool\nisBool home name =\n  home == ModuleName.basics && name == Name.bool\n\n\nisInt :: ModuleName.Canonical -> Name.Name -> Bool\nisInt home name =\n  home == ModuleName.basics && name == Name.int\n\n\nisFloat :: ModuleName.Canonical -> Name.Name -> Bool\nisFloat home name =\n  home == ModuleName.basics && name == Name.float\n\n\nisString :: ModuleName.Canonical -> Name.Name -> Bool\nisString home name =\n  home == ModuleName.string && name == Name.string\n\n\nisChar :: ModuleName.Canonical -> Name.Name -> Bool\nisChar home name =\n  home == ModuleName.char && name == Name.char\n\n\nisMaybe :: ModuleName.Canonical -> Name.Name -> Bool\nisMaybe home name =\n  home == ModuleName.maybe && name == Name.maybe\n\n\nisList :: ModuleName.Canonical -> Name.Name -> Bool\nisList home name =\n  home == ModuleName.list && name == Name.list\n\n\n\n-- IS SUPER?\n\n\nisSuper :: Super -> Type -> Bool\nisSuper super tipe =\n  case iteratedDealias tipe of\n    Type h n args ->\n      case super of\n        Number     -> isInt h n || isFloat h n\n        Comparable -> isInt h n || isFloat h n || isString h n || isChar h n || isList h n && isSuper super (head args)\n        Appendable -> isString h n || isList h n\n        CompAppend -> isString h n || isList h n && isSuper Comparable (head args)\n\n    Tuple a b maybeC ->\n      case super of\n        Number     -> False\n        Comparable -> isSuper super a && isSuper super b && maybe True (isSuper super) maybeC\n        Appendable -> False\n        CompAppend -> False\n\n    _ ->\n      False\n\n\n\n-- NAME CLASH\n\n\nnameClashToDoc :: RT.Context -> L.Localizer -> ModuleName.Canonical -> Name.Name -> [Type] -> D.Doc\nnameClashToDoc ctx localizer (ModuleName.Canonical _ home) name args =\n  RT.apply ctx\n    (D.yellow (D.fromName home) <> D.dullyellow (\".\" <> D.fromName name))\n    (map (toDoc localizer RT.App) args)\n\n\n\n-- DIFF ALIASED RECORD\n\n\ndiffAliasedRecord :: L.Localizer -> Type -> Type -> Maybe (Diff D.Doc)\ndiffAliasedRecord localizer t1 t2 =\n  case (iteratedDealias t1, iteratedDealias t2) of\n    (Record fields1 ext1, Record fields2 ext2) ->\n      Just (diffRecord localizer fields1 ext1 fields2 ext2)\n\n    _ ->\n      Nothing\n\n\n\n-- RECORD DIFFS\n\n\ndiffRecord :: L.Localizer -> Map.Map Name.Name Type -> Extension -> Map.Map Name.Name Type -> Extension -> Diff D.Doc\ndiffRecord localizer fields1 ext1 fields2 ext2 =\n  let\n    toUnknownDocs field tipe =\n      ( D.dullyellow (D.fromName field), toDoc localizer RT.None tipe )\n\n    toOverlapDocs field t1 t2 =\n      (,) (D.fromName field) <$> toDiff localizer RT.None t1 t2\n\n    left = Map.mapWithKey toUnknownDocs (Map.difference fields1 fields2)\n    both = Map.intersectionWithKey toOverlapDocs fields1 fields2\n    right = Map.mapWithKey toUnknownDocs (Map.difference fields2 fields1)\n\n    fieldsDiff =\n      Map.elems <$>\n        if Map.null left && Map.null right then\n          sequenceA both\n        else\n          Map.union\n            <$> sequenceA both\n            <*> Diff left right (Different Bag.empty)\n\n    (Diff doc1 doc2 status) =\n      RT.record\n        <$> fieldsDiff\n        <*> extToDiff ext1 ext2\n  in\n  Diff doc1 doc2 $ merge status $\n    case (hasFixedFields ext1, hasFixedFields ext2) of\n      (True, True) ->\n        case Map.lookupMin left of\n          Just (f,_) -> Different $ Bag.one $ FieldTypo f (Map.keys fields2)\n          Nothing ->\n            if Map.null right\n              then Similar\n              else Different $ Bag.one $ FieldsMissing (Map.keys right)\n\n      (False, True) ->\n        case Map.lookupMin left of\n          Just (f,_) -> Different $ Bag.one $ FieldTypo f (Map.keys fields2)\n          Nothing    -> Similar\n\n      (True, False) ->\n        case Map.lookupMin right of\n          Just (f,_) -> Different $ Bag.one $ FieldTypo f (Map.keys fields1)\n          Nothing    -> Similar\n\n      (False, False) ->\n        Similar\n\n\nhasFixedFields :: Extension -> Bool\nhasFixedFields ext =\n  case ext of\n    Closed      -> True\n    FlexOpen _  -> False\n    RigidOpen _ -> True\n\n\n\n-- DIFF RECORD EXTENSION\n\n\nextToDiff :: Extension -> Extension -> Diff (Maybe D.Doc)\nextToDiff ext1 ext2 =\n  let\n    status = extToStatus ext1 ext2\n    extDoc1 = extToDoc ext1\n    extDoc2 = extToDoc ext2\n  in\n  case status of\n    Similar ->\n      Diff extDoc1 extDoc2 status\n\n    Different _ ->\n      Diff (D.dullyellow <$> extDoc1) (D.dullyellow <$> extDoc2) status\n\n\nextToStatus :: Extension -> Extension -> Status\nextToStatus ext1 ext2 =\n  case ext1 of\n    Closed ->\n      case ext2 of\n        Closed      -> Similar\n        FlexOpen  _ -> Similar\n        RigidOpen _ -> Different Bag.empty\n\n    FlexOpen _ ->\n      Similar\n\n    RigidOpen x ->\n      case ext2 of\n        Closed      -> Different Bag.empty\n        FlexOpen  _ -> Similar\n        RigidOpen y ->\n          if x == y\n            then Similar\n            else Different $ Bag.one $ BadRigidVar x (RigidVar y)\n"
  },
  {
    "path": "compiler/src/Type/Instantiate.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Type.Instantiate\n  ( FreeVars\n  , fromSrcType\n  )\n  where\n\n\nimport qualified Data.Map.Strict as Map\nimport Data.Map.Strict ((!))\nimport qualified Data.Name as Name\n\nimport qualified AST.Canonical as Can\nimport Type.Type\n\n\n\n-- FREE VARS\n\n\ntype FreeVars =\n  Map.Map Name.Name Type\n\n\n\n-- FROM SOURCE TYPE\n\n\nfromSrcType :: Map.Map Name.Name Type -> Can.Type -> IO Type\nfromSrcType freeVars sourceType =\n  case sourceType of\n    Can.TLambda arg result ->\n      FunN\n        <$> fromSrcType freeVars arg\n        <*> fromSrcType freeVars result\n\n    Can.TVar name ->\n      return (freeVars ! name)\n\n    Can.TType home name args ->\n      AppN home name <$> traverse (fromSrcType freeVars) args\n\n    Can.TAlias home name args aliasedType ->\n      do  targs <- traverse (traverse (fromSrcType freeVars)) args\n          AliasN home name targs <$>\n            case aliasedType of\n              Can.Filled realType ->\n                fromSrcType freeVars realType\n\n              Can.Holey realType ->\n                fromSrcType (Map.fromList targs) realType\n\n    Can.TTuple a b maybeC ->\n      TupleN\n        <$> fromSrcType freeVars a\n        <*> fromSrcType freeVars b\n        <*> traverse (fromSrcType freeVars) maybeC\n\n    Can.TUnit ->\n      return UnitN\n\n    Can.TRecord fields maybeExt ->\n      RecordN\n        <$> traverse (fromSrcFieldType freeVars) fields\n        <*>\n          case maybeExt of\n            Nothing ->\n              return EmptyRecordN\n\n            Just ext ->\n              return (freeVars ! ext)\n\n\nfromSrcFieldType :: Map.Map Name.Name Type -> Can.FieldType -> IO Type\nfromSrcFieldType freeVars (Can.FieldType _ tipe) =\n  fromSrcType freeVars tipe\n"
  },
  {
    "path": "compiler/src/Type/Occurs.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Type.Occurs\n  ( occurs\n  )\n  where\n\n\nimport Data.Foldable (foldrM)\nimport qualified Data.Map.Strict as Map\n\nimport Type.Type as Type\nimport qualified Type.UnionFind as UF\n\n\n\n-- OCCURS\n\n\noccurs :: Type.Variable -> IO Bool\noccurs var =\n  occursHelp [] var False\n\n\noccursHelp :: [Type.Variable] -> Type.Variable -> Bool -> IO Bool\noccursHelp seen var foundCycle =\n  if elem var seen then\n    return True\n\n  else\n    do  (Descriptor content _ _ _) <- UF.get var\n        case content of\n          FlexVar _ ->\n              return foundCycle\n\n          FlexSuper _ _ ->\n              return foundCycle\n\n          RigidVar _ ->\n              return foundCycle\n\n          RigidSuper _ _ ->\n              return foundCycle\n\n          Structure term ->\n              let newSeen = var : seen in\n              case term of\n                App1 _ _ args ->\n                    foldrM (occursHelp newSeen) foundCycle args\n\n                Fun1 a b ->\n                    occursHelp newSeen a =<<\n                      occursHelp newSeen b foundCycle\n\n                EmptyRecord1 ->\n                    return foundCycle\n\n                Record1 fields ext ->\n                    occursHelp newSeen ext =<<\n                      foldrM (occursHelp newSeen) foundCycle (Map.elems fields)\n\n                Unit1 ->\n                    return foundCycle\n\n                Tuple1 a b maybeC ->\n                    case maybeC of\n                      Nothing ->\n                        occursHelp newSeen a =<<\n                          occursHelp newSeen b foundCycle\n\n                      Just c ->\n                        occursHelp newSeen a =<<\n                          occursHelp newSeen b =<<\n                            occursHelp newSeen c foundCycle\n\n          Alias _ _ args _ ->\n              foldrM (occursHelp (var:seen)) foundCycle (map snd args)\n\n          Error ->\n              return foundCycle\n"
  },
  {
    "path": "compiler/src/Type/Solve.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Type.Solve\n  ( run\n  )\n  where\n\n\nimport Control.Monad\nimport qualified Data.Map.Strict as Map\nimport Data.Map.Strict ((!))\nimport qualified Data.Name as Name\nimport qualified Data.NonEmptyList as NE\nimport qualified Data.Vector as Vector\nimport qualified Data.Vector.Mutable as MVector\n\nimport qualified AST.Canonical as Can\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Type as Error\nimport qualified Reporting.Render.Type as RT\nimport qualified Reporting.Render.Type.Localizer as L\nimport qualified Type.Occurs as Occurs\nimport Type.Type as Type\nimport qualified Type.Error as ET\nimport qualified Type.Unify as Unify\nimport qualified Type.UnionFind as UF\n\n\n\n-- RUN SOLVER\n\n\nrun :: Constraint -> IO (Either (NE.List Error.Error) (Map.Map Name.Name Can.Annotation))\nrun constraint =\n  do  pools <- MVector.replicate 8 []\n\n      (State env _ errors) <-\n        solve Map.empty outermostRank pools emptyState constraint\n\n      case errors of\n        [] ->\n          Right <$> traverse Type.toAnnotation env\n\n        e:es ->\n          return $ Left (NE.List e es)\n\n\n\n{-# NOINLINE emptyState #-}\nemptyState :: State\nemptyState =\n  State Map.empty (nextMark noMark) []\n\n\n\n-- SOLVER\n\n\ntype Env =\n  Map.Map Name.Name Variable\n\n\ntype Pools =\n  MVector.IOVector [Variable]\n\n\ndata State =\n  State\n    { _env :: Env\n    , _mark :: Mark\n    , _errors :: [Error.Error]\n    }\n\n\nsolve :: Env -> Int -> Pools -> State -> Constraint -> IO State\nsolve env rank pools state constraint =\n  case constraint of\n    CTrue ->\n      return state\n\n    CSaveTheEnvironment ->\n      return (state { _env = env })\n\n    CEqual region category tipe expectation ->\n      do  actual <- typeToVariable rank pools tipe\n          expected <- expectedToVariable rank pools expectation\n          answer <- Unify.unify actual expected\n          case answer of\n            Unify.Ok vars ->\n              do  introduce rank pools vars\n                  return state\n\n            Unify.Err vars actualType expectedType ->\n              do  introduce rank pools vars\n                  return $ addError state $\n                    Error.BadExpr region category actualType $\n                      Error.typeReplace expectation expectedType\n\n    CLocal region name expectation ->\n      do  actual <- makeCopy rank pools (env ! name)\n          expected <- expectedToVariable rank pools expectation\n          answer <- Unify.unify actual expected\n          case answer of\n            Unify.Ok vars ->\n              do  introduce rank pools vars\n                  return state\n\n            Unify.Err vars actualType expectedType ->\n              do  introduce rank pools vars\n                  return $ addError state $\n                    Error.BadExpr region (Error.Local name) actualType $\n                      Error.typeReplace expectation expectedType\n\n    CForeign region name (Can.Forall freeVars srcType) expectation ->\n      do  actual <- srcTypeToVariable rank pools freeVars srcType\n          expected <- expectedToVariable rank pools expectation\n          answer <- Unify.unify actual expected\n          case answer of\n            Unify.Ok vars ->\n              do  introduce rank pools vars\n                  return state\n\n            Unify.Err vars actualType expectedType ->\n              do  introduce rank pools vars\n                  return $ addError state $\n                    Error.BadExpr region (Error.Foreign name) actualType $\n                      Error.typeReplace expectation expectedType\n\n    CPattern region category tipe expectation ->\n      do  actual <- typeToVariable rank pools tipe\n          expected <- patternExpectationToVariable rank pools expectation\n          answer <- Unify.unify actual expected\n          case answer of\n            Unify.Ok vars ->\n              do  introduce rank pools vars\n                  return state\n\n            Unify.Err vars actualType expectedType ->\n              do  introduce rank pools vars\n                  return $ addError state $\n                    Error.BadPattern region category actualType\n                      (Error.ptypeReplace expectation expectedType)\n\n    CAnd constraints ->\n      foldM (solve env rank pools) state constraints\n\n    CLet [] flexs _ headerCon CTrue ->\n      do  introduce rank pools flexs\n          solve env rank pools state headerCon\n\n    CLet [] [] header headerCon subCon ->\n      do  state1 <- solve env rank pools state headerCon\n          locals <- traverse (A.traverse (typeToVariable rank pools)) header\n          let newEnv = Map.union env (Map.map A.toValue locals)\n          state2 <- solve newEnv rank pools state1 subCon\n          foldM occurs state2 $ Map.toList locals\n\n    CLet rigids flexs header headerCon subCon ->\n      do\n          -- work in the next pool to localize header\n          let nextRank = rank + 1\n          let poolsLength = MVector.length pools\n          nextPools <-\n            if nextRank < poolsLength\n              then return pools\n              else MVector.grow pools poolsLength\n\n          -- introduce variables\n          let vars = rigids ++ flexs\n          forM_ vars $ \\var ->\n            UF.modify var $ \\(Descriptor content _ mark copy) ->\n              Descriptor content nextRank mark copy\n          MVector.write nextPools nextRank vars\n\n          -- run solver in next pool\n          locals <- traverse (A.traverse (typeToVariable nextRank nextPools)) header\n          (State savedEnv mark errors) <-\n            solve env nextRank nextPools state headerCon\n\n          let youngMark = mark\n          let visitMark = nextMark youngMark\n          let finalMark = nextMark visitMark\n\n          -- pop pool\n          generalize youngMark visitMark nextRank nextPools\n          MVector.write nextPools nextRank []\n\n          -- check that things went well\n          mapM_ isGeneric rigids\n\n          let newEnv = Map.union env (Map.map A.toValue locals)\n          let tempState = State savedEnv finalMark errors\n          newState <- solve newEnv rank nextPools tempState subCon\n\n          foldM occurs newState (Map.toList locals)\n\n\n-- Check that a variable has rank == noRank, meaning that it can be generalized.\nisGeneric :: Variable -> IO ()\nisGeneric var =\n  do  (Descriptor _ rank _ _) <- UF.get var\n      if rank == noRank\n        then return ()\n        else\n          do  tipe <- Type.toErrorType var\n              error $\n                \"You ran into a compiler bug. Here are some details for the developers:\\n\\n\"\n                ++ \"    \" ++ show (ET.toDoc L.empty RT.None tipe) ++ \" [rank = \" ++ show rank ++ \"]\\n\\n\"\n                ++\n                  \"Please create an <http://sscce.org/> and then report it\\n\\\n                  \\at <https://github.com/elm/compiler/issues>\\n\\n\"\n\n\n\n-- EXPECTATIONS TO VARIABLE\n\n\nexpectedToVariable :: Int -> Pools -> Error.Expected Type -> IO Variable\nexpectedToVariable rank pools expectation =\n  typeToVariable rank pools $\n    case expectation of\n      Error.NoExpectation tipe ->\n        tipe\n\n      Error.FromContext _ _ tipe ->\n        tipe\n\n      Error.FromAnnotation _ _ _ tipe ->\n        tipe\n\n\npatternExpectationToVariable :: Int -> Pools -> Error.PExpected Type -> IO Variable\npatternExpectationToVariable rank pools expectation =\n  typeToVariable rank pools $\n    case expectation of\n      Error.PNoExpectation tipe ->\n        tipe\n\n      Error.PFromContext _ _ tipe ->\n        tipe\n\n\n\n-- ERROR HELPERS\n\n\naddError :: State -> Error.Error -> State\naddError (State savedEnv rank errors) err =\n  State savedEnv rank (err:errors)\n\n\n\n-- OCCURS CHECK\n\n\noccurs :: State -> (Name.Name, A.Located Variable) -> IO State\noccurs state (name, A.At region variable) =\n  do  hasOccurred <- Occurs.occurs variable\n      if hasOccurred\n        then\n          do  errorType <- Type.toErrorType variable\n              (Descriptor _ rank mark copy) <- UF.get variable\n              UF.set variable (Descriptor Error rank mark copy)\n              return $ addError state (Error.InfiniteType region name errorType)\n        else\n          return state\n\n\n\n-- GENERALIZE\n\n\n{-| Every variable has rank less than or equal to the maxRank of the pool.\nThis sorts variables into the young and old pools accordingly.\n-}\ngeneralize :: Mark -> Mark -> Int -> Pools -> IO ()\ngeneralize youngMark visitMark youngRank pools =\n  do  youngVars <- MVector.read pools youngRank\n      rankTable <- poolToRankTable youngMark youngRank youngVars\n\n      -- get the ranks right for each entry.\n      -- start at low ranks so that we only have to pass\n      -- over the information once.\n      Vector.imapM_\n        (\\rank table -> mapM_ (adjustRank youngMark visitMark rank) table)\n        rankTable\n\n      -- For variables that have rank lowerer than youngRank, register them in\n      -- the appropriate old pool if they are not redundant.\n      Vector.forM_ (Vector.unsafeInit rankTable) $ \\vars ->\n        forM_ vars $ \\var ->\n          do  isRedundant <- UF.redundant var\n              if isRedundant\n                then return ()\n                else\n                  do  (Descriptor _ rank _ _) <- UF.get var\n                      MVector.modify pools (var:) rank\n\n      -- For variables with rank youngRank\n      --   If rank < youngRank: register in oldPool\n      --   otherwise generalize\n      forM_ (Vector.unsafeLast rankTable) $ \\var ->\n        do  isRedundant <- UF.redundant var\n            if isRedundant\n              then return ()\n              else\n                do  (Descriptor content rank mark copy) <- UF.get var\n                    if rank < youngRank\n                      then MVector.modify pools (var:) rank\n                      else UF.set var $ Descriptor content noRank mark copy\n\n\npoolToRankTable :: Mark -> Int -> [Variable] -> IO (Vector.Vector [Variable])\npoolToRankTable youngMark youngRank youngInhabitants =\n  do  mutableTable <- MVector.replicate (youngRank + 1) []\n\n      -- Sort the youngPool variables into buckets by rank.\n      forM_ youngInhabitants $ \\var ->\n        do  (Descriptor content rank _ copy) <- UF.get var\n            UF.set var (Descriptor content rank youngMark copy)\n            MVector.modify mutableTable (var:) rank\n\n      Vector.unsafeFreeze mutableTable\n\n\n\n-- ADJUST RANK\n\n--\n-- Adjust variable ranks such that ranks never increase as you move deeper.\n-- This way the outermost rank is representative of the entire structure.\n--\nadjustRank :: Mark -> Mark -> Int -> Variable -> IO Int\nadjustRank youngMark visitMark groupRank var =\n  do  (Descriptor content rank mark copy) <- UF.get var\n      if mark == youngMark then\n          do  -- Set the variable as marked first because it may be cyclic.\n              UF.set var $ Descriptor content rank visitMark copy\n              maxRank <- adjustRankContent youngMark visitMark groupRank content\n              UF.set var $ Descriptor content maxRank visitMark copy\n              return maxRank\n\n        else if mark == visitMark then\n          return rank\n\n        else\n          do  let minRank = min groupRank rank\n              -- TODO how can minRank ever be groupRank?\n              UF.set var $ Descriptor content minRank visitMark copy\n              return minRank\n\n\nadjustRankContent :: Mark -> Mark -> Int -> Content -> IO Int\nadjustRankContent youngMark visitMark groupRank content =\n  let\n    go = adjustRank youngMark visitMark groupRank\n  in\n    case content of\n      FlexVar _ ->\n          return groupRank\n\n      FlexSuper _ _ ->\n          return groupRank\n\n      RigidVar _ ->\n          return groupRank\n\n      RigidSuper _ _ ->\n          return groupRank\n\n      Structure flatType ->\n        case flatType of\n          App1 _ _ args ->\n            foldM (\\rank arg -> max rank <$> go arg) outermostRank args\n\n          Fun1 arg result ->\n              max <$> go arg <*> go result\n\n          EmptyRecord1 ->\n              -- THEORY: an empty record never needs to get generalized\n              return outermostRank\n\n          Record1 fields extension ->\n              do  extRank <- go extension\n                  foldM (\\rank field -> max rank <$> go field) extRank fields\n\n          Unit1 ->\n              -- THEORY: a unit never needs to get generalized\n              return outermostRank\n\n          Tuple1 a b maybeC ->\n              do  ma <- go a\n                  mb <- go b\n                  case maybeC of\n                    Nothing ->\n                      return (max ma mb)\n\n                    Just c ->\n                      max (max ma mb) <$> go c\n\n      Alias _ _ args _ ->\n          -- THEORY: anything in the realVar would be outermostRank\n          foldM (\\rank (_, argVar) -> max rank <$> go argVar) outermostRank args\n\n      Error ->\n          return groupRank\n\n\n\n-- REGISTER VARIABLES\n\n\nintroduce :: Int -> Pools -> [Variable] -> IO ()\nintroduce rank pools variables =\n  do  MVector.modify pools (variables++) rank\n      forM_ variables $ \\var ->\n        UF.modify var $ \\(Descriptor content _ mark copy) ->\n          Descriptor content rank mark copy\n\n\n\n-- TYPE TO VARIABLE\n\n\ntypeToVariable :: Int -> Pools -> Type -> IO Variable\ntypeToVariable rank pools tipe =\n  typeToVar rank pools Map.empty tipe\n\n\n-- PERF working with @mgriffith we noticed that a 784 line entry in a `let` was\n-- causing a ~1.5 second slowdown. Moving it to the top-level to be a function\n-- saved all that time. The slowdown seems to manifest in `typeToVar` and in\n-- `register` in particular. Have not explored further yet. Top-level definitions\n-- are recommended in cases like this anyway, so there is at least a safety\n-- valve for now.\n--\ntypeToVar :: Int -> Pools -> Map.Map Name.Name Variable -> Type -> IO Variable\ntypeToVar rank pools aliasDict tipe =\n  let go = typeToVar rank pools aliasDict in\n  case tipe of\n    VarN v ->\n      return v\n\n    AppN home name args ->\n      do  argVars <- traverse go args\n          register rank pools (Structure (App1 home name argVars))\n\n    FunN a b ->\n      do  aVar <- go a\n          bVar <- go b\n          register rank pools (Structure (Fun1 aVar bVar))\n\n    AliasN home name args aliasType ->\n      do  argVars <- traverse (traverse go) args\n          aliasVar <- typeToVar rank pools (Map.fromList argVars) aliasType\n          register rank pools (Alias home name argVars aliasVar)\n\n    PlaceHolder name ->\n      return (aliasDict ! name)\n\n    RecordN fields ext ->\n      do  fieldVars <- traverse go fields\n          extVar <- go ext\n          register rank pools (Structure (Record1 fieldVars extVar))\n\n    EmptyRecordN ->\n      register rank pools emptyRecord1\n\n    UnitN ->\n      register rank pools unit1\n\n    TupleN a b c ->\n      do  aVar <- go a\n          bVar <- go b\n          cVar <- traverse go c\n          register rank pools (Structure (Tuple1 aVar bVar cVar))\n\n\nregister :: Int -> Pools -> Content -> IO Variable\nregister rank pools content =\n  do  var <- UF.fresh (Descriptor content rank noMark Nothing)\n      MVector.modify pools (var:) rank\n      return var\n\n\n{-# NOINLINE emptyRecord1 #-}\nemptyRecord1 :: Content\nemptyRecord1 =\n  Structure EmptyRecord1\n\n\n{-# NOINLINE unit1 #-}\nunit1 :: Content\nunit1 =\n  Structure Unit1\n\n\n\n-- SOURCE TYPE TO VARIABLE\n\n\nsrcTypeToVariable :: Int -> Pools -> Map.Map Name.Name () -> Can.Type -> IO Variable\nsrcTypeToVariable rank pools freeVars srcType =\n  let\n    nameToContent name\n      | Name.isNumberType     name = FlexSuper Number (Just name)\n      | Name.isComparableType name = FlexSuper Comparable (Just name)\n      | Name.isAppendableType name = FlexSuper Appendable (Just name)\n      | Name.isCompappendType name = FlexSuper CompAppend (Just name)\n      | otherwise                  = FlexVar (Just name)\n\n    makeVar name _ =\n      UF.fresh (Descriptor (nameToContent name) rank noMark Nothing)\n  in\n  do  flexVars <- Map.traverseWithKey makeVar freeVars\n      MVector.modify pools (Map.elems flexVars ++) rank\n      srcTypeToVar rank pools flexVars srcType\n\n\nsrcTypeToVar :: Int -> Pools -> Map.Map Name.Name Variable -> Can.Type -> IO Variable\nsrcTypeToVar rank pools flexVars srcType =\n  let go = srcTypeToVar rank pools flexVars in\n  case srcType of\n    Can.TLambda argument result ->\n      do  argVar <- go argument\n          resultVar <- go result\n          register rank pools (Structure (Fun1 argVar resultVar))\n\n    Can.TVar name ->\n      return (flexVars ! name)\n\n    Can.TType home name args ->\n      do  argVars <- traverse go args\n          register rank pools (Structure (App1 home name argVars))\n\n    Can.TRecord fields maybeExt ->\n      do  fieldVars <- traverse (srcFieldTypeToVar rank pools flexVars) fields\n          extVar <-\n            case maybeExt of\n              Nothing -> register rank pools emptyRecord1\n              Just ext -> return (flexVars ! ext)\n          register rank pools (Structure (Record1 fieldVars extVar))\n\n    Can.TUnit ->\n      register rank pools unit1\n\n    Can.TTuple a b c ->\n      do  aVar <- go a\n          bVar <- go b\n          cVar <- traverse go c\n          register rank pools (Structure (Tuple1 aVar bVar cVar))\n\n    Can.TAlias home name args aliasType ->\n      do  argVars <- traverse (traverse go) args\n          aliasVar <-\n            case aliasType of\n              Can.Holey tipe ->\n                srcTypeToVar rank pools (Map.fromList argVars) tipe\n\n              Can.Filled tipe ->\n                go tipe\n\n          register rank pools (Alias home name argVars aliasVar)\n\n\nsrcFieldTypeToVar :: Int -> Pools -> Map.Map Name.Name Variable -> Can.FieldType -> IO Variable\nsrcFieldTypeToVar rank pools flexVars (Can.FieldType _ srcTipe) =\n  srcTypeToVar rank pools flexVars srcTipe\n\n\n\n-- COPY\n\n\nmakeCopy :: Int -> Pools -> Variable -> IO Variable\nmakeCopy rank pools var =\n  do  copy <- makeCopyHelp rank pools var\n      restore var\n      return copy\n\n\nmakeCopyHelp :: Int -> Pools -> Variable -> IO Variable\nmakeCopyHelp maxRank pools variable =\n  do  (Descriptor content rank _ maybeCopy) <- UF.get variable\n\n      case maybeCopy of\n        Just copy ->\n          return copy\n\n        Nothing ->\n          if rank /= noRank then\n            return variable\n\n          else\n            do  let makeDescriptor c = Descriptor c maxRank noMark Nothing\n                copy <- UF.fresh $ makeDescriptor content\n                MVector.modify pools (copy:) maxRank\n\n                -- Link the original variable to the new variable. This lets us\n                -- avoid making multiple copies of the variable we are instantiating.\n                --\n                -- Need to do this before recursively copying to avoid looping.\n                UF.set variable $\n                  Descriptor content rank noMark (Just copy)\n\n                -- Now we recursively copy the content of the variable.\n                -- We have already marked the variable as copied, so we\n                -- will not repeat this work or crawl this variable again.\n                case content of\n                  Structure term ->\n                    do  newTerm <- traverseFlatType (makeCopyHelp maxRank pools) term\n                        UF.set copy $ makeDescriptor (Structure newTerm)\n                        return copy\n\n                  FlexVar _ ->\n                    return copy\n\n                  FlexSuper _ _ ->\n                    return copy\n\n                  RigidVar name ->\n                    do  UF.set copy $ makeDescriptor $ FlexVar (Just name)\n                        return copy\n\n                  RigidSuper super name ->\n                    do  UF.set copy $ makeDescriptor $ FlexSuper super (Just name)\n                        return copy\n\n                  Alias home name args realType ->\n                    do  newArgs <- mapM (traverse (makeCopyHelp maxRank pools)) args\n                        newRealType <- makeCopyHelp maxRank pools realType\n                        UF.set copy $ makeDescriptor (Alias home name newArgs newRealType)\n                        return copy\n\n                  Error ->\n                    return copy\n\n\n\n-- RESTORE\n\n\nrestore :: Variable -> IO ()\nrestore variable =\n  do  (Descriptor content _ _ maybeCopy) <- UF.get variable\n      case maybeCopy of\n        Nothing ->\n          return ()\n\n        Just _ ->\n          do  UF.set variable $ Descriptor content noRank noMark Nothing\n              restoreContent content\n\n\nrestoreContent :: Content -> IO ()\nrestoreContent content =\n  case content of\n    FlexVar _ ->\n      return ()\n\n    FlexSuper _ _ ->\n      return ()\n\n    RigidVar _ ->\n      return ()\n\n    RigidSuper _ _ ->\n      return ()\n\n    Structure term ->\n      case term of\n        App1 _ _ args ->\n          mapM_ restore args\n\n        Fun1 arg result ->\n          do  restore arg\n              restore result\n\n        EmptyRecord1 ->\n          return ()\n\n        Record1 fields ext ->\n          do  mapM_ restore fields\n              restore ext\n\n        Unit1 ->\n          return ()\n\n        Tuple1 a b maybeC ->\n          do  restore a\n              restore b\n              case maybeC of\n                Nothing -> return ()\n                Just c  -> restore c\n\n    Alias _ _ args var ->\n      do  mapM_ (traverse restore) args\n          restore var\n\n    Error ->\n        return ()\n\n\n\n-- TRAVERSE FLAT TYPE\n\n\ntraverseFlatType :: (Variable -> IO Variable) -> FlatType -> IO FlatType\ntraverseFlatType f flatType =\n  case flatType of\n    App1 home name args ->\n        liftM (App1 home name) (traverse f args)\n\n    Fun1 a b ->\n        liftM2 Fun1 (f a) (f b)\n\n    EmptyRecord1 ->\n        pure EmptyRecord1\n\n    Record1 fields ext ->\n        liftM2 Record1 (traverse f fields) (f ext)\n\n    Unit1 ->\n        pure Unit1\n\n    Tuple1 a b cs ->\n        liftM3 Tuple1 (f a) (f b) (traverse f cs)\n"
  },
  {
    "path": "compiler/src/Type/Type.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Type.Type\n  ( Constraint(..)\n  , exists\n  , Variable\n  , FlatType(..)\n  , Type(..)\n  , Descriptor(Descriptor)\n  , Content(..)\n  , SuperType(..)\n  , noRank\n  , outermostRank\n  , Mark\n  , noMark\n  , nextMark\n  , (==>)\n  , int, float, char, string, bool, never\n  , vec2, vec3, vec4, mat4, texture\n  , mkFlexVar\n  , mkFlexNumber\n  , unnamedFlexVar\n  , unnamedFlexSuper\n  , nameToFlex\n  , nameToRigid\n  , toAnnotation\n  , toErrorType\n  )\n  where\n\n\nimport Control.Monad.State.Strict (StateT, liftIO)\nimport qualified Control.Monad.State.Strict as State\nimport Data.Foldable (foldrM)\nimport qualified Data.Map.Strict as Map\nimport qualified Data.Name as Name\nimport Data.Word (Word32)\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Utils.Type as Type\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error.Type as E\nimport qualified Type.Error as ET\nimport qualified Type.UnionFind as UF\n\n\n\n-- CONSTRAINTS\n\n\ndata Constraint\n  = CTrue\n  | CSaveTheEnvironment\n  | CEqual A.Region E.Category Type (E.Expected Type)\n  | CLocal A.Region Name.Name (E.Expected Type)\n  | CForeign A.Region Name.Name Can.Annotation (E.Expected Type)\n  | CPattern A.Region E.PCategory Type (E.PExpected Type)\n  | CAnd [Constraint]\n  | CLet\n      { _rigidVars :: [Variable]\n      , _flexVars :: [Variable]\n      , _header :: Map.Map Name.Name (A.Located Type)\n      , _headerCon :: Constraint\n      , _bodyCon :: Constraint\n      }\n\n\nexists :: [Variable] -> Constraint -> Constraint\nexists flexVars constraint =\n  CLet [] flexVars Map.empty constraint CTrue\n\n\n\n-- TYPE PRIMITIVES\n\n\ntype Variable =\n    UF.Point Descriptor\n\n\ndata FlatType\n    = App1 ModuleName.Canonical Name.Name [Variable]\n    | Fun1 Variable Variable\n    | EmptyRecord1\n    | Record1 (Map.Map Name.Name Variable) Variable\n    | Unit1\n    | Tuple1 Variable Variable (Maybe Variable)\n\n\ndata Type\n    = PlaceHolder Name.Name\n    | AliasN ModuleName.Canonical Name.Name [(Name.Name, Type)] Type\n    | VarN Variable\n    | AppN ModuleName.Canonical Name.Name [Type]\n    | FunN Type Type\n    | EmptyRecordN\n    | RecordN (Map.Map Name.Name Type) Type\n    | UnitN\n    | TupleN Type Type (Maybe Type)\n\n\n\n-- DESCRIPTORS\n\n\ndata Descriptor =\n  Descriptor\n    { _content :: Content\n    , _rank :: Int\n    , _mark :: Mark\n    , _copy :: Maybe Variable\n    }\n\n\ndata Content\n    = FlexVar (Maybe Name.Name)\n    | FlexSuper SuperType (Maybe Name.Name)\n    | RigidVar Name.Name\n    | RigidSuper SuperType Name.Name\n    | Structure FlatType\n    | Alias ModuleName.Canonical Name.Name [(Name.Name,Variable)] Variable\n    | Error\n\n\ndata SuperType\n  = Number\n  | Comparable\n  | Appendable\n  | CompAppend\n  deriving (Eq)\n\n\nmakeDescriptor :: Content -> Descriptor\nmakeDescriptor content =\n  Descriptor content noRank noMark Nothing\n\n\n\n-- RANKS\n\n\nnoRank :: Int\nnoRank =\n  0\n\n\noutermostRank :: Int\noutermostRank =\n  1\n\n\n\n-- MARKS\n\n\nnewtype Mark = Mark Word32\n  deriving (Eq, Ord)\n\n\nnoMark :: Mark\nnoMark =\n  Mark 2\n\n\noccursMark :: Mark\noccursMark =\n  Mark 1\n\n\ngetVarNamesMark :: Mark\ngetVarNamesMark =\n  Mark 0\n\n\n{-# INLINE nextMark #-}\nnextMark :: Mark -> Mark\nnextMark (Mark mark) =\n  Mark (mark + 1)\n\n\n\n-- FUNCTION TYPES\n\n\ninfixr 9 ==>\n\n\n{-# INLINE (==>) #-}\n(==>) :: Type -> Type -> Type\n(==>) =\n  FunN\n\n\n\n-- PRIMITIVE TYPES\n\n\n{-# NOINLINE int #-}\nint :: Type\nint = AppN ModuleName.basics \"Int\" []\n\n\n{-# NOINLINE float #-}\nfloat :: Type\nfloat = AppN ModuleName.basics \"Float\" []\n\n\n{-# NOINLINE char #-}\nchar :: Type\nchar = AppN ModuleName.char \"Char\" []\n\n\n{-# NOINLINE string #-}\nstring :: Type\nstring = AppN ModuleName.string \"String\" []\n\n\n{-# NOINLINE bool #-}\nbool :: Type\nbool = AppN ModuleName.basics \"Bool\" []\n\n\n{-# NOINLINE never #-}\nnever :: Type\nnever = AppN ModuleName.basics \"Never\" []\n\n\n\n-- WEBGL TYPES\n\n\n{-# NOINLINE vec2 #-}\nvec2 :: Type\nvec2 = AppN ModuleName.vector2 \"Vec2\" []\n\n\n{-# NOINLINE vec3 #-}\nvec3 :: Type\nvec3 = AppN ModuleName.vector3 \"Vec3\" []\n\n\n{-# NOINLINE vec4 #-}\nvec4 :: Type\nvec4 = AppN ModuleName.vector4 \"Vec4\" []\n\n\n{-# NOINLINE mat4 #-}\nmat4 :: Type\nmat4 = AppN ModuleName.matrix4 \"Mat4\" []\n\n\n{-# NOINLINE texture #-}\ntexture :: Type\ntexture = AppN ModuleName.texture \"Texture\" []\n\n\n\n-- MAKE FLEX VARIABLES\n\n\nmkFlexVar :: IO Variable\nmkFlexVar =\n  UF.fresh flexVarDescriptor\n\n\n{-# NOINLINE flexVarDescriptor #-}\nflexVarDescriptor :: Descriptor\nflexVarDescriptor =\n  makeDescriptor unnamedFlexVar\n\n\n{-# NOINLINE unnamedFlexVar #-}\nunnamedFlexVar :: Content\nunnamedFlexVar =\n  FlexVar Nothing\n\n\n\n-- MAKE FLEX NUMBERS\n\n\nmkFlexNumber :: IO Variable\nmkFlexNumber =\n  UF.fresh flexNumberDescriptor\n\n\n{-# NOINLINE flexNumberDescriptor #-}\nflexNumberDescriptor :: Descriptor\nflexNumberDescriptor =\n  makeDescriptor (unnamedFlexSuper Number)\n\n\nunnamedFlexSuper :: SuperType -> Content\nunnamedFlexSuper super =\n  FlexSuper super Nothing\n\n\n\n-- MAKE NAMED VARIABLES\n\n\nnameToFlex :: Name.Name -> IO Variable\nnameToFlex name =\n  UF.fresh $ makeDescriptor $\n    maybe FlexVar FlexSuper (toSuper name) (Just name)\n\n\nnameToRigid :: Name.Name -> IO Variable\nnameToRigid name =\n  UF.fresh $ makeDescriptor $\n    maybe RigidVar RigidSuper (toSuper name) name\n\n\ntoSuper :: Name.Name -> Maybe SuperType\ntoSuper name =\n  if Name.isNumberType name then\n      Just Number\n\n  else if Name.isComparableType name then\n      Just Comparable\n\n  else if Name.isAppendableType name then\n      Just Appendable\n\n  else if Name.isCompappendType name then\n      Just CompAppend\n\n  else\n      Nothing\n\n\n\n-- TO TYPE ANNOTATION\n\n\ntoAnnotation :: Variable -> IO Can.Annotation\ntoAnnotation variable =\n  do  userNames <- getVarNames variable Map.empty\n      (tipe, NameState freeVars _ _ _ _ _) <-\n        State.runStateT (variableToCanType variable) (makeNameState userNames)\n      return $ Can.Forall freeVars tipe\n\n\nvariableToCanType :: Variable -> StateT NameState IO Can.Type\nvariableToCanType variable =\n  do  (Descriptor content _ _ _) <- liftIO $ UF.get variable\n      case content of\n        Structure term ->\n            termToCanType term\n\n        FlexVar maybeName ->\n          case maybeName of\n            Just name ->\n              return (Can.TVar name)\n\n            Nothing ->\n              do  name <- getFreshVarName\n                  liftIO $ UF.modify variable (\\desc -> desc { _content = FlexVar (Just name) })\n                  return (Can.TVar name)\n\n        FlexSuper super maybeName ->\n          case maybeName of\n            Just name ->\n              return (Can.TVar name)\n\n            Nothing ->\n              do  name <- getFreshSuperName super\n                  liftIO $ UF.modify variable (\\desc -> desc { _content = FlexSuper super (Just name) })\n                  return (Can.TVar name)\n\n        RigidVar name ->\n            return (Can.TVar name)\n\n        RigidSuper _ name ->\n            return (Can.TVar name)\n\n        Alias home name args realVariable ->\n            do  canArgs <- traverse (traverse variableToCanType) args\n                canType <- variableToCanType realVariable\n                return (Can.TAlias home name canArgs (Can.Filled canType))\n\n        Error ->\n            error \"cannot handle Error types in variableToCanType\"\n\n\ntermToCanType :: FlatType -> StateT NameState IO Can.Type\ntermToCanType term =\n  case term of\n    App1 home name args ->\n      Can.TType home name <$> traverse variableToCanType args\n\n    Fun1 a b ->\n      Can.TLambda\n        <$> variableToCanType a\n        <*> variableToCanType b\n\n    EmptyRecord1 ->\n      return $ Can.TRecord Map.empty Nothing\n\n    Record1 fields extension ->\n      do  canFields <- traverse fieldToCanType fields\n          canExt <- Type.iteratedDealias <$> variableToCanType extension\n          return $\n              case canExt of\n                Can.TRecord subFields subExt ->\n                    Can.TRecord (Map.union subFields canFields) subExt\n\n                Can.TVar name ->\n                    Can.TRecord canFields (Just name)\n\n                _ ->\n                    error \"Used toAnnotation on a type that is not well-formed\"\n\n    Unit1 ->\n      return Can.TUnit\n\n    Tuple1 a b maybeC ->\n      Can.TTuple\n        <$> variableToCanType a\n        <*> variableToCanType b\n        <*> traverse variableToCanType maybeC\n\n\nfieldToCanType :: Variable -> StateT NameState IO Can.FieldType\nfieldToCanType variable =\n  do  tipe <- variableToCanType variable\n      return (Can.FieldType 0 tipe)\n\n\n\n-- TO ERROR TYPE\n\n\ntoErrorType :: Variable -> IO ET.Type\ntoErrorType variable =\n  do  userNames <- getVarNames variable Map.empty\n      State.evalStateT (variableToErrorType variable) (makeNameState userNames)\n\n\nvariableToErrorType :: Variable -> StateT NameState IO ET.Type\nvariableToErrorType variable =\n  do  descriptor <- liftIO $ UF.get variable\n      let mark = _mark descriptor\n      if mark == occursMark\n        then\n          return ET.Infinite\n\n        else\n          do  liftIO $ UF.modify variable (\\desc -> desc { _mark = occursMark })\n              errType <- contentToErrorType variable (_content descriptor)\n              liftIO $ UF.modify variable (\\desc -> desc { _mark = mark })\n              return errType\n\n\ncontentToErrorType :: Variable -> Content -> StateT NameState IO ET.Type\ncontentToErrorType variable content =\n  case content of\n    Structure term ->\n        termToErrorType term\n\n    FlexVar maybeName ->\n      case maybeName of\n        Just name ->\n          return (ET.FlexVar name)\n\n        Nothing ->\n          do  name <- getFreshVarName\n              liftIO $ UF.modify variable (\\desc -> desc { _content = FlexVar (Just name) })\n              return (ET.FlexVar name)\n\n    FlexSuper super maybeName ->\n      case maybeName of\n        Just name ->\n          return (ET.FlexSuper (superToSuper super) name)\n\n        Nothing ->\n          do  name <- getFreshSuperName super\n              liftIO $ UF.modify variable (\\desc -> desc { _content = FlexSuper super (Just name) })\n              return (ET.FlexSuper (superToSuper super) name)\n\n    RigidVar name ->\n        return (ET.RigidVar name)\n\n    RigidSuper super name ->\n        return (ET.RigidSuper (superToSuper super) name)\n\n    Alias home name args realVariable ->\n        do  errArgs <- traverse (traverse variableToErrorType) args\n            errType <- variableToErrorType realVariable\n            return (ET.Alias home name errArgs errType)\n\n    Error ->\n        return ET.Error\n\n\nsuperToSuper :: SuperType -> ET.Super\nsuperToSuper super =\n  case super of\n    Number -> ET.Number\n    Comparable -> ET.Comparable\n    Appendable -> ET.Appendable\n    CompAppend -> ET.CompAppend\n\n\ntermToErrorType :: FlatType -> StateT NameState IO ET.Type\ntermToErrorType term =\n  case term of\n    App1 home name args ->\n      ET.Type home name <$> traverse variableToErrorType args\n\n    Fun1 a b ->\n      do  arg <- variableToErrorType a\n          result <- variableToErrorType b\n          return $\n            case result of\n              ET.Lambda arg1 arg2 others ->\n                ET.Lambda arg arg1 (arg2:others)\n\n              _ ->\n                ET.Lambda arg result []\n\n    EmptyRecord1 ->\n      return $ ET.Record Map.empty ET.Closed\n\n    Record1 fields extension ->\n      do  errFields <- traverse variableToErrorType fields\n          errExt <- ET.iteratedDealias <$> variableToErrorType extension\n          return $\n              case errExt of\n                ET.Record subFields subExt ->\n                    ET.Record (Map.union subFields errFields) subExt\n\n                ET.FlexVar ext ->\n                    ET.Record errFields (ET.FlexOpen ext)\n\n                ET.RigidVar ext ->\n                    ET.Record errFields (ET.RigidOpen ext)\n\n                _ ->\n                    error \"Used toErrorType on a type that is not well-formed\"\n\n    Unit1 ->\n      return ET.Unit\n\n    Tuple1 a b maybeC ->\n      ET.Tuple\n        <$> variableToErrorType a\n        <*> variableToErrorType b\n        <*> traverse variableToErrorType maybeC\n\n\n\n-- MANAGE FRESH VARIABLE NAMES\n\n\ndata NameState =\n  NameState\n    { _taken :: Map.Map Name.Name ()\n    , _normals :: Int\n    , _numbers :: Int\n    , _comparables :: Int\n    , _appendables :: Int\n    , _compAppends :: Int\n    }\n\n\nmakeNameState :: Map.Map Name.Name Variable -> NameState\nmakeNameState taken =\n  NameState (Map.map (const ()) taken) 0 0 0 0 0\n\n\n\n-- FRESH VAR NAMES\n\n\ngetFreshVarName :: (Monad m) => StateT NameState m Name.Name\ngetFreshVarName =\n  do  index <- State.gets _normals\n      taken <- State.gets _taken\n      let (name, newIndex, newTaken) = getFreshVarNameHelp index taken\n      State.modify $ \\state -> state { _taken = newTaken, _normals = newIndex }\n      return name\n\n\ngetFreshVarNameHelp :: Int -> Map.Map Name.Name () -> (Name.Name, Int, Map.Map Name.Name ())\ngetFreshVarNameHelp index taken =\n  let\n    name =\n      Name.fromTypeVariableScheme index\n  in\n  if Map.member name taken then\n    getFreshVarNameHelp (index + 1) taken\n  else\n    ( name, index + 1, Map.insert name () taken )\n\n\n\n-- FRESH SUPER NAMES\n\n\ngetFreshSuperName :: (Monad m) => SuperType -> StateT NameState m Name.Name\ngetFreshSuperName super =\n  case super of\n    Number ->\n      getFreshSuper \"number\" _numbers (\\index state -> state { _numbers = index })\n\n    Comparable ->\n      getFreshSuper \"comparable\" _comparables (\\index state -> state { _comparables = index })\n\n    Appendable ->\n      getFreshSuper \"appendable\" _appendables (\\index state -> state { _appendables = index })\n\n    CompAppend ->\n      getFreshSuper \"compappend\" _compAppends (\\index state -> state { _compAppends = index })\n\n\ngetFreshSuper :: (Monad m) => Name.Name -> (NameState -> Int) -> (Int -> NameState -> NameState) -> StateT NameState m Name.Name\ngetFreshSuper prefix getter setter =\n  do  index <- State.gets getter\n      taken <- State.gets _taken\n      let (name, newIndex, newTaken) = getFreshSuperHelp prefix index taken\n      State.modify (\\state -> setter newIndex state { _taken = newTaken })\n      return name\n\n\ngetFreshSuperHelp :: Name.Name -> Int -> Map.Map Name.Name () -> (Name.Name, Int, Map.Map Name.Name ())\ngetFreshSuperHelp prefix index taken =\n  let\n    name =\n      Name.fromTypeVariable prefix index\n  in\n    if Map.member name taken then\n      getFreshSuperHelp prefix (index + 1) taken\n\n    else\n      ( name, index + 1, Map.insert name () taken )\n\n\n\n-- GET ALL VARIABLE NAMES\n\n\ngetVarNames :: Variable -> Map.Map Name.Name Variable -> IO (Map.Map Name.Name Variable)\ngetVarNames var takenNames =\n  do  (Descriptor content rank mark copy) <- UF.get var\n      if mark == getVarNamesMark\n        then return takenNames\n        else\n        do  UF.set var (Descriptor content rank getVarNamesMark copy)\n            case content of\n              Error ->\n                return takenNames\n\n              FlexVar maybeName ->\n                case maybeName of\n                  Nothing ->\n                    return takenNames\n\n                  Just name ->\n                    addName 0 name var (FlexVar . Just) takenNames\n\n              FlexSuper super maybeName ->\n                case maybeName of\n                  Nothing ->\n                    return takenNames\n\n                  Just name ->\n                    addName 0 name var (FlexSuper super . Just) takenNames\n\n              RigidVar name ->\n                addName 0 name var RigidVar takenNames\n\n              RigidSuper super name ->\n                addName 0 name var (RigidSuper super) takenNames\n\n              Alias _ _ args _ ->\n                foldrM getVarNames takenNames (map snd args)\n\n              Structure flatType ->\n                case flatType of\n                  App1 _ _ args ->\n                    foldrM getVarNames takenNames args\n\n                  Fun1 arg body ->\n                    getVarNames arg =<< getVarNames body takenNames\n\n                  EmptyRecord1 ->\n                    return takenNames\n\n                  Record1 fields extension ->\n                    getVarNames extension =<<\n                      foldrM getVarNames takenNames (Map.elems fields)\n\n                  Unit1 ->\n                    return takenNames\n\n                  Tuple1 a b Nothing ->\n                    getVarNames a =<< getVarNames b takenNames\n\n                  Tuple1 a b (Just c) ->\n                    getVarNames a =<< getVarNames b =<< getVarNames c takenNames\n\n\n\n-- REGISTER NAME / RENAME DUPLICATES\n\n\naddName :: Int -> Name.Name -> Variable -> (Name.Name -> Content) -> Map.Map Name.Name Variable -> IO (Map.Map Name.Name Variable)\naddName index givenName var makeContent takenNames =\n  let\n    indexedName =\n      Name.fromTypeVariable givenName index\n  in\n    case Map.lookup indexedName takenNames of\n      Nothing ->\n        do  if indexedName == givenName then return () else\n              UF.modify var $ \\(Descriptor _ rank mark copy) ->\n                Descriptor (makeContent indexedName) rank mark copy\n            return $ Map.insert indexedName var takenNames\n\n      Just otherVar ->\n        do  same <- UF.equivalent var otherVar\n            if same\n              then return takenNames\n              else addName (index + 1) givenName var makeContent takenNames\n"
  },
  {
    "path": "compiler/src/Type/Unify.hs",
    "content": "{-# LANGUAGE OverloadedStrings, Rank2Types #-}\nmodule Type.Unify\n  ( Answer(..)\n  , unify\n  )\n  where\n\n\nimport qualified Data.Map.Strict as Map\nimport qualified Data.Name as Name\n\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Type.Error as Error\nimport qualified Type.Occurs as Occurs\nimport Type.Type as Type\nimport qualified Type.UnionFind as UF\n\n\n\n-- UNIFY\n\n\ndata Answer\n  = Ok [Variable]\n  | Err [Variable] Error.Type Error.Type\n\n\nunify :: Variable -> Variable -> IO Answer\nunify v1 v2 =\n  case guardedUnify v1 v2 of\n    Unify k ->\n      k [] onSuccess $ \\vars () ->\n        do  t1 <- Type.toErrorType v1\n            t2 <- Type.toErrorType v2\n            UF.union v1 v2 errorDescriptor\n            return (Err vars t1 t2)\n\n\nonSuccess :: [Variable] -> () -> IO Answer\nonSuccess vars () =\n  return (Ok vars)\n\n\n{-# NOINLINE errorDescriptor #-}\nerrorDescriptor :: Descriptor\nerrorDescriptor =\n  Descriptor Error noRank noMark Nothing\n\n\n\n-- CPS UNIFIER\n\n\nnewtype Unify a =\n  Unify (forall r.\n    [Variable]\n    -> ([Variable] -> a -> IO r)\n    -> ([Variable] -> () -> IO r)\n    -> IO r\n  )\n\n\ninstance Functor Unify where\n  fmap func (Unify kv) =\n    Unify $ \\vars ok err ->\n      let\n        ok1 vars1 value =\n          ok vars1 (func value)\n      in\n      kv vars ok1 err\n\n\ninstance Applicative Unify where\n  pure a =\n    Unify $ \\vars ok _ ->\n      ok vars a\n\n  (<*>) (Unify kf) (Unify kv) =\n    Unify $ \\vars ok err ->\n      let\n        ok1 vars1 func =\n          let\n            ok2 vars2 value =\n              ok vars2 (func value)\n          in\n          kv vars1 ok2 err\n      in\n      kf vars ok1 err\n\n  (*>) (Unify ka) (Unify kb) =\n    Unify $ \\vars ok err ->\n      let\n        ok1 vars1 _ = kb vars1 ok err\n      in\n      ka vars ok1 err\n\n\ninstance Monad Unify where\n  (>>=) (Unify ka) callback =\n    Unify $ \\vars ok err ->\n      let\n        ok1 vars1 a =\n          case callback a of\n            Unify kb -> kb vars1 ok err\n      in\n      ka vars ok1 err\n\n\nregister :: IO Variable -> Unify Variable\nregister mkVar =\n  Unify $ \\vars ok _ ->\n    do  var <- mkVar\n        ok (var:vars) var\n\n\nmismatch :: Unify a\nmismatch =\n  Unify $ \\vars _ err ->\n    err vars ()\n\n\n\n-- UNIFICATION HELPERS\n\n\ndata Context =\n  Context\n    { _first :: Variable\n    , _firstDesc :: Descriptor\n    , _second :: Variable\n    , _secondDesc :: Descriptor\n    }\n\n\nreorient :: Context -> Context\nreorient (Context var1 desc1 var2 desc2) =\n  Context var2 desc2 var1 desc1\n\n\n\n-- MERGE\n\n\nmerge :: Context -> Content -> Unify ()\nmerge (Context var1 (Descriptor _ rank1 _ _) var2 (Descriptor _ rank2 _ _)) content =\n  Unify $ \\vars ok _ ->\n    ok vars =<<\n      UF.union var1 var2 (Descriptor content (min rank1 rank2) noMark Nothing)\n\n\nfresh :: Context -> Content -> Unify Variable\nfresh (Context _ (Descriptor _ rank1 _ _) _ (Descriptor _ rank2 _ _)) content =\n  register $ UF.fresh $\n    Descriptor content (min rank1 rank2) noMark Nothing\n\n\n\n-- ACTUALLY UNIFY THINGS\n\n\nguardedUnify :: Variable -> Variable -> Unify ()\nguardedUnify left right =\n  Unify $ \\vars ok err ->\n    do  equivalent <- UF.equivalent left right\n        if equivalent\n          then ok vars ()\n          else\n            do  leftDesc <- UF.get left\n                rightDesc <- UF.get right\n                case actuallyUnify (Context left leftDesc right rightDesc) of\n                  Unify k ->\n                    k vars ok err\n\n\nsubUnify :: Variable -> Variable -> Unify ()\nsubUnify var1 var2 =\n  guardedUnify var1 var2\n\n\nactuallyUnify :: Context -> Unify ()\nactuallyUnify context@(Context _ (Descriptor firstContent _ _ _) _ (Descriptor secondContent _ _ _)) =\n  case firstContent of\n    FlexVar _ ->\n        unifyFlex context firstContent secondContent\n\n    FlexSuper super _ ->\n        unifyFlexSuper context super firstContent secondContent\n\n    RigidVar _ ->\n        unifyRigid context Nothing firstContent secondContent\n\n    RigidSuper super _ ->\n        unifyRigid context (Just super) firstContent secondContent\n\n    Alias home name args realVar ->\n        unifyAlias context home name args realVar secondContent\n\n    Structure flatType ->\n        unifyStructure context flatType firstContent secondContent\n\n    Error ->\n        -- If there was an error, just pretend it is okay. This lets us avoid\n        -- \"cascading\" errors where one problem manifests as multiple message.\n        merge context Error\n\n\n\n-- UNIFY FLEXIBLE VARIABLES\n\n\nunifyFlex :: Context -> Content -> Content -> Unify ()\nunifyFlex context content otherContent =\n  case otherContent of\n    Error ->\n        merge context Error\n\n    FlexVar maybeName ->\n        merge context $\n          case maybeName of\n            Nothing ->\n              content\n\n            Just _ ->\n              otherContent\n\n    FlexSuper _ _ ->\n        merge context otherContent\n\n    RigidVar _ ->\n        merge context otherContent\n\n    RigidSuper _ _ ->\n        merge context otherContent\n\n    Alias _ _ _ _ ->\n        merge context otherContent\n\n    Structure _ ->\n        merge context otherContent\n\n\n\n-- UNIFY RIGID VARIABLES\n\n\nunifyRigid :: Context -> Maybe SuperType -> Content -> Content -> Unify ()\nunifyRigid context maybeSuper content otherContent =\n  case otherContent of\n    FlexVar _ ->\n        merge context content\n\n    FlexSuper otherSuper _ ->\n        case maybeSuper of\n          Just super ->\n            if combineRigidSupers super otherSuper then\n              merge context content\n            else\n              mismatch\n\n          Nothing ->\n            mismatch\n\n    RigidVar _ ->\n        mismatch\n\n    RigidSuper _ _ ->\n        mismatch\n\n    Alias _ _ _ _ ->\n        mismatch\n\n    Structure _ ->\n        mismatch\n\n    Error ->\n        merge context Error\n\n\n\n-- UNIFY SUPER VARIABLES\n\n\nunifyFlexSuper :: Context -> SuperType -> Content -> Content -> Unify ()\nunifyFlexSuper context super content otherContent =\n  case otherContent of\n    Structure flatType ->\n        unifyFlexSuperStructure context super flatType\n\n    RigidVar _ ->\n        mismatch\n\n    RigidSuper otherSuper _ ->\n        if combineRigidSupers otherSuper super then\n            merge context otherContent\n        else\n            mismatch\n\n    FlexVar _ ->\n        merge context content\n\n    FlexSuper otherSuper _ ->\n      case super of\n        Number ->\n          case otherSuper of\n            Number     -> merge context content\n            Comparable -> merge context content\n            Appendable -> mismatch\n            CompAppend -> mismatch\n\n        Comparable ->\n          case otherSuper of\n            Comparable -> merge context otherContent\n            Number     -> merge context otherContent\n            Appendable -> merge context (Type.unnamedFlexSuper CompAppend)\n            CompAppend -> merge context otherContent\n\n        Appendable ->\n          case otherSuper of\n            Appendable -> merge context otherContent\n            Comparable -> merge context (Type.unnamedFlexSuper CompAppend)\n            CompAppend -> merge context otherContent\n            Number     -> mismatch\n\n        CompAppend ->\n          case otherSuper of\n            Comparable -> merge context content\n            Appendable -> merge context content\n            CompAppend -> merge context content\n            Number     -> mismatch\n\n    Alias _ _ _ realVar ->\n        subUnify (_first context) realVar\n\n    Error ->\n        merge context Error\n\n\ncombineRigidSupers :: SuperType -> SuperType -> Bool\ncombineRigidSupers rigid flex =\n  rigid == flex\n  || (rigid == Number && flex == Comparable)\n  || (rigid == CompAppend && (flex == Comparable || flex == Appendable))\n\n\natomMatchesSuper :: SuperType -> ModuleName.Canonical -> Name.Name -> Bool\natomMatchesSuper super home name =\n  case super of\n    Number ->\n      isNumber home name\n\n    Comparable ->\n      isNumber home name\n      || Error.isString home name\n      || Error.isChar home name\n\n    Appendable ->\n      Error.isString home name\n\n    CompAppend ->\n      Error.isString home name\n\n\nisNumber :: ModuleName.Canonical -> Name.Name -> Bool\nisNumber home name =\n  home == ModuleName.basics\n  &&\n  (name == Name.int || name == Name.float)\n\n\nunifyFlexSuperStructure :: Context -> SuperType -> FlatType -> Unify ()\nunifyFlexSuperStructure context super flatType =\n  case flatType of\n    App1 home name [] ->\n      if atomMatchesSuper super home name then\n        merge context (Structure flatType)\n      else\n        mismatch\n\n    App1 home name [variable] | home == ModuleName.list && name == Name.list ->\n      case super of\n        Number ->\n            mismatch\n\n        Appendable ->\n            merge context (Structure flatType)\n\n        Comparable ->\n            do  comparableOccursCheck context\n                unifyComparableRecursive variable\n                merge context (Structure flatType)\n\n        CompAppend ->\n            do  comparableOccursCheck context\n                unifyComparableRecursive variable\n                merge context (Structure flatType)\n\n    Tuple1 a b maybeC ->\n      case super of\n        Number ->\n            mismatch\n\n        Appendable ->\n            mismatch\n\n        Comparable ->\n            do  comparableOccursCheck context\n                unifyComparableRecursive a\n                unifyComparableRecursive b\n                case maybeC of\n                  Nothing -> return ()\n                  Just c  -> unifyComparableRecursive c\n                merge context (Structure flatType)\n\n        CompAppend ->\n            mismatch\n\n    _ ->\n      mismatch\n\n\n-- TODO: is there some way to avoid doing this?\n-- Do type classes require occurs checks?\ncomparableOccursCheck :: Context -> Unify ()\ncomparableOccursCheck (Context _ _ var _) =\n  Unify $ \\vars ok err ->\n    do  hasOccurred <- Occurs.occurs var\n        if hasOccurred\n          then err vars ()\n          else ok vars ()\n\n\nunifyComparableRecursive :: Variable -> Unify ()\nunifyComparableRecursive var =\n  do  compVar <- register $\n        do  (Descriptor _ rank _ _) <- UF.get var\n            UF.fresh $ Descriptor (Type.unnamedFlexSuper Comparable) rank noMark Nothing\n      guardedUnify compVar var\n\n\n\n-- UNIFY ALIASES\n\n\nunifyAlias :: Context -> ModuleName.Canonical -> Name.Name -> [(Name.Name, Variable)] -> Variable -> Content -> Unify ()\nunifyAlias context home name args realVar otherContent =\n  case otherContent of\n    FlexVar _ ->\n      merge context (Alias home name args realVar)\n\n    FlexSuper _ _ ->\n      subUnify realVar (_second context)\n\n    RigidVar _ ->\n      subUnify realVar (_second context)\n\n    RigidSuper _ _ ->\n      subUnify realVar (_second context)\n\n    Alias otherHome otherName otherArgs otherRealVar ->\n      if name == otherName && home == otherHome then\n        Unify $ \\vars ok err ->\n          let\n            ok1 vars1 () =\n              case merge context otherContent of\n                Unify k ->\n                  k vars1 ok err\n          in\n          unifyAliasArgs vars context args otherArgs ok1 err\n\n      else\n        subUnify realVar otherRealVar\n\n    Structure _ ->\n      subUnify realVar (_second context)\n\n    Error ->\n      merge context Error\n\n\nunifyAliasArgs :: [Variable] -> Context -> [(Name.Name,Variable)] -> [(Name.Name,Variable)] -> ([Variable] -> () -> IO r) -> ([Variable] -> () -> IO r) -> IO r\nunifyAliasArgs vars context args1 args2 ok err =\n  case args1 of\n    (_,arg1):others1 ->\n      case args2 of\n        (_,arg2):others2 ->\n          case subUnify arg1 arg2 of\n            Unify k ->\n              k vars\n                (\\vs () -> unifyAliasArgs vs context others1 others2 ok err)\n                (\\vs () -> unifyAliasArgs vs context others1 others2 err err)\n\n        _ ->\n          err vars ()\n\n    [] ->\n      case args2 of\n        [] ->\n          ok vars ()\n\n        _ ->\n          err vars ()\n\n\n\n-- UNIFY STRUCTURES\n\n\nunifyStructure :: Context -> FlatType -> Content -> Content -> Unify ()\nunifyStructure context flatType content otherContent =\n  case otherContent of\n    FlexVar _ ->\n        merge context content\n\n    FlexSuper super _ ->\n        unifyFlexSuperStructure (reorient context) super flatType\n\n    RigidVar _ ->\n        mismatch\n\n    RigidSuper _ _ ->\n        mismatch\n\n    Alias _ _ _ realVar ->\n        subUnify (_first context) realVar\n\n    Structure otherFlatType ->\n        case (flatType, otherFlatType) of\n          (App1 home name args, App1 otherHome otherName otherArgs) | home == otherHome && name == otherName ->\n              Unify $ \\vars ok err ->\n                let\n                  ok1 vars1 () =\n                    case merge context otherContent of\n                      Unify k ->\n                        k vars1 ok err\n                in\n                unifyArgs vars context args otherArgs ok1 err\n\n          (Fun1 arg1 res1, Fun1 arg2 res2) ->\n              do  subUnify arg1 arg2\n                  subUnify res1 res2\n                  merge context otherContent\n\n          (EmptyRecord1, EmptyRecord1) ->\n              merge context otherContent\n\n          (Record1 fields ext, EmptyRecord1) | Map.null fields ->\n              subUnify ext (_second context)\n\n          (EmptyRecord1, Record1 fields ext) | Map.null fields ->\n              subUnify (_first context) ext\n\n          (Record1 fields1 ext1, Record1 fields2 ext2) ->\n              Unify $ \\vars ok err ->\n                do  structure1 <- gatherFields fields1 ext1\n                    structure2 <- gatherFields fields2 ext2\n                    case unifyRecord context structure1 structure2 of\n                      Unify k ->\n                        k vars ok err\n\n          (Tuple1 a b Nothing, Tuple1 x y Nothing) ->\n              do  subUnify a x\n                  subUnify b y\n                  merge context otherContent\n\n          (Tuple1 a b (Just c), Tuple1 x y (Just z)) ->\n              do  subUnify a x\n                  subUnify b y\n                  subUnify c z\n                  merge context otherContent\n\n          (Unit1, Unit1) ->\n              merge context otherContent\n\n          _ ->\n              mismatch\n\n    Error ->\n        merge context Error\n\n\n\n-- UNIFY ARGS\n\n\nunifyArgs :: [Variable] -> Context -> [Variable] -> [Variable] -> ([Variable] -> () -> IO r) -> ([Variable] -> () -> IO r) -> IO r\nunifyArgs vars context args1 args2 ok err =\n  case args1 of\n    arg1:others1 ->\n      case args2 of\n        arg2:others2 ->\n          case subUnify arg1 arg2 of\n            Unify k ->\n              k vars\n                (\\vs () -> unifyArgs vs context others1 others2 ok err)\n                (\\vs () -> unifyArgs vs context others1 others2 err err)\n\n        _ ->\n          err vars ()\n\n    [] ->\n      case args2 of\n        [] ->\n          ok vars ()\n\n        _ ->\n          err vars ()\n\n\n\n-- UNIFY RECORDS\n\n\nunifyRecord :: Context -> RecordStructure -> RecordStructure -> Unify ()\nunifyRecord context (RecordStructure fields1 ext1) (RecordStructure fields2 ext2) =\n  let\n    sharedFields = Map.intersectionWith (,) fields1 fields2\n    uniqueFields1 = Map.difference fields1 fields2\n    uniqueFields2 = Map.difference fields2 fields1\n  in\n  if Map.null uniqueFields1 then\n\n    if Map.null uniqueFields2 then\n      do  subUnify ext1 ext2\n          unifySharedFields context sharedFields Map.empty ext1\n\n    else\n      do  subRecord <- fresh context (Structure (Record1 uniqueFields2 ext2))\n          subUnify ext1 subRecord\n          unifySharedFields context sharedFields Map.empty subRecord\n\n  else\n\n    if Map.null uniqueFields2 then\n      do  subRecord <- fresh context (Structure (Record1 uniqueFields1 ext1))\n          subUnify subRecord ext2\n          unifySharedFields context sharedFields Map.empty subRecord\n\n    else\n      do  let otherFields = Map.union uniqueFields1 uniqueFields2\n          ext <- fresh context Type.unnamedFlexVar\n          sub1 <- fresh context (Structure (Record1 uniqueFields1 ext))\n          sub2 <- fresh context (Structure (Record1 uniqueFields2 ext))\n          subUnify ext1 sub2\n          subUnify sub1 ext2\n          unifySharedFields context sharedFields otherFields ext\n\n\nunifySharedFields :: Context -> Map.Map Name.Name (Variable, Variable) -> Map.Map Name.Name Variable -> Variable -> Unify ()\nunifySharedFields context sharedFields otherFields ext =\n  do  matchingFields <- Map.traverseMaybeWithKey unifyField sharedFields\n      if Map.size sharedFields == Map.size matchingFields\n        then merge context (Structure (Record1 (Map.union matchingFields otherFields) ext))\n        else mismatch\n\n\nunifyField :: Name.Name -> (Variable, Variable) -> Unify (Maybe Variable)\nunifyField _ (actual, expected) =\n  Unify $ \\vars ok _ ->\n    case subUnify actual expected of\n      Unify k ->\n        k vars\n          (\\vs () -> ok vs (Just actual))\n          (\\vs () -> ok vs Nothing)\n\n\n\n-- GATHER RECORD STRUCTURE\n\n\ndata RecordStructure =\n  RecordStructure\n    { _fields :: Map.Map Name.Name Variable\n    , _extension :: Variable\n    }\n\n\ngatherFields :: Map.Map Name.Name Variable -> Variable -> IO RecordStructure\ngatherFields fields variable =\n  do  (Descriptor content _ _ _) <- UF.get variable\n      case content of\n        Structure (Record1 subFields subExt) ->\n            gatherFields (Map.union fields subFields) subExt\n\n        Alias _ _ _ var ->\n            -- TODO may be dropping useful alias info here\n            gatherFields fields var\n\n        _ ->\n            return (RecordStructure fields variable)\n\n"
  },
  {
    "path": "compiler/src/Type/UnionFind.hs",
    "content": "{-# OPTIONS_GHC -funbox-strict-fields #-}\n{-# LANGUAGE BangPatterns #-}\nmodule Type.UnionFind\n  ( Point\n  , fresh\n  , union\n  , equivalent\n  , redundant\n  , get\n  , set\n  , modify\n  )\n  where\n\n\n{- This is based on the following implementations:\n\n  - https://hackage.haskell.org/package/union-find-0.2/docs/src/Data-UnionFind-IO.html\n  - http://yann.regis-gianas.org/public/mini/code_UnionFind.html\n\nIt seems like the OCaml one came first, but I am not sure.\n\nCompared to the Haskell implementation, the major changes here include:\n\n  1. No more reallocating PointInfo when changing the weight\n  2. Using the strict modifyIORef\n\n-}\n\n\nimport Control.Monad ( when )\nimport Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef)\nimport Data.Word (Word32)\n\n\n\n-- POINT\n\n\nnewtype Point a =\n  Pt (IORef (PointInfo a))\n  deriving Eq\n\n\ndata PointInfo a\n  = Info {-# UNPACK #-} !(IORef Word32) {-# UNPACK #-} !(IORef a)\n  | Link {-# UNPACK #-} !(Point a)\n\n\n\n-- HELPERS\n\n\nfresh :: a -> IO (Point a)\nfresh value =\n  do  weight <- newIORef 1\n      desc <- newIORef value\n      link <- newIORef (Info weight desc)\n      return (Pt link)\n\n\nrepr :: Point a -> IO (Point a)\nrepr point@(Pt ref) =\n  do  pInfo <- readIORef ref\n      case pInfo of\n        Info _ _ ->\n          return point\n\n        Link point1@(Pt ref1) ->\n          do  point2 <- repr point1\n              when (point2 /= point1) $\n                do  pInfo1 <- readIORef ref1\n                    writeIORef ref pInfo1\n              return point2\n\n\nget :: Point a -> IO a\nget point@(Pt ref) =\n  do  pInfo <- readIORef ref\n      case pInfo of\n        Info _ descRef ->\n          readIORef descRef\n\n        Link (Pt ref1) ->\n          do  link' <- readIORef ref1\n              case link' of\n                Info _ descRef ->\n                  readIORef descRef\n\n                Link _ ->\n                  get =<< repr point\n\n\nset :: Point a -> a -> IO ()\nset point@(Pt ref) newDesc =\n  do  pInfo <- readIORef ref\n      case pInfo of\n        Info _ descRef ->\n          writeIORef descRef newDesc\n\n        Link (Pt ref1) ->\n          do  link' <- readIORef ref1\n              case link' of\n                Info _ descRef ->\n                  writeIORef descRef newDesc\n\n                Link _ ->\n                  do  newPoint <- repr point\n                      set newPoint newDesc\n\n\nmodify :: Point a -> (a -> a) -> IO ()\nmodify point@(Pt ref) func =\n  do  pInfo <- readIORef ref\n      case pInfo of\n        Info _ descRef ->\n          modifyIORef' descRef func\n\n        Link (Pt ref1) ->\n          do  link' <- readIORef ref1\n              case link' of\n                Info _ descRef ->\n                  modifyIORef' descRef func\n\n                Link _ ->\n                  do  newPoint <- repr point\n                      modify newPoint func\n\n\nunion :: Point a -> Point a -> a -> IO ()\nunion p1 p2 newDesc =\n  do  point1@(Pt ref1) <- repr p1\n      point2@(Pt ref2) <- repr p2\n\n      Info w1 d1 <- readIORef ref1\n      Info w2 d2 <- readIORef ref2\n\n      if point1 == point2\n        then writeIORef d1 newDesc\n        else do\n          weight1 <- readIORef w1\n          weight2 <- readIORef w2\n\n          let !newWeight = weight1 + weight2\n\n          if weight1 >= weight2\n            then\n              do  writeIORef ref2 (Link point1)\n                  writeIORef w1 newWeight\n                  writeIORef d1 newDesc\n            else\n              do  writeIORef ref1 (Link point2)\n                  writeIORef w2 newWeight\n                  writeIORef d2 newDesc\n\n\nequivalent :: Point a -> Point a -> IO Bool\nequivalent p1 p2 =\n  do  v1 <- repr p1\n      v2 <- repr p2\n      return (v1 == v2)\n\n\nredundant :: Point a -> IO Bool\nredundant (Pt ref) =\n  do  pInfo <- readIORef ref\n      case pInfo of\n        Info _ _ ->\n          return False\n\n        Link _ ->\n          return True\n"
  },
  {
    "path": "docs/elm.json/application.md",
    "content": "# `elm.json` for applications\n\nThis is a decent baseline for pretty much any applications made with Elm. You will need these dependencies or more.\n\n```json\n{\n    \"type\": \"application\",\n    \"source-directories\": [\n        \"src\"\n    ],\n    \"elm-version\": \"0.19.1\",\n    \"dependencies\": {\n        \"direct\": {\n            \"elm/browser\": \"1.0.0\",\n            \"elm/core\": \"1.0.0\",\n            \"elm/html\": \"1.0.0\",\n            \"elm/json\": \"1.0.0\"\n        },\n        \"indirect\": {\n            \"elm/time\": \"1.0.0\",\n            \"elm/url\": \"1.0.0\",\n            \"elm/virtual-dom\": \"1.0.0\"\n        }\n    },\n    \"test-dependencies\": {\n        \"direct\": {},\n        \"indirect\": {}\n    }\n}\n```\n\n<br>\n\n\n## `\"type\"`\n\nEither `\"application\"` or `\"package\"`. All the other fields are based on this choice!\n\n<br>\n\n\n## `\"source-directories\"`\n\nA list of directories where Elm code lives. Most projects just use `\"src\"` for everything.\n\n<br>\n\n\n## `\"elm-version\"`\n\nThe exact version of Elm this builds with. Should be `\"0.19.1\"` for most people!\n\n<br>\n\n\n## `\"dependencies\"`\n\nAll the packages you depend upon. We use exact versions, so your `elm.json` file doubles as a \"lock file\" that ensures reliable builds.\n\nYou can use modules from any `\"direct\"` dependency in your code. Some `\"direct\"` dependencies have their own dependencies that folks typically do not care about. These are the `\"indirect\"` dependencies. They are listed explicitly so that (1) builds are reproducible and (2) you can easily review the quantity and quality of dependencies.\n\n**Note:** We plan to eventually have a screen in `reactor` that helps add, remove, and upgrade packages. It can sometimes be tricky to keep all of the constraints happy, so we think having a UI will help a lot. If you get into trouble in the meantime, adding things back one-by-one often helps, and I hope you do not get into trouble!\n\n<br>\n\n\n## `\"test-dependencies\"`\n\nAll the packages that you use in `tests/` with `elm-test` but not in the application you actually want to ship. This also uses exact versions to make tests more reliable.\n"
  },
  {
    "path": "docs/elm.json/package.md",
    "content": "# `elm.json` for packages\n\nThis is roughly `elm.json` for the `elm/json` package:\n\n```json\n{\n    \"type\": \"package\",\n    \"name\": \"elm/json\",\n    \"summary\": \"Encode and decode JSON values\",\n    \"license\": \"BSD-3-Clause\",\n    \"version\": \"1.0.0\",\n    \"exposed-modules\": [\n        \"Json.Decode\",\n        \"Json.Encode\"\n    ],\n    \"elm-version\": \"0.19.0 <= v < 0.20.0\",\n    \"dependencies\": {\n        \"elm/core\": \"1.0.0 <= v < 2.0.0\"\n    },\n    \"test-dependencies\": {}\n}\n```\n\n<br>\n\n\n## `\"type\"`\n\nEither `\"application\"` or `\"package\"`. All the other fields are based on this choice.\n\n<br>\n\n\n## `\"name\"`\n\nThe name of a GitHub repo like `\"elm-lang/core\"` or `\"rtfeldman/elm-css\"`.\n\n> **Note:** We currently only support GitHub repos to ensure that there are no author name collisions. This seems like a pretty tricky problem to solve in a pleasant way. For example, do we have to keep an author name registry and give them out as we see them? But if someone is the same person on two platforms? And how to make this all happen in a way this is really nice for typical Elm users? Etc. So adding other hosting endpoints is harder than it sounds.\n\n<br>\n\n\n## `\"summary\"`\n\nA short summary that will appear on [`package.elm-lang.org`](https://package.elm-lang.org/) that describes what the package is for. Must be under 80 characters.\n\n<br>\n\n\n## `\"license\"`\n\nAn OSI approved SPDX code like `\"BSD-3-Clause\"` or `\"MIT\"`. These are the two most common licenses in the Elm ecosystem, and BSD-3-Clause is a good default. But you can see the full list of options [here](https://spdx.org/licenses/).\n\n<br>\n\n\n## `\"version\"`\n\nAll packages start at `\"1.0.0\"` and from there, Elm automatically enforces semantic versioning by comparing API changes.\n\nSo if you make a PATCH change and call `elm bump` it will update you to `\"1.0.1\"`. And if you then decide to remove a function (a MAJOR change) and call `elm bump` it will update you to `\"2.0.0\"`. Etc.\n\n<br>\n\n\n## `\"exposed-modules\"`\n\nA list of modules that will be exposed to people using your package. The order you list them will be the order they appear on [`package.elm-lang.org`](https://package.elm-lang.org/).\n\n**Note:** If you have five or more modules, you can use a labelled list like [this](https://github.com/elm-lang/core/blob/master/elm.json). We show the labels on the package website to help people sort through larger packages with distinct categories. Labels must be under 20 characters.\n\n<br>\n\n\n## `\"elm-version\"`\n\nThe range of Elm compilers that work with your package. Right now `\"0.19.0 <= v < 0.20.0\"` is always what you want for this.\n\n<br>\n\n\n## `\"dependencies\"`\n\nA list of packages that you depend upon. In each application, there can only be one version of each package, so wide ranges are great. Fewer dependencies is even better though!\n\n> **Note:** Dependency ranges should only express _tested_ ranges. It is not nice to use optimistic ranges and end up causing build failures for your users down the line. Eventually we would like to have an automated system that tries to build and test packages as new packages come out. If it all works, we could send a PR to the author widening the range.\n\n<br>\n\n\n## `\"test-dependencies\"`\n\nDependencies that are only used in the `tests/` directory by `elm test`. Values from these packages will not appear in any final build artifacts.\n"
  },
  {
    "path": "docs/upgrade-instructions/0.16.md",
    "content": "# Upgrading to 0.16\n\nUpgrading should be pretty easy. Everything is quite mechanical, so I would not be very afraid of this process.\n\n\n## Update elm-package.json\n\nFirst thing you want to do is update your `elm-package.json` file. The fields that need work are `repository`, `elm-version`, and `dependencies`.\n\nIf you have some dummy information in `repository`, something like `https://github.com/USER/PROJECT.git`, you will need to change it such that the project is all lower case. This should work: `https://github.com/user/project.git`.\n\nHere is a working `elm-version`:\n\n```json\n{\n    \"elm-version\": \"0.16.0 <= v < 0.17.0\"\n}\n```\n\nHere are the latest bounds for a bunch of `dependencies`.\n\n```json\n{\n    \"dependencies\": {\n        \"elm-lang/core\": \"3.0.0 <= v < 4.0.0\",\n        \"evancz/elm-effects\": \"2.0.1 <= v < 3.0.0\",\n        \"evancz/elm-html\": \"4.0.2 <= v < 5.0.0\",\n        \"evancz/elm-http\": \"3.0.0 <= v < 4.0.0\",\n        \"evancz/elm-markdown\": \"2.0.0 <= v < 3.0.0\",\n        \"evancz/elm-svg\": \"2.0.1 <= v < 3.0.0\",\n        \"evancz/start-app\": \"2.0.2 <= v < 3.0.0\"\n    },\n}\n```\n\nThe easiest way to get this all set up is to remove everything from `dependencies` and just install the things you need one at a time with `elm-package install`.\n\n\n## Updating Syntax\n\nThe major syntax changes are:\n\n\n<table>\n  <tr>\n    <th>feature</th>\n    <th>0.15.1</th> \n    <th>0.16</th>\n  </tr>\n\n  <tr>\n    <td>field update</td>\n    <td><pre lang=\"elm\">{ record | x <- 42 }</pre></td>\n    <td><pre lang=\"elm\">{ record | x = 42 }</pre></td>\n  </tr>\n\n  <tr>\n    <td>field addition</td>\n    <td><pre lang=\"elm\">{ record | x = 42 }</pre></td>\n    <td>removed</td>\n  </tr>\n\n  <tr>\n    <td>field deletion</td>\n    <td><pre lang=\"elm\">{ record - x }</pre></td>\n    <td>removed</td>\n  </tr>\n\n  <tr>\n    <td>record constructors that add fields</td>\n    <td>\n<pre lang=\"elm\">\ntype alias Named r =\n  { r | name : String }\n  \n-- generates a function like this:\n-- Named : String -> r -> Named r\n</pre>\n    </td>\n    <td>\n<pre lang=\"elm\">\ntype alias Named r =\n  { r | name : String }\n</pre>\nGenerates no function. Field addition is gone. A function\nwill still be generated for \"closed\" records though.\n    </td>\n  </tr>\n\n  <tr>\n    <td>field parameters</td>\n    <td>\n<pre lang=\"elm\">\ntype alias Foo =\n  { prefix : String -> String }\n\nfoo : Foo\nfoo = { prefix x = \"prefix\" ++ x }\n</pre>\n    </td>\n    <td>\n<pre lang=\"elm\">\ntype alias Foo =\n  { prefix : String -> String }\n\nfoo : Foo\nfoo = { prefix = \\x-> \"prefix\" ++ x }\n    </td>\n  </tr>\n\n  <tr>\n    <td>multi-way if</td>\n    <td>\n<pre lang=\"elm\">\nif | x < 0 -> \"left\"\n   | x > 0 -> \"right\"\n   | otherwise -> \"neither\"\n</pre>\n    </td>\n    <td>\n<pre lang=\"elm\">\nif x < 0 then\n    \"left\"\n\nelse if x > 0 then\n    \"right\"\n\nelse\n    \"neither\"\n</pre>\n    </td>\n  </tr>\n</table>\n\nThe most common by far should be the record update change. That was the only syntax that used the `<-` operator, so you can pretty safely do a find-and-replace from `<-` to `=` and be all set.\n\nThe multi-way if is also pretty easy. You just translate it into the equivalent `if/then/else` construct. As you are doing this, notice the style used. It should look quite a bit like Python or any C-like language really. You start with an `if` and do `else if` until you are done. The body of each branch should be indented and things look way nicer if you have a blank line between each branch. I sometimes put a blank line above and below each branch, especially when the branch is more complex.\n\nIf you are using field addition and deletion, it is possible to translate your code into:\n\n  1. A union type that models things with a simpler API, like [in this case](https://github.com/elm-lang/elm-compiler/issues/985#issuecomment-121927230).\n  2. Nesting records instead of adding things onto them. Rather than adding a field, create an outer record that contains a field for the two things you are trying to put together. This seems to lead to nicer code in the long run.\n\n\n## Incomplete Pattern Matches\n\nAs of 0.16, incomplete pattern matches are caught at compile time as errors. This is true both of `case` expressions and function arguments.\n\nAs I updated things, I ran into this only when I had been tricky with `Maybe` and `List` where I knew something about their structure based on some incidental details. The nicest example of this was [some code in package.elm-lang.org](https://gist.github.com/evancz/e590750a5bd1ea04c2d2) where the priority has often been \"get it working\" over \"excellent quality code\".\n\nThe compiler should give you pretty nice hints in all these cases, so I think the best advice is just to expect this sort of thing and treat it as an oppurtunity to clean your code up a bit where you were being tricky.\n\n\n## Updating Library Usages\n\nThere is not actually a lot that changed in `elm-lang/core` and in `evancz/*` libraries.\n\nThe most noticable removals will be:\n\n  * `Basics.otherwise`\n  * `Signal.(<~)`\n  * `Signal.(~)`\n\n`otherwise` is gone because it is very useless without the multi-way if syntax.\n\nRemoving `(<~)` and `(~)` is in the spirit of \"infix functions should be avoided\" and the overall move towards removing redundant and ugly syntax in this release. You can instead use `Signal.mapN` to fill the void here. If you are combining a ton of signals, you can redefine the equivalent of `(~)` like this:\n\n```elm\nandMap : Signal (a -> b) -> Signal a -> Signal b\nandMap =\n  Signal.map2 (<|)\n```\n\nOtherwise it is pretty much all small bug fixes and improvements to documentation.\n"
  },
  {
    "path": "docs/upgrade-instructions/0.17.md",
    "content": "\n# Upgrading to 0.17\n\nUpgrading should be pretty easy. Everything is quite mechanical, so I would not be very afraid of this process.\n\n\n## Update elm-package.json\n\nSome core packages have been renamed:\n\n  - `evancz/elm-html` is now `elm-lang/html`\n  - `evancz/elm-svg` is now `elm-lang/svg`\n  - `evancz/virtual-dom` is now `elm-lang/virtual-dom`\n  - The functionality of `evancz/start-app` now lives in `elm-lang/html` in `Html.App`\n  - The functionality of `evancz/elm-effects` now lives in `elm-lang/core` in `Platform.*`\n  - The functionality of `Graphics.*` now lives in `evancz/elm-graphics`\n\nSo the first thing you want to do is update your `elm-package.json` file. Here is one that has been properly updated:\n\n```json\n{\n    \"version\": \"1.0.0\",\n    \"summary\": \"let people do a cool thing in a fun way\",\n    \"repository\": \"https://github.com/user/project.git\",\n    \"license\": \"BSD3\",\n    \"source-directories\": [\n        \"src\"\n    ],\n    \"exposed-modules\": [],\n    \"dependencies\": {\n        \"elm-lang/core\": \"4.0.0 <= v < 5.0.0\",\n        \"elm-lang/html\": \"1.0.0 <= v < 2.0.0\",\n        \"evancz/elm-http\": \"3.0.1 <= v < 4.0.0\",\n        \"evancz/elm-markdown\": \"3.0.0 <= v < 4.0.0\"\n    },\n    \"elm-version\": \"0.17.0 <= v < 0.18.0\"\n}\n```\n\nThe only changes should be in the `dependencies` and `elm-version` fields where you need to update constraints. The easiest way to get this all set up is to update `elm-version` by hand, and then remove everything from `dependencies` so you can install the dependencies you still need one at a time with `elm package install`.\n\n\n## Updating Syntax\n\nThe major syntax changes are:\n\n\n<table>\n  <tr>\n    <th>feature</th>\n    <th>0.16</th>\n    <th>0.17</th>\n  </tr>\n\n  <tr>\n    <td>module declaration</td>\n    <td><pre lang=\"elm\">module Queue (..) where</pre></td>\n    <td><pre lang=\"elm\">module Queue exposing (..)</pre></td>\n  </tr>\n</table>\n\nThis is a super easy change, so we will add a link to an auto-upgrade tool here when one exists.\n\n\n## `Action` is now `Msg`\n\nThe Elm Architecture tutorial uses the term `Action` for the data that gets fed into your `update` function. This is a silly name. So in 0.17 the standard name is *message*.\n\n```elm\n-- 0.16\ntype Action = Increment | Decrement\n\n-- 0.17\ntype Msg = Increment | Decrement\n```\n\nThe idea is that your app is receiving *messages* from the user, from servers, from the browser, etc. Your app then reacts to these messages in the `update` function.\n\n\n## No More `Signal.Address`\n\nThe most common thing in your code will probably be that `Signal.Address` no longer exists. Here is a before and after of upgrading some typical `view` code.\n\n```elm\n-- 0.16\nview : Signal.Address Action -> Model -> Html\nview address model =\n  div []\n    [ button [ onClick address Decrement ] [ text \"-\" ]\n    , div [ countStyle ] [ text (toString model) ]\n    , button [ onClick address Increment ] [ text \"+\" ]\n    ]\n\n-- 0.17\nview : Model -> Html Msg\nview model =\n  div []\n    [ button [ onClick Decrement ] [ text \"-\" ]\n    , div [ countStyle ] [ text (toString model) ]\n    , button [ onClick Increment ] [ text \"+\" ]\n    ]\n```\n\nThis change is pretty simple. Any occurance of `address` just gets deleted. In the types, you see the addresses removed, and `Html` becomes `Html Msg`. You can read `Html Msg` as \"an HTML node that can produce messages of type `Msg`\". This change makes addresses unnecessary and makes it much clearer what kind of messages can be produced by a particular block of HTML.\n\nThe `Signal.forwardTo` function is replaced by `Html.App.map`. So you may need to make changes like this:\n\n```elm\n-- 0.16\nview : Signal.Address Action -> Model -> Html\nview address model =\n  div []\n    [ Counter.view (Signal.forwardTo address Top) model.topCounter\n    , Counter.view (Signal.forwardTo address Bottom) model.bottomCounter\n    , button [ onClick address Reset ] [ text \"RESET\" ]\n    ]\n\n-- 0.17\nview : Model -> Html Msg\nview model =\n  div []\n    [ map Top (Counter.view model.topCounter)\n    , map Bottom (Counter.view model.bottomCounter)\n    , button [ onClick Reset ] [ text \"RESET\" ]\n    ]\n```\n\nThese changes are nice for a couple really good reasons:\n\n  - Addresses were consistently one of the things that new folks found most confusing.\n  - It allows the `elm-lang/virtual-dom` implementation to be more efficient with `lazy`\n  - It uses a normal `map` instead of some unfamiliar API.\n\nYou can see more examples of the new HTML API [here](https://evancz.gitbooks.io/an-introduction-to-elm/content/architecture/user_input/index.html).\n\n\n## `Effects` is now `Cmd`\n\nIf you are working with HTTP or anything, you are probably using `evancz/elm-effects` and have your `update` function returning `Effects` values. That library was a successful experiment, so it has been folded into `elm-lang/core` and given a name that works better in the context of Elm 0.17.\n\nThe changes are basically a simple rename:\n\n```elm\n-- 0.16\nupdate : Action -> Model -> (Model, Effects Action)\nupdate action model =\n  case action of\n    RequestMore ->\n      (model, getRandomGif model.topic)\n\n    NewGif maybeUrl ->\n      ( Model model.topic (Maybe.withDefault model.gifUrl maybeUrl)\n      , Effects.none\n      )\n\n-- 0.17\nupdate : Msg -> Model -> (Model, Cmd Msg)\nupdate msg model =\n  case msg of\n    RequestMore ->\n      ( model, getRandomGif model.topic )\n\n    NewGif maybeUrl ->\n      ( Model model.topic (Maybe.withDefault model.gifUrl maybeUrl)\n      , Cmd.none\n      )\n```\n\nThe `Cmd` stuff lives in `elm-lang/core` in `Platform.Cmd`. It is imported by default with `import Platform.Cmd as Cmd exposing (Cmd)` to make it easier to use.\n\nAgain, very easy changes. The key goal of 0.17 was to manage effects in a nicer way, so in making these facilities more complete, the term `Effects` became very ambiguous. You should read more about this in the updated Elm Architecture Tutorial which has [a section all about effects](https://evancz.gitbooks.io/an-introduction-to-elm/content/architecture/effects/index.html).\n\n\n## `StartApp` is now `Html.App`\n\nThe `evancz/start-app` package was an experiment to help people get productive with Elm more quickly. It meant that newcomers could get really far with Elm without knowing a ton about signals, and it has been very effective. With 0.17, it has been folded in to `elm-lang/html` in the `Html.App` module.\n\nUpgrading looks like this:\n\n```elm\n-- 0.16 ---------------------------------------\nimport StartApp\nimport Task\n\napp =\n  StartApp.start\n    { init = init, update = update, view = view, inputs = [] }\n\nmain =\n  app.html\n\nport tasks : Signal (Task.Task Never ())\nport tasks =\n  app.tasks\n\n-- 0.17 ---------------------------------------\nimport Html.App as Html\n\nmain =\n  Html.program\n    { init = init, update = update, view = view, subscriptions = \\_ -> Sub.none }\n```\n\nThe type of `main` has changed from `Signal Html` to `Program flags`. The main value is a program that knows exactly how it needs to be set up. All that will be handled by Elm, so you no longer need to specially hook tasks up to a port or anything.\n\n\n## Upgrading Ports\n\nTalking to JavaScript still uses ports. It is pretty similar, but adapted to fit nicely with commands and subscriptions.\n\nHere is the change for *outgoing* ports:\n\n```elm\n-- 0.16\nport focus : Signal String\nport focus =\n  ...\n\n-- 0.17\nport focus : String -> Cmd msg\n```\n\nInstead of hooking up a signal, you have a function that can create commands. So you just call `focus : String -> Cmd msg` from anywhere in your app and the command is processed like all the others.\n\nAnd here is the change for *incoming* ports:\n\n```elm\ntype User = { name : String, age : Int }\n\n-- 0.16\nport users : Signal User\n\n-- 0.17\nport users : (User -> msg) -> Sub msg\n```\n\nInstead of getting a signal to route to the right place, we now can create subscriptions to incoming ports. So wherever you need to know about users, you just subscribe to it.\n\nYou should definitely read more about this [here](https://evancz.gitbooks.io/an-introduction-to-elm/content/interop/javascript.html).\n\n\n## JavaScript Interop\n\nThe style of initializing Elm programs in JS has also changed slightly.\n\n<table>\n  <tr>\n    <th>Initialize</th>\n    <th>0.16</th>\n    <th>0.17</th>\n  </tr>\n\n  <tr>\n    <td>Embed</td>\n    <td><pre lang=\"javascript\">Elm.embed(Elm.Main, someNode);</pre></td>\n    <td><pre lang=\"javascript\">Elm.Main.embed(someNode);</pre></td>\n  </tr>\n\n  <tr>\n    <td>Fullscreen</td>\n    <td><pre lang=\"javascript\">Elm.fullscreen(Elm.Main);</pre></td>\n    <td><pre lang=\"javascript\">Elm.Main.fullscreen();</pre></td>\n  </tr>\n  \n  <tr>\n    <td>Worker</td>\n    <td><pre lang=\"javascript\">Elm.worker(Elm.Main);</pre></td>\n    <td><pre lang=\"javascript\">Elm.Main.worker();</pre></td>\n  </tr>\n</table>\n\n\n## Next Steps\n\nFrom here, I would highly recommend looking through [guide.elm-lang.org](http://guide.elm-lang.org/), particularly the sections on [The Elm Architecture](http://guide.elm-lang.org/architecture/index.html). This will help you get a feel for 0.17.\n"
  },
  {
    "path": "docs/upgrade-instructions/0.18.md",
    "content": "# Upgrading to 0.18\n\nLike always, not that much has really changed. To make the process as smooth as possible, this document outlines all the things you will want to do to use 0.18.\n\n  - [Update `elm-package.json`](#update-elm-packagejson)\n  - [List Ranges](#list-ranges)\n  - [No More Primes](#no-more-primes)\n  - [Backticks and `andThen`](#backticks-and-andthen)\n  - [Renamed Functions in Core](#renamed-functions-in-core)\n  - [Package Changes](#package-changes)\n\nA lot of this can be done automatically with [`elm-upgrade`](https://github.com/avh4/elm-upgrade#elm-upgrade), so check it out after reading through this document!\n\n\n## Update elm-package.json\n\nSo the first thing you want to do is update your `elm-package.json` file. The only tricky thing is that the HTTP package moved:\n\n  - `evancz/elm-http` => [`elm-lang/http`](http://package.elm-lang.org/packages/elm-lang/http/latest)\n\nFrom there, here is an `elm-package.json` that has been properly updated:\n\n```json\n{\n    \"version\": \"1.0.0\",\n    \"summary\": \"let people do a cool thing in a fun way\",\n    \"repository\": \"https://github.com/user/project.git\",\n    \"license\": \"BSD3\",\n    \"source-directories\": [\n        \"src\"\n    ],\n    \"exposed-modules\": [],\n    \"dependencies\": {\n        \"elm-lang/core\": \"5.0.0 <= v < 6.0.0\",\n        \"elm-lang/html\": \"2.0.0 <= v < 3.0.0\",\n        \"elm-lang/http\": \"1.0.0 <= v < 2.0.0\",\n        \"evancz/elm-markdown\": \"3.0.1 <= v < 4.0.0\"\n    },\n    \"elm-version\": \"0.18.0 <= v < 0.19.0\"\n}\n```\n\nThe only changes should be in the `dependencies` and `elm-version` fields where you need to update constraints.\n\nThe easiest way to get this all set up is to use [`elm-upgrade`](https://github.com/avh4/elm-upgrade#elm-upgrade), but you can also:\n\n  - Update `elm-version` by hand.\n  - Remove everything from `dependencies` by hand.\n  - Install what you need with `elm-package install elm-lang/core` one-by-one.\n\n\n## List Ranges\n\nThe `[1..5]` syntax has been removed.\n\nSo replace any occurance of `[1..9]` with `List.range 1 9`.\n\n\n## No More Primes\n\nYou are not allowed to have primes in variable names, so things like `type'` are renamed to `type_`.\n\n\n## Backticks and `andThen`\n\nElm used to let you take normal functions and use them as infix operators. This is most notable in the case of `andThen` which is pretty much the only function that used this feature. You will want to make the following updates to your code:\n\n```elm\n-- old\n\nandThenIn17 : Result String Int\nandThenIn17 =\n  String.toInt \"1234\"\n    `Result.andThen` \\year -> isValidYear year\n\n-- andThen : Result x a -> (a -> Result x b) -> Result x b\n\n\n-- new\n\nandThenIn18 : Result String Int\nandThenIn18 =\n  String.toInt \"1234\"\n    |> Result.andThen (\\year -> isValidYear year)\n\n-- andThen : (a -> Result x b) -> Result x a -> Result x b\n```\n\nNotice that the backtick style is replaced by pipelining. The `onError` function has been flipped in the same way, so if you are working with tasks you may say something like this in 0.18:\n\n```elm\ntype Msg = NewText String | DidNotLoad\n\ntasksIn18 : Task x Msg\ntasksIn18 =\n  Http.toTask (Http.getString \"http://example.com/war-and-peace\")\n    |> Task.andThen (\\fullText -> Task.succeed (NewText fullText))\n    |> Task.onError (\\error -> Task.succeed DidNotLoad)\n```\n\nThis also means that `andThen` and `onError` group together much better than in the infix style.\n\n**This change should be happening across the entire Elm ecosystem as package authors upgrade to 0.18.**\n\n\n## Renamed Functions in Core\n\nA couple functions have been removed or renamed.\n\n  - [`Json.Decode`](http://package.elm-lang.org/packages/elm-lang/core/5.0.0/Json-Decode)\n    - `objectN` becomes `mapN` (Note: `object1` becomes `map`) \n    - `tupleN` becomes `mapN` with `index`\n    - `(:=)` becomes `field`\n    - `andThen` args flip\n\n  - [`Bitwise`](http://package.elm-lang.org/packages/elm-lang/core/5.0.0/Bitwise)\n    - `shiftLeft` becomes `shiftLeftBy` and args flip\n    - `shiftRight` becomes `shiftRightBy` and args flip\n    - `shiftRightLogical` becomes `shiftRightZfBy` and args flip\n\n  - [`Task`](http://package.elm-lang.org/packages/elm-lang/core/5.0.0/Task)\n    - `andThen` args flip\n    - `onError` args flip\n    - Removed `perform : (x -> msg) -> (a -> msg) -> Task x a -> Cmd msg`\n    - Added  `perform : (a -> msg) -> Task Never a -> Cmd msg`\n    - Added  `attempt : (Result x a -> msg) -> Task x a -> Cmd msg`\n    - Removed `toMaybe` and `toResult` in favor of using `onError` directly\n\n  - [`Result`](http://package.elm-lang.org/packages/elm-lang/core/5.0.0/Result)\n    - Renamed `formatError` to `mapError` to match names in `Task`\n    - `andThen` args flip\n\n  - [`Maybe`](http://package.elm-lang.org/packages/elm-lang/core/5.0.0/Maybe)\n    - `andThen` args flip\n    - Removed `oneOf`\n\n  - [`Random`](http://package.elm-lang.org/packages/elm-lang/core/5.0.0/Random)\n    - `andThen` args flip\n\n  - [`Tuple`](http://package.elm-lang.org/packages/elm-lang/core/5.0.0/Tuple)\n    - `Basics.fst` becomes `Tuple.first`\n    - `Basics.snd` becomes `Tuple.second`\n\n\n## Package Changes\n\nThe following packages have changed a little bit:\n\n  - [`elm-lang/html`](http://package.elm-lang.org/packages/elm-lang/html/latest) collapsed `Html.App` into `Html`. So you need to remove any `import Html.App` imports and refer to `Html.program` instead.\n\n  - [`elm-lang/http`](http://package.elm-lang.org/packages/elm-lang/http/latest) was redone to be easier and have more features. It now supports tracking progress and rate-limiting HTTP requests. It should be pretty easy to upgrade to the new stuff, but if you have a complex `Task` that chains many requests, you will want to use the `Http.toTask` function to keep that code working the same.\n\n  - [`elm-lang/navigation`](http://package.elm-lang.org/packages/elm-lang/navigation/latest) no longer has its own concept of a `Parser`. You just turn a `Navigation.Location` into a message and it is fed into your normal `update` function. This means `Navigation.program` is now much closer to `Html.program` so this should simplify things a bit.\n\n  - [`evancz/url-parser`](http://package.elm-lang.org/packages/evancz/url-parser/latest) is pretty much the same, but works better and is friendlier. New things include:\n    - You can use `<?>` to parse query parameters.\n    - Some bugs about parsing leading and trailing slashes are fixed.\n    - The parser backtracks, always finding a valid parse of the URL if one exists.\n    - You can use `parsePath` to parse a `Navigation.Location` directly.\n\nIn all cases, the packages have become simpler and easier to use. The actual changes did not seem to be too serious as I upgraded `elm-lang.org` and `package.elm-lang.org` and all the examples I control.\n"
  },
  {
    "path": "docs/upgrade-instructions/0.19.0.md",
    "content": "# Upgrading to 0.19\n\nTo make the process as smooth as possible, this document outlines all the things you need to do to upgrade to 0.19.\n\n- [Command Line](#command-line)\n- [`elm.json`](#elmjson)\n- [Changes](#changes)\n- [`--optimize`](#--optimize)\n- [Compiler Performance](#compiler-performance)\n- [Parse Errors](#parse-errors)\n- [Stricter Record Update Syntax](#stricter-record-update-syntax)\n- [Removed User-Defined Operators](#removed-user-defined-operators)\n\n> **Note:** You can try out [`elm-upgrade`](https://github.com/avh4/elm-upgrade#elm-upgrade--) which automates some of the 0.18 to 0.19 changes. It is also in an alpha stage, and Aaron has said it makes sense to talk things through [here](https://github.com/avh4/elm-upgrade/issues).\n\n<br>\n\n\n## Command Line\n\nThere is now just one `elm` binary at the command line. The terminal commands are now:\n\n```bash\n# 0.19         # 0.18\nelm make       # elm-make\nelm repl       # elm-repl\nelm reactor    # elm-reactor\nelm install    # elm-package install\nelm publish    # elm-package publish\nelm bump       # elm-package bump\nelm diff       # elm-package diff\n```\n\n\n<br>\n\n\n## `elm.json`\n\n`elm-package.json` becomes `elm.json` which is specialized for applications and packages. For example, it helps you lock your dependencies in applications and get broad dependency ranges in packages.\n\nSee the full outlines here:\n\n  - `elm.json` for [applications](https://github.com/elm/compiler/blob/master/docs/elm.json/application.md)\n  - `elm.json` for [packages](https://github.com/elm/compiler/blob/master/docs/elm.json/package.md)\n\nBoth are quite similar to the `elm-package.json` format, and `elm-upgrade` can help you with this.\n\n<br>\n\n\n## Changes\n\n#### Functions Changed\n\n- `String.toInt : String -> Maybe Int` (not `Result` anymore)\n- `String.toFloat : String -> Maybe Float` (not `Result` anymore)\n- `Basics.toString` becomes [`Debug.toString`](https://package.elm-lang.org/packages/elm/core/latest/Debug#toString), [`String.fromInt`](https://package.elm-lang.org/packages/elm/core/latest/String#fromInt), and [`String.fromFloat`](https://package.elm-lang.org/packages/elm/core/latest/String#fromFloat).\n- `Basics.rem 451 10` becomes [`remainderBy 10 451`](https://package.elm-lang.org/packages/elm/core/latest/Basics#remainderBy)\n- `451 % 10` becomes [`modBy 10 451`](https://package.elm-lang.org/packages/elm/core/latest/Basics#modBy)\n- `(,)` becomes [`Tuple.pair`](https://package.elm-lang.org/packages/elm/core/latest/Tuple#pair)\n- `style : List (String, String) -> Attribute msg` becomes `String -> String -> Attribute msg`\n- `Html.beginnerProgram` becomes [`Browser.sandbox`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#sandbox).\n- `Html.program` becomes [`Browser.element`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#element) and [`Browser.document`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#document).\n\n\n#### Modules Moved\n\n- `Json.Encode` and `Json.Decode` moved to [`elm/json`](https://package.elm-lang.org/packages/elm/json/latest)\n- `Time` and `Date` moved to [`elm/time`](https://package.elm-lang.org/packages/elm/time/latest/) with a significantly improved API\n- `Random` moved to [`elm/random`](https://package.elm-lang.org/packages/elm/random/latest/) with a better implementation and a few new functions\n- `Regex` moved to [`elm/regex`](https://package.elm-lang.org/packages/elm/regex/latest) with a much clearer README\n\n\n#### Packages Moved\n\n- `elm-lang/*` moved to `elm/*`\n- `evancz/url-parser` moved to [`elm/url`](https://package.elm-lang.org/packages/elm/url/latest) with a simpler and more flexible API\n- `elm-tools/elm-parser` moved to [`elm/parser`](https://package.elm-lang.org/packages/elm/parser/latest) with speed boost when compiling with the `--optimize` flag\n- [`elm/browser`](https://package.elm-lang.org/packages/elm/browser/latest) combines and simplifies the following 0.18 packages:\n  - `elm-lang/navigation` with smoother APIs\n  - `elm-lang/dom` with ability to get node positions and dimensions.\n  - `elm-lang/mouse` with decoders\n  - `elm-lang/window`\n  - `elm-lang/keyboard` uses decoders like [this](https://github.com/elm/browser/blob/master/notes/keyboard.md)\n  - `elm-lang/page-visibility`\n  - `elm-lang/animation-frame`\n\n\n#### Functions Removed\n\n- `uncurry`\n- `curry`\n- `flip`\n- `(!)`\n\nPrefer named helper functions in these cases.\n\n<br>\n\n## `--optimize`\n\nYou can now compile with `elm make --optimize` which enables things like:\n\n- Reliable field name shortening in compiled assets\n- Unbox things like `type Height = Height Float` to just be a float at runtime\n- Unbox `Char` values\n- Use more compact names for `type` constructors in compiled assets.\n\nSome of these optimizations require \"forgetting information\" that is useful while debugging, so the `Debug` module becomes unavailable when you add the `--optimize` flag. The idea being that you want to be shipping code with this flag (like `-O2` in C) but not compiling with it all day in development.\n\n<br>\n\n\n## Compiler Performance\n\nI did a bunch of performance optimizations for the compiler itself. For example:\n\n- I rewrote the parser to be very significantly faster (partly by allocating very little!)\n- I revamped how type inference looks up the type of foreign variables to be `O(1)` rather than `O(log(n))`\n- I redid how code is generated to allow DCE with declarations as the level of granuality\n- Packages are downloaded once per user and saved in `~/.elm/`\n- Packages are built once for any given set of dependencies, so they do not contribute to build times of fresh projects.\n\nPoint is, the compiler is very significantly faster!\n\n\n<br>\n\n\n## Parse Errors\n\nPart of rewriting the parser was making nicer parse errors. Many people only really see them when getting started, and rather than saying \"man, these are terrible\" they think \"man, programming is hard\" leading to a big underreporting of quality issues here. Anyway, please explore that a bit and see if you run into anything odd!\n\n<br>\n\n\n## Stricter Record Update Syntax\n\nIt used to be possible for `{ r | x = v }` to change the type of field `x`. This is no longer possible. This greatly improves the quality of error messages in many cases.\n\nYou can still change the type of a field, but you must reconstruct the record with the record literal syntax, or with a record constructor.\n\nThe idea is that 99.9% of uses get a much better experience with type errors, whereas 0.1% of uses become somewhat more verbose. As someone who had a bit of code that changed record types, I have found this to be a really excellent trade.\n\n<br>\n\n\n## Removed User-Defined Operators\n\nIt is no longer possible to define custom operators. For example, someone defined:\n\n```elm\n(|-~->) : (a -> a1_1 -> a3) -> (a2 -> a1_1) -> a -> a2 -> a3\n```\n\nThey are still able to define that function, but it will need a human readable name that explains what it is meant to do. The reasoning behind this decision is outlined in detail in [this document](https://gist.github.com/evancz/769bba8abb9ddc3bf81d69fa80cc76b1).\n\n<br>\n\n\n## Notes:\n\n- `toString` &mdash; A relatively common bug was to show an `Int` in the UI, and then later that value changes to something else. `toString` would just show wrong information until someone noticed. The new `String.fromInt` and `String.fromFloat` ensure that cannot happen. Furthermore, more elaborate types almost certainly need localization or internationalization, which should be handled differently anyway.\n"
  },
  {
    "path": "docs/upgrade-instructions/0.19.1.md",
    "content": "# Upgrading to 0.19.1\n\n**There are no language changes**, so once you swap to `\"elm-version\": \"0.19.1\"` in your `elm.json`, most users should be able to proceed without any further code changes. **You may run into a handful of bugfixes though!** These cases are outlined below!\n\n\n<br>\n\n## Improvements\n\n- Parse error message quality (like [this](https://github.com/elm/error-message-catalog/issues/255) and [this](https://github.com/elm/error-message-catalog/issues/225))\n- Faster compilation, especially for incremental compiles\n- Uses filelocks so that cached files are not corrupted when plugins run `elm make` multiple times on the same project at the same time. (Still worth avoiding that though!)\n- More intuitive multiline declarations in REPL\n- Various bug fixes (e.g. `--debug`, `x /= 0`, `type Height = Height Float` in `--optimize`)\n\n\n<br>\n\n## Detectable Bug Fixes\n\nThere are three known cases where code that compiled with 0.19.0 will not compile with 0.19.1 due to bug fixes:\n\n\n### 1. Ambiguous Imports\n\nSay you have an import like this:\n\n```elm\nimport Html exposing (min)\nimport Regex exposing (never)\n\nx = min\ny = never\n```\n\nThese should be reported as ambiguous usages since the names are also exposed by `Basics`, but there was a regression in 0.19.0 described [here](https://github.com/elm/compiler/issues/1945) such that they weren't caught in specific circumstances.\n\nThe fix is to use a qualified name like `Html.min` or `Regex.never` to make it unambiguous.\n\nWe found a couple instances of this in packages and have submitted PRs to the relevant authors in August 2019. You may run into this in your own code as well.\n\nFor more details on why this is considered a regression, check out the details [here](https://github.com/elm/compiler/issues/1945#issuecomment-507871919) or try it in 0.18.0 to see how it worked before.\n\n\n### 2. Tabs in Comments\n\nThe 0.19.0 binaries did not catch tab characters in comments. The new parser is better at checking for tabs, so it will object when it finds these.\n\nAgain, we found this in some packages and reached out to the relevant authors with PRs so patches would be published before the 0.19.1 release.\n\n\n### 3. Port Module with no Ports\n\nIf you have any files that start with:\n\n```elm\nport module Main exposing (..)\n```\n\nBut they do not actually have any `port` declarations, the 0.19.1 binary will ask you to switch to a normal module declaration like `module Main exposing (..)`\n"
  },
  {
    "path": "docs/upgrade-instructions/earlier.md",
    "content": "\n# 0.16\n\nRead all about it at these links:\n\n  * http://elm-lang.org/blog/compilers-as-assistants\n  * https://github.com/elm-lang/elm-platform/blob/master/upgrade-docs/0.16.md\n\n\n# 0.15\n\n### Improve Import Syntax\n\nThe changes in 0.14 meant that people were seeing pretty long import sections,\nsometimes with two lines for a single module to bring it in qualified and to\nexpose some unqualified values. The new syntax is like this:\n\n```elm\nimport List\n  -- Just bring `List` into scope, allowing you to say `List.map`,\n  -- `List.filter`, etc.\n\nimport List exposing (map, filter)\n  -- Bring `List` into scope, but also bring in `map` and `filter`\n  -- without any prefix.\n\nimport List exposing (..)\n  -- Bring `List` into scope, and bring in all the values in the\n  -- module without a prefix.\n\nimport List as L\n  -- Bring `L` into scope, but not `List`. This lets you say `L.map`,\n  -- `L.filter`, etc.\n\nimport List as L exposing (map, filter)\n  -- Bring `L` into scope along with unqualified versions of `map`\n  -- and `filter`.\n\nimport List as L exposing (..)\n  -- Bring in all the values unqualified and qualified with `L`.\n```\n\nThis means you are doing more with each import, writing less overall. It also\nmakes the default imports more comprehensive because you now can refer to\n`List` and `Result` without importing them explicitly as they are in the\ndefaults.\n\n### Revise Port Syntax\n\nOne common confusion with the `port` syntax is that the only difference\nbetween incoming ports and outgoing ports is whether the type annotation comes\nwith a definition. To make things a bit clearer, we are using the keywords\n`foreign input` and `foreign output`.\n\n```elm\nforeign input dbResults : Stream String\n\nforeign output dbRequests : Stream String\nforeign output dbRequests =\n    Stream.map toRequest userNames\n```\n\n### Input / Output\n\nThe biggest change in 0.15 is the addition of tasks, allowing us to represent\narbitrary effects in Elm in a safe way. This parallels how ports work, so we\nare trying to draw attention to that in syntax. First addition is a way to\ncreate new inputs to an Elm program.\n\n```elm\ninput actions : Input Action\n```\n\nThis creates a `Input` that is made up of an `Address` you can send messages to\nand a `Stream` of those messages. This is similar to a `foreign input` except\nthere we use the name as the address. The second addition is a way to run\ntasks.\n\n```elm\noutput Stream.map toRequest userNames\n```\n\nThis lets us turn tasks into effects in the world. Sometimes it is useful to\npipe the results of these tasks back into Elm. For that, we have the third and\nfinal addition.\n\n```elm\ninput results : Stream (Result Http.Error String)\ninput results from\n    Stream.map toRequest userNames\n```\n\n# 0.14.1\n\nModify default import of `List` to expose `(::)` as well.\n\n\n# 0.14\n\n### Breaking Changes\n\n  * Keyword `data` renamed to `type`\n  * Keyword `type` renamed to `type alias`\n\n\n# 0.13\n\n### Improvements:\n\n  * Type aliases in port types \n  * Add Keyboard.alt and Keyboard.meta\n  * Add Debug.crash, Debug.watch, Debug.watchSummary, and Debug.trace\n  * Add List.indexedMap and List.filterMap\n  * Add Maybe.map\n  * Add Basics.negate\n  * Add (>>) to Basics as in F#\n  * Add --bundle-runtime flag which creates stand-alone Elm programs\n  * Error on ambiguious use of imported variables\n  * Replace dependency on Pandoc with cheapskate+kate\n  * Better architecture for compiler. Uses types to make compilation pipeline\n    safer, setting things up for giving programmatic access to the AST to\n    improve editor and IDE support.\n\n### Breaking Changes:\n\n  * Rename (.) to (<<) as in F#\n  * Rename Basics.id to Basics.identity\n  * Rename Basics.div to (//)\n  * Rename Basics.mod to (%)\n  * Remove Maybe.justs for (List.filterMap identity)\n  * Remove List.and for (List.foldl (&&) True)\n  * Remove List.or  for (List.foldl (||) False)\n  * Unambiguous syntax for importing ADTs and type aliases\n  * sqrt and logBase both only work on Floats now\n\n# 0.12.3\n\n  * Minor changes to support webgl as a separate library\n  * Switch from HSV to HSL\n  * Programmatic access to colors with toHsl and toRgb\n\n# 0.12.1\n\n### Improvements:\n\n  * New Array library (thanks entirely to @Xashili)\n  * Json.Value can flow through ports\n  * Improve speed and stack usage in List library (thanks to @maxsnew)\n  * Add Dict.filter and Dict.partition (thanks to @hdgarrood)\n\n### Breaking Changes:\n\n  * Revamp Json library, simpler with better names\n  * Revamp JavaScript.Experimental library to have slightly better names\n  * Remove JavaScript library which was made redundant by ports\n\n# 0.12\n\n### Breaking Changes:\n\n  * Overhaul Graphics.Input library (inspired by Spiros Eliopoulos and Jeff Smitts)\n  * Overhaul Text library to accomodate new Graphics.Input.Field\n    library and make the API more consistent overall\n  * Overhaul Regex library (inspired by Attila Gazso)\n  * Change syntax for \"import open List\" to \"import List (..)\"\n  * Improved JSON format for types generated by elm-doc\n  * Remove problematic Mouse.isClicked signal\n  * Revise the semantics of keepWhen and dropWhen to only update when\n    the filtered signal changes (thanks Max New and Janis Voigtländer)\n\n### Improvements:\n\n  * Add Graphics.Input.Field for customizable text fields\n  * Add Trampoline library (thanks to @maxsnew and @timthelion) \n  * Add Debug library (inspired by @timthelion)\n  * Drastically improved performance on markdown parsing (thanks to @Dandandan) \n  * Add Date.fromTime function\n  * Use pointer-events to detect hovers on layered elements (thanks to @Xashili)\n  * Fix bugs in Bitwise library\n  * Fix bug when exporting Maybe values through ports\n\n# 0.11\n\n  * Ports, a new FFI that is more general and much nicer to use\n  * Basic compiler tests (thanks to Max New)\n\n# 0.10.1\n\n  * sort, sortBy, sortWith (thanks to Max Goldstein)\n  * elm-repl\n  * Bitwise library\n  * Regex library\n  * Improve Transform2D library (thanks to Michael Søndergaard)\n\n# 0.10\n\n  * Native strings\n  * Tango colors\n  * custom precedence and associativity for infix operators\n  * elm-doc released with new documentation format\n  * Realiasing in type errors\n  * Rename Matrix2D => Transform2D\n  * Add Random.floatList (thank you Max GoldStein)\n  * Fix remove function in Dict (thank you Max New)\n  * Start using language-ecmascript for JS generation\n  * Make compatable with cabal-1.18 (thank you Justin Leitgeb)\n  * All functions with 10+ arguments (thanks to Max New)\n\n# 0.9.1\n\n  * Allow custom precedence and associativity for user-defined infix ops\n  * Realias types before printing\n  * Switch to Tango color scheme, adding a bunch of nice colors\n  * add the greyscale function for easily producing greys\n  * Check the type of main\n  * Fix miscellaneous bugs in type checker\n  * Switch name of Matrix2D to Transform2D\n\n# 0.9\n\nBuild Improvements:\n  * Major speed improvements to type-checker\n  * Type-checker should catch _all_ type errors now\n  * Module-level compilation, only re-compile if necessary\n  * Import types and type aliases between modules\n  * Intermediate files are generated to avoid unneeded recompilation\n    and shorten compile time. These files go in ElmFiles/ by default\n  * Generated files are placed in ElmFiles/ by default, replicating\n    the directory structure of your source code.\n\nError Messages:\n  * Cross-module type errors\n  * Errors for undefined values\n  * Pretty printing of expressions and types\n \nSyntax:\n  * Pattern matching on literals\n  * Pattern aliases with `as` (Andrew)\n  * Unary negation\n  * Triple-quoted multi-line strings\n  * Type annotations in let expressions (Andrew)\n  * Record Constructors\n  * Record type aliases can be closed on the zeroth column\n  * (,,) syntax in types\n  * Allow infix op definitions without args: (*) = add\n  * Unparenthesized if, let, case, lambda at end of binary expressions\n\nelm-server:\n  * Build multi-module projects\n  * Report all errors in browser\n\nLibraries:\n  * Detect hovering over any Element\n  * Set alpha of arbitrary forms in collages\n  * Switch Text.height to use px instead of em\n\nBug Fixes:\n  * Many bug fixes for collage, especially when rendering Elements.\n\nWebsite:\n  * Hot-swapping\n  * Much faster page load with pre-compiled Elm files (Max New)\n\n\n\n\nforgot to fill this in again...\n\n\n# 0.7.2\n\n* Add a WebSockets library.\n* Add support for the mathematical looking operator for function composition (U+2218).\n\n\nforgot to fill this in for a while...\n\n\n# 0.5.0\n\n* Add Dict, Set, and Automaton libraries!\n\n* Add (,,) notation for creating tuples.\n\n* Redo HTTP library, allowing any kind of request and more flexibility.\n\n* Remove the library prefixes `Data.`, `Graphics.`, and `Signal.` because\n  they were more confusing than helpful.\n\n* Better type error reporting for ambiguous uses of variables and for\n  variables in aliased modules.\n\n* Add `readInt` and `readFloat` functions.\n* Add `complement` function to compute complementary colors.\n* Ensure that `String` is treated as an alias of `[Char]`.\n\n* Fix bug in pattern parsing. `A B _ _` was parsed as `A (B _ _)`.\n* Make pattern matching a bit more compact in generated code.\n* Make generated JS more readable.\n\n* The Haskell API exports the absolute path to the Elm runtime\n  system (with the corresponding version number). This makes it easier\n  to run Elm programs with less setup.\n\n\n\n# 0.4.0\n\nThis version is all about graphics: nicer API with more features and major\nefficiency improvements. I am really excited about this release!\n\n* Add native Markdown support. You can now embed markdown directly in .elm files\n  and it is used as an `Element`. Syntax is `[markdown| ... |]` where `...` is\n  formatted as described [here](http://daringfireball.net/projects/markdown/).\n  Content can span multiple lines too.\n\n* Drastically improve the `collage` interface. You can now move, rotate, and scale\n  the following forms:\n  - Elements (any Element you want can be turned into a Form with `toForm`)\n  - Images\n  - Shapes (shapes can be textured now too)\n  - Lines\n  This will make it way easier to make games in Elm. Games can now include text,\n  gifs, videos, and any other Element you can think of.\n\n* Add `--minify` flag, to minify JS code.\n\n* Significantly improve performance of pattern matching.\n\n* Compiler performs beta-reduction in some simple cases.\n\n* The rendering section of the Elm runtume-system (RTS) has been totally rewritten,\n  making screen refreshes use fewer cycles, less memory, and cause less garbage-collection.\n\n\n\n# 0.3.6\n\n* Add JSON library.\n\n* Type-error messages improved. Gives better context for error, making them\n  easier to find. Better messages for runtime errors as well (errors that\n  the type checker cannot find yet).\n\n* Add Comparable super-type which allows the comparision of any values\n  of type {Int,Float,Char,String}. Now possible to make Set and Map libraries.\n\n* Parser now handles decimal numbers.\n\n* Added many new functions for manipulating numbers:\n  - truncate, round, floor, ceiling :: Float -> Int\n  - toFloat :: Int -> Float\n  - (^) :: Number -> Number -> Number\n  - e :: Float\n\n* Foreign import/export statements no longer have to preceed all other\n  variable and datatype definitions. They can be mixed in, making things\n  a bit more readable/natural.\n\n* Bug fixes:\n  - The `toText` function did not escape strings properly\n  - Correct `castJSTupleToTupleN` family of functions\n  - `foldr1` took the leftmost element as the base case instead of the rightmost\n  - Fix minor display issue in latest version of Chrome.\n  - Fix behavior of [ lo .. hi ] syntax (now [4..0] == [], not [0]).\n\n\n\n# 0.3.5\n\n* Add JavaScript event interface. Allows Elm to import and export JS values\n  and events. This makes it possible to import and export Elements, so users\n  can use JS techniques and libraries if necessary. Conversion between JS\n  and Elm values happens with functions from here:\n    http://localhost:8000/docs/Foreign/JavaScript.elm\n    http://localhost:8000/docs/Foreign/JavaScript/Experimental.elm\n\n* Add new flags to help with JavaScript event interface.\n\n* Add three built-in event listeners (elm_title, elm_log, elm_redirect) that\n  make it possible to make some common/simple imperative actions without\n  having to worry about writing the JS yourself. For example:\n        foreign export jsevent \"elm_title\"\n            title :: Signal JSString\n  will update the page's title to the current value of the title signal.\n  Empty strings are ignored. \"elm_redirect\" and \"elm_log\" events work much\n  the same way, except that \"elm_log\" does not skip empty strings.\n\n* Add new Signal functions:\n    count       :: Signal a -> Signal Int\n    keepIf      :: (a -> Bool) -> a -> Signal a -> Signal a\n    dropIf      :: (a -> Bool) -> a -> Signal a -> Signal a\n    keepWhen    :: Signal Bool -> a -> Signal a -> Signal a\n    dropWhen    :: Signal Bool -> a -> Signal a -> Signal a\n    dropRepeats :: Signal a -> Signal a\n    sampleOn    :: Signal a -> Signal b -> Signal b\n    clicks      :: Signal ()\n  The keep and drop functions make it possible to filter events, which\n  was not possible in prior releases. More documentation:\n  http://elm-lang.org/docs/Signal/Signal.elm\n\n* Add examples of JS event interface and new signal functions:\n  https://github.com/evancz/Elm/tree/master/Examples/elm-js\n\n* Use more compressed format for strings. Should make strings 10-12 times\n  more space efficient than in previous releases. Anecdotal evidence:\n  Elm's home page is now 70% of its previous size.\n\n* Add new function to Data.List:\n    last :: [a] -> a\n\n* Fix parenthesization bug with binary operators.\n\n\n\n# 0.3.0\n\n### Major Changes (Read this part!)\n\n* Add a basic module system.\n* Elm's JavaScript runtime is now distributed with the elm package.\n  Previously it was available for download as an unversioned JavaScript\n  file (elm-mini.js). It is now installed with the elm compiler as\n  elm-runtime-0.3.0.js. Be sure to serve the Elm runtime system that matches\n  the version of the compiler used to generate JavaScript. When working\n  locally, the compiler will automatically use your local copy of this file.\n* BREAKING CHANGE: rgb and rgba (in the color module) now take their red,\n  green, and blue components as integers between 0 and 255 inclusive.\n* Improve error messages for parse errors and runtime errors.\n\n\n### New Functions and Other Additions\n\n* Add support for keyboard events: Keyboard.Raw\n* Add buttons in Signal.Input:\n  button :: String -> (Element, Signal Bool)\n* Add new basic element (an empty rectangle, good for adding spaces):\n  rectangle :: Int -> Int -> Element\n* Add (an awkwardly named) way to display right justified text: rightedText\n* Add two basic libraries: Data.Char and Data.Maybe\n* Add some new colors: magenta, yellow, cyan, gray, grey\n* Add functions to Data.List module: take, drop\n* Add functions to Prelude (the default imports):\n  fst, snd, curry, uncurry, and a bunch of list functions\n* Add --make, --separate-js, and --only-js flags to help compile\n  with the new module system.\n"
  },
  {
    "path": "elm.cabal",
    "content": "\nName: elm\nVersion: 0.19.1\n\nSynopsis:\n    The `elm` command line interface.\n\nDescription:\n    This includes commands like `elm make`, `elm repl`, and many others\n    for helping make Elm developers happy and productive.\n\nHomepage: https://elm-lang.org\n\nLicense: BSD3\nLicense-file: LICENSE\n\nAuthor:     Evan Czaplicki\nMaintainer: info@elm-lang.org\nCopyright:  Copyright (c) 2011-present, Evan Czaplicki\n\nCategory: Compiler, Language\n\nCabal-version: >=1.9\nBuild-type: Simple\n\nsource-repository head\n    type:     git\n    location: git://github.com/elm/compiler.git\n\n\nFlag dev {\n  Description: Turn off optimization and make warnings errors\n  Default: False\n}\n\n\nExecutable elm\n        ghc-options: -O2 -rtsopts -threaded \"-with-rtsopts=-N -qg -A128m\" -Wall -Werror\n        -- add -eventlog for (elm make src/Main.elm +RTS -l; threadscope elm.eventlog)\n        -- https://www.oreilly.com/library/view/parallel-and-concurrent/9781449335939/\n\n    Hs-Source-Dirs:\n        compiler/src\n        builder/src\n        terminal/impl\n        terminal/src\n\n    other-extensions:\n        TemplateHaskell\n\n    Main-Is:\n        Main.hs\n\n    other-modules:\n        Bump\n        Develop\n        Diff\n        Init\n        Install\n        Make\n        Publish\n        Repl\n\n        -- terminal args\n        Terminal\n        Terminal.Chomp\n        Terminal.Error\n        Terminal.Helpers\n        Terminal.Internal\n\n        -- from terminal/\n        Develop.Generate.Help\n        Develop.Generate.Index\n        Develop.StaticFiles\n        Develop.StaticFiles.Build\n\n        -- from builder/\n        Build\n        BackgroundWriter\n        Deps.Bump\n        Deps.Diff\n        Deps.Registry\n        Deps.Solver\n        Deps.Website\n        File\n        Generate\n        Http\n        Reporting\n        Reporting.Exit\n        Reporting.Exit.Help\n        Reporting.Task\n        Stuff\n\n        -- Elm things\n        Elm.Outline\n        Elm.Details\n        --\n        Elm.Compiler.Imports\n        Elm.Compiler.Type\n        Elm.Compiler.Type.Extract\n        Elm.Constraint\n        Elm.Docs\n        Elm.Float\n        Elm.Interface\n        Elm.Kernel\n        Elm.Licenses\n        Elm.Magnitude\n        Elm.ModuleName\n        Elm.Package\n        Elm.String\n        Elm.Version\n\n        -- data structures\n        Data.Bag\n        Data.Index\n        Data.Map.Utils\n        Data.Name\n        Data.NonEmptyList\n        Data.OneOrMore\n        Data.Utf8\n\n        -- json\n        Json.Decode\n        Json.Encode\n        Json.String\n\n        -- from compiler/\n        AST.Canonical\n        AST.Optimized\n        AST.Source\n        AST.Utils.Binop\n        AST.Utils.Shader\n        AST.Utils.Type\n        Canonicalize.Effects\n        Canonicalize.Environment\n        Canonicalize.Environment.Dups\n        Canonicalize.Environment.Foreign\n        Canonicalize.Environment.Local\n        Canonicalize.Expression\n        Canonicalize.Module\n        Canonicalize.Pattern\n        Canonicalize.Type\n        Compile\n        Generate.Html\n        Generate.JavaScript\n        Generate.JavaScript.Builder\n        Generate.JavaScript.Expression\n        Generate.JavaScript.Functions\n        Generate.JavaScript.Name\n        Generate.Mode\n        Nitpick.Debug\n        Nitpick.PatternMatches\n        Optimize.Case\n        Optimize.DecisionTree\n        Optimize.Expression\n        Optimize.Module\n        Optimize.Names\n        Optimize.Port\n        Parse.Declaration\n        Parse.Expression\n        Parse.Keyword\n        Parse.Module\n        Parse.Number\n        Parse.Pattern\n        Parse.Shader\n        Parse.Space\n        Parse.String\n        Parse.Symbol\n        Parse.Type\n        Parse.Variable\n        Parse.Primitives\n        Reporting.Annotation\n        Reporting.Doc\n        Reporting.Error\n        Reporting.Error.Canonicalize\n        Reporting.Error.Docs\n        Reporting.Error.Import\n        Reporting.Error.Json\n        Reporting.Error.Main\n        Reporting.Error.Pattern\n        Reporting.Error.Syntax\n        Reporting.Error.Type\n        Reporting.Render.Code\n        Reporting.Render.Type\n        Reporting.Render.Type.Localizer\n        Reporting.Report\n        Reporting.Result\n        Reporting.Suggest\n        Reporting.Warning\n        Type.Constrain.Expression\n        Type.Constrain.Module\n        Type.Constrain.Pattern\n        Type.Error\n        Type.Instantiate\n        Type.Occurs\n        Type.Solve\n        Type.Type\n        Type.Unify\n        Type.UnionFind\n        Paths_elm\n\n    Build-depends:\n        ansi-terminal,\n        ansi-wl-pprint < 1,\n        base,\n        binary,\n        bytestring,\n        containers,\n        directory,\n        edit-distance,\n        file-embed,\n        filelock,\n        filepath,\n        ghc-prim,\n        haskeline,\n        HTTP,\n        http-client,\n        http-client-tls,\n        http-types,\n        language-glsl,\n        mtl,\n        network,\n        parsec,\n        process,\n        raw-strings-qq,\n        scientific,\n        SHA,\n        snap-core,\n        snap-server,\n        template-haskell,\n        time,\n        unordered-containers,\n        utf8-string,\n        vector,\n        zip-archive\n"
  },
  {
    "path": "hints/bad-recursion.md",
    "content": "\n# Hints for Bad Recursion\n\nThere are two problems that will lead you here, both of them pretty tricky:\n\n  1. [**No Mutation**](#no-mutation) &mdash; Defining values in Elm is slightly different than defining values in languages like JavaScript.\n\n  2. [**Tricky Recursion**](#tricky-recursion) &mdash; Sometimes you need to define recursive values when creating generators, decoders, and parsers. A common case is a JSON decoder a discussion forums where a comment may have replies, which may have replies, which may have replies, etc.\n\n\n## No Mutation\n\nLanguages like JavaScript let you “reassign” variables. When you say `x = x + 1` it means: whatever `x` was pointing to, have it point to `x + 1` instead. This is called *mutating* a variable. All values are immutable in Elm, so reassigning variables does not make any sense! Okay, so what *should* `x = x + 1` mean in Elm?\n\nWell, what does it mean with functions? In Elm, we write recursive functions like this:\n\n```elm\nfactorial : Int -> Int\nfactorial n =\n  if n <= 0 then 1 else n * factorial (n - 1)\n```\n\nOne cool thing about Elm is that whenever you see `factorial 3`, you can always replace that expression with `if 3 <= 0 then 1 else 3 * factorial (3 - 1)` and it will work exactly the same. So when Elm code gets evaluated, we will keep expanding `factorial` until the `if` produces a 1. At that point, we are done expanding and move on.\n\nThe thing that surprises newcomers is that recursion works the same way with values too. So take the following definition:\n\n```elm\nx = x + 1\n```\n\nWe are actually defining `x` in terms of itself. So it would expand out to `x = ... + 1 + 1 + 1 + 1`, trying to add one to `x` an infinite number of times! This means your program would just run forever, endlessly expanding `x`. In practice, this means the page freezes and the computer starts to get kind of warm. No good! We can detect cases like this with the compiler, so we give an error at compile time so this does not happen in the wild.\n\nThe fix is usually to just give the new value a new name. So you could rewrite it to:\n\n```elm\nx1 = x + 1\n```\n\nNow `x` is the old value and `x1` is the new value. Again, one cool thing about Elm is that whenever you see a `factorial 3` you can safely replace it with its definition. Well, the same is true of values. Wherever I see `x1`, I can replace it with `x + 1`. Thanks to the way definitions work in Elm, this is always safe!\n\n\n## Tricky Recursion\n\nNow, there are some cases where you *do* want a recursive value. Say you are building a website with comments and replies. You may define a comment like this:\n\n```elm\ntype alias Comment =\n  { message : String\n  , upvotes : Int\n  , downvotes : Int\n  , responses : Responses\n  }\n\ntype Responses =\n  Responses (List Comment)\n```\n\nYou may have run into this definition in the [hints for recursive aliases](recursive-alias.md)! Anyway, once you have comments, you may want to turn them into JSON to send back to your server or to store in your database or whatever. So you will probably write some code like this:\n\n```elm\nimport Json.Decode as Decode exposing (Decoder)\n\ndecodeComment : Decoder Comment\ndecodeComment =\n  Decode.map4 Comment\n    (Decode.field \"message\" Decode.string)\n    (Decode.field \"upvotes\" Decode.int)\n    (Decode.field \"downvotes\" Decode.int)\n    (Decode.field \"responses\" decodeResponses)\n\n-- PROBLEM\ndecodeResponses : Decoder Responses\ndecodeResponses =\n  Decode.map Responses (Decode.list decodeComment)\n```\n\nThe problem is that now `decodeComment` is defined in terms of itself! To know what `decodeComment` is, I need to expand `decodeResponses`. To know what `decodeResponses` is, I need to expand `decodeComment`. This loop will repeat endlessly!\n\nIn this case, the trick is to use `Json.Decode.lazy` which delays the evaluation of a decoder until it is needed. So the valid definition would look like this:\n\n```elm\nimport Json.Decode as Decode exposing (Decoder)\n\ndecodeComment : Decoder Comment\ndecodeComment =\n  Decode.map4 Comment\n    (Decode.field \"message\" Decode.string)\n    (Decode.field \"upvotes\" Decode.int)\n    (Decode.field \"downvotes\" Decode.int)\n    (Decode.field \"responses\" decodeResponses)\n\n-- SOLUTION\ndecodeResponses : Decoder Responses\ndecodeResponses =\n  Decode.map Responses (Decode.list (Decode.lazy (\\_ -> decodeComment)))\n```\n\nNotice that in `decodeResponses`, we hide `decodeComment` behind an anonymous function. Elm cannot evaluate an anonymous function until it is given arguments, so it allows us to delay evaluation until it is needed. If there are no comments, we will not need to expand it!\n\nThis saves us from expanding the value infinitely. Instead we only expand the value if we need to.\n\n> **Note:** The same kind of logic can be applied to tasks, random value generators, and parsers. Use `lazy` or `andThen` to make sure a recursive value is only expanded if needed.\n\n\n## Understanding “Bad Recursion”\n\nThe compiler tries to detect bad recursion, but how does it know the difference between good and bad situations? Writing `factorial` is fine, but writing `x = x + 1` is not. One version of `decodeComment` was bad, but the other was fine. What is the rule?\n\n**Elm will allow recursive definitions as long as there is at least one lambda before you get back to yourself.** So if we write `factorial` without any pretty syntax, it looks like this:\n\n```elm\nfactorial =\n  \\n -> if n <= 0 then 1 else n * factorial (n - 1)\n```\n\nThere is technically a lambda between the definition and the use, so it is okay! The same is true with the good version of `decodeComment`. There is a lambda between the definition and the use. As long as there is a lambda before you get back to yourself, the compiler will let it through.\n\n**This rule is nice, but it does not catch everything.** It is pretty easy to write a definition where the recursion is hidden behind a lambda, but it still immediately expands forever:\n\n```elm\nx =\n  (\\_ -> x) () + 1\n```\n\nThis follows the rules, but it immediately expands until our program runs out of stack space. It leads to a runtime error as soon as you start your program. It is nice to fail fast, but why not have the compiler detect this as well? It turns out this is much harder than it sounds!\n\nThis is called [the halting problem](https://en.wikipedia.org/wiki/Halting_problem) in computer science. Computational theorists were asking:\n\n> Can we determine if a program will finish running (i.e. halt) or if it will continue to run forever?\n\nIt turns out that Alan Turing wrote a proof in 1936 showing that (1) in some cases you just have to check by running the program and (2) this check will take forever for programs that do not halt!\n\n**So we cannot solve the halting problem *in general*, but our simple rule about lambdas can detect the majority of bad cases *in practice*.**\n"
  },
  {
    "path": "hints/comparing-custom-types.md",
    "content": "# Comparing Custom Types\n\nThe built-in comparison operators work on a fixed set of types, like `Int` and `String`. That covers a lot of cases, but what happens when you want to compare custom types?\n\nThis page aims to catalog these scenarios and offer alternative paths that can get you unstuck.\n\n\n## Wrapped Types\n\nIt is common to try to get some extra type safety by creating really simple custom types:\n\n```elm\ntype Id = Id Int\ntype Age = Age Int\n\ntype Comment = Comment String\ntype Description = Description String\n```\n\nBy wrapping the primitive values like this, the type system can now help you make sure that you never mix up a `Id` and an `Age`. Those are different types! This trick is extra cool because it has no runtime cost in `--optimize` mode. The compiler can just use an `Int` or `String` directly when you use that flag!\n\nThe problem arises when you want to use a `Id` as a key in a dictionary. This is a totally reasonable thing to do, but the current version of Elm cannot handle this scenario.\n\nInstead of creating a `Dict Id Info` type, one thing you can do is create a custom data structure like this:\n\n```elm\nmodule User exposing (Id, Table, empty, get, add)\n\nimport Dict exposing (Dict)\n\n\n-- USER\n\ntype Id = Id Int\n\n\n-- TABLE\n\ntype Table info =\n  Table Int (Dict Int info)\n\nempty : Table info\nempty =\n  Table 0 Dict.empty\n\nget : Id -> Table info -> Maybe info\nget (Id id) (Table _ dict) =\n  Dict.get id dict\n\nadd : info -> Table info -> (Table info, Id)\nadd info (Table nextId dict) =\n  ( Table (nextId + 1) (Dict.insert nextId info dict)\n  , Id nextId\n  )\n```\n\nThere are a couple nice things about this approach:\n\n1. The only way to get a new `User.Id` is to `add` information to a `User.Table`.\n2. All the operations on a `User.Table` are explicit. Does it make sense to remove users? To merge two tables together? Are there any special details to consider in those cases? This will always be captured explicitly in the interface of the `User` module.\n3. If you ever want to switch the internal representation from `Dict` to `Array` or something else, it is no problem. All the changes will be within the `User` module.\n\nSo while this approach is not as convenient as using a `Dict` directly, it has some benefits of its own that can be helpful in some cases.\n\n\n## Enumerations to Ints\n\nSay you need to define a `trafficLightToInt` function:\n\n```elm\ntype TrafficLight = Green | Yellow | Red\n\ntrafficLightToInt : TrafficLight -> Int\ntrafficLightToInt trafficLight =\n  ???\n```\n\nWe have heard that some people would prefer to use a dictionary for this sort of thing. That way you do not need to write the numbers yourself, they can be generated such that you never have a typo.\n\nI would recommend using a `case` expression though:\n\n```elm\ntype TrafficLight = Green | Yellow | Red\n\ntrafficLightToInt : TrafficLight -> Int\ntrafficLightToInt trafficLight =\n  case trafficLight of\n    Green  -> 1\n    Yellow -> 2\n    Red    -> 3\n```\n\nThis is really straight-forward while avoiding questions like “is `Green` less than or greater than `Red`?”\n\n\n## Something else?\n\nIf you have some other situation, please tell us about it [here](https://github.com/elm/error-message-catalog/issues). That is a log of error messages that can be improved, and we can use the particulars of your scenario to add more advice on this page!\n"
  },
  {
    "path": "hints/comparing-records.md",
    "content": "# Comparing Records\n\nThe built-in comparison operators work on a fixed set of types, like `Int` and `String`. That covers a lot of cases, but what happens when you want to compare records?\n\nThis page aims to catalog these scenarios and offer alternative paths that can get you unstuck.\n\n\n## Sorting Records\n\nSay we want a `view` function that can show a list of students sorted by different characteristics.\n\nWe could create something like this:\n\n```elm\nimport Html exposing (..)\n\ntype alias Student =\n  { name : String\n  , age : Int\n  , gpa : Float\n  }\n\ntype Order = Name | Age | GPA\n\nviewStudents : Order -> List Student -> Html msg\nviewStudents order students =\n  let\n    orderlyStudents =\n      case order of\n        Name -> List.sortBy .name students\n        Age -> List.sortBy .age students\n        GPA -> List.sortBy .gpa students\n  in\n  ul [] (List.map viewStudent orderlyStudents)\n\nviewStudent : Student -> Html msg\nviewStudent student =\n  li [] [ text student.name ]\n```\n\nIf you are worried about the performance of changing the order or updating information about particular students, you can start using the [`Html.Lazy`](https://package.elm-lang.org/packages/elm/html/latest/Html-Lazy) and [`Html.Keyed`](https://package.elm-lang.org/packages/elm/html/latest/Html-Keyed) modules. The updated code would look something like this:\n\n```elm\nimport Html exposing (..)\nimport Html.Lazy exposing (lazy)\nimport Html.Keyed as Keyed\n\ntype Order = Name | Age | GPA\n\ntype alias Student =\n  { name : String\n  , age : Int\n  , gpa : Float\n  }\n\nviewStudents : Order -> List Student -> Html msg\nviewStudents order students =\n  let\n    orderlyStudents =\n      case order of\n        Name -> List.sortBy .name students\n        Age -> List.sortBy .age students\n        GPA -> List.sortBy .gpa students\n  in\n  Keyed.ul [] (List.map viewKeyedStudent orderlyStudents)\n\nviewKeyedStudent : Student -> (String, Html msg)\nviewKeyedStudent student =\n  ( student.name, lazy viewStudent student )\n\nviewStudent : Student -> Html msg\nviewStudent student =\n  li [] [ text student.name ]\n```\n\nBy using `Keyed.ul` we help the renderer move the DOM nodes around based on their key. This makes it much cheaper to reorder a bunch of students. And by using `lazy` we help the renderer skip a bunch of work. If the `Student` is the same as last time, the render can skip over it.\n\n> **Note:** Some people are skeptical of having logic like this in `view` functions, but I think the alternative (maintaining sort order in your `Model`) has some serious downsides. Say a colleague is adding a message to `Add` students, but they do not know about the sort order rules needed for presentation. Bug! So in this alternate design, you must diligently test your `update` function to make sure that no message disturbs the sort order. This is bound to lead to bugs over time!\n>\n> With all the optimizations possible with `Html.Lazy` and `Html.Keyed`, I would always be inclined to work on optimizing my `view` functions rather than making my `update` functions more complicated and error prone.\n\n\n## Something else?\n\nIf you have some other situation, please tell us about it [here](https://github.com/elm/error-message-catalog/issues). That is a log of error messages that can be improved, and we can use the particulars of your scenario to add more advice on this page!\n"
  },
  {
    "path": "hints/implicit-casts.md",
    "content": "\n# Implicit Casts\n\nMany languages automatically convert from `Int` to `Float` when they think it is necessary. This conversion is often called an [implicit cast](https://en.wikipedia.org/wiki/Type_conversion).\n\nLanguages that will add in implicit casts for addition include:\n\n  - JavaScript\n  - Python\n  - Ruby\n  - C\n  - C++\n  - C#\n  - Java\n  - Scala\n\nThese languages generally agree that an `Int` may be implicitly cast to a `Float` when necessary. So everyone is doing it, why not Elm?!\n\n## Type Inference + Implicit Casts\n\nElm comes from the ML-family of languages. Languages in the ML-family that **never** do implicit casts include:\n\n  - Standard ML\n  - OCaml\n  - Elm\n  - F#\n  - Haskell\n\nWhy would so many languages from this lineage require explicit conversions though?\n\nWell, we have to go back to the 1970s for some background. J. Roger Hindley and Robin Milner independently discovered an algorithm that could _efficiently_ figure out the type of everything in your program without any type annotations. Type Inference! Every ML-family language has some variation of this algorithm at the center of its design.\n\nFor decades, the problem was that nobody could figure out how to combine type inference with implicit casts AND make the resulting algorithm efficient enough for daily use. As far as I know, Scala was the first widely known language to figure out how to combine these two things! Its creator, Martin Odersky did a lot of work on combining type inference and subtyping to make this possible.\n\nSo for any ML-family language designed before Scala, it is safe to assume that implicit conversions just was not an option. Okay, but what about Elm?! It comes after Scala, so why not do it like them?!\n\n  1. You pay performance cost to mix type inference and implicit conversions. At least as far as anyone knows, it defeats an optimization that is crucial to getting _reliably_ good performance. It is fine in most cases, but it can be a real issue in very large code bases.\n\n  2. Based on experience reports from Scala users, it seemed like the convenience was not worth the hidden cost. Yes, you can convert `n` in `(n + 1.5)` and everything is nice, but when you are in larger programs that are sparsely annotated, it can be quite difficult to figure out what is going on.\n\nThis user data may be confounded by the fact that Scala allows quite extensive conversions, not just from `Int` to `Float`, but I think it is worth taking seriously nonetheless. So it is _possible_, but it has tradeoffs.\n\n\n## Conclusion\n\nFirst, based on the landscape of design possibilities, it seems like requiring _explicit_ conversions is a pretty nice balance. We can have type inference, it can produce friendly error messages, the algorithm is snappy, and an unintended implicit cast will not flow hundreds of lines before manifesting to the user.\n\nSecond, Elm very much favors explicit code, so this also fits in with the overall spirit of the language and libraries.\n\nI hope that clarifies why you have to add those `toFloat` and `round` functions! It definitely can take some getting used to, but there are tons of folks who get past that acclimation period and really love the tradeoffs!\n"
  },
  {
    "path": "hints/import-cycles.md",
    "content": "\n# Import Cycles\n\nWhat is an import cycle? In practice you may see it if you create two modules with interrelated `User` and `Comment` types like this:\n\n```elm\nmodule Comment exposing (..)\n\nimport User\n\ntype alias Comment =\n  { comment : String\n  , author : User.User\n  }\n```\n\n```elm\nmodule User exposing (..)\n\nimport Comment\n\ntype alias User =\n  { name : String\n  , comments : List Comment.Comment\n  }\n```\n\nNotice that to compile `Comment` we need to `import User`. And notice that to compile `User` we need to `import Comment`. We need both to compile either!\n\nNow this is *possible* if the compiler figures out any module cycles and puts them all in one big file to compile them together. That seems fine in our small example, but imagine we have a cycle of 20 modules. If you change *one* of them, you must now recompile *all* of them. In a large code base, this causes extremely long compile times. It is also very hard to disentangle them in practice, so you just end up with slow builds. That is your life now.\n\nThe thing is that you can always write the code *without* cycles by shuffling declarations around, and the resulting code is often much clearer.\n\n\n# How to Break Cycles\n\nThere are quite a few ways to break our `Comment` and `User` cycle from above, so let’s go through four useful strategies. The first one is by far the most common solution!\n\n\n## 1. Combine the Modules\n\nOne approach is to just combine the two modules. If we check out the resulting code, we have actually revealed a problem in how we are representing our data:\n\n```elm\nmodule BadCombination1 exposing (..)\n\ntype alias Comment =\n  { comment : String\n  , author : User\n  }\n\ntype alias User =\n  { name : String\n  , comments : List Comment\n  }\n```\n\nNotice that the `Comment` type alias is defined in terms of the `User` type alias and vice versa. Having recursive type aliases like this does not work! That problem is described in depth [here](recursive-alias.md), but the quick takeaway is that one `type alias` needs to become a `type` to break the recursion. So let’s try again:\n\n```elm\nmodule BadCombination2 exposing (..)\n\ntype alias Comment =\n  { comment : String\n  , author : User\n  }\n\ntype alias User =\n  { name : String\n  , comments : AllUserComments\n  }\n\ntype AllUserComments = AllUserComments (List Comment)\n```\n\nOkay, now we have broken the recursion, but we need to ask ourselves, how are we going to actually instantiate these `Comment` and `User` types that we have described. A `Comment` will always have an author, and that `User` will always refer back to the `Comment`. So we seem to want cyclic data here. If we were in JavaScript we might instantiate all the comments in one pass, and then go back through and mutate the users to point to all the relevant comments. In other words, we need *mutation* to create this cyclic data!\n\nAll values are immutable in Elm, so we need to use a more functional strategy. One common approach is to use unique identifiers. Instead of referring directly to “the user object” we can refer to a user ID:\n\n```elm\nmodule GoodCombination exposing (..)\n\nimport Dict\n\ntype alias Comment =\n  { comment : String\n  , author : UserId\n  }\n\ntype alias UserId = String\n\ntype alias AllComments =\n  Dict.Dict UserId (List Comment)\n```\n\nNow in this world, we do not even have cycles in our types anymore! That means we can actually break these out into separate modules again:\n\n```elm\nmodule Comment exposing (..)\n\nimport Dict\nimport User\n\ntype alias Comment =\n  { comment : String\n  , author : User.Id\n  }\n\ntype alias AllComments =\n  Dict.Dict User.Id (List Comment)\n```\n\n```elm\nmodule User exposing (..)\n\ntype alias Id = String\n```\n\nSo now we are back to the two modules we wanted, but we have data structures that are going to work much better in a functional language like Elm! **This is the common approach, and it is what you hope will happen!**\n\n\n## 2. Make a New Module\n\nNow say there are actually a ton of functions and values in the `Comment` and `User` modules. Combining them into one does not seem like a good strategy. Instead you can create a *third* module that just has the shared types and functions. Let’s pretend we call that third module `GoodCombination`. So rather than having `Comment` and `User` depend on each other, they now both depend on `GoodCombination`. We broke our cycle!\n\n**This strategy is less common.** You generally want to keep the core `type` of a module with all the functions that act upon it directly, so separating a `type` from everything else is a bad sign. So maybe there is a `User` module that contains a bunch of helper functions, but you *use* all those helper functions in a bunch of other modules that interact with users in various ways. In that scenario, it is still more sophisticated than “just throw the types in a module together” and hope it turns out alright.\n\n\n## 3. Use Type Variables\n\nAnother way to avoid module cycles is to be more generic in how you represent your data:\n\n```elm\nmodule Comment exposing (..)\n\ntype alias Comment author =\n  { comment : String\n  , author : author\n  }\n```\n\n```elm\nmodule User exposing (..)\n\ntype alias User comment =\n  { name : String\n  , comments : List comment\n  }\n```\n\nNotice that `Comment` and `User` no longer need to import each other! Instead, whenever we use these modules, we need to fill in the type variable. So we may import both `Comment` and `User` and try to combine them into a `Comment (User (Comment (User ...)))`. Gah, we ran into the recursive type alias thing again!\n\nSo this strategy fails pretty badly with our particular example. The code is more complicated and it still does not work! So **this strategy is rarely useful**, but when it works, it can simplify things quite a lot.\n\n\n## 4. Hiding Implementation Details in Packages\n\nThis gets a little bit trickier when you are creating a package like `elm-lang/parser` which is built around the `Parser` type.\n\nThat package has a couple exposed modules: `Parser`, `Parser.LanguageKit`, and `Parser.LowLevel`. All of these modules want access to the internal details of the `Parser` type, but we do not want to ever expose those internal details to the *users* of this package. So where should the `Parser` type live?!\n\nUsually you know which module should expose the type for the best public API. In this case, it makes sense for it to live in the `Parser` module. The way to manage this is to create a `Parser.Internal` module with a definition like:\n\n```elm\nmodule Parser.Internal exposing (..)\n\ntype Parser a =\n  Parser ...\n```\n\nNow we can `import Parser.Internal` and use it in any of the modules in our package. The trick is that we never expose the `Parser.Internal` module to the *users* of our package. We can see what is inside, but they cannot! Then in the `Parser` module we can say:\n\n```elm\nmodule Parser exposing (..)\n\nimport Parser.Internal as Internal\n\ntype alias Parser a =\n  Internal.Parser a\n```\n\nSo now folks see a `Parser` type exposed by the `Parser` module, and it is the one that is used throughout all the modules in the package. Do not screw up your data representation to avoid this trick! I think we can improve how this appears in documentation, but overall this is the best way to go.\n\nNow again, this strategy is particularly useful in packages. It is not as worthwhile in application code.\n"
  },
  {
    "path": "hints/imports.md",
    "content": "\n# Hints for Imports\n\nWhen getting started with Elm, it is pretty common to have questions about how the `import` declarations work exactly. These questions usually arise when you start playing with the `Html` library so we will focus on that.\n\n\n<br>\n\n## `import`\n\nAn Elm file is called a **module**. To access code in other files, you need to `import` it!\n\nSo say you want to use the [`div`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html#div) function from the [`elm-lang/html`](http://package.elm-lang.org/packages/elm-lang/html/latest) package. The simplest way is to import it like this:\n\n```elm\nimport Html\n\nmain =\n  Html.div [] []\n```\n\nAfter saying `import Html` we can refer to anything inside that module as long as it is *qualified*. This works for:\n\n  - **Values** &mdash; we can refer to `Html.text`, `Html.h1`, etc.\n  - **Types** &mdash; We can refer to [`Attribute`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html#Attribute) as `Html.Attribute`.\n\nSo if we add a type annotation to `main` it would look like this:\n\n```elm\nimport Html\n\nmain : Html.Html msg\nmain =\n  Html.div [] []\n```\n\nWe are referring to the [`Html`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html#Html) type, using its *qualified* name `Html.Html`. This can feel weird at first, but it starts feeling natural quite quickly!\n\n> **Note:** Modules do not contain other modules. So the `Html` module *does not* contain the `Html.Attributes` module. Those are separate names that happen to have some overlap. So if you say `import Html` you *do not* get access to `Html.Attributes.style`. You must `import Html.Attributes` module separately.\n\n\n<br>\n\n## `as`\n\nIt is best practice to always use *qualified* names, but sometimes module names are so long that it becomes unwieldy. This is common for the `Html.Attributes` module. We can use the `as` keyword to help with this:\n\n```elm\nimport Html\nimport Html.Attributes as A\n\nmain =\n  Html.div [ A.style \"color\" \"red\" ] [ Html.text \"Hello!\" ]\n```\n\nSaying `import Html.Attributes as A` lets us refer to any value or type in `Html.Attributes` as long as it is qualified with an `A`. So now we can refer to [`style`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Attributes#style) as `A.style`.\n\n\n<br>\n\n## `exposing`\n\nIn quick drafts, maybe you want to use *unqualified* names. You can do that with the `exposing` keyword like this:\n\n```elm\nimport Html exposing (..)\nimport Html.Attributes exposing (style)\n\nmain : Html msg\nmain =\n  div [ style \"color\" \"red\" ] [ text \"Hello!\" ]\n```\n\nSaying `import Html exposing (..)` means I can refer to any value or type from the `Html` module without qualification. Notice that I use the `Html` type, the `div` function, and the `text` function without qualification in the example above.\n\n> **Note:** It seems neat to expose types and values directly, but it can get out of hand. Say you `import` ten modules `exposing` all of their content. It quickly becomes difficult to figure out what is going on in your code. “Wait, where is this function from?” And then trying to sort through all the imports to find it. Point is, use `exposing (..)` sparingly!\n\nSaying `import Html.Attributes exposing (style)` is a bit more reasonable. It means I can refer to the `style` function without qualification, but that is it. You are still importing the `Html.Attributes` module like normal though, so you would say `Html.Attributes.class` or `Html.Attributes.id` to refer to other values and types from that module.\n\n\n<br>\n\n## `as` and `exposing`\n\nThere is one last way to import a module. You can combine `as` and `exposing` to try to get a nice balance of qualified names:\n\n```elm\nimport Html exposing (Html, div, text)\nimport Html.Attributes as A exposing (style)\n\nmain : Html msg\nmain =\n  div [ A.class \"greeting\", style \"color\" \"red\" ] [ text \"Hello!\" ]\n```\n\nNotice that I refer to `A.class` which is qualified and `style` which is unqualified.\n\n\n<br>\n\n## Default Imports\n\nWe just learned all the variations of the `import` syntax in Elm. You will use some version of that syntax to `import` any module you ever write.\n\nIt would be the best policy to make it so every module in the whole ecosystem works this way. We thought so in the past at least, but there are some modules that are so commonly used that the Elm compiler automatically adds the imports to every file. These default imports include:\n\n```elm\nimport Basics exposing (..)\nimport List exposing (List, (::))\nimport Maybe exposing (Maybe(..))\nimport Result exposing (Result(..))\nimport String\nimport Tuple\n\nimport Debug\n\nimport Platform exposing (Program)\nimport Platform.Cmd as Cmd exposing (Cmd)\nimport Platform.Sub as Sub exposing (Sub)\n```\n\nYou can think of these imports being at the top of any module you write.\n\nOne could argue that `Maybe` is so fundamental to how we handle errors in Elm code that it is *basically* part of the language. One could also argue that it is extraordinarily annoying to have to import `Maybe` once you get past your first couple weeks with Elm. Either way, we know that default imports are not ideal in some sense, so we have tried to keep the default imports as minimal as possible.\n\n> **Note:** Elm performs dead code elimination, so if you do not use something from a module, it is not included in the generated code. So if you `import` a module with hundreds of functions, you do not need to worry about the size of your assets. You will only get what you use!\n"
  },
  {
    "path": "hints/infinite-type.md",
    "content": "\n# Hints for Infinite Types\n\nInfinite types are probably the trickiest kind of bugs to track down. **Writing down type annotations is usually the fastest way to figure them out.** Let's work through an example to get a feel for how these errors usually work though!\n\n\n## Example\n\nA common way to get an infinite type error is very small typos. For example, do you see the problem in the following code?\n\n```elm\nincrementNumbers list =\n  List.map incrementNumbers list\n\nincrementNumber n =\n  n + 1\n```\n\nThe issue is that `incrementNumbers` calls itself, not the `incrementNumber` function defined below. So there is an extra `s` in this program! Let's focus on that:\n\n```elm\nincrementNumbers list =\n  List.map incrementNumbers list -- BUG extra `s` makes this self-recursive\n```\n\nNow the compiler does not know that anything is wrong yet. It just tries to figure out the types like normal. It knows that `incrementNumbers` is a function. The definition uses `List.map` so we can deduce that `list : List t1` and the result of this function call should be some other `List t2`. This also means that `incrementNumbers : List t1 -> List t2`.\n\nThe issue is that `List.map` uses `incrementNumbers` on `list`! That means that each element of `list` (which has type `t1`) must be fed into `incrementNumbers` (which takes `List t1`)\n\nThat means that `t1 = List t1`, which is an infinite type! If we start expanding this, we get `List (List (List (List (List ...))))` out to infinity!\n\nThe point is mainly that we are in a confusing situation. The types are confusing. This explanation is confusing. The compiler is confused. It is a bad time. But luckily, the more type annotations you add, the better chance there is that you and the compiler can figure things out! So say we change our definition to:\n\n```elm\nincrementNumbers : List Int -> List Int\nincrementNumbers list =\n  List.map incrementNumbers list -- STILL HAS BUG\n```\n\nNow we are going to get a pretty normal type error. Hey, you said that each element in the `list` is an `Int` but I cannot feed that into a `List Int -> List Int` function! Something like that.\n\nIn summary, the root issue is often some small typo, and the best way out is to start adding type annotations on everything!\n"
  },
  {
    "path": "hints/init.md",
    "content": "\n# Creating an Elm project\n\nThe main goal of `elm init` is to get you to this page!\n\nIt just creates an `elm.json` file and a `src/` directory for your code.\n\n\n## What is `elm.json`?\n\nThis file describes your project. It lists all of the packages you depend upon, so it will say the particular version of [`elm/core`](https://package.elm-lang.org/packages/elm/core/latest/) and [`elm/html`](https://package.elm-lang.org/packages/elm/html/latest/) that you are using. It makes builds reproducible! You can read a bit more about it [here](https://github.com/elm/compiler/blob/master/docs/elm.json/application.md).\n\nYou should generally not edit it by hand. It is better to add new dependencies with commands like `elm install elm/http` or `elm install elm/json`.\n\n\n## What goes in `src/`?\n\nThis is where all of your Elm files live. It is best to start with a file called `src/Main.elm`. As you work through [the official guide](https://guide.elm-lang.org/), you can put the code examples in that `src/Main.elm` file.\n\n\n## How do I compile it?\n\nRun `elm reactor` in your project. Now you can go to [`http://localhost:8000`](http://localhost:8000) and browse through all the files in your project. If you navigate to `.elm` files, it will compile them for you!\n\nIf you want to do things more manually, you can run `elm make src/Main.elm` and it will produce an `index.html` file that you can look at in your browser.\n\n\n## How do I structure my directories?\n\nMany folks get anxious about their project structure. “If I get it wrong, I am doomed!” This anxiety makes sense in languages where refactoring is risky, but Elm is not one of those languages!\n\nSo we recommend that newcomers staying in one file until you get into the 600 to 1000 range. Push out of your comfort zone. Having the experience of being fine in large files will help you understand the boundaries in Elm, rather than just defaulting to the boundaries you learned in another language.\n\nThe talk [The Life of a File](https://youtu.be/XpDsk374LDE) gets into this a lot more. The advice about building modules around a specific [custom type](https://guide.elm-lang.org/types/custom_types.html) is particularly important! You will see that emphasized a lot as you work through the official guide.\n\n\n## How do I write tests?\n\nElm will catch a bunch of errors statically, and I think it is worth skipping tests at first to get a feeling for when tests will actually help you _in Elm_.\n\nFrom there, we have a great testing package called [`elm-explorations/test`](https://github.com/elm-explorations/test) that can help you out! It is particularly helpful for teams working on a large codebase. When you are editing code you have never seen before, tests can capture additional details and constraints that are not otherwise apparent!\n\n\n## How do I start fancier projects?\n\nI wanted `elm init` to generate as little code as possible. It is mainly meant to get you to this page! If you would like a more elaborate starting point, I recommend starting projects with commands like these:\n\n```bash\ngit clone https://github.com/evancz/elm-todomvc.git\ngit clone https://github.com/rtfeldman/elm-spa-example.git\n```\n\nThe idea is that Elm projects should be so simple that nobody needs a tool to generate a bunch of stuff. This also captures the fact that project structure _should_ evolve organically as your application develops, never ending up exactly the same as other projects.\n\nBut if you have something particular you want, I recommend creating your own starter recipe and using `git clone` when you start new projects. That way (1) you can get exactly what you want and (2) we do not end up with a complex `elm init` that ends up being confusing for beginners!\n"
  },
  {
    "path": "hints/missing-patterns.md",
    "content": "\n# Hints for Missing Patterns\n\nElm checks to make sure that all possible inputs to a function or `case` are handled. This gives us the guarantee that no Elm code is ever going to crash because data had an unexpected shape.\n\nThere are a couple techniques for making this work for you in every scenario.\n\n\n## The danger of wildcard patterns\n\nA common scenario is that you want to add a tag to a custom type that is used in a bunch of places. For example, maybe you are working different variations of users in a chat room:\n\n```elm\ntype User\n  = Regular String Int\n  | Anonymous\n\ntoName : User -> String\ntoName user =\n  case user of\n    Regular name _ ->\n      name\n\n    _ ->\n      \"anonymous\"\n```\n\nNotice the wildcard pattern in `toName`. This will hurt us! Say we add a `Visitor String` variant to `User` at some point. Now we have a bug that visitor names are reported as `\"anonymous\"`, and the compiler cannot help us!\n\nSo instead, it is better to explicitly list all possible variants, like this:\n\n```elm\ntype User\n  = Regular String Int\n  | Visitor String\n  | Anonymous\n\ntoName : User -> String\ntoName user =\n  case user of\n    Regular name _ ->\n      name\n\n    Anonymous ->\n      \"anonymous\"\n```\n\nNow the compiler will say \"hey, what should `toName` do when it sees a `Visitor`?\" This is a tiny bit of extra work, but it is very worth it!\n\n\n## I want to go fast!\n\nImagine that the `User` type appears in 20 or 30 functions across your project. When we add a `Visitor` variant, the compiler points out all the places that need to be updated. That is very convenient, but in a big project, maybe you want to get through it extra quickly.\n\nIn that case, it can be helpful to use [`Debug.todo`](https://package.elm-lang.org/packages/elm-lang/core/latest/Debug#todo) to leave some code incomplete:\n\n```elm\ntype User\n  = Regular String Int\n  | Visitor String\n  | Anonymous\n\ntoName : User -> String\ntoName user =\n  case user of\n    Regular name _ ->\n      name\n\n    Visitor _ ->\n      Debug.todo \"give the visitor name\"\n\n    Anonymous ->\n      \"anonymous\"\n\n-- and maybe a bunch of other things\n```\n\nIn this case it is easier to just write the implementation, but the point is that on more complex functions, you can put things off a bit.\n\nThe Elm compiler is actually aware of `Debug.todo` so when it sees it in a `case` like this, it will crash with a bunch of helpful information. It will tell you:\n\n  1. The name of the module that contains the code.\n  2. The line numbers of the `case` containing the TODO.\n  3. The particular value that led to this TODO.\n\nFrom that information you have a pretty good idea of what went wrong and can go fix it.\n\nI tend to use `Debug.todo` as the message when my goal is to go quick because it makes it easy to go and find all remaining todos in my code before a release.\n\n\n## A list that definitely is not empty\n\nThis can come up from time to time, but Elm **will not** let you write code like this:\n\n```elm\nlast : List a -> a\nlast list =\n  case list of\n    [x] ->\n        x\n\n    _ :: rest ->\n        last rest\n```\n\nThis is no good. It does not handle the empty list. There are two ways to handle this. One is to make the function return a `Maybe` like this:\n\n```elm\nlast : List a -> Maybe a\nlast list =\n  case list of\n    [] ->\n        Nothing\n\n    [x] ->\n        Just x\n\n    _ :: rest ->\n        last rest\n```\n\nThis is nice because it lets users know that there might be a failure, so they can recover from it however they want.\n\nThe other option is to “unroll the list” one level to ensure that no one can ever provide an empty list in the first place:\n\n```elm\nlast : a -> List a -> a\nlast first rest =\n  case rest of\n    [] ->\n      first\n\n    newFirst :: newRest ->\n      last newFirst newRest\n```\n\nBy demanding the first element of the list as an argument, it becomes impossible to call this function if you have an empty list!\n\nThis “unroll the list” trick is quite useful. I recommend using it directly, not through some external library. It is nothing special. Just a useful idea!\n"
  },
  {
    "path": "hints/optimize.md",
    "content": "\n# How to optimize Elm code\n\nWhen you are serving a website, there are two kinds of optimizations you want to do:\n\n1. **Asset Size** &mdash; How can we send as few bits as possible?\n2. **Performance** &mdash; How can those bits run as quickly as possible?\n\nIt turns out that Elm does really well on both! We have [very small assets](https://elm-lang.org/news/small-assets-without-the-headache) and [very fast code](https://elm-lang.org/news/blazing-fast-html-round-two) when compared to the popular alternatives.\n\nOkay, but how do we get those numbers?\n\n\n## Instructions\n\nStep one is to compile with the `--optimize` flag. This does things like shortening record field names and unboxing values.\n\nStep two is to call `uglifyjs` with a bunch of special flags. The flags unlock optimizations that are unreliable in normal JS code, but because Elm does not have side-effects, they work fine for us!\n\nPutting those together, here is how I would optimize `src/Main.elm` with two terminal commands:\n\n```bash\nelm make src/Main.elm --optimize --output=elm.js\nuglifyjs elm.js --compress \"pure_funcs=[F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9],pure_getters,keep_fargs=false,unsafe_comps,unsafe\" | uglifyjs --mangle --output elm.min.js\n```\n\nAfter this you will have an `elm.js` and a significantly smaller `elm.min.js` file!\n\n**Note 1:** `uglifyjs` is called twice there. First to `--compress` and second to `--mangle`. This is necessary! Otherwise `uglifyjs` will ignore our `pure_funcs` flag.\n\n**Note 2:** If the `uglifyjs` command is not available in your terminal, you can run the command `npm install uglify-js --global` to download it. You probably already have `npm` from getting `elm repl` working, but if not, it is bundled with [nodejs](https://nodejs.org/).\n\n## Scripts\n\nIt is hard to remember all that, so it is probably a good idea to write a script that does it.\n\nI would maybe want to run `./optimize.sh src/Main.elm` and get out `elm.js` and `elm.min.js`, so on Mac or Linux, I would make a script called `optimize.sh` like this:\n\n```bash\n#!/bin/sh\n\nset -e\n\njs=\"elm.js\"\nmin=\"elm.min.js\"\n\nelm make --optimize --output=$js $@\n\nuglifyjs $js --compress \"pure_funcs=[F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9],pure_getters,keep_fargs=false,unsafe_comps,unsafe\" | uglifyjs --mangle --output $min\n\necho \"Initial size: $(cat $js | wc -c) bytes  ($js)\"\necho \"Minified size:$(cat $min | wc -c) bytes  ($min)\"\necho \"Gzipped size: $(cat $min | gzip -c | wc -c) bytes\"\n```\n\nIt also prints out all the asset sizes for you! Your server should be configured to gzip the assets it sends, so the last line is telling you how many bytes would _actually_ get sent to the user.\n\nAgain, the important commands are `elm` and `uglifyjs` which work on any platform, so it should not be too tough to do something similar on Windows.\n\n"
  },
  {
    "path": "hints/port-modules.md",
    "content": "\n# No Ports in Packages\n\nThe package ecosystem is one of the most important parts of Elm. Right now, our ecosystem has some compelling benefits:\n\n  - There are many obvious default packages that work well.\n  - Adding dependencies cannot introduce runtime exceptions.\n  - Patch changes cannot lead to surprise build failures.\n\nThese are really important factors if you want to *quickly* create *reliable* applications. The Elm community thinks this is valuable.\n\nOther communities think that the *number* of packages is a better measure of ecosystem health. That is a fine metric to use, but it is not the one we use for Elm. We would rather have 50 great packages than 100k packages of wildly varying quality.\n\n\n## So what about ports?\n\nImagine you install a new package that claims to support `localStorage`. You get it set up, working through any compile errors. You run it, but it does not seem to work! After trying to figure it out for hours, you realize there is some poorly documented `port` to hook up...\n\nOkay, now you need to hook up some JavaScript code. Is that JS file in the Elm package? Or is it on `npm`? Wait, what version on `npm` though? And is this patch version going to work as well? Also, how does this file fit into my build process? And assuming we get through all that, maybe the `port` has the same name as one of the ports in your project. Or it clashes with a `port` name in another package.\n\n**Suddenly adding dependencies is much more complicated and risky!** An experienced developer would always check for ports up front, spending a bunch of time manually classifying unacceptable packages. Most people would not know to do that and learn all the pitfalls through personal experience, ultimately spending even *more* time than the person who defensively checks to avoid these issues.\n\nSo “ports in packages” would impose an enormous cost on application developers, and in the end, we would have a less reliable package ecosystem overall.\n\n\n## Conclusion\n\nOur wager with the Elm package ecosystem is that it is better to get a package *right* than to get it *right now*. So while we could use “ports in packages” as a way to get twenty `localStorage` packages of varying quality *right now*, we are choosing not to go that route. Instead we ask that developers use ports directly in their application code, getting the same result a different way.\n\nNow this may not be the right choice for your particular project, and that is okay! We will be expanding our core libraries over time, as explained [here](https://github.com/elm-lang/projects/blob/master/roadmap.md#where-is-the-localstorage-package), and we hope you will circle back later to see if Elm has grown into a better fit!\n\nIf you have more questions about this choice or what it means for your application, please come ask in [the Elm slack](http://elmlang.herokuapp.com/). Folks are friendly and happy to help out! Chances are that a `port` in your application will work great for your case once you learn more about how they are meant to be used.\n"
  },
  {
    "path": "hints/recursive-alias.md",
    "content": "\n# Hints for Recursive Type Aliases\n\nAt the root of this issue is the distinction between a `type` and a `type alias`.\n\n\n## What is a type alias?\n\nWhen you create a type alias, you are just creating a shorthand to refer to an existing type. So when you say the following:\n\n```elm\ntype alias Time = Float\n\ntype alias Degree = Float\n\ntype alias Weight = Float\n```\n\nYou have not created any *new* types, you just made some alternate names for `Float`. You can write down things like this and it'll work fine:\n\n```elm\nadd : Time -> Degree -> Weight\nadd time degree =\n  time + degree\n```\n\nThis is kind of a weird way to use type aliases though. The typical usage would be for records, where you do not want to write out the whole thing every time. Stuff like this:\n\n```elm\ntype alias Person =\n  { name : String\n  , age : Int\n  , height : Float\n  }\n```\n\nIt is much easier to write down `Person` in a type, and then it will just expand out to the underlying type when the compiler checks the program.\n\n\n## Recursive type aliases?\n\nOkay, so let's say you have some type that may contain itself. In Elm, a common example of this is a comment that might have subcomments:\n\n```elm\ntype alias Comment =\n  { message : String\n  , upvotes : Int\n  , downvotes : Int\n  , responses : List Comment\n  }\n```\n\nNow remember that type *aliases* are just alternate names for the real type. So to make `Comment` into a concrete type, the compiler would start expanding it out.\n\n```elm\n  { message : String\n  , upvotes : Int\n  , downvotes : Int\n  , responses :\n      List\n        { message : String\n        , upvotes : Int\n        , downvotes : Int\n        , responses :\n            List\n              { message : String\n              , upvotes : Int\n              , downvotes : Int\n              , responses : List ...\n              }\n        }\n  }\n```\n\nThe compiler cannot deal with values like this. It would just keep expanding forever.\n\n\n## Recursive types!\n\nIn cases where you want a recursive type, you need to actually create a brand new type. This is what the `type` keyword is for. A simple example of this can be seen when defining a linked list:\n\n```elm\ntype List\n    = Empty\n    | Node Int List\n```\n\nNo matter what, the type of `Node n xs` is going to be `List`. There is no expansion to be done. This means you can represent recursive structures with types that do not explode into infinity.\n\nSo let's return to wanting to represent a `Comment` that may have responses. There are a couple ways to do this:\n\n\n### Obvious, but kind of annoying\n\n```elm\ntype Comment =\n   Comment\n      { message : String\n      , upvotes : Int\n      , downvotes : Int\n      , responses : List Comment\n      }\n```\n\nNow let's say you want to register an upvote on a comment:\n\n```elm\nupvote : Comment -> Comment\nupvote (Comment comment) =\n  Comment { comment | upvotes = 1 + comment.upvotes }\n```\n\nIt is kind of annoying that we now have to unwrap and wrap the record to do anything with it.\n\n\n### Less obvious, but nicer\n\n```elm\ntype alias Comment =\n  { message : String\n  , upvotes : Int\n  , downvotes : Int\n  , responses : Responses\n  }\n\ntype Responses = Responses (List Comment)\n```\n\nIn this world, we introduce the `Responses` type to capture the recursion, but `Comment` is still an alias for a record. This means the `upvote` function looks nice again:\n\n```elm\nupvote : Comment -> Comment\nupvote comment =\n  { comment | upvotes = 1 + comment.upvotes }\n```\n\nSo rather than having to unwrap a `Comment` to do *anything* to it, you only have to do some unwrapping in the cases where you are doing something recursive. In practice, this means you will do less unwrapping which is nice.\n\n\n## Mutually recursive type aliases\n\nIt is also possible to build type aliases that are *mutually* recursive. That might be something like this:\n\n```elm\ntype alias Comment =\n  { message : String\n  , upvotes : Int\n  , downvotes : Int\n  , responses : Responses\n  }\n\ntype alias Responses =\n  { sortBy : SortBy\n  , responses : List Comment\n  }\n\ntype SortBy = Time | Score | MostResponses\n```\n\nWhen you try to expand `Comment` you have to expand `Responses` which needs to expand `Comment` which needs to expand `Responses`, etc.\n\nSo this is just a fancy case of a self-recursive type alias. The solution is the same. Somewhere in that cycle, you need to define an actual `type` to end the infinite expansion.\n"
  },
  {
    "path": "hints/repl.md",
    "content": "\n# REPL\n\nThe REPL lets you interact with Elm values and functions in your terminal.\n\n\n## Use\n\nYou can type in expressions, definitions, custom types, and module imports using normal Elm syntax.\n\n```elm\n> 1 + 1\n2 : number\n\n> \"hello\" ++ \"world\"\n\"helloworld\" : String\n```\n\nThe same can be done with definitions and custom types:\n\n```elm\n> fortyTwo = 42\n42 : number\n\n> increment n = n + 1\n<function> : number -> number\n\n> increment 41\n42 : number\n\n> factorial n =\n|   if n < 1 then\n|     1\n|   else\n|     n * factorial (n-1)\n|\n<function> : number -> number\n\n> factorial 5\n120 : number\n\n> type User\n|   = Regular String\n|   | Visitor String\n|\n\n> case Regular \"Tom\" of\n|   Regular name -> \"Hey again!\"\n|   Visitor name -> \"Nice to meet you!\"\n|\n\"Hey again!\" : String\n```\n\nWhen you run `elm repl` in a project with an [`elm.json`](https://github.com/elm/compiler/blob/master/docs/elm.json/application.md) file, you can import any module available in the project. So if your project has an `elm/html` dependency, you could say:\n\n```elm\n> import Html exposing (Html)\n\n> Html.text \"hello\"\n<internals> : Html msg\n\n> Html.text\n<function> : String -> Html msg\n```\n\nIf you create a module in your project named `MyThing` in your project, you can say `import MyThing` in the REPL as well. Any module that is accessible in your project should be accessible in the REPL.\n\n\n## Exit\n\nTo exit the REPL, you can type `:exit`.\n\nYou can also press `ctrl-d` or `ctrl-c` on some platforms.\n"
  },
  {
    "path": "hints/shadowing.md",
    "content": "\n# Variable Shadowing\n\nVariable shadowing is when you define the same variable name twice in an ambiguous way. Here is a pretty reasonable use of shadowing:\n\n```elm\nviewName : Maybe String -> Html msg\nviewName name =\n  case name of\n    Nothing ->\n      ...\n\n    Just name ->\n      ...\n```\n\nI define a `name` with type `Maybe String` and then in that second branch, I define a `name` that is a `String`. Now that there are two `name` values, it is not 100% obvious which one you want in that second branch.\n\nMost linters produce warnings on variable shadowing, so Elm makes “best practices” the default. Just rename the first one to `maybeName` and move on.\n\nThis choice is relatively uncommon in programming languages though, so I want to provide the reasoning behind it.\n\n\n## The Cost of Shadowing\n\nThe code snippet from above is the best case scenario for variable shadowing. It is pretty clear really. But that is because it is a fake example. It does not even compile.\n\nIn a large module that is evolving over time, this is going to cause bugs in a very predictable way. You will have two definitions, separated by hundreds of lines. For example:\n\n```elm\nname : String\nname =\n  \"Tom\"\n\n-- hundreds of lines\n\nviewName : String -> Html msg\nviewName name =\n  ... name ... name ... name ...\n```\n\nOkay, so the `viewName` function has an argument `name` and it uses it three times. Maybe the `viewName` function is 50 lines long in total, so those uses are not totally easy to see. This is fine so far, but say your colleague comes along five months later and wants to support first and last names. They refactor the code like this:\n\n```elm\nviewName : String -> String -> Html msg\nviewName firstName lastName =\n  ... name ... name ... name ...\n```\n\nThe code compiles, but it does not work as intended. They forgot to change all the uses of `name`, and because it shadows the top-level `name` value, it always shows up as `\"Tom\"`. It is a simple mistake, but it is always the last thing I think of.\n\n> Is the data being fetched properly? Let me log all of the JSON requests. Maybe the JSON decoders are messed up? Hmm. Maybe someone is transforming the name in a bad way at some point? Let me check my `update` code.\n\nBasically, a bunch of time gets wasted on something that could easily be detected by the compiler. But this bug is rare, right?\n\n\n## Aggregate Cost\n\nThinking of a unique and helpful name takes some extra time. Maybe 30 seconds. But it means that:\n\n  1. Your code is easier to read and understand later on. So you spend 30 seconds once `O(1)` rather than spending 10 seconds each time someone reads that code in the future `O(n)`.\n\n  2. The tricky shadowing bug described above is impossible. Say there is a 5% chance that any given edit produces a shadowing bug, and that resolving that shadowing bug takes one hour. That means the expected time for each edit increases by three minutes.\n\nIf you are still skeptical, I encourage you can play around with the number of edits, time costs, and probabilities here. When shadowing is not allowed, the resulting overhead for the entire lifetime of the code is the 30 seconds it takes to pick a better name, so that is what you need to beat!\n\n\n## Summary\n\nWithout shadowing, the code easier to read and folks spend less time on pointless debugging. The net outcome is that folks have more time to make something wonderful with Elm!\n"
  },
  {
    "path": "hints/tuples.md",
    "content": "\n# From Tuples to Records\n\nThe largest tuple possible in Elm has three entries. Once you get to four, it is best to make a record with named entries.\n\nFor example, it is _conceivable_ to represent a rectangle as four numbers like `(10,10,100,100)` but it would be more self-documenting to use a record like this:\n\n```elm\ntype alias Rectangle =\n  { x : Float\n  , y : Float\n  , width : Float\n  , height : Float\n  }\n```\n\nNow it is clear that the dimensions should be `Float` values. It is also clear that we are not using the convention of specifying the top-left and bottom-right corners. It could be clearer about whether the `x` and `y` is the point in the top-left or in the middle though!\n\nAnyway, using records like this also gives you access to syntax like `rect.x`, `.x`, and `{ rect | x = 40 }`. It is not clear how to design features like that for arbitrarily sized tuples, so we did not. We already have a way, and it is more self-documenting!\n"
  },
  {
    "path": "hints/type-annotations.md",
    "content": "\n# Hints for Type Annotation Problems\n\nAt the root of this kind of issue is always the fact that a type annotation in your code does not match the corresponding definition. Now that may mean that the type annotation is \"wrong\" or it may mean that the definition is \"wrong\". The compiler cannot figure out your intent, only that there is some mismatch.\n\nThis document is going to outline the various things that can go wrong and show some examples.\n\n\n## Annotation vs. Definition\n\nThe most common issue is with user-defined type variables that are too general. So let's say you have defined a function like this:\n\n```elm\naddPair : (a, a) -> a\naddPair (x, y) =\n  x + y\n```\n\nThe issue is that the type annotation is saying \"I will accept a tuple containing literally *anything*\" but the definition is using `(+)` which requires things to be numbers. So the compiler is going to infer that the true type of the definition is this:\n\n```elm\naddPair : (number, number) -> number\n```\n\nSo you will probably see an error saying \"I cannot match `a` with `number`\" which is essentially saying, you are trying to provide a type annotation that is **too general**. You are saying `addPair` accepts anything, but in fact, it can only handle numbers.\n\nIn cases like this, you want to go with whatever the compiler inferred. It is good at figuring this kind of stuff out ;)\n\n\n## Annotation vs. Itself\n\nIt is also possible to have a type annotation that clashes with itself. This is probably more rare, but someone will run into it eventually. Let's use another version of `addPair` with problems:\n\n```elm\naddPair : (Int, Int) -> number\naddPair (x, y) =\n  x + y\n```\n\nIn this case the annotation says we should get a `number` out, but because we were specific about the inputs being `Int`, the output should also be an `Int`.\n\n\n## Annotation vs. Internal Annotation\n\nA quite tricky case is when an outer type annotation clashes with an inner type annotation. Here is an example of this:\n\n```elm\nfilter : (a -> Bool) -> List a -> List a\nfilter isOkay list =\n  let\n    keepIfOkay : a -> Maybe a\n    keepIfOkay x =\n      if isOkay x then Just x else Nothing\n  in\n    List.filterMap keepIfOkay list\n```\n\nThis case is very unfortunate because all the type annotations are correct, but there is a detail of how type inference works right now that **user-defined type variables are not shared between annotations**. This can lead to probably the worst type error messages we have because the problem here is that `a` in the outer annotation does not equal `a` in the inner annotation.\n\nFor now the best route is to leave off the inner annotation. It is unfortunate, and hopefully we will be able to do a nicer thing in future releases.\n"
  },
  {
    "path": "installers/README.md",
    "content": "# Installing Elm\n\nThe normal path is to work through [the guide](https://guide.elm-lang.org/) until you need to install, but you can skip to installation directly by going [here](https://guide.elm-lang.org/install/terminal.html).\n\n\n<br/>\n\n## Installing Multiple Versions\n\nThe secret is that Elm is just a single executable file. If you are developing a project in `~/Desktop/project/` you can download this file into that directory and run commands like `~/Desktop/project/elm make src/Main.elm` or `./elm make src/Main.elm`. You just run the local copy of the executable file!\n\nThe instructions for [Mac][mac] and [Linux][lin] explain how to do this in more detail. You can follow the same steps on Windows, but you need to do each step by hand. (E.g. download the file through your browser rather than with a terminal command.)\n\n[mac]: https://github.com/elm/compiler/blob/master/installers/mac/README.md\n[lin]: https://github.com/elm/compiler/blob/master/installers/linux/README.md\n\n<br/>\n\n## Installing Previous Versions\n\nThe past binaries for Mac, Linux, and Windows are hosted [here](https://github.com/elm/compiler/releases).\n\nYou can download the executable files directly and use them locally.\n\n\n<br/>\n\n## Uninstall\n\n- [Mac](https://github.com/elm/compiler/blob/master/installers/mac/README.md#uninstall)\n- [Linux](https://github.com/elm/compiler/blob/master/installers/linux/README.md#uninstall)\n- [Windows](https://github.com/elm/compiler/blob/master/installers/win/README.md#uninstall)\n"
  },
  {
    "path": "installers/linux/Dockerfile",
    "content": "# Based initially on https://gist.github.com/rlefevre/1523f47e75310e28eee243c9c5651ac9\n#\n# Build Linux x64 binary from elm compiler top-level directory:\n# $ docker build -t elm -f installers/linux/Dockerfile .\n#\n# Retrieve elm Linux binary:\n# $ docker cp $(docker create elm):/usr/local/bin/elm DESTINATION_DIRECTORY\n#\n# Delete docker elm image:\n# $ docker rmi elm\n#\n# Display all images:\n# $ docker images -a\n#\n# Delete all unused docker images:\n# $ docker system prune -a\n\n# Use Alpine 3.11 with GHC 8.6.5\nFROM alpine:3.11\n\n# Install packages required to build elm\nRUN apk add --no-cache ghc cabal wget musl-dev zlib-dev zlib-static ncurses-dev ncurses-static\n\nWORKDIR /elm\n\n# Import source code\nCOPY builder builder\nCOPY compiler compiler\nCOPY reactor reactor\nCOPY terminal terminal\nCOPY cabal.config elm.cabal LICENSE ./\n\n# Build statically linked elm binary\nRUN cabal new-update\nRUN cabal new-build --ghc-option=-optl=-static --ghc-option=-split-sections\nRUN cp ./dist-newstyle/build/x86_64-linux/ghc-*/elm-*/x/elm/build/elm/elm /usr/local/bin/elm\n\n# Remove debug symbols to optimize the binary size\nRUN strip -s /usr/local/bin/elm\n"
  },
  {
    "path": "installers/linux/README.md",
    "content": "# Install Instructions\n\nThe pre-compiled binary for Linux works on a very wide range of distributions.\n\nIt should be possible to install it by running the following commands in your terminal:\n\n```bash\n# Move to your Desktop so you can see what is going on easier.\n#\ncd ~/Desktop/\n\n# Download the 0.19.1 binary for Linux.\n#\n# +-----------+----------------------+\n# | FLAG      | MEANING              |\n# +-----------+----------------------+\n# | -L        | follow redirects     |\n# | -o elm.gz | name the file elm.gz |\n# +-----------+----------------------+\n#\ncurl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz\n\n# There should now be a file named `elm.gz` on your Desktop.\n#\n# The downloaded file is compressed to make it faster to download.\n# This next command decompresses it, replacing `elm.gz` with `elm`.\n#\ngunzip elm.gz\n\n# There should now be a file named `elm` on your Desktop!\n#\n# Every file has \"permissions\" about whether it can be read, written, or executed.\n# So before we use this file, we need to mark this file as executable:\n#\nchmod +x elm\n\n# The `elm` file is now executable. That means running `~/Desktop/elm --help`\n# should work. Saying `./elm --help` works the same.\n#\n# But we want to be able to say `elm --help` without specifying the full file\n# path every time. We can do this by moving the `elm` binary to one of the\n# directories listed in your `PATH` environment variable:\n#\nsudo mv elm /usr/local/bin/\n\n# Now it should be possible to run the `elm` binary just by saying its name!\n#\nelm --help\n```\n\n<br/>\n\n## Wait, what is the `PATH` variable?\n\nWhen you run a command like `elm make src/Main.elm`, your computer starts by trying to find an executable file called `elm`.\n\nThe `PATH` is the list of directories that get searched. You can see these directories by running:\n\n```bash\necho $PATH\n```\n\nThis prints `/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin` on my computer. The directories are separated by a `:` so there are five possibilities listed here.\n\nWhen I run `elm make src/Main.elm`, my terminal starts by searching these five directories for an executable file named `elm`. It finds `/usr/local/bin/elm` and then runs `/usr/local/bin/elm make src/Main.elm` with whatever arguments I gave.\n\nSo the `PATH` environment variable is a convention that allows you to refer to a specific executable file without knowing exactly where it lives on your computer. This is actually how all \"terminal commands\" work! Commands like `ls` are really executable files that live in directories listed in your `PATH` variable.\n\nSo the point of running `sudo mv elm /usr/local/bin/` is to turn the `elm` binary into a terminal command, allowing us to call it just like `ls` and `cd`.\n\n**Note:** Why do we need to use `sudo` for that one command? Imagine if some program was able to add executables named `ls` or `cd` to `/usr/local/bin` that did something tricky and unexpected. That would be a security problem! Many distributions make this scenario less likely by requiring special permissions to modify the `/usr/local/bin/` directory.\n\n\n<br/>\n\n## Uninstall\n\nThe following commands should remove everything:\n\n```bash\n# Remove the `elm` executable.\n#\nsudo rm /usr/local/bin/elm\n\n# Remove any cached files. The files here reduce compile times when\n# starting new projects and make it possible to work offline in more\n# cases. No need to keep it around if you are uninstalling though!\n#\nrm -r ~/.elm/\n```\n\nIf you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.\n\n"
  },
  {
    "path": "installers/mac/Distribution.xml",
    "content": "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>\n<installer-script minSpecVersion=\"1.000000\" authoringTool=\"com.apple.PackageMaker\" authoringToolVersion=\"3.0.6\" authoringToolBuild=\"201\">\n    <title>Elm</title>\n    <options customize=\"allow\" allow-external-scripts=\"no\"/>\n    <domains enable_localSystem=\"true\"/>\n    <volume-check script=\"pm_volume_check();\"/>\n    <script>\n\n\nfunction pm_volume_check() {\n  if(!(my.target.systemVersion &amp;&amp; /* >= */ system.compareVersions(my.target.systemVersion.ProductVersion, '10.6.0') >= 0)) {\n    my.result.title = 'Failure';\n    my.result.message = 'This version of Elm requires Mac OS X 10.6 or later.';\n    my.result.type = 'Fatal';\n    return false;\n  }\n  return true;\n}\n\n</script>\n    <!--\n    <background file=\"background.png\" alignment=\"bottomleft\" scaling=\"none\" mime-type=\"image/png\"/>\n    -->\n    <welcome mime-type=\"text/rtf\" file=\"welcome.rtf\" />\n    <conclusion mime-type=\"text/rtf\" file=\"conclusion.rtf\" />\n    <choices-outline>\n        <line choice=\"choice2\"/>\n    </choices-outline>\n    <choice id=\"choice2\" title=\"Elm\">\n        <pkg-ref id=\"org.elm-lang.binaries.pkg\"/>\n    </choice>\n    <pkg-ref id=\"org.elm-lang.binaries.pkg\" installKBytes=\"19444\" version=\"1\" auth=\"Root\">binaries.pkg</pkg-ref>\n</installer-script>\n"
  },
  {
    "path": "installers/mac/README.md",
    "content": "# Install Instructions\n\nThe easiest way to install is to to use [the Mac installer](https://github.com/elm/compiler/releases/download/0.19.1/installer-for-mac.pkg)!\n\nBut it is also possible to install by running the following commands in your terminal:\n\n```bash\n# Move to your Desktop so you can see what is going on easier.\n#\ncd ~/Desktop/\n\n# Download the 0.19.1 binary for Linux.\n#\n# +-----------+----------------------+\n# | FLAG      | MEANING              |\n# +-----------+----------------------+\n# | -L        | follow redirects     |\n# | -o elm.gz | name the file elm.gz |\n# +-----------+----------------------+\n#\ncurl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-mac-64-bit.gz\n\n# There should now be a file named `elm.gz` on your Desktop.\n#\n# The downloaded file is compressed to make it faster to download.\n# This next command decompresses it, replacing `elm.gz` with `elm`.\n#\ngunzip elm.gz\n\n# There should now be a file named `elm` on your Desktop!\n#\n# Every file has \"permissions\" about whether it can be read, written, or executed.\n# So before we use this file, we need to mark this file as executable:\n#\nchmod +x elm\n\n# The `elm` file is now executable. That means running `~/Desktop/elm --help`\n# should work. Saying `./elm --help` works the same.\n#\n# But we want to be able to say `elm --help` without specifying the full file\n# path every time. We can do this by moving the `elm` binary to one of the\n# directories listed in your `PATH` environment variable:\n#\nsudo mv elm /usr/local/bin/\n\n# Now it should be possible to run the `elm` binary just by saying its name!\n#\nelm --help\n```\n\n<br/>\n\n## What is the `PATH` variable?\n\nWhen you run a command like `elm make src/Main.elm`, your computer starts by trying to find an executable file called `elm`.\n\nThe `PATH` is the list of directories that get searched. You can see these directories by running:\n\n```bash\necho $PATH\n```\n\nThis prints `/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin` on my computer. The directories are separated by a `:` so there are five possibilities listed here.\n\nWhen I run `elm make src/Main.elm`, my terminal starts by searching these five directories for an executable file named `elm`. It finds `/usr/local/bin/elm` and then runs `/usr/local/bin/elm make src/Main.elm` with whatever arguments I gave.\n\nSo the `PATH` environment variable is a convention that allows you to refer to a specific executable file without knowing exactly where it lives on your computer. This is actually how all \"terminal commands\" work! Commands like `ls` are really executable files that live in directories listed in your `PATH` variable.\n\nSo the point of running `sudo mv elm /usr/local/bin/` is to turn the `elm` binary into a terminal command, allowing us to call it just like `ls` and `cd`.\n\n**Note:** Why do we need to use `sudo` for that one command? Imagine if some program was able to add executables named `ls` or `cd` to `/usr/local/bin` that did something tricky and unexpected. That would be a security problem! Many distributions make this scenario less likely by requiring special permissions to modify the `/usr/local/bin/` directory.\n\n\n<br/>\n\n## Uninstall\n\nThe following commands should remove everything:\n\n```bash\n# Remove the `elm` executable.\n#\nsudo rm /usr/local/bin/elm\n\n# Remove any cached files. The files here reduce compile times when\n# starting new projects and make it possible to work offline in more\n# cases. No need to keep it around if you are uninstalling though!\n#\nrm -r ~/.elm/\n```\n\nIf you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.\n\n"
  },
  {
    "path": "installers/mac/Resources/en.lproj/conclusion.rtf",
    "content": "{\\rtf1\\ansi\\ansicpg1252\\cocoartf2509\n\\cocoatextscaling0\\cocoaplatform0{\\fonttbl\\f0\\fswiss\\fcharset0 Helvetica;\\f1\\fmodern\\fcharset0 CourierNewPSMT;}\n{\\colortbl;\\red255\\green255\\blue255;}\n{\\*\\expandedcolortbl;;}\n\\paperw11900\\paperh16840\\margl1440\\margr1440\\vieww11180\\viewh8400\\viewkind0\n\\pard\\tx720\\tx1440\\tx2160\\tx2880\\tx3600\\tx4320\\tx5040\\tx5760\\tx6480\\tx7200\\tx7920\\tx8640\\pardirnatural\\partightenfactor0\n\n\\f0\\fs28 \\cf0 Try opening the terminal and running commands like:\\\n\\\n\n\\f1 elm init\\\nelm make src/Main.elm --optimize\\\nelm repl\n\\f0 \\\n\\\nCheck out {\\field{\\*\\fldinst{HYPERLINK \"https://guide.elm-lang.org/\"}}{\\fldrslt this tutorial}} for more advice!}"
  },
  {
    "path": "installers/mac/Resources/en.lproj/welcome.rtf",
    "content": "{\\rtf1\\ansi\\ansicpg1252\\cocoartf2509\n\\cocoatextscaling0\\cocoaplatform0{\\fonttbl\\f0\\fswiss\\fcharset0 Helvetica;\\f1\\fmodern\\fcharset0 CourierNewPSMT;}\n{\\colortbl;\\red255\\green255\\blue255;}\n{\\*\\expandedcolortbl;;}\n\\paperw11900\\paperh16840\\margl1440\\margr1440\\vieww10800\\viewh8400\\viewkind0\n\\pard\\tx566\\tx1133\\tx1700\\tx2267\\tx2834\\tx3401\\tx3968\\tx4535\\tx5102\\tx5669\\tx6236\\tx6803\\pardirnatural\\partightenfactor0\n\n\\f0\\fs28 \\cf0 Thank you for trying out Elm!\\\n\\\nThis installer makes \n\\f1 elm\n\\f0  available in your terminal.}"
  },
  {
    "path": "installers/mac/helper-scripts/elm-startup.sh",
    "content": "#!/bin/sh\n\nopen 'http://guide.elm-lang.org'\n"
  },
  {
    "path": "installers/mac/helper-scripts/uninstall.sh",
    "content": "#!/bin/sh\n\nset -e\n\necho \"Warning: You are about to remove all Elm executables!\"\n\ninstalldir=/usr/local/bin\n\nfor bin in elm elm-compiler elm-get elm-reactor elm-repl elm-doc elm-server elm-package elm-make\ndo\n\tif [ -f $installdir/$bin ]; then\n\t\tsudo rm -f $installdir/$bin\n\tfi\n\tif [ -f $installdir/$bin-unwrapped ]; then\n\t\tsudo rm -f $installdir/$bin-unwrapped\n\tfi\n\ndone\n\nsharedir=/usr/local/share/elm\nsudo rm -rf $sharedir\n"
  },
  {
    "path": "installers/mac/make-installer.sh",
    "content": "#!/bin/sh\n# Run the following command to create an installer:\n#\n#     bash make-installer.sh\n#\n\n\n\n#### SETUP ####\n\nset -e\n\n# Create directory structure for new pkgs\npkg_root=$(mktemp -d -t package-artifacts)\npkg_binaries=$pkg_root\npkg_scripts=$pkg_root/Scripts\n\nmkdir -p $pkg_binaries\nmkdir -p $pkg_scripts\n\nusr_binaries=/usr/local/bin\n\n\n#### BUILD ASSETS ####\n\ncp ../../dist/build/elm/elm $pkg_binaries/elm\n\ncp $(pwd)/preinstall $pkg_scripts\ncp $(pwd)/postinstall $pkg_scripts\n\npkgbuild \\\n    --sign \"Developer ID Installer: <NAME>\" \\\n    --identifier org.elm-lang.binary \\\n    --install-location $usr_binaries \\\n    --scripts $pkg_scripts \\\n    --filter 'Scripts.*' \\\n    --root $pkg_root \\\n    binaries.pkg\n\n\n#### BUNDLE ASSETS ####\n\nrm -f installer-for-mac.pkg\n\nproductbuild \\\n    --sign \"Developer ID Installer: <NAME>\" \\\n    --identifier org.elm-lang.installer \\\n    --distribution Distribution.xml \\\n    --package-path . \\\n    --resources Resources \\\n    installer-for-mac.pkg\n\n\n#### CLEAN UP ####\n\nrm binaries.pkg\nrm -rf $pkg_root\n\n\n#### BEGIN NOTARIZATION ####\n\nxcrun altool \\\n    --notarize-app \\\n    --primary-bundle-id \"org.elm-lang.installer\" \\\n    --username \"<EMAIL>\" \\\n    --password \"@keychain:Developer-altool\" \\\n    --file \"installer-for-mac.pkg\"\n\n# From https://scriptingosx.com/2019/09/notarize-a-command-line-tool/\n#\n#### Check on notarization:\n#\n# xcrun altool \\\n#     --notarization-info \"<RequestUUID>\" \\\n#     --username \"<EMAIL>\" \\\n#     --password \"@keychain:Developer-altool\"\n#\n#\n#### Staple Notarization:\n#\n# xcrun stapler staple installer-for-mac.pkg\n"
  },
  {
    "path": "installers/mac/postinstall",
    "content": "#!/bin/sh\n\nset -ex\n\necho \"$(date)\" > /tmp/elm-installer.log\n"
  },
  {
    "path": "installers/mac/preinstall",
    "content": "#!/bin/sh\n\nset -e\n\ninstalldir=/usr/local/bin\n\nfor bin in elm elm-compiler elm-package elm-reactor elm-repl\ndo\n\tif [ -f $installdir/$bin ]; then\n\t\tsudo rm -f $installdir/$bin\n\tfi\n\tif [ -f $installdir/$bin-unwrapped ]; then\n\t\tsudo rm -f $installdir/$bin-unwrapped\n\tfi\ndone\n\nsharedir=/usr/local/share/elm\nsudo rm -rf $sharedir\n"
  },
  {
    "path": "installers/npm/.gitignore",
    "content": "node_modules/\npackages/*/elm\npackages/*/elm.exe\n"
  },
  {
    "path": "installers/npm/.npmignore",
    "content": "README.md\n.gitignore\n.git\n"
  },
  {
    "path": "installers/npm/PUBLISHING.md",
    "content": "# Publishing\n\nHere's how to update the `npm` installer.\n\n## 0. Overview\n\n- There is one _main npm package_ called `elm`.\n- Then there is one _binary npm package_ for each platform, called for example `@elm_binaries/darwin_arm64`.\n\nThe binary packages declare which OS and CPU they are compatible with. For example:\n\n```json\n  \"os\": [ \"darwin\" ],\n  \"cpu\": [ \"arm64\" ]\n```\n\nThe main npm package depend on the binary packages via [optional dependencies](https://docs.npmjs.com/cli/v9/configuring-npm/package-json#optionaldependencies):\n\n```json\n    \"@elm_binaries/darwin_arm64\": \"0.19.1-0\",\n    \"@elm_binaries/darwin_x64\": \"0.19.1-0\",\n    \"@elm_binaries/linux_arm64\": \"0.19.1-0\",\n    ...\n```\n\nWhen installing, `npm` fetches the metadata for all the optional dependencies and only installs the one with a matching OS and CPU. If none of them match, `npm` still considers the install successful. However, the main npm package contains an install script that gives a helpful error.\n\n\n## 1. GitHub Release\n\nCreate a [GitHub Release](https://github.com/elm/compiler/releases) with the following files:\n\n1. `binary-for-mac-64-bit.gz`\n2. `binary-for-mac-arm-64-bit.gz`\n3. `binary-for-linux-64-bit.gz`\n4. `binary-for-linux-arm-64-bit.gz`\n5. `binary-for-windows-64-bit.gz`\n\nCreate each of these by running the `elm` executable for each platform through `gzip elm`.\n\n\n## 2. Put the binaries in place\n\nPut the above files at:\n\n1. `packages/darwin_arm64/elm`\n2. `packages/darwin_x64/elm`\n3. `packages/linux_x64/elm`\n4. `packages/linux_arm64/elm`\n5. `packages/win32_x64/elm.exe` (Note the `.exe` file extension!)\n\n(They are ignored by git.)\n\n\n## 3. Publish the binary packages\n\nRepeat this for all the packages mentioned in the previous section. This uses `packages/darwin_arm64` as an example.\n\n1. Go to the folder: `cd packages/darwin_arm64`\n2. Double-check that you put the right binary in the right package: `file elm`\n3. Double-check that the file is executable: `ls -l elm`\n4. In `package.json` of the binary package, bump the version for example to `\"0.19.1-2\"`.\n5. In `package.json` of the main npm package, update `\"optionalDependencies\"` to point to the bumped version. For example: `\"@elm_binaries/darwin_arm64\": \"0.19.1-2\"`\n6. Publish the package: `npm publish --access=public`\n\n   `--access=public` is needed because scoped packages are private by default.\n\n<details>\n<summary>Notes about the versions of the binary packages</summary>\n\n- End users never have to think about them. They only need to think about the version of the main npm package.\n\n- The binary packages can have different versions. One can have `\"0.19.1-0\"` while another is at `\"0.19.1-1\"`. This is useful if you mess up publishing one platform: Then you can bump just that one and re-release, instead of having to re-release _all_ platforms.\n\n- The version of the main npm package is not related to the versions of the binary packages – they’re all independent. So the main npm package can be at `\"0.19.1-6\"` while the binary packages have suffixes like `-0`, `-1` and `-9`. (They all share the `0.19.1` prefix though to make things more understandable!)\n\n- The main npm package pins the versions of the binary packages _exactly_ – no version ranges.\n  - This means that installing `elm@0.19.1-6` installs the exact same bytes in two years as today.\n  - The `package.json` of each binary package says which OS and CPU it works for. `binary.js` in the main npm package has code that deals with OS and CPU too, so the main npm package needs to install binary packages with known OS and CPU declarations.\n\n- There is no need to use `beta` suffixes for the binary packages. Just bump the number suffix and point to it in a beta release of the main npm package. As mentioned above:\n  - Already published versions of the main npm package depend on exact versions of the binary packages, so they won’t accidentally start downloading beta versions.\n  - End users only see the version of the main npm package.\n\n</details>\n\n\n## 4. Try a beta release\n\nIn `package.json`, bump the version to `\"0.19.2-beta\"`.\n\nDouble-check that `\"optionalDependencies\"` is in sync with the binary packages.\n\n```bash\nnpm publish --tag beta\n```\n\nTo test that it works, run these commands:\n\n```bash\nnpm dist-tags ls elm\nnpm install elm@beta --ignore-scripts\n```\n\nThe `latest` tag should not be changed, and there should be an additional `beta` tag.\n\nTry this on Windows, Linux, and Mac.\n\n\n## 5. Publish final release\n\nRemove the `-beta` suffix from the version in `package.json`. Then run:\n\n```bash\nnpm publish\n```\n\n\n## 6. Tag the `latest-0.19.1` version\n\nMany compiler releases have needed multiple `npm` publications. Maybe something does not work on Windows or some dependency becomes insecure. Normal `npm` problems.\n\nThe convention for each Elm release is to create a tag the latest one.\n\n```bash\nnpm dist-tag add elm@0.19.1-3 latest-0.19.1\n```\n\nThat way people who want a specific version can point to `latest-0.19.1` or `latest-0.18.0` instead of knowing the particular names of all the various publications.\n\nYou can read more about dist-tags [here](https://docs.npmjs.com/cli/dist-tag).\n\n"
  },
  {
    "path": "installers/npm/README.md",
    "content": "# Elm Installer\n\n[Elm](https://elm-lang.org) is a functional programming language that compiles to JavaScript.\n\nHead over to [The Official Guide](https://guide.elm-lang.org/) to start learning Elm!\n\n\n<br/>\n\n## What is this package for?\n\nFor normal installs, I reccomend using the instructions [here](https://guide.elm-lang.org/install/elm.html) instead. This package is only for people who enjoy using `npm` even when it is not necessary, or for people who want to use `npm` for certain scenarios such as:\n\n**Multiple versions**\n\nPeople using Elm at work may use different versions of Elm in different projects. They can run `npm install elm@latest-0.19.1` in each project and use the binary at `./node_modules/.bin/elm` for compilation.\n\n**Continuous integration**\n\nThe `npm` installer works for this, but there are faster and more reliable options:\n\n1. You can download `elm` directly from GitHub with [this script](https://github.com/elm/compiler/blob/master/installers/linux/README.md). This allows you to skip `npm` entirely.\n2. Many continuous integration have ways to cache files ([example](https://docs.travis-ci.com/user/caching/)) to make builds faster and more reliable. This is the ideal setup.\n\nThat said, it works to use the `npm` installer on CI if you prefer that option.\n\n\n<br/>\n\n## Install Locally\n\nThe following command should download the latest Elm 0.19.1 binary:\n\n```\nnpm install elm@latest-0.19.1\n```\n\nYou should be able to run `./node_modules/bin/elm --version` within your project and see `0.19.1`. Now you can compile with `./node_modules/bin/elm make src/Main.elm` and not disrupt other packages.\n\nUse `npm install elm@latest-0.19.0` or `npm install elm@latest-0.18.0` for earlier versions.\n\n**Note:** The `latest-X.Y.Z` convention is used in case we need to publish patches for the `npm` installer within a given Elm release. For example, say `npm` decides that some transitive dependency is not secure. Nothing is changing about Elm or the binaries, but we need to publish a new `npm` installer that fixes this issue.\n\n"
  },
  {
    "path": "installers/npm/bin/elm",
    "content": "#!/usr/bin/env node\n\nvar child_process = require('child_process');\n\n\n// Some npm users enable --ignore-scripts (a good security measure) so\n// they do not run the post-install hook and install.js does not run.\n// Instead they will run this script.\n//\n// On Mac and Linux, we hard link the elm executable into the exact same\n// location as this file. Since npm uses symlinks on these platforms,\n// that means that the first run will invoke this file and subsequent\n// runs will call the elm binary directly.\n//\n// On Windows, our binary file must be named elm.exe for it to run properly.\n// Instead of symlinks, npm creates two files:\n//\n//   - node_modules/.bin/elm (a bash file)\n//   - node_modules/.bin/elm.cmd (a batch file)\n//\n// Both files specifically invoke `node` to run the file listed at package.bin,\n// so there is no way around instantiating node for no reason on Windows.\n\n\nvar binaryPath = require('../binary.js')();\nchild_process\n\t.spawn(binaryPath, process.argv.slice(2), { stdio: 'inherit' })\n\t.on('exit', process.exit);\n"
  },
  {
    "path": "installers/npm/binary.js",
    "content": "var fs = require('fs');\nvar package = require('./package.json');\nvar path = require('path');\n\n\n\n// MAIN\n//\n// This function is used by install.js and by the bin/elm backup that gets\n// called when --ignore-scripts is enabled.\n\n\nmodule.exports = function()\n{\n\t// figure out package of binary\n\tvar version = package.version.replace(/^(\\d+\\.\\d+\\.\\d+).*$/, '$1'); // turn '1.2.3-alpha' into '1.2.3'\n\tvar subPackageName = '@elm_binaries/' + process.platform + '_' + process.arch;\n\n\tverifyPlatform(version, subPackageName);\n\n\tvar fileName = process.platform === 'win32' ? 'elm.exe' : 'elm';\n\n\ttry\n\t{\n\t\tvar subBinaryPath = require.resolve(subPackageName + '/' + fileName);\n\t}\n\tcatch (error)\n\t{\n\t\tif (error && error.code === 'MODULE_NOT_FOUND')\n\t\t{\n\t\t\texitFailure(version, missingSubPackageHelp(subPackageName));\n\t\t}\n\t\telse\n\t\t{\n\t\t\texitFailure(version, 'I had trouble requiring the binary package for your platform (' + subPackageName + '):\\n\\n' + error);\n\t\t}\n\t}\n\n\t// Yarn 2 and later (\"Berry\") always invokes `node` (regardless of configuration)\n\t// so we cannot do any optimizations there\n\tvar isYarnBerry = /\\byarn\\/(?!1\\.)/.test(process.env.npm_config_user_agent || \"\");\n\n\t// as mentioned in bin/elm we cannot do any optimizations on Windows\n\tif (process.platform === 'win32' || isYarnBerry)\n\t{\n\t\treturn subBinaryPath;\n\t}\n\n\t// figure out where to put the binary\n\tvar binaryPath = path.resolve(__dirname, package.bin.elm);\n\tvar tmpPath = binaryPath + '.tmp';\n\n\t// optimize by replacing the JS bin/elm with the native binary directly\n\ttry\n\t{\n\t\t// atomically replace the file with a hard link to the binary\n\t\tfs.linkSync(subBinaryPath, tmpPath);\n\t\tfs.renameSync(tmpPath, binaryPath);\n\t}\n\tcatch (error)\n\t{\n\t\texitFailure(version, 'I had some trouble writing file to disk. It is saying:\\n\\n' + error);\n\t}\n\n\treturn binaryPath;\n}\n\n\n\n// VERIFY PLATFORM\n\n\nfunction verifyPlatform(version, subPackageName)\n{\n\tif (subPackageName in package.optionalDependencies) return;\n\n\tvar situation = process.platform + '_' + process.arch;\n\tconsole.error(\n\t\t'-- ERROR -----------------------------------------------------------------------\\n\\n'\n\t\t+ 'I am detecting that your computer (' + situation + ') may not be compatible with any\\n'\n\t\t+ 'of the official pre-built binaries.\\n\\n'\n\t\t+ 'I recommend against using the npm installer for your situation. Check out the\\n'\n\t\t+ 'alternative installers at https://github.com/elm/compiler/releases/tag/' + version + '\\n'\n\t\t+ 'to see if there is something that will work better for you.\\n\\n'\n\t\t+ 'From there I recommend asking for guidance on Slack or Discourse to find someone\\n'\n\t\t+ 'who can help with your specific situation.\\n\\n'\n\t\t+ '--------------------------------------------------------------------------------\\n'\n\t);\n\tprocess.exit(1);\n}\n\n\n\n// EXIT FAILURE\n\n\nfunction exitFailure(version, message)\n{\n\tconsole.error(\n\t\t'-- ERROR -----------------------------------------------------------------------\\n\\n'\n\t\t+ message\n\t\t+ '\\n\\nNOTE: You can avoid npm entirely by downloading directly from:\\n'\n\t\t+ 'https://github.com/elm/compiler/releases/tag/' + version + '\\n'\n\t\t+ 'All this package does is distribute a file from there.\\n\\n'\n\t\t+ '--------------------------------------------------------------------------------\\n'\n\t);\n\tprocess.exit(1);\n}\n\n\n\n// MISSING SUB PACKAGE HELP\n\n\nfunction missingSubPackageHelp(subPackageName)\n{\n\treturn (\n\t\t'I tried to get `elm` from ' + subPackageName + ', but something went wrong.\\n'\n\t\t+ 'This can happen if you use the \"--omit=optional\" or \"--no-optional\" npm flag, or\\n'\n\t\t+ 'if your \"node_modules\" folder was copied over from a different computer (or VM).\\n'\n\t);\n}\n"
  },
  {
    "path": "installers/npm/install.js",
    "content": "require('./binary.js')();\n"
  },
  {
    "path": "installers/npm/package.json",
    "content": "{\n  \"name\": \"elm\",\n  \"version\": \"0.19.1-6\",\n  \"description\": \"Installer for Elm: just downloads the binary into node_modules\",\n  \"license\": \"BSD-3-Clause\",\n  \"repository\": {\n    \"type\": \"git\",\n    \"url\": \"https://github.com/elm/compiler.git\"\n  },\n  \"homepage\": \"https://github.com/elm/compiler/tree/master/installers/npm\",\n  \"bugs\": \"https://github.com/elm/compiler/issues\",\n  \"author\": {\n    \"name\": \"Evan Czaplicki\",\n    \"email\": \"evan@elm-lang.org\",\n    \"url\": \"https://github.com/evancz\"\n  },\n  \"engines\": {\n    \"node\": \">=7.0.0\"\n  },\n  \"scripts\": {\n    \"install\": \"node install.js\"\n  },\n  \"files\": [\n    \"install.js\",\n    \"binary.js\",\n    \"bin\",\n    \"bin/elm\"\n  ],\n  \"keywords\": [\n    \"bin\",\n    \"binary\",\n    \"binaries\",\n    \"elm\",\n    \"install\",\n    \"installer\"\n  ],\n  \"bin\": { \"elm\": \"bin/elm\" },\n  \"optionalDependencies\": {\n    \"@elm_binaries/darwin_arm64\": \"0.19.1-0\",\n    \"@elm_binaries/darwin_x64\": \"0.19.1-0\",\n    \"@elm_binaries/linux_x64\": \"0.19.1-0\",\n    \"@elm_binaries/win32_x64\": \"0.19.1-0\"\n  }\n}\n"
  },
  {
    "path": "installers/npm/packages/darwin_arm64/README.md",
    "content": "# Elm Binary for macOS (arm64)\n\nSome people install [Elm](https://elm-lang.org/) with `npm`. This package helps make [`npm install elm`](https://www.npmjs.com/package/elm) a bit faster and a bit more reliable. It is not intended for direct use!\n\nIf you do not need to use `npm`, the official binaries are published via [GitHub releases](https://github.com/elm/compiler/releases) with installation instructions.\n"
  },
  {
    "path": "installers/npm/packages/darwin_arm64/package.json",
    "content": "{\n  \"name\": \"@elm_binaries/darwin_arm64\",\n  \"version\": \"0.19.1-0\",\n  \"description\": \"Download the Elm binary for macOS (arm64)\",\n  \"repository\": \"https://github.com/elm/compiler\",\n  \"license\": \"BSD-3-Clause\",\n  \"os\": [ \"darwin\" ],\n  \"cpu\": [ \"arm64\" ]\n}\n"
  },
  {
    "path": "installers/npm/packages/darwin_x64/README.md",
    "content": "# Elm Binary for macOS (x64)\n\nSome people install [Elm](https://elm-lang.org/) with `npm`. This package helps make [`npm install elm`](https://www.npmjs.com/package/elm) a bit faster and a bit more reliable. It is not intended for direct use!\n\nIf you do not need to use `npm`, the official binaries are published via [GitHub releases](https://github.com/elm/compiler/releases) with installation instructions.\n"
  },
  {
    "path": "installers/npm/packages/darwin_x64/package.json",
    "content": "{\n  \"name\": \"@elm_binaries/darwin_x64\",\n  \"version\": \"0.19.1-0\",\n  \"description\": \"Download the Elm binary for macOS (x64)\",\n  \"repository\": \"https://github.com/elm/compiler\",\n  \"license\": \"BSD-3-Clause\",\n  \"os\": [ \"darwin\" ],\n  \"cpu\": [ \"x64\" ]\n}\n"
  },
  {
    "path": "installers/npm/packages/linux_arm64/README.md",
    "content": "# Elm Binary for Linux (arm64)\n\nSome people install [Elm](https://elm-lang.org/) with `npm`. This package helps make [`npm install elm`](https://www.npmjs.com/package/elm) a bit faster and a bit more reliable. It is not intended for direct use!\n\nIf you do not need to use `npm`, the official binaries are published via [GitHub releases](https://github.com/elm/compiler/releases) with installation instructions.\n"
  },
  {
    "path": "installers/npm/packages/linux_arm64/package.json",
    "content": "{\n  \"name\": \"@elm_binaries/linux_arm64\",\n  \"version\": \"0.19.1-0\",\n  \"description\": \"Download the Elm binary for Linux (arm64)\",\n  \"repository\": \"https://github.com/elm/compiler\",\n  \"license\": \"BSD-3-Clause\",\n  \"os\": [ \"linux\" ],\n  \"cpu\": [ \"arm64\" ]\n}\n"
  },
  {
    "path": "installers/npm/packages/linux_x64/README.md",
    "content": "# Elm Binary for Linux (x64)\n\nSome people install [Elm](https://elm-lang.org/) with `npm`. This package helps make [`npm install elm`](https://www.npmjs.com/package/elm) a bit faster and a bit more reliable. It is not intended for direct use!\n\nIf you do not need to use `npm`, the official binaries are published via [GitHub releases](https://github.com/elm/compiler/releases) with installation instructions.\n"
  },
  {
    "path": "installers/npm/packages/linux_x64/package.json",
    "content": "{\n  \"name\": \"@elm_binaries/linux_x64\",\n  \"version\": \"0.19.1-0\",\n  \"description\": \"Download the Elm binary for Linux (x64)\",\n  \"repository\": \"https://github.com/elm/compiler\",\n  \"license\": \"BSD-3-Clause\",\n  \"os\": [ \"linux\" ],\n  \"cpu\": [ \"x64\" ]\n}\n"
  },
  {
    "path": "installers/npm/packages/win32_x64/README.md",
    "content": "# Elm Binary for Windows (x64)\n\nSome people install [Elm](https://elm-lang.org/) with `npm`. This package helps make [`npm install elm`](https://www.npmjs.com/package/elm) a bit faster and a bit more reliable. It is not intended for direct use!\n\nIf you do not need to use `npm`, the official binaries are published via [GitHub releases](https://github.com/elm/compiler/releases) with installation instructions.\n"
  },
  {
    "path": "installers/npm/packages/win32_x64/package.json",
    "content": "{\n  \"name\": \"@elm_binaries/win32_x64\",\n  \"version\": \"0.19.1-0\",\n  \"description\": \"Download the Elm binary for Windows (x64)\",\n  \"repository\": \"https://github.com/elm/compiler\",\n  \"license\": \"BSD-3-Clause\",\n  \"os\": [ \"win32\" ],\n  \"cpu\": [ \"x64\" ]\n}\n"
  },
  {
    "path": "installers/npm/troubleshooting.md",
    "content": "# Troubleshooting\n\nI very highly recommend asking for help on [the Elm slack](https://elmlang.herokuapp.com).\n\nThere are a lot of things that can go wrong when installing software, and it can really help to have a second pair of eyes on your situation!\n\nThis document goes through a couple options that may help you out.\n\n<br/>\n\n\n## Can you skip npm entirely?\n\nThe most reliable way to get Elm installed using the official installers for Mac and Windows [here][download].\n\nYou can also download the binaries directly. On Linux, you could do it in the terminal like this:\n\n```bash\ncd ~/Desktop/\ncurl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz\ngunzip elm.gz                # unzip the file\nchmod +x elm                 # make the file executable\nsudo mv elm /usr/local/bin/  # put the executable in a directory likely to be listed in your PATH variable\n```\n\nIf these exact commands do not work for you, you can try to do the same thing by hand.\n\nRead the section below on `PATH` variables if you are not sure what that is!\n\n[download]: https://github.com/elm/compiler/releases/tag/0.19.1\n\n<br/>\n\n\n## Do you need to use npm for some reason?\n\nThe company running npm has a list of common troubleshooting situations [here](https://npm.community/c/support/troubleshooting), but it may be better to just try to find your specific case on Stack Overflow. Often there are permissions issues where you may need to use `sudo` with some command.\n\n### Firewalls\n\nSome companies have a firewall.\n\nThese companies usually have set the `HTTP_PROXY` or `HTTPS_PROXY` environment variable on your computer. This is more common with Windows computers.\n\nThe result is that the requests for npm packages are being sent to a \"proxy server\" where they monitor traffic. Maybe they rule out certain domains, maybe they check data when it comes back from the actual URL, etc.\n\nIt is probably best to ask someone about the situation on this, but you can test things out by temporarily using an alternate `HTTPS_PROXY` value with something like this:\n\n```\n# Mac and Linux\nHTTPS_PROXY=http://proxy.example.com npm install -g elm\n\n# Windows\nset HTTPS_PROXY=http://proxy.example.com\nnpm install -g elm\n```\n\nCheck out [this document](https://docs.npmjs.com/cli/using-npm/config/) for more information on how environment variables like [NO_PROXY](https://docs.npmjs.com/cli/using-npm/config#noproxy), [HTTP_PROXY](https://docs.npmjs.com/cli/using-npm/config#proxy), and [HTTPS_PROXY](https://docs.npmjs.com/cli/using-npm/config#https-proxy) are handled by npm.\n\n<br/>\n\n\n## Do you know what a `PATH` variable is?\n\nWhen you run a command like `elm make src/Main.elm`, your computer starts by trying to find a file called `elm`.\n\nThe `PATH` is a list of directories to search within. On Mac and Linux, you can see these directories by running:\n\n```\n$ echo $PATH\n/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/local/git/bin\n```\n\nThe are separated by `:` for some reason. So running `elm make src/Main.elm` starts by searching the `PATH` for files named `elm`. On my computer, it finds `/usr/local/bin/elm` and then can actually run the command.\n\nIs `elm` in one of the directories listed in your `PATH` variable? I recommend asking for help if you are in this scenario and unsure how to proceed.\n"
  },
  {
    "path": "installers/win/CreateInternetShortcut.nsh",
    "content": "!macro CreateInternetShortcut FILENAME URL ICONFILE ICONINDEX\r\nWriteINIStr \"${FILENAME}.url\" \"InternetShortcut\" \"URL\" \"${URL}\"\r\nWriteINIStr \"${FILENAME}.url\" \"InternetShortcut\" \"IconFile\" \"${ICONFILE}\"\r\nWriteINIStr \"${FILENAME}.url\" \"InternetShortcut\" \"IconIndex\" \"${ICONINDEX}\"\r\n!macroend"
  },
  {
    "path": "installers/win/Nsisfile.nsi",
    "content": "; Elm Installer\r\n\r\n;--------------------------------\r\n;Includes\r\n\r\n  !Include \"FileFunc.nsh\"\r\n  !Include \"LogicLib.nsh\"\r\n  !Include \"MUI2.nsh\"\r\n  !Include \"WordFunc.nsh\"\r\n  !Include \"CreateInternetShortcut.nsh\"\r\n\r\n;--------------------------------\r\n;Defines\r\n\r\n  !Define PRODUCT_DIR_REG_KEY \"Software\\Elm\\Elm\\${PLATFORM_VERSION}\"\r\n  !Define FILES_SOURCE_PATH \"files\"\r\n  !Define INST_DAT \"inst.dat\"\r\n  !Define UNINST_DAT \"uninst.dat\"\r\n\r\n;--------------------------------\r\n;Variables\r\n\r\n  Var START_MENU_FOLDER\r\n\r\n;--------------------------------\r\n;General settings\r\n\r\n  ;Name and file\r\n  Name \"Elm ${PLATFORM_VERSION}\"\r\n  OutFile \"Elm-${PLATFORM_VERSION}.exe\"\r\n\r\n  ;Default install dir\r\n  InstallDir \"$PROGRAMFILES\\Elm\\${PLATFORM_VERSION}\"\r\n  InstallDirRegKey HKLM \"${PRODUCT_DIR_REG_KEY}\" \"\"\r\n\r\n  ;Icon\r\n  !Define MUI_ICON \"logo.ico\"\r\n  !Define MUI_UNICON \"logo.ico\"\r\n\r\n  ;Request application privileges for Windows Vista\r\n  RequestExecutionLevel highest\r\n\r\n  ;Best available compression\r\n  SetCompressor /SOLID lzma\r\n\r\n  ;Install types\r\n  InstType \"Standard\"\r\n  InstType \"Portable (just unpack the files)\"\r\n\r\n;--------------------------------\r\n;Macros\r\n\r\n!macro CheckAdmin thing\r\nUserInfo::GetAccountType\r\npop $0\r\n${If} $0 != \"admin\" ;Require admin rights on NT4+\r\n    MessageBox MB_YESNO \"It is recommended to run this ${thing} as administrator. Do you want to quit and restart the ${thing} manually with elevated privileges?\" IDNO CheckAdminDone\r\n    SetErrorLevel 740 ;ERROR_ELEVATION_REQUIRED\r\n    Quit\r\n${EndIf}\r\nCheckAdminDone:\r\n!macroend\r\n\r\n;--------------------------------\r\n;Callbacks\r\n\r\nFunction .onInit\r\n  !insertmacro CheckAdmin \"installer\"\r\n  SetShellVarContext all\r\nFunctionEnd\r\n\r\nFunction un.onInit\r\n  !insertmacro CheckAdmin \"uninstaller\"\r\n  SetShellVarContext all\r\nFunctionEnd\r\n\r\nFunction LaunchLink\r\n  ExecShell \"open\" \"https://guide.elm-lang.org\"\r\nFunctionEnd\r\n\r\n;--------------------------------\r\n;Interface Settings\r\n\r\n  !define MUI_ABORTWARNING\r\n\r\n;--------------------------------\r\n;Pages\r\n\r\n  !Define MUI_WELCOMEFINISHPAGE_BITMAP \"welcome.bmp\"\r\n  !insertmacro MUI_PAGE_WELCOME\r\n  ;!insertmacro MUI_PAGE_LICENSE \"LICENSE\"\r\n  !insertmacro MUI_PAGE_DIRECTORY\r\n\r\n  !Define MUI_COMPONENTSPAGE_NODESC\r\n  !insertmacro MUI_PAGE_COMPONENTS\r\n\r\n  ;Start Menu Folder Page Configuration\r\n  !Define MUI_PAGE_HEADER_SUBTEXT \\\r\n  \"Choose a Start Menu folder for the Elm ${PLATFORM_VERSION} shortcuts.\"\r\n  !Define MUI_STARTMENUPAGE_TEXT_TOP \\\r\n  \"Select the Start Menu folder in which you would like to create Elm shortcuts. You can also enter a name to create a new folder.\"\r\n  !Define MUI_STARTMENUPAGE_REGISTRY_ROOT \"HKLM\"\r\n  !Define MUI_STARTMENUPAGE_REGISTRY_KEY \"${PRODUCT_DIR_REG_KEY}\"\r\n  !Define MUI_STARTMENUPAGE_REGISTRY_VALUENAME \"Start Menu Folder\"\r\n  !Define MUI_STARTMENUPAGE_DEFAULTFOLDER \"Elm ${PLATFORM_VERSION}\"\r\n  !insertmacro MUI_PAGE_STARTMENU StartMenuPage $START_MENU_FOLDER\r\n  !insertmacro MUI_PAGE_INSTFILES\r\n  !define MUI_FINISHPAGE_RUN\r\n  !define MUI_FINISHPAGE_RUN_FUNCTION \"LaunchLink\"\r\n  !define MUI_FINISHPAGE_RUN_TEXT \"Open tutorial on how to use Elm\"\r\n  !insertmacro MUI_PAGE_FINISH\r\n\r\n  !insertmacro MUI_UNPAGE_WELCOME\r\n  !insertmacro MUI_UNPAGE_CONFIRM\r\n  !insertmacro MUI_UNPAGE_INSTFILES\r\n  !insertmacro MUI_UNPAGE_FINISH\r\n\r\n;--------------------------------\r\n;Languages\r\n\r\n  !insertmacro MUI_LANGUAGE \"English\"\r\n\r\n;--------------------------------\r\n;Installer Sections\r\n\r\nSection \"Base components\" SecMain\r\n\r\n  SectionIn 1 2\r\n  ; Make this section mandatory\r\n  SectionIn RO\r\n\r\n  !Include ${INST_DAT}\r\n\r\nSectionEnd\r\n\r\nSectionGroup \"Update system settings\" SecGr\r\n\r\n;Section \"Associate with .elm files\" SecAssoc\r\n;\r\n;  SectionIn 1\r\n;\r\n;  ; File associations\r\n;  WriteRegStr HKCR \".elm\" \"\" \"elm\"\r\n;  WriteRegStr HKCR \"elm\" \"\" \"Elm Source File\"\r\n;  WriteRegStr HKCR \"elm\\DefaultIcon\" \"\" \"$INSTDIR\\file.ico\"\r\n;  WriteRegStr HKCR \"elm\\shell\\open\\command\" \"\" '\"$INSTDIR\\bin\\elm.exe\" \"%1\"'\r\n;\r\n;  ;Remember that we registered associations\r\n;  WriteRegDWORD HKLM \"${PRODUCT_DIR_REG_KEY}\" Assocs 0x1\r\n;\r\n;SectionEnd\r\n\r\nSection \"Update the PATH environment variable\" SecPath\r\n\r\n  SectionIn 1\r\n\r\n  ; Update PATH\r\n  ; First, remove any older version\r\n  ExecWait '\"$SYSDIR\\wscript.exe\" //E:vbscript \"$INSTDIR\\removefrompath.vbs\" \"$PROGRAMFILES\\Elm\"'\r\n  ; Then add to the PATH\r\n  ExecWait '\"$SYSDIR\\wscript.exe\" //E:vbscript \"$INSTDIR\\updatepath.vbs\" \"$INSTDIR\\bin\"'\r\n  SetShellVarContext current\r\n\r\n  ; Update environment variables\r\n  SendMessage ${HWND_BROADCAST} ${WM_SETTINGCHANGE} 0 \"STR:Environment\" /TIMEOUT=5000\r\n\r\nSectionEnd\r\n\r\nSection \"Store Elm's location in registry\" SecElmLoc\r\n\r\n  SectionIn 1\r\n\r\n  ; (copied from the GHC installer).\r\n  ;WriteRegStr HKCU \"Software\\Elm\\ghc-${GHC_VERSION}\" \"InstallDir\" \"$INSTDIR\"\r\n  WriteRegStr HKCU \"Software\\Elm\" \"InstallDir\" \"$INSTDIR\"\r\n\r\nSectionEnd\r\n\r\nSection \"Create uninstaller\" SecAddRem\r\n\r\n  SectionIn 1\r\n  SectionIn RO\r\n\r\n  ; Add uninstall information to Add/Remove Programs\r\n  WriteRegStr HKLM \"Software\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\Elm-${PLATFORM_VERSION}\" \\\r\n  \"DisplayName\" \"Elm ${PLATFORM_VERSION}\"\r\n  WriteRegStr HKLM \"Software\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\Elm-${PLATFORM_VERSION}\" \\\r\n  \"UninstallString\" \"$\\\"$INSTDIR\\Uninstall.exe$\\\"\"\r\n  WriteRegStr HKLM \"Software\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\Elm-${PLATFORM_VERSION}\" \\\r\n  \"DisplayIcon\" \"$INSTDIR\\logo.ico\"\r\n  WriteRegStr HKLM \"Software\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\Elm-${PLATFORM_VERSION}\" \\\r\n  \"Publisher\" \"elm-lang.org\"\r\n\r\n  ;Create uninstaller\r\n  WriteUninstaller \"$INSTDIR\\Uninstall.exe\"\r\n\r\n  ; This is needed for uninstaller to work\r\n  WriteRegStr HKLM \"${PRODUCT_DIR_REG_KEY}\" \"\" \"$INSTDIR\\Uninstall.exe\"\r\n  WriteRegStr HKLM \"${PRODUCT_DIR_REG_KEY}\" \"InstallDir\" \"$INSTDIR\"\r\n\r\nSectionEnd\r\n\r\nSectionGroupEnd\r\n\r\n;Section \"-StartMenu\" StartMenu\r\n;  SectionIn 1 2\r\n;\r\n;  ; Add start menu shortcuts\r\n;\r\n;  !insertmacro MUI_STARTMENU_WRITE_BEGIN StartMenuPage\r\n;\r\n;    ;Create shortcuts\r\n;    CreateDirectory \"$SMPROGRAMS\\$START_MENU_FOLDER\"\r\n;    !insertmacro CreateInternetShortcut \\\r\n;    \"$SMPROGRAMS\\$START_MENU_FOLDER\\${HACKAGE_SHORTCUT_TEXT}\" \\\r\n;    \"http://hackage.haskell.org\" \\\r\n;    \"$INSTDIR\\icons\\hackage.ico\" \"0\"\r\n;  !insertmacro MUI_STARTMENU_WRITE_END\r\n;\r\n;SectionEnd\r\n\r\n;--------------------------------\r\n;Uninstaller Section\r\n\r\nSection \"Uninstall\"\r\n\r\n  ; Update PATH\r\n  ExecWait '\"$SYSDIR\\wscript.exe\" //E:vbscript \"$INSTDIR\\removefrompath.vbs\" \"$PROGRAMFILES\\Elm\"'\r\n  SetShellVarContext current\r\n\r\n  !Include ${UNINST_DAT}\r\n\r\n  Delete \"$INSTDIR\\Uninstall.exe\"\r\n  RMDir $INSTDIR\r\n\r\n  ;Since we install to '$PF\\Elm\\$PLATFORM_VERSION', we\r\n  ;should also try to delete '$PF\\Elm' if it is empty.\r\n  ${GetParent} $INSTDIR $R0\r\n  RMDir $R0\r\n\r\n  ; Delete start menu shortcuts\r\n  ;!insertmacro MUI_STARTMENU_GETFOLDER StartMenuPage $START_MENU_FOLDER\r\n\r\n  ;Delete \"$SMPROGRAMS\\$START_MENU_FOLDER\\${HACKAGE_SHORTCUT_TEXT}.url\"\r\n  ;RMDir \"$SMPROGRAMS\\$START_MENU_FOLDER\\\"\r\n\r\n  ; Delete registry keys\r\n\r\n  ReadRegDWORD $0 HKLM \"${PRODUCT_DIR_REG_KEY}\" Assocs\r\n\r\n  ${If} $0 = 0x1\r\n    DeleteRegValue HKCR \".elm\" \"\"\r\n    DeleteRegKey HKCR \"elm\\DefaultIcon\"\r\n  ${EndIf}\r\n\r\n  DeleteRegKey HKCU \"Software\\Elm\"\r\n  DeleteRegKey HKLM \"${PRODUCT_DIR_REG_KEY}\"\r\n  DeleteRegKey /IfEmpty HKCU Software\\Elm\r\n  DeleteRegKey HKLM \"Software\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\Elm-${PLATFORM_VERSION}\"\r\n\r\n  ; Update environment variables\r\n  SendMessage ${HWND_BROADCAST} ${WM_SETTINGCHANGE} 0 \"STR:Environment\" /TIMEOUT=5000\r\n\r\nSectionEnd\r\n"
  },
  {
    "path": "installers/win/README.md",
    "content": "# Installing on Windows\n\nThe installer for Windows is available [here](https://guide.elm-lang.org/install.html).\n\n\n<br/>\n\n## Uninstall\n\nFirst run the `C:\\Program Files (x86)\\Elm\\0.19\\uninstall.exe` file. This will remove Elm stuff from your `PATH`.\n\nThen remove the whole `C:\\Users\\<username>\\AppData\\Roaming\\elm` directory. Elm caches some packages and build artifacts to reduce compile times and to help you work offline. Getting rid of this directory will clear that information out!\n\n<br/>\n\n## Building the Windows installer\n\nYou will need the [NSIS installer](http://nsis.sourceforge.net/Download) to be installed.\n\nOnce everything is installed, run something like this command:\n\n    make_installer.cmd 0.19.0\n\nIt will build an installer called `Elm-0.19.0-setup.exe`.\n"
  },
  {
    "path": "installers/win/make_installer.cmd",
    "content": "\r\nset version=%1\r\n\r\nmkdir files\r\nmkdir files\\bin\r\n\r\nxcopy ..\\..\\dist\\build\\elm\\elm.exe files\\bin /s /e\r\nxcopy updatepath.vbs files\r\n\r\nif EXIST \"%ProgramFiles%\\NSIS\" (\r\n    set nsis=\"%ProgramFiles%\\NSIS\\makensis.exe\"\r\n) else (\r\n    set nsis=\"%ProgramFiles(x86)%\\NSIS\\makensis.exe\"\r\n)\r\n\r\n%nsis% /DPLATFORM_VERSION=%version% Nsisfile.nsi\r\n\r\nrd /s /q files\r\n"
  },
  {
    "path": "installers/win/removefrompath.vbs",
    "content": "Set WshShell = CreateObject(\"WScript.Shell\")\n' Make sure there is no trailing slash at the end of elmBasePath\nelmBasePath = WScript.Arguments(0)\n'const PathRegKey = \"HKLM\\SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment\\Path\"\nconst PathRegKey = \"HKCU\\Environment\\Path\"\n\non error resume next\npath = WshShell.RegRead(PathRegKey)\nif err.number = 0 then\n\tSet regEx = New RegExp\n\telmBasePath = Replace(Replace(Replace(elmBasePath, \"\\\", \"\\\\\"), \"(\", \"\\(\"), \")\", \"\\)\")\n\tregEx.Pattern = elmBasePath & \"\\\\\\d+\\.\\d+(\\.\\d+|)\\\\bin(;|)\"\n\tregEx.Global = True\n\tnewPath = regEx.Replace(path, \"\")\n\tCall WshShell.RegWrite(PathRegKey, newPath, \"REG_EXPAND_SZ\")\nend if\non error goto 0\n"
  },
  {
    "path": "installers/win/updatepath.vbs",
    "content": "Set WshShell = CreateObject(\"WScript.Shell\")\nelmPath = WScript.Arguments(0)\n'const PathRegKey = \"HKLM\\SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment\\Path\"\nconst PathRegKey = \"HKCU\\Environment\\Path\"\n\non error resume next\npath = WshShell.RegRead(PathRegKey)\nif err.number <> 0 then\n\tpath = \"\"\nend if\non error goto 0\n\nnewPath = elmPath & \";\" & path\nCall WshShell.RegWrite(PathRegKey, newPath, \"REG_EXPAND_SZ\")\n"
  },
  {
    "path": "reactor/assets/styles.css",
    "content": "@charset \"UTF-8\";\n\n\n/* FONTS */\n\n@font-face {\n  font-family: 'Source Code Pro';\n  font-style: normal;\n  font-weight: 400;\n  src: local('Source Code Pro'), local('SourceCodePro-Regular'), url(/_elm/source-code-pro.ttf) format('truetype');\n}\n\n@font-face {\n  font-family: 'Source Sans Pro';\n  font-style: normal;\n  font-weight: 400;\n  src: local('Source Sans Pro'), local('SourceSansPro-Regular'), url(/_elm/source-sans-pro.ttf) format('truetype');\n}\n\n\n/* GENERIC STUFF */\n\nhtml, head, body {\n  margin: 0;\n  height: 100%;\n}\n\nbody {\n  font-family: 'Source Sans Pro', 'Trebuchet MS', 'Lucida Grande', 'Bitstream Vera Sans', 'Helvetica Neue', sans-serif;\n  color: #293c4b;\n}\n\na {\n  color: #60B5CC;\n  text-decoration: none;\n}\n\na:hover {\n  text-decoration: underline;\n}\n\n\n/* INDEX */\n\n.header {\n  width: 100%;\n  background-color: #60B5CC;\n  height: 8px;\n}\n\n.content {\n  width: 960px;\n  margin-left: auto;\n  margin-right: auto;\n}\n\n\n/* COLUMNS */\n\n.left-column {\n  float: left;\n  width: 600px;\n  padding-bottom: 80px;\n}\n\n.right-column {\n  float: right;\n  width: 300px;\n  padding-bottom: 80px;\n}\n\n\n/* BOXES */\n\n.box {\n  border: 1px solid #c7c7c7;\n  border-radius: 5px;\n  margin-bottom: 40px;\n}\n\n.box-header {\n  display: block;\n  overflow: hidden;\n  padding: 7px 12px;\n  background-color: #fafafa;\n  text-align: center;\n  border-radius: 5px;\n}\n\n.box-item {\n  display: block;\n  overflow: hidden;\n  padding: 7px 12px;\n  border-top: 1px solid #e1e1e1;\n}\n\n.box-footer {\n  display: block;\n  overflow: hidden;\n  padding: 2px 12px;\n  border-top: 1px solid #e1e1e1;\n  text-align: center;\n  background-color: #fafafa;\n  height: 16px;\n}\n\n\n/* ICONS */\n\n.icon {\n  display: inline-block;\n  vertical-align: middle;\n  padding-right: 0.5em;\n}\n\n\n/* PAGES */\n\n.page-name {\n  float: left;\n}\n\n.page-size {\n  float: right;\n  color: #293c4b;\n}\n\n.page-size:hover {\n  color: #60B5CC;\n}\n\n\n/* WAITING */\n\n.waiting {\n  width: 100%;\n  height: 100%;\n  display: flex;\n  flex-direction: column;\n  justify-content: center;\n  align-items: center;\n  color: #9A9A9A;\n}\n\n\n/* NOT FOUND */\n\n.not-found {\n  width: 100%;\n  height: 100%;\n  display: flex;\n  flex-direction: column;\n  justify-content: center;\n  align-items: center;\n  background-color: #F5F5F5;\n  color: #9A9A9A;\n}\n"
  },
  {
    "path": "reactor/check.py",
    "content": "#!/usr/bin/env python\n\nimport os\nimport sys\n\n\n## FIGURE OUT NEW MODIFICATION TIME\n\ndef mostRecentModification(directory):\n\tmostRecent = 0\n\n\tfor dirpath, dirs, files in os.walk(directory):\n\t\tfor f in files:\n\t\t\tlastModified = os.path.getmtime(dirpath + '/' + f)\n\t\t\tmostRecent = max(int(lastModified), mostRecent)\n\n\treturn mostRecent\n\n\nsrcTime = mostRecentModification('ui/src')\nassetTime = mostRecentModification('ui/assets')\nmostRecent = max(srcTime, assetTime)\n\n\n## FIGURE OUT OLD MODIFICATION TIME\n\nwith open('ui/last-modified', 'a') as handle:\n\tpass\n\n\nprevMostRecent = 0\n\n\nwith open('ui/last-modified', 'r+') as handle:\n\tline = handle.read()\n\tprevMostRecent = int(line) if line else 0\n\n\n## TOUCH FILES IF NECESSARY\n\nif mostRecent > prevMostRecent:\n\tprint \"+------------------------------------------------------------+\"\n\tprint \"| Some ui/ code changed. Touching src/Reactor/StaticFiles.hs |\"\n\tprint \"| to trigger a recompilation of the Template Haskell stuff.  |\"\n\tprint \"+------------------------------------------------------------+\"\n\tos.utime('src/Reactor/StaticFiles.hs', None)\n\twith open('ui/last-modified', 'w') as handle:\n\t\thandle.write(str(mostRecent))\n"
  },
  {
    "path": "reactor/elm.json",
    "content": "{\n    \"type\": \"application\",\n    \"source-directories\": [\n        \"src\"\n    ],\n    \"elm-version\": \"0.19.1\",\n    \"dependencies\": {\n        \"direct\": {\n            \"elm/browser\": \"1.0.1\",\n            \"elm/core\": \"1.0.2\",\n            \"elm/html\": \"1.0.0\",\n            \"elm/http\": \"2.0.0\",\n            \"elm/json\": \"1.1.2\",\n            \"elm/project-metadata-utils\": \"1.0.0\",\n            \"elm/svg\": \"1.0.1\",\n            \"elm-explorations/markdown\": \"1.0.0\"\n        },\n        \"indirect\": {\n            \"elm/bytes\": \"1.0.7\",\n            \"elm/file\": \"1.0.1\",\n            \"elm/parser\": \"1.1.0\",\n            \"elm/time\": \"1.0.0\",\n            \"elm/url\": \"1.0.0\",\n            \"elm/virtual-dom\": \"1.0.2\"\n        }\n    },\n    \"test-dependencies\": {\n        \"direct\": {},\n        \"indirect\": {}\n    }\n}\n"
  },
  {
    "path": "reactor/src/Deps.elm",
    "content": "module Deps exposing (main)\n\n\nimport Browser\nimport Browser.Dom as Dom\nimport Dict exposing (Dict)\nimport Elm.Constraint as Constraint exposing (Constraint)\nimport Html exposing (..)\nimport Html.Attributes exposing (..)\nimport Html.Events exposing (..)\nimport Html.Keyed as Keyed\nimport Html.Lazy exposing (..)\nimport Http\nimport Json.Decode as D\nimport Json.Encode as E\nimport Svg\nimport Svg.Attributes as S\nimport Task\n\n\n\n-- MAIN\n\n\nmain =\n  Browser.document\n    { init = init\n    , view = view\n    , update = update\n    , subscriptions = \\_ -> Sub.none\n    }\n\n\n\n-- MODEL\n\n\ntype alias Model =\n  { status : Status\n  , id : Int\n  -- queries\n  , search : Search\n  , registry : Registry\n  -- history\n  , past : List Change\n  , future : List Change\n  , origin : Origin\n  }\n\n\n\n-- STATUS\n\n\ntype Status\n  = Failure Checkpoint (List Change)\n  | Waiting Checkpoint (List Change)\n  | Success Checkpoint\n\n\ntype alias Checkpoint =\n  { direct : Dict String Bounds\n  , indirect : Dict String Bounds\n  }\n\n\ntype Bounds\n  = New Version NewBounds\n  | Old Version Version OldBounds\n\n\ntype NewBounds\n  = NAny\n  | NCustom Constraint\n\n\ntype OldBounds\n  = OLocked\n  | OPatch\n  | OMinor\n  | OMajor\n  | OAny\n  | OCustom Constraint\n\n\n\n-- CHANGES\n\n\ntype Change\n  = MassLock\n  | MassPatch\n  | MassMinor\n  | MassMajor\n  | AddDirect String\n  | TweakOldDirect String OldBounds\n  | TweakNewDirect String NewBounds\n  | TweakOldIndirect String OldBounds\n  | TweakNewIndirect String NewBounds\n  | DeleteDirect String\n  | DeleteIndirect String\n\n\n\n-- PREVIEW\n\n\ntype alias Preview =\n  { direct : Dict String PBounds\n  , indirect : Dict String PBounds\n  }\n\n\ntype PBounds\n  = PNew (Maybe Version) NewBounds\n  | POld Version Version OldBounds\n\n\ntoPreview : Origin -> Checkpoint -> List Change -> Preview\ntoPreview origin checkpoint changes =\n  let\n    toPreviewBounds _ bounds =\n      case bounds of\n        New vsn nb     -> PNew (Just vsn) nb\n        Old old new ob -> POld old new ob\n\n    start =\n      { direct   = Dict.map toPreviewBounds checkpoint.direct\n      , indirect = Dict.map toPreviewBounds checkpoint.indirect\n      }\n  in\n  List.foldr (step origin) start changes\n\n\nstep : Origin -> Change -> Preview -> Preview\nstep origin change preview =\n  case change of\n    MassLock ->\n      massChange OLocked preview\n\n    MassPatch ->\n      massChange OPatch preview\n\n    MassMinor ->\n      massChange OMinor preview\n\n    MassMajor ->\n      massChange OMajor preview\n\n    AddDirect pkg ->\n      let\n        pBound =\n          case Dict.get pkg origin.direct of\n            Just vsn -> POld vsn vsn OLocked\n            Nothing ->\n              case Dict.get pkg origin.indirect of\n                Just vsn -> POld vsn vsn OLocked\n                Nothing -> PNew Nothing NAny\n      in\n      { direct = Dict.insert pkg pBound preview.direct\n      , indirect = Dict.remove pkg preview.indirect\n      }\n\n    TweakOldDirect pkg oldBounds ->\n      { direct = Dict.update pkg (alterOld oldBounds) preview.direct\n      , indirect = preview.indirect\n      }\n\n    TweakNewDirect pkg newBounds ->\n      { direct = Dict.update pkg (alterNew newBounds) preview.direct\n      , indirect = preview.indirect\n      }\n\n    TweakOldIndirect pkg oldBounds ->\n      { direct = preview.direct\n      , indirect = Dict.update pkg (alterOld oldBounds) preview.indirect\n      }\n\n    TweakNewIndirect pkg newBounds ->\n      { direct = preview.direct\n      , indirect = Dict.update pkg (alterNew newBounds) preview.indirect\n      }\n\n    DeleteDirect pkg ->\n      { direct = Dict.remove pkg preview.direct\n      , indirect = preview.indirect\n      }\n\n    DeleteIndirect pkg ->\n      { direct = preview.direct\n      , indirect = Dict.remove pkg preview.indirect\n      }\n\n\nmassChange : OldBounds -> Preview -> Preview\nmassChange oldBounds preview =\n  let\n    changeBounds _ bounds =\n      case bounds of\n        PNew vsn newBounds -> PNew vsn newBounds\n        POld old new _ -> POld old new oldBounds\n  in\n  { direct   = Dict.map changeBounds preview.direct\n  , indirect = Dict.map changeBounds preview.indirect\n  }\n\n\nalterOld : OldBounds -> Maybe PBounds -> Maybe PBounds\nalterOld ob maybeBounds =\n  case maybeBounds of\n    Nothing ->\n      Nothing\n\n    Just bounds ->\n      case bounds of\n        PNew vsn nb    -> Just (PNew vsn nb)\n        POld old new _ -> Just (POld old new ob)\n\n\nalterNew : NewBounds -> Maybe PBounds -> Maybe PBounds\nalterNew nb maybeBounds =\n  case maybeBounds of\n    Nothing ->\n      Nothing\n\n    Just bounds ->\n      case bounds of\n        PNew vsn _      -> Just (PNew vsn nb)\n        POld old new ob -> Just (POld old new ob)\n\n\n\n-- INIT\n\n\ninit : () -> (Model, Cmd Msg)\ninit () =\n  let\n    origin = startTODO\n    chkp = toInitialCheckpoint origin\n  in\n  await chkp []\n    { status = Waiting chkp []\n    , id = 0\n    , search = { query = \"\", focus = Nothing }\n    , registry = registryTODO\n    , past = []\n    , future = []\n    , origin = origin\n    }\n\n\ntype alias Origin =\n  { direct : Dict String Version\n  , indirect : Dict String Version\n  }\n\n\nstartTODO : Origin\nstartTODO =\n  { direct =\n      Dict.fromList\n        [ (\"elm/browser\", Version 1 0 1)\n        , (\"elm/core\", Version 1 0 2)\n        , (\"elm/html\", Version 1 0 0)\n        , (\"elm/http\", Version 2 0 0)\n        , (\"elm/json\", Version 1 1 2)\n        , (\"elm/project-metadata-utils\", Version 1 0 0)\n        , (\"elm/svg\", Version 1 0 1)\n        , (\"elm-explorations/markdown\", Version 1 0 0)\n        ]\n  , indirect =\n      Dict.fromList\n        [ (\"elm/parser\", Version 1 1 0)\n        , (\"elm/time\", Version 1 0 0)\n        , (\"elm/url\", Version 1 0 0)\n        , (\"elm/virtual-dom\", Version 1 0 2)\n        ]\n  }\n\n\n\n-- CHECKPOINTS\n\n\ntoInitialCheckpoint : Origin -> Checkpoint\ntoInitialCheckpoint origin =\n  { direct   = Dict.map (\\_ v -> Old v v OLocked) origin.direct\n  , indirect = Dict.map (\\_ v -> Old v v OLocked) origin.indirect\n  }\n\n\ntoCheckpoint : Dict String Version -> Preview -> Maybe Checkpoint\ntoCheckpoint solution preview =\n  let\n    direct   = Dict.foldr (addBound solution) Dict.empty preview.direct\n    indirect = Dict.foldr (addBound solution) Dict.empty preview.indirect\n  in\n  if Dict.size direct == Dict.size preview.direct then\n    Just (Checkpoint direct indirect)\n  else\n    Nothing\n\n\naddBound : Dict String Version -> String -> PBounds -> Dict String Bounds -> Dict String Bounds\naddBound solution pkg bounds dict =\n  case Dict.get pkg solution of\n    Nothing ->\n      dict\n\n    Just new ->\n      case bounds of\n        PNew _ newBounds ->\n          Dict.insert pkg (New new newBounds) dict\n\n        POld old _ oldBounds ->\n          Dict.insert pkg (Old old new oldBounds) dict\n\n\n\n-- UPDATE\n\n\ntype Msg\n  = NoOp\n  | Commit Change\n  | Undo\n  | Redo\n  | GotSolution Int (Result Http.Error (Dict String Version))\n  | SearchTouched SearchMsg\n\n\nupdate : Msg -> Model -> (Model, Cmd Msg)\nupdate msg model =\n  case Debug.log \"msg\" msg of\n    NoOp ->\n      ( model, Cmd.none )\n\n    Commit latest ->\n      let (checkpoint, changes) = getCheckpoint model.status in\n      await checkpoint (latest::changes) { model | future = [] }\n\n    Undo ->\n      case getCheckpoint model.status of\n        (checkpoint, latest :: previous) ->\n          await checkpoint previous { model | future = latest :: model.future }\n\n        (_, []) ->\n          case model.past of\n            [] -> ( model, Cmd.none )\n\n            latest :: previous ->\n              await (toInitialCheckpoint model.origin) previous\n                { model | past = [], future = latest :: model.future }\n\n    Redo ->\n      case model.future of\n        [] ->\n          ( model, Cmd.none )\n\n        next :: nexterer ->\n          let (checkpoint, changes) = getCheckpoint model.status in\n          await checkpoint (next::changes) { model | future = nexterer }\n\n    GotSolution id result ->\n      if model.id /= id then\n        ( model, Cmd.none )\n      else\n        let\n          (oldCheckpoint, changes) = getCheckpoint model.status\n        in\n        case result of\n          Err _ ->\n            ( { model | status = Failure oldCheckpoint changes }, Cmd.none )\n\n          Ok solution ->\n            case toCheckpoint solution (toPreview model.origin oldCheckpoint changes) of\n              Nothing ->\n                ( { model | status = Failure oldCheckpoint changes }\n                , Cmd.none\n                )\n\n              Just newCheckpoint ->\n                ( { model\n                      | status = Success newCheckpoint\n                      , past = changes ++ model.past\n                  }\n                , Cmd.none\n                )\n\n    SearchTouched searchMsg ->\n      case updateSearch model.registry searchMsg model.search of\n        SNone ->\n          ( model, Cmd.none )\n\n        SUpdate newSearch ->\n          ( { model | search = newSearch }\n          , Cmd.none\n          )\n\n        SManualBlur newSearch ->\n          ( { model | search = newSearch }\n          , Task.attempt (\\_ -> NoOp) (Dom.blur searchDepsID)\n          )\n\n        SAdd name ->\n          let (checkpoint, changes) = getCheckpoint model.status in\n          await checkpoint (AddDirect name :: changes)\n            { model\n                | search = { query = \"\", focus = Nothing }\n                , future = []\n            }\n\n\ngetCheckpoint : Status -> (Checkpoint, List Change)\ngetCheckpoint status =\n  case status of\n    Failure chkp cs -> (chkp, cs)\n    Waiting chkp cs -> (chkp, cs)\n    Success chkp    -> (chkp, [])\n\n\nawait : Checkpoint -> List Change -> Model -> (Model, Cmd Msg)\nawait checkpoint changes model =\n  let\n    id = model.id + 1\n    preview = toPreview model.origin checkpoint changes\n  in\n  (\n    { model\n        | status = Waiting checkpoint changes\n        , id = id\n    }\n  ,\n    Http.post\n      { url = \"/elm-stuff/solve\"\n      , body =\n          Http.jsonBody <|\n            E.object\n              [ (\"direct\", E.dict identity encodeConstraint preview.direct)\n              , (\"indirect\", E.dict identity encodeConstraint preview.indirect)\n              ]\n      , expect = Http.expectJson (GotSolution id) solutionDecoder\n      }\n  )\n\n\n\n-- VIEW\n\n\nview : Model -> Browser.Document Msg\nview model =\n  { title = \"elm.json\"\n  , body =\n      [ span\n          [ style \"width\" \"calc(100% - 500px - 2em)\"\n          , style \"position\" \"fixed\"\n          , style \"top\" \"0\"\n          , style \"left\" \"0\"\n          , style \"bottom\" \"0\"\n          , style \"overflow-x\" \"hidden\"\n          , style \"overflow-y\" \"scroll\"\n          , style \"filter\" \"blur(4px)\"\n          , style \"white-space\" \"pre\"\n          , style \"font-family\" \"monospace\"\n          ]\n          [ text elmJson\n          ]\n      , viewEditPanel model\n      ]\n  }\n\n\nviewEditPanel : Model -> Html Msg\nviewEditPanel model =\n  div\n    [ style \"width\" \"500px\"\n    , style \"position\" \"fixed\"\n    , style \"top\" \"0\"\n    , style \"right\" \"0\"\n    , style \"bottom\" \"0\"\n    , style \"overflow-y\" \"scroll\"\n    , style \"background-color\" \"white\"\n    , style \"padding\" \"1em\"\n    ]\n    [ node \"style\" [] [ text styles ]\n    , div\n        [ style \"display\" \"flex\"\n        , style \"justify-content\" \"space-between\"\n        ]\n        [ viewMassUpdates\n        , lazy3 viewUndoRedo model.status model.past model.future\n        ]\n    , div\n        [ style \"display\" \"flex\"\n        , style \"justify-content\" \"space-between\"\n        , style \"align-items\" \"center\"\n        ]\n        [ h2 [] [ text \"Dependencies\" ]\n        , Html.map SearchTouched <|\n            lazy4 viewSearch searchDepsID \"Package Search\" model.registry model.search\n        ]\n    , lazy2 viewStatus model.origin model.status\n    ]\n\n\nviewMassUpdates : Html Msg\nviewMassUpdates =\n  div []\n    [ text \"Mass Updates: \"\n    , activeButton (Commit MassLock ) (text \"LOCK\")\n    , activeButton (Commit MassPatch) (text \"PATCH\")\n    , activeButton (Commit MassMinor) (text \"MINOR\")\n    , activeButton (Commit MassMajor) (text \"MAJOR\")\n    ]\n\n\nviewUndoRedo : Status -> List Change -> List Change -> Html Msg\nviewUndoRedo status past future =\n  let\n    hasNoPast =\n      List.isEmpty past &&\n      case status of\n        Failure _ cs -> List.isEmpty cs\n        Waiting _ cs -> List.isEmpty cs\n        Success _    -> True\n\n    hasNoFuture =\n      List.isEmpty future\n  in\n  div []\n    [ if hasNoPast   then inactiveButton undoIcon else activeButton Undo undoIcon\n    , if hasNoFuture then inactiveButton redoIcon else activeButton Redo redoIcon\n    ]\n\n\nactiveButton : msg -> Html msg -> Html msg\nactiveButton msg content =\n  button [ class \"button\", onClick msg ] [ content ]\n\n\ninactiveButton : Html msg -> Html msg\ninactiveButton content =\n  button [ class \"button-inactive\" ] [ content ]\n\n\n\n-- VIEW STATUS\n\n\nviewStatus : Origin -> Status -> Html Msg\nviewStatus origin status =\n  let\n    (directs, indirects) = viewStatusRows origin status\n  in\n  div []\n    [ viewTable \"Direct\"   <| Dict.toList directs\n    , viewTable \"Indirect\" <| Dict.toList indirects\n    ]\n\n\nviewStatusRows : Origin -> Status -> (Dict String (Html Msg), Dict String (Html Msg))\nviewStatusRows origin status =\n  case status of\n    Failure checkpoint changes ->\n      let preview = toPreview origin checkpoint changes in\n      ( Dict.map (lazy2 viewWaitingRow) preview.direct\n      , Dict.map (lazy2 viewWaitingRow) preview.indirect\n      )\n\n    Waiting checkpoint changes ->\n      let preview = toPreview origin checkpoint changes in\n      ( Dict.map (lazy2 viewWaitingRow) preview.direct\n      , Dict.map (lazy2 viewWaitingRow) preview.indirect\n      )\n\n    Success checkpoint ->\n      ( Dict.map (lazy2 viewSuccessRow) checkpoint.direct\n      , Dict.map (lazy2 viewSuccessRow) checkpoint.indirect\n      )\n\n\nviewSuccessRow : String -> Bounds -> Html Msg\nviewSuccessRow pkg bounds =\n  case bounds of\n    New version newBounds ->\n      viewRow pkg (RowNew version)\n\n    Old old new oldBounds ->\n      viewRow pkg (RowOld old new)\n\n\nviewWaitingRow : String -> PBounds -> Html Msg\nviewWaitingRow pkg bounds =\n  case bounds of\n    PNew vsn newBounds ->\n      viewRow pkg (RowNewGuess vsn)\n\n    POld old new oldBounds ->\n      viewRow pkg (RowOldGuess old new)\n\n\n\n-- VIEW TABLE\n\n\nviewTable : String -> List (String, Html Msg) -> Html Msg\nviewTable title rows =\n  table [ style \"padding-bottom\" \"1em\" ]\n    [ viewColgroup\n    , thead [] [ tr [] [ td [ class \"table-title\" ] [ text title ] ] ]\n    , Keyed.node \"tbody\" [] rows\n    ]\n\n\nviewColgroup : Html msg\nviewColgroup =\n  colgroup []\n    [ col [ style \"width\" \"350px\" ] []\n    , col [ style \"width\" \"50px\" ] []\n    , col [ style \"width\" \"50px\" ] []\n    , col [ style \"width\" \"50px\" ] []\n    ]\n\n\ntype RowInfo\n  = RowNew Version\n  | RowOld Version Version\n  | RowNewGuess (Maybe Version)\n  | RowOldGuess Version Version\n\n\nviewRow : String -> RowInfo -> Html msg\nviewRow pkg info =\n  case info of\n    RowNew vsn ->\n      viewRowHelp pkg (text \"\") (text \"\") (viewVersion \"black\" vsn)\n\n    RowNewGuess Nothing ->\n      viewRowHelp pkg (text \"\") (text \"\") (text \"\")\n\n    RowNewGuess (Just v) ->\n      viewRowHelp pkg (text \"\") (text \"\") (viewVersion \"#eeeeee\" v)\n\n    RowOld old new ->\n      if old == new\n      then viewRowHelp pkg (text \"\") (text \"\") (viewVersion \"#cccccc\" new)\n      else viewRowHelp pkg (viewVersion \"#cccccc\" old) (viewArrow \"#cccccc\") (viewVersion \"black\" new)\n\n    RowOldGuess old new  ->\n      if old == new\n      then viewRowHelp pkg (text \"\") (text \"\") (viewVersion \"#eeeeee\" new)\n      else viewRowHelp pkg (viewVersion \"#eeeeee\" old) (viewArrow \"#eeeeee\") (viewVersion \"#eeeeee\" new)\n\n\nviewRowHelp : String -> Html msg -> Html msg -> Html msg -> Html msg\nviewRowHelp pkg oldHtml arrowHtml newHtml =\n  tr []\n    [ td [ style \"font-family\" \"monospace\" ] [ text pkg ]\n    , td [ style \"text-align\" \"right\"      ] [ oldHtml ]\n    , td [ style \"text-align\" \"center\"     ] [ arrowHtml ]\n    , td [                                 ] [ newHtml ]\n    ]\n\n\nviewVersion : String -> Version -> Html msg\nviewVersion color (Version x y z) =\n  span\n    [ style \"font-family\" \"monospace\"\n    , style \"color\" color\n    , style \"transition\" \"color 1s\"\n    ]\n    [ text (v2s x y z)\n    ]\n\n\nviewArrow : String -> Html msg\nviewArrow color =\n  span\n    [ style \"color\" color\n    , style \"transition\" \"color 1s\"\n    ]\n    [ text \"→\"\n    ]\n\n\n\n-- REGISTRY\n\n\ntype alias Registry = Dict String (List Char)\n\n\ntoRegistry : List String -> Registry\ntoRegistry packages =\n  Dict.fromList (List.map (\\n -> (n, toSearchChars n)) packages)\n\n\ntoSearchChars : String -> List Char\ntoSearchChars string =\n  String.toList (String.toLower string)\n\n\nregistryTODO : Registry\nregistryTODO =\n  toRegistry\n    [ \"elm-explorations/test\"\n    , \"elm-explorations/markdown\"\n    , \"elm/browser\"\n    , \"elm/bytes\"\n    , \"elm/core\"\n    , \"elm/file\"\n    , \"elm/html\"\n    , \"elm/http\"\n    , \"elm/json\"\n    , \"elm/project-metadata-utils\"\n    , \"elm/svg\"\n    , \"elm/parser\"\n    , \"elm/time\"\n    , \"elm/url\"\n    , \"elm/virtual-dom\"\n    ]\n\n\n\n-- SEARCH\n\n\ntype alias Search =\n  { query : String\n  , focus : Maybe Int\n  }\n\n\ntype SearchMsg\n  = SChanged String\n  | SUp\n  | SDown\n  | SFocus\n  | SBlur\n  | SEscape\n  | SEnter\n  | SClickAdd\n  | SClickMatch String\n\n\ntype SearchNext\n  = SNone\n  | SUpdate Search\n  | SManualBlur Search\n  | SAdd String\n\n\nupdateSearch : Registry -> SearchMsg -> Search -> SearchNext\nupdateSearch registry msg search =\n  case msg of\n    SChanged query ->\n      SUpdate { query = query, focus = Just 0 }\n\n    SUp ->\n      let\n        newFocus = Maybe.map (\\n -> Basics.max 0 (n - 1)) search.focus\n      in\n      SUpdate { search | focus = newFocus }\n\n    SDown ->\n      let\n        numMatches = List.length (getBestMatches search.query registry)\n        newFocus = Maybe.map (\\n -> Basics.min numMatches (n + 1)) search.focus\n      in\n      SUpdate { search | focus = newFocus }\n\n    SFocus ->\n      SUpdate { search | focus = Just 0 }\n\n    SBlur ->\n      SUpdate { search | focus = Nothing }\n\n    SEscape ->\n      SManualBlur { search | focus = Nothing }\n\n    SEnter ->\n      case search.focus of\n        Nothing ->\n          SNone\n\n        Just 0 ->\n          if Dict.member search.query registry\n          then SAdd search.query\n          else SNone\n\n        Just n ->\n          case getMatch n (getBestMatches search.query registry) of\n            Just match -> SUpdate { query = match, focus = Just 0 }\n            Nothing -> SNone\n\n    SClickAdd ->\n      if Dict.member search.query registry\n      then SAdd search.query\n      else SNone\n\n    SClickMatch match ->\n      SUpdate { query = match, focus = Just 0 }\n\n\ngetMatch : Int -> List (Int, String) -> Maybe String\ngetMatch n matches =\n  case matches of\n    [] ->\n      Nothing\n\n    (_, match) :: worseMatches ->\n      if n <= 0 then\n        Nothing\n      else if n == 1 then\n        Just match\n      else\n        getMatch (n-1) worseMatches\n\n\n\n-- VIEW SEARCH\n\n\nsearchDepsID : String\nsearchDepsID = \"search-deps\"\n\n\nsearchTestID : String\nsearchTestID = \"search-test\"\n\n\nviewSearch : String -> String -> Registry -> Search -> Html SearchMsg\nviewSearch searchID ghostText registry search =\n  div [ style \"position\" \"relative\" ]\n    [ lazy3 viewSearchQuery searchID ghostText search.query\n    , lazy2 viewSearchAdd search.query registry\n    , lazy3 viewSearchMatches search.query search.focus registry\n    ]\n\n\nviewSearchAdd : String -> Registry -> Html SearchMsg\nviewSearchAdd query registry =\n  if Dict.member query registry then\n    activeButton SClickAdd (text \"Add\")\n  else\n    inactiveButton (text \"Add\")\n\n\nviewSearchMatches : String -> Maybe Int -> Registry -> Html SearchMsg\nviewSearchMatches query focus registry =\n  case focus of\n    Nothing ->\n      text \"\"\n\n    Just n ->\n      if String.isEmpty query\n      then text \"\"\n      else\n        case getBestMatches query registry of\n          [] ->\n            text \"\"\n\n          bestMatches ->\n            div [ class \"search-matches\" ] <|\n              List.indexedMap (viewSearchMatch (n-1)) bestMatches\n\n\nviewSearchMatch : Int -> Int -> (Int, String) -> Html SearchMsg\nviewSearchMatch target actual (_, name) =\n  div\n    [ class \"search-match\"\n    , classList [(\"search-match-focused\", target == actual)]\n    , onClick (SClickMatch name)\n    ]\n    [ div [ style \"padding\" \"0.5em 1em\" ] [ text name ]\n    ]\n\n\n\n-- VIEW SEARCH QUERY\n\n\nviewSearchQuery : String -> String -> String -> Html SearchMsg\nviewSearchQuery searchID ghostText query =\n  input\n    [ type_ \"text\"\n    , id searchID\n    , placeholder ghostText\n    , autocomplete False\n    , class \"search-input\"\n    , value query\n    , onInput SChanged\n    , on \"keydown\" keyDecoder\n    , onFocus SFocus\n    , onBlur SBlur\n    ]\n    []\n\n\nkeyDecoder : D.Decoder SearchMsg\nkeyDecoder =\n  let\n    check up down enter escape value =\n      if value == up then\n        D.succeed SUp\n      else if value == down then\n        D.succeed SDown\n      else if value == enter then\n        D.succeed SEnter\n      else if value == escape then\n        D.succeed SEscape\n      else\n        D.fail \"not up or down\"\n  in\n  D.oneOf\n    [ D.field \"key\" D.string\n        |> D.andThen (check \"ArrowUp\" \"ArrowDown\" \"Enter\" \"Escape\")\n    , D.field \"keyCode\" D.int\n        |> D.andThen (check 38 40 13 27)\n    ]\n\n\n\n-- MATCHES\n\n\ngetBestMatches : String -> Registry -> List (Int, String)\ngetBestMatches query registry =\n  Dict.foldl (addMatch (toSearchChars query)) [] registry\n\n\naddMatch : List Char -> String -> List Char -> List (Int, String) -> List (Int, String)\naddMatch queryChars targetName targetChars bestMatches =\n  case distance 0 queryChars targetChars of\n    Nothing ->\n      bestMatches\n\n    Just dist ->\n      insert 4 targetName dist bestMatches\n\n\ninsert : Int -> String -> Int -> List (Int, String) -> List (Int, String)\ninsert limit name dist bestMatches =\n  if limit <= 0 then\n    bestMatches\n  else\n    case bestMatches of\n      [] ->\n        [ (dist, name) ]\n\n      ((bestDist, bestName) as best) :: worseMatches ->\n        if dist < bestDist then\n          (dist, name) :: List.take (limit - 1) bestMatches\n        else\n          best :: insert (limit - 1) name dist worseMatches\n\n\ndistance : Int -> List Char -> List Char -> Maybe Int\ndistance dist queryChars targetChars =\n  case queryChars of\n    [] ->\n      case dist + List.length targetChars of\n        0 -> Nothing\n        n -> Just n\n\n    qc :: qcs ->\n      case targetChars of\n        [] ->\n          Nothing\n\n        tc :: tcs ->\n          if qc == tc then\n            distance dist qcs tcs\n          else\n            distance (dist + 1) queryChars tcs\n\n\n\n-- ICONS\n\n\nundoIcon : Html msg\nundoIcon =\n  icon \"M255.545 8c-66.269.119-126.438 26.233-170.86 68.685L48.971 40.971C33.851 25.851 8 36.559 8 57.941V192c0 13.255 10.745 24 24 24h134.059c21.382 0 32.09-25.851 16.971-40.971l-41.75-41.75c30.864-28.899 70.801-44.907 113.23-45.273 92.398-.798 170.283 73.977 169.484 169.442C423.236 348.009 349.816 424 256 424c-41.127 0-79.997-14.678-110.63-41.556-4.743-4.161-11.906-3.908-16.368.553L89.34 422.659c-4.872 4.872-4.631 12.815.482 17.433C133.798 479.813 192.074 504 256 504c136.966 0 247.999-111.033 248-247.998C504.001 119.193 392.354 7.755 255.545 8z\"\n\n\nredoIcon : Html msg\nredoIcon =\n  icon \"M256.455 8c66.269.119 126.437 26.233 170.859 68.685l35.715-35.715C478.149 25.851 504 36.559 504 57.941V192c0 13.255-10.745 24-24 24H345.941c-21.382 0-32.09-25.851-16.971-40.971l41.75-41.75c-30.864-28.899-70.801-44.907-113.23-45.273-92.398-.798-170.283 73.977-169.484 169.442C88.764 348.009 162.184 424 256 424c41.127 0 79.997-14.678 110.629-41.556 4.743-4.161 11.906-3.908 16.368.553l39.662 39.662c4.872 4.872 4.631 12.815-.482 17.433C378.202 479.813 319.926 504 256 504 119.034 504 8.001 392.967 8 256.002 7.999 119.193 119.646 7.755 256.455 8z\"\n\n\nunlockIcon : Html msg\nunlockIcon =\n  icon \"M423.5 0C339.5.3 272 69.5 272 153.5V224H48c-26.5 0-48 21.5-48 48v192c0 26.5 21.5 48 48 48h352c26.5 0 48-21.5 48-48V272c0-26.5-21.5-48-48-48h-48v-71.1c0-39.6 31.7-72.5 71.3-72.9 40-.4 72.7 32.1 72.7 72v80c0 13.3 10.7 24 24 24h32c13.3 0 24-10.7 24-24v-80C576 68 507.5-.3 423.5 0z\"\n\n\nlockIcon : Html msg\nlockIcon =\n  icon \"M400 224h-24v-72C376 68.2 307.8 0 224 0S72 68.2 72 152v72H48c-26.5 0-48 21.5-48 48v192c0 26.5 21.5 48 48 48h352c26.5 0 48-21.5 48-48V272c0-26.5-21.5-48-48-48zm-104 0H152v-72c0-39.7 32.3-72 72-72s72 32.3 72 72v72z\"\n\n\nicon : String -> Html msg\nicon path =\n  div\n    [ style \"display\" \"inline-flex\"\n    , style \"align-self\" \"center\"\n    , style \"top\" \".125em\"\n    , style \"position\" \"relative\"\n    ]\n    [ Svg.svg\n        [ S.viewBox \"0 0 512 512\"\n        , S.width \"1em\"\n        , S.height \"1em\"\n        ]\n        [ Svg.path\n            [ S.fill \"currentColor\"\n            , S.d path\n            ]\n            []\n        ]\n    ]\n\n\n\n-- VERSIONS\n\n\ntype Version =\n  Version Int Int Int\n\n\n\n-- ENCODE CONSTRAINTS\n\n\nencodeConstraint : PBounds -> E.Value\nencodeConstraint bounds =\n  case bounds of\n    POld (Version x y z) _ oldBounds ->\n      case oldBounds of\n        OLocked   -> E.string <| v2s x y z ++ \" <= v < \" ++ v2s x y (z + 1)\n        OPatch    -> E.string <| v2s x y z ++ \" <= v < \" ++ v2s x y max16\n        OMinor    -> E.string <| v2s x y z ++ \" <= v < \" ++ v2s x max16 0\n        OMajor    -> E.string <| v2s x y z ++ \" <= v < \" ++ v2s max16 0 0\n        OAny      -> encodeAny\n        OCustom c -> Constraint.encode c\n\n    PNew _ newBounds ->\n      case newBounds of\n        NAny      -> encodeAny\n        NCustom c -> Constraint.encode c\n\n\nencodeAny : E.Value\nencodeAny =\n  E.string <| v2s 1 0 0 ++ \" <= v <= \" ++ v2s max16 max16 max16\n\n\nmax16 : Int\nmax16 =\n  65535\n\n\nv2s : Int -> Int -> Int -> String\nv2s major minor patch =\n  String.fromInt major ++ \".\" ++ String.fromInt minor ++ \".\" ++ String.fromInt patch\n\n\n\n-- DECODE SOLUTION\n\n\nsolutionDecoder : D.Decoder (Dict String Version)\nsolutionDecoder =\n  D.dict versionDecoder\n\n\nversionDecoder : D.Decoder Version\nversionDecoder =\n  let\n    toVersion str =\n      case fromString str of\n        Just vsn -> D.succeed vsn\n        Nothing -> D.fail \"invalid version number\"\n  in\n  D.andThen toVersion D.string\n\n\nfromString : String -> Maybe Version\nfromString string =\n  case List.map String.toInt (String.split \".\" string) of\n    [Just major, Just minor, Just patch] ->\n      fromStringHelp major minor patch\n\n    _ ->\n      Nothing\n\n\nfromStringHelp : Int -> Int -> Int -> Maybe Version\nfromStringHelp major minor patch =\n  if major >= 0 && minor >= 0 && patch >= 0 then\n    Just (Version major minor patch)\n  else\n    Nothing\n\n\n\n-- TODO delete everything below here\n\n\nstyles : String\nstyles = \"\"\"\nbody {\n  font-family: sans-serif;\n  font-size: 16px;\n  background-color: #cccccc;\n}\n.search-input {\n  padding: 0.5em 1em;\n  border: 1px solid #cccccc;\n  border-radius: 2px;\n}\n.search-matches {\n  position: absolute;\n  top: 100%;\n  left: 0;\n  right: 0;\n  background-color: white;\n}\n.search-match {\n  border-left: 1px solid #cccccc;\n  border-right: 1px solid #cccccc;\n  border-bottom: 1px solid #cccccc;\n}\n.search-match:hover {\n  background-color: #eeeeee;\n  cursor: pointer;\n}\n.search-match-focused {\n  background-color: #60B5CC !important;\n  border-color: #60B5CC;\n  color: white;\n}\n.button {\n  padding: 0.5em 1em;\n  border: 1px solid #60B5CC;\n  background-color: white;\n  border-radius: 2px;\n  color: #60B5CC;\n}\n.button:hover {\n  color: white;\n  background-color: #60B5CC;\n}\n.button:active {\n  color: white;\n  border-color: #5A6378;\n  background-color: #5A6378;\n}\n.button-inactive {\n  padding: 0.5em 1em;\n  border: 1px solid #cccccc;\n  background-color: white;\n  border-radius: 2px;\n  color: #cccccc;\n}\n.table-title {\n  text-transform: uppercase;\n  color: #cccccc;\n  font-size: .75em;\n}\n\"\"\"\n\n\nelmJson : String\nelmJson = \"\"\"\n{\n    \"type\": \"application\",\n    \"source-directories\": [\n        \"src\"\n    ],\n    \"elm-version\": \"0.19.0\",\n    \"dependencies\": {\n        \"direct\": {\n            \"elm/browser\": \"1.0.1\",\n            \"elm/core\": \"1.0.2\",\n            \"elm/html\": \"1.0.0\",\n            \"elm/http\": \"2.0.0\",\n            \"elm/json\": \"1.1.2\",\n            \"elm/project-metadata-utils\": \"1.0.0\",\n            \"elm/svg\": \"1.0.1\",\n            \"elm-explorations/markdown\": \"1.0.0\"\n        },\n        \"indirect\": {\n            \"elm/bytes\": \"1.0.7\",\n            \"elm/file\": \"1.0.1\",\n            \"elm/parser\": \"1.1.0\",\n            \"elm/time\": \"1.0.0\",\n            \"elm/url\": \"1.0.0\",\n            \"elm/virtual-dom\": \"1.0.2\"\n        }\n    },\n    \"test-dependencies\": {\n        \"direct\": {},\n        \"indirect\": {}\n    }\n}\n\"\"\"\n"
  },
  {
    "path": "reactor/src/Errors.elm",
    "content": "module Errors exposing (main)\n\n\nimport Browser\nimport Char\nimport Html exposing (..)\nimport Html.Attributes exposing (..)\nimport String\nimport Json.Decode as D\nimport Elm.Error as Error\n\n\n\n-- MAIN\n\n\nmain =\n  Browser.document\n    { init = \\flags -> (D.decodeValue Error.decoder flags, Cmd.none)\n    , update = \\_ exit -> (exit, Cmd.none)\n    , view = view\n    , subscriptions = \\_ -> Sub.none\n    }\n\n\n\n-- VIEW\n\n\nview : Result D.Error Error.Error -> Browser.Document msg\nview result =\n  { title = \"Problem!\"\n  , body =\n      case result of\n        Err err ->\n          [ text (D.errorToString err) ]\n\n        Ok error ->\n          [ viewError error ]\n  }\n\n\nviewError : Error.Error -> Html msg\nviewError error =\n  div\n    [ style \"width\" \"100%\"\n    , style \"min-height\" \"100%\"\n    , style \"display\" \"flex\"\n    , style \"flex-direction\" \"column\"\n    , style \"align-items\" \"center\"\n    , style \"background-color\" \"rgb(39, 40, 34)\"\n    , style \"color\" \"rgb(233, 235, 235)\"\n    , style \"font-family\" \"monospace\"\n    ]\n    [ div\n        [ style \"display\" \"block\"\n        , style \"white-space\" \"pre-wrap\"\n        , style \"background-color\" \"black\"\n        , style \"padding\" \"2em\"\n        ]\n        (viewErrorHelp error)\n    ]\n\n\nviewErrorHelp : Error.Error -> List (Html msg)\nviewErrorHelp error =\n  case error of\n    Error.GeneralProblem { path, title, message } ->\n      viewHeader title path :: viewMessage message\n\n    Error.ModuleProblems badModules ->\n      viewBadModules badModules\n\n\n\n-- VIEW HEADER\n\n\nviewHeader : String -> Maybe String -> Html msg\nviewHeader title maybeFilePath =\n  let\n    left = \"-- \" ++ title ++ \" \"\n    right =\n      case maybeFilePath of\n        Nothing ->\n          \"\"\n        Just filePath ->\n          \" \" ++ filePath\n  in\n  span [ style \"color\" \"rgb(51,187,200)\" ] [ text (fill left right ++ \"\\n\\n\") ]\n\n\nfill : String -> String -> String\nfill left right =\n  left ++ String.repeat (80 - String.length left - String.length right) \"-\" ++ right\n\n\n\n-- VIEW BAD MODULES\n\n\nviewBadModules : List Error.BadModule -> List (Html msg)\nviewBadModules badModules =\n  case badModules of\n    [] ->\n      []\n\n    [badModule] ->\n      [viewBadModule badModule]\n\n    a :: b :: cs ->\n      viewBadModule a :: viewSeparator a.name b.name :: viewBadModules (b :: cs)\n\n\nviewBadModule : Error.BadModule -> Html msg\nviewBadModule { path, problems } =\n  span [] (List.map (viewProblem path) problems)\n\n\nviewProblem : String -> Error.Problem -> Html msg\nviewProblem filePath problem =\n  span [] (viewHeader problem.title (Just filePath) :: viewMessage problem.message)\n\n\nviewSeparator : String -> String -> Html msg\nviewSeparator before after =\n  span [ style \"color\" \"rgb(211,56,211)\" ]\n    [ text <|\n        String.padLeft 80 ' ' (before ++ \"  ↑    \") ++ \"\\n\" ++\n        \"====o======================================================================o====\\n\" ++\n        \"    ↓  \" ++ after ++ \"\\n\\n\\n\"\n    ]\n\n\n\n-- VIEW MESSAGE\n\n\nviewMessage : List Error.Chunk -> List (Html msg)\nviewMessage chunks =\n  case chunks of\n    [] ->\n      [ text \"\\n\\n\\n\" ]\n\n    chunk :: others ->\n      let\n        htmlChunk =\n          case chunk of\n            Error.Unstyled string ->\n              text string\n\n            Error.Styled style string ->\n              span (styleToAttrs style) [ text string ]\n      in\n      htmlChunk :: viewMessage others\n\n\nstyleToAttrs : Error.Style -> List (Attribute msg)\nstyleToAttrs { bold, underline, color } =\n  addBold bold <| addUnderline underline <| addColor color []\n\n\naddBold : Bool -> List (Attribute msg) -> List (Attribute msg)\naddBold bool attrs =\n  if bool then\n    style \"font-weight\" \"bold\" :: attrs\n  else\n    attrs\n\n\naddUnderline : Bool -> List (Attribute msg) -> List (Attribute msg)\naddUnderline bool attrs =\n  if bool then\n    style \"text-decoration\" \"underline\" :: attrs\n  else\n    attrs\n\n\naddColor : Maybe Error.Color -> List (Attribute msg) -> List (Attribute msg)\naddColor maybeColor attrs =\n  case maybeColor of\n    Nothing ->\n      attrs\n\n    Just color ->\n      style \"color\" (colorToCss color) :: attrs\n\n\ncolorToCss : Error.Color -> String\ncolorToCss color =\n  case color of\n    Error.Red -> \"rgb(194,54,33)\"\n    Error.RED -> \"rgb(252,57,31)\"\n    Error.Magenta -> \"rgb(211,56,211)\"\n    Error.MAGENTA -> \"rgb(249,53,248)\"\n    Error.Yellow -> \"rgb(173,173,39)\"\n    Error.YELLOW -> \"rgb(234,236,35)\"\n    Error.Green -> \"rgb(37,188,36)\"\n    Error.GREEN -> \"rgb(49,231,34)\"\n    Error.Cyan -> \"rgb(51,187,200)\"\n    Error.CYAN -> \"rgb(20,240,240)\"\n    Error.Blue -> \"rgb(73,46,225)\"\n    Error.BLUE -> \"rgb(88,51,255)\"\n    Error.White -> \"rgb(203,204,205)\"\n    Error.WHITE -> \"rgb(233,235,235)\"\n    Error.Black -> \"rgb(0,0,0)\"\n    Error.BLACK -> \"rgb(129,131,131)\"\n"
  },
  {
    "path": "reactor/src/Index/Icon.elm",
    "content": "module Index.Icon exposing\n  ( home\n  , image\n  , file\n  , gift\n  , folder\n  , package\n  , plus\n  , lookup\n  )\n\nimport Dict\nimport Html exposing (Html)\nimport Svg exposing (..)\nimport Svg.Attributes exposing (class, width, height, viewBox, d, fill)\n\n\n\n-- ICON\n\n\nicon : String -> String -> String -> Html msg\nicon color size pathString =\n  svg\n    [ class \"icon\"\n    , width size\n    , height size\n    , viewBox \"0 0 1792 1792\"\n    ]\n    [ path [ fill color, d pathString ] []\n    ]\n\n\n\n-- NECESSARY ICONS\n\n\nhome : Html msg\nhome =\n  icon \"#babdb6\" \"36px\" \"M1472 992v480q0 26-19 45t-45 19h-384v-384h-256v384h-384q-26 0-45-19t-19-45v-480q0-1 .5-3t.5-3l575-474 575 474q1 2 1 6zm223-69l-62 74q-8 9-21 11h-3q-13 0-21-7l-692-577-692 577q-12 8-24 7-13-2-21-11l-62-74q-8-10-7-23.5t11-21.5l719-599q32-26 76-26t76 26l244 204v-195q0-14 9-23t23-9h192q14 0 23 9t9 23v408l219 182q10 8 11 21.5t-7 23.5z\"\n\n\nimage : Html msg\nimage =\n  icon \"#babdb6\" \"16px\" \"M1596 380q28 28 48 76t20 88v1152q0 40-28 68t-68 28h-1344q-40 0-68-28t-28-68v-1600q0-40 28-68t68-28h896q40 0 88 20t76 48zm-444-244v376h376q-10-29-22-41l-313-313q-12-12-41-22zm384 1528v-1024h-416q-40 0-68-28t-28-68v-416h-768v1536h1280zm-128-448v320h-1024v-192l192-192 128 128 384-384zm-832-192q-80 0-136-56t-56-136 56-136 136-56 136 56 56 136-56 136-136 56z\"\n\n\nfile : Html msg\nfile =\n  icon \"#babdb6\" \"16px\" \"M1596 380q28 28 48 76t20 88v1152q0 40-28 68t-68 28h-1344q-40 0-68-28t-28-68v-1600q0-40 28-68t68-28h896q40 0 88 20t76 48zm-444-244v376h376q-10-29-22-41l-313-313q-12-12-41-22zm384 1528v-1024h-416q-40 0-68-28t-28-68v-416h-768v1536h1280zm-1024-864q0-14 9-23t23-9h704q14 0 23 9t9 23v64q0 14-9 23t-23 9h-704q-14 0-23-9t-9-23v-64zm736 224q14 0 23 9t9 23v64q0 14-9 23t-23 9h-704q-14 0-23-9t-9-23v-64q0-14 9-23t23-9h704zm0 256q14 0 23 9t9 23v64q0 14-9 23t-23 9h-704q-14 0-23-9t-9-23v-64q0-14 9-23t23-9h704z\"\n\n\ngift : Html msg\ngift =\n  icon \"#babdb6\" \"16px\" \"M1056 1356v-716h-320v716q0 25 18 38.5t46 13.5h192q28 0 46-13.5t18-38.5zm-456-844h195l-126-161q-26-31-69-31-40 0-68 28t-28 68 28 68 68 28zm688-96q0-40-28-68t-68-28q-43 0-69 31l-125 161h194q40 0 68-28t28-68zm376 256v320q0 14-9 23t-23 9h-96v416q0 40-28 68t-68 28h-1088q-40 0-68-28t-28-68v-416h-96q-14 0-23-9t-9-23v-320q0-14 9-23t23-9h440q-93 0-158.5-65.5t-65.5-158.5 65.5-158.5 158.5-65.5q107 0 168 77l128 165 128-165q61-77 168-77 93 0 158.5 65.5t65.5 158.5-65.5 158.5-158.5 65.5h440q14 0 23 9t9 23z\"\n\n\nfolder : Html msg\nfolder =\n  icon \"#babdb6\" \"16px\" \"M1728 608v704q0 92-66 158t-158 66h-1216q-92 0-158-66t-66-158v-960q0-92 66-158t158-66h320q92 0 158 66t66 158v32h672q92 0 158 66t66 158z\"\n\n\npackage : Html msg\npackage =\n  icon \"#babdb6\" \"16px\" \"M1088 832q0-26-19-45t-45-19h-256q-26 0-45 19t-19 45 19 45 45 19h256q26 0 45-19t19-45zm576-192v960q0 26-19 45t-45 19h-1408q-26 0-45-19t-19-45v-960q0-26 19-45t45-19h1408q26 0 45 19t19 45zm64-448v256q0 26-19 45t-45 19h-1536q-26 0-45-19t-19-45v-256q0-26 19-45t45-19h1536q26 0 45 19t19 45z\"\n\n\nplus : Html msg\nplus =\n  icon \"#babdb6\" \"16px\" \"M1600 736v192q0 40-28 68t-68 28h-416v416q0 40-28 68t-68 28h-192q-40 0-68-28t-28-68v-416h-416q-40 0-68-28t-28-68v-192q0-40 28-68t68-28h416v-416q0-40 28-68t68-28h192q40 0 68 28t28 68v416h416q40 0 68 28t28 68z\"\n\n\n\n-- LOOKUP\n\n\nlookup : String -> Html msg\nlookup fileName =\n  let\n    extension =\n      getExtension fileName\n  in\n    Maybe.withDefault file (Dict.get extension extensionIcons)\n\n\nextensionIcons : Dict.Dict String (Html msg)\nextensionIcons =\n  Dict.fromList\n    [ (\"jpg\" , image)\n    , (\"jpeg\", image)\n    , (\"png\" , image)\n    , (\"gif\" , image)\n    ]\n\n\ngetExtension : String -> String\ngetExtension str =\n  getExtensionHelp (String.split \".\" str)\n\n\ngetExtensionHelp : List String -> String\ngetExtensionHelp segments =\n  case segments of\n    [] ->\n      \"\"\n\n    [ext] ->\n      String.toLower ext\n\n    _ :: rest ->\n      getExtensionHelp rest\n"
  },
  {
    "path": "reactor/src/Index/Navigator.elm",
    "content": "module Index.Navigator exposing (view)\n\n\nimport Html exposing (..)\nimport Html.Attributes exposing (..)\nimport Index.Icon as Icon\n\n\n\n-- VIEW\n\n\nview : String -> List String -> Html msg\nview root dirs =\n  div\n    [ style \"font-size\" \"2em\"\n    , style \"padding\" \"20px 0\"\n    , style \"display\" \"flex\"\n    , style \"align-items\" \"center\"\n    , style \"height\" \"40px\"\n    ]\n    (makeLinks root dirs \"\" [])\n\n\nmakeLinks : String -> List String -> String -> List (Html msg) -> List (Html msg)\nmakeLinks root dirs oldPath revAnchors =\n  case dirs of\n    dir :: otherDirs ->\n      let\n        newPath =\n          oldPath ++ \"/\" ++ dir\n\n        anchor =\n          a [ href newPath ] [ text dir ]\n      in\n        makeLinks root otherDirs newPath (anchor :: revAnchors)\n\n    [] ->\n      let\n        home =\n          a [ href \"/\"\n            , title root\n            , style \"display\" \"inherit\"\n            ]\n            [ Icon.home\n            ]\n      in\n        case revAnchors of\n          [] ->\n            [home]\n\n          lastAnchor :: otherRevAnchors ->\n            home :: slash :: List.foldl addSlash [lastAnchor] otherRevAnchors\n\n\naddSlash : Html msg -> List (Html msg) -> List (Html msg)\naddSlash front back =\n  front :: slash :: back\n\n\nslash : Html msg\nslash =\n  span [ style \"padding\" \"0 8px\" ] [ text \"/\" ]\n"
  },
  {
    "path": "reactor/src/Index/Skeleton.elm",
    "content": "module Index.Skeleton exposing\n  ( box\n  , readmeBox\n  )\n\nimport Html exposing (..)\nimport Html.Attributes exposing (..)\nimport Markdown\n\nimport Index.Icon as Icon\n\n\n\n-- VIEW BOXES\n\n\ntype alias BoxArgs msg =\n  { title : String\n  , items : List (List (Html msg))\n  , footer : Maybe (String, String)\n  }\n\n\nbox : BoxArgs msg -> Html msg\nbox { title, items, footer } =\n  let\n    realItems =\n      List.map (div [ class \"box-item\" ]) items\n  in\n    boxHelp title realItems footer\n\n\nreadmeBox : String -> Html msg\nreadmeBox markdown =\n  let\n    readme =\n      Markdown.toHtml [ class \"box-item\" ] markdown\n  in\n    boxHelp \"README\" [readme] Nothing\n\n\nboxHelp : String -> List (Html msg) -> Maybe (String, String) -> Html msg\nboxHelp boxTitle items footer =\n  div [ class \"box\" ] <|\n    div [ class \"box-header\" ] [ text boxTitle ]\n    :: items\n    ++ [ boxFooter footer ]\n\n\nboxFooter : Maybe (String, String) -> Html msg\nboxFooter maybeFooter =\n  case maybeFooter of\n    Nothing ->\n      text \"\"\n\n    Just (path, description) ->\n      a [ href path\n        , title description\n        ]\n        [ div [ class \"box-footer\" ] [ Icon.plus ]\n        ]\n"
  },
  {
    "path": "reactor/src/Index.elm",
    "content": "module Index exposing (main)\n\n\nimport Browser\nimport Dict\nimport Html exposing (..)\nimport Html.Attributes exposing (class, href, src, style, title)\nimport Json.Decode as D\n\nimport Elm.License as License\nimport Elm.Package as Package\nimport Elm.Project as Project\nimport Elm.Version as Version\n\nimport Index.Icon as Icon\nimport Index.Navigator as Navigator\nimport Index.Skeleton as Skeleton\n\n\n\n-- MAIN\n\n\nmain : Program D.Value Model Never\nmain =\n  Browser.document\n    { init = \\flags -> (D.decodeValue decoder flags, Cmd.none)\n    , update = \\_ model -> (model, Cmd.none)\n    , subscriptions = \\_ -> Sub.none\n    , view = view\n    }\n\n\n\n-- FLAGS\n\n\ntype alias Flags =\n  { root : String\n  , pwd : List String\n  , dirs : List String\n  , files : List File\n  , readme : Maybe String\n  , project : Maybe Project.Project\n  , exactDeps : Dict.Dict String Version.Version\n  }\n\n\ntype alias File =\n  { name : String\n  , runnable : Bool\n  }\n\n\n\n-- DECODER\n\n\ndecoder : D.Decoder Flags\ndecoder =\n  D.map7 Flags\n    (D.field \"root\" D.string)\n    (D.field \"pwd\" (D.list D.string))\n    (D.field \"dirs\" (D.list D.string))\n    (D.field \"files\" (D.list fileDecoder))\n    (D.field \"readme\" (D.nullable D.string))\n    (D.field \"outline\" (D.nullable Project.decoder))\n    (D.field \"exactDeps\" (D.dict Version.decoder))\n\n\nfileDecoder : D.Decoder File\nfileDecoder =\n  D.map2 File\n    (D.field \"name\" D.string)\n    (D.field \"runnable\" D.bool)\n\n\n\n-- MODEL\n\n\ntype alias Model =\n  Result D.Error Flags\n\n\n\n-- VIEW\n\n\nview : Model -> Browser.Document msg\nview model =\n  case model of\n    Err error ->\n      { title = \"???\"\n      , body =\n          [ text (D.errorToString error)\n          ]\n      }\n\n    Ok { root, pwd, dirs, files, readme, project, exactDeps } ->\n      { title = String.join \"/\" (\"~\" :: pwd)\n      , body =\n          [ header [ class \"header\" ] []\n          , div [ class \"content\" ]\n              [ Navigator.view root pwd\n              , viewLeftColumn dirs files readme\n              , viewRightColumn exactDeps project\n              , div [ style \"clear\" \"both\" ] []\n              ]\n          ]\n      }\n\n\nviewLeftColumn : List String -> List File -> Maybe String -> Html msg\nviewLeftColumn dirs files readme =\n  section [ class \"left-column\" ]\n    [ viewFiles dirs files\n    , viewReadme readme\n    ]\n\n\nviewRightColumn : ExactDeps -> Maybe Project.Project -> Html msg\nviewRightColumn exactDeps maybeProject =\n  section [ class \"right-column\" ] <|\n    case maybeProject of\n      Nothing ->\n        []\n\n      Just project ->\n        [ viewProjectSummary project\n        , viewDeps exactDeps project\n        , viewTestDeps exactDeps project\n        ]\n\n\n-- VIEW README\n\n\nviewReadme : Maybe String -> Html msg\nviewReadme readme =\n  case readme of\n    Nothing ->\n      text \"\"\n\n    Just markdown ->\n      Skeleton.readmeBox markdown\n\n\n\n-- VIEW FILES\n\n\nviewFiles : List String -> List File -> Html msg\nviewFiles dirs files =\n  Skeleton.box\n    { title = \"File Navigation\"\n    , items =\n        List.filterMap viewDir (List.sort dirs)\n        ++\n        List.filterMap viewFile (List.sortBy .name files)\n    , footer = Nothing\n    }\n\n\nviewDir : String -> Maybe (List (Html msg))\nviewDir dir =\n  if String.startsWith \".\" dir || dir == \"elm-stuff\" then\n    Nothing\n  else\n    Just [ a [ href dir ] [ Icon.folder, text dir ] ]\n\n\nviewFile : File -> Maybe (List (Html msg))\nviewFile {name} =\n  if String.startsWith \".\" name then\n    Nothing\n  else\n    Just [ a [ href name ] [ Icon.lookup name, text name ] ]\n\n\n\n-- VIEW PAGE SUMMARY\n\n\nviewProjectSummary : Project.Project -> Html msg\nviewProjectSummary project =\n  case project of\n    Project.Application info ->\n      Skeleton.box\n        { title = \"Source Directories\"\n        , items = List.map (\\dir -> [text dir]) info.dirs\n        , footer = Nothing\n        }\n        -- TODO show estimated bundle size here\n\n    Project.Package info ->\n      Skeleton.box\n        { title = \"Package Info\"\n        , items =\n            [ [ text (\"Name: \" ++ Package.toString info.name) ]\n            , [ text (\"Version: \" ++ Version.toString info.version) ]\n            , [ text (\"License: \" ++ License.toString info.license) ]\n            ]\n        , footer = Nothing\n        }\n\n\n\n-- VIEW DEPENDENCIES\n\n\ntype alias ExactDeps =\n  Dict.Dict String Version.Version\n\n\nviewDeps : ExactDeps -> Project.Project -> Html msg\nviewDeps exactDeps project =\n  let\n    dependencies =\n      case project of\n        Project.Application info ->\n          List.map viewVersion info.depsDirect\n\n        Project.Package info ->\n          List.map (viewConstraint exactDeps) info.deps\n  in\n  Skeleton.box\n    { title = \"Dependencies\"\n    , items = dependencies\n    , footer = Nothing -- TODO Just (\"/_elm/dependencies\", \"Add more dependencies?\")\n    }\n\n\nviewTestDeps : ExactDeps -> Project.Project -> Html msg\nviewTestDeps exactDeps project =\n  let\n    dependencies =\n      case project of\n        Project.Application info ->\n          List.map viewVersion info.testDepsDirect\n\n        Project.Package info ->\n          List.map (viewConstraint exactDeps) info.testDeps\n  in\n  Skeleton.box\n    { title = \"Test Dependencies\"\n    , items = dependencies\n    , footer = Nothing -- TODO Just (\"/_elm/test-dependencies\", \"Add more test dependencies?\")\n    }\n\n\nviewVersion : (Package.Name, Version.Version) -> List (Html msg)\nviewVersion (pkg, version) =\n  [ div [ style \"float\" \"left\" ]\n      [ Icon.package\n      , a [ href (toPackageUrl pkg version) ] [ text (Package.toString pkg) ]\n      ]\n  , div [ style \"float\" \"right\" ] [ text (Version.toString version) ]\n  ]\n\n\nviewConstraint : ExactDeps -> (Package.Name, constraint) -> List (Html msg)\nviewConstraint exactDeps (pkg, _) =\n  case Dict.get (Package.toString pkg) exactDeps of\n    Just vsn ->\n      viewVersion (pkg, vsn)\n\n    Nothing ->\n      [ div [ style \"float\" \"left\" ]\n          [ Icon.package\n          , text (Package.toString pkg)\n          ]\n      , div [ style \"float\" \"right\" ] [ text \"???\" ]\n      ]\n\n\ntoPackageUrl : Package.Name -> Version.Version -> String\ntoPackageUrl name version =\n  \"https://package.elm-lang.org/packages/\"\n  ++ Package.toString name ++ \"/\" ++ Version.toString version\n"
  },
  {
    "path": "reactor/src/NotFound.elm",
    "content": "module NotFound exposing (main)\n\n\nimport Browser\nimport Html exposing (..)\nimport Html.Attributes exposing (..)\n\n\n\nmain : Program () () ()\nmain =\n  Browser.document\n    { init = \\_ -> ((), Cmd.none)\n    , update = \\_ _ -> ((), Cmd.none)\n    , subscriptions = \\_ -> Sub.none\n    , view = \\_ -> page\n    }\n\n\npage : Browser.Document ()\npage =\n  { title = \"Page not found\"\n  , body =\n      [ div [ class \"not-found\" ]\n          [ div [ style \"font-size\" \"12em\" ] [ text \"404\" ]\n          , div [ style \"font-size\" \"3em\" ] [ text \"Page not found\" ]\n          ]\n      ]\n  }"
  },
  {
    "path": "reactor/src/mock.txt",
    "content": "# Dependency Explorer\n\nMass Updates: | RESET | PATCH | MINOR | MAJOR |\n\n⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣇  ←→\n\nDEPENDENCIES\n\n  DIRECT\n  NoRedInk/elm-json-decode-pipeline     1.0.0  →  3.0.0      (MAJOR)\n  elm/browser                           1.0.0  →  1.0.2      (MINOR)\n  elm/core                              1.0.0  →  1.0.5      (CUSTOM: 1.0.0 <= v < 2.0.0)\n  elm/html                              1.0.0  →  6.0.2      (ANY)\n  elm/http                              1.0.0  →  1.0.0      (LOCKED)\n  elm/json                              1.0.0  →  1.0.0      (LOCKED)\n  elm/time                              1.0.0  →  1.0.0      (LOCKED)\n  elm/url                               1.0.0  →  1.0.0      (LOCKED)\n  elm-explorations/markdown             1.0.0  →  1.0.0      (LOCKED)\n  rtfeldman/elm-iso8601-date-strings    1.1.0  →             (REMOVE)\n  ADD\n\n  INDIRECT\n  elm/parser                            1.0.0  →  1.0.0      (LOCKED)\n  elm/virtual-dom                       1.0.0  →  1.0.0      (LOCKED)\n\nTEST DEPENDENCIES\n\n  DIRECT\n  elm-explorations/test                 1.0.0  →  1.0.0      (LOCKED)\n  ADD\n\n  INDIRECT\n  elm/random                            1.0.0  →  1.0.0      (LOCKED)\n"
  },
  {
    "path": "roadmap.md",
    "content": "# Roadmap\n\nIf you like what you see now, that's pretty much what Elm is going to be for a while.\n\nI'm currently doing some exploratory work with compiler techniques and targets, but it is still too early to tell which parts of that might work out. I know many readers take \"exploring X\" as a promise that \"X will definitely happen\", so I want to be careful in setting expectations low since there is still so much uncertainty in the work. So while there is no real news to share at this point, I can give some expectations about future stability of Elm:\n\n**If this exploratory work goes well**, even in the wildest version of success, I wouldn't expect the language or core packages to change very much. Maybe two or three years down the line it could reveal something that'd be good to fix up, but I don't really foresee notable changes right now.\n\n**If this exploratory work does not work out**, I have some more conservative projects that are good ideas that I want to circle back to at some point. Things like:\n\n- add a constrained type variable `eq` to get rid of the runtime error for `(==)` on functions\n- try to integrate `elm test` so it can run only tests that changed\n- try to get `elm format` using the latest parsing infrastructure so it's not a perf bottleneck during development anymore\n- do another round on perf because I have one last idea that can squeeze out a bit more speed\n\nThese are all nice quality of life things, but with 0.19.0 and 0.19.1 taking so long, I got pretty burnt out on \"incremental improvements that are good ideas, but take a very long time and aren't very exciting to non-Elm users.\" Without getting too into the details, I really needed to change things up before returning to these particular ideas.\n\nIf someone has a security issue from the compiler or core libraries, please DM me about it on the Elm Slack. Outside of security issues, I think capacity for more discretionary changes will increase once the lessons from the compiler explorations become more clear. Hopefully the discussion [here](https://discourse.elm-lang.org/t/costs-funding-in-open-source-languages/5722) clarifies the thinking on these capacity questions a bit.\n\n<br>\n<br>\n\n**Taking a step back**, I have found that working in this looser style has produced a high baseline of quality, and I think that is an important part of Elm. For example, all the error message work in Elm began as a project to implement the `--report=json` flag. That work happened to reveal some cool ideas on improving error messages, and if I had been using a rigid roadmap, I might have skipped those ideas to meet the publicly-stated arbitrary deadline. We'd have a clearer roadmap, but error messages no different than other type-inferred languages.\n\nSo I think having more flexibility in planning is a competitive advantage for Elm in certain ways, but it is obviously a trade off that does not work for everyone. If someone needs more certainty, I generally recommend looking into other languages to see if they have a balance that works better for their needs. For example, languages made by big corporations are generally \"less risky\" on things like this, but I think you see the fruits of that kind of process in the design decisions as well. Trade offs!\n\nAnyway, like I said at the beginning, if you like what you see now, that's what it's going to be for a while. Even in the best case scenario with my current explorations!\n\nI hope this is helpful information, and I hope you have a good experience with Elm, even if you ultimately find a different language that works better for you!\n"
  },
  {
    "path": "terminal/impl/Terminal/Chomp.hs",
    "content": "{-# LANGUAGE GADTs, Rank2Types #-}\nmodule Terminal.Chomp\n  ( chomp\n  )\n  where\n\n\nimport qualified Data.List as List\n\nimport Terminal.Error\nimport Terminal.Internal\n\n\n\n-- CHOMP INTERFACE\n\n\nchomp :: Maybe Int -> [String] -> Args args -> Flags flags -> ( IO [String], Either Error (args, flags) )\nchomp maybeIndex strings args flags =\n  let\n    (Chomper flagChomper) =\n      chompFlags flags\n\n    ok suggest chunks flagValue =\n      fmap (flip (,) flagValue) <$> chompArgs suggest chunks args\n\n    err suggest flagError =\n      ( addSuggest (return []) suggest, Left (BadFlag flagError) )\n  in\n  flagChomper (toSuggest maybeIndex) (toChunks strings) ok err\n\n\ntoChunks :: [String] -> [Chunk]\ntoChunks strings =\n  zipWith Chunk [ 1 .. length strings ] strings\n\n\ntoSuggest :: Maybe Int -> Suggest\ntoSuggest maybeIndex =\n  case maybeIndex of\n    Nothing ->\n      NoSuggestion\n\n    Just index ->\n      Suggest index\n\n\n\n-- CHOMPER\n\n\nnewtype Chomper x a =\n  Chomper (\n    forall result.\n      Suggest\n      -> [Chunk]\n      -> (Suggest -> [Chunk] -> a -> result)\n      -> (Suggest -> x -> result)\n      -> result\n  )\n\n\ndata Chunk =\n  Chunk\n    { _index :: Int\n    , _chunk :: String\n    }\n\n\ndata Suggest\n  = NoSuggestion\n  | Suggest Int\n  | Suggestions (IO [String])\n\n\nmakeSuggestion :: Suggest -> (Int -> Maybe (IO [String])) -> Suggest\nmakeSuggestion suggest maybeUpdate =\n  case suggest of\n    NoSuggestion ->\n      suggest\n\n    Suggestions _ ->\n      suggest\n\n    Suggest index ->\n      maybe suggest Suggestions (maybeUpdate index)\n\n\n\n-- ARGS\n\n\nchompArgs :: Suggest -> [Chunk] -> Args a -> (IO [String], Either Error a)\nchompArgs suggest chunks (Args completeArgsList) =\n  chompArgsHelp suggest chunks completeArgsList [] []\n\n\nchompArgsHelp :: Suggest -> [Chunk] -> [CompleteArgs a] -> [Suggest] -> [(CompleteArgs a, ArgError)] -> (IO [String], Either Error a)\nchompArgsHelp suggest chunks completeArgsList revSuggest revArgErrors =\n  case completeArgsList of\n    [] ->\n      ( foldl addSuggest (return []) revSuggest\n      , Left (BadArgs (reverse revArgErrors))\n      )\n\n    completeArgs : others ->\n      case chompCompleteArgs suggest chunks completeArgs of\n        (s1, Left argError) ->\n          chompArgsHelp suggest chunks others (s1:revSuggest) ((completeArgs,argError):revArgErrors)\n\n        (s1, Right value) ->\n          ( addSuggest (return []) s1\n          , Right value\n          )\n\n\naddSuggest :: IO [String] -> Suggest -> IO [String]\naddSuggest everything suggest =\n  case suggest of\n    NoSuggestion ->\n      everything\n\n    Suggest _ ->\n      everything\n\n    Suggestions newStuff ->\n      (++) <$> newStuff <*> everything\n\n\n\n-- COMPLETE ARGS\n\n\nchompCompleteArgs :: Suggest -> [Chunk] -> CompleteArgs a -> (Suggest, Either ArgError a)\nchompCompleteArgs suggest chunks completeArgs =\n  let\n    numChunks = length chunks\n  in\n  case completeArgs of\n    Exactly requiredArgs ->\n      chompExactly suggest chunks (chompRequiredArgs numChunks requiredArgs)\n\n    Optional requiredArgs parser ->\n      chompOptional suggest chunks (chompRequiredArgs numChunks requiredArgs) parser\n\n    Multiple requiredArgs parser ->\n      chompMultiple suggest chunks (chompRequiredArgs numChunks requiredArgs) parser\n\n\nchompExactly :: Suggest -> [Chunk] -> Chomper ArgError a -> (Suggest, Either ArgError a)\nchompExactly suggest chunks (Chomper chomper) =\n  let\n    ok s cs value =\n      case map _chunk cs of\n        [] -> (s, Right value)\n        es -> (s, Left (ArgExtras es))\n\n    err s argError =\n      (s, Left argError)\n  in\n  chomper suggest chunks ok err\n\n\nchompOptional :: Suggest -> [Chunk] -> Chomper ArgError (Maybe a -> b) -> Parser a -> (Suggest, Either ArgError b)\nchompOptional suggest chunks (Chomper chomper) parser =\n  let\n    ok s1 cs func =\n      case cs of\n        [] ->\n          (s1, Right (func Nothing))\n\n        Chunk index string : others ->\n          case tryToParse s1 parser index string of\n            (s2, Left expectation) ->\n              (s2, Left (ArgBad string expectation))\n\n            (s2, Right value) ->\n              case map _chunk others of\n                [] -> (s2, Right (func (Just value)))\n                es -> (s2, Left (ArgExtras es))\n\n    err s1 argError =\n      (s1, Left argError)\n  in\n  chomper suggest chunks ok err\n\n\nchompMultiple :: Suggest -> [Chunk] -> Chomper ArgError ([a] -> b) -> Parser a -> (Suggest, Either ArgError b)\nchompMultiple suggest chunks (Chomper chomper) parser =\n  let\n    err s1 argError =\n      (s1, Left argError)\n  in\n  chomper suggest chunks (chompMultipleHelp parser []) err\n\n\nchompMultipleHelp :: Parser a -> [a] -> Suggest -> [Chunk] -> ([a] -> b) -> (Suggest, Either ArgError b)\nchompMultipleHelp parser revArgs suggest chunks func =\n  case chunks of\n    [] ->\n      (suggest, Right (func (reverse revArgs)))\n\n    Chunk index string : otherChunks ->\n      case tryToParse suggest parser index string of\n        (s1, Left expectation) ->\n          (s1, Left (ArgBad string expectation))\n\n        (s1, Right arg) ->\n          chompMultipleHelp parser (arg:revArgs) s1 otherChunks func\n\n\n\n-- REQUIRED ARGS\n\n\nchompRequiredArgs :: Int -> RequiredArgs a -> Chomper ArgError a\nchompRequiredArgs numChunks args =\n  case args of\n    Done value ->\n      return value\n\n    Required funcArgs argParser ->\n      do  func <- chompRequiredArgs numChunks funcArgs\n          arg <- chompArg numChunks argParser\n          return (func arg)\n\n\nchompArg :: Int -> Parser a -> Chomper ArgError a\nchompArg numChunks parser@(Parser singular _ _ _ toExamples) =\n  Chomper $ \\suggest chunks ok err ->\n    case chunks of\n      [] ->\n        let\n          newSuggest = makeSuggestion suggest (suggestArg parser numChunks)\n          theError = ArgMissing (Expectation singular (toExamples \"\"))\n        in\n        err newSuggest theError\n\n      Chunk index string : otherChunks ->\n        case tryToParse suggest parser index string of\n          (newSuggest, Left expectation) ->\n            err newSuggest (ArgBad string expectation)\n\n          (newSuggest, Right arg) ->\n            ok newSuggest otherChunks arg\n\n\nsuggestArg :: Parser a -> Int -> Int -> Maybe (IO [String])\nsuggestArg (Parser _ _ _ toSuggestions _) numChunks targetIndex =\n  if numChunks <= targetIndex then\n    Just (toSuggestions \"\")\n  else\n    Nothing\n\n\n\n-- PARSER\n\n\ntryToParse :: Suggest -> Parser a -> Int -> String -> (Suggest, Either Expectation a)\ntryToParse suggest (Parser singular _ parse toSuggestions toExamples) index string =\n  let\n    newSuggest =\n      makeSuggestion suggest $ \\targetIndex ->\n        if index == targetIndex then Just (toSuggestions string) else Nothing\n\n    outcome =\n      case parse string of\n        Nothing ->\n          Left (Expectation singular (toExamples string))\n\n        Just value ->\n          Right value\n  in\n  (newSuggest, outcome)\n\n\n\n-- FLAGS\n\n\nchompFlags :: Flags a -> Chomper FlagError a\nchompFlags flags =\n  do  value <- chompFlagsHelp flags\n      checkForUnknownFlags flags\n      return value\n\n\nchompFlagsHelp :: Flags a -> Chomper FlagError a\nchompFlagsHelp flags =\n  case flags of\n    FDone value ->\n      return value\n\n    FMore funcFlags argFlag ->\n      do  func <- chompFlagsHelp funcFlags\n          arg <- chompFlag argFlag\n          return (func arg)\n\n\n\n-- FLAG\n\n\nchompFlag :: Flag a -> Chomper FlagError a\nchompFlag flag =\n  case flag of\n    OnOff flagName _ ->\n      chompOnOffFlag flagName\n\n    Flag flagName parser _ ->\n      chompNormalFlag flagName parser\n\n\nchompOnOffFlag :: String -> Chomper FlagError Bool\nchompOnOffFlag flagName =\n  Chomper $ \\suggest chunks ok err ->\n    case findFlag flagName chunks of\n      Nothing ->\n        ok suggest chunks False\n\n      Just (FoundFlag before value after) ->\n        case value of\n          DefNope ->\n            ok suggest (before ++ after) True\n\n          Possibly chunk ->\n            ok suggest (before ++ chunk : after) True\n\n          Definitely _ string ->\n            err suggest (FlagWithValue flagName string)\n\n\nchompNormalFlag :: String -> Parser a -> Chomper FlagError (Maybe a)\nchompNormalFlag flagName parser@(Parser singular _ _ _ toExamples) =\n  Chomper $ \\suggest chunks ok err ->\n    case findFlag flagName chunks of\n      Nothing ->\n        ok suggest chunks Nothing\n\n      Just (FoundFlag before value after) ->\n        let\n          attempt index string =\n            case tryToParse suggest parser index string of\n              (newSuggest, Left expectation) ->\n                err newSuggest (FlagWithBadValue flagName string expectation)\n\n              (newSuggest, Right flagValue) ->\n                ok newSuggest (before ++ after) (Just flagValue)\n        in\n        case value of\n          Definitely index string ->\n            attempt index string\n\n          Possibly (Chunk index string) ->\n            attempt index string\n\n          DefNope ->\n            err suggest (FlagWithNoValue flagName (Expectation singular (toExamples \"\")))\n\n\n\n-- FIND FLAG\n\n\ndata FoundFlag =\n  FoundFlag\n    { _before :: [Chunk]\n    , _value :: Value\n    , _after :: [Chunk]\n    }\n\n\ndata Value\n  = Definitely Int String\n  | Possibly Chunk\n  | DefNope\n\n\nfindFlag :: String -> [Chunk] -> Maybe FoundFlag\nfindFlag flagName chunks =\n  findFlagHelp [] (\"--\" ++ flagName) (\"--\" ++ flagName ++ \"=\") chunks\n\n\nfindFlagHelp :: [Chunk] -> String -> String -> [Chunk] -> Maybe FoundFlag\nfindFlagHelp revPrev loneFlag flagPrefix chunks =\n  let\n    succeed value after =\n      Just (FoundFlag (reverse revPrev) value after)\n\n    deprefix string =\n      drop (length flagPrefix) string\n  in\n  case chunks of\n    [] ->\n      Nothing\n\n    chunk@(Chunk index string) : rest ->\n      if List.isPrefixOf flagPrefix string then\n        succeed (Definitely index (deprefix string)) rest\n\n      else if string /= loneFlag then\n        findFlagHelp (chunk:revPrev) loneFlag flagPrefix rest\n\n      else\n        case rest of\n          [] ->\n            succeed DefNope []\n\n          argChunk@(Chunk _ potentialArg) : restOfRest ->\n            if List.isPrefixOf \"-\" potentialArg then\n              succeed DefNope rest\n            else\n              succeed (Possibly argChunk) restOfRest\n\n\n\n-- CHECK FOR UNKNOWN FLAGS\n\n\ncheckForUnknownFlags :: Flags a -> Chomper FlagError ()\ncheckForUnknownFlags flags =\n  Chomper $ \\suggest chunks ok err ->\n    case filter startsWithDash chunks of\n      [] ->\n        ok suggest chunks ()\n\n      unknownFlags@(Chunk _ unknownFlag : _) ->\n        err\n          (makeSuggestion suggest (suggestFlag unknownFlags flags))\n          (FlagUnknown unknownFlag flags)\n\n\nsuggestFlag :: [Chunk] -> Flags a -> Int -> Maybe (IO [String])\nsuggestFlag unknownFlags flags targetIndex =\n  case unknownFlags of\n    [] ->\n      Nothing\n\n    Chunk index string : otherUnknownFlags ->\n      if index == targetIndex then\n        Just (return (filter (List.isPrefixOf string) (getFlagNames flags [])))\n      else\n        suggestFlag otherUnknownFlags flags targetIndex\n\n\nstartsWithDash :: Chunk -> Bool\nstartsWithDash (Chunk _ string) =\n  List.isPrefixOf \"-\" string\n\n\ngetFlagNames :: Flags a -> [String] -> [String]\ngetFlagNames flags names =\n  case flags of\n    FDone _ ->\n      \"--help\" : names\n\n    FMore subFlags flag ->\n      getFlagNames subFlags (getFlagName flag : names)\n\n\ngetFlagName :: Flag a -> String\ngetFlagName flag =\n  case flag of\n    Flag name _ _ ->\n      \"--\" ++ name\n\n    OnOff name _ ->\n      \"--\" ++ name\n\n\n\n-- CHOMPER INSTANCES\n\n\ninstance Functor (Chomper x) where\n  fmap func (Chomper chomper) =\n    Chomper $ \\i w ok err ->\n      let\n        ok1 s1 cs1 value =\n          ok s1 cs1 (func value)\n      in\n      chomper i w ok1 err\n\n\ninstance Applicative (Chomper x) where\n  pure value =\n    Chomper $ \\ss cs ok _ ->\n      ok ss cs value\n\n  (<*>) (Chomper funcChomper) (Chomper argChomper) =\n    Chomper $ \\s cs ok err ->\n      let\n        ok1 s1 cs1 func =\n          let\n            ok2 s2 cs2 value =\n              ok s2 cs2 (func value)\n          in\n          argChomper s1 cs1 ok2 err\n      in\n      funcChomper s cs ok1 err\n\n\ninstance Monad (Chomper x) where\n  return = pure\n\n  (>>=) (Chomper aChomper) callback =\n    Chomper $ \\s cs ok err ->\n      let\n        ok1 s1 cs1 a =\n          case callback a of\n            Chomper bChomper -> bChomper s1 cs1 ok err\n      in\n      aChomper s cs ok1 err\n"
  },
  {
    "path": "terminal/impl/Terminal/Error.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-x-partial #-}\n{-# LANGUAGE GADTs, OverloadedStrings #-}\nmodule Terminal.Error\n  ( Error(..)\n  , ArgError(..)\n  , FlagError(..)\n  , Expectation(..)\n  , exitWithHelp\n  , exitWithError\n  , exitWithUnknown\n  , exitWithOverview\n  )\n  where\n\n\nimport qualified Data.List as List\nimport qualified Data.Maybe as Maybe\nimport GHC.IO.Handle (hIsTerminalDevice)\nimport qualified System.Environment as Env\nimport qualified System.Exit as Exit\nimport qualified System.FilePath as FP\nimport System.IO (hPutStrLn, stderr)\nimport qualified Text.PrettyPrint.ANSI.Leijen as P\n\nimport Reporting.Suggest as Suggest\nimport Terminal.Internal\n\n\n\n-- ERROR\n\n\ndata Error where\n  BadArgs :: [(CompleteArgs a, ArgError)] -> Error\n  BadFlag :: FlagError -> Error\n\n\ndata ArgError\n  = ArgMissing Expectation\n  | ArgBad String Expectation\n  | ArgExtras [String]\n\n\ndata FlagError where\n  FlagWithValue :: String -> String -> FlagError\n  FlagWithBadValue :: String -> String -> Expectation -> FlagError\n  FlagWithNoValue :: String -> Expectation -> FlagError\n  FlagUnknown :: String -> Flags a -> FlagError\n\n\ndata Expectation =\n  Expectation\n    { _type :: String\n    , _examples :: IO [String]\n    }\n\n\n\n-- EXIT\n\n\nexitSuccess :: [P.Doc] -> IO a\nexitSuccess =\n  exitWith Exit.ExitSuccess\n\n\nexitFailure :: [P.Doc] -> IO a\nexitFailure =\n  exitWith (Exit.ExitFailure 1)\n\n\nexitWith :: Exit.ExitCode -> [P.Doc] -> IO a\nexitWith code docs =\n  do  isTerminal <- hIsTerminalDevice stderr\n      let adjust = if isTerminal then id else P.plain\n      P.displayIO stderr $ P.renderPretty 1 80 $\n        adjust $ P.vcat $ concatMap (\\d -> [d,\"\"]) docs\n      hPutStrLn stderr \"\"\n      Exit.exitWith code\n\n\ngetExeName :: IO String\ngetExeName =\n  FP.takeFileName <$> Env.getProgName\n\n\nstack :: [P.Doc] -> P.Doc\nstack docs =\n  P.vcat $ List.intersperse \"\" docs\n\n\nreflow :: String -> P.Doc\nreflow string =\n  P.fillSep $ map P.text $ words string\n\n\n\n-- HELP\n\n\nexitWithHelp :: Maybe String -> String -> P.Doc -> Args args -> Flags flags -> IO a\nexitWithHelp maybeCommand details example (Args args) flags =\n  do  command <- toCommand maybeCommand\n      exitSuccess $\n        [ reflow details\n        , P.indent 4 $ P.cyan $ P.vcat $ map (argsToDoc command) args\n        , example\n        ]\n        ++\n          case flagsToDocs flags [] of\n            [] ->\n              []\n\n            docs@(_:_) ->\n              [ \"You can customize this command with the following flags:\"\n              , P.indent 4 $ stack docs\n              ]\n\n\ntoCommand :: Maybe String -> IO String\ntoCommand maybeCommand =\n  do  exeName <- getExeName\n      return $\n        case maybeCommand of\n          Nothing ->\n            exeName\n\n          Just command ->\n            exeName ++ \" \" ++ command\n\n\nargsToDoc :: String -> CompleteArgs a -> P.Doc\nargsToDoc command args =\n  case args of\n    Exactly required ->\n      argsToDocHelp command required []\n\n    Multiple required (Parser _ plural _ _ _) ->\n      argsToDocHelp command required [\"zero or more \" ++ plural]\n\n    Optional required (Parser singular _ _ _ _) ->\n      argsToDocHelp command required [\"optional \" ++ singular]\n\n\nargsToDocHelp :: String -> RequiredArgs a -> [String] -> P.Doc\nargsToDocHelp command args names =\n  case args of\n    Done _ ->\n      P.hang 4 $ P.hsep $ map P.text $\n        command : map toToken names\n\n    Required others (Parser singular _ _ _ _) ->\n      argsToDocHelp command others (singular : names)\n\n\ntoToken :: String -> String\ntoToken string =\n  \"<\" ++ map (\\c -> if c == ' ' then '-' else c) string ++ \">\"\n\n\nflagsToDocs :: Flags flags -> [P.Doc] -> [P.Doc]\nflagsToDocs flags docs =\n  case flags of\n    FDone _ ->\n      docs\n\n    FMore more flag ->\n      let\n        flagDoc =\n          P.vcat $\n            case flag of\n              Flag name (Parser singular _ _ _ _) description ->\n                [ P.dullcyan $ P.text $ \"--\" ++ name ++ \"=\" ++ toToken singular\n                , P.indent 4 $ reflow description\n                ]\n\n              OnOff name description ->\n                [ P.dullcyan $ P.text $ \"--\" ++ name\n                , P.indent 4 $ reflow description\n                ]\n      in\n      flagsToDocs more (flagDoc:docs)\n\n\n\n-- OVERVIEW\n\n\nexitWithOverview :: P.Doc -> P.Doc -> [Command] -> IO a\nexitWithOverview intro outro commands =\n  do  exeName <- getExeName\n      exitSuccess\n        [ intro\n        , \"The most common commands are:\"\n        , P.indent 4 $ stack $ Maybe.mapMaybe (toSummary exeName) commands\n        , \"There are a bunch of other commands as well though. Here is a full list:\"\n        , P.indent 4 $ P.dullcyan $ toCommandList exeName commands\n        , \"Adding the --help flag gives a bunch of additional details about each one.\"\n        , outro\n        ]\n\n\ntoSummary :: String -> Command -> Maybe P.Doc\ntoSummary exeName (Command name summary _ _ (Args args) _ _) =\n  case summary of\n    Uncommon ->\n      Nothing\n\n    Common summaryString ->\n      Just $\n        P.vcat\n          [ P.cyan $ argsToDoc (exeName ++ \" \" ++ name) (head args)\n          , P.indent 4 $ reflow summaryString\n          ]\n\n\ntoCommandList :: String -> [Command] -> P.Doc\ntoCommandList exeName commands =\n  let\n    names = map toName commands\n    width = maximum (map length names)\n\n    toExample name =\n      P.text $ exeName ++ \" \" ++ name ++ replicate (width - length name) ' ' ++ \" --help\"\n  in\n  P.vcat (map toExample names)\n\n\n\n-- UNKNOWN\n\n\nexitWithUnknown :: String -> [String] -> IO a\nexitWithUnknown unknown knowns =\n  let\n    nearbyKnowns =\n      takeWhile (\\(r,_) -> r <= 3) (Suggest.rank unknown id knowns)\n\n    suggestions =\n      case map toGreen (map snd nearbyKnowns) of\n        [] ->\n          []\n\n        [nearby] ->\n          [\"Try\",nearby,\"instead?\"]\n\n        [a,b] ->\n          [\"Try\",a,\"or\",b,\"instead?\"]\n\n        abcs@(_:_:_:_) ->\n          [\"Try\"] ++ map (<> \",\") (init abcs) ++ [\"or\",last abcs,\"instead?\"]\n  in\n  do  exeName <- getExeName\n      exitFailure\n        [ P.fillSep $ [\"There\",\"is\",\"no\",toRed unknown,\"command.\"] ++ suggestions\n        , reflow $ \"Run `\" ++ exeName ++ \"` with no arguments to get more hints.\"\n        ]\n\n\n\n-- ERROR TO DOC\n\n\nexitWithError :: Error -> IO a\nexitWithError err =\n  exitFailure =<<\n    case err of\n      BadFlag flagError ->\n        flagErrorToDocs flagError\n\n      BadArgs argErrors ->\n        case argErrors of\n          [] ->\n            return\n              [ reflow $ \"I was not expecting any arguments for this command.\"\n              , reflow $ \"Try removing them?\"\n              ]\n\n          [(_args, argError)] ->\n            argErrorToDocs argError\n\n          _:_:_ ->\n            argErrorToDocs $ head $ List.sortOn toArgErrorRank (map snd argErrors)\n\n\ntoArgErrorRank :: ArgError -> Int -- lower is better\ntoArgErrorRank err =\n  case err of\n    ArgBad _ _   -> 0\n    ArgMissing _ -> 1\n    ArgExtras _  -> 2\n\n\ntoGreen :: String -> P.Doc\ntoGreen str =\n  P.green (P.text str)\n\n\ntoYellow :: String -> P.Doc\ntoYellow str =\n  P.yellow (P.text str)\n\n\ntoRed :: String -> P.Doc\ntoRed str =\n  P.red (P.text str)\n\n\n\n-- ARG ERROR TO DOC\n\n\nargErrorToDocs :: ArgError -> IO [P.Doc]\nargErrorToDocs argError =\n  case argError of\n    ArgMissing (Expectation tipe makeExamples) ->\n      do  examples <- makeExamples\n          return\n            [ P.fillSep\n                [\"The\",\"arguments\",\"you\",\"have\",\"are\",\"fine,\",\"but\",\"in\",\"addition,\",\"I\",\"was\"\n                ,\"expecting\",\"a\",toYellow (toToken tipe),\"value.\",\"For\",\"example:\"\n                ]\n            , P.indent 4 $ P.green $ P.vcat $ map P.text examples\n            ]\n\n    ArgBad string (Expectation tipe makeExamples) ->\n      do  examples <- makeExamples\n          return\n            [ \"I am having trouble with this argument:\"\n            , P.indent 4 $ toRed string\n            , P.fillSep $\n                [\"It\",\"is\",\"supposed\",\"to\",\"be\",\"a\"\n                ,toYellow (toToken tipe),\"value,\",\"like\"\n                ] ++ if length examples == 1 then [\"this:\"] else [\"one\",\"of\",\"these:\"]\n            , P.indent 4 $ P.green $ P.vcat $ map P.text examples\n            ]\n\n    ArgExtras extras ->\n      let\n        (these, them) =\n          case extras of\n            [_] -> (\"this argument\", \"it\")\n            _ -> (\"these arguments\", \"them\")\n      in\n      return\n        [ reflow $ \"I was not expecting \" ++ these ++ \":\"\n        , P.indent 4 $ P.red $ P.vcat $ map P.text extras\n        , reflow $ \"Try removing \" ++ them ++ \"?\"\n        ]\n\n\n\n-- FLAG ERROR TO DOC\n\n\nflagErrorHelp :: String -> String -> [P.Doc] -> IO [P.Doc]\nflagErrorHelp summary original explanation =\n  return $\n    [ reflow summary\n    , P.indent 4 (toRed original)\n    ]\n    ++ explanation\n\n\nflagErrorToDocs :: FlagError -> IO [P.Doc]\nflagErrorToDocs flagError =\n  case flagError of\n    FlagWithValue flagName value ->\n      flagErrorHelp\n        \"This on/off flag was given a value:\"\n        (\"--\" ++ flagName ++ \"=\" ++ value)\n        [ \"An on/off flag either exists or not. It cannot have an equals sign and value.\\n\\\n          \\Maybe you want this instead?\"\n        , P.indent 4 $ toGreen $ \"--\" ++ flagName\n        ]\n\n    FlagWithNoValue flagName (Expectation tipe makeExamples) ->\n      do  examples <- makeExamples\n          flagErrorHelp\n            \"This flag needs more information:\"\n            (\"--\" ++ flagName)\n            [ P.fillSep [\"It\",\"needs\",\"a\",toYellow (toToken tipe),\"like\",\"this:\"]\n            , P.indent 4 $ P.vcat $ map toGreen $\n                case take 4 examples of\n                  [] ->\n                    [\"--\" ++ flagName ++ \"=\" ++ toToken tipe]\n\n                  _:_ ->\n                    map (\\example -> \"--\" ++ flagName ++ \"=\" ++ example) examples\n            ]\n\n    FlagWithBadValue flagName badValue (Expectation tipe makeExamples) ->\n      do  examples <- makeExamples\n          flagErrorHelp\n            \"This flag was given a bad value:\"\n            (\"--\" ++ flagName ++ \"=\" ++ badValue)\n            [ P.fillSep $\n                [\"I\",\"need\",\"a\",\"valid\",toYellow (toToken tipe),\"value.\",\"For\",\"example:\"\n                ]\n            , P.indent 4 $ P.vcat $ map toGreen $\n                case take 4 examples of\n                  [] ->\n                    [\"--\" ++ flagName ++ \"=\" ++ toToken tipe]\n\n                  _:_ ->\n                    map (\\example -> \"--\" ++ flagName ++ \"=\" ++ example) examples\n            ]\n\n    FlagUnknown unknown flags ->\n      flagErrorHelp\n        \"I do not recognize this flag:\"\n        unknown\n        (\n          let unknownName = takeWhile ('=' /=) (dropWhile ('-' ==) unknown) in\n          case getNearbyFlags unknownName flags [] of\n            [] ->\n              []\n\n            [thisOne] ->\n              [ P.fillSep [\"Maybe\",\"you\",\"want\",P.green thisOne,\"instead?\"]\n              ]\n\n            suggestions ->\n              [ P.fillSep [\"Maybe\",\"you\",\"want\",\"one\",\"of\",\"these\",\"instead?\"]\n              , P.indent 4 $ P.green $ P.vcat suggestions\n              ]\n        )\n\n\ngetNearbyFlags :: String -> Flags a -> [(Int, String)] -> [P.Doc]\ngetNearbyFlags unknown flags unsortedFlags =\n  case flags of\n    FMore more flag ->\n      getNearbyFlags unknown more (getNearbyFlagsHelp unknown flag : unsortedFlags)\n\n    FDone _ ->\n      map P.text $ map snd $ List.sortOn fst $\n        case filter (\\(d,_) -> d < 3) unsortedFlags of\n          [] ->\n            unsortedFlags\n\n          nearbyUnsortedFlags ->\n            nearbyUnsortedFlags\n\n\ngetNearbyFlagsHelp :: String -> Flag a -> (Int, String)\ngetNearbyFlagsHelp unknown flag =\n  case flag of\n    OnOff flagName _ ->\n      ( Suggest.distance unknown flagName\n      , \"--\" ++ flagName\n      )\n\n    Flag flagName (Parser singular _ _ _ _) _ ->\n      ( Suggest.distance unknown flagName\n      , \"--\" ++ flagName ++ \"=\" ++ toToken singular\n      )\n"
  },
  {
    "path": "terminal/impl/Terminal/Helpers.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Terminal.Helpers\n  ( version\n  , elmFile\n  , package\n  )\n  where\n\n\nimport qualified Data.ByteString.UTF8 as BS_UTF8\nimport qualified Data.Char as Char\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Utf8 as Utf8\nimport qualified System.FilePath as FP\n\nimport Terminal (Parser(..))\nimport qualified Deps.Registry as Registry\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified Parse.Primitives as P\nimport qualified Stuff\nimport qualified Reporting.Suggest as Suggest\n\n\n\n-- VERSION\n\n\nversion :: Parser V.Version\nversion =\n  Parser\n    { _singular = \"version\"\n    , _plural = \"versions\"\n    , _parser = parseVersion\n    , _suggest = suggestVersion\n    , _examples = return . exampleVersions\n    }\n\n\nparseVersion :: String -> Maybe V.Version\nparseVersion chars =\n  case P.fromByteString V.parser (,) (BS_UTF8.fromString chars) of\n    Right vsn -> Just vsn\n    Left _    -> Nothing\n\n\nsuggestVersion :: String -> IO [String]\nsuggestVersion _ =\n  return []\n\n\nexampleVersions :: String -> [String]\nexampleVersions chars =\n  let\n    chunks = map Utf8.toChars (Utf8.split 0x2E {-.-} (Utf8.fromChars chars))\n    isNumber cs = not (null cs) && all Char.isDigit cs\n  in\n  if all isNumber chunks then\n    case chunks of\n      [x]     -> [ x ++ \".0.0\" ]\n      [x,y]   -> [ x ++ \".\" ++ y ++ \".0\" ]\n      x:y:z:_ -> [ x ++ \".\" ++ y ++ \".\" ++ z ]\n      _       -> [\"1.0.0\", \"2.0.3\"]\n\n  else\n    [\"1.0.0\", \"2.0.3\"]\n\n\n\n-- ELM FILE\n\n\nelmFile :: Parser FilePath\nelmFile =\n  Parser\n    { _singular = \"elm file\"\n    , _plural = \"elm files\"\n    , _parser = parseElmFile\n    , _suggest = \\_ -> return []\n    , _examples = exampleElmFiles\n    }\n\n\nparseElmFile :: String -> Maybe FilePath\nparseElmFile chars =\n  if FP.takeExtension chars == \".elm\" then\n    Just chars\n  else\n    Nothing\n\n\nexampleElmFiles :: String -> IO [String]\nexampleElmFiles _ =\n  return [\"Main.elm\",\"src/Main.elm\"]\n\n\n\n-- PACKAGE\n\n\npackage :: Parser Pkg.Name\npackage =\n  Parser\n    { _singular = \"package\"\n    , _plural = \"packages\"\n    , _parser = parsePackage\n    , _suggest = suggestPackages\n    , _examples = examplePackages\n    }\n\n\nparsePackage :: String -> Maybe Pkg.Name\nparsePackage chars =\n  case P.fromByteString Pkg.parser (,) (BS_UTF8.fromString chars) of\n    Right pkg -> Just pkg\n    Left _    -> Nothing\n\n\nsuggestPackages :: String -> IO [String]\nsuggestPackages given =\n  do  cache <- Stuff.getPackageCache\n      maybeRegistry <- Registry.read cache\n      return $\n        case maybeRegistry of\n          Nothing ->\n            []\n\n          Just (Registry.Registry _ versions) ->\n            filter (List.isPrefixOf given) $\n              map Pkg.toChars (Map.keys versions)\n\n\nexamplePackages :: String -> IO [String]\nexamplePackages given =\n  do  cache <- Stuff.getPackageCache\n      maybeRegistry <- Registry.read cache\n      return $\n        case maybeRegistry of\n          Nothing ->\n            [ \"elm/json\"\n            , \"elm/http\"\n            , \"elm/random\"\n            ]\n\n          Just (Registry.Registry _ versions) ->\n            map Pkg.toChars $ take 4 $\n              Suggest.sort given Pkg.toChars (Map.keys versions)\n"
  },
  {
    "path": "terminal/impl/Terminal/Internal.hs",
    "content": "{-# LANGUAGE GADTs #-}\nmodule Terminal.Internal\n  ( Command(..)\n  , toName\n  , Summary(..)\n  , Flags(..)\n  , Flag(..)\n  , Parser(..)\n  , Args(..)\n  , CompleteArgs(..)\n  , RequiredArgs(..)\n  )\n  where\n\n\nimport Text.PrettyPrint.ANSI.Leijen (Doc)\n\n\n\n-- COMMAND\n\n\ndata Command where\n  Command\n    :: String\n    -> Summary\n    -> String\n    -> Doc\n    -> Args args\n    -> Flags flags\n    -> (args -> flags -> IO ())\n    -> Command\n\n\ntoName :: Command -> String\ntoName (Command name _ _ _ _ _ _) =\n  name\n\n\n\n{-| The information that shows when you run the executable with no arguments.\nIf you say it is `Common`, you need to tell people what it does. Try to keep\nit to two or three lines. If you say it is `Uncommon` you can rely on `Details`\nfor a more complete explanation.\n-}\ndata Summary = Common String | Uncommon\n\n\n\n-- FLAGS\n\n\ndata Flags a where\n  FDone :: a -> Flags a\n  FMore :: Flags (a -> b) -> Flag a -> Flags b\n\n\ndata Flag a where\n  Flag :: String -> Parser a -> String -> Flag (Maybe a)\n  OnOff :: String -> String -> Flag Bool\n\n\n\n-- PARSERS\n\n\ndata Parser a =\n  Parser\n    { _singular :: String\n    , _plural :: String\n    , _parser :: String -> Maybe a\n    , _suggest :: String -> IO [String]\n    , _examples :: String -> IO [String]\n    }\n\n\n\n-- ARGS\n\n\nnewtype Args a =\n  Args [CompleteArgs a]\n\n\ndata CompleteArgs args where\n  Exactly  :: RequiredArgs args -> CompleteArgs args\n  Multiple :: RequiredArgs ([a] -> args) -> Parser a -> CompleteArgs args\n  Optional :: RequiredArgs (Maybe a -> args) -> Parser a -> CompleteArgs args\n\n\ndata RequiredArgs a where\n  Done :: a -> RequiredArgs a\n  Required :: RequiredArgs (a -> b) -> Parser a -> RequiredArgs b\n"
  },
  {
    "path": "terminal/impl/Terminal.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-x-partial #-}\nmodule Terminal\n  ( app\n  , Command(..)\n  , Summary(..)\n  , Flags, noFlags, flags, (|--)\n  , Flag, flag, onOff\n  , Parser(..)\n  , Args, noArgs, required, optional, zeroOrMore, oneOrMore, oneOf\n  , require0, require1, require2, require3, require4, require5\n  , RequiredArgs, args, exactly, (!), (?), (...)\n  )\n  where\n\n\nimport qualified Data.List as List\nimport qualified Data.Maybe as Maybe\nimport qualified System.Directory as Dir\nimport qualified System.Environment as Env\nimport qualified System.Exit as Exit\nimport qualified System.FilePath as FP\nimport System.FilePath ((</>))\nimport GHC.IO.Encoding (setLocaleEncoding, utf8)\nimport System.IO (hPutStr, hPutStrLn, stdout)\nimport qualified Text.PrettyPrint.ANSI.Leijen as P\nimport qualified Text.Read as Read\n\nimport qualified Elm.Version as V\nimport Terminal.Internal\nimport qualified Terminal.Chomp as Chomp\nimport qualified Terminal.Error as Error\n\n\n\n-- COMMAND\n\n\n_command :: String -> P.Doc -> Args args -> Flags flags -> (args -> flags -> IO ()) -> IO ()\n_command details example args_ flags_ callback =\n  do  setLocaleEncoding utf8\n      argStrings <- Env.getArgs\n      case argStrings of\n        [\"--version\"] ->\n          do  hPutStrLn stdout (V.toChars V.compiler)\n              Exit.exitSuccess\n\n        chunks ->\n          if elem \"--help\" chunks then\n            Error.exitWithHelp Nothing details example args_ flags_\n\n          else\n            case snd $ Chomp.chomp Nothing chunks args_ flags_ of\n              Right (argsValue, flagValue) ->\n                callback argsValue flagValue\n\n              Left err ->\n                Error.exitWithError err\n\n\n\n-- APP\n\n\napp :: P.Doc -> P.Doc -> [Command] -> IO ()\napp intro outro commands =\n  do  setLocaleEncoding utf8\n      argStrings <- Env.getArgs\n      case argStrings of\n        [] ->\n          Error.exitWithOverview intro outro commands\n\n        [\"--help\"] ->\n          Error.exitWithOverview intro outro commands\n\n        [\"--version\"] ->\n          do  hPutStrLn stdout (V.toChars V.compiler)\n              Exit.exitSuccess\n\n        command : chunks ->\n          do  case List.find (\\cmd -> toName cmd == command) commands of\n                Nothing ->\n                  Error.exitWithUnknown command (map toName commands)\n\n                Just (Command _ _ details example args_ flags_ callback) ->\n                  if elem \"--help\" chunks then\n                    Error.exitWithHelp (Just command) details example args_ flags_\n\n                  else\n                    case snd $ Chomp.chomp Nothing chunks args_ flags_ of\n                      Right (argsValue, flagsValue) ->\n                        callback argsValue flagsValue\n\n                      Left err ->\n                        Error.exitWithError err\n\n\n\n-- AUTO-COMPLETE\n\n\n_maybeAutoComplete :: [String] -> (Int -> [String] -> IO [String]) -> IO ()\n_maybeAutoComplete argStrings getSuggestions =\n  if length argStrings /= 3 then\n    return ()\n  else\n    do  maybeLine <- Env.lookupEnv \"COMP_LINE\"\n        case maybeLine of\n          Nothing ->\n            return ()\n\n          Just line ->\n            do  (index, chunks) <- getCompIndex line\n                suggestions <- getSuggestions index chunks\n                hPutStr stdout (unlines suggestions)\n                Exit.exitFailure\n\n\ngetCompIndex :: String -> IO (Int, [String])\ngetCompIndex line =\n  do  maybePoint <- Env.lookupEnv \"COMP_POINT\"\n      case Read.readMaybe =<< maybePoint of\n        Nothing ->\n          do  let chunks = words line\n              return (length chunks, chunks)\n\n        Just point ->\n          let\n            groups = List.groupBy grouper (zip line [0..])\n            rawChunks = drop 1 (filter (all (not . isSpace . fst)) groups)\n          in\n          return\n            ( findIndex 1 point rawChunks\n            , map (map fst) rawChunks\n            )\n\n\ngrouper :: (Char, Int) -> (Char, Int) -> Bool\ngrouper (c1, _) (c2, _) =\n  isSpace c1 == isSpace c2\n\n\nisSpace :: Char -> Bool\nisSpace char =\n  char == ' ' || char == '\\t' || char == '\\n'\n\n\nfindIndex :: Int -> Int -> [[(Char,Int)]] -> Int\nfindIndex index point chunks =\n  case chunks of\n    [] ->\n      index\n\n    chunk:cs ->\n      let\n        lo = snd (head chunk)\n        hi = snd (last chunk)\n      in\n      if point < lo then\n        0\n      else if point <= hi + 1 then\n        index\n      else\n        findIndex (index + 1) point cs\n\n\n_complexSuggest :: [Command] -> Int -> [String] -> IO [String]\n_complexSuggest commands index strings =\n  case strings of\n    [] ->\n      return (map toName commands)\n\n    command : chunks ->\n      if index == 1 then\n        return (filter (List.isPrefixOf command) (map toName commands))\n      else\n        case List.find (\\cmd -> toName cmd == command) commands of\n          Nothing ->\n            return []\n\n          Just (Command _ _ _ _ args_ flags_ _) ->\n            fst $ Chomp.chomp (Just (index-1)) chunks args_ flags_\n\n\n\n-- FLAGS\n\n\n{-|-}\nnoFlags :: Flags ()\nnoFlags =\n  FDone ()\n\n\n{-|-}\nflags :: a -> Flags a\nflags =\n  FDone\n\n\n{-|-}\n(|--) :: Flags (a -> b) -> Flag a -> Flags b\n(|--) =\n  FMore\n\n\n\n-- FLAG\n\n\n{-|-}\nflag :: String -> Parser a -> String -> Flag (Maybe a)\nflag =\n  Flag\n\n\n{-|-}\nonOff :: String -> String -> Flag Bool\nonOff =\n  OnOff\n\n\n\n-- FANCY ARGS\n\n\n{-|-}\nargs :: a -> RequiredArgs a\nargs =\n  Done\n\n\n{-|-}\nexactly :: RequiredArgs a -> Args a\nexactly requiredArgs =\n  Args [Exactly requiredArgs]\n\n\n{-|-}\n(!) :: RequiredArgs (a -> b) -> Parser a -> RequiredArgs b\n(!) =\n  Required\n\n\n{-|-}\n(?) :: RequiredArgs (Maybe a -> b) -> Parser a -> Args b\n(?) requiredArgs optionalArg =\n  Args [Optional requiredArgs optionalArg]\n\n\n{-|-}\n(...) :: RequiredArgs ([a] -> b) -> Parser a -> Args b\n(...) requiredArgs repeatedArg =\n  Args [Multiple requiredArgs repeatedArg]\n\n\n{-|-}\noneOf :: [Args a] -> Args a\noneOf listOfArgs =\n  Args (concatMap (\\(Args a) -> a) listOfArgs)\n\n\n\n-- SIMPLE ARGS\n\n\n{-|-}\nnoArgs :: Args ()\nnoArgs =\n  exactly (args ())\n\n\n{-|-}\nrequired :: Parser a -> Args a\nrequired parser =\n  require1 id parser\n\n\n{-|-}\noptional :: Parser a -> Args (Maybe a)\noptional parser =\n  args id ? parser\n\n\n{-|-}\nzeroOrMore :: Parser a -> Args [a]\nzeroOrMore parser =\n  args id ... parser\n\n\n{-|-}\noneOrMore :: Parser a -> Args (a, [a])\noneOrMore parser =\n  args (,) ! parser ... parser\n\n\n{-|-}\nrequire0 :: args -> Args args\nrequire0 value =\n  exactly (args value)\n\n\n{-|-}\nrequire1 :: (a -> args) -> Parser a -> Args args\nrequire1 func a =\n  exactly (args func ! a)\n\n\n{-|-}\nrequire2 :: (a -> b -> args) -> Parser a -> Parser b -> Args args\nrequire2 func a b =\n  exactly (args func ! a ! b)\n\n\n{-|-}\nrequire3 :: (a -> b -> c -> args) -> Parser a -> Parser b -> Parser c -> Args args\nrequire3 func a b c =\n  exactly (args func ! a ! b ! c)\n\n\n{-|-}\nrequire4 :: (a -> b -> c -> d -> args) -> Parser a -> Parser b -> Parser c -> Parser d -> Args args\nrequire4 func a b c d =\n  exactly (args func ! a ! b ! c ! d)\n\n\n{-|-}\nrequire5 :: (a -> b -> c -> d -> e -> args) -> Parser a -> Parser b -> Parser c -> Parser d -> Parser e -> Args args\nrequire5 func a b c d e =\n  exactly (args func ! a ! b ! c ! d ! e)\n\n\n\n-- SUGGEST FILES\n\n\n{-| Helper for creating custom `Parser` values. It will suggest directories and\nfile names:\n\n    suggestFiles []             -- suggests any file\n    suggestFiles [\"elm\"]        -- suggests only .elm files\n    suggestFiles [\"js\",\"html\"]  -- suggests only .js and .html files\n\nNotice that you can limit the suggestion by the file extension! If you need\nsomething more elaborate, you can implement a function like this yourself that\ndoes whatever you need!\n-}\n_suggestFiles :: [String] -> String -> IO [String]\n_suggestFiles extensions string =\n  let\n    (dir, start) =\n      FP.splitFileName string\n  in\n  do  content <- Dir.getDirectoryContents dir\n      Maybe.catMaybes\n        <$> traverse (isPossibleSuggestion extensions start dir) content\n\n\nisPossibleSuggestion :: [String] -> String -> FilePath -> FilePath -> IO (Maybe FilePath)\nisPossibleSuggestion extensions start dir path =\n  if List.isPrefixOf start path then\n    do  isDir <- Dir.doesDirectoryExist (dir </> path)\n        return $\n          if isDir then\n            Just (path ++ \"/\")\n          else if isOkayExtension path extensions then\n            Just path\n          else\n            Nothing\n  else\n    return Nothing\n\n\nisOkayExtension :: FilePath -> [String] -> Bool\nisOkayExtension path extensions =\n  null extensions || elem (FP.takeExtension path) extensions\n\n"
  },
  {
    "path": "terminal/src/Bump.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-x-partial #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Bump\n  ( run\n  )\n  where\n\n\nimport qualified Data.List as List\nimport qualified Data.NonEmptyList as NE\n\nimport qualified BackgroundWriter as BW\nimport qualified Build\nimport qualified Deps.Bump as Bump\nimport qualified Deps.Diff as Diff\nimport qualified Deps.Registry as Registry\nimport qualified Elm.Details as Details\nimport qualified Elm.Docs as Docs\nimport qualified Elm.Magnitude as M\nimport qualified Elm.Outline as Outline\nimport qualified Elm.Version as V\nimport qualified Http\nimport Reporting.Doc ((<+>))\nimport qualified Reporting\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Exit.Help as Help\nimport qualified Reporting.Task as Task\nimport qualified Stuff\n\n\n\n-- RUN\n\n\nrun :: () -> () -> IO ()\nrun () () =\n  Reporting.attempt Exit.bumpToReport $\n    Task.run (bump =<< getEnv)\n\n\n\n-- ENV\n\n\ndata Env =\n  Env\n    { _root :: FilePath\n    , _cache :: Stuff.PackageCache\n    , _manager :: Http.Manager\n    , _registry :: Registry.Registry\n    , _outline :: Outline.PkgOutline\n    }\n\n\ngetEnv :: Task.Task Exit.Bump Env\ngetEnv =\n  do  maybeRoot <- Task.io $ Stuff.findRoot\n      case maybeRoot of\n        Nothing ->\n          Task.throw Exit.BumpNoOutline\n\n        Just root ->\n          do  cache <- Task.io $ Stuff.getPackageCache\n              manager <- Task.io $ Http.getManager\n              registry <- Task.eio Exit.BumpMustHaveLatestRegistry $ Registry.latest manager cache\n              outline <- Task.eio Exit.BumpBadOutline $ Outline.read root\n              case outline of\n                Outline.App _ ->\n                  Task.throw Exit.BumpApplication\n\n                Outline.Pkg pkgOutline ->\n                  return $ Env root cache manager registry pkgOutline\n\n\n\n-- BUMP\n\n\nbump :: Env -> Task.Task Exit.Bump ()\nbump env@(Env root _ _ registry outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) =\n  case Registry.getVersions pkg registry of\n    Just knownVersions ->\n      let\n        bumpableVersions =\n          map (\\(old, _, _) -> old) (Bump.getPossibilities knownVersions)\n      in\n      if elem vsn bumpableVersions\n      then suggestVersion env\n      else\n        Task.throw $ Exit.BumpUnexpectedVersion vsn $\n          map head (List.group (List.sort bumpableVersions))\n\n    Nothing ->\n      Task.io $ checkNewPackage root outline\n\n\n\n-- CHECK NEW PACKAGE\n\n\ncheckNewPackage :: FilePath -> Outline.PkgOutline -> IO ()\ncheckNewPackage root outline@(Outline.PkgOutline _ _ _ version _ _ _ _) =\n  do  putStrLn Exit.newPackageOverview\n      if version == V.one\n        then\n          putStrLn \"The version number in elm.json is correct so you are all set!\"\n        else\n          changeVersion root outline V.one $\n            \"It looks like the version in elm.json has been changed though!\\n\\\n            \\Would you like me to change it back to \"\n            <> D.fromVersion V.one <> \"? [Y/n] \"\n\n\n\n-- SUGGEST VERSION\n\n\nsuggestVersion :: Env -> Task.Task Exit.Bump ()\nsuggestVersion (Env root cache manager _ outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) =\n  do  oldDocs <- Task.eio (Exit.BumpCannotFindDocs pkg vsn) (Diff.getDocs cache manager pkg vsn)\n      newDocs <- generateDocs root outline\n      let changes = Diff.diff oldDocs newDocs\n      let newVersion = Diff.bump changes vsn\n      Task.io $ changeVersion root outline newVersion $\n        let\n          old = D.fromVersion vsn\n          new = D.fromVersion newVersion\n          mag = D.fromChars $ M.toChars (Diff.toMagnitude changes)\n        in\n        \"Based on your new API, this should be a\" <+> D.green mag <+> \"change (\" <> old <> \" => \" <> new <> \")\\n\"\n        <> \"Bail out of this command and run 'elm diff' for a full explanation.\\n\"\n        <> \"\\n\"\n        <> \"Should I perform the update (\" <> old <> \" => \" <> new <> \") in elm.json? [Y/n] \"\n\n\ngenerateDocs :: FilePath -> Outline.PkgOutline -> Task.Task Exit.Bump Docs.Documentation\ngenerateDocs root (Outline.PkgOutline _ _ _ _ exposed _ _ _) =\n  do  details <-\n        Task.eio Exit.BumpBadDetails $ BW.withScope $ \\scope ->\n          Details.load Reporting.silent scope root\n\n      case Outline.flattenExposed exposed of\n        [] ->\n          Task.throw $ Exit.BumpNoExposed\n\n        e:es ->\n          Task.eio Exit.BumpBadBuild $\n            Build.fromExposed Reporting.silent root details Build.KeepDocs (NE.List e es)\n\n\n\n-- CHANGE VERSION\n\n\nchangeVersion :: FilePath -> Outline.PkgOutline -> V.Version -> D.Doc -> IO ()\nchangeVersion root outline targetVersion question =\n  do  approved <- Reporting.ask question\n      if not approved\n        then\n          putStrLn \"Okay, I did not change anything!\"\n\n        else\n          do  Outline.write root $ Outline.Pkg $\n                outline { Outline._pkg_version = targetVersion }\n\n              Help.toStdout $\n                \"Version changed to \"\n                <> D.green (D.fromVersion targetVersion)\n                <> \"!\\n\"\n"
  },
  {
    "path": "terminal/src/Develop/Generate/Help.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE QuasiQuotes #-}\nmodule Develop.Generate.Help\n  ( makePageHtml\n  , makeCodeHtml\n  )\n  where\n\n\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.Name as Name\nimport Text.RawString.QQ (r)\n\nimport qualified Json.Encode as Encode\n\n\n\n-- PAGES\n\n\nmakePageHtml :: Name.Name -> Maybe Encode.Value -> B.Builder\nmakePageHtml moduleName maybeFlags =\n  [r|<!DOCTYPE HTML>\n<html>\n<head>\n  <meta charset=\"UTF-8\">\n  <link type=\"text/css\" rel=\"stylesheet\" href=\"/_elm/styles.css\">\n  <script src=\"/_elm/elm.js\"></script>\n</head>\n<body>\n<script>\nElm.|] <> Name.toBuilder moduleName <> [r|.init({ flags: |] <> maybe \"undefined\" Encode.encode maybeFlags <> [r| });\n</script>\n</body>\n</html>\n|]\n\n\n\n-- CODE\n\n\nmakeCodeHtml :: FilePath -> B.Builder -> B.Builder\nmakeCodeHtml title code =\n  [r|<!DOCTYPE HTML>\n<html>\n<head>\n  <meta charset=\"UTF-8\">\n  <title>|] <> B.stringUtf8 title <> [r|</title>\n  <style type=\"text/css\">\n    @import url(/_elm/source-code-pro.ttf);\n    html, head, body, pre { margin: 0; height: 100%; }\n    body { font-family: \"Source Code Pro\", monospace; }\n  </style>\n  <link type=\"text/css\" rel=\"stylesheet\" href=\"//cdnjs.cloudflare.com/ajax/libs/highlight.js/9.3.0/styles/default.min.css\">\n  <script src=\"//cdnjs.cloudflare.com/ajax/libs/highlight.js/9.3.0/highlight.min.js\"></script>\n  <script>if (hljs) { hljs.initHighlightingOnLoad(); }</script>\n</head>\n<body style=\"background-color: #F0F0F0;\">\n<pre><code>|] <> code <> [r|</code></pre>\n</body>\n</html>\n|]\n"
  },
  {
    "path": "terminal/src/Develop/Generate/Index.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Develop.Generate.Index\n  ( generate\n  )\n  where\n\n\nimport Control.Monad (filterM)\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified System.Directory as Dir\nimport System.FilePath ((</>), splitDirectories, takeExtension)\n\nimport qualified BackgroundWriter as BW\nimport qualified Develop.Generate.Help as Help\nimport qualified Elm.Details as Details\nimport qualified Elm.Outline as Outline\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified Json.Encode as E\nimport Json.Encode ((==>))\nimport qualified Reporting\nimport qualified Stuff\n\n\n\n-- GENERATE\n\n\ngenerate :: FilePath -> IO B.Builder\ngenerate pwd =\n  do  flags <- getFlags pwd\n      return $ Help.makePageHtml \"Index\" (Just (encode flags))\n\n\n\n-- FLAGS\n\n\ndata Flags =\n  Flags\n    { _root :: FilePath\n    , _pwd :: [String]\n    , _dirs :: [FilePath]\n    , _files :: [File]\n    , _readme :: Maybe String\n    , _outline :: Maybe Outline.Outline\n    , _exactDeps :: Map.Map Pkg.Name V.Version\n    }\n\n\ndata File =\n  File\n    { _path :: FilePath\n    , _runnable :: Bool\n    }\n\n\n\n-- GET FLAGS\n\n\ngetFlags :: FilePath -> IO Flags\ngetFlags pwd =\n  do  contents <- Dir.getDirectoryContents pwd\n      root <- Dir.getCurrentDirectory\n      dirs <- getDirs pwd contents\n      files <- getFiles pwd contents\n      readme <- getReadme pwd\n      outline <- getOutline\n      exactDeps <- getExactDeps outline\n      return $\n        Flags\n          { _root = root\n          , _pwd = dropWhile (\".\" ==) (splitDirectories pwd)\n          , _dirs = dirs\n          , _files = files\n          , _readme = readme\n          , _outline = outline\n          , _exactDeps = exactDeps\n          }\n\n\n\n-- README\n\n\ngetReadme :: FilePath -> IO (Maybe String)\ngetReadme dir =\n  do  let readmePath = dir </> \"README.md\"\n      exists <- Dir.doesFileExist readmePath\n      if exists\n        then Just <$> readFile readmePath\n        else return Nothing\n\n\n\n-- GET DIRECTORIES\n\n\ngetDirs :: FilePath -> [FilePath] -> IO [FilePath]\ngetDirs pwd contents =\n  filterM (Dir.doesDirectoryExist . (pwd </>)) contents\n\n\n\n-- GET FILES\n\n\ngetFiles :: FilePath -> [FilePath] -> IO [File]\ngetFiles pwd contents =\n  do  paths <- filterM (Dir.doesFileExist . (pwd </>)) contents\n      mapM (toFile pwd) paths\n\n\ntoFile :: FilePath -> FilePath -> IO File\ntoFile pwd path =\n  if takeExtension path == \".elm\" then\n    do  source <- readFile (pwd </> path)\n        let hasMain = List.isInfixOf \"\\nmain \" source\n        return (File path hasMain)\n  else\n    return (File path False)\n\n\n\n-- GET OUTLINE\n\n\ngetOutline :: IO (Maybe Outline.Outline)\ngetOutline =\n  do  maybeRoot <- Stuff.findRoot\n      case maybeRoot of\n        Nothing ->\n          return Nothing\n\n        Just root ->\n          do  result <- Outline.read root\n              case result of\n                Left _        -> return Nothing\n                Right outline -> return (Just outline)\n\n\n\n-- GET EXACT DEPS\n\n\n-- TODO revamp how `elm reactor` works so that this can go away.\n-- I am trying to \"just get it working again\" at this point though.\n--\ngetExactDeps :: Maybe Outline.Outline -> IO (Map.Map Pkg.Name V.Version)\ngetExactDeps maybeOutline =\n  case maybeOutline of\n    Nothing ->\n      return Map.empty\n\n    Just outline ->\n      case outline of\n        Outline.App _ ->\n          return Map.empty\n\n        Outline.Pkg _ ->\n          do  maybeRoot <- Stuff.findRoot\n              case maybeRoot of\n                Nothing ->\n                  return Map.empty\n\n                Just root ->\n                  BW.withScope $ \\scope ->\n                  do  result <- Details.load Reporting.silent scope root\n                      case result of\n                        Left _ ->\n                          return Map.empty\n\n                        Right (Details.Details _ validOutline _ _ _ _) ->\n                          case validOutline of\n                            Details.ValidApp _ ->\n                              return Map.empty\n\n                            Details.ValidPkg _ _ solution ->\n                              return solution\n\n\n\n-- ENCODE\n\n\nencode :: Flags -> E.Value\nencode (Flags root pwd dirs files readme outline exactDeps) =\n  E.object\n    [ \"root\" ==> encodeFilePath root\n    , \"pwd\" ==> E.list encodeFilePath pwd\n    , \"dirs\" ==> E.list encodeFilePath dirs\n    , \"files\" ==> E.list encodeFile files\n    , \"readme\" ==> maybe E.null E.chars readme\n    , \"outline\" ==> maybe E.null Outline.encode outline\n    , \"exactDeps\" ==> E.dict Pkg.toJsonString V.encode exactDeps\n    ]\n\n\nencodeFilePath :: FilePath -> E.Value\nencodeFilePath filePath =\n  E.chars filePath\n\n\nencodeFile :: File -> E.Value\nencodeFile (File path hasMain) =\n  E.object\n    [ \"name\" ==> encodeFilePath path\n    , \"runnable\" ==> E.bool hasMain\n    ]\n"
  },
  {
    "path": "terminal/src/Develop/Socket.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Develop.Socket (watchFile) where\n\nimport Control.Concurrent (forkIO, threadDelay)\nimport Control.Exception (SomeException, catch)\nimport qualified Data.ByteString.Char8 as BS\nimport qualified Network.WebSockets as WS\nimport qualified System.FSNotify.Devel as Notify\nimport qualified System.FSNotify as Notify\n\n\n\nwatchFile :: FilePath -> WS.PendingConnection -> IO ()\nwatchFile watchedFile pendingConnection =\n  do  connection <- WS.acceptRequest pendingConnection\n\n      Notify.withManager $ \\mgmt ->\n        do  stop <- Notify.treeExtAny mgmt \".\" \".elm\" print\n            tend connection\n            stop\n\n\ntend :: WS.Connection -> IO ()\ntend connection =\n  let\n    pinger :: Integer -> IO a\n    pinger n =\n      do  threadDelay (5 * 1000 * 1000)\n          WS.sendPing connection (BS.pack (show n))\n          pinger (n + 1)\n\n    receiver :: IO ()\n    receiver =\n      do  _ <- WS.receiveDataMessage connection\n          receiver\n\n    shutdown :: SomeException -> IO ()\n    shutdown _ =\n      return ()\n  in\n    do  _pid <- forkIO (receiver `catch` shutdown)\n        pinger 1 `catch` shutdown\n"
  },
  {
    "path": "terminal/src/Develop/StaticFiles/Build.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Develop.StaticFiles.Build\n  ( readAsset\n  , buildReactorFrontEnd\n  )\n  where\n\n\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.ByteString.Lazy as LBS\nimport qualified Data.NonEmptyList as NE\nimport qualified System.Directory as Dir\nimport System.FilePath ((</>))\n\nimport qualified BackgroundWriter as BW\nimport qualified Build\nimport qualified Elm.Details as Details\nimport qualified Generate\nimport qualified Reporting\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Task as Task\n\n\n\n-- ASSETS\n\n\nreadAsset :: FilePath -> IO BS.ByteString\nreadAsset path =\n  BS.readFile (\"reactor\" </> \"assets\" </> path)\n\n\n\n-- BUILD REACTOR ELM\n\n\nbuildReactorFrontEnd :: IO BS.ByteString\nbuildReactorFrontEnd =\n  BW.withScope $ \\scope ->\n  Dir.withCurrentDirectory \"reactor\" $\n  do  root <- Dir.getCurrentDirectory\n      runTaskUnsafe $\n        do  details    <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root\n            artifacts  <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details paths\n            javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.prod root details artifacts\n            return (LBS.toStrict (B.toLazyByteString javascript))\n\n\npaths :: NE.List FilePath\npaths =\n  NE.List\n    (\"src\" </> \"NotFound.elm\")\n    [ \"src\" </> \"Errors.elm\"\n    , \"src\" </> \"Index.elm\"\n    ]\n\n\nrunTaskUnsafe :: Task.Task Exit.Reactor a -> IO a\nrunTaskUnsafe task =\n  do  result <- Task.run task\n      case result of\n        Right a ->\n          return a\n\n        Left exit ->\n          do  Exit.toStderr (Exit.reactorToReport exit)\n              error\n                \"\\n--------------------------------------------------------\\\n                \\\\nError in Develop.StaticFiles.Build.buildReactorFrontEnd\\\n                \\\\nCompile with `elm make` directly to figure it out faster\\\n                \\\\n--------------------------------------------------------\\\n                \\\\n\"\n"
  },
  {
    "path": "terminal/src/Develop/StaticFiles.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule Develop.StaticFiles\n  ( lookup\n  , cssPath\n  , elmPath\n  , waitingPath\n  )\n  where\n\nimport Prelude hiding (lookup)\nimport qualified Data.ByteString as BS\nimport Data.FileEmbed (bsToExp)\nimport qualified Data.HashMap.Strict as HM\nimport Language.Haskell.TH (runIO)\nimport System.FilePath ((</>))\n\nimport qualified Develop.StaticFiles.Build as Build\n\n\n\n-- FILE LOOKUP\n\n\ntype MimeType =\n  BS.ByteString\n\n\nlookup :: FilePath -> Maybe (BS.ByteString, MimeType)\nlookup path =\n  HM.lookup path dict\n\n\ndict :: HM.HashMap FilePath (BS.ByteString, MimeType)\ndict =\n  HM.fromList\n    [ faviconPath  ==> (favicon , \"image/x-icon\")\n    , elmPath      ==> (elm     , \"application/javascript\")\n    , cssPath      ==> (css     , \"text/css\")\n    , codeFontPath ==> (codeFont, \"font/ttf\")\n    , sansFontPath ==> (sansFont, \"font/ttf\")\n    ]\n\n\n(==>) :: a -> b -> (a,b)\n(==>) a b =\n  (a, b)\n\n\n\n-- PATHS\n\n\nfaviconPath :: FilePath\nfaviconPath =\n  \"favicon.ico\"\n\n\nwaitingPath :: FilePath\nwaitingPath =\n  \"_elm\" </> \"waiting.gif\"\n\n\nelmPath :: FilePath\nelmPath =\n  \"_elm\" </> \"elm.js\"\n\n\ncssPath :: FilePath\ncssPath =\n  \"_elm\" </> \"styles.css\"\n\n\ncodeFontPath :: FilePath\ncodeFontPath =\n  \"_elm\" </> \"source-code-pro.ttf\"\n\n\nsansFontPath :: FilePath\nsansFontPath =\n  \"_elm\" </> \"source-sans-pro.ttf\"\n\n\n\n-- ELM\n\n\nelm :: BS.ByteString\nelm =\n  $(bsToExp =<< runIO Build.buildReactorFrontEnd)\n\n\n\n-- CSS\n\n\ncss :: BS.ByteString\ncss =\n  $(bsToExp =<< runIO (Build.readAsset \"styles.css\"))\n\n\n\n-- FONTS\n\n\ncodeFont :: BS.ByteString\ncodeFont =\n  $(bsToExp =<< runIO (Build.readAsset \"source-code-pro.ttf\"))\n\n\nsansFont :: BS.ByteString\nsansFont =\n  $(bsToExp =<< runIO (Build.readAsset \"source-sans-pro.ttf\"))\n\n\n\n-- IMAGES\n\n\nfavicon :: BS.ByteString\nfavicon =\n  $(bsToExp =<< runIO (Build.readAsset \"favicon.ico\"))\n"
  },
  {
    "path": "terminal/src/Develop.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Develop\n  ( Flags(..)\n  , run\n  )\n  where\n\n\nimport Control.Applicative ((<|>))\nimport Control.Monad (guard)\nimport Control.Monad.Trans (MonadIO(liftIO))\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.ByteString as BS\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.NonEmptyList as NE\nimport qualified System.Directory as Dir\nimport System.FilePath as FP\nimport Snap.Core hiding (path)\nimport Snap.Http.Server\nimport Snap.Util.FileServe\n\nimport qualified BackgroundWriter as BW\nimport qualified Build\nimport qualified Elm.Details as Details\nimport qualified Develop.Generate.Help as Help\nimport qualified Develop.Generate.Index as Index\nimport qualified Develop.StaticFiles as StaticFiles\nimport qualified Generate.Html as Html\nimport qualified Generate\nimport qualified Reporting\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Task as Task\nimport qualified Stuff\n\n\n\n-- RUN THE DEV SERVER\n\n\ndata Flags =\n  Flags\n    { _port :: Maybe Int\n    }\n\n\nrun :: () -> Flags -> IO ()\nrun () (Flags maybePort) =\n  do  let port = maybe 8000 id maybePort\n      putStrLn $ \"Go to http://localhost:\" ++ show port ++ \" to see your project dashboard.\"\n      httpServe (config port) $\n        serveFiles\n        <|> serveDirectoryWith directoryConfig \".\"\n        <|> serveAssets\n        <|> error404\n\n\nconfig :: Int -> Config Snap a\nconfig port =\n  setVerbose False $ setPort port $\n    setAccessLog ConfigNoLog $ setErrorLog ConfigNoLog $ defaultConfig\n\n\n\n-- INDEX\n\n\ndirectoryConfig :: MonadSnap m => DirectoryConfig m\ndirectoryConfig =\n  fancyDirectoryConfig\n    { indexFiles = []\n    , indexGenerator = \\pwd ->\n        do  modifyResponse $ setContentType \"text/html;charset=utf-8\"\n            writeBuilder =<< liftIO (Index.generate pwd)\n    }\n\n\n\n-- NOT FOUND\n\n\nerror404 :: Snap ()\nerror404 =\n  do  modifyResponse $ setResponseStatus 404 \"Not Found\"\n      modifyResponse $ setContentType \"text/html;charset=utf-8\"\n      writeBuilder $ Help.makePageHtml \"NotFound\" Nothing\n\n\n\n-- SERVE FILES\n\n\nserveFiles :: Snap ()\nserveFiles =\n  do  path <- getSafePath\n      guard =<< liftIO (Dir.doesFileExist path)\n      serveElm path <|> serveFilePretty path\n\n\n\n-- SERVE FILES + CODE HIGHLIGHTING\n\n\nserveFilePretty :: FilePath -> Snap ()\nserveFilePretty path =\n  let\n    possibleExtensions =\n      getSubExts (takeExtensions path)\n  in\n    case mconcat (map lookupMimeType possibleExtensions) of\n      Nothing ->\n        serveCode path\n\n      Just mimeType ->\n        serveFileAs mimeType path\n\n\ngetSubExts :: String -> [String]\ngetSubExts fullExtension =\n  if null fullExtension then\n    []\n  else\n    fullExtension : getSubExts (takeExtensions (drop 1 fullExtension))\n\n\nserveCode :: String -> Snap ()\nserveCode path =\n  do  code <- liftIO (BS.readFile path)\n      modifyResponse (setContentType \"text/html\")\n      writeBuilder $\n        Help.makeCodeHtml ('~' : '/' : path) (B.byteString code)\n\n\n\n-- SERVE ELM\n\n\nserveElm :: FilePath -> Snap ()\nserveElm path =\n  do  guard (takeExtension path == \".elm\")\n      modifyResponse (setContentType \"text/html\")\n      result <- liftIO $ compile path\n      case result of\n        Right builder ->\n          writeBuilder builder\n\n        Left exit ->\n          writeBuilder $ Help.makePageHtml \"Errors\" $ Just $\n            Exit.toJson $ Exit.reactorToReport exit\n\n\ncompile :: FilePath -> IO (Either Exit.Reactor B.Builder)\ncompile path =\n  do  maybeRoot <- Stuff.findRoot\n      case maybeRoot of\n        Nothing ->\n          return $ Left $ Exit.ReactorNoOutline\n\n        Just root ->\n          BW.withScope $ \\scope -> Stuff.withRootLock root $ Task.run $\n            do  details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root\n                artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details (NE.List path [])\n                javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.dev root details artifacts\n                let (NE.List name _) = Build.getRootNames artifacts\n                return $ Html.sandwich name javascript\n\n\n\n-- SERVE STATIC ASSETS\n\n\nserveAssets :: Snap ()\nserveAssets =\n  do  path <- getSafePath\n      case StaticFiles.lookup path of\n        Nothing ->\n          pass\n\n        Just (content, mimeType) ->\n          do  modifyResponse (setContentType (mimeType <> \";charset=utf-8\"))\n              writeBS content\n\n\n\n-- MIME TYPES\n\n\nlookupMimeType :: FilePath -> Maybe BS.ByteString\nlookupMimeType ext =\n  HashMap.lookup ext mimeTypeDict\n\n\n(==>) :: a -> b -> (a,b)\n(==>) a b =\n  (a, b)\n\n\nmimeTypeDict :: HashMap.HashMap FilePath BS.ByteString\nmimeTypeDict =\n  HashMap.fromList\n    [ \".asc\"     ==> \"text/plain\"\n    , \".asf\"     ==> \"video/x-ms-asf\"\n    , \".asx\"     ==> \"video/x-ms-asf\"\n    , \".avi\"     ==> \"video/x-msvideo\"\n    , \".bz2\"     ==> \"application/x-bzip\"\n    , \".css\"     ==> \"text/css\"\n    , \".dtd\"     ==> \"text/xml\"\n    , \".dvi\"     ==> \"application/x-dvi\"\n    , \".gif\"     ==> \"image/gif\"\n    , \".gz\"      ==> \"application/x-gzip\"\n    , \".htm\"     ==> \"text/html\"\n    , \".html\"    ==> \"text/html\"\n    , \".ico\"     ==> \"image/x-icon\"\n    , \".jpeg\"    ==> \"image/jpeg\"\n    , \".jpg\"     ==> \"image/jpeg\"\n    , \".js\"      ==> \"text/javascript\"\n    , \".json\"    ==> \"application/json\"\n    , \".m3u\"     ==> \"audio/x-mpegurl\"\n    , \".mov\"     ==> \"video/quicktime\"\n    , \".mp3\"     ==> \"audio/mpeg\"\n    , \".mp4\"     ==> \"video/mp4\"\n    , \".mpeg\"    ==> \"video/mpeg\"\n    , \".mpg\"     ==> \"video/mpeg\"\n    , \".ogg\"     ==> \"application/ogg\"\n    , \".otf\"     ==> \"font/otf\"\n    , \".pac\"     ==> \"application/x-ns-proxy-autoconfig\"\n    , \".pdf\"     ==> \"application/pdf\"\n    , \".png\"     ==> \"image/png\"\n    , \".qt\"      ==> \"video/quicktime\"\n    , \".sfnt\"    ==> \"font/sfnt\"\n    , \".sig\"     ==> \"application/pgp-signature\"\n    , \".spl\"     ==> \"application/futuresplash\"\n    , \".svg\"     ==> \"image/svg+xml\"\n    , \".swf\"     ==> \"application/x-shockwave-flash\"\n    , \".tar\"     ==> \"application/x-tar\"\n    , \".tar.bz2\" ==> \"application/x-bzip-compressed-tar\"\n    , \".tar.gz\"  ==> \"application/x-tgz\"\n    , \".tbz\"     ==> \"application/x-bzip-compressed-tar\"\n    , \".text\"    ==> \"text/plain\"\n    , \".tgz\"     ==> \"application/x-tgz\"\n    , \".ttf\"     ==> \"font/ttf\"\n    , \".txt\"     ==> \"text/plain\"\n    , \".wav\"     ==> \"audio/x-wav\"\n    , \".wax\"     ==> \"audio/x-ms-wax\"\n    , \".webm\"    ==> \"video/webm\"\n    , \".webp\"    ==> \"image/webp\"\n    , \".wma\"     ==> \"audio/x-ms-wma\"\n    , \".wmv\"     ==> \"video/x-ms-wmv\"\n    , \".woff\"    ==> \"font/woff\"\n    , \".woff2\"   ==> \"font/woff2\"\n    , \".xbm\"     ==> \"image/x-xbitmap\"\n    , \".xml\"     ==> \"text/xml\"\n    , \".xpm\"     ==> \"image/x-xpixmap\"\n    , \".xwd\"     ==> \"image/x-xwindowdump\"\n    , \".zip\"     ==> \"application/zip\"\n    ]\n"
  },
  {
    "path": "terminal/src/Diff.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Diff\n  ( Args(..)\n  , run\n  )\n  where\n\n\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Maybe as Maybe\nimport qualified Data.Name as Name\nimport qualified Data.NonEmptyList as NE\n\nimport qualified BackgroundWriter as BW\nimport qualified Build\nimport Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..))\nimport qualified Deps.Diff as DD\nimport qualified Deps.Registry as Registry\nimport qualified Elm.Compiler.Type as Type\nimport qualified Elm.Details as Details\nimport qualified Elm.Docs as Docs\nimport qualified Elm.Magnitude as M\nimport qualified Elm.Outline as Outline\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified Http\nimport qualified Reporting\nimport Reporting.Doc ((<+>))\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Exit.Help as Help\nimport qualified Reporting.Render.Type.Localizer as L\nimport qualified Reporting.Task as Task\nimport qualified Stuff\n\n\n\n-- RUN\n\n\ndata Args\n  = CodeVsLatest\n  | CodeVsExactly V.Version\n  | LocalInquiry V.Version V.Version\n  | GlobalInquiry Pkg.Name V.Version V.Version\n\n\nrun :: Args -> () -> IO ()\nrun args () =\n  Reporting.attempt Exit.diffToReport $\n    Task.run $\n      do  env <- getEnv\n          diff env args\n\n\n\n-- ENVIRONMENT\n\n\ndata Env =\n  Env\n    { _maybeRoot :: Maybe FilePath\n    , _cache :: Stuff.PackageCache\n    , _manager :: Http.Manager\n    , _registry :: Registry.Registry\n    }\n\n\ngetEnv :: Task Env\ngetEnv =\n  do  maybeRoot <- Task.io $ Stuff.findRoot\n      cache     <- Task.io $ Stuff.getPackageCache\n      manager   <- Task.io $ Http.getManager\n      registry  <- Task.eio Exit.DiffMustHaveLatestRegistry $ Registry.latest manager cache\n      return (Env maybeRoot cache manager registry)\n\n\n\n-- DIFF\n\n\ntype Task a =\n  Task.Task Exit.Diff a\n\n\ndiff :: Env -> Args -> Task ()\ndiff env@(Env _ _ _ registry) args =\n  case args of\n    GlobalInquiry name v1 v2 ->\n      case Registry.getVersions' name registry of\n        Right vsns ->\n          do  oldDocs <- getDocs env name vsns (min v1 v2)\n              newDocs <- getDocs env name vsns (max v1 v2)\n              writeDiff oldDocs newDocs\n\n        Left suggestions ->\n          Task.throw $ Exit.DiffUnknownPackage name suggestions\n\n    LocalInquiry v1 v2 ->\n      do  (name, vsns) <- readOutline env\n          oldDocs <- getDocs env name vsns (min v1 v2)\n          newDocs <- getDocs env name vsns (max v1 v2)\n          writeDiff oldDocs newDocs\n\n    CodeVsLatest ->\n      do  (name, vsns) <- readOutline env\n          oldDocs <- getLatestDocs env name vsns\n          newDocs <- generateDocs env\n          writeDiff oldDocs newDocs\n\n    CodeVsExactly version ->\n      do  (name, vsns) <- readOutline env\n          oldDocs <- getDocs env name vsns version\n          newDocs <- generateDocs env\n          writeDiff oldDocs newDocs\n\n\n\n-- GET DOCS\n\n\ngetDocs :: Env -> Pkg.Name -> Registry.KnownVersions -> V.Version -> Task Docs.Documentation\ngetDocs (Env _ cache manager _) name (Registry.KnownVersions latest previous) version =\n  if latest == version || elem version previous\n  then Task.eio (Exit.DiffDocsProblem version) $ DD.getDocs cache manager name version\n  else Task.throw $ Exit.DiffUnknownVersion name version (latest:previous)\n\n\ngetLatestDocs :: Env -> Pkg.Name -> Registry.KnownVersions -> Task Docs.Documentation\ngetLatestDocs (Env _ cache manager _) name (Registry.KnownVersions latest _) =\n  Task.eio (Exit.DiffDocsProblem latest) $ DD.getDocs cache manager name latest\n\n\n\n-- READ OUTLINE\n\n\nreadOutline :: Env -> Task (Pkg.Name, Registry.KnownVersions)\nreadOutline (Env maybeRoot _ _ registry) =\n  case maybeRoot of\n    Nothing ->\n      Task.throw $ Exit.DiffNoOutline\n\n    Just root ->\n      do  result <- Task.io $ Outline.read root\n          case result of\n            Left err ->\n              Task.throw $ Exit.DiffBadOutline err\n\n            Right outline ->\n              case outline of\n                Outline.App _ ->\n                  Task.throw $ Exit.DiffApplication\n\n                Outline.Pkg (Outline.PkgOutline pkg _ _ _ _ _ _ _) ->\n                  case Registry.getVersions pkg registry of\n                    Just vsns -> return (pkg, vsns)\n                    Nothing   -> Task.throw Exit.DiffUnpublished\n\n\n\n-- GENERATE DOCS\n\n\ngenerateDocs :: Env -> Task Docs.Documentation\ngenerateDocs (Env maybeRoot _ _ _) =\n  case maybeRoot of\n    Nothing ->\n      Task.throw $ Exit.DiffNoOutline\n\n    Just root ->\n      do  details <-\n            Task.eio Exit.DiffBadDetails $ BW.withScope $ \\scope ->\n              Details.load Reporting.silent scope root\n\n          case Details._outline details of\n            Details.ValidApp _ ->\n              Task.throw $ Exit.DiffApplication\n\n            Details.ValidPkg _ exposed _ ->\n              case exposed of\n                [] ->\n                  Task.throw $ Exit.DiffNoExposed\n\n                e:es ->\n                  Task.eio Exit.DiffBadBuild $\n                    Build.fromExposed Reporting.silent root details Build.KeepDocs (NE.List e es)\n\n\n\n-- WRITE DIFF\n\n\nwriteDiff :: Docs.Documentation -> Docs.Documentation -> Task ()\nwriteDiff oldDocs newDocs =\n  let\n    changes = DD.diff oldDocs newDocs\n    localizer = L.fromNames (Map.union oldDocs newDocs)\n  in\n  Task.io $ Help.toStdout $ toDoc localizer changes <> \"\\n\"\n\n\n\n-- TO DOC\n\n\ntoDoc :: L.Localizer -> PackageChanges -> D.Doc\ntoDoc localizer changes@(PackageChanges added changed removed) =\n  if null added && Map.null changed && null removed then\n    \"No API changes detected, so this is a\" <+> D.green \"PATCH\" <+> \"change.\"\n  else\n    let\n      magDoc =\n        D.fromChars (M.toChars (DD.toMagnitude changes))\n\n      header =\n        \"This is a\" <+> D.green magDoc <+> \"change.\"\n\n      addedChunk =\n        if null added then [] else\n          [ Chunk \"ADDED MODULES\" M.MINOR $\n              D.vcat $ map D.fromName added\n          ]\n\n      removedChunk =\n        if null removed then [] else\n          [ Chunk \"REMOVED MODULES\" M.MAJOR $\n              D.vcat $ map D.fromName removed\n          ]\n\n      chunks =\n        addedChunk ++ removedChunk ++ map (changesToChunk localizer) (Map.toList changed)\n    in\n      D.vcat (header : \"\" : map chunkToDoc chunks)\n\n\ndata Chunk =\n  Chunk\n    { _title :: String\n    , _magnitude :: M.Magnitude\n    , _details :: D.Doc\n    }\n\n\nchunkToDoc :: Chunk -> D.Doc\nchunkToDoc (Chunk title magnitude details) =\n  let\n    header =\n      \"----\" <+> D.fromChars title <+> \"-\" <+> D.fromChars (M.toChars magnitude) <+> \"----\"\n  in\n    D.vcat\n      [ D.dullcyan header\n      , \"\"\n      , D.indent 4 details\n      , \"\"\n      , \"\"\n      ]\n\n\nchangesToChunk :: L.Localizer -> (Name.Name, ModuleChanges) -> Chunk\nchangesToChunk localizer (name, changes@(ModuleChanges unions aliases values binops)) =\n  let\n    magnitude =\n      DD.moduleChangeMagnitude changes\n\n    (unionAdd, unionChange, unionRemove) =\n      changesToDocTriple (unionToDoc localizer) unions\n\n    (aliasAdd, aliasChange, aliasRemove) =\n      changesToDocTriple (aliasToDoc localizer) aliases\n\n    (valueAdd, valueChange, valueRemove) =\n      changesToDocTriple (valueToDoc localizer) values\n\n    (binopAdd, binopChange, binopRemove) =\n      changesToDocTriple (binopToDoc localizer) binops\n  in\n    Chunk (Name.toChars name) magnitude $\n      D.vcat $ List.intersperse \"\" $ Maybe.catMaybes $\n        [ changesToDoc \"Added\" unionAdd aliasAdd valueAdd binopAdd\n        , changesToDoc \"Removed\" unionRemove aliasRemove valueRemove binopRemove\n        , changesToDoc \"Changed\" unionChange aliasChange valueChange binopChange\n        ]\n\n\nchangesToDocTriple :: (k -> v -> D.Doc) -> Changes k v -> ([D.Doc], [D.Doc], [D.Doc])\nchangesToDocTriple entryToDoc (Changes added changed removed) =\n  let\n    indented (name, value) =\n      D.indent 4 (entryToDoc name value)\n\n    diffed (name, (oldValue, newValue)) =\n      D.vcat\n        [ \"  - \" <> entryToDoc name oldValue\n        , \"  + \" <> entryToDoc name newValue\n        , \"\"\n        ]\n  in\n    ( map indented (Map.toList added)\n    , map diffed   (Map.toList changed)\n    , map indented (Map.toList removed)\n    )\n\n\nchangesToDoc :: String -> [D.Doc] -> [D.Doc] -> [D.Doc] -> [D.Doc] -> Maybe D.Doc\nchangesToDoc categoryName unions aliases values binops =\n  if null unions && null aliases && null values && null binops then\n    Nothing\n\n  else\n    Just $ D.vcat $\n      D.fromChars categoryName <> \":\" : unions ++ aliases ++ binops ++ values\n\n\nunionToDoc :: L.Localizer -> Name.Name -> Docs.Union -> D.Doc\nunionToDoc localizer name (Docs.Union _ tvars ctors) =\n  let\n    setup =\n      \"type\" <+> D.fromName name <+> D.hsep (map D.fromName tvars)\n\n    ctorDoc (ctor, tipes) =\n      typeDoc localizer (Type.Type ctor tipes)\n  in\n    D.hang 4 (D.sep (setup : zipWith (<+>) (\"=\" : repeat \"|\") (map ctorDoc ctors)))\n\n\naliasToDoc :: L.Localizer -> Name.Name -> Docs.Alias -> D.Doc\naliasToDoc localizer name (Docs.Alias _ tvars tipe) =\n  let\n    declaration =\n      \"type\" <+> \"alias\" <+> D.hsep (map D.fromName (name:tvars)) <+> \"=\"\n  in\n    D.hang 4 (D.sep [ declaration, typeDoc localizer tipe ])\n\n\nvalueToDoc :: L.Localizer -> Name.Name -> Docs.Value -> D.Doc\nvalueToDoc localizer name (Docs.Value _ tipe) =\n  D.hang 4 $ D.sep [ D.fromName name <+> \":\", typeDoc localizer tipe ]\n\n\nbinopToDoc :: L.Localizer -> Name.Name -> Docs.Binop -> D.Doc\nbinopToDoc localizer name (Docs.Binop _ tipe associativity (Docs.Precedence n)) =\n    \"(\" <> D.fromName name <> \")\" <+> \":\" <+> typeDoc localizer tipe <> D.black details\n  where\n    details =\n      \"    (\" <> D.fromName assoc <> \"/\" <> D.fromInt n <> \")\"\n\n    assoc =\n      case associativity of\n        Docs.Left  -> \"left\"\n        Docs.Non   -> \"non\"\n        Docs.Right -> \"right\"\n\n\ntypeDoc :: L.Localizer -> Type.Type -> D.Doc\ntypeDoc localizer tipe =\n  Type.toDoc localizer Type.None tipe\n"
  },
  {
    "path": "terminal/src/Init.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Init\n  ( run\n  )\n  where\n\n\nimport Prelude hiding (init)\nimport qualified Data.Map as Map\nimport qualified Data.NonEmptyList as NE\nimport qualified System.Directory as Dir\n\nimport qualified Deps.Solver as Solver\nimport qualified Elm.Constraint as Con\nimport qualified Elm.Outline as Outline\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified Reporting\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Exit as Exit\n\n\n\n-- RUN\n\n\nrun :: () -> () -> IO ()\nrun () () =\n  Reporting.attempt Exit.initToReport $\n  do  exists <- Dir.doesFileExist \"elm.json\"\n      if exists\n        then return (Left Exit.InitAlreadyExists)\n        else\n          do  approved <- Reporting.ask question\n              if approved\n                then init\n                else\n                  do  putStrLn \"Okay, I did not make any changes!\"\n                      return (Right ())\n\n\nquestion :: D.Doc\nquestion =\n  D.stack\n    [ D.fillSep\n        [\"Hello!\"\n        ,\"Elm\",\"projects\",\"always\",\"start\",\"with\",\"an\",D.green \"elm.json\",\"file.\"\n        ,\"I\",\"can\",\"create\",\"them!\"\n        ]\n    , D.reflow\n        \"Now you may be wondering, what will be in this file? How do I add Elm files to\\\n        \\ my project? How do I see it in the browser? How will my code grow? Do I need\\\n        \\ more directories? What about tests? Etc.\"\n    , D.fillSep\n        [\"Check\",\"out\",D.cyan (D.fromChars (D.makeLink \"init\"))\n        ,\"for\",\"all\",\"the\",\"answers!\"\n        ]\n    , \"Knowing all that, would you like me to create an elm.json file now? [Y/n]: \"\n    ]\n\n\n\n-- INIT\n\n\ninit :: IO (Either Exit.Init ())\ninit =\n  do  eitherEnv <- Solver.initEnv\n      case eitherEnv of\n        Left problem ->\n          return (Left (Exit.InitRegistryProblem problem))\n\n        Right (Solver.Env cache _ connection registry) ->\n          do  result <- Solver.verify cache connection registry defaults\n              case result of\n                Solver.Err exit ->\n                  return (Left (Exit.InitSolverProblem exit))\n\n                Solver.NoSolution ->\n                  return (Left (Exit.InitNoSolution (Map.keys defaults)))\n\n                Solver.NoOfflineSolution ->\n                  return (Left (Exit.InitNoOfflineSolution (Map.keys defaults)))\n\n                Solver.Ok details ->\n                  let\n                    solution = Map.map (\\(Solver.Details vsn _) -> vsn) details\n                    directs = Map.intersection solution defaults\n                    indirects = Map.difference solution defaults\n                  in\n                  do  Dir.createDirectoryIfMissing True \"src\"\n                      Outline.write \".\" $ Outline.App $\n                        Outline.AppOutline V.compiler (NE.List (Outline.RelativeSrcDir \"src\") []) directs indirects Map.empty Map.empty\n                      putStrLn \"Okay, I created it. Now read that link!\"\n                      return (Right ())\n\n\ndefaults :: Map.Map Pkg.Name Con.Constraint\ndefaults =\n  Map.fromList\n    [ (Pkg.core, Con.anything)\n    , (Pkg.browser, Con.anything)\n    , (Pkg.html, Con.anything)\n    ]\n"
  },
  {
    "path": "terminal/src/Install.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Install\n  ( Args(..)\n  , run\n  )\n  where\n\n\nimport Data.Map ((!))\nimport qualified Data.Map as Map\nimport qualified Data.Map.Merge.Strict as Map\n\nimport qualified BackgroundWriter as BW\nimport qualified Deps.Solver as Solver\nimport qualified Deps.Registry as Registry\nimport qualified Elm.Constraint as C\nimport qualified Elm.Details as Details\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Outline as Outline\nimport qualified Elm.Version as V\nimport qualified Reporting\nimport Reporting.Doc ((<+>))\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Task as Task\nimport qualified Stuff\n\n\n\n-- RUN\n\n\ndata Args\n  = NoArgs\n  | Install Pkg.Name\n\n\nrun :: Args -> () -> IO ()\nrun args () =\n  Reporting.attempt Exit.installToReport $\n    do  maybeRoot <- Stuff.findRoot\n        case maybeRoot of\n          Nothing ->\n            return (Left Exit.InstallNoOutline)\n\n          Just root ->\n            case args of\n              NoArgs ->\n                do  elmHome <- Stuff.getElmHome\n                    return (Left (Exit.InstallNoArgs elmHome))\n\n              Install pkg ->\n                Task.run $\n                  do  env <- Task.eio Exit.InstallBadRegistry $ Solver.initEnv\n                      oldOutline <- Task.eio Exit.InstallBadOutline $ Outline.read root\n                      case oldOutline of\n                        Outline.App outline ->\n                          do  changes <- makeAppPlan env pkg outline\n                              attemptChanges root env oldOutline V.toChars changes\n\n                        Outline.Pkg outline ->\n                          do  changes <- makePkgPlan env pkg outline\n                              attemptChanges root env oldOutline C.toChars changes\n\n\n\n-- ATTEMPT CHANGES\n\n\ndata Changes vsn\n  = AlreadyInstalled\n  | PromoteTest Outline.Outline\n  | PromoteIndirect Outline.Outline\n  | Changes (Map.Map Pkg.Name (Change vsn)) Outline.Outline\n\n\ntype Task = Task.Task Exit.Install\n\n\nattemptChanges :: FilePath -> Solver.Env -> Outline.Outline -> (a -> String) -> Changes a -> Task ()\nattemptChanges root env oldOutline toChars changes =\n  case changes of\n    AlreadyInstalled ->\n      Task.io $ putStrLn \"It is already installed!\"\n\n    PromoteIndirect newOutline ->\n      attemptChangesHelp root env oldOutline newOutline $\n        D.vcat\n         [ D.fillSep\n            [\"I\",\"found\",\"it\",\"in\",\"your\",\"elm.json\",\"file,\"\n            ,\"but\",\"in\",\"the\",D.dullyellow \"\\\"indirect\\\"\",\"dependencies.\"\n            ]\n         , D.fillSep\n            [\"Should\",\"I\",\"move\",\"it\",\"into\",D.green \"\\\"direct\\\"\"\n            ,\"dependencies\",\"for\",\"more\",\"general\",\"use?\",\"[Y/n]: \"\n            ]\n         ]\n\n    PromoteTest newOutline ->\n      attemptChangesHelp root env oldOutline newOutline $\n        D.vcat\n         [ D.fillSep\n            [\"I\",\"found\",\"it\",\"in\",\"your\",\"elm.json\",\"file,\"\n            ,\"but\",\"in\",\"the\",D.dullyellow \"\\\"test-dependencies\\\"\",\"field.\"\n            ]\n         , D.fillSep\n            [\"Should\",\"I\",\"move\",\"it\",\"into\",D.green \"\\\"dependencies\\\"\"\n            ,\"for\",\"more\",\"general\",\"use?\",\"[Y/n]: \"\n            ]\n         ]\n\n    Changes changeDict newOutline ->\n      let\n        widths = Map.foldrWithKey (widen toChars) (Widths 0 0 0) changeDict\n        changeDocs = Map.foldrWithKey (addChange toChars widths) (Docs [] [] []) changeDict\n      in\n      attemptChangesHelp root env oldOutline newOutline $ D.vcat $\n        [ \"Here is my plan:\"\n        , viewChangeDocs changeDocs\n        , \"\"\n        , \"Would you like me to update your elm.json accordingly? [Y/n]: \"\n        ]\n\n\nattemptChangesHelp :: FilePath -> Solver.Env -> Outline.Outline -> Outline.Outline -> D.Doc -> Task ()\nattemptChangesHelp root env oldOutline newOutline question =\n  Task.eio Exit.InstallBadDetails $\n  BW.withScope $ \\scope ->\n  do  approved <- Reporting.ask question\n      if approved\n        then\n          do  Outline.write root newOutline\n              result <- Details.verifyInstall scope root env newOutline\n              case result of\n                Left exit ->\n                  do  Outline.write root oldOutline\n                      return (Left exit)\n\n                Right () ->\n                  do  putStrLn \"Success!\"\n                      return (Right ())\n        else\n          do  putStrLn \"Okay, I did not change anything!\"\n              return (Right ())\n\n\n\n-- MAKE APP PLAN\n\n\nmakeAppPlan :: Solver.Env -> Pkg.Name -> Outline.AppOutline -> Task (Changes V.Version)\nmakeAppPlan (Solver.Env cache _ connection registry) pkg outline@(Outline.AppOutline _ _ direct indirect testDirect testIndirect) =\n  if Map.member pkg direct then\n    return AlreadyInstalled\n\n  else\n    -- is it already indirect?\n    case Map.lookup pkg indirect of\n      Just vsn ->\n        return $ PromoteIndirect $ Outline.App $\n          outline\n            { Outline._app_deps_direct = Map.insert pkg vsn direct\n            , Outline._app_deps_indirect = Map.delete pkg indirect\n            }\n\n      Nothing ->\n        -- is it already a test dependency?\n        case Map.lookup pkg testDirect of\n          Just vsn ->\n            return $ PromoteTest $ Outline.App $\n              outline\n                { Outline._app_deps_direct = Map.insert pkg vsn direct\n                , Outline._app_test_direct = Map.delete pkg testDirect\n                }\n\n          Nothing ->\n            -- is it already an indirect test dependency?\n            case Map.lookup pkg testIndirect of\n              Just vsn ->\n                return $ PromoteTest $ Outline.App $\n                  outline\n                    { Outline._app_deps_direct = Map.insert pkg vsn direct\n                    , Outline._app_test_indirect = Map.delete pkg testIndirect\n                    }\n\n              Nothing ->\n                -- finally try to add it from scratch\n                case Registry.getVersions' pkg registry of\n                  Left suggestions ->\n                    case connection of\n                      Solver.Online _ -> Task.throw (Exit.InstallUnknownPackageOnline pkg suggestions)\n                      Solver.Offline  -> Task.throw (Exit.InstallUnknownPackageOffline pkg suggestions)\n\n                  Right _ ->\n                    do  result <- Task.io $ Solver.addToApp cache connection registry pkg outline\n                        case result of\n                          Solver.Ok (Solver.AppSolution old new app) ->\n                            return (Changes (detectChanges old new) (Outline.App app))\n\n                          Solver.NoSolution ->\n                            Task.throw (Exit.InstallNoOnlineAppSolution pkg)\n\n                          Solver.NoOfflineSolution ->\n                            Task.throw (Exit.InstallNoOfflineAppSolution pkg)\n\n                          Solver.Err exit ->\n                            Task.throw (Exit.InstallHadSolverTrouble exit)\n\n\n\n-- MAKE PACKAGE PLAN\n\n\nmakePkgPlan :: Solver.Env -> Pkg.Name -> Outline.PkgOutline -> Task (Changes C.Constraint)\nmakePkgPlan (Solver.Env cache _ connection registry) pkg outline@(Outline.PkgOutline _ _ _ _ _ deps test _) =\n  if Map.member pkg deps then\n    return AlreadyInstalled\n  else\n    -- is already in test dependencies?\n    case Map.lookup pkg test of\n      Just con ->\n        return $ PromoteTest $ Outline.Pkg $\n          outline\n            { Outline._pkg_deps = Map.insert pkg con deps\n            , Outline._pkg_test_deps = Map.delete pkg test\n            }\n\n      Nothing ->\n        -- try to add a new dependency\n        case Registry.getVersions' pkg registry of\n          Left suggestions ->\n            case connection of\n              Solver.Online _ -> Task.throw (Exit.InstallUnknownPackageOnline pkg suggestions)\n              Solver.Offline  -> Task.throw (Exit.InstallUnknownPackageOffline pkg suggestions)\n\n          Right (Registry.KnownVersions _ _) ->\n            do  let old = Map.union deps test\n                let cons = Map.insert pkg C.anything old\n                result <- Task.io $ Solver.verify cache connection registry cons\n                case result of\n                  Solver.Ok solution ->\n                    let\n                      (Solver.Details vsn _) = solution ! pkg\n\n                      con = C.untilNextMajor vsn\n                      new = Map.insert pkg con old\n                      changes = detectChanges old new\n                      news = Map.mapMaybe keepNew changes\n                    in\n                    return $ Changes changes $ Outline.Pkg $\n                      outline\n                        { Outline._pkg_deps = addNews (Just pkg) news deps\n                        , Outline._pkg_test_deps = addNews Nothing news test\n                        }\n\n                  Solver.NoSolution ->\n                    Task.throw (Exit.InstallNoOnlinePkgSolution pkg)\n\n                  Solver.NoOfflineSolution ->\n                    Task.throw (Exit.InstallNoOfflinePkgSolution pkg)\n\n                  Solver.Err exit ->\n                    Task.throw (Exit.InstallHadSolverTrouble exit)\n\n\naddNews :: Maybe Pkg.Name -> Map.Map Pkg.Name C.Constraint -> Map.Map Pkg.Name C.Constraint -> Map.Map Pkg.Name C.Constraint\naddNews pkg new old =\n  Map.merge\n    Map.preserveMissing\n    (Map.mapMaybeMissing (\\k c -> if Just k == pkg then Just c else Nothing))\n    (Map.zipWithMatched (\\_ _ n -> n))\n    old\n    new\n\n\n\n-- CHANGES\n\n\ndata Change a\n  = Insert a\n  | Change a a\n  | Remove a\n\n\ndetectChanges :: (Eq a) => Map.Map Pkg.Name a -> Map.Map Pkg.Name a -> Map.Map Pkg.Name (Change a)\ndetectChanges old new =\n  Map.merge\n    (Map.mapMissing (\\_ v -> Remove v))\n    (Map.mapMissing (\\_ v -> Insert v))\n    (Map.zipWithMaybeMatched keepChange)\n    old\n    new\n\n\nkeepChange :: (Eq v) => k -> v -> v -> Maybe (Change v)\nkeepChange _ old new =\n  if old == new then\n    Nothing\n  else\n    Just (Change old new)\n\n\nkeepNew :: Change a -> Maybe a\nkeepNew change =\n  case change of\n    Insert a ->\n      Just a\n\n    Change _ a ->\n      Just a\n\n    Remove _ ->\n      Nothing\n\n\n\n-- VIEW CHANGE DOCS\n\n\ndata ChangeDocs =\n  Docs\n    { _doc_inserts :: [D.Doc]\n    , _doc_changes :: [D.Doc]\n    , _doc_removes :: [D.Doc]\n    }\n\n\nviewChangeDocs :: ChangeDocs -> D.Doc\nviewChangeDocs (Docs inserts changes removes) =\n  D.indent 2 $ D.vcat $ concat $\n    [ viewNonZero \"Add:\"    inserts\n    , viewNonZero \"Change:\" changes\n    , viewNonZero \"Remove:\" removes\n    ]\n\n\nviewNonZero :: String -> [D.Doc] -> [D.Doc]\nviewNonZero title entries =\n  if null entries then\n    []\n  else\n    [ \"\"\n    , D.fromChars title\n    , D.indent 2 (D.vcat entries)\n    ]\n\n\n\n-- VIEW CHANGE\n\n\naddChange :: (a -> String) -> Widths -> Pkg.Name -> Change a -> ChangeDocs -> ChangeDocs\naddChange toChars widths name change (Docs inserts changes removes) =\n  case change of\n    Insert new ->\n      Docs (viewInsert toChars widths name new : inserts) changes removes\n\n    Change old new ->\n      Docs inserts (viewChange toChars widths name old new : changes) removes\n\n    Remove old ->\n      Docs inserts changes (viewRemove toChars widths name old : removes)\n\n\nviewInsert :: (a -> String) -> Widths -> Pkg.Name -> a -> D.Doc\nviewInsert toChars (Widths nameWidth leftWidth _) name new =\n  viewName nameWidth name <+> pad leftWidth (toChars new)\n\n\nviewChange :: (a -> String) -> Widths -> Pkg.Name -> a -> a -> D.Doc\nviewChange toChars (Widths nameWidth leftWidth rightWidth) name old new =\n  D.hsep\n    [ viewName nameWidth name\n    , pad leftWidth (toChars old)\n    , \"=>\"\n    , pad rightWidth (toChars new)\n    ]\n\n\nviewRemove :: (a -> String) -> Widths -> Pkg.Name -> a -> D.Doc\nviewRemove toChars (Widths nameWidth leftWidth _) name old =\n  viewName nameWidth name <+> pad leftWidth (toChars old)\n\n\nviewName :: Int -> Pkg.Name -> D.Doc\nviewName width name =\n  D.fill (width + 3) (D.fromPackage name)\n\n\npad :: Int -> String -> D.Doc\npad width string =\n  D.fromChars (replicate (width - length string) ' ') <> D.fromChars string\n\n\n\n-- WIDTHS\n\n\ndata Widths =\n  Widths\n    { _name :: !Int\n    , _left :: !Int\n    , _right :: !Int\n    }\n\n\nwiden :: (a -> String) -> Pkg.Name -> Change a -> Widths -> Widths\nwiden toChars pkg change (Widths name left right) =\n  let\n    toLength a =\n      length (toChars a)\n\n    newName =\n      max name (length (Pkg.toChars pkg))\n  in\n    case change of\n      Insert new ->\n        Widths newName (max left (toLength new)) right\n\n      Change old new ->\n        Widths newName (max left (toLength old)) (max right (toLength new))\n\n      Remove old ->\n        Widths newName (max left (toLength old)) right\n"
  },
  {
    "path": "terminal/src/Main.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Main\n  ( main\n  )\n  where\n\n\nimport Prelude hiding (init)\nimport qualified Data.List as List\nimport qualified Text.PrettyPrint.ANSI.Leijen as P\nimport Text.Read (readMaybe)\n\nimport qualified Elm.Version as V\nimport Terminal\nimport Terminal.Helpers\n\nimport qualified Bump\nimport qualified Develop\nimport qualified Diff\nimport qualified Init\nimport qualified Install\nimport qualified Make\nimport qualified Publish\nimport qualified Repl\n\n\n\n-- MAIN\n\n\nmain :: IO ()\nmain =\n  Terminal.app intro outro\n    [ repl\n    , init\n    , reactor\n    , make\n    , install\n    , bump\n    , diff\n    , publish\n    ]\n\n\nintro :: P.Doc\nintro =\n  P.vcat\n    [ P.fillSep\n        [\"Hi,\",\"thank\",\"you\",\"for\",\"trying\",\"out\"\n        ,P.green \"Elm\"\n        ,P.green (P.text (V.toChars V.compiler)) <> \".\"\n        ,\"I hope you like it!\"\n        ]\n    , \"\"\n    , P.black \"-------------------------------------------------------------------------------\"\n    , P.black \"I highly recommend working through <https://guide.elm-lang.org> to get started.\"\n    , P.black \"It teaches many important concepts, including how to use `elm` in the terminal.\"\n    , P.black \"-------------------------------------------------------------------------------\"\n    ]\n\n\noutro :: P.Doc\noutro =\n  P.fillSep $ map P.text $ words $\n    \"Be sure to ask on the Elm slack if you run into trouble! Folks are friendly and\\\n    \\ happy to help out. They hang out there because it is fun, so be kind to get the\\\n    \\ best results!\"\n\n\n\n-- INIT\n\n\ninit :: Terminal.Command\ninit =\n  let\n    summary =\n      \"Start an Elm project. It creates a starter elm.json file and\\\n      \\ provides a link explaining what to do from there.\"\n\n    details =\n      \"The `init` command helps start Elm projects:\"\n\n    example =\n      reflow\n        \"It will ask permission to create an elm.json file, the one thing common\\\n        \\ to all Elm projects. It also provides a link explaining what to do from there.\"\n  in\n  Terminal.Command \"init\" (Common summary) details example noArgs noFlags Init.run\n\n\n\n-- REPL\n\n\nrepl :: Terminal.Command\nrepl =\n  let\n    summary =\n      \"Open up an interactive programming session. Type in Elm expressions\\\n      \\ like (2 + 2) or (String.length \\\"test\\\") and see if they equal four!\"\n\n    details =\n      \"The `repl` command opens up an interactive programming session:\"\n\n    example =\n      reflow\n        \"Start working through <https://guide.elm-lang.org> to learn how to use this!\\\n        \\ It has a whole chapter that uses the REPL for everything, so that is probably\\\n        \\ the quickest way to get started.\"\n\n    replFlags =\n      flags Repl.Flags\n        |-- flag \"interpreter\" interpreter \"Path to a alternate JS interpreter, like node or nodejs.\"\n        |-- onOff \"no-colors\" \"Turn off the colors in the REPL. This can help if you are having trouble reading the values. Some terminals use a custom color scheme that diverges significantly from the standard ANSI colors, so another path may be to pick a more standard color scheme.\"\n  in\n  Terminal.Command \"repl\" (Common summary) details example noArgs replFlags Repl.run\n\n\ninterpreter :: Parser String\ninterpreter =\n  Parser\n    { _singular = \"interpreter\"\n    , _plural = \"interpreters\"\n    , _parser = Just\n    , _suggest = \\_ -> return []\n    , _examples = \\_ -> return [\"node\",\"nodejs\"]\n    }\n\n\n\n-- REACTOR\n\n\nreactor :: Terminal.Command\nreactor =\n  let\n    summary =\n      \"Compile code with a click. It opens a file viewer in your browser, and\\\n      \\ when you click on an Elm file, it compiles and you see the result.\"\n\n    details =\n      \"The `reactor` command starts a local server on your computer:\"\n\n    example =\n      reflow\n        \"After running that command, you would have a server at <http://localhost:8000>\\\n        \\ that helps with development. It shows your files like a file viewer. If you\\\n        \\ click on an Elm file, it will compile it for you! And you can just press\\\n        \\ the refresh button in the browser to recompile things.\"\n\n    reactorFlags =\n      flags Develop.Flags\n        |-- flag \"port\" port_ \"The port of the server (default: 8000)\"\n  in\n  Terminal.Command \"reactor\" (Common summary) details example noArgs reactorFlags Develop.run\n\n\nport_ :: Parser Int\nport_ =\n  Parser\n    { _singular = \"port\"\n    , _plural = \"ports\"\n    , _parser = readMaybe\n    , _suggest = \\_ -> return []\n    , _examples = \\_ -> return [\"3000\",\"8000\"]\n    }\n\n\n\n-- MAKE\n\n\nmake :: Terminal.Command\nmake =\n  let\n    details =\n      \"The `make` command compiles Elm code into JS or HTML:\"\n\n    example =\n      stack\n        [ reflow\n            \"For example:\"\n        , P.indent 4 $ P.green \"elm make src/Main.elm\"\n        , reflow\n            \"This tries to compile an Elm file named src/Main.elm, generating an index.html\\\n            \\ file if possible.\"\n        ]\n\n    makeFlags =\n      flags Make.Flags\n        |-- onOff \"debug\" \"Turn on the time-travelling debugger. It allows you to rewind and replay events. The events can be imported/exported into a file, which makes for very precise bug reports!\"\n        |-- onOff \"optimize\" \"Turn on optimizations to make code smaller and faster. For example, the compiler renames record fields to be as short as possible and unboxes values to reduce allocation.\"\n        |-- flag \"output\" Make.output \"Specify the name of the resulting JS file. For example --output=assets/elm.js to generate the JS at assets/elm.js or --output=/dev/null to generate no output at all!\"\n        |-- flag \"report\" Make.reportType \"You can say --report=json to get error messages as JSON. This is only really useful if you are an editor plugin. Humans should avoid it!\"\n        |-- flag \"docs\" Make.docsFile \"Generate a JSON file of documentation for a package. Eventually it will be possible to preview docs with `reactor` because it is quite hard to deal with these JSON files directly.\"\n  in\n  Terminal.Command \"make\" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run\n\n\n\n-- INSTALL\n\n\ninstall :: Terminal.Command\ninstall =\n  let\n    details =\n      \"The `install` command fetches packages from <https://package.elm-lang.org> for\\\n      \\ use in your project:\"\n\n    example =\n      stack\n        [ reflow\n            \"For example, if you want to get packages for HTTP and JSON, you would say:\"\n        , P.indent 4 $ P.green $ P.vcat $\n              [ \"elm install elm/http\"\n              , \"elm install elm/json\"\n              ]\n        , reflow\n            \"Notice that you must say the AUTHOR name and PROJECT name! After running those\\\n            \\ commands, you could say `import Http` or `import Json.Decode` in your code.\"\n        , reflow\n            \"What if two projects use different versions of the same package? No problem!\\\n            \\ Each project is independent, so there cannot be conflicts like that!\"\n        ]\n\n    installArgs =\n      oneOf\n        [ require0 Install.NoArgs\n        , require1 Install.Install package\n        ]\n  in\n  Terminal.Command \"install\" Uncommon details example installArgs noFlags Install.run\n\n\n\n-- PUBLISH\n\n\npublish :: Terminal.Command\npublish =\n  let\n    details =\n      \"The `publish` command publishes your package on <https://package.elm-lang.org>\\\n      \\ so that anyone in the Elm community can use it.\"\n\n    example =\n      stack\n        [ reflow\n            \"Think hard if you are ready to publish NEW packages though!\"\n        , reflow\n            \"Part of what makes Elm great is the packages ecosystem. The fact that\\\n            \\ there is usually one option (usually very well done) makes it way\\\n            \\ easier to pick packages and become productive. So having a million\\\n            \\ packages would be a failure in Elm. We do not need twenty of\\\n            \\ everything, all coded in a single weekend.\"\n        , reflow\n            \"So as community members gain wisdom through experience, we want\\\n            \\ them to share that through thoughtful API design and excellent\\\n            \\ documentation. It is more about sharing ideas and insights than\\\n            \\ just sharing code! The first step may be asking for advice from\\\n            \\ people you respect, or in community forums. The second step may\\\n            \\ be using it at work to see if it is as nice as you think. Maybe\\\n            \\ it ends up as an experiment on GitHub only. Point is, try to be\\\n            \\ respectful of the community and package ecosystem!\"\n        , reflow\n            \"Check out <https://package.elm-lang.org/help/design-guidelines> for guidance on how to create great packages!\"\n        ]\n  in\n  Terminal.Command \"publish\" Uncommon details example noArgs noFlags Publish.run\n\n\n\n-- BUMP\n\n\nbump :: Terminal.Command\nbump =\n  let\n    details =\n      \"The `bump` command figures out the next version number based on API changes:\"\n\n    example =\n      reflow\n        \"Say you just published version 1.0.0, but then decided to remove a function.\\\n        \\ I will compare the published API to what you have locally, figure out that\\\n        \\ it is a MAJOR change, and bump your version number to 2.0.0. I do this with\\\n        \\ all packages, so there cannot be MAJOR changes hiding in PATCH releases in Elm!\"\n  in\n  Terminal.Command \"bump\" Uncommon details example noArgs noFlags Bump.run\n\n\n\n-- DIFF\n\n\ndiff :: Terminal.Command\ndiff =\n  let\n    details =\n      \"The `diff` command detects API changes:\"\n\n    example =\n      stack\n        [ reflow\n            \"For example, to see what changed in the HTML package between\\\n            \\ versions 1.0.0 and 2.0.0, you can say:\"\n        , P.indent 4 $ P.green $ \"elm diff elm/html 1.0.0 2.0.0\"\n        , reflow\n            \"Sometimes a MAJOR change is not actually very big, so\\\n            \\ this can help you plan your upgrade timelines.\"\n        ]\n\n    diffArgs =\n      oneOf\n        [ require0 Diff.CodeVsLatest\n        , require1 Diff.CodeVsExactly version\n        , require2 Diff.LocalInquiry version version\n        , require3 Diff.GlobalInquiry package version version\n        ]\n  in\n  Terminal.Command \"diff\" Uncommon details example diffArgs noFlags Diff.run\n\n\n\n-- HELPERS\n\n\nstack :: [P.Doc] -> P.Doc\nstack docs =\n  P.vcat $ List.intersperse \"\" docs\n\n\nreflow :: String -> P.Doc\nreflow string =\n  P.fillSep $ map P.text $ words string\n"
  },
  {
    "path": "terminal/src/Make.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Make\n  ( Flags(..)\n  , Output(..)\n  , ReportType(..)\n  , run\n  , reportType\n  , output\n  , docsFile\n  )\n  where\n\n\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.Maybe as Maybe\nimport qualified Data.NonEmptyList as NE\nimport qualified System.Directory as Dir\nimport qualified System.FilePath as FP\n\nimport qualified AST.Optimized as Opt\nimport qualified BackgroundWriter as BW\nimport qualified Build\nimport qualified Elm.Details as Details\nimport qualified Elm.ModuleName as ModuleName\nimport qualified File\nimport qualified Generate\nimport qualified Generate.Html as Html\nimport qualified Reporting\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Task as Task\nimport qualified Stuff\nimport Terminal (Parser(..))\n\n\n\n-- FLAGS\n\n\ndata Flags =\n  Flags\n    { _debug :: Bool\n    , _optimize :: Bool\n    , _output :: Maybe Output\n    , _report :: Maybe ReportType\n    , _docs :: Maybe FilePath\n    }\n\n\ndata Output\n  = JS FilePath\n  | Html FilePath\n  | DevNull\n\n\ndata ReportType\n  = Json\n\n\n\n-- RUN\n\n\ntype Task a = Task.Task Exit.Make a\n\n\nrun :: [FilePath] -> Flags -> IO ()\nrun paths flags@(Flags _ _ _ report _) =\n  do  style <- getStyle report\n      maybeRoot <- Stuff.findRoot\n      Reporting.attemptWithStyle style Exit.makeToReport $\n        case maybeRoot of\n          Just root -> runHelp root paths style flags\n          Nothing   -> return $ Left $ Exit.MakeNoOutline\n\n\nrunHelp :: FilePath -> [FilePath] -> Reporting.Style -> Flags -> IO (Either Exit.Make ())\nrunHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) =\n  BW.withScope $ \\scope ->\n  Stuff.withRootLock root $ Task.run $\n  do  desiredMode <- getMode debug optimize\n      details <- Task.eio Exit.MakeBadDetails (Details.load style scope root)\n      case paths of\n        [] ->\n          do  exposed <- getExposed details\n              buildExposed style root details maybeDocs exposed\n\n        p:ps ->\n          do  artifacts <- buildPaths style root details (NE.List p ps)\n              case maybeOutput of\n                Nothing ->\n                  case getMains artifacts of\n                    [] ->\n                      return ()\n\n                    [name] ->\n                      do  builder <- toBuilder root details desiredMode artifacts\n                          generate style \"index.html\" (Html.sandwich name builder) (NE.List name [])\n\n                    name:names ->\n                      do  builder <- toBuilder root details desiredMode artifacts\n                          generate style \"elm.js\" builder (NE.List name names)\n\n                Just DevNull ->\n                  return ()\n\n                Just (JS target) ->\n                  case getNoMains artifacts of\n                    [] ->\n                      do  builder <- toBuilder root details desiredMode artifacts\n                          generate style target builder (Build.getRootNames artifacts)\n\n                    name:names ->\n                      Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names)\n\n                Just (Html target) ->\n                  do  name <- hasOneMain artifacts\n                      builder <- toBuilder root details desiredMode artifacts\n                      generate style target (Html.sandwich name builder) (NE.List name [])\n\n\n\n-- GET INFORMATION\n\n\ngetStyle :: Maybe ReportType -> IO Reporting.Style\ngetStyle report =\n  case report of\n    Nothing -> Reporting.terminal\n    Just Json -> return Reporting.json\n\n\ngetMode :: Bool -> Bool -> Task DesiredMode\ngetMode debug optimize =\n  case (debug, optimize) of\n    (True , True ) -> Task.throw Exit.MakeCannotOptimizeAndDebug\n    (True , False) -> return Debug\n    (False, False) -> return Dev\n    (False, True ) -> return Prod\n\n\ngetExposed :: Details.Details -> Task (NE.List ModuleName.Raw)\ngetExposed (Details.Details _ validOutline _ _ _ _) =\n  case validOutline of\n    Details.ValidApp _ ->\n      Task.throw Exit.MakeAppNeedsFileNames\n\n    Details.ValidPkg _ exposed _ ->\n      case exposed of\n        [] -> Task.throw Exit.MakePkgNeedsExposing\n        m:ms -> return (NE.List m ms)\n\n\n\n-- BUILD PROJECTS\n\n\nbuildExposed :: Reporting.Style -> FilePath -> Details.Details -> Maybe FilePath -> NE.List ModuleName.Raw -> Task ()\nbuildExposed style root details maybeDocs exposed =\n  let\n    docsGoal = maybe Build.IgnoreDocs Build.WriteDocs maybeDocs\n  in\n  Task.eio Exit.MakeCannotBuild $\n    Build.fromExposed style root details docsGoal exposed\n\n\nbuildPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> Task Build.Artifacts\nbuildPaths style root details paths =\n  Task.eio Exit.MakeCannotBuild $\n    Build.fromPaths style root details paths\n\n\n\n-- GET MAINS\n\n\ngetMains :: Build.Artifacts -> [ModuleName.Raw]\ngetMains (Build.Artifacts _ _ roots modules) =\n  Maybe.mapMaybe (getMain modules) (NE.toList roots)\n\n\ngetMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw\ngetMain modules root =\n  case root of\n    Build.Inside name ->\n      if any (isMain name) modules\n      then Just name\n      else Nothing\n\n    Build.Outside name _ (Opt.LocalGraph maybeMain _ _) ->\n      case maybeMain of\n        Just _  -> Just name\n        Nothing -> Nothing\n\n\nisMain :: ModuleName.Raw -> Build.Module -> Bool\nisMain targetName modul =\n  case modul of\n    Build.Fresh name _ (Opt.LocalGraph maybeMain _ _) ->\n      Maybe.isJust maybeMain && name == targetName\n\n    Build.Cached name mainIsDefined _ ->\n      mainIsDefined && name == targetName\n\n\n\n-- HAS ONE MAIN\n\n\nhasOneMain :: Build.Artifacts -> Task ModuleName.Raw\nhasOneMain (Build.Artifacts _ _ roots modules) =\n  case roots of\n    NE.List root [] -> Task.mio Exit.MakeNoMain (return $ getMain modules root)\n    NE.List _ (_:_) -> Task.throw Exit.MakeMultipleFilesIntoHtml\n\n\n\n-- GET MAINLESS\n\n\ngetNoMains :: Build.Artifacts -> [ModuleName.Raw]\ngetNoMains (Build.Artifacts _ _ roots modules) =\n  Maybe.mapMaybe (getNoMain modules) (NE.toList roots)\n\n\ngetNoMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw\ngetNoMain modules root =\n  case root of\n    Build.Inside name ->\n      if any (isMain name) modules\n      then Nothing\n      else Just name\n\n    Build.Outside name _ (Opt.LocalGraph maybeMain _ _) ->\n      case maybeMain of\n        Just _  -> Nothing\n        Nothing -> Just name\n\n\n\n-- GENERATE\n\n\ngenerate :: Reporting.Style -> FilePath -> B.Builder -> NE.List ModuleName.Raw -> Task ()\ngenerate style target builder names =\n  Task.io $\n    do  Dir.createDirectoryIfMissing True (FP.takeDirectory target)\n        File.writeBuilder target builder\n        Reporting.reportGenerate style names target\n\n\n\n-- TO BUILDER\n\n\ndata DesiredMode = Debug | Dev | Prod\n\n\ntoBuilder :: FilePath -> Details.Details -> DesiredMode -> Build.Artifacts -> Task B.Builder\ntoBuilder root details desiredMode artifacts =\n  Task.mapError Exit.MakeBadGenerate $\n    case desiredMode of\n      Debug -> Generate.debug root details artifacts\n      Dev   -> Generate.dev   root details artifacts\n      Prod  -> Generate.prod  root details artifacts\n\n\n\n-- PARSERS\n\n\nreportType :: Parser ReportType\nreportType =\n  Parser\n    { _singular = \"report type\"\n    , _plural = \"report types\"\n    , _parser = \\string -> if string == \"json\" then Just Json else Nothing\n    , _suggest = \\_ -> return [\"json\"]\n    , _examples = \\_ -> return [\"json\"]\n    }\n\n\noutput :: Parser Output\noutput =\n  Parser\n    { _singular = \"output file\"\n    , _plural = \"output files\"\n    , _parser = parseOutput\n    , _suggest = \\_ -> return []\n    , _examples = \\_ -> return [ \"elm.js\", \"index.html\", \"/dev/null\" ]\n    }\n\n\nparseOutput :: String -> Maybe Output\nparseOutput name\n  | isDevNull name      = Just DevNull\n  | hasExt \".html\" name = Just (Html name)\n  | hasExt \".js\"   name = Just (JS name)\n  | otherwise           = Nothing\n\n\ndocsFile :: Parser FilePath\ndocsFile =\n  Parser\n    { _singular = \"json file\"\n    , _plural = \"json files\"\n    , _parser = \\name -> if hasExt \".json\" name then Just name else Nothing\n    , _suggest = \\_ -> return []\n    , _examples = \\_ -> return [\"docs.json\",\"documentation.json\"]\n    }\n\n\nhasExt :: String -> String -> Bool\nhasExt ext path =\n  FP.takeExtension path == ext && length path > length ext\n\n\nisDevNull :: String -> Bool\nisDevNull name =\n  name == \"/dev/null\" || name == \"NUL\" || name == \"$null\"\n"
  },
  {
    "path": "terminal/src/Publish.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Publish\n  ( run\n  )\n  where\n\n\nimport Control.Exception (bracket_)\nimport Control.Monad (void)\nimport qualified Data.List as List\nimport qualified Data.NonEmptyList as NE\nimport qualified Data.Utf8 as Utf8\nimport qualified System.Directory as Dir\nimport qualified System.Exit as Exit\nimport System.FilePath ((</>))\nimport qualified System.Info as Info\nimport qualified System.IO as IO\nimport qualified System.Process as Process\n\nimport qualified BackgroundWriter as BW\nimport qualified Build\nimport qualified Deps.Bump as Bump\nimport qualified Deps.Diff as Diff\nimport qualified Deps.Registry as Registry\nimport qualified Deps.Website as Website\nimport qualified Elm.Details as Details\nimport qualified Elm.Docs as Docs\nimport qualified Elm.Magnitude as M\nimport qualified Elm.Outline as Outline\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified File\nimport qualified Http\nimport qualified Json.Decode as D\nimport qualified Json.String as Json\nimport qualified Reporting\nimport Reporting.Doc ((<+>))\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Exit.Help as Help\nimport qualified Reporting.Task as Task\nimport qualified Stuff\n\n\n\n-- RUN\n\n\n-- TODO mandate no \"exposing (..)\" in packages to make\n-- optimization to skip builds in Elm.Details always valid\n\n\nrun :: () -> () -> IO ()\nrun () () =\n  Reporting.attempt Exit.publishToReport $\n    Task.run $ publish =<< getEnv\n\n\n\n-- ENV\n\n\ndata Env =\n  Env\n    { _root :: FilePath\n    , _cache :: Stuff.PackageCache\n    , _manager :: Http.Manager\n    , _registry :: Registry.Registry\n    , _outline :: Outline.Outline\n    }\n\n\ngetEnv :: Task.Task Exit.Publish Env\ngetEnv =\n  do  root <- Task.mio Exit.PublishNoOutline $ Stuff.findRoot\n      cache <- Task.io $ Stuff.getPackageCache\n      manager <- Task.io $ Http.getManager\n      registry <- Task.eio Exit.PublishMustHaveLatestRegistry $ Registry.latest manager cache\n      outline <- Task.eio Exit.PublishBadOutline $ Outline.read root\n      return $ Env root cache manager registry outline\n\n\n\n-- PUBLISH\n\n\npublish ::  Env -> Task.Task Exit.Publish ()\npublish env@(Env root _ manager registry outline) =\n  case outline of\n    Outline.App _ ->\n      Task.throw Exit.PublishApplication\n\n    Outline.Pkg (Outline.PkgOutline pkg summary _ vsn exposed _ _ _) ->\n      do  let maybeKnownVersions = Registry.getVersions pkg registry\n\n          reportPublishStart pkg vsn maybeKnownVersions\n\n          if noExposed  exposed then Task.throw Exit.PublishNoExposed else return ()\n          if badSummary summary then Task.throw Exit.PublishNoSummary else return ()\n\n          verifyReadme root\n          verifyLicense root\n          docs <- verifyBuild root\n          verifyVersion env pkg vsn docs maybeKnownVersions\n          git <- getGit\n          commitHash <- verifyTag git manager pkg vsn\n          verifyNoChanges git commitHash vsn\n          zipHash <- verifyZip env pkg vsn\n\n          Task.io $ putStrLn \"\"\n          register manager pkg vsn docs commitHash zipHash\n          Task.io $ putStrLn \"Success!\"\n\n\n\n-- VERIFY SUMMARY\n\n\nbadSummary :: Json.String -> Bool\nbadSummary summary =\n  Json.isEmpty summary || Outline.defaultSummary == summary\n\n\nnoExposed :: Outline.Exposed -> Bool\nnoExposed exposed =\n  case exposed of\n    Outline.ExposedList modules ->\n      null modules\n\n    Outline.ExposedDict chunks ->\n      all (null . snd) chunks\n\n\n\n-- VERIFY README\n\n\nverifyReadme :: FilePath -> Task.Task Exit.Publish ()\nverifyReadme root =\n  reportReadmeCheck $\n  do  let readmePath = root </> \"README.md\"\n      exists <- File.exists readmePath\n      case exists of\n        False ->\n          return (Left Exit.PublishNoReadme)\n\n        True ->\n          do  size <- IO.withFile readmePath IO.ReadMode IO.hFileSize\n              if size < 300\n                then return (Left Exit.PublishShortReadme)\n                else return (Right ())\n\n\n\n-- VERIFY LICENSE\n\n\nverifyLicense :: FilePath -> Task.Task Exit.Publish ()\nverifyLicense root =\n  reportLicenseCheck $\n  do  let licensePath = root </> \"LICENSE\"\n      exists <- File.exists licensePath\n      if exists\n        then return (Right ())\n        else return (Left Exit.PublishNoLicense)\n\n\n\n-- VERIFY BUILD\n\n\nverifyBuild :: FilePath -> Task.Task Exit.Publish Docs.Documentation\nverifyBuild root =\n  reportBuildCheck $ BW.withScope $ \\scope ->\n    Task.run $\n    do  details@(Details.Details _ outline _ _ _ _) <-\n          Task.eio Exit.PublishBadDetails $\n            Details.load Reporting.silent scope root\n\n        exposed <-\n          case outline of\n            Details.ValidApp _          -> Task.throw Exit.PublishApplication\n            Details.ValidPkg _ []     _ -> Task.throw Exit.PublishNoExposed\n            Details.ValidPkg _ (e:es) _ -> return (NE.List e es)\n\n        Task.eio Exit.PublishBuildProblem $\n          Build.fromExposed Reporting.silent root details Build.KeepDocs exposed\n\n\n-- GET GIT\n\n\nnewtype Git =\n  Git { _run :: [String] -> IO Exit.ExitCode }\n\n\ngetGit :: Task.Task Exit.Publish Git\ngetGit =\n  do  maybeGit <- Task.io $ Dir.findExecutable \"git\"\n      case maybeGit of\n        Nothing ->\n          Task.throw Exit.PublishNoGit\n\n        Just git ->\n          return $ Git $ \\args ->\n            let\n              process =\n                (Process.proc git args)\n                  { Process.std_in  = Process.CreatePipe\n                  , Process.std_out = Process.CreatePipe\n                  , Process.std_err = Process.CreatePipe\n                  }\n            in\n            Process.withCreateProcess process $ \\_ _ _ handle ->\n              Process.waitForProcess handle\n\n\n\n-- VERIFY GITHUB TAG\n\n\nverifyTag :: Git -> Http.Manager -> Pkg.Name -> V.Version -> Task.Task Exit.Publish String\nverifyTag git manager pkg vsn =\n  reportTagCheck vsn $\n  do  -- https://stackoverflow.com/questions/1064499/how-to-list-all-git-tags\n      exitCode <- _run git [ \"show\", \"--name-only\", V.toChars vsn, \"--\" ]\n      case exitCode of\n        Exit.ExitFailure _ ->\n          return $ Left (Exit.PublishMissingTag vsn)\n\n        Exit.ExitSuccess ->\n          let url = toTagUrl pkg vsn in\n          Http.get manager url [Http.accept \"application/json\"] (Exit.PublishCannotGetTag vsn) $ \\body ->\n            case D.fromByteString commitHashDecoder body of\n              Right hash ->\n                return $ Right hash\n\n              Left _ ->\n                return $ Left (Exit.PublishCannotGetTagData vsn url body)\n\n\ntoTagUrl :: Pkg.Name -> V.Version -> String\ntoTagUrl pkg vsn =\n  \"https://api.github.com/repos/\" ++ Pkg.toUrl pkg ++ \"/git/refs/tags/\" ++ V.toChars vsn\n\n\ncommitHashDecoder :: D.Decoder e String\ncommitHashDecoder =\n  Utf8.toChars <$>\n    D.field \"object\" (D.field \"sha\" D.string)\n\n\n\n-- VERIFY NO LOCAL CHANGES SINCE TAG\n\n\nverifyNoChanges :: Git -> String -> V.Version -> Task.Task Exit.Publish ()\nverifyNoChanges git commitHash vsn =\n  reportLocalChangesCheck $\n  do  -- https://stackoverflow.com/questions/3878624/how-do-i-programmatically-determine-if-there-are-uncommited-changes\n      exitCode <- _run git [ \"diff-index\", \"--quiet\", commitHash, \"--\" ]\n      case exitCode of\n        Exit.ExitSuccess   -> return $ Right ()\n        Exit.ExitFailure _ -> return $ Left (Exit.PublishLocalChanges vsn)\n\n\n\n-- VERIFY THAT ZIP BUILDS / COMPUTE HASH\n\n\nverifyZip :: Env -> Pkg.Name -> V.Version -> Task.Task Exit.Publish Http.Sha\nverifyZip (Env root _ manager _ _) pkg vsn =\n  withPrepublishDir root $ \\prepublishDir ->\n    do  let url = toZipUrl pkg vsn\n\n        (sha, archive) <-\n          reportDownloadCheck $\n            Http.getArchive manager url\n              Exit.PublishCannotGetZip\n              (Exit.PublishCannotDecodeZip url)\n              (return . Right)\n\n        Task.io $ File.writePackage prepublishDir archive\n\n        reportZipBuildCheck $\n          Dir.withCurrentDirectory prepublishDir $\n            verifyZipBuild prepublishDir\n\n        return sha\n\n\ntoZipUrl :: Pkg.Name -> V.Version -> String\ntoZipUrl pkg vsn =\n  \"https://github.com/\" ++ Pkg.toUrl pkg ++ \"/zipball/\" ++ V.toChars vsn ++ \"/\"\n\n\nwithPrepublishDir :: FilePath -> (FilePath -> Task.Task x a) -> Task.Task x a\nwithPrepublishDir root callback =\n  let\n    dir = Stuff.prepublishDir root\n  in\n  Task.eio id $\n    bracket_\n      (Dir.createDirectoryIfMissing True dir)\n      (Dir.removeDirectoryRecursive dir)\n      (Task.run (callback dir))\n\n\nverifyZipBuild :: FilePath -> IO (Either Exit.Publish ())\nverifyZipBuild root =\n  BW.withScope $ \\scope -> Task.run $\n  do  details@(Details.Details _ outline _ _ _ _) <-\n        Task.eio Exit.PublishZipBadDetails $\n          Details.load Reporting.silent scope root\n\n      exposed <-\n        case outline of\n          Details.ValidApp _          -> Task.throw Exit.PublishZipApplication\n          Details.ValidPkg _ []     _ -> Task.throw Exit.PublishZipNoExposed\n          Details.ValidPkg _ (e:es) _ -> return (NE.List e es)\n\n      _ <- Task.eio Exit.PublishZipBuildProblem $\n        Build.fromExposed Reporting.silent root details Build.KeepDocs exposed\n\n      return ()\n\n\n\n-- VERIFY VERSION\n\n\ndata GoodVersion\n  = GoodStart\n  | GoodBump V.Version M.Magnitude\n\n\nverifyVersion :: Env -> Pkg.Name -> V.Version -> Docs.Documentation -> Maybe Registry.KnownVersions -> Task.Task Exit.Publish ()\nverifyVersion env pkg vsn newDocs publishedVersions =\n  reportSemverCheck vsn $\n    case publishedVersions of\n      Nothing ->\n        if vsn == V.one\n        then return $ Right GoodStart\n        else return $ Left $ Exit.PublishNotInitialVersion vsn\n\n      Just knownVersions@(Registry.KnownVersions latest previous) ->\n        if vsn == latest || elem vsn previous\n        then return $ Left $ Exit.PublishAlreadyPublished vsn\n        else verifyBump env pkg vsn newDocs knownVersions\n\n\nverifyBump :: Env -> Pkg.Name -> V.Version -> Docs.Documentation -> Registry.KnownVersions -> IO (Either Exit.Publish GoodVersion)\nverifyBump (Env _ cache manager _ _) pkg vsn newDocs knownVersions@(Registry.KnownVersions latest _) =\n  case List.find (\\(_ ,new, _) -> vsn == new) (Bump.getPossibilities knownVersions) of\n    Nothing ->\n      return $ Left $\n        Exit.PublishInvalidBump vsn latest\n\n    Just (old, new, magnitude) ->\n      do  result <- Diff.getDocs cache manager pkg old\n          case result of\n            Left dp ->\n              return $ Left $ Exit.PublishCannotGetDocs old new dp\n\n            Right oldDocs ->\n              let\n                changes = Diff.diff oldDocs newDocs\n                realNew = Diff.bump changes old\n              in\n              if new == realNew\n              then return $ Right $ GoodBump old magnitude\n              else\n                return $ Left $\n                  Exit.PublishBadBump old new magnitude realNew (Diff.toMagnitude changes)\n\n\n\n-- REGISTER PACKAGES\n\n\nregister :: Http.Manager -> Pkg.Name -> V.Version -> Docs.Documentation -> String -> Http.Sha -> Task.Task Exit.Publish ()\nregister manager pkg vsn docs commitHash sha =\n  let\n    url =\n      Website.route \"/register\"\n        [ (\"name\", Pkg.toChars pkg)\n        , (\"version\", V.toChars vsn)\n        , (\"commit-hash\", commitHash)\n        ]\n  in\n  Task.eio Exit.PublishCannotRegister $\n    Http.upload manager url\n      [ Http.filePart \"elm.json\" \"elm.json\"\n      , Http.jsonPart \"docs.json\" \"docs.json\" (Docs.encode docs)\n      , Http.filePart \"README.md\" \"README.md\"\n      , Http.stringPart \"github-hash\" (Http.shaToChars sha)\n      ]\n\n\n\n-- REPORTING\n\n\nreportPublishStart :: Pkg.Name -> V.Version -> Maybe Registry.KnownVersions -> Task.Task x ()\nreportPublishStart pkg vsn maybeKnownVersions =\n  Task.io $\n  case maybeKnownVersions of\n    Nothing ->\n      putStrLn $ Exit.newPackageOverview ++ \"\\nI will now verify that everything is in order...\\n\"\n\n    Just _ ->\n      putStrLn $ \"Verifying \" ++ Pkg.toChars pkg ++ \" \" ++ V.toChars vsn ++ \" ...\\n\"\n\n\n\n-- REPORTING PHASES\n\n\nreportReadmeCheck :: IO (Either x a) -> Task.Task x a\nreportReadmeCheck =\n  reportCheck\n    \"Looking for README.md\"\n    \"Found README.md\"\n    \"Problem with your README.md\"\n\n\nreportLicenseCheck :: IO (Either x a) -> Task.Task x a\nreportLicenseCheck =\n  reportCheck\n    \"Looking for LICENSE\"\n    \"Found LICENSE\"\n    \"Problem with your LICENSE\"\n\n\nreportBuildCheck :: IO (Either x a) -> Task.Task x a\nreportBuildCheck =\n  reportCheck\n    \"Verifying documentation...\"\n    \"Verified documentation\"\n    \"Problem with documentation\"\n\n\nreportSemverCheck :: V.Version -> IO (Either x GoodVersion) -> Task.Task x ()\nreportSemverCheck version work =\n  let\n    vsn = V.toChars version\n\n    waiting = \"Checking semantic versioning rules. Is \" ++ vsn ++ \" correct?\"\n    failure = \"Version \" ++ vsn ++ \" is not correct!\"\n    success result =\n      case result of\n        GoodStart ->\n          \"All packages start at version \" ++ V.toChars V.one\n\n        GoodBump oldVersion magnitude ->\n          \"Version number \" ++ vsn ++ \" verified (\"\n          ++ M.toChars magnitude ++ \" change, \"\n          ++ V.toChars oldVersion ++ \" => \" ++ vsn ++ \")\"\n  in\n  void $ reportCustomCheck waiting success failure work\n\n\nreportTagCheck :: V.Version -> IO (Either x a) -> Task.Task x a\nreportTagCheck vsn =\n  reportCheck\n    (\"Is version \" ++ V.toChars vsn ++ \" tagged on GitHub?\")\n    (\"Version \" ++ V.toChars vsn ++ \" is tagged on GitHub\")\n    (\"Version \" ++ V.toChars vsn ++ \" is not tagged on GitHub!\")\n\n\nreportDownloadCheck :: IO (Either x a) -> Task.Task x a\nreportDownloadCheck =\n  reportCheck\n    \"Downloading code from GitHub...\"\n    \"Code downloaded successfully from GitHub\"\n    \"Could not download code from GitHub!\"\n\n\nreportLocalChangesCheck :: IO (Either x a) -> Task.Task x a\nreportLocalChangesCheck =\n  reportCheck\n    \"Checking for uncommitted changes...\"\n    \"No uncommitted changes in local code\"\n    \"Your local code is different than the code tagged on GitHub\"\n\n\nreportZipBuildCheck :: IO (Either x a) -> Task.Task x a\nreportZipBuildCheck =\n  reportCheck\n    \"Verifying downloaded code...\"\n    \"Downloaded code compiles successfully\"\n    \"Cannot compile downloaded code!\"\n\n\nreportCheck :: String -> String -> String -> IO (Either x a) -> Task.Task x a\nreportCheck waiting success failure work =\n  reportCustomCheck waiting (\\_ -> success) failure work\n\n\nreportCustomCheck :: String -> (a -> String) -> String -> IO (Either x a) -> Task.Task x a\nreportCustomCheck waiting success failure work =\n  let\n    putFlush doc =\n      Help.toStdout doc >> IO.hFlush IO.stdout\n\n    padded message =\n      message ++ replicate (length waiting - length message) ' '\n  in\n  Task.eio id $\n  do  putFlush $ \"  \" <> waitingMark <+> D.fromChars waiting\n      result <- work\n      putFlush $\n        case result of\n          Right a -> \"\\r  \" <> goodMark <+> D.fromChars (padded (success a) ++ \"\\n\")\n          Left _  -> \"\\r  \" <> badMark  <+> D.fromChars (padded failure ++ \"\\n\\n\")\n\n      return result\n\n\n-- MARKS\n\n\ngoodMark :: D.Doc\ngoodMark =\n  D.green $ if isWindows then \"+\" else \"●\"\n\n\nbadMark :: D.Doc\nbadMark =\n  D.red $ if isWindows then \"X\" else \"✗\"\n\n\nwaitingMark :: D.Doc\nwaitingMark =\n  D.dullyellow $ if isWindows then \"-\" else \"→\"\n\n\nisWindows :: Bool\nisWindows =\n  Info.os == \"mingw32\"\n"
  },
  {
    "path": "terminal/src/Repl.hs",
    "content": "{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-incomplete-uni-patterns #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Repl\n  ( Flags(..)\n  , run\n  --\n  , Lines(..)\n  , Input(..)\n  , Prefill(..)\n  , CategorizedInput(..)\n  , categorize\n  --\n  , State(..)\n  , Output(..)\n  , toByteString\n  )\n  where\n\n\nimport Prelude hiding (lines, read)\nimport Control.Applicative ((<|>))\nimport Control.Monad.Trans (lift, liftIO)\nimport qualified Control.Monad.State.Strict as State\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.ByteString.Char8 as BSC\nimport qualified Data.ByteString.Lazy as LBS\nimport qualified Data.ByteString.UTF8 as BS_UTF8\nimport qualified Data.Char as Char\nimport qualified Data.List as List\nimport qualified Data.Map as Map\nimport qualified Data.Name as N\nimport qualified System.Console.Haskeline as Repl\nimport qualified System.Directory as Dir\nimport qualified System.Exit as Exit\nimport System.FilePath ((</>))\nimport qualified System.IO as IO\nimport qualified System.Process as Proc\n\nimport qualified AST.Source as Src\nimport qualified BackgroundWriter as BW\nimport qualified Build\nimport qualified Elm.Constraint as C\nimport qualified Elm.Details as Details\nimport qualified Elm.Licenses as Licenses\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Outline as Outline\nimport qualified Elm.Package as Pkg\nimport qualified Elm.Version as V\nimport qualified Generate\nimport qualified Parse.Expression as PE\nimport qualified Parse.Declaration as PD\nimport qualified Parse.Module as PM\nimport qualified Parse.Primitives as P\nimport qualified Parse.Space as PS\nimport qualified Parse.Type as PT\nimport qualified Parse.Variable as PV\nimport Parse.Primitives (Row, Col)\nimport qualified Reporting\nimport qualified Reporting.Annotation as A\nimport Reporting.Doc ((<+>))\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Error.Syntax as ES\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Render.Code as Code\nimport qualified Reporting.Report as Report\nimport qualified Reporting.Task as Task\nimport qualified Stuff\n\n\n\n-- RUN\n\n\ndata Flags =\n  Flags\n    { _maybeInterpreter :: Maybe FilePath\n    , _noColors :: Bool\n    }\n\n\nrun :: () -> Flags -> IO ()\nrun () flags =\n  do  printWelcomeMessage\n      settings <- initSettings\n      env <- initEnv flags\n      let looper = Repl.runInputT settings (Repl.withInterrupt (loop env initialState))\n      exitCode <- State.evalStateT looper initialState\n      Exit.exitWith exitCode\n\n\n\n-- WELCOME\n\n\nprintWelcomeMessage :: IO ()\nprintWelcomeMessage =\n  let\n    vsn = V.toChars V.compiler\n    title = \"Elm\" <+> D.fromChars vsn\n    dashes = replicate (70 - length vsn) '-'\n  in\n  D.toAnsi IO.stdout $\n    D.vcat\n      [ D.black \"----\" <+> D.dullcyan title <+> D.black (D.fromChars dashes)\n      , D.black $ D.fromChars $ \"Say :help for help and :exit to exit! More at \" <> D.makeLink \"repl\"\n      , D.black \"--------------------------------------------------------------------------------\"\n      , D.empty\n      ]\n\n\n\n-- ENV\n\n\ndata Env =\n  Env\n    { _root :: FilePath\n    , _interpreter :: FilePath\n    , _ansi :: Bool\n    }\n\n\ninitEnv :: Flags -> IO Env\ninitEnv (Flags maybeAlternateInterpreter noColors) =\n  do  root <- getRoot\n      interpreter <- getInterpreter maybeAlternateInterpreter\n      return $ Env root interpreter (not noColors)\n\n\n\n-- LOOP\n\n\ndata Outcome\n  = Loop State\n  | End Exit.ExitCode\n\n\ntype M =\n  State.StateT State IO\n\n\nloop :: Env -> State -> Repl.InputT M Exit.ExitCode\nloop env state =\n  do  input <- Repl.handleInterrupt (return Skip) read\n      outcome <- liftIO (eval env state input)\n      case outcome of\n        Loop state ->\n          do  lift (State.put state)\n              loop env state\n\n        End exitCode ->\n          return exitCode\n\n\n\n-- READ\n\n\ndata Input\n  = Import ModuleName.Raw BS.ByteString\n  | Type N.Name BS.ByteString\n  | Port\n  | Decl N.Name BS.ByteString\n  | Expr BS.ByteString\n  --\n  | Reset\n  | Exit\n  | Skip\n  | Help (Maybe String)\n\n\nread :: Repl.InputT M Input\nread =\n  do  maybeLine <- Repl.getInputLine \"> \"\n      case maybeLine of\n        Nothing ->\n          return Exit\n\n        Just chars ->\n          let\n            lines = Lines (stripLegacyBackslash chars) []\n          in\n          case categorize lines of\n            Done input -> return input\n            Continue p -> readMore lines p\n\n\nreadMore :: Lines -> Prefill -> Repl.InputT M Input\nreadMore previousLines prefill =\n  do  input <- Repl.getInputLineWithInitial \"| \" (renderPrefill prefill, \"\")\n      case input of\n        Nothing ->\n          return Skip\n\n        Just chars ->\n          let\n            lines = addLine (stripLegacyBackslash chars) previousLines\n          in\n          case categorize lines of\n            Done input -> return input\n            Continue p -> readMore lines p\n\n\n-- For compatibility with 0.19.0 such that readers of \"Programming Elm\" by @jfairbank\n-- can get through the REPL section successfully.\n--\n-- TODO: remove stripLegacyBackslash in next MAJOR release\n--\nstripLegacyBackslash :: [Char] -> [Char]\nstripLegacyBackslash chars =\n  case chars of\n    [] ->\n      []\n\n    _:_ ->\n      if last chars == '\\\\'\n      then init chars\n      else chars\n\n\ndata Prefill\n  = Indent\n  | DefStart N.Name\n\n\nrenderPrefill :: Prefill -> String\nrenderPrefill lineStart =\n  case lineStart of\n    Indent ->\n      \"  \"\n\n    DefStart name ->\n      N.toChars name ++ \" \"\n\n\n\n-- LINES\n\n\ndata Lines =\n  Lines\n    { _prevLine :: String\n    , _revLines :: [String]\n    }\n\n\naddLine :: [Char] -> Lines -> Lines\naddLine line (Lines x xs) =\n  Lines line (x:xs)\n\n\nisBlank :: Lines -> Bool\nisBlank (Lines prev rev) =\n  null rev && all (==' ') prev\n\n\nisSingleLine :: Lines -> Bool\nisSingleLine (Lines _ rev) =\n  null rev\n\n\nendsWithBlankLine :: Lines -> Bool\nendsWithBlankLine (Lines prev _) =\n  all (==' ') prev\n\n\nlinesToByteString :: Lines -> BS_UTF8.ByteString\nlinesToByteString (Lines prev rev) =\n  BS_UTF8.fromString (unlines (reverse (prev:rev)))\n\n\ngetFirstLine :: Lines -> String\ngetFirstLine (Lines x xs) =\n  case xs of\n    []   -> x\n    y:ys -> getFirstLine (Lines y ys)\n\n\n\n\n-- CATEGORIZE INPUT\n\n\ndata CategorizedInput\n  = Done Input\n  | Continue Prefill\n\n\ncategorize :: Lines -> CategorizedInput\ncategorize lines\n  | isBlank lines                    = Done Skip\n  | startsWithColon lines            = Done (toCommand lines)\n  | startsWithKeyword \"import\" lines = attemptImport lines\n  | otherwise                        = attemptDeclOrExpr lines\n\n\nattemptImport :: Lines -> CategorizedInput\nattemptImport lines =\n  let\n    src = linesToByteString lines\n    parser = P.specialize (\\_ _ _ -> ()) PM.chompImport\n  in\n  case P.fromByteString parser (\\_ _ -> ()) src of\n    Right (Src.Import (A.At _ name) _ _) ->\n      Done (Import name src)\n\n    Left () ->\n      ifFail lines (Import \"ERR\" src)\n\n\nifFail :: Lines -> Input -> CategorizedInput\nifFail lines input =\n  if endsWithBlankLine lines\n  then Done input\n  else Continue Indent\n\n\nifDone :: Lines -> Input -> CategorizedInput\nifDone lines input =\n  if isSingleLine lines || endsWithBlankLine lines\n  then Done input\n  else Continue Indent\n\n\nattemptDeclOrExpr :: Lines -> CategorizedInput\nattemptDeclOrExpr lines =\n  let\n    src = linesToByteString lines\n    exprParser = P.specialize (toExprPosition src) PE.expression\n    declParser = P.specialize (toDeclPosition src) PD.declaration\n  in\n  case P.fromByteString declParser (,) src of\n    Right (decl, _) ->\n      case decl of\n        PD.Value _ (A.At _ (Src.Value (A.At _ name) _ _ _)) -> ifDone lines (Decl name src)\n        PD.Union _ (A.At _ (Src.Union (A.At _ name) _ _  )) -> ifDone lines (Type name src)\n        PD.Alias _ (A.At _ (Src.Alias (A.At _ name) _ _  )) -> ifDone lines (Type name src)\n        PD.Port  _ _                                        -> Done Port\n\n    Left declPosition\n      | startsWithKeyword \"type\" lines ->\n          ifFail lines (Type \"ERR\" src)\n\n      | startsWithKeyword \"port\" lines ->\n          Done Port\n\n      | otherwise ->\n          case P.fromByteString exprParser (,) src of\n            Right _ ->\n              ifDone lines (Expr src)\n\n            Left exprPosition ->\n              if exprPosition >= declPosition then\n                ifFail lines (Expr src)\n              else\n                case P.fromByteString annotation (\\_ _ -> ()) src of\n                  Right name -> Continue (DefStart name)\n                  Left ()    -> ifFail lines (Decl \"ERR\" src)\n\n\nstartsWithColon :: Lines -> Bool\nstartsWithColon lines =\n  case dropWhile (==' ') (getFirstLine lines) of\n    [] -> False\n    c:_ -> c == ':'\n\n\ntoCommand :: Lines -> Input\ntoCommand lines =\n  case drop 1 $ dropWhile (==' ') (getFirstLine lines) of\n    \"reset\" -> Reset\n    \"exit\"  -> Exit\n    \"quit\"  -> Exit\n    \"help\"  -> Help Nothing\n    rest    -> Help (Just (takeWhile (/=' ') rest))\n\n\nstartsWithKeyword :: [Char] -> Lines -> Bool\nstartsWithKeyword keyword lines =\n  let\n    line = getFirstLine lines\n  in\n  List.isPrefixOf keyword line &&\n    case drop (length keyword) line of\n      [] -> True\n      c:_ -> not (Char.isAlphaNum c)\n\n\ntoExprPosition :: BS.ByteString -> ES.Expr -> Row -> Col -> (Row, Col)\ntoExprPosition src expr row col =\n  let\n    decl = ES.DeclDef N.replValueToPrint (ES.DeclDefBody expr row col) row col\n  in\n  toDeclPosition src decl row col\n\n\ntoDeclPosition :: BS.ByteString -> ES.Decl -> Row -> Col -> (Row, Col)\ntoDeclPosition src decl r c =\n  let\n    err = ES.ParseError (ES.Declarations decl r c)\n    report = ES.toReport (Code.toSource src) err\n\n    (Report.Report _ (A.Region (A.Position row col) _) _ _) = report\n  in\n  (row, col)\n\n\nannotation :: P.Parser () N.Name\nannotation =\n  let\n    err _ _ = ()\n    err_ _ _ _ = ()\n  in\n  do  name <- PV.lower err\n      PS.chompAndCheckIndent err_ err\n      P.word1 0x3A {-:-} err\n      PS.chompAndCheckIndent err_ err\n      (_, _) <- P.specialize err_ PT.expression\n      PS.checkFreshLine err\n      return name\n\n\n\n-- STATE\n\n\ndata State =\n  State\n    { _imports :: Map.Map N.Name B.Builder\n    , _types :: Map.Map N.Name B.Builder\n    , _decls :: Map.Map N.Name B.Builder\n    }\n\n\ninitialState :: State\ninitialState =\n  State Map.empty Map.empty Map.empty\n\n\n\n-- EVAL\n\n\neval :: Env -> State -> Input -> IO Outcome\neval env state@(State imports types decls) input =\n  Repl.handleInterrupt (putStrLn \"<cancelled>\" >> return (Loop state)) $\n  case input of\n    Skip ->\n      return (Loop state)\n\n    Exit ->\n      return (End Exit.ExitSuccess)\n\n    Reset ->\n      do  putStrLn \"<reset>\"\n          return (Loop initialState)\n\n    Help maybeUnknownCommand ->\n      do  putStrLn (toHelpMessage maybeUnknownCommand)\n          return (Loop state)\n\n    Import name src ->\n      do  let newState = state { _imports = Map.insert name (B.byteString src) imports }\n          Loop <$> attemptEval env state newState OutputNothing\n\n    Type name src ->\n      do  let newState = state { _types = Map.insert name (B.byteString src) types }\n          Loop <$> attemptEval env state newState OutputNothing\n\n    Port ->\n      do  putStrLn \"I cannot handle port declarations.\"\n          return (Loop state)\n\n    Decl name src ->\n      do  let newState = state { _decls = Map.insert name (B.byteString src) decls }\n          Loop <$> attemptEval env state newState (OutputDecl name)\n\n    Expr src ->\n      Loop <$> attemptEval env state state (OutputExpr src)\n\n\n\n-- ATTEMPT EVAL\n\n\ndata Output\n  = OutputNothing\n  | OutputDecl N.Name\n  | OutputExpr BS.ByteString\n\n\nattemptEval :: Env -> State -> State -> Output -> IO State\nattemptEval (Env root interpreter ansi) oldState newState output =\n  do  result <-\n        BW.withScope $ \\scope ->\n        Stuff.withRootLock root $ Task.run $\n        do  details <-\n              Task.eio Exit.ReplBadDetails $\n                Details.load Reporting.silent scope root\n\n            artifacts <-\n              Task.eio id $\n                Build.fromRepl root details (toByteString newState output)\n\n            traverse (Task.mapError Exit.ReplBadGenerate . Generate.repl root details ansi artifacts) (toPrintName output)\n\n      case result of\n        Left exit ->\n          do  Exit.toStderr (Exit.replToReport exit)\n              return oldState\n\n        Right Nothing ->\n          return newState\n\n        Right (Just javascript) ->\n          do  exitCode <- interpret interpreter javascript\n              case exitCode of\n                Exit.ExitSuccess   -> return newState\n                Exit.ExitFailure _ -> return oldState\n\n\ninterpret :: FilePath -> B.Builder -> IO Exit.ExitCode\ninterpret interpreter javascript =\n  let\n    createProcess = (Proc.proc interpreter []) { Proc.std_in = Proc.CreatePipe }\n  in\n  Proc.withCreateProcess createProcess $ \\(Just stdin) _ _ handle ->\n    do  B.hPutBuilder stdin javascript\n        IO.hClose stdin\n        Proc.waitForProcess handle\n\n\n\n-- TO BYTESTRING\n\n\ntoByteString :: State -> Output -> BS.ByteString\ntoByteString (State imports types decls) output =\n  LBS.toStrict $ B.toLazyByteString $\n    mconcat\n      [ \"module \", N.toBuilder N.replModule, \" exposing (..)\\n\"\n      , Map.foldr mappend mempty imports\n      , Map.foldr mappend mempty types\n      , Map.foldr mappend mempty decls\n      , outputToBuilder output\n      ]\n\n\noutputToBuilder :: Output -> B.Builder\noutputToBuilder output =\n  N.toBuilder N.replValueToPrint <> \" =\" <>\n  case output of\n    OutputNothing ->\n      \" ()\\n\"\n\n    OutputDecl _ ->\n      \" ()\\n\"\n\n    OutputExpr expr ->\n      foldr (\\line rest -> \"\\n  \" <> B.byteString line <> rest) \"\\n\" (BSC.lines expr)\n\n\n\n-- TO PRINT NAME\n\n\ntoPrintName :: Output -> Maybe N.Name\ntoPrintName output =\n  case output of\n    OutputNothing   -> Nothing\n    OutputDecl name -> Just name\n    OutputExpr _    -> Just N.replValueToPrint\n\n\n\n-- HELP MESSAGES\n\n\ntoHelpMessage :: Maybe String -> String\ntoHelpMessage maybeBadCommand =\n  case maybeBadCommand of\n    Nothing ->\n      genericHelpMessage\n\n    Just command ->\n      \"I do not recognize the :\" ++ command ++ \" command. \" ++ genericHelpMessage\n\n\ngenericHelpMessage :: String\ngenericHelpMessage =\n  \"Valid commands include:\\n\\\n  \\\\n\\\n  \\  :exit    Exit the REPL\\n\\\n  \\  :help    Show this information\\n\\\n  \\  :reset   Clear all previous imports and definitions\\n\\\n  \\\\n\\\n  \\More info at \" ++ D.makeLink \"repl\" ++ \"\\n\"\n\n\n\n-- GET ROOT\n\n\ngetRoot :: IO FilePath\ngetRoot =\n  do  maybeRoot <- Stuff.findRoot\n      case maybeRoot of\n        Just root ->\n          return root\n\n        Nothing ->\n          do  cache <- Stuff.getReplCache\n              let root = cache </> \"tmp\"\n              Dir.createDirectoryIfMissing True (root </> \"src\")\n              Outline.write root $ Outline.Pkg $\n                Outline.PkgOutline\n                  Pkg.dummyName\n                  Outline.defaultSummary\n                  Licenses.bsd3\n                  V.one\n                  (Outline.ExposedList [])\n                  defaultDeps\n                  Map.empty\n                  C.defaultElm\n\n              return root\n\n\ndefaultDeps :: Map.Map Pkg.Name C.Constraint\ndefaultDeps =\n  Map.fromList\n    [ (Pkg.core, C.anything)\n    , (Pkg.json, C.anything)\n    , (Pkg.html, C.anything)\n    ]\n\n\n\n-- GET INTERPRETER\n\n\ngetInterpreter :: Maybe String -> IO FilePath\ngetInterpreter maybeName =\n  case maybeName of\n    Just name ->\n      getInterpreterHelp name (Dir.findExecutable name)\n\n    Nothing ->\n      getInterpreterHelp \"node` or `nodejs\" $\n        do  exe1 <- Dir.findExecutable \"node\"\n            exe2 <- Dir.findExecutable \"nodejs\"\n            return (exe1 <|> exe2)\n\n\ngetInterpreterHelp :: String -> IO (Maybe FilePath) -> IO FilePath\ngetInterpreterHelp name findExe =\n  do  maybePath <- findExe\n      case maybePath of\n        Just path ->\n          return path\n\n        Nothing ->\n          do  IO.hPutStrLn IO.stderr (exeNotFound name)\n              Exit.exitFailure\n\n\nexeNotFound :: String -> String\nexeNotFound name =\n  \"The REPL relies on node.js to execute JavaScript code outside the browser.\\n\"\n  ++ \"I could not find executable `\" ++ name ++ \"` on your PATH though!\\n\\n\"\n  ++ \"You can install node.js from <http://nodejs.org/>. If it is already installed\\n\"\n  ++ \"but has a different name, use the --interpreter flag.\"\n\n\n\n-- SETTINGS\n\n\ninitSettings :: IO (Repl.Settings M)\ninitSettings =\n  do  cache <- Stuff.getReplCache\n      return $\n        Repl.Settings\n          { Repl.historyFile = Just (cache </> \"history\")\n          , Repl.autoAddHistory = True\n          , Repl.complete = Repl.completeWord Nothing \" \\n\" lookupCompletions\n          }\n\n\nlookupCompletions :: String -> M [Repl.Completion]\nlookupCompletions string =\n  do  (State imports types decls) <- State.get\n      return $\n        addMatches string False decls $\n        addMatches string False types $\n        addMatches string True imports $\n        addMatches string False commands []\n\n\ncommands :: Map.Map N.Name ()\ncommands =\n  Map.fromList\n    [ (\":exit\", ())\n    , (\":quit\", ())\n    , (\":reset\", ())\n    , (\":help\", ())\n    ]\n\n\naddMatches :: String -> Bool -> Map.Map N.Name v -> [Repl.Completion] -> [Repl.Completion]\naddMatches string isFinished dict completions =\n  Map.foldrWithKey (addMatch string isFinished) completions dict\n\n\naddMatch :: String -> Bool -> N.Name -> v -> [Repl.Completion] -> [Repl.Completion]\naddMatch string isFinished name _ completions =\n  let\n    suggestion = N.toChars name\n  in\n  if List.isPrefixOf string suggestion then\n    Repl.Completion suggestion suggestion isFinished : completions\n  else\n    completions\n"
  },
  {
    "path": "worker/elm.cabal",
    "content": "\nName: elm\nVersion: 0.19.1\n\nSynopsis:\n    Perform tasks for various Elm websites\n\nDescription:\n    Compile code for the online editor. Maybe do more someday!\n\nHomepage: https://elm-lang.org\n\nLicense: BSD3\nLicense-file: ../LICENSE\n\nAuthor:     Evan Czaplicki\nMaintainer: info@elm-lang.org\nCopyright:  Copyright (c) 2019-present, Evan Czaplicki\n\nCategory: Compiler, Language\n\nCabal-version: >=1.9\nBuild-type: Simple\n\nsource-repository head\n    type:     git\n    location: git://github.com/elm/compiler.git\n\n\nFlag dev {\n  Description: Turn off optimization and make warnings errors\n  Default: False\n}\n\n\nExecutable worker\n    if flag(dev)\n        ghc-options: -O0 -Wall -Werror\n    else\n        ghc-options: -O2 -rtsopts -threaded \"-with-rtsopts=-N -qg\"\n\n    Hs-Source-Dirs:\n        src\n        ../compiler/src\n        ../builder/src\n        ../terminal/src\n\n    Main-Is:\n        Main.hs\n\n    other-modules:\n        Artifacts\n        Cors\n        Endpoint.Compile\n        Endpoint.Quotes\n        Endpoint.Repl\n        Endpoint.Slack\n\n        AST.Canonical\n        AST.Optimized\n        AST.Source\n        AST.Utils.Binop\n        AST.Utils.Shader\n        AST.Utils.Type\n        BackgroundWriter\n        Build\n        Canonicalize.Effects\n        Canonicalize.Environment\n        Canonicalize.Environment.Dups\n        Canonicalize.Environment.Foreign\n        Canonicalize.Environment.Local\n        Canonicalize.Expression\n        Canonicalize.Module\n        Canonicalize.Pattern\n        Canonicalize.Type\n        Compile\n        Data.Bag\n        Data.Index\n        Data.Map.Utils\n        Data.Name\n        Data.NonEmptyList\n        Data.OneOrMore\n        Data.Utf8\n        Deps.Registry\n        Deps.Solver\n        Deps.Website\n        Elm.Compiler.Imports\n        Elm.Compiler.Type\n        Elm.Compiler.Type.Extract\n        Elm.Constraint\n        Elm.Details\n        Elm.Docs\n        Elm.Float\n        Elm.Interface\n        Elm.Kernel\n        Elm.Licenses\n        Elm.Magnitude\n        Elm.ModuleName\n        Elm.Outline\n        Elm.Package\n        Elm.String\n        Elm.Version\n        File\n        Generate\n        Generate.Html\n        Generate.JavaScript\n        Generate.JavaScript.Builder\n        Generate.JavaScript.Expression\n        Generate.JavaScript.Functions\n        Generate.JavaScript.Name\n        Generate.Mode\n        Http\n        Json.Decode\n        Json.Encode\n        Json.String\n        Nitpick.Debug\n        Nitpick.PatternMatches\n        Optimize.Case\n        Optimize.DecisionTree\n        Optimize.Expression\n        Optimize.Module\n        Optimize.Names\n        Optimize.Port\n        Parse.Declaration\n        Parse.Expression\n        Parse.Keyword\n        Parse.Module\n        Parse.Number\n        Parse.Pattern\n        Parse.Primitives\n        Parse.Shader\n        Parse.Space\n        Parse.String\n        Parse.Symbol\n        Parse.Type\n        Parse.Variable\n        Paths_elm\n        Repl\n        Reporting\n        Reporting.Annotation\n        Reporting.Doc\n        Reporting.Error\n        Reporting.Error.Canonicalize\n        Reporting.Error.Docs\n        Reporting.Error.Import\n        Reporting.Error.Json\n        Reporting.Error.Main\n        Reporting.Error.Pattern\n        Reporting.Error.Syntax\n        Reporting.Error.Type\n        Reporting.Exit\n        Reporting.Exit.Help\n        Reporting.Render.Code\n        Reporting.Render.Type\n        Reporting.Render.Type.Localizer\n        Reporting.Report\n        Reporting.Result\n        Reporting.Suggest\n        Reporting.Task\n        Reporting.Warning\n        Stuff\n        Type.Constrain.Expression\n        Type.Constrain.Module\n        Type.Constrain.Pattern\n        Type.Error\n        Type.Instantiate\n        Type.Occurs\n        Type.Solve\n        Type.Type\n        Type.Unify\n        Type.UnionFind\n\n    Build-depends:\n        aeson,\n        ansi-terminal >= 0.8,\n        ansi-wl-pprint >= 0.6.8 && < 1,\n        base >=4.11 && <5,\n        base64-bytestring,\n        binary >= 0.8,\n        bytestring >= 0.9,\n        containers >= 0.5.8.2,\n        directory >= 1.2.3.0,\n        edit-distance >= 0.2,\n        filelock,\n        filepath >= 1,\n        ghc-prim >= 0.5.2,\n        haskeline,\n        HTTP >= 4000.2.5,\n        http-client >= 0.6,\n        http-client-tls >= 0.3,\n        http-types >= 0.12,\n        io-streams,\n        language-glsl >= 0.3,\n        mtl >= 2.2.1,\n        network >= 2.4,\n        network-uri,\n        parsec,\n        process,\n        random,\n        raw-strings-qq,\n        scientific,\n        SHA,\n        snap-core,\n        snap-server,\n        template-haskell,\n        text,\n        time >= 1.9.1,\n        unordered-containers,\n        utf8-string,\n        vector,\n        zip-archive\n"
  },
  {
    "path": "worker/elm.json",
    "content": "{\n    \"type\": \"application\",\n    \"source-directories\": [\n        \"src\"\n    ],\n    \"elm-version\": \"0.19.1\",\n    \"dependencies\": {\n        \"direct\": {\n            \"elm/browser\": \"1.0.1\",\n            \"elm/core\": \"1.0.2\",\n            \"elm/html\": \"1.0.0\",\n            \"elm/json\": \"1.1.3\",\n            \"elm/project-metadata-utils\": \"1.0.0\"\n        },\n        \"indirect\": {\n            \"elm/parser\": \"1.1.0\",\n            \"elm/time\": \"1.0.0\",\n            \"elm/url\": \"1.0.0\",\n            \"elm/virtual-dom\": \"1.0.2\"\n        }\n    },\n    \"test-dependencies\": {\n        \"direct\": {},\n        \"indirect\": {}\n    }\n}\n"
  },
  {
    "path": "worker/logrotate.conf",
    "content": "/usr/local/elm/nginx/logs/*.log {\n        daily\n        size 64M\n        rotate 16\n        missingok\n        compress\n        delaycompress\n        notifempty\n        sharedscripts\n        postrotate\n                if [ -f /usr/local/elm/nginx/logs/nginx.pid ]; then\n                        kill -USR1 `cat /usr/local/elm/nginx/logs/nginx.pid`\n                fi\n        endscript\n}\n"
  },
  {
    "path": "worker/nginx.conf",
    "content": "server {\n    listen 80;\n    server_name worker.elm-lang.org;\n\n    location / {\n        proxy_pass http://localhost:8000;\n    }\n}\n\nserver {\n    listen 443 ssl;\n    server_name worker.elm-lang.org;\n\n    location / {\n        proxy_pass http://localhost:8000;\n    }\n\n    ssl_certificate /etc/letsencrypt/live/worker.elm-lang.org/fullchain.pem; # managed by Certbot\n    ssl_certificate_key /etc/letsencrypt/live/worker.elm-lang.org/privkey.pem; # managed by Certbot\n    include /etc/letsencrypt/options-ssl-nginx.conf;\n    ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem;\n}\n"
  },
  {
    "path": "worker/outlines/compile/elm.json",
    "content": "{\n    \"type\": \"application\",\n    \"source-directories\": [\n        \"../../src\"\n    ],\n    \"elm-version\": \"0.19.1\",\n    \"dependencies\": {\n        \"direct\": {\n            \"elm/browser\": \"1.0.1\",\n            \"elm/core\": \"1.0.2\",\n            \"elm/file\": \"1.0.5\",\n            \"elm/html\": \"1.0.0\",\n            \"elm/http\": \"2.0.0\",\n            \"elm/json\": \"1.1.3\",\n            \"elm/random\": \"1.0.0\",\n            \"elm/svg\": \"1.0.1\",\n            \"elm/time\": \"1.0.0\",\n            \"elm-explorations/linear-algebra\": \"1.0.3\",\n            \"elm-explorations/webgl\": \"1.1.0\",\n            \"evancz/elm-playground\": \"1.0.2\"\n        },\n        \"indirect\": {\n            \"elm/bytes\": \"1.0.8\",\n            \"elm/url\": \"1.0.0\",\n            \"elm/virtual-dom\": \"1.0.2\"\n        }\n    },\n    \"test-dependencies\": {\n        \"direct\": {},\n        \"indirect\": {}\n    }\n}\n"
  },
  {
    "path": "worker/outlines/repl/elm.json",
    "content": "{\n    \"type\": \"application\",\n    \"source-directories\": [\n        \"../../src\"\n    ],\n    \"elm-version\": \"0.19.1\",\n    \"dependencies\": {\n        \"direct\": {\n            \"elm/core\": \"1.0.2\"\n        },\n        \"indirect\": {\n            \"elm/json\": \"1.1.3\"\n        }\n    },\n    \"test-dependencies\": {\n        \"direct\": {},\n        \"indirect\": {}\n    }\n}\n"
  },
  {
    "path": "worker/src/Artifacts.hs",
    "content": "module Artifacts\n  ( Artifacts(..)\n  , Root(..)\n  , loadCompile\n  , loadRepl\n  , toDepsInfo\n  )\n  where\n\n\nimport Control.Concurrent (readMVar)\nimport Control.Monad (liftM2)\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.ByteString.Lazy as LBS\nimport qualified Data.Map as Map\nimport qualified Data.Name as N\nimport qualified Data.OneOrMore as OneOrMore\nimport System.FilePath ((</>))\n\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified BackgroundWriter as BW\nimport qualified Elm.Details as Details\nimport qualified Elm.Interface as I\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport Json.Encode ((==>))\nimport qualified Json.Encode as E\nimport qualified Json.String as Json\nimport qualified Reporting\n\n\n\n-- ARTIFACTS\n\n\ndata Artifacts =\n  Artifacts\n    { _ifaces :: Map.Map ModuleName.Raw I.Interface\n    , _graph :: Opt.GlobalGraph\n    }\n\n\ndata Root =\n  Root FilePath\n\n\nloadCompile :: Root -> IO Artifacts\nloadCompile root =\n  load root (\"outlines\" </> \"compile\")\n\n\nloadRepl :: Root -> IO Artifacts\nloadRepl root =\n  load root (\"outlines\" </> \"repl\")\n\n\n\n-- LOAD\n\n\nload :: Root -> FilePath -> IO Artifacts\nload (Root rootPath) dir =\n  BW.withScope $ \\scope ->\n  do  putStrLn $ \"Loading \" ++ rootPath </> dir </> \"elm.json\"\n      style <- Reporting.terminal\n      let root = rootPath </> dir\n      result <- Details.load style scope root\n      case result of\n        Left _ ->\n          error $ \"Ran into some problem loading elm.json\\nTry running `elm make` in: \" ++ dir\n\n        Right details ->\n          do  omvar <- Details.loadObjects root details\n              imvar <- Details.loadInterfaces root details\n              mdeps <- readMVar imvar\n              mobjs <- readMVar omvar\n              case liftM2 (,) mdeps mobjs of\n                Nothing ->\n                  error $ \"Ran into some weird problem loading elm.json\\nTry running `elm make` in: \" ++ dir\n\n                Just (deps, objs) ->\n                  return $ Artifacts (toInterfaces deps) objs\n\n\ntoInterfaces :: Map.Map ModuleName.Canonical I.DependencyInterface -> Map.Map ModuleName.Raw I.Interface\ntoInterfaces deps =\n  Map.mapMaybe toUnique $ Map.fromListWith OneOrMore.more $\n    Map.elems (Map.mapMaybeWithKey getPublic deps)\n\n\ngetPublic :: ModuleName.Canonical -> I.DependencyInterface -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore I.Interface)\ngetPublic (ModuleName.Canonical _ name) dep =\n  case dep of\n    I.Public  iface -> Just (name, OneOrMore.one iface)\n    I.Private _ _ _ -> Nothing\n\n\ntoUnique :: OneOrMore.OneOrMore a -> Maybe a\ntoUnique oneOrMore =\n  case oneOrMore of\n    OneOrMore.One value -> Just value\n    OneOrMore.More _ _  -> Nothing\n\n\n\n-- TO DEPS INFO\n\n\ntoDepsInfo :: Artifacts -> BS.ByteString\ntoDepsInfo (Artifacts ifaces _) =\n  LBS.toStrict $ B.toLazyByteString $ E.encodeUgly $ encode ifaces\n\n\n\n-- ENCODE\n\n\nencode :: Map.Map ModuleName.Raw I.Interface -> E.Value\nencode ifaces =\n  E.dict Json.fromName encodeInterface ifaces\n\n\nencodeInterface :: I.Interface -> E.Value\nencodeInterface (I.Interface pkg values unions aliases binops) =\n  E.object\n    [ \"pkg\" ==> E.chars (Pkg.toChars pkg)\n    , \"ops\" ==> E.list E.name (Map.keys binops)\n    , \"values\" ==> E.list E.name (Map.keys values)\n    , \"aliases\" ==> E.list E.name (Map.keys (Map.filter isPublicAlias aliases))\n    , \"types\" ==> E.dict Json.fromName (E.list E.name) (Map.mapMaybe toPublicUnion unions)\n    ]\n\n\nisPublicAlias :: I.Alias -> Bool\nisPublicAlias alias =\n  case alias of\n    I.PublicAlias  _ -> True\n    I.PrivateAlias _ -> False\n\n\ntoPublicUnion :: I.Union -> Maybe [N.Name]\ntoPublicUnion union =\n  case union of\n    I.OpenUnion (Can.Union _ variants _ _) ->\n      Just (map getVariantName variants)\n\n    I.ClosedUnion _ ->\n      Just []\n\n    I.PrivateUnion _ ->\n      Nothing\n\n\ngetVariantName :: Can.Ctor -> N.Name\ngetVariantName (Can.Ctor name _ _ _) =\n  name\n"
  },
  {
    "path": "worker/src/Cors.hs",
    "content": "module Cors\n  ( allow\n  )\n  where\n\n\nimport qualified Data.HashSet as HashSet\nimport Network.URI (parseURI)\nimport Snap.Core (Snap, Method, method)\nimport Snap.Util.CORS (CORSOptions(..), HashableMethod(..), OriginList(Origins), applyCORS, mkOriginSet)\n\n\n\n-- ALLOW\n\n\nallow :: Method -> [String] -> Snap () -> Snap ()\nallow method_ origins snap =\n  applyCORS (toOptions method_ origins) $ method method_ $\n    snap\n\n\n\n-- TO OPTIONS\n\n\ntoOptions :: (Monad m) => Method -> [String] -> CORSOptions m\ntoOptions method_ origins =\n  let\n    allowedOrigins = toOriginList origins\n    allowedMethods = HashSet.singleton (HashableMethod method_)\n  in\n  CORSOptions\n    { corsAllowOrigin = return allowedOrigins\n    , corsAllowCredentials = return True\n    , corsExposeHeaders = return HashSet.empty\n    , corsAllowedMethods = return allowedMethods\n    , corsAllowedHeaders = return\n    }\n\n\ntoOriginList :: [String] -> OriginList\ntoOriginList origins =\n  Origins $ mkOriginSet $\n    case traverse parseURI origins of\n      Just uris -> uris\n      Nothing -> error \"invalid entry given to toOriginList list\"\n"
  },
  {
    "path": "worker/src/Endpoint/Compile.hs",
    "content": "{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}\nmodule Endpoint.Compile\n  ( endpoint_V1\n  , endpoint_V2\n  , loadErrorJS\n  )\n  where\n\n\nimport qualified Data.ByteString as B\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.ByteString.Lazy as LBS\nimport qualified Data.Map as Map\nimport qualified Data.Map.Utils as Map\nimport qualified Data.Name as N\nimport qualified Data.NonEmptyList as NE\nimport Snap.Core\nimport Snap.Util.FileUploads\nimport System.FilePath ((</>))\nimport qualified System.IO.Streams as Stream\nimport Text.RawString.QQ (r)\n\nimport qualified Artifacts as A\nimport qualified Cors\n\nimport qualified AST.Source as Src\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified BackgroundWriter as BW\nimport qualified Build\nimport qualified Compile\nimport qualified Elm.Details as Details\nimport qualified Elm.Interface as I\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified File\nimport qualified Generate\nimport qualified Generate.Html as Html\nimport qualified Generate.JavaScript as JS\nimport qualified Generate.Mode as Mode\nimport qualified Json.Encode as Encode\nimport qualified Parse.Module as Parse\nimport qualified Reporting\nimport qualified Reporting.Annotation as A\nimport Reporting.Doc ((<>))\nimport qualified Reporting.Doc as D\nimport qualified Reporting.Error as Error\nimport qualified Reporting.Error.Import as Import\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Exit.Help as Help\nimport qualified Reporting.Task as Task\n\n\n\n-- ALLOWED ORIGINS\n\n\nallowedOrigins :: [String]\nallowedOrigins =\n  [ \"https://elm-lang.org\"\n  , \"https://package.elm-lang.org\"\n  ]\n\n\n\n-- ENDPOINT (V1)\n\n\nendpoint_V1 :: A.Artifacts -> Snap ()\nendpoint_V1 artifacts =\n  endpoint artifacts $ \\result ->\n    case result of\n      Ok name js -> writeBuilder $ Html.sandwich name js\n      Err report -> writeBuilder $ renderProblem_V1 report\n\n\n\n-- ENDPOINT (V2)\n\n\nendpoint_V2 :: A.Artifacts -> Snap ()\nendpoint_V2 artifacts =\n  endpoint artifacts $ \\result ->\n    case result of\n      Ok name js -> writeBuilder $ renderSuccess_V2 name js\n      Err report -> writeBuilder $ renderProblem_V2 report\n\n\n\n-- ENDPOINT\n\n\ndata Result\n  = Ok N.Name B.Builder\n  | Err Help.Report\n\n\nendpoint :: A.Artifacts -> (Result -> Snap ()) -> Snap ()\nendpoint artifacts callback =\n  Cors.allow POST allowedOrigins $\n  do  result <- foldMultipart defaultUploadPolicy ignoreFile 0\n      case result of\n        ([(\"code\",source)], 0) ->\n          do  modifyResponse $ setContentType \"text/html; charset=utf-8\"\n              callback $\n                case compile artifacts source of\n                  Success name js   -> Ok name js\n                  NoMain            -> Err noMain\n                  BadInput name err -> Err $ Help.compilerReport \"/\" (Error.Module name \"/try\" File.zeroTime source err) []\n\n        _ ->\n          do  modifyResponse $ setResponseStatus 400 \"Bad Request\"\n              modifyResponse $ setContentType \"text/html; charset=utf-8\"\n              writeBS\n                \"<p>Unexpected request format. This should not be possible!</p>\\\n                \\<p>Please report this\\\n                \\ <a href=\\\"https://github.com/elm/compiler/issues\\\">here</a>\\\n                \\ along with the URL and your browser version.</p>\"\n\n\nignoreFile :: PartInfo -> Stream.InputStream B.ByteString -> Int -> IO Int\nignoreFile _ _ count =\n  return (count + 1)\n\n\n\n-- COMPILE\n\n\ndata Outcome\n  = Success N.Name B.Builder\n  | NoMain\n  | BadInput ModuleName.Raw Error.Error\n\n\ncompile :: A.Artifacts -> B.ByteString -> Outcome\ncompile (A.Artifacts interfaces objects) source =\n  case Parse.fromByteString Parse.Application source of\n    Left err ->\n      BadInput N._Main (Error.BadSyntax err)\n\n    Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->\n      case checkImports interfaces imports of\n        Left err ->\n          BadInput (Src.getName modul) (Error.BadImports err)\n\n        Right ifaces ->\n          case Compile.compile Pkg.dummyName ifaces modul of\n            Left err ->\n              BadInput (Src.getName modul) err\n\n            Right (Compile.Artifacts canModule _ locals) ->\n              case locals of\n                Opt.LocalGraph Nothing _ _ ->\n                  NoMain\n\n                Opt.LocalGraph (Just main_) _ _ ->\n                  let\n                    mode  = Mode.Dev Nothing\n                    home  = Can._name canModule\n                    name  = ModuleName._module home\n                    mains = Map.singleton home main_\n                    graph = Opt.addLocalGraph locals objects\n                  in\n                  Success name $ JS.generate mode graph mains\n\n\ncheckImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)\ncheckImports interfaces imports =\n  let\n    importDict = Map.fromValues Src.getImportName imports\n    missing = Map.difference importDict interfaces\n  in\n  case Map.elems missing of\n    [] ->\n      Right (Map.intersection interfaces importDict)\n\n    i:is ->\n      let\n        unimported =\n          Map.keysSet (Map.difference interfaces importDict)\n\n        toError (Src.Import (A.At region name) _ _) =\n          Import.Error region name unimported Import.NotFound\n      in\n      Left (fmap toError (NE.List i is))\n\n\n\n-- RENDER PROBLEM (V1)\n\n\nrenderProblem_V1 :: Help.Report -> B.Builder\nrenderProblem_V1 report =\n  [r|<!DOCTYPE HTML>\n<html>\n<head>\n  <meta charset=\"UTF-8\">\n  <style>body { padding: 0; margin: 0; background-color: black; }</style>\n  <script src=\"https://worker.elm-lang.org/compile/errors.js\"></script>\n</head>\n<body>\n  <script>\n    var app = Elm.Errors.init({flags:|] <> Encode.encodeUgly (Exit.toJson report) <> [r|});\n    app.ports.jumpTo.subscribe(function(region) {\n      window.parent.postMessage(JSON.stringify(region), \"*\");\n    });\n  </script>\n</body>\n</html>|]\n\n\n\n-- RENDER SUCCESS (V2)\n\n\nrenderSuccess_V2 :: N.Name -> B.Builder -> B.Builder\nrenderSuccess_V2 moduleName javascript =\n  let name = N.toBuilder moduleName in\n  [r|<!DOCTYPE HTML>\n<html>\n<head>\n  <meta charset=\"UTF-8\">\n  <title>|] <> name <> [r|</title>\n  <style>body { padding: 0; margin: 0; }</style>\n</head>\n\n<body>\n\n<pre id=\"elm\"></pre>\n\n<script>\nwindow.parent.postMessage(\"SUCCESS\", \"*\");\n\ntry {\n|] <> javascript <> [r|\n\n  var app = Elm.|] <> name <> [r|.init({ node: document.getElementById(\"elm\") });\n}\ncatch (e)\n{\n  // display initialization errors (e.g. bad flags, infinite recursion)\n  var header = document.createElement(\"h1\");\n  header.style.fontFamily = \"monospace\";\n  header.innerText = \"Initialization Error\";\n  var pre = document.getElementById(\"elm\");\n  document.body.insertBefore(header, pre);\n  pre.innerText = e;\n  throw e;\n}\n</script>\n\n</body>\n</html>|]\n\n\n\n-- RENDER PROBLEM (V2)\n\n\nrenderProblem_V2 :: Help.Report -> B.Builder\nrenderProblem_V2 report =\n  [r|<!DOCTYPE HTML>\n<html>\n<head>\n  <meta charset=\"UTF-8\">\n  <style>body { padding: 0; margin: 0; display: none; }</style>\n</head>\n<body>\n  <script>\n    var errors = |] <> Encode.encodeUgly (Exit.toJson report) <> [r|;\n    window.parent.postMessage(JSON.stringify(errors), \"*\");\n  </script>\n</body>\n</html>|]\n\n\n\n-- NO MAIN\n\n\nnoMain :: Help.Report\nnoMain =\n  Help.report \"NO MAIN\" Nothing\n    (\n      \"Without a `main` value, I do not know what to show on screen!\"\n    )\n    [ D.reflow $\n        \"Adding a `main` value can be as brief as:\"\n    , D.vcat\n        [ D.fillSep [D.cyan \"import\",\"Html\"]\n        , \"\"\n        , D.fillSep [D.green \"main\",\"=\"]\n        , D.indent 2 $ D.fillSep [D.cyan \"Html\" <> \".text\",D.dullyellow \"\\\"Hello!\\\"\"]\n        ]\n    , D.reflow $\n        \"Try adding something like that!\"\n    , D.toSimpleNote $\n        \"I recommend looking through https://guide.elm-lang.org for more advice on\\\n        \\ how to fill in `main` values.\"\n    ]\n\n\n\n-- LOAD ERROR JS\n\n\nloadErrorJS :: A.Root -> IO B.ByteString\nloadErrorJS (A.Root root) =\n  let\n    run work =\n      do  result <- work\n          case result of\n            Right a -> return a\n            Left _ -> error \"problem building src/Errors.elm\"\n  in\n  BW.withScope $ \\scope ->\n    do  details <- run $ Details.load Reporting.silent scope root\n        artifacts <- run $ Build.fromPaths Reporting.silent root details (NE.List (root </> \"src\" </> \"Errors.elm\") [])\n        javascript <- run $ Task.run $ Generate.prod root details artifacts\n        return $ LBS.toStrict $ B.toLazyByteString javascript\n"
  },
  {
    "path": "worker/src/Endpoint/Quotes.hs",
    "content": "{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}\nmodule Endpoint.Quotes\n  ( endpoint\n  )\n  where\n\n\nimport Control.Monad.IO.Class (liftIO)\nimport Data.Bits ((.&.), (.|.), shiftR)\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Internal as BS\nimport qualified Data.Char as Char\nimport GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))\nimport GHC.IO (IO(IO), unsafePerformIO)\nimport GHC.Int (Int(I#))\nimport GHC.Prim\nimport GHC.ST (ST(ST), runST)\nimport GHC.Word (Word8(W8#))\nimport qualified System.Random as Random\n\nimport Snap.Core\n\n\n\n-- ENDPOINT\n\n\nendpoint :: Snap ()\nendpoint =\n  do  modifyResponse\n        $ setContentType \"application/json\"\n        . setHeader \"Access-Control-Allow-Origin\" \"*\"\n      writeBS =<< liftIO getQuote\n\n\ngetQuote :: IO BS.ByteString\ngetQuote =\n  let\n    (Quotes sa) = quotes\n  in\n  do  (I# i) <- Random.randomRIO (0, I# (sizeofSmallArray# sa -# 1#))\n      case indexSmallArray# sa i of\n        (# json #) ->\n          return json\n\n\n\n-- QUOTES\n\n\ndata Quotes =\n  Quotes (SmallArray# BS.ByteString)\n\n\n{-# NOINLINE quotes #-}\nquotes :: Quotes\nquotes =\n  let\n    !(I# len) = length quoteList\n  in\n  runST $ ST $ \\s ->\n    case newSmallArray# len \"\"       s of { (# s, sma #) ->\n    case quotesHelp# sma quoteList   s of {    s         ->\n    case unsafeFreezeSmallArray# sma s of { (# s, sa  #) ->\n      (# s, Quotes sa #)\n    }}}\n\n\nquotesHelp# :: SmallMutableArray# s a -> [a] -> State# s -> State# s\nquotesHelp# sma =\n    go 0#\n  where\n    go i list s =\n      case list of\n        [] ->\n          s\n\n        x:xs ->\n          case writeSmallArray# sma i x s of\n            s ->\n              go (i +# 1#) xs s\n\n\nquoteList :: [BS.ByteString]\nquoteList =\n  map toUtf8\n    [ \"{\\\"source\\\":\\\"Civilization and its Discontents\\\",\\\"author\\\":\\\"Sigmund Freud\\\",\\\"year\\\":1902,\\\"quote\\\":\\\"The enormous expansion of communications, due to the world-wide telegraph and telephone networks, has entirely transformed the conditions of trade and commerce. Everything is done in haste, at fever pitch. The night is used for travel, the day for business; even \\\\u201Choliday trips\\\\u201D put a strain on the nervous system. Great political, industrial and financial crises carry this excitement into far wider areas of the population than ever before. Interest in political life has become universal: tempers are inflamed by political, religious and social struggles, party politics, electioneering and the immense growth of trade-unionism; people are forced to engage in constant mental activity and robbed of the time the need for relaxation, sleep and rest.\\\"}\"\n    , \"{\\\"source\\\":\\\"A Preface to Politics\\\",\\\"author\\\":\\\"Walter Lippmann\\\",\\\"year\\\":1913,\\\"quote\\\":\\\"The Economic Man\\\\u2014that lazy abstraction\\\\u2014is still paraded in the lecture room.\\\"}\"\n    , \"{\\\"source\\\":\\\"Letters from a Stoic\\\",\\\"author\\\":\\\"Seneca\\\",\\\"year\\\":54,\\\"quote\\\":\\\"You ask me to say what you should consider it particularly important to avoid. My answer is this: a mass crowd. It is something to which you cannot entrust yourself yet without risk. I at any rate am ready to confess my own frailty in this respect. I never come back home with quite the same moral character as I went out with.\\\"}\"\n    , \"{\\\"source\\\":\\\"Letters from a Stoic\\\",\\\"author\\\":\\\"Seneca\\\",\\\"year\\\":54,\\\"quote\\\":\\\"December used to be a month but it is now a year\\\"}\"\n    , \"{\\\"source\\\":\\\"Letters from a Stoic\\\",\\\"author\\\":\\\"Seneca\\\",\\\"year\\\":54,\\\"quote\\\":\\\"But nothing is as ruinous to the character as sitting away one\\\\u2019s time at a show - for it is then, through the medium of entertainment, that vices creep into one with more than usual ease.\\\"}\"\n    , \"{\\\"source\\\":\\\"Letters from a Stoic\\\",\\\"author\\\":\\\"Seneca\\\",\\\"year\\\":54,\\\"quote\\\":\\\"All this hurrying from place to place won\\\\u2019t bring you any relief, for you\\\\u2019re travelling in the company of your own emotions, followed by your troubles all the way. If only they were really following you! They\\\\u2019d be farther away from you: as it is they\\\\u2019re not at your back, but on it! That\\\\u2019s why they weigh you down with just the same uncomfortable chafing wherever you are. It\\\\u2019s medicine, not a particular part of the world, that a person needs if he\\\\u2019s ill. Suppose someone has broken his leg or dislocated a joint; he doesn\\\\u2019t get into a carriage or board a ship: he calls in a doctor to have the fracture set or the dislocation reduced. Well then, when a person\\\\u2019s spirit is wrenched or broken at so many points, do you imagine that it can be put right by a change of scenery, that that sort of trouble isn\\\\u2019t so serious that it can\\\\u2019t be cured by an outing?\\\"}\"\n    , \"{\\\"source\\\":\\\"Progress and Poverty\\\",\\\"author\\\":\\\"Henry George\\\",\\\"year\\\":1879,\\\"quote\\\":\\\"The present century has been marked by a prodigious increase in wealth-producing power. The utilization of steam and electricity, the introduction of improved processes and laborsaving machinery, the greater subdivision and grander scale of production, the wonderful facilitation of exchanges, have multiplied enormously the effectiveness of labor. At the beginning of this marvelous era it was natural to expect, and it was expected, that laborsaving inventions would lighten the toil and improve the condition of the laborer; that the enormous increase in the power of producing wealth would make real poverty a thing of the past.\\\"}\"\n    , \"{\\\"source\\\":\\\"Imperialism\\\",\\\"author\\\":\\\"John Hobson\\\",\\\"year\\\":1902,\\\"quote\\\":\\\"Although the new Imperialism has been bad business for the nation, it has been good business for certain classes and certain trades within the nation. The vast expenditure on armaments, the costly wars, the grave risks and embarrassments of foreign policy, the stoppage of political and social reforms within Great Britain, though fraught with great injury to the nation, have served well the present business interests of certain industries and professions.\\\"}\"\n    , \"{\\\"source\\\":\\\"Neo-Colonialism\\\",\\\"author\\\":\\\"Kwame Nkrumah\\\",\\\"year\\\":1965,\\\"quote\\\":\\\"The essence of neo-colonialism is that the State which is subject to it is, in theory, independent and has all the outward trappings of international sovereignty. In reality its economic system and thus its political policy is directed from the outside. The methods and form of this direction can take various shapes. For example, in an extreme case the troops of the imperial power may garrison the territory of the neo-colonial State and control the government of it. More often, however, neo-colonialist control is exercised through economic or monetary means. The neo-colonial State may be obliged to take the manufactured products of the imperialist power to the exclusion of competing products from elsewhere. Control over government policy in the neo-colonial State may be secured by payments towards the cost of running the State, by the provision of civil servants in positions where they can dictate policy, and by monetary control over foreign exchange through the imposition of a banking system controlled by the imperial power.\\\"}\"\n    , \"{\\\"source\\\":\\\"Neo-Colonialism\\\",\\\"author\\\":\\\"Kwame Nkrumah\\\",\\\"year\\\":1965,\\\"quote\\\":\\\"In the end the situation arises that the only type of aid which the neo-colonialist masters consider as safe is \\\\u2018military aid\\\\u2019. Once a neo-colonialist territory is brought to such a state of economic chaos and misery that revolt actually breaks out then, and only then, is there no limit to the generosity of the neo-colonial overlord, provided, of course, that the funds supplied are utilised exclusively for military purposes. Military aid in fact marks the last stage of neo-colonialism and its effect is self-destructive. Sooner or later the weapons supplied pass into the hands of the opponents of the neo-colonialist regime and the war itself increases the social misery which originally provoked it.\\\"}\"\n    , \"{\\\"source\\\":\\\"Barnyard in your Backyard\\\",\\\"author\\\":\\\"Gail Damerow\\\",\\\"year\\\":2002,\\\"quote\\\":\\\"Wild jungle fowl, the ancestors of modern chickens, met their nutritional needs by consuming a variety of plants and insects. Given enough room to roam, some of today\\\\u2019s breeds remain active foragers.\\\"}\"\n    , \"{\\\"source\\\":\\\"Barnyard in your Backyard\\\",\\\"author\\\":\\\"Gail Damerow\\\",\\\"year\\\":2002,\\\"quote\\\":\\\"Another way to reduce the cost of feed is to let your chickens roam on a lawn or in a pasture for part of the day. By eating plants, seeds, and insects, they will balance their diet and eat less of the expensive commercial stuff. Take care not to put your chickens on grass or around buildings that have been sprayed with toxins.\\\"}\"\n    , \"{\\\"source\\\":\\\"Co-operation in Danish Agriculture\\\",\\\"author\\\":\\\"Harald Faber\\\",\\\"year\\\":1918,\\\"quote\\\":\\\"A plan for improving the butter made from the milk from peasant farms by collecting the milk to be worked at one place was submitted to the Royal Agricultural Society of Denmark as early as 1852, and it pointed out that this could be done on co-operative lines, the peasants being the owners of the factory and sharing the proceeds.\\\"}\"\n    , \"{\\\"source\\\":\\\"Co-operation in Danish Agriculture\\\",\\\"author\\\":\\\"Harald Faber\\\",\\\"year\\\":1918,\\\"quote\\\":\\\"It was the Danish peasants themselves who found a practical way of developing the dairy industry, and they found this by applying the co-operative principles introduced by the Rochdale weavers. They received no support and only lukewarm sympathy from large farmers and estate owners, until later on when the co-operative dairies were doing so well that even owners of estates with two to three hundred cows found it to their advantage to close their private dairies and to join co-operative dairies.\\\"}\"\n    , \"{\\\"source\\\":\\\"Beekeeping: A Practical Guide\\\",\\\"author\\\":\\\"Richard Bonney\\\",\\\"year\\\":1993,\\\"quote\\\":\\\"How many of you have been in a classroom or a training program where the instructor says at the outset, \\\\u201CLook at the person on your right; now look at the person on your left. One of you won\\\\u2019t be here next year.\\\\u201D Beekeeping is like that. Furthermore, not all beekeepers are truly beekeepers. Some are beehavers.\\\"}\"\n    , \"{\\\"source\\\":\\\"The Rodale Book of Composting\\\",\\\"author\\\":\\\"Deborah Martin and Grace Gershuny\\\",\\\"year\\\":1992,\\\"quote\\\":\\\"Earthworms. If bacteria are the champion microscopic decomposers, then the heavyweight champion is doubtless the earthworm. Pages of praise have been written to the earthworm, ever since it became known that this creature spends most of its time tilling and enriching the soil.\\\"}\"\n    , \"{\\\"source\\\":\\\"War is a Racket\\\",\\\"author\\\":\\\"General Smedley Butler\\\",\\\"year\\\":1935,\\\"quote\\\":\\\"There are 40,000,000 men under arms in the world today, and our statesmen and diplomats have the temerity to say that war is not in the making. Hell\\\\u2019s bells! Are these 40,000,000 men being trained to be dancers?\\\"}\"\n    , \"{\\\"source\\\":\\\"Root Cellaring\\\",\\\"author\\\":\\\"Mike and Nancy Bubel\\\",\\\"year\\\":1991,\\\"quote\\\":\\\"What is not so widely acknowledged is that the soil in which your plants grow can influence the keeping quality of the vegetables you harvest. According to studies reported in E. P. Shirakov\\\\u2019s \\\\u201CPractical Course in Storage and Processing of Fruits and Vegetables\\\\u201D, abundant potash in the soil promotes long storage life of fruits and vegetables grown on that soil.\\\"}\"\n    , \"{\\\"source\\\":\\\"Angora Goats the Northern Way\\\",\\\"author\\\":\\\"Susan Black Drummond\\\",\\\"year\\\":1985,\\\"quote\\\":\\\"Because of its long wearing qualities and resistance to soil, mohair was once a major upholstery fabric in this country, and was the seat cover material in many cars and in British Railroad seats. The synthetic fiber craze put an end to mohair use as upholstery fabric here.\\\"}\"\n    , \"{\\\"source\\\":\\\"Making a Newspaper\\\",\\\"author\\\":\\\"John Given\\\",\\\"year\\\":1912,\\\"quote\\\":\\\"Yellow journalism originated through a desire to gain readers and advertisers, and it produced results. Its original disciples have readers by the hundred thousand and they have about all the advertising that they can well handle.\\\"}\"\n    , \"{\\\"source\\\":\\\"Making a Newspaper\\\",\\\"author\\\":\\\"John Given\\\",\\\"year\\\":1912,\\\"quote\\\":\\\"With the adding of every new train and the improvement of every new time-table, the building of every new trolley road, and the establishment of every new mail route, the big city papers are enabled to reach out further, and, wherever they reach, the local papers suffer [...] There is not a paper published in any city between New York and Boston that has not in the last ten years been hurt by the papers of these two cities.\\\"}\"\n    , \"{\\\"source\\\":\\\"Muscles: Testing and Function (4th Edition)\\\",\\\"author\\\":\\\"Florence Kendall, Elizabeth McCreary, Patricia Provance\\\",\\\"year\\\":1993,\\\"quote\\\":\\\"The mechanics of the low back is inseparable from that of the overall posture but especially that of the pelvis and the lower extremities. Pain manifested in the leg may be due to an underlying problem in the back. Conversely, the symptoms appearing in the low back may be due to underlying faulty mechanics of the feet, legs, or pelvis.\\\"}\"\n    , \"{\\\"source\\\":\\\"Farmers of Forty Centuries\\\",\\\"author\\\":\\\"F. H. King\\\",\\\"year\\\":1911,\\\"quote\\\":\\\"The Sikiang is one of the great rivers of China and indeed of the world. Its width at Wuchow at low water was nearly a mile and our steamer anchored in twenty-four feet of water to a floating dock made fast by huge iron chains reaching three hundred feet up the slop to the city proper, thus providing for a rise of twenty-six feet in the river at its flood stage during the rainy season.\\\"}\"\n    , \"{\\\"source\\\":\\\"How to Grow More Vegetables\\\",\\\"author\\\":\\\"John Jeavons\\\",\\\"year\\\":1974,\\\"quote\\\":\\\"If you are having trouble with birds eating the berries in your berry patch, you could erect a wren house in the middle of it. Wrens are insectivores, and they will not bother the berries. But they will attack any bird, however large, that comes near their nest.\\\"}\"\n    , \"{\\\"source\\\":\\\"Confidence Men and Painted Women\\\",\\\"author\\\":\\\"Karen Halttunen\\\",\\\"year\\\":1982,\\\"quote\\\":\\\"Even one\\\\u2019s neighbor next door, as a visitor to Pittsburgh commented in 1818, might be a stranger: \\\\u201CA next door neighbor is, with them, frequently unknown, and months and years pass, without their exchanging with each other the ordinary compliments of friendship and goodwill.\\\\u201D\\\"}\"\n    , \"{\\\"source\\\":\\\"Secondhand Time\\\",\\\"author\\\":\\\"Svetlana Alexievich\\\",\\\"year\\\":2016,\\\"quote\\\":\\\"I couldn\\\\u2019t understand what was going on. I remember seeing Gaidar on TV saying, \\\\u201Clearn how to sell... The market will save us...\\\\u201D You buy a bottle of mineral water on one corner and sell it on another\\\\u2014that\\\\u2019s business. The people listened, bewildered. I would come home, lock the door, and weep.\\\"}\"\n    , \"{\\\"source\\\":\\\"Hiroshima\\\",\\\"author\\\":\\\"John Hersey\\\",\\\"year\\\":1985,\\\"quote\\\":\\\"At exactly fifteen minutes past eight in the morning, on August 6, 1945, Japanese time, at the moment when the atomic bomb flashed above Hiroshima, Miss Toshiko Sasaki, a clerk in the personnel department of the East Asia Tin Works, had just sat down at her place in the plant office and was turning her head to speak to the girl at the next desk.\\\"}\"\n    , \"{\\\"source\\\":\\\"The Orphan\\\",\\\"author\\\":\\\"Maxim Gorky\\\",\\\"year\\\":1899,\\\"quote\\\":\\\"On a foggy and rainy day, by the cemetery gate, a small group of people standing in a muddy puddle were bargaining with the cabman. \\\\u201CFifteen kopeks!\\\\u201D The tall and heavy-set priest exclaimed in a deep bass, in response to the cabman\\\\u2019s shouts asking for twenty-five kopecks.\\\"}\"\n    , \"{\\\"source\\\":\\\"Shah of Shahs\\\",\\\"author\\\":\\\"Ryszard Kapuściński\\\",\\\"year\\\":1982,\\\"quote\\\":\\\"This plane flies out of Teheran every day and lands at Munich at noon. Waiting limousines carry the passengers to elegant restaurants for lunch. After lunch they all fly back to Teheran in the same airplane and eat their suppers at home. Hardly an expensive entertainment, the jaunt costs only two thousand dollars a head. For people in the Shah\\\\u2019s favor, such a sum is nothing.\\\"}\"\n    , \"{\\\"source\\\":\\\"Introduction to Fortran IV\\\",\\\"author\\\":\\\"Paul Chirlian\\\",\\\"year\\\":1973,\\\"quote\\\":\\\"There are many programming languages that can be used. We shall discuss a language that is almost universally used, and which is particularly applicable to mathematical and scientific computations. This language is FORTRAN IV.\\\"}\"\n    ]\n\n\n\n-- TO UTF8 BYTESTRING\n\n\ntoUtf8 :: [Char] -> BS.ByteString\ntoUtf8 chars =\n  unsafePerformIO $\n    do  mba <- newByteArray (sum (map getWidth chars))\n        writeChars mba 0 chars\n\n\nwriteChars :: MBA -> Int -> [Char] -> IO BS.ByteString\nwriteChars mba !offset chars =\n  case chars of\n    [] ->\n      finalize mba\n\n    char : chars\n      | n < 0x80 ->\n          do  writeWord8 mba (offset    ) (fromIntegral n)\n              writeChars mba (offset + 1) chars\n\n      | n < 0x800 ->\n          do  writeWord8 mba (offset    ) (fromIntegral ((shiftR n 6         ) + 0xC0))\n              writeWord8 mba (offset + 1) (fromIntegral ((       n   .&. 0x3F) + 0x80))\n              writeChars mba (offset + 2) chars\n\n      | n < 0x10000 ->\n          do  writeWord8 mba (offset    ) (fromIntegral ((shiftR n 12         ) + 0xE0))\n              writeWord8 mba (offset + 1) (fromIntegral ((shiftR n  6 .&. 0x3F) + 0x80))\n              writeWord8 mba (offset + 2) (fromIntegral ((       n    .&. 0x3F) + 0x80))\n              writeChars mba (offset + 3) chars\n\n      | otherwise ->\n          do  writeWord8 mba (offset    ) (fromIntegral ((shiftR n 18         ) + 0xF0))\n              writeWord8 mba (offset + 1) (fromIntegral ((shiftR n 12 .&. 0x3F) + 0x80))\n              writeWord8 mba (offset + 2) (fromIntegral ((shiftR n  6 .&. 0x3F) + 0x80))\n              writeWord8 mba (offset + 3) (fromIntegral ((       n    .&. 0x3F) + 0x80))\n              writeChars mba (offset + 4) chars\n\n      where\n        n = Char.ord char\n\n\ngetWidth :: Char -> Int\ngetWidth char\n  | code < 0x80    = 1\n  | code < 0x800   = 2\n  | code < 0x10000 = 3\n  | otherwise      = 4\n  where\n    code = Char.ord char\n\n\n\n-- MUTABLE BYTE ARRAYS\n\n\ndata MBA =\n  MBA (MutableByteArray# RealWorld)\n\n\nnewByteArray :: Int -> IO MBA\nnewByteArray (I# len) =\n  IO $ \\s ->\n    case newPinnedByteArray# len s of\n      (# s, mba #) -> (# s, MBA mba #)\n\n\nwriteWord8 :: MBA -> Int -> Word8 -> IO ()\nwriteWord8 (MBA mba) (I# offset) (W8# w) =\n  IO $ \\s ->\n    case writeWord8Array# mba offset w s of\n      s -> (# s, () #)\n\n\nfinalize :: MBA -> IO BS.ByteString\nfinalize (MBA mba) =\n  IO $ \\s ->\n    case getSizeofMutableByteArray# mba s of { (# s, len #) ->\n    case mutableByteArrayContents# mba    of {       addr   ->\n      (# s, BS.BS (ForeignPtr addr (PlainPtr mba)) (I# len) #)\n    }}\n\n"
  },
  {
    "path": "worker/src/Endpoint/Repl.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Endpoint.Repl\n  ( endpoint\n  )\n  where\n\n\nimport Data.Aeson ((.:))\nimport qualified Data.Aeson as Aeson\nimport qualified Data.Aeson.Types as Aeson\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Builder as B\nimport qualified Data.ByteString.Lazy as LBS\nimport Data.Map ((!))\nimport qualified Data.Map as Map\nimport qualified Data.Map.Utils as Map\nimport qualified Data.Name as N\nimport qualified Data.NonEmptyList as NE\nimport Snap.Core\n\nimport qualified Artifacts as A\nimport qualified Cors\n\nimport qualified AST.Source as Src\nimport qualified AST.Canonical as Can\nimport qualified AST.Optimized as Opt\nimport qualified Compile\nimport qualified Elm.Interface as I\nimport qualified Elm.ModuleName as ModuleName\nimport qualified Elm.Package as Pkg\nimport qualified File\nimport qualified Generate.JavaScript as JS\nimport qualified Json.Encode as Encode\nimport qualified Parse.Module as Parse\nimport qualified Repl\nimport qualified Reporting.Annotation as A\nimport qualified Reporting.Error as Error\nimport qualified Reporting.Error.Import as Import\nimport qualified Reporting.Exit as Exit\nimport qualified Reporting.Exit.Help as Help\nimport qualified Reporting.Render.Type.Localizer as L\n\n\n\n-- ALLOWED ORIGINS\n\n\nallowedOrigins :: [String]\nallowedOrigins =\n  [ \"https://guide.elm-lang.org\"\n  , \"https://guide.elm-lang.jp\"\n  , \"http://localhost:8007\"\n  ]\n\n\n\n-- ENDPOINT\n\n\nendpoint :: A.Artifacts -> Snap ()\nendpoint artifacts =\n  Cors.allow POST allowedOrigins $\n  do  body <- readRequestBody (64 * 1024)\n      case decodeBody body of\n        Just (state, entry) ->\n          serveOutcome (toOutcome artifacts state entry)\n\n        Nothing ->\n          do  modifyResponse $ setResponseStatus 400 \"Bad Request\"\n              modifyResponse $ setContentType \"text/html; charset=utf-8\"\n              writeBS \"Received unexpected JSON body.\"\n\n\n\n-- TO OUTCOME\n\n\ndata Outcome\n  = NewImport N.Name\n  | NewType N.Name\n  | NewWork B.Builder\n  --\n  | Skip\n  | Indent\n  | DefStart N.Name\n  --\n  | NoPorts\n  | InvalidCommand\n  | Failure BS.ByteString Error.Error\n\n\ntoOutcome :: A.Artifacts -> Repl.State -> String -> Outcome\ntoOutcome artifacts state entry =\n  case reverse (lines entry) of\n    [] ->\n      Skip\n\n    prev : rev ->\n      case Repl.categorize (Repl.Lines prev rev) of\n        Repl.Done input ->\n          case input of\n            Repl.Import name src -> compile artifacts state (ImportEntry name src)\n            Repl.Type name src   -> compile artifacts state (TypeEntry name src)\n            Repl.Decl name src   -> compile artifacts state (DeclEntry name src)\n            Repl.Expr src        -> compile artifacts state (ExprEntry src)\n            Repl.Port            -> NoPorts\n            Repl.Skip            -> Skip\n            Repl.Reset           -> InvalidCommand\n            Repl.Exit            -> InvalidCommand\n            Repl.Help _          -> InvalidCommand\n\n        Repl.Continue prefill ->\n          case prefill of\n            Repl.Indent        -> Indent\n            Repl.DefStart name -> DefStart name\n\n\n\n-- SERVE OUTCOME\n\n\nserveOutcome :: Outcome -> Snap ()\nserveOutcome outcome =\n  let\n    serveString = serveBuilder \"text/plain\"\n  in\n  case outcome of\n    NewImport name -> serveString $ \"add-import:\" <> N.toBuilder name\n    NewType name   -> serveString $ \"add-type:\" <> N.toBuilder name\n    NewWork js     -> serveBuilder \"application/javascript\" js\n    Skip           -> serveString $ \"skip\"\n    Indent         -> serveString $ \"indent\"\n    DefStart name  -> serveString $ \"def-start:\" <> N.toBuilder name\n    NoPorts        -> serveString $ \"no-ports\"\n    InvalidCommand -> serveString $ \"invalid-command\"\n    Failure source err ->\n      serveBuilder \"application/json\" $ Encode.encodeUgly $ Exit.toJson $\n        Help.compilerReport \"/\" (Error.Module N.replModule \"/repl\" File.zeroTime source err) []\n\n\nserveBuilder :: BS.ByteString -> B.Builder -> Snap ()\nserveBuilder mime builder =\n  do  modifyResponse (setContentType mime)\n      writeBuilder builder\n\n\n\n-- COMPILE\n\n\ndata EntryType\n  = ImportEntry N.Name BS.ByteString\n  | TypeEntry N.Name BS.ByteString\n  | DeclEntry N.Name BS.ByteString\n  | ExprEntry BS.ByteString\n\n\ncompile :: A.Artifacts -> Repl.State -> EntryType -> Outcome\ncompile (A.Artifacts interfaces objects) state@(Repl.State imports types decls) entryType =\n  let\n    source =\n      case entryType of\n        ImportEntry name src -> Repl.toByteString (state { Repl._imports = Map.insert name (B.byteString src) imports }) Repl.OutputNothing\n        TypeEntry   name src -> Repl.toByteString (state { Repl._types = Map.insert name (B.byteString src) types }) Repl.OutputNothing\n        DeclEntry   name src -> Repl.toByteString (state { Repl._decls = Map.insert name (B.byteString src) decls }) (Repl.OutputDecl name)\n        ExprEntry        src -> Repl.toByteString state (Repl.OutputExpr src)\n  in\n  case\n    do  modul <- mapLeft Error.BadSyntax $ Parse.fromByteString Parse.Application source\n        ifaces <- mapLeft Error.BadImports $ checkImports interfaces (Src._imports modul)\n        artifacts <- Compile.compile Pkg.dummyName ifaces modul\n        return ( modul, artifacts, objects )\n  of\n    Left err ->\n      Failure source err\n\n    Right info ->\n      case entryType of\n        ImportEntry name _ -> NewImport name\n        TypeEntry name _   -> NewType name\n        DeclEntry name _   -> NewWork (toJavaScript info (Just name))\n        ExprEntry _        -> NewWork (toJavaScript info Nothing)\n\n\ntoJavaScript :: (Src.Module, Compile.Artifacts, Opt.GlobalGraph) -> Maybe N.Name -> B.Builder\ntoJavaScript (modul, Compile.Artifacts canModule types locals, objects) maybeName =\n  let\n    localizer = L.fromModule modul\n    graph = Opt.addLocalGraph locals objects\n    home = Can._name canModule\n    tipe = types ! maybe N.replValueToPrint id maybeName\n  in\n  JS.generateForReplEndpoint localizer graph home maybeName tipe\n\n\nmapLeft :: (x -> y) -> Either x a -> Either y a\nmapLeft func result =\n  either (Left . func) Right result\n\n\ncheckImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)\ncheckImports interfaces imports =\n  let\n    importDict = Map.fromValues Src.getImportName imports\n    missing = Map.difference importDict interfaces\n  in\n  case Map.elems missing of\n    [] ->\n      Right (Map.intersection interfaces importDict)\n\n    i:is ->\n      let\n        unimported =\n          Map.keysSet (Map.difference interfaces importDict)\n\n        toError (Src.Import (A.At region name) _ _) =\n          Import.Error region name unimported Import.NotFound\n      in\n      Left (fmap toError (NE.List i is))\n\n\n\n-- DECODE BODY\n\n\ndecodeBody :: LBS.ByteString -> Maybe ( Repl.State, String )\ndecodeBody body =\n  Aeson.parseMaybe decodeBodyHelp =<< Aeson.decode' body\n\n\ndecodeBodyHelp :: Aeson.Object -> Aeson.Parser ( Repl.State, String )\ndecodeBodyHelp obj =\n  let\n    get key =\n      do  dict <- obj .: key\n          let f (k,v) = (N.fromChars k, B.stringUtf8 v)\n          return $ Map.fromList $ map f $ Map.toList dict\n  in\n  do  imports <- get \"imports\"\n      types   <- get \"types\"\n      decls   <- get \"decls\"\n      entry   <- obj .: \"entry\"\n      return ( Repl.State imports types decls, entry )\n"
  },
  {
    "path": "worker/src/Endpoint/Slack.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Endpoint.Slack\n  ( endpoint\n  )\n  where\n\n\nimport Control.Monad.IO.Class (liftIO)\nimport Network.HTTP.Client\nimport Snap.Core\n\nimport qualified Cors\n\nimport qualified Data.ByteString.Char8 as BSC\nimport qualified Data.Map as Map\n\n\n\n-- Send invitations to the Elm Slack to whoever asks.\n--\n-- NOTE: The API to invite users is not officially documented, but the people\n-- here looked in the Network tab of Developer Tools to figure it out:\n--\n--   https://levels.io/slack-typeform-auto-invite-sign-ups/\n--   https://github.com/outsideris/slack-invite-automation\n--\n\n\n\n-- ALLOWED ORIGINS\n\n\nallowedOrigins :: [String]\nallowedOrigins =\n  [ \"https://elm-lang.org\"\n  ]\n\n\n\n-- ENDPOINT\n\n\nendpoint :: String -> Manager -> Snap ()\nendpoint token manager =\n  Cors.allow POST allowedOrigins $\n    do  req <- getRequest\n        case Map.findWithDefault [] \"email\" (rqQueryParams req) of\n          [email] ->\n            do  response <- liftIO $ httpLbs (request email) manager\n                modifyResponse $ setContentType \"application/json\"\n                writeLBS (responseBody response)\n\n          _ ->\n            do  modifyResponse $ setResponseStatus 400 \"Bad Request\"\n                modifyResponse $ setContentType \"text/html; charset=utf-8\"\n                writeBS \"expecting query parameter like ?email=you@example.com\"\n  where\n    slack_token =\n      BSC.pack token\n\n    request email =\n      urlEncodedBody\n        [ (\"email\", email)\n        , (\"token\", slack_token)\n        , (\"set_active\",\"true\")\n        ]\n        (parseRequest_ \"https://elmlang.slack.com/api/users.admin.invite\")\n"
  },
  {
    "path": "worker/src/Errors.elm",
    "content": "port module Errors exposing (main)\n\n\nimport Browser\nimport Char\nimport Html exposing (..)\nimport Html.Attributes exposing (..)\nimport Html.Events exposing (onClick)\nimport String\nimport Json.Decode as D\nimport Elm.Error as Error\n\n\n\n-- PORTS\n\n\nport jumpTo : Error.Region -> Cmd msg\n\n\n\n-- MAIN\n\n\nmain =\n  Browser.document\n    { init = \\flags -> (D.decodeValue Error.decoder flags, Cmd.none)\n    , update = \\region result -> (result, jumpTo region)\n    , view = view\n    , subscriptions = \\_ -> Sub.none\n    }\n\n\ntype alias Msg = Error.Region\n\n\n\n-- VIEW\n\n\nview : Result D.Error Error.Error -> Browser.Document Msg\nview result =\n  { title = \"Problem!\"\n  , body =\n      case result of\n        Err err ->\n          [ text (D.errorToString err) ]\n\n        Ok error ->\n          [ viewError error ]\n  }\n\n\nviewError : Error.Error -> Html Msg\nviewError error =\n  div\n    [ style \"width\" \"calc(100% - 4em)\"\n    , style \"min-height\" \"calc(100% - 4em)\"\n    , style \"font-family\" \"monospace\"\n    , style \"white-space\" \"pre-wrap\"\n    , style \"background-color\" \"black\"\n    , style \"color\" \"rgb(233,235,235)\"\n    , style \"padding\" \"2em\"\n    ]\n    (viewErrorHelp error)\n\n\nviewErrorHelp : Error.Error -> List (Html Msg)\nviewErrorHelp error =\n  case error of\n    Error.GeneralProblem { title, message } ->\n      viewHeader title Nothing :: viewMessage message\n\n    Error.ModuleProblems badModules ->\n      viewBadModules badModules\n\n\n\n-- VIEW HEADER\n\n\nviewHeader : String -> Maybe Error.Region -> Html Msg\nviewHeader title maybeRegion =\n  case maybeRegion of\n    Nothing ->\n      span [ style \"color\" \"rgb(51,187,200)\" ]\n        [ text <| \"-- \" ++ title ++ \" \"\n        , text <| String.repeat (76 - String.length title) \"-\"\n        , text <| \"\\n\\n\"\n        ]\n\n    Just region ->\n      span [ style \"color\" \"rgb(51,187,200)\" ]\n        [ text <| \"-- \" ++ title ++ \" \"\n        , text <| String.repeat (60 - String.length title) \"-\"\n        , text \" \"\n        , span\n            [ style \"cursor\" \"pointer\"\n            , style \"text-decoration\" \"underline\"\n            , onClick region\n            ]\n            [ text \"Jump To Problem\"\n            ]\n        , text <| \"\\n\\n\"\n        ]\n\n\n\n-- VIEW BAD MODULES\n\n\nviewBadModules : List Error.BadModule -> List (Html Msg)\nviewBadModules badModules =\n  case badModules of\n    [] ->\n      []\n\n    [badModule] ->\n      [viewBadModule badModule]\n\n    a :: b :: cs ->\n      viewBadModule a :: viewSeparator a.name b.name :: viewBadModules (b :: cs)\n\n\nviewBadModule : Error.BadModule -> Html Msg\nviewBadModule { problems } =\n  span [] (List.map viewProblem problems)\n\n\nviewProblem : Error.Problem -> Html Msg\nviewProblem problem =\n  span [] (viewHeader problem.title (Just problem.region) :: viewMessage problem.message)\n\n\nviewSeparator : String -> String -> Html msg\nviewSeparator before after =\n  span [ style \"color\" \"rgb(211,56,211)\" ]\n    [ text <|\n        String.padLeft 80 ' ' (before ++ \"  ↑    \") ++ \"\\n\" ++\n        \"====o======================================================================o====\\n\" ++\n        \"    ↓  \" ++ after ++ \"\\n\\n\\n\"\n    ]\n\n\n\n-- VIEW MESSAGE\n\n\nviewMessage : List Error.Chunk -> List (Html msg)\nviewMessage chunks =\n  case chunks of\n    [] ->\n      [ text \"\\n\\n\\n\" ]\n\n    chunk :: others ->\n      let\n        htmlChunk =\n          case chunk of\n            Error.Unstyled string ->\n              text string\n\n            Error.Styled style string ->\n              span (styleToAttrs style) [ text string ]\n      in\n      htmlChunk :: viewMessage others\n\n\nstyleToAttrs : Error.Style -> List (Attribute msg)\nstyleToAttrs { bold, underline, color } =\n  addBold bold <| addUnderline underline <| addColor color []\n\n\naddBold : Bool -> List (Attribute msg) -> List (Attribute msg)\naddBold bool attrs =\n  if bool then\n    style \"font-weight\" \"bold\" :: attrs\n  else\n    attrs\n\n\naddUnderline : Bool -> List (Attribute msg) -> List (Attribute msg)\naddUnderline bool attrs =\n  if bool then\n    style \"text-decoration\" \"underline\" :: attrs\n  else\n    attrs\n\n\naddColor : Maybe Error.Color -> List (Attribute msg) -> List (Attribute msg)\naddColor maybeColor attrs =\n  case maybeColor of\n    Nothing ->\n      attrs\n\n    Just color ->\n      style \"color\" (colorToCss color) :: attrs\n\n\ncolorToCss : Error.Color -> String\ncolorToCss color =\n  case color of\n    Error.Red -> \"rgb(194,54,33)\"\n    Error.RED -> \"rgb(252,57,31)\"\n    Error.Magenta -> \"rgb(211,56,211)\"\n    Error.MAGENTA -> \"rgb(249,53,248)\"\n    Error.Yellow -> \"rgb(173,173,39)\"\n    Error.YELLOW -> \"rgb(234,236,35)\"\n    Error.Green -> \"rgb(37,188,36)\"\n    Error.GREEN -> \"rgb(49,231,34)\"\n    Error.Cyan -> \"rgb(51,187,200)\"\n    Error.CYAN -> \"rgb(20,240,240)\"\n    Error.Blue -> \"rgb(73,46,225)\"\n    Error.BLUE -> \"rgb(88,51,255)\"\n    Error.White -> \"rgb(203,204,205)\"\n    Error.WHITE -> \"rgb(233,235,235)\"\n    Error.Black -> \"rgb(0,0,0)\"\n    Error.BLACK -> \"rgb(129,131,131)\"\n"
  },
  {
    "path": "worker/src/Main.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\nmodule Main\n  ( main\n  )\n  where\n\n\nimport Control.Monad (msum)\nimport qualified Data.ByteString as BS\nimport Network.HTTP.Client.TLS (newTlsManager)\nimport Snap.Core\nimport Snap.Http.Server\nimport qualified System.Environment as Env\n\nimport qualified Artifacts\nimport qualified Cors\nimport qualified Endpoint.Compile as Compile\nimport qualified Endpoint.Quotes as Quotes\nimport qualified Endpoint.Repl as Repl\nimport qualified Endpoint.Slack as Slack\n\n\n\n-- RUN THE DEV SERVER\n\n\nmain :: IO ()\nmain =\n  withArgs $ \\root ->\n  do  manager    <- newTlsManager\n      slackToken <- Env.getEnv \"SLACK_TOKEN\"\n      rArtifacts <- Artifacts.loadRepl root\n      cArtifacts <- Artifacts.loadCompile root\n      errorJS    <- Compile.loadErrorJS root\n      let depsInfo = Artifacts.toDepsInfo cArtifacts\n\n      httpServe config $ msum $\n        [ ifTop $ status\n        , path \"repl\" $ Repl.endpoint rArtifacts\n        , path \"compile\" $ Compile.endpoint_V1 cArtifacts\n        , path \"compile/v2\" $ Compile.endpoint_V2 cArtifacts\n        , path \"compile/errors.js\" $ serveJavaScript errorJS\n        , path \"compile/deps-info.json\" $ serveDepsInfo depsInfo\n        , path \"quotes\" $ Quotes.endpoint\n        , path \"slack-invite\" $ Slack.endpoint slackToken manager\n        , notFound\n        ]\n\n\nconfig :: Config Snap a\nconfig =\n  setPort 8000 $\n  setAccessLog ConfigNoLog $\n  setErrorLog ConfigNoLog $\n    defaultConfig\n\n\nwithArgs :: (Artifacts.Root -> IO r) -> IO r\nwithArgs cont =\n  do  args <- Env.getArgs\n      case args of\n        [rootPath] -> cont (Artifacts.Root rootPath)\n        _          -> error \"expecting one argument, the path to the artifacts directory\"\n\n\nstatus :: Snap ()\nstatus =\n  do  modifyResponse $ setContentType \"text/plain\"\n      writeBuilder \"Status: OK\"\n\n\nnotFound :: Snap ()\nnotFound =\n  do  modifyResponse $ setResponseStatus 404 \"Not Found\"\n      modifyResponse $ setContentType \"text/html; charset=utf-8\"\n      writeBuilder \"Not Found\"\n\n\nserveJavaScript :: BS.ByteString -> Snap ()\nserveJavaScript javascript =\n  do  modifyResponse $ setContentType \"application/javascript\"\n      writeBS javascript\n\n\nserveDepsInfo :: BS.ByteString -> Snap ()\nserveDepsInfo json =\n  Cors.allow GET [\"https://elm-lang.org\"] $\n    do  modifyResponse $ setContentType \"application/json\"\n        writeBS json\n\n"
  }
]