├── installers ├── npm │ ├── .gitignore │ ├── .npmignore │ ├── install.js │ ├── package.json │ ├── PUBLISHING.md │ ├── bin │ │ └── elm │ ├── README.md │ ├── download.js │ └── troubleshooting.md ├── mac │ ├── helper-scripts │ │ ├── elm-startup.sh │ │ └── uninstall.sh │ ├── postinstall │ ├── preinstall │ ├── Resources │ │ └── en.lproj │ │ │ ├── welcome.rtf │ │ │ └── conclusion.rtf │ ├── Distribution.xml │ ├── make-installer.sh │ └── README.md ├── win │ ├── logo.ico │ ├── welcome.bmp │ ├── inst.dat │ ├── uninst.dat │ ├── CreateInternetShortcut.nsh │ ├── make_installer.cmd │ ├── updatepath.vbs │ ├── removefrompath.vbs │ └── README.md ├── linux │ ├── Dockerfile │ └── README.md └── README.md ├── cabal.config ├── ContributorAgreement.pdf ├── .gitignore ├── .github ├── ISSUE_TEMPLATE.md ├── PULL_REQUEST_TEMPLATE.md ├── workflows │ ├── set-issue-expectations.yml │ └── set-pull-expectations.yml └── CONTRIBUTING.md ├── compiler └── src │ ├── Elm │ ├── Magnitude.hs │ ├── Float.hs │ ├── Compiler │ │ ├── Imports.hs │ │ └── Type.hs │ ├── String.hs │ └── Version.hs │ ├── Reporting │ ├── Report.hs │ ├── Suggest.hs │ ├── Annotation.hs │ ├── Result.hs │ ├── Render │ │ └── Type │ │ │ └── Localizer.hs │ ├── Warning.hs │ └── Error │ │ └── Main.hs │ ├── Data │ ├── Map │ │ └── Utils.hs │ ├── NonEmptyList.hs │ ├── Bag.hs │ ├── OneOrMore.hs │ └── Index.hs │ ├── AST │ ├── Utils │ │ ├── Binop.hs │ │ ├── Shader.hs │ │ └── Type.hs │ └── Source.hs │ ├── Generate │ ├── Html.hs │ ├── Mode.hs │ └── JavaScript │ │ └── Functions.hs │ ├── Type │ ├── Instantiate.hs │ ├── Occurs.hs │ └── UnionFind.hs │ ├── Parse │ └── Symbol.hs │ ├── Compile.hs │ ├── Nitpick │ └── Debug.hs │ ├── Canonicalize │ ├── Environment │ │ └── Dups.hs │ └── Type.hs │ ├── Json │ └── String.hs │ └── Optimize │ ├── Case.hs │ └── Names.hs ├── worker ├── outlines │ ├── repl │ │ └── elm.json │ └── compile │ │ └── elm.json ├── nginx.conf ├── elm.json └── src │ ├── Cors.hs │ ├── Main.hs │ └── Artifacts.hs ├── .travis.yml ├── hints ├── tuples.md ├── repl.md ├── infinite-type.md ├── type-annotations.md ├── optimize.md ├── port-modules.md ├── implicit-casts.md ├── shadowing.md ├── comparing-records.md ├── comparing-custom-types.md ├── init.md ├── missing-patterns.md └── recursive-alias.md ├── LICENSE ├── terminal ├── impl │ └── Terminal │ │ ├── Internal.hs │ │ └── Helpers.hs └── src │ └── Main.hs ├── docs ├── elm.json │ ├── application.md │ └── package.md └── upgrade-instructions │ └── 0.19.1.md └── README.md /installers/npm/.gitignore: -------------------------------------------------------------------------------- 1 | node_modules/ 2 | -------------------------------------------------------------------------------- /cabal.config: -------------------------------------------------------------------------------- 1 | profiling: False 2 | library-profiling: True 3 | -------------------------------------------------------------------------------- /installers/npm/.npmignore: -------------------------------------------------------------------------------- 1 | README.md 2 | .gitignore 3 | .git 4 | -------------------------------------------------------------------------------- /ContributorAgreement.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sebsheep/elm2node/HEAD/ContributorAgreement.pdf -------------------------------------------------------------------------------- /installers/mac/helper-scripts/elm-startup.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | open 'http://guide.elm-lang.org' 4 | -------------------------------------------------------------------------------- /installers/win/logo.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sebsheep/elm2node/HEAD/installers/win/logo.ico -------------------------------------------------------------------------------- /installers/mac/postinstall: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -ex 4 | 5 | echo "$(date)" > /tmp/elm-installer.log 6 | -------------------------------------------------------------------------------- /installers/win/welcome.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sebsheep/elm2node/HEAD/installers/win/welcome.bmp -------------------------------------------------------------------------------- /installers/npm/install.js: -------------------------------------------------------------------------------- 1 | 2 | var download = require('./download.js'); 3 | 4 | download(function() {}); 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff 2 | dist 3 | cabal-dev 4 | .cabal-sandbox/ 5 | cabal.sandbox.config 6 | .DS_Store 7 | *~ 8 | travis.log 9 | -------------------------------------------------------------------------------- /installers/win/inst.dat: -------------------------------------------------------------------------------- 1 | SetOutPath "$INSTDIR\bin" 2 | File "${FILES_SOURCE_PATH}\bin\elm.exe" 3 | 4 | SetOutPath "$INSTDIR" 5 | File "updatepath.vbs" 6 | File "removefrompath.vbs" 7 | -------------------------------------------------------------------------------- /installers/win/uninst.dat: -------------------------------------------------------------------------------- 1 | Delete "$INSTDIR\bin\elm.exe" 2 | RmDir "$INSTDIR\bin" 3 | 4 | Delete "$INSTDIR\updatepath.vbs" 5 | Delete "$INSTDIR\removefrompath.vbs" 6 | RmDir "$INSTDIR" 7 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | 2 | **Quick Summary:** ??? 3 | 4 | 5 | ## SSCCE 6 | 7 | ```elm 8 | 9 | ``` 10 | 11 | - **Elm:** ??? 12 | - **Browser:** ??? 13 | - **Operating System:** ??? 14 | 15 | 16 | ## Additional Details 17 | 18 | ??? -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | 2 | **Quick Summary:** ??? 3 | 4 | 5 | ## SSCCE 6 | 7 | ```elm 8 | 9 | ``` 10 | 11 | - **Elm:** ??? 12 | - **Browser:** ??? 13 | - **Operating System:** ??? 14 | 15 | 16 | ## Additional Details 17 | 18 | ??? 19 | -------------------------------------------------------------------------------- /installers/win/CreateInternetShortcut.nsh: -------------------------------------------------------------------------------- 1 | !macro CreateInternetShortcut FILENAME URL ICONFILE ICONINDEX 2 | WriteINIStr "${FILENAME}.url" "InternetShortcut" "URL" "${URL}" 3 | WriteINIStr "${FILENAME}.url" "InternetShortcut" "IconFile" "${ICONFILE}" 4 | WriteINIStr "${FILENAME}.url" "InternetShortcut" "IconIndex" "${ICONINDEX}" 5 | !macroend -------------------------------------------------------------------------------- /compiler/src/Elm/Magnitude.hs: -------------------------------------------------------------------------------- 1 | module Elm.Magnitude 2 | ( Magnitude(..) 3 | , toChars 4 | ) 5 | where 6 | 7 | 8 | 9 | -- MAGNITUDE 10 | 11 | 12 | data Magnitude 13 | = PATCH 14 | | MINOR 15 | | MAJOR 16 | deriving (Eq, Ord) 17 | 18 | 19 | toChars :: Magnitude -> String 20 | toChars magnitude = 21 | case magnitude of 22 | PATCH -> "PATCH" 23 | MINOR -> "MINOR" 24 | MAJOR -> "MAJOR" 25 | -------------------------------------------------------------------------------- /installers/mac/preinstall: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | installdir=/usr/local/bin 6 | 7 | for bin in elm elm-compiler elm-package elm-reactor elm-repl 8 | do 9 | if [ -f $installdir/$bin ]; then 10 | sudo rm -f $installdir/$bin 11 | fi 12 | if [ -f $installdir/$bin-unwrapped ]; then 13 | sudo rm -f $installdir/$bin-unwrapped 14 | fi 15 | done 16 | 17 | sharedir=/usr/local/share/elm 18 | sudo rm -rf $sharedir 19 | -------------------------------------------------------------------------------- /compiler/src/Reporting/Report.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Reporting.Report 3 | ( Report(..) 4 | ) 5 | where 6 | 7 | 8 | import qualified Reporting.Annotation as A 9 | import qualified Reporting.Doc as D 10 | 11 | 12 | 13 | -- BUILD REPORTS 14 | 15 | 16 | data Report = 17 | Report 18 | { _title :: String 19 | , _region :: A.Region 20 | , _sgstns :: [String] 21 | , _message :: D.Doc 22 | } 23 | -------------------------------------------------------------------------------- /installers/win/make_installer.cmd: -------------------------------------------------------------------------------- 1 | 2 | set version=%1 3 | 4 | mkdir files 5 | mkdir files\bin 6 | 7 | xcopy ..\..\dist\build\elm\elm.exe files\bin /s /e 8 | xcopy updatepath.vbs files 9 | 10 | if EXIST "%ProgramFiles%\NSIS" ( 11 | set nsis="%ProgramFiles%\NSIS\makensis.exe" 12 | ) else ( 13 | set nsis="%ProgramFiles(x86)%\NSIS\makensis.exe" 14 | ) 15 | 16 | %nsis% /DPLATFORM_VERSION=%version% Nsisfile.nsi 17 | 18 | rd /s /q files 19 | -------------------------------------------------------------------------------- /worker/outlines/repl/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "../../src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/core": "1.0.2" 10 | }, 11 | "indirect": { 12 | "elm/json": "1.1.3" 13 | } 14 | }, 15 | "test-dependencies": { 16 | "direct": {}, 17 | "indirect": {} 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /installers/win/updatepath.vbs: -------------------------------------------------------------------------------- 1 | Set WshShell = CreateObject("WScript.Shell") 2 | elmPath = WScript.Arguments(0) 3 | 'const PathRegKey = "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\Path" 4 | const PathRegKey = "HKCU\Environment\Path" 5 | 6 | on error resume next 7 | path = WshShell.RegRead(PathRegKey) 8 | if err.number <> 0 then 9 | path = "" 10 | end if 11 | on error goto 0 12 | 13 | newPath = elmPath & ";" & path 14 | Call WshShell.RegWrite(PathRegKey, newPath, "REG_EXPAND_SZ") 15 | -------------------------------------------------------------------------------- /installers/mac/helper-scripts/uninstall.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | echo "Warning: You are about to remove all Elm executables!" 6 | 7 | installdir=/usr/local/bin 8 | 9 | for bin in elm elm-compiler elm-get elm-reactor elm-repl elm-doc elm-server elm-package elm-make 10 | do 11 | if [ -f $installdir/$bin ]; then 12 | sudo rm -f $installdir/$bin 13 | fi 14 | if [ -f $installdir/$bin-unwrapped ]; then 15 | sudo rm -f $installdir/$bin-unwrapped 16 | fi 17 | 18 | done 19 | 20 | sharedir=/usr/local/share/elm 21 | sudo rm -rf $sharedir 22 | -------------------------------------------------------------------------------- /installers/mac/Resources/en.lproj/welcome.rtf: -------------------------------------------------------------------------------- 1 | {\rtf1\ansi\ansicpg1252\cocoartf2509 2 | \cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;} 3 | {\colortbl;\red255\green255\blue255;} 4 | {\*\expandedcolortbl;;} 5 | \paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0 6 | \pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural\partightenfactor0 7 | 8 | \f0\fs28 \cf0 Thank you for trying out Elm!\ 9 | \ 10 | This installer makes 11 | \f1 elm 12 | \f0 available in your terminal.} -------------------------------------------------------------------------------- /worker/nginx.conf: -------------------------------------------------------------------------------- 1 | server { 2 | listen 80; 3 | server_name worker.elm-lang.org; 4 | 5 | location / { 6 | proxy_pass http://localhost:8000; 7 | } 8 | } 9 | 10 | server { 11 | listen 443 ssl; 12 | server_name worker.elm-lang.org; 13 | 14 | location / { 15 | proxy_pass http://localhost:8000; 16 | } 17 | 18 | ssl_certificate /etc/letsencrypt/live/worker.elm-lang.org/fullchain.pem; # managed by Certbot 19 | ssl_certificate_key /etc/letsencrypt/live/worker.elm-lang.org/privkey.pem; # managed by Certbot 20 | include /etc/letsencrypt/options-ssl-nginx.conf; 21 | ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem; 22 | } 23 | -------------------------------------------------------------------------------- /worker/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/browser": "1.0.1", 10 | "elm/core": "1.0.2", 11 | "elm/html": "1.0.0", 12 | "elm/json": "1.1.3", 13 | "elm/project-metadata-utils": "1.0.0" 14 | }, 15 | "indirect": { 16 | "elm/parser": "1.1.0", 17 | "elm/time": "1.0.0", 18 | "elm/url": "1.0.0", 19 | "elm/virtual-dom": "1.0.2" 20 | } 21 | }, 22 | "test-dependencies": { 23 | "direct": {}, 24 | "indirect": {} 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /installers/mac/Resources/en.lproj/conclusion.rtf: -------------------------------------------------------------------------------- 1 | {\rtf1\ansi\ansicpg1252\cocoartf2509 2 | \cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;} 3 | {\colortbl;\red255\green255\blue255;} 4 | {\*\expandedcolortbl;;} 5 | \paperw11900\paperh16840\margl1440\margr1440\vieww11180\viewh8400\viewkind0 6 | \pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200\tx7920\tx8640\pardirnatural\partightenfactor0 7 | 8 | \f0\fs28 \cf0 Try opening the terminal and running commands like:\ 9 | \ 10 | 11 | \f1 elm init\ 12 | elm make src/Main.elm --optimize\ 13 | elm repl 14 | \f0 \ 15 | \ 16 | Check out {\field{\*\fldinst{HYPERLINK "https://guide.elm-lang.org/"}}{\fldrslt this tutorial}} for more advice!} -------------------------------------------------------------------------------- /installers/win/removefrompath.vbs: -------------------------------------------------------------------------------- 1 | Set WshShell = CreateObject("WScript.Shell") 2 | ' Make sure there is no trailing slash at the end of elmBasePath 3 | elmBasePath = WScript.Arguments(0) 4 | 'const PathRegKey = "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\Path" 5 | const PathRegKey = "HKCU\Environment\Path" 6 | 7 | on error resume next 8 | path = WshShell.RegRead(PathRegKey) 9 | if err.number = 0 then 10 | Set regEx = New RegExp 11 | elmBasePath = Replace(Replace(Replace(elmBasePath, "\", "\\"), "(", "\("), ")", "\)") 12 | regEx.Pattern = elmBasePath & "\\\d+\.\d+(\.\d+|)\\bin(;|)" 13 | regEx.Global = True 14 | newPath = regEx.Replace(path, "") 15 | Call WshShell.RegWrite(PathRegKey, newPath, "REG_EXPAND_SZ") 16 | end if 17 | on error goto 0 18 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: minimal 2 | services: docker 3 | 4 | env: 5 | global: 6 | - LINUX_ARCHIVE=binary-for-linux-64-bit.gz 7 | 8 | before_install: 9 | - docker build -t elm -f installers/linux/Dockerfile . 10 | - docker cp $(docker create elm):/usr/local/bin/elm . 11 | - gzip -9 -c elm > $LINUX_ARCHIVE 12 | 13 | deploy: 14 | provider: releases 15 | api_key: 16 | secure: Yz2Lo4u9rZQ7Ee7ohAsrZpkqsYDUerCSMdSQIH8ryrf7phHhiloPEkTKsM+NupHqU/LEAVsunxbau4QrCEjA2vPavAPVk8cKomRUWK/YjbXHKa24hPkal2c+A2bnMQ6w3qYk/PjL9rW+Goq++/SNLcYZwHBV0Chl2blivMwWCSA= 17 | file: $LINUX_ARCHIVE 18 | skip_cleanup: true 19 | on: 20 | branch: master 21 | tags: true 22 | 23 | notifications: 24 | email: 25 | recipients: 26 | - rlefevre@dmy.fr 27 | on_success: change 28 | on_failure: change 29 | -------------------------------------------------------------------------------- /installers/win/README.md: -------------------------------------------------------------------------------- 1 | # Installing on Windows 2 | 3 | The installer for Windows is available [here](https://guide.elm-lang.org/install.html). 4 | 5 | 6 |
7 | 8 | ## Uninstall 9 | 10 | First run the `C:\Program Files (x86)\Elm\0.19\uninstall.exe` file. This will remove Elm stuff from your `PATH`. 11 | 12 | Then remove the whole `C:\Users\\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! 13 | 14 |
15 | 16 | ## Building the Windows installer 17 | 18 | You will need the [NSIS installer](http://nsis.sourceforge.net/Download) to be installed. 19 | 20 | Once everything is installed, run something like this command: 21 | 22 | make_installer.cmd 0.19.0 23 | 24 | It will build an installer called `Elm-0.19.0-setup.exe`. 25 | -------------------------------------------------------------------------------- /compiler/src/Elm/Float.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wall #-} 2 | {-# LANGUAGE EmptyDataDecls, FlexibleInstances #-} 3 | module Elm.Float 4 | ( Float 5 | , fromPtr 6 | , toBuilder 7 | ) 8 | where 9 | 10 | 11 | import Prelude hiding (Float) 12 | import Data.Binary (Binary, get, put) 13 | import qualified Data.ByteString.Builder as B 14 | import qualified Data.Utf8 as Utf8 15 | import Data.Word (Word8) 16 | import Foreign.Ptr (Ptr) 17 | 18 | 19 | 20 | -- FLOATS 21 | 22 | 23 | type Float = 24 | Utf8.Utf8 ELM_FLOAT 25 | 26 | 27 | data ELM_FLOAT 28 | 29 | 30 | 31 | -- HELPERS 32 | 33 | 34 | fromPtr :: Ptr Word8 -> Ptr Word8 -> Float 35 | fromPtr = 36 | Utf8.fromPtr 37 | 38 | 39 | {-# INLINE toBuilder #-} 40 | toBuilder :: Float -> B.Builder 41 | toBuilder = 42 | Utf8.toBuilder 43 | 44 | 45 | 46 | -- BINARY 47 | 48 | 49 | instance Binary (Utf8.Utf8 ELM_FLOAT) where 50 | get = Utf8.getUnder256 51 | put = Utf8.putUnder256 52 | -------------------------------------------------------------------------------- /worker/outlines/compile/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "../../src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/browser": "1.0.1", 10 | "elm/core": "1.0.2", 11 | "elm/file": "1.0.5", 12 | "elm/html": "1.0.0", 13 | "elm/http": "2.0.0", 14 | "elm/json": "1.1.3", 15 | "elm/random": "1.0.0", 16 | "elm/svg": "1.0.1", 17 | "elm/time": "1.0.0", 18 | "elm-explorations/linear-algebra": "1.0.3", 19 | "elm-explorations/webgl": "1.1.0", 20 | "evancz/elm-playground": "1.0.2" 21 | }, 22 | "indirect": { 23 | "elm/bytes": "1.0.8", 24 | "elm/url": "1.0.0", 25 | "elm/virtual-dom": "1.0.2" 26 | } 27 | }, 28 | "test-dependencies": { 29 | "direct": {}, 30 | "indirect": {} 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /compiler/src/Data/Map/Utils.hs: -------------------------------------------------------------------------------- 1 | module Data.Map.Utils 2 | ( fromKeys 3 | , fromKeysA 4 | , fromValues 5 | , any 6 | ) 7 | where 8 | 9 | 10 | import Prelude hiding (any) 11 | import qualified Data.Map as Map 12 | import Data.Map.Internal (Map(..)) 13 | 14 | 15 | 16 | -- FROM KEYS 17 | 18 | 19 | fromKeys :: (Ord k) => (k -> v) -> [k] -> Map.Map k v 20 | fromKeys toValue keys = 21 | Map.fromList $ map (\k -> (k, toValue k)) keys 22 | 23 | 24 | fromKeysA :: (Applicative f, Ord k) => (k -> f v) -> [k] -> f (Map.Map k v) 25 | fromKeysA toValue keys = 26 | Map.fromList <$> traverse (\k -> (,) k <$> toValue k) keys 27 | 28 | 29 | fromValues :: (Ord k) => (v -> k) -> [v] -> Map.Map k v 30 | fromValues toKey values = 31 | Map.fromList $ map (\v -> (toKey v, v)) values 32 | 33 | 34 | 35 | -- ANY 36 | 37 | 38 | {-# INLINE any #-} 39 | any :: (v -> Bool) -> Map.Map k v -> Bool 40 | any isGood = go 41 | where 42 | go Tip = False 43 | go (Bin _ _ v l r) = isGood v || go l || go r 44 | -------------------------------------------------------------------------------- /.github/workflows/set-issue-expectations.yml: -------------------------------------------------------------------------------- 1 | name: Set Issue Expectations 2 | on: 3 | issues: 4 | types: [opened] 5 | jobs: 6 | comment-on-issue: 7 | name: Comment On Issue 8 | runs-on: ubuntu-latest 9 | steps: 10 | - uses: actions/github@v1.0.0 11 | env: 12 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 13 | with: 14 | args: | 15 | comment "Thanks for reporting this! To set expectations: 16 | 17 | - Issues are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response. 18 | - Ask questions a [community forum](https://elm-lang.org/community). You will get an answer quicker that way! 19 | - If you experience something similar, open a new issue. [We like duplicates](https://github.com/elm/expectations/blob/master/duplicates.md). 20 | 21 | Finally, please be patient with the core team. They are trying their best with limited resources." 22 | -------------------------------------------------------------------------------- /hints/tuples.md: -------------------------------------------------------------------------------- 1 | 2 | # From Tuples to Records 3 | 4 | The largest tuple possible in Elm has three entries. Once you get to four, it is best to make a record with named entries. 5 | 6 | For 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: 7 | 8 | ```elm 9 | type alias Rectangle = 10 | { x : Float 11 | , y : Float 12 | , width : Float 13 | , height : Float 14 | } 15 | ``` 16 | 17 | Now 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! 18 | 19 | Anyway, 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! 20 | -------------------------------------------------------------------------------- /compiler/src/AST/Utils/Binop.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wall #-} 2 | module AST.Utils.Binop 3 | ( Precedence(..) 4 | , Associativity(..) 5 | ) 6 | where 7 | 8 | 9 | import Prelude hiding (Either(..)) 10 | import Control.Monad (liftM) 11 | import Data.Binary 12 | 13 | 14 | 15 | -- BINOP STUFF 16 | 17 | 18 | newtype Precedence = Precedence Int 19 | deriving (Eq, Ord) 20 | 21 | 22 | data Associativity 23 | = Left 24 | | Non 25 | | Right 26 | deriving (Eq) 27 | 28 | 29 | 30 | -- BINARY 31 | 32 | 33 | instance Binary Precedence where 34 | get = 35 | liftM Precedence get 36 | 37 | put (Precedence n) = 38 | put n 39 | 40 | 41 | instance Binary Associativity where 42 | get = 43 | do n <- getWord8 44 | case n of 45 | 0 -> return Left 46 | 1 -> return Non 47 | 2 -> return Right 48 | _ -> fail "Error reading valid associativity from serialized string" 49 | 50 | put assoc = 51 | putWord8 $ 52 | case assoc of 53 | Left -> 0 54 | Non -> 1 55 | Right -> 2 56 | -------------------------------------------------------------------------------- /installers/npm/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "elm", 3 | "version": "0.19.1-3", 4 | "description": "Installer for Elm: just downloads the binary into node_modules", 5 | "preferGlobal": true, 6 | "license": "BSD-3-Clause", 7 | "repository": { 8 | "type": "git", 9 | "url": "https://github.com/elm/compiler.git" 10 | }, 11 | "homepage": "https://github.com/elm/compiler/tree/master/installers/npm", 12 | "bugs": "https://github.com/elm/compiler/issues", 13 | "author": { 14 | "name": "Evan Czaplicki", 15 | "email": "evan@elm-lang.org", 16 | "url": "https://github.com/evancz" 17 | }, 18 | "engines": { 19 | "node": ">=7.0.0" 20 | }, 21 | "scripts": { 22 | "install": "node install.js" 23 | }, 24 | "files": [ 25 | "install.js", 26 | "download.js", 27 | "bin", 28 | "bin/elm" 29 | ], 30 | "keywords": [ 31 | "bin", 32 | "binary", 33 | "binaries", 34 | "elm", 35 | "install", 36 | "installer" 37 | ], 38 | "bin": { "elm": "bin/elm" }, 39 | "dependencies": { 40 | "request": "^2.88.0" 41 | } 42 | } 43 | -------------------------------------------------------------------------------- /compiler/src/Reporting/Suggest.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wall #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | module Reporting.Suggest 4 | ( distance 5 | , sort 6 | , rank 7 | ) 8 | where 9 | 10 | 11 | import qualified Data.Char as Char 12 | import qualified Data.List as List 13 | import qualified Text.EditDistance as Dist 14 | 15 | 16 | 17 | -- DISTANCE 18 | 19 | 20 | distance :: String -> String -> Int 21 | distance x y = 22 | Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y 23 | 24 | 25 | 26 | -- SORT 27 | 28 | 29 | sort :: String -> (a -> String) -> [a] -> [a] 30 | sort target toString values = 31 | List.sortOn (distance (toLower target) . toLower . toString) values 32 | 33 | 34 | toLower :: String -> String 35 | toLower string = 36 | map Char.toLower string 37 | 38 | 39 | 40 | -- RANK 41 | 42 | 43 | rank :: String -> (a -> String) -> [a] -> [(Int,a)] 44 | rank target toString values = 45 | let 46 | toRank v = 47 | distance (toLower target) (toLower (toString v)) 48 | 49 | addRank v = 50 | (toRank v, v) 51 | in 52 | List.sortOn fst (map addRank values) 53 | -------------------------------------------------------------------------------- /.github/workflows/set-pull-expectations.yml: -------------------------------------------------------------------------------- 1 | name: Set Pull Expectations 2 | on: 3 | pull_request: 4 | types: [opened] 5 | jobs: 6 | comment-on-pull: 7 | name: Comment On Pull 8 | runs-on: ubuntu-latest 9 | steps: 10 | - uses: actions/github@v1.0.0 11 | env: 12 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 13 | with: 14 | args: | 15 | comment "Thanks for suggesting these code changes. To set expectations: 16 | 17 | - 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. 18 | - 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). 19 | - 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. 20 | 21 | Finally, please be patient with the core team. They are trying their best with limited resources." 22 | -------------------------------------------------------------------------------- /compiler/src/Generate/Html.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | module Generate.Html 4 | ( sandwich 5 | ) 6 | where 7 | 8 | 9 | import qualified Data.ByteString.Builder as B 10 | import Data.Monoid ((<>)) 11 | import qualified Data.Name as Name 12 | import Text.RawString.QQ (r) 13 | 14 | 15 | 16 | -- SANDWICH 17 | 18 | 19 | sandwich :: Name.Name -> B.Builder -> B.Builder 20 | sandwich moduleName javascript = 21 | let name = Name.toBuilder moduleName in 22 | [r| 23 | 24 | 25 | 26 | |] <> name <> [r| 27 | 28 | 29 | 30 | 31 | 32 | 

33 | 
34 | 
52 | 
53 | 
54 | |]
55 | 


--------------------------------------------------------------------------------
/installers/linux/Dockerfile:
--------------------------------------------------------------------------------
 1 | # Based initially on https://gist.github.com/rlefevre/1523f47e75310e28eee243c9c5651ac9
 2 | #
 3 | # Build Linux x64 binary from elm compiler top-level directory:
 4 | # $ docker build -t elm -f installers/linux/Dockerfile .
 5 | #
 6 | # Retrieve elm Linux binary:
 7 | # $ docker cp $(docker create elm):/usr/local/bin/elm DESTINATION_DIRECTORY
 8 | #
 9 | # Delete docker elm image:
10 | # $ docker rmi elm
11 | #
12 | # Display all images:
13 | # $ docker images -a
14 | #
15 | # Delete all unused docker images:
16 | # $ docker system prune -a
17 | 
18 | # Use Alpine 3.11 with GHC 8.6.5
19 | FROM alpine:3.11
20 | 
21 | # Install packages required to build elm
22 | RUN apk add --no-cache ghc cabal wget musl-dev zlib-dev zlib-static ncurses-dev ncurses-static
23 | 
24 | WORKDIR /elm
25 | 
26 | # Import source code
27 | COPY builder builder
28 | COPY compiler compiler
29 | COPY reactor reactor
30 | COPY terminal terminal
31 | COPY cabal.config elm.cabal LICENSE ./
32 | 
33 | # Build statically linked elm binary
34 | RUN cabal new-update
35 | RUN cabal new-build --ghc-option=-optl=-static --ghc-option=-split-sections
36 | RUN cp ./dist-newstyle/build/x86_64-linux/ghc-*/elm-*/x/elm/build/elm/elm /usr/local/bin/elm
37 | 
38 | # Remove debug symbols to optimize the binary size
39 | RUN strip -s /usr/local/bin/elm
40 | 


--------------------------------------------------------------------------------
/worker/src/Cors.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wall #-}
 2 | module Cors
 3 |   ( allow
 4 |   )
 5 |   where
 6 | 
 7 | 
 8 | import qualified Data.HashSet as HashSet
 9 | import Network.URI (parseURI)
10 | import Snap.Core (Snap, Method, method)
11 | import Snap.Util.CORS (CORSOptions(..), HashableMethod(..), OriginList(Origins), applyCORS, mkOriginSet)
12 | 
13 | 
14 | 
15 | -- ALLOW
16 | 
17 | 
18 | allow :: Method -> [String] -> Snap () -> Snap ()
19 | allow method_ origins snap =
20 |   applyCORS (toOptions method_ origins) $ method method_ $
21 |     snap
22 | 
23 | 
24 | 
25 | -- TO OPTIONS
26 | 
27 | 
28 | toOptions :: (Monad m) => Method -> [String] -> CORSOptions m
29 | toOptions method_ origins =
30 |   let
31 |     allowedOrigins = toOriginList origins
32 |     allowedMethods = HashSet.singleton (HashableMethod method_)
33 |   in
34 |   CORSOptions
35 |     { corsAllowOrigin = return allowedOrigins
36 |     , corsAllowCredentials = return True
37 |     , corsExposeHeaders = return HashSet.empty
38 |     , corsAllowedMethods = return allowedMethods
39 |     , corsAllowedHeaders = return
40 |     }
41 | 
42 | 
43 | toOriginList :: [String] -> OriginList
44 | toOriginList origins =
45 |   Origins $ mkOriginSet $
46 |     case traverse parseURI origins of
47 |       Just uris -> uris
48 |       Nothing -> error "invalid entry given to toOriginList list"
49 | 


--------------------------------------------------------------------------------
/installers/mac/Distribution.xml:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 |     Elm
 4 |     
 5 |     
 6 |     
 7 |     
21 |     
24 |     
25 |     
26 |     
27 |         
28 |     
29 |     
30 |         
31 |     
32 |     binaries.pkg
33 | 
34 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | Copyright 2012-present Evan Czaplicki
 2 | 
 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
 4 | 
 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
 6 | 
 7 | 2. 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.
 8 | 
 9 | 3. 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.
10 | 
11 | THIS 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.
12 | 


--------------------------------------------------------------------------------
/installers/README.md:
--------------------------------------------------------------------------------
 1 | # Installing Elm
 2 | 
 3 | The 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).
 4 | 
 5 | 
 6 | 

 7 | 
 8 | ## Installing Multiple Versions
 9 | 
10 | The 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!
11 | 
12 | The 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.)
13 | 
14 | [mac]: https://github.com/elm/compiler/blob/master/installers/mac/README.md
15 | [lin]: https://github.com/elm/compiler/blob/master/installers/linux/README.md
16 | 
17 | 

18 | 
19 | ## Installing Previous Versions
20 | 
21 | The past binaries for Mac, Linux, and Windows are hosted [here](https://github.com/elm/compiler/releases).
22 | 
23 | You can download the executable files directly and use them locally.
24 | 
25 | 
26 | 

27 | 
28 | ## Uninstall
29 | 
30 | - [Mac](https://github.com/elm/compiler/blob/master/installers/mac/README.md#uninstall)
31 | - [Linux](https://github.com/elm/compiler/blob/master/installers/linux/README.md#uninstall)
32 | - [Windows](https://github.com/elm/compiler/blob/master/installers/win/README.md#uninstall)
33 | 


--------------------------------------------------------------------------------
/compiler/src/Generate/Mode.hs:
--------------------------------------------------------------------------------
 1 | module Generate.Mode
 2 |   ( Mode(..)
 3 |   , isDebug
 4 |   , ShortFieldNames
 5 |   , shortenFieldNames
 6 |   )
 7 |   where
 8 | 
 9 | 
10 | import qualified Data.List as List
11 | import qualified Data.Map as Map
12 | import qualified Data.Maybe as Maybe
13 | import qualified Data.Name as Name
14 | 
15 | import qualified AST.Optimized as Opt
16 | import qualified Elm.Compiler.Type.Extract as Extract
17 | import qualified Generate.JavaScript.Name as JsName
18 | 
19 | 
20 | 
21 | -- MODE
22 | 
23 | 
24 | data Mode
25 |   = Dev (Maybe Extract.Types)
26 |   | Prod ShortFieldNames
27 | 
28 | 
29 | isDebug :: Mode -> Bool
30 | isDebug mode =
31 |   case mode of
32 |     Dev mi -> Maybe.isJust mi
33 |     Prod _ -> False
34 | 
35 | 
36 | 
37 | -- SHORTEN FIELD NAMES
38 | 
39 | 
40 | type ShortFieldNames =
41 |   Map.Map Name.Name JsName.Name
42 | 
43 | 
44 | shortenFieldNames :: Opt.GlobalGraph -> ShortFieldNames
45 | shortenFieldNames (Opt.GlobalGraph _ frequencies) =
46 |   Map.foldr addToShortNames Map.empty $
47 |     Map.foldrWithKey addToBuckets Map.empty frequencies
48 | 
49 | 
50 | addToBuckets :: Name.Name -> Int -> Map.Map Int [Name.Name] -> Map.Map Int [Name.Name]
51 | addToBuckets field frequency buckets =
52 |   Map.insertWith (++) frequency [field] buckets
53 | 
54 | 
55 | addToShortNames :: [Name.Name] -> ShortFieldNames -> ShortFieldNames
56 | addToShortNames fields shortNames =
57 |   List.foldl' addField shortNames fields
58 | 
59 | 
60 | addField :: ShortFieldNames -> Name.Name -> ShortFieldNames
61 | addField shortNames field =
62 |   let rename = JsName.fromInt (Map.size shortNames) in
63 |   Map.insert field rename shortNames
64 | 


--------------------------------------------------------------------------------
/compiler/src/Data/NonEmptyList.hs:
--------------------------------------------------------------------------------
 1 | module Data.NonEmptyList
 2 |   ( List(..)
 3 |   , singleton
 4 |   , toList
 5 |   , sortBy
 6 |   )
 7 |   where
 8 | 
 9 | 
10 | import Control.Monad (liftM2)
11 | import Data.Binary (Binary, get, put)
12 | import qualified Data.List as List
13 | 
14 | 
15 | 
16 | -- LIST
17 | 
18 | 
19 | data List a =
20 |   List a [a]
21 | 
22 | 
23 | singleton :: a -> List a
24 | singleton a =
25 |   List a []
26 | 
27 | 
28 | toList :: List a -> [a]
29 | toList (List x xs) =
30 |   x:xs
31 | 
32 | 
33 | 
34 | -- INSTANCES
35 | 
36 | instance Show a => Show (List a) where
37 |   show (List x xs) =  show (x:xs)
38 | 
39 | instance Functor List where
40 |   fmap func (List x xs) = List (func x) (map func xs)
41 | 
42 | 
43 | instance Traversable List where
44 |   traverse func (List x xs) = List <$> func x <*> traverse func xs
45 | 
46 | 
47 | instance Foldable List where
48 |   foldr step state (List x xs) = step x (foldr step state xs)
49 |   foldl step state (List x xs) = foldl step (step state x) xs
50 |   foldl1 step      (List x xs) = foldl step x xs
51 | 
52 | 
53 | 
54 | -- SORT BY
55 | 
56 | 
57 | sortBy :: (Ord b) => (a -> b) -> List a -> List a
58 | sortBy toRank (List x xs) =
59 |   let
60 |     comparison a b =
61 |       compare (toRank a) (toRank b)
62 |   in
63 |   case List.sortBy comparison xs of
64 |     [] ->
65 |       List x []
66 | 
67 |     y:ys ->
68 |       case comparison x y of
69 |         LT -> List x (y:ys)
70 |         EQ -> List x (y:ys)
71 |         GT -> List y (List.insertBy comparison x ys)
72 | 
73 | 
74 | 
75 | -- BINARY
76 | 
77 | 
78 | instance (Binary a) => Binary (List a) where
79 |   put (List x xs) = put x >> put xs
80 |   get = liftM2 List get get
81 | 


--------------------------------------------------------------------------------
/installers/npm/PUBLISHING.md:
--------------------------------------------------------------------------------
 1 | # Publishing
 2 | 
 3 | Here's how to update the `npm` installer.
 4 | 
 5 | 
 6 | ## 1. GitHub Release
 7 | 
 8 | Create a [GitHub Release](https://github.com/elm/compiler/releases) with the following files:
 9 | 
10 | 1. `binary-for-mac-64-bit.gz`
11 | 2. `binary-for-windows-64-bit.gz`
12 | 3. `binary-for-linux-64-bit.gz`
13 | 
14 | Create each of these by running the `elm` executable for each platform through `gzip elm`.
15 | 
16 | 
17 | ## 2. Try a beta release
18 | 
19 | In `package.json`, bump the version to `"0.19.2-beta"`.
20 | 
21 | ```bash
22 | npm publish --tag beta
23 | ```
24 | 
25 | To test that it works, run these commands:
26 | 
27 | ```bash
28 | npm dist-tags ls elm
29 | npm install elm@beta --ignore-scripts
30 | ```
31 | 
32 | The `latest` tag should not be changed, and there should be an additional `beta` tag.
33 | 
34 | Try this on Windows, Linux, and Mac.
35 | 
36 | 
37 | ## 3. Publish final release
38 | 
39 | Remove the `-beta` suffix from the version in `package.json`. Then run:
40 | 
41 | ```bash
42 | npm publish
43 | ```
44 | 
45 | 
46 | ## 4. Tag the `latest-0.19.1` version
47 | 
48 | Many compiler releases have needed multiple `npm` publications. Maybe something does not work on Windows or some dependency becomes insecure. Normal `npm` problems.
49 | 
50 | The convention for each Elm release is to create a tag the latest one.
51 | 
52 | ```bash
53 | npm dist-tag add elm@0.19.1-3 latest-0.19.1
54 | ```
55 | 
56 | That 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.
57 | 
58 | You can read more about dist-tags [here](https://docs.npmjs.com/cli/dist-tag).
59 | 
60 | 


--------------------------------------------------------------------------------
/hints/repl.md:
--------------------------------------------------------------------------------
 1 | 
 2 | # REPL
 3 | 
 4 | The REPL lets you interact with Elm values and functions in your terminal.
 5 | 
 6 | 
 7 | ## Use
 8 | 
 9 | You can type in expressions, definitions, custom types, and module imports using normal Elm syntax.
10 | 
11 | ```elm
12 | > 1 + 1
13 | 2 : number
14 | 
15 | > "hello" ++ "world"
16 | "helloworld" : String
17 | ```
18 | 
19 | The same can be done with definitions and custom types:
20 | 
21 | ```elm
22 | > fortyTwo = 42
23 | 42 : number
24 | 
25 | > increment n = n + 1
26 |  : number -> number
27 | 
28 | > increment 41
29 | 42 : number
30 | 
31 | > factorial n =
32 | |   if n < 1 then
33 | |     1
34 | |   else
35 | |     n * factorial (n-1)
36 | |
37 |  : number -> number
38 | 
39 | > factorial 5
40 | 120 : number
41 | 
42 | > type User
43 | |   = Regular String
44 | |   | Visitor String
45 | |
46 | 
47 | > case Regular "Tom" of
48 | |   Regular name -> "Hey again!"
49 | |   Visitor name -> "Nice to meet you!"
50 | |
51 | "Hey again!" : String
52 | ```
53 | 
54 | When 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:
55 | 
56 | ```elm
57 | > import Html exposing (Html)
58 | 
59 | > Html.text "hello"
60 |  : Html msg
61 | 
62 | > Html.text
63 |  : String -> Html msg
64 | ```
65 | 
66 | If 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.
67 | 
68 | 
69 | ## Exit
70 | 
71 | To exit the REPL, you can type `:exit`.
72 | 
73 | You can also press `ctrl-d` or `ctrl-c` on some platforms.
74 | 


--------------------------------------------------------------------------------
/compiler/src/AST/Utils/Shader.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wall #-}
 2 | {-# LANGUAGE EmptyDataDecls #-}
 3 | module AST.Utils.Shader
 4 |   ( Source
 5 |   , Types(..)
 6 |   , Type(..)
 7 |   , fromChars
 8 |   , toJsStringBuilder
 9 |   )
10 |   where
11 | 
12 | 
13 | import Control.Monad (liftM)
14 | import Data.Binary (Binary, get, put)
15 | import qualified Data.ByteString as BS
16 | import qualified Data.ByteString.Builder as B
17 | import qualified Data.ByteString.UTF8 as BS_UTF8
18 | import qualified Data.Map as Map
19 | import qualified Data.Name as Name
20 | 
21 | 
22 | 
23 | -- SOURCE
24 | 
25 | 
26 | newtype Source =
27 |   Source BS.ByteString
28 | 
29 | 
30 | 
31 | -- TYPES
32 | 
33 | 
34 | data Types =
35 |   Types
36 |     { _attribute :: Map.Map Name.Name Type
37 |     , _uniform :: Map.Map Name.Name Type
38 |     , _varying :: Map.Map Name.Name Type
39 |     }
40 | 
41 | 
42 | data Type
43 |   = Int
44 |   | Float
45 |   | V2
46 |   | V3
47 |   | V4
48 |   | M4
49 |   | Texture
50 | 
51 | 
52 | 
53 | -- TO BUILDER
54 | 
55 | 
56 | toJsStringBuilder :: Source -> B.Builder
57 | toJsStringBuilder (Source src) =
58 |   B.byteString src
59 | 
60 | 
61 | 
62 | -- FROM CHARS
63 | 
64 | 
65 | fromChars :: [Char] -> Source
66 | fromChars chars =
67 |   Source (BS_UTF8.fromString (escape chars))
68 | 
69 | 
70 | escape :: [Char] -> [Char]
71 | escape chars =
72 |   case chars of
73 |     [] ->
74 |       []
75 | 
76 |     c:cs
77 |       | c == '\r' -> escape cs
78 |       | c == '\n' -> '\\' : 'n'  : escape cs
79 |       | c == '\"' -> '\\' : '"'  : escape cs
80 |       | c == '\'' -> '\\' : '\'' : escape cs
81 |       | c == '\\' -> '\\' : '\\' : escape cs
82 |       | otherwise -> c : escape cs
83 | 
84 | 
85 | 
86 | -- BINARY
87 | 
88 | 
89 | instance Binary Source where
90 |   get = liftM Source get
91 |   put (Source a) = put a
92 | 


--------------------------------------------------------------------------------
/.github/CONTRIBUTING.md:
--------------------------------------------------------------------------------
 1 | # Contributing to Elm
 2 | 
 3 | Thanks helping with the development of Elm! This document describes the basic
 4 | standards for opening pull requests and making the review process as smooth as
 5 | possible.
 6 | 
 7 | ## Licensing
 8 | 
 9 | You need to sign the [contributor agreement](ContributorAgreement.pdf)
10 | and send it to  before opening your pull request.
11 | 
12 | ## Style Guide
13 | 
14 |   * Haskell — conform to [these guidelines][haskell]
15 |   * JavaScript — use [Google's JS style guide][js]
16 | 
17 | [haskell]: https://gist.github.com/evancz/0a1f3717c92fe71702be
18 | [js]: https://google.github.io/styleguide/javascriptguide.xml
19 | 
20 | ## Branches
21 | 
22 |   * [The master branch][master] is the home of the next release of the compiler
23 |     so new features and improvements get merged there. Most pull requests
24 |     should target this branch!
25 | 
26 |   * [The stable branch][stable] is for tagging releases and critical bug fixes.
27 |     This branch is handy for folks who want to build the most recent public
28 |     release from source.
29 | 
30 | [master]: http://github.com/elm-lang/elm/tree/master
31 | [stable]: http://github.com/elm-lang/elm/tree/stable
32 | 
33 | If you are working on a fairly large feature, we will probably want to merge it
34 | in as its own branch and do some testing before bringing it into the master
35 | branch. This way we can keep releases of the master branch independent of new
36 | features.
37 | 
38 | Note that the master branch of the compiler should always be in sync with the
39 | master branch of the [website][], and the stable branch of the compiler should
40 | always be in sync with the stable branch of the [website][]. Make sure that
41 | your changes maintain this compatibility.
42 | 
43 | [website]: https://github.com/elm-lang/elm-lang.org
44 | 


--------------------------------------------------------------------------------
/compiler/src/Elm/Compiler/Imports.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wall #-}
 2 | {-# LANGUAGE OverloadedStrings #-}
 3 | module Elm.Compiler.Imports
 4 |   ( defaults
 5 |   )
 6 |   where
 7 | 
 8 | 
 9 | import qualified Data.Name as Name
10 | 
11 | import qualified AST.Source as Src
12 | import qualified Elm.ModuleName as ModuleName
13 | import qualified Reporting.Annotation as A
14 | 
15 | 
16 | 
17 | -- DEFAULTS
18 | 
19 | 
20 | defaults :: [Src.Import]
21 | defaults =
22 |   [ import_ ModuleName.basics Nothing Src.Open
23 |   , import_ ModuleName.debug Nothing closed
24 |   , import_ ModuleName.list Nothing (operator "::")
25 |   , import_ ModuleName.maybe Nothing (typeOpen Name.maybe)
26 |   , import_ ModuleName.result Nothing (typeOpen Name.result)
27 |   , import_ ModuleName.string Nothing (typeClosed Name.string)
28 |   , import_ ModuleName.char Nothing (typeClosed Name.char)
29 |   , import_ ModuleName.tuple Nothing closed
30 |   , import_ ModuleName.platform Nothing (typeClosed Name.program)
31 |   , import_ ModuleName.cmd (Just Name.cmd) (typeClosed Name.cmd)
32 |   , import_ ModuleName.sub (Just Name.sub) (typeClosed Name.sub)
33 |   ]
34 | 
35 | 
36 | import_ :: ModuleName.Canonical -> Maybe Name.Name -> Src.Exposing -> Src.Import
37 | import_ (ModuleName.Canonical _ name) maybeAlias exposing =
38 |   Src.Import (A.At A.zero name) maybeAlias exposing
39 | 
40 | 
41 | 
42 | -- EXPOSING
43 | 
44 | 
45 | closed :: Src.Exposing
46 | closed =
47 |   Src.Explicit []
48 | 
49 | 
50 | typeOpen :: Name.Name -> Src.Exposing
51 | typeOpen name =
52 |   Src.Explicit [ Src.Upper (A.At A.zero name) (Src.Public A.zero) ]
53 | 
54 | 
55 | typeClosed :: Name.Name -> Src.Exposing
56 | typeClosed name =
57 |   Src.Explicit [ Src.Upper (A.At A.zero name) Src.Private ]
58 | 
59 | 
60 | operator :: Name.Name -> Src.Exposing
61 | operator op =
62 |   Src.Explicit [ Src.Operator A.zero op ]
63 | 


--------------------------------------------------------------------------------
/compiler/src/Data/Bag.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | module Data.Bag
  3 |   ( Bag(..)
  4 |   , empty
  5 |   , one
  6 |   , append
  7 |   , map
  8 |   , toList
  9 |   , fromList
 10 |   )
 11 |   where
 12 | 
 13 | 
 14 | import Prelude hiding (map)
 15 | import qualified Data.List as List
 16 | 
 17 | 
 18 | 
 19 | -- BAGS
 20 | 
 21 | 
 22 | data Bag a
 23 |   = Empty
 24 |   | One a
 25 |   | Two (Bag a) (Bag a)
 26 | 
 27 | 
 28 | 
 29 | -- HELPERS
 30 | 
 31 | 
 32 | empty :: Bag a
 33 | empty =
 34 |   Empty
 35 | 
 36 | 
 37 | one :: a -> Bag a
 38 | one =
 39 |   One
 40 | 
 41 | 
 42 | append :: Bag a -> Bag a -> Bag a
 43 | append left right =
 44 |   case (left, right) of
 45 |     (other, Empty) ->
 46 |       other
 47 | 
 48 |     (Empty, other) ->
 49 |       other
 50 | 
 51 |     (_, _) ->
 52 |       Two left right
 53 | 
 54 | 
 55 | 
 56 | -- MAP
 57 | 
 58 | 
 59 | map :: (a -> b) -> Bag a -> Bag b
 60 | map func bag =
 61 |   case bag of
 62 |     Empty ->
 63 |       Empty
 64 | 
 65 |     One a ->
 66 |       One (func a)
 67 | 
 68 |     Two left right ->
 69 |       Two (map func left) (map func right)
 70 | 
 71 | 
 72 | 
 73 | -- TO LIST
 74 | 
 75 | 
 76 | toList :: Bag a -> [a]
 77 | toList bag =
 78 |   toListHelp bag []
 79 | 
 80 | 
 81 | toListHelp :: Bag a -> [a] -> [a]
 82 | toListHelp bag list =
 83 |   case bag of
 84 |     Empty ->
 85 |       list
 86 | 
 87 |     One x ->
 88 |       x : list
 89 | 
 90 |     Two a b ->
 91 |       toListHelp a (toListHelp b list)
 92 | 
 93 | 
 94 | 
 95 | -- FROM LIST
 96 | 
 97 | 
 98 | fromList :: (a -> b) -> [a] -> Bag b
 99 | fromList func list =
100 |   case list of
101 |     [] ->
102 |       Empty
103 | 
104 |     first : rest ->
105 |       List.foldl' (add func) (One (func first)) rest
106 | 
107 | 
108 | add :: (a -> b) -> Bag b -> a -> Bag b
109 | add func bag value =
110 |   Two (One (func value)) bag
111 | 


--------------------------------------------------------------------------------
/installers/mac/make-installer.sh:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | # Run the following command to create an installer:
 3 | #
 4 | #     bash make-installer.sh
 5 | #
 6 | 
 7 | 
 8 | 
 9 | #### SETUP ####
10 | 
11 | set -e
12 | 
13 | # Create directory structure for new pkgs
14 | pkg_root=$(mktemp -d -t package-artifacts)
15 | pkg_binaries=$pkg_root
16 | pkg_scripts=$pkg_root/Scripts
17 | 
18 | mkdir -p $pkg_binaries
19 | mkdir -p $pkg_scripts
20 | 
21 | usr_binaries=/usr/local/bin
22 | 
23 | 
24 | #### BUILD ASSETS ####
25 | 
26 | cp ../../dist/build/elm/elm $pkg_binaries/elm
27 | 
28 | cp $(pwd)/preinstall $pkg_scripts
29 | cp $(pwd)/postinstall $pkg_scripts
30 | 
31 | pkgbuild \
32 |     --sign "Developer ID Installer: " \
33 |     --identifier org.elm-lang.binary \
34 |     --install-location $usr_binaries \
35 |     --scripts $pkg_scripts \
36 |     --filter 'Scripts.*' \
37 |     --root $pkg_root \
38 |     binaries.pkg
39 | 
40 | 
41 | #### BUNDLE ASSETS ####
42 | 
43 | rm -f installer-for-mac.pkg
44 | 
45 | productbuild \
46 |     --sign "Developer ID Installer: " \
47 |     --identifier org.elm-lang.installer \
48 |     --distribution Distribution.xml \
49 |     --package-path . \
50 |     --resources Resources \
51 |     installer-for-mac.pkg
52 | 
53 | 
54 | #### CLEAN UP ####
55 | 
56 | rm binaries.pkg
57 | rm -rf $pkg_root
58 | 
59 | 
60 | #### BEGIN NOTARIZATION ####
61 | 
62 | xcrun altool \
63 |     --notarize-app \
64 |     --primary-bundle-id "org.elm-lang.installer" \
65 |     --username "" \
66 |     --password "@keychain:Developer-altool" \
67 |     --file "installer-for-mac.pkg"
68 | 
69 | # From https://scriptingosx.com/2019/09/notarize-a-command-line-tool/
70 | #
71 | #### Check on notarization:
72 | #
73 | # xcrun altool \
74 | #     --notarization-info "" \
75 | #     --username "" \
76 | #     --password "@keychain:Developer-altool"
77 | #
78 | #
79 | #### Staple Notarization:
80 | #
81 | # xcrun stapler staple installer-for-mac.pkg
82 | 


--------------------------------------------------------------------------------
/compiler/src/Data/OneOrMore.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | module Data.OneOrMore
  3 |   ( OneOrMore(..)
  4 |   , one
  5 |   , more
  6 |   , map
  7 |   , destruct
  8 |   , getFirstTwo
  9 |   )
 10 |   where
 11 | 
 12 | 
 13 | import Prelude hiding (map)
 14 | 
 15 | 
 16 | 
 17 | -- ONE OR MORE
 18 | 
 19 | 
 20 | data OneOrMore a
 21 |   = One a
 22 |   | More (OneOrMore a) (OneOrMore a)
 23 | 
 24 | 
 25 | one :: a -> OneOrMore a
 26 | one =
 27 |   One
 28 | 
 29 | 
 30 | more :: OneOrMore a -> OneOrMore a -> OneOrMore a
 31 | more =
 32 |   More
 33 | 
 34 | 
 35 | 
 36 | -- MAP
 37 | 
 38 | 
 39 | map :: (a -> b) -> OneOrMore a -> OneOrMore b
 40 | map func oneOrMore =
 41 |   case oneOrMore of
 42 |     One value ->
 43 |       One (func value)
 44 | 
 45 |     More left right ->
 46 |       More (map func left) (map func right)
 47 | 
 48 | 
 49 | 
 50 | -- DESTRUCT
 51 | 
 52 | 
 53 | destruct :: (a -> [a] -> b) -> OneOrMore a -> b
 54 | destruct func oneOrMore =
 55 |   destructLeft func oneOrMore []
 56 | 
 57 | 
 58 | destructLeft :: (a -> [a] -> b) -> OneOrMore a -> [a] -> b
 59 | destructLeft func oneOrMore xs =
 60 |   case oneOrMore of
 61 |     One x ->
 62 |       func x xs
 63 | 
 64 |     More a b ->
 65 |       destructLeft func a (destructRight b xs)
 66 | 
 67 | 
 68 | destructRight :: OneOrMore a -> [a] -> [a]
 69 | destructRight oneOrMore xs =
 70 |   case oneOrMore of
 71 |     One x ->
 72 |       x : xs
 73 | 
 74 |     More a b ->
 75 |       destructRight a (destructRight b xs)
 76 | 
 77 | 
 78 | 
 79 | -- GET FIRST TWO
 80 | 
 81 | 
 82 | getFirstTwo :: OneOrMore a -> OneOrMore a -> (a,a)
 83 | getFirstTwo left right =
 84 |   case left of
 85 |     One x ->
 86 |       (x, getFirstOne right)
 87 | 
 88 |     More lleft lright ->
 89 |       getFirstTwo lleft lright
 90 | 
 91 | 
 92 | getFirstOne :: OneOrMore a -> a
 93 | getFirstOne oneOrMore =
 94 |   case oneOrMore of
 95 |     One x ->
 96 |       x
 97 | 
 98 |     More left _ ->
 99 |       getFirstOne left
100 | 


--------------------------------------------------------------------------------
/compiler/src/Type/Instantiate.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wall #-}
 2 | {-# LANGUAGE OverloadedStrings #-}
 3 | module Type.Instantiate
 4 |   ( FreeVars
 5 |   , fromSrcType
 6 |   )
 7 |   where
 8 | 
 9 | 
10 | import qualified Data.Map.Strict as Map
11 | import Data.Map.Strict ((!))
12 | import qualified Data.Name as Name
13 | 
14 | import qualified AST.Canonical as Can
15 | import Type.Type
16 | 
17 | 
18 | 
19 | -- FREE VARS
20 | 
21 | 
22 | type FreeVars =
23 |   Map.Map Name.Name Type
24 | 
25 | 
26 | 
27 | -- FROM SOURCE TYPE
28 | 
29 | 
30 | fromSrcType :: Map.Map Name.Name Type -> Can.Type -> IO Type
31 | fromSrcType freeVars sourceType =
32 |   case sourceType of
33 |     Can.TLambda arg result ->
34 |       FunN
35 |         <$> fromSrcType freeVars arg
36 |         <*> fromSrcType freeVars result
37 | 
38 |     Can.TVar name ->
39 |       return (freeVars ! name)
40 | 
41 |     Can.TType home name args ->
42 |       AppN home name <$> traverse (fromSrcType freeVars) args
43 | 
44 |     Can.TAlias home name args aliasedType ->
45 |       do  targs <- traverse (traverse (fromSrcType freeVars)) args
46 |           AliasN home name targs <$>
47 |             case aliasedType of
48 |               Can.Filled realType ->
49 |                 fromSrcType freeVars realType
50 | 
51 |               Can.Holey realType ->
52 |                 fromSrcType (Map.fromList targs) realType
53 | 
54 |     Can.TTuple a b maybeC ->
55 |       TupleN
56 |         <$> fromSrcType freeVars a
57 |         <*> fromSrcType freeVars b
58 |         <*> traverse (fromSrcType freeVars) maybeC
59 | 
60 |     Can.TUnit ->
61 |       return UnitN
62 | 
63 |     Can.TRecord fields maybeExt ->
64 |       RecordN
65 |         <$> traverse (fromSrcFieldType freeVars) fields
66 |         <*>
67 |           case maybeExt of
68 |             Nothing ->
69 |               return EmptyRecordN
70 | 
71 |             Just ext ->
72 |               return (freeVars ! ext)
73 | 
74 | 
75 | fromSrcFieldType :: Map.Map Name.Name Type -> Can.FieldType -> IO Type
76 | fromSrcFieldType freeVars (Can.FieldType _ tipe) =
77 |   fromSrcType freeVars tipe
78 | 


--------------------------------------------------------------------------------
/terminal/impl/Terminal/Internal.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE GADTs #-}
 2 | module Terminal.Internal
 3 |   ( Command(..)
 4 |   , toName
 5 |   , Summary(..)
 6 |   , Flags(..)
 7 |   , Flag(..)
 8 |   , Parser(..)
 9 |   , Args(..)
10 |   , CompleteArgs(..)
11 |   , RequiredArgs(..)
12 |   )
13 |   where
14 | 
15 | 
16 | import Text.PrettyPrint.ANSI.Leijen (Doc)
17 | 
18 | 
19 | 
20 | -- COMMAND
21 | 
22 | 
23 | data Command where
24 |   Command
25 |     :: String
26 |     -> Summary
27 |     -> String
28 |     -> Doc
29 |     -> Args args
30 |     -> Flags flags
31 |     -> (args -> flags -> IO ())
32 |     -> Command
33 | 
34 | 
35 | toName :: Command -> String
36 | toName (Command name _ _ _ _ _ _) =
37 |   name
38 | 
39 | 
40 | 
41 | {-| The information that shows when you run the executable with no arguments.
42 | If you say it is `Common`, you need to tell people what it does. Try to keep
43 | it to two or three lines. If you say it is `Uncommon` you can rely on `Details`
44 | for a more complete explanation.
45 | -}
46 | data Summary = Common String | Uncommon
47 | 
48 | 
49 | 
50 | -- FLAGS
51 | 
52 | 
53 | data Flags a where
54 |   FDone :: a -> Flags a
55 |   FMore :: Flags (a -> b) -> Flag a -> Flags b
56 | 
57 | 
58 | data Flag a where
59 |   Flag :: String -> Parser a -> String -> Flag (Maybe a)
60 |   OnOff :: String -> String -> Flag Bool
61 | 
62 | 
63 | 
64 | -- PARSERS
65 | 
66 | 
67 | data Parser a =
68 |   Parser
69 |     { _singular :: String
70 |     , _plural :: String
71 |     , _parser :: String -> Maybe a
72 |     , _suggest :: String -> IO [String]
73 |     , _examples :: String -> IO [String]
74 |     }
75 | 
76 | 
77 | 
78 | -- ARGS
79 | 
80 | 
81 | newtype Args a =
82 |   Args [CompleteArgs a]
83 | 
84 | 
85 | data CompleteArgs args where
86 |   Exactly  :: RequiredArgs args -> CompleteArgs args
87 |   Multiple :: RequiredArgs ([a] -> args) -> Parser a -> CompleteArgs args
88 |   Optional :: RequiredArgs (Maybe a -> args) -> Parser a -> CompleteArgs args
89 | 
90 | 
91 | data RequiredArgs a where
92 |   Done :: a -> RequiredArgs a
93 |   Required :: RequiredArgs (a -> b) -> Parser a -> RequiredArgs b
94 | 


--------------------------------------------------------------------------------
/installers/npm/bin/elm:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env node
 2 | 
 3 | var child_process = require('child_process');
 4 | var path = require('path');
 5 | var fs = require('fs');
 6 | 
 7 | 
 8 | // Some npm users enable --ignore-scripts (a good security measure) so
 9 | // they do not run the post-install hook and install.js does not run.
10 | // Instead they will run this script.
11 | //
12 | // On Mac and Linux, we download the elm executable into the exact same
13 | // location as this file. Since npm uses symlinks on these platforms,
14 | // that means that the first run will invoke this file and subsequent
15 | // runs will call the elm binary directly.
16 | //
17 | // On Windows, we must download a file named elm.exe for it to run properly.
18 | // Instead of symlinks, npm creates two files:
19 | //
20 | //   - node_modules/.bin/elm (a bash file)
21 | //   - node_modules/.bin/elm.cmd (a batch file)
22 | //
23 | // Both files specifically invoke `node` to run the file listed at package.bin,
24 | // so there is no way around instantiating node for no reason on Windows. So
25 | // the existsSync check is needed so that it is not downloaded more than once.
26 | 
27 | 
28 | // figure out where to put the binary (calls path.resolve() to get path separators right on Windows)
29 | //
30 | var binaryPath = path.resolve(__dirname, 'elm') + (process.platform === 'win32' ? '.exe' : '');
31 | 
32 | // Run the command directly if possible, otherwise download and then run.
33 | // This check is important for Windows where this file will be run all the time.
34 | //
35 | if (process.platform === 'win32')
36 | {
37 | 	fs.existsSync(binaryPath)
38 | 		? runCommand()
39 | 		: require('../download.js')(runCommand);
40 | }
41 | else
42 | {
43 | 	require('../download.js')(runCommand);
44 | }
45 | 
46 | 
47 | function runCommand()
48 | {
49 | 	// Need double quotes and { shell: true } when there are spaces in the path on windows:
50 | 	// https://github.com/nodejs/node/issues/7367#issuecomment-229721296
51 | 	child_process
52 | 		.spawn('"' + binaryPath + '"', process.argv.slice(2), { stdio: 'inherit', shell: true })
53 | 		.on('exit', process.exit);
54 | }
55 | 


--------------------------------------------------------------------------------
/installers/npm/README.md:
--------------------------------------------------------------------------------
 1 | # Elm Installer
 2 | 
 3 | [Elm](https://elm-lang.org) is a functional programming language that compiles to JavaScript.
 4 | 
 5 | Head over to [The Official Guide](https://guide.elm-lang.org/) to start learning Elm!
 6 | 
 7 | 
 8 | 

 9 | 
10 | ## What is this package for?
11 | 
12 | **Normal installs** ❌
13 | 
14 | Use the instructions [here](https://guide.elm-lang.org/install/elm.html) instead.
15 | 
16 | **Multiple versions** ✅
17 | 
18 | People 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.
19 | 
20 | **Continuous integration** ⚠️
21 | 
22 | This works, but there are usually faster and more reliable options:
23 | 
24 | 1. You can download `elm` directly from GitHub with [this script](https://github.com/elm/compiler/blob/master/installers/linux/README.md). This is all the `npm` installer does, but with extra HTTP requests to `npmjs.com` servers, making it slower and adding more failure points.
25 | 2. Many continuous integration have ways to cache files ([example](https://docs.travis-ci.com/user/caching/)) to make builds faster and more reliable.
26 | 
27 | That said, it will definitely work to use the `npm` installer on CI if you prefer that option.
28 | 
29 | 
30 | 

31 | 
32 | ## Install Locally
33 | 
34 | The following command should download the latest Elm 0.19.1 binary:
35 | 
36 | ```
37 | npm install elm@latest-0.19.1
38 | ```
39 | 
40 | You 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.
41 | 
42 | Use `npm install elm@latest-0.19.0` or `npm install elm@latest-0.18.0` for earlier versions.
43 | 
44 | **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.
45 | 
46 | 


--------------------------------------------------------------------------------
/compiler/src/Reporting/Annotation.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | module Reporting.Annotation
  3 |   ( Located(..)
  4 |   , Position(..)
  5 |   , Region(..)
  6 |   , traverse
  7 |   , toValue
  8 |   , merge
  9 |   , at
 10 |   , toRegion
 11 |   , mergeRegions
 12 |   , zero
 13 |   , one
 14 |   )
 15 |   where
 16 | 
 17 | 
 18 | import Prelude hiding (traverse)
 19 | import Control.Monad (liftM2)
 20 | import Data.Binary (Binary, get, put)
 21 | import Data.Word (Word16)
 22 | 
 23 | 
 24 | 
 25 | -- LOCATED
 26 | 
 27 | 
 28 | data Located a =
 29 |   At Region a  -- PERF see if unpacking region is helpful
 30 | 
 31 | 
 32 | instance Functor Located where
 33 |   fmap f (At region a) =
 34 |     At region (f a)
 35 | 
 36 | 
 37 | traverse :: (Functor f) => (a -> f b) -> Located a -> f (Located b)
 38 | traverse func (At region value) =
 39 |   At region <$> func value
 40 | 
 41 | 
 42 | toValue :: Located a -> a
 43 | toValue (At _ value) =
 44 |   value
 45 | 
 46 | 
 47 | merge :: Located a -> Located b -> value -> Located value
 48 | merge (At r1 _) (At r2 _) value =
 49 |   At (mergeRegions r1 r2) value
 50 | 
 51 | 
 52 | 
 53 | -- POSITION
 54 | 
 55 | 
 56 | data Position =
 57 |   Position
 58 |     {-# UNPACK #-} !Word16
 59 |     {-# UNPACK #-} !Word16
 60 |   deriving (Eq)
 61 | 
 62 | 
 63 | at :: Position -> Position -> a -> Located a
 64 | at start end a =
 65 |   At (Region start end) a
 66 | 
 67 | 
 68 | 
 69 | -- REGION
 70 | 
 71 | 
 72 | data Region = Region Position Position
 73 |   deriving (Eq)
 74 | 
 75 | 
 76 | toRegion :: Located a -> Region
 77 | toRegion (At region _) =
 78 |   region
 79 | 
 80 | 
 81 | mergeRegions :: Region -> Region -> Region
 82 | mergeRegions (Region start _) (Region _ end) =
 83 |   Region start end
 84 | 
 85 | 
 86 | zero :: Region
 87 | zero =
 88 |   Region (Position 0 0) (Position 0 0)
 89 | 
 90 | 
 91 | one :: Region
 92 | one =
 93 |   Region (Position 1 1) (Position 1 1)
 94 | 
 95 | 
 96 | instance Binary Region where
 97 |   put (Region a b) = put a >> put b
 98 |   get = liftM2 Region get get
 99 | 
100 | 
101 | instance Binary Position where
102 |   put (Position a b) = put a >> put b
103 |   get = liftM2 Position get get
104 | 


--------------------------------------------------------------------------------
/compiler/src/Parse/Symbol.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wall #-}
 2 | {-# LANGUAGE BangPatterns, OverloadedStrings #-}
 3 | module Parse.Symbol
 4 |   ( operator
 5 |   , BadOperator(..)
 6 |   , binopCharSet
 7 |   )
 8 |   where
 9 | 
10 | 
11 | import qualified Data.Char as Char
12 | import qualified Data.IntSet as IntSet
13 | import qualified Data.Name as Name
14 | import qualified Data.Vector as Vector
15 | import Foreign.Ptr (Ptr, plusPtr, minusPtr)
16 | import GHC.Word (Word8)
17 | 
18 | import Parse.Primitives (Parser, Row, Col)
19 | import qualified Parse.Primitives as P
20 | 
21 | 
22 | 
23 | -- OPERATOR
24 | 
25 | 
26 | data BadOperator
27 |   = BadDot
28 |   | BadPipe
29 |   | BadArrow
30 |   | BadEquals
31 |   | BadHasType
32 | 
33 | 
34 | operator :: (Row -> Col -> x) -> (BadOperator -> Row -> Col -> x) -> Parser x Name.Name
35 | operator toExpectation toError =
36 |   P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->
37 |     let !newPos = chompOps pos end in
38 |     if pos == newPos then
39 |       eerr row col toExpectation
40 | 
41 |     else
42 |       case Name.fromPtr pos newPos of
43 |         "."  -> eerr row col (toError BadDot)
44 |         "|"  -> cerr row col (toError BadPipe)
45 |         "->" -> cerr row col (toError BadArrow)
46 |         "="  -> cerr row col (toError BadEquals)
47 |         ":"  -> cerr row col (toError BadHasType)
48 |         op   ->
49 |           let
50 |             !newCol = col + fromIntegral (minusPtr newPos pos)
51 |             !newState = P.State src newPos end indent row newCol
52 |           in
53 |           cok op newState
54 | 
55 | 
56 | chompOps :: Ptr Word8 -> Ptr Word8 -> Ptr Word8
57 | chompOps pos end =
58 |   if pos < end && isBinopCharHelp (P.unsafeIndex pos) then
59 |     chompOps (plusPtr pos 1) end
60 |   else
61 |     pos
62 | 
63 | 
64 | {-# INLINE isBinopCharHelp #-}
65 | isBinopCharHelp :: Word8 -> Bool
66 | isBinopCharHelp word =
67 |   word < 128 && Vector.unsafeIndex binopCharVector (fromIntegral word)
68 | 
69 | 
70 | {-# NOINLINE binopCharVector #-}
71 | binopCharVector :: Vector.Vector Bool
72 | binopCharVector =
73 |   Vector.generate 128 (\i -> IntSet.member i binopCharSet)
74 | 
75 | 
76 | {-# NOINLINE binopCharSet #-}
77 | binopCharSet :: IntSet.IntSet
78 | binopCharSet =
79 |   IntSet.fromList (map Char.ord "+-/*=.<>:&|^?%!")
80 | 


--------------------------------------------------------------------------------
/compiler/src/Type/Occurs.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wall #-}
 2 | {-# LANGUAGE OverloadedStrings #-}
 3 | module Type.Occurs
 4 |   ( occurs
 5 |   )
 6 |   where
 7 | 
 8 | 
 9 | import Data.Foldable (foldrM)
10 | import qualified Data.Map.Strict as Map
11 | 
12 | import Type.Type as Type
13 | import qualified Type.UnionFind as UF
14 | 
15 | 
16 | 
17 | -- OCCURS
18 | 
19 | 
20 | occurs :: Type.Variable -> IO Bool
21 | occurs var =
22 |   occursHelp [] var False
23 | 
24 | 
25 | occursHelp :: [Type.Variable] -> Type.Variable -> Bool -> IO Bool
26 | occursHelp seen var foundCycle =
27 |   if elem var seen then
28 |     return True
29 | 
30 |   else
31 |     do  (Descriptor content _ _ _) <- UF.get var
32 |         case content of
33 |           FlexVar _ ->
34 |               return foundCycle
35 | 
36 |           FlexSuper _ _ ->
37 |               return foundCycle
38 | 
39 |           RigidVar _ ->
40 |               return foundCycle
41 | 
42 |           RigidSuper _ _ ->
43 |               return foundCycle
44 | 
45 |           Structure term ->
46 |               let newSeen = var : seen in
47 |               case term of
48 |                 App1 _ _ args ->
49 |                     foldrM (occursHelp newSeen) foundCycle args
50 | 
51 |                 Fun1 a b ->
52 |                     occursHelp newSeen a =<<
53 |                       occursHelp newSeen b foundCycle
54 | 
55 |                 EmptyRecord1 ->
56 |                     return foundCycle
57 | 
58 |                 Record1 fields ext ->
59 |                     occursHelp newSeen ext =<<
60 |                       foldrM (occursHelp newSeen) foundCycle (Map.elems fields)
61 | 
62 |                 Unit1 ->
63 |                     return foundCycle
64 | 
65 |                 Tuple1 a b maybeC ->
66 |                     case maybeC of
67 |                       Nothing ->
68 |                         occursHelp newSeen a =<<
69 |                           occursHelp newSeen b foundCycle
70 | 
71 |                       Just c ->
72 |                         occursHelp newSeen a =<<
73 |                           occursHelp newSeen b =<<
74 |                             occursHelp newSeen c foundCycle
75 | 
76 |           Alias _ _ args _ ->
77 |               foldrM (occursHelp (var:seen)) foundCycle (map snd args)
78 | 
79 |           Error ->
80 |               return foundCycle
81 | 


--------------------------------------------------------------------------------
/docs/elm.json/application.md:
--------------------------------------------------------------------------------
 1 | # `elm.json` for applications
 2 | 
 3 | This is a decent baseline for pretty much any applications made with Elm. You will need these dependencies or more.
 4 | 
 5 | ```json
 6 | {
 7 |     "type": "application",
 8 |     "source-directories": [
 9 |         "src"
10 |     ],
11 |     "elm-version": "0.19.1",
12 |     "dependencies": {
13 |         "direct": {
14 |             "elm/browser": "1.0.0",
15 |             "elm/core": "1.0.0",
16 |             "elm/html": "1.0.0",
17 |             "elm/json": "1.0.0"
18 |         },
19 |         "indirect": {
20 |             "elm/time": "1.0.0",
21 |             "elm/url": "1.0.0",
22 |             "elm/virtual-dom": "1.0.0"
23 |         }
24 |     },
25 |     "test-dependencies": {
26 |         "direct": {},
27 |         "indirect": {}
28 |     }
29 | }
30 | ```
31 | 
32 | 

33 | 
34 | 
35 | ## `"type"`
36 | 
37 | Either `"application"` or `"package"`. All the other fields are based on this choice!
38 | 
39 | 

40 | 
41 | 
42 | ## `"source-directories"`
43 | 
44 | A list of directories where Elm code lives. Most projects just use `"src"` for everything.
45 | 
46 | 

47 | 
48 | 
49 | ## `"elm-version"`
50 | 
51 | The exact version of Elm this builds with. Should be `"0.19.1"` for most people!
52 | 
53 | 

54 | 
55 | 
56 | ## `"dependencies"`
57 | 
58 | All the packages you depend upon. We use exact versions, so your `elm.json` file doubles as a "lock file" that ensures reliable builds.
59 | 
60 | You 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.
61 | 
62 | **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!
63 | 
64 | 

65 | 
66 | 
67 | ## `"test-dependencies"`
68 | 
69 | All 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.
70 | 


--------------------------------------------------------------------------------
/hints/infinite-type.md:
--------------------------------------------------------------------------------
 1 | 
 2 | # Hints for Infinite Types
 3 | 
 4 | Infinite 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!
 5 | 
 6 | 
 7 | ## Example
 8 | 
 9 | A common way to get an infinite type error is very small typos. For example, do you see the problem in the following code?
10 | 
11 | ```elm
12 | incrementNumbers list =
13 |   List.map incrementNumbers list
14 | 
15 | incrementNumber n =
16 |   n + 1
17 | ```
18 | 
19 | The 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:
20 | 
21 | ```elm
22 | incrementNumbers list =
23 |   List.map incrementNumbers list -- BUG extra `s` makes this self-recursive
24 | ```
25 | 
26 | Now 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`.
27 | 
28 | The 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`)
29 | 
30 | That 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!
31 | 
32 | The 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:
33 | 
34 | ```elm
35 | incrementNumbers : List Int -> List Int
36 | incrementNumbers list =
37 |   List.map incrementNumbers list -- STILL HAS BUG
38 | ```
39 | 
40 | Now 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.
41 | 
42 | In summary, the root issue is often some small typo, and the best way out is to start adding type annotations on everything!
43 | 


--------------------------------------------------------------------------------
/docs/upgrade-instructions/0.19.1.md:
--------------------------------------------------------------------------------
 1 | # Upgrading to 0.19.1
 2 | 
 3 | **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!
 4 | 
 5 | 
 6 | 

 7 | 
 8 | ## Improvements
 9 | 
10 | - 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))
11 | - Faster compilation, especially for incremental compiles
12 | - 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!)
13 | - More intuitive multiline declarations in REPL
14 | - Various bug fixes (e.g. `--debug`, `x /= 0`, `type Height = Height Float` in `--optimize`)
15 | 
16 | 
17 | 

18 | 
19 | ## Detectable Bug Fixes
20 | 
21 | There are three known cases where code that compiled with 0.19.0 will not compile with 0.19.1 due to bug fixes:
22 | 
23 | 
24 | ### 1. Ambiguous Imports
25 | 
26 | Say you have an import like this:
27 | 
28 | ```elm
29 | import Html exposing (min)
30 | import Regex exposing (never)
31 | 
32 | x = min
33 | y = never
34 | ```
35 | 
36 | These 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.
37 | 
38 | The fix is to use a qualified name like `Html.min` or `Regex.never` to make it unambiguous.
39 | 
40 | We 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.
41 | 
42 | For 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.
43 | 
44 | 
45 | ### 2. Tabs in Comments
46 | 
47 | The 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.
48 | 
49 | Again, 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.
50 | 
51 | 
52 | ### 3. Port Module with no Ports
53 | 
54 | If you have any files that start with:
55 | 
56 | ```elm
57 | port module Main exposing (..)
58 | ```
59 | 
60 | But 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 (..)`
61 | 


--------------------------------------------------------------------------------
/worker/src/Main.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wall #-}
 2 | {-# LANGUAGE OverloadedStrings #-}
 3 | module Main
 4 |   ( main
 5 |   )
 6 |   where
 7 | 
 8 | 
 9 | import Control.Monad (msum)
10 | import qualified Data.ByteString as BS
11 | import Snap.Core
12 | import Snap.Http.Server
13 | import qualified System.Environment as Env
14 | import qualified System.Exit as Exit
15 | import qualified System.IO as IO
16 | 
17 | import qualified Artifacts
18 | import qualified Cors
19 | import qualified Endpoint.Compile as Compile
20 | import qualified Endpoint.Donate as Donate
21 | import qualified Endpoint.Repl as Repl
22 | 
23 | 
24 | 
25 | -- RUN THE DEV SERVER
26 | 
27 | 
28 | main :: IO ()
29 | main =
30 |   do  rArtifacts <- Artifacts.loadRepl
31 |       cArtifacts <- Artifacts.loadCompile
32 |       errorJS <- Compile.loadErrorJS
33 |       manager <- Donate.getManager =<< getSecret
34 |       let depsInfo = Artifacts.toDepsInfo cArtifacts
35 | 
36 |       httpServe config $ msum $
37 |         [ ifTop $ status
38 |         , path "repl" $ Repl.endpoint rArtifacts
39 |         , path "compile" $ Compile.endpoint cArtifacts
40 |         , path "compile/errors.js" $ serveJavaScript errorJS
41 |         , path "compile/deps-info.json" $ serveDepsInfo depsInfo
42 |         , path "donate" $ Donate.endpoint manager
43 |         , notFound
44 |         ]
45 | 
46 | 
47 | config :: Config Snap a
48 | config =
49 |   setPort 8000 $ setAccessLog ConfigNoLog $ setErrorLog ConfigNoLog $ defaultConfig
50 | 
51 | 
52 | status :: Snap ()
53 | status =
54 |   do  modifyResponse $ setContentType "text/plain"
55 |       writeBuilder "Status: OK"
56 | 
57 | 
58 | notFound :: Snap ()
59 | notFound =
60 |   do  modifyResponse $ setResponseStatus 404 "Not Found"
61 |       modifyResponse $ setContentType "text/html; charset=utf-8"
62 |       writeBuilder "Not Found"
63 | 
64 | 
65 | serveJavaScript :: BS.ByteString -> Snap ()
66 | serveJavaScript javascript =
67 |   do  modifyResponse $ setContentType "application/javascript"
68 |       writeBS javascript
69 | 
70 | 
71 | serveDepsInfo :: BS.ByteString -> Snap ()
72 | serveDepsInfo json =
73 |   Cors.allow GET ["https://elm-lang.org"] $
74 |     do  modifyResponse $ setContentType "application/json"
75 |         writeBS json
76 | 
77 | 
78 | 
79 | -- GET SECRET
80 | 
81 | 
82 | getSecret :: IO String
83 | getSecret =
84 |   do  maybeValue <- Env.lookupEnv "STRIPE_SECRET"
85 |       case maybeValue of
86 |         Just secret ->
87 |           return secret
88 | 
89 |         Nothing ->
90 |           do  IO.hPutStrLn IO.stderr
91 |                 "Expecting environment variable STRIPE_SECRET to be defined:\n\
92 |                 \\n\
93 |                 \    STRIPE_SECRET=sk_test_abcdefghijklmnopqrstuvwxyz\n\
94 |                 \\n\
95 |                 \It is needed for handling donations with Stripe."
96 |               Exit.exitFailure
97 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # Elm To Node
 2 | 
 3 | Use the pure functions defined in your [elm](http://elm-lang.or/) code in your Node.js server in a synchronous way!
 4 | 
 5 | 

 6 | 
 7 | ## Install
 8 | 
 9 | Only available on Linux right now.
10 | 
11 | ✨ [Install on linux](https://github.com/sebsheep/elm2node/tree/0.1.0-alpha-2/installers/linux) ✨
12 | 
13 | 

14 | 
15 | ## Basic Usage
16 | 
17 | Say you have some wonderful elm code, computing sums and storing specific data:
18 | 
19 | ```elm
20 | -- src/Main.elm
21 | module Main exposing (answer, sum)
22 | 
23 | answer : Int
24 | answer = 42
25 | 
26 | sum : { a: Float, b: Float} -> Float
27 | sum data =
28 |     data.a + data.b
29 | ```
30 | 
31 | You just have to run:
32 | ```sh
33 | elm2node src/Main.elm
34 | ```
35 | 
36 | This will produce an `elm.js` file which is a valid Node.js module. Try it out in 
37 | the Node.js repl:
38 | 
39 | ```sh
40 | $ node
41 | > myModel = require('./elm.js')
42 | { answer: 42, sum: [Function: sum] }
43 | > myModel.answer
44 | 42
45 | > myModel.sum({a: 5, b: 7})
46 | 12
47 | ```
48 | 
49 | 
50 | 

51 | 
52 | ## Restrictions
53 | 
54 | The exposed values do have some restrictions:
55 |  * only "static" values or functions with one argument can be exposed
56 |  * the only accepted types in exposed values are:
57 |         `Int`, `Float`, `String`, `Maybe`, `Records`, `List`, `Array`, `Json.Encode.Value`
58 |  * exposed user defined types are silently ignored.
59 | 
60 | 

61 | 
62 | ## FAQ
63 | 
64 | ### Can I export to Node.js a elm function taking multiple arguments?
65 | Short answer: no. 
66 | 
67 | More useful answer: you can simulate the mutiple arguments using an "JS object/elm record"
68 | as argument. For example, if you want your function sum two floats `a` and `b`, you can
69 | define:
70 | ```elm
71 | sum : { a: Float, b: Float} -> Float
72 | sum data =
73 |     data.a + data.b
74 | ```
75 | In the Node.js server side, you'd have to write something like:
76 | ```js
77 | myModule.calc({a: 5, b: 7})
78 | ```
79 | 
80 | However, as recommended in the [elm documentation](https://guide.elm-lang.org/interop/ports.html#notes),
81 | consider using a `Json.Encode.Value` as type and use a custom decoder to handle errors.
82 | 
83 | ### I've tried to export `answer = 42` and it failed!
84 | If you omit the type annotation in the top level `answer = 42` declaration,
85 | the type of `answer` will be inferred as `number` which is not an exportable type.
86 | 
87 | Add a type annotation like (it is a good habit to have, anyway!):
88 | ```elm
89 | answer : Int
90 | answer = 42
91 | ```
92 | 
93 | ### Do I have the guarantee my elm code will be compiled the same way than with `elm make`?
94 | Yes! This tool was built from the official elm 0.19.1 compiler, just modifying how the compiler deal
95 | with exposed functions for the files given as arguments and removing useless stuff for our purpose 
96 | (reactor, publishing packages...).
97 | 


--------------------------------------------------------------------------------
/compiler/src/Compile.hs:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
 2 | module Compile
 3 |   ( Artifacts(..)
 4 |   , compile
 5 |   )
 6 |   where
 7 | 
 8 | 
 9 | import qualified Data.Map as Map
10 | import qualified Data.Name as Name
11 | 
12 | import qualified AST.Source as Src
13 | import qualified AST.Canonical as Can
14 | import qualified AST.Optimized as Opt
15 | import qualified Canonicalize.Module as Canonicalize
16 | import qualified Elm.Interface as I
17 | import qualified Elm.ModuleName as ModuleName
18 | import qualified Elm.Package as Pkg
19 | import qualified Nitpick.PatternMatches as PatternMatches
20 | import qualified Optimize.Module as Optimize
21 | import qualified Reporting.Error as E
22 | import qualified Reporting.Result as R
23 | import qualified Reporting.Render.Type.Localizer as Localizer
24 | import qualified Type.Constrain.Module as Type
25 | import qualified Type.Solve as Type
26 | 
27 | import System.IO.Unsafe (unsafePerformIO)
28 | 
29 | 
30 | 
31 | -- COMPILE
32 | 
33 | 
34 | data Artifacts =
35 |   Artifacts
36 |     { _modul :: Can.Module
37 |     , _types :: Map.Map Name.Name Can.Annotation
38 |     , _graph :: Opt.LocalGraph
39 |     }
40 | 
41 | 
42 | compile :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Either E.Error Artifacts
43 | compile pkg ifaces modul =
44 |   do  canonical   <- canonicalize pkg ifaces modul
45 |       annotations <- typeCheck modul canonical
46 |       ()          <- nitpick canonical
47 |       objects     <- optimize modul annotations canonical
48 |       return (Artifacts canonical annotations objects)
49 | 
50 | 
51 | 
52 | -- PHASES
53 | 
54 | 
55 | canonicalize :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Either E.Error Can.Module
56 | canonicalize pkg ifaces modul =
57 |   case snd $ R.run $ Canonicalize.canonicalize pkg ifaces modul of
58 |     Right canonical ->
59 |       Right canonical
60 | 
61 |     Left errors ->
62 |       Left $ E.BadNames errors
63 | 
64 | 
65 | typeCheck :: Src.Module -> Can.Module -> Either E.Error (Map.Map Name.Name Can.Annotation)
66 | typeCheck modul canonical =
67 |   case unsafePerformIO (Type.run =<< Type.constrain canonical) of
68 |     Right annotations ->
69 |       Right annotations
70 | 
71 |     Left errors ->
72 |       Left (E.BadTypes (Localizer.fromModule modul) errors)
73 | 
74 | 
75 | nitpick :: Can.Module -> Either E.Error ()
76 | nitpick canonical =
77 |   case PatternMatches.check canonical of
78 |     Right () ->
79 |       Right ()
80 | 
81 |     Left errors ->
82 |       Left (E.BadPatterns errors)
83 | 
84 | 
85 | optimize :: Src.Module -> Map.Map Name.Name Can.Annotation -> Can.Module -> Either E.Error Opt.LocalGraph
86 | optimize modul annotations canonical =
87 |   case snd $ R.run $ Optimize.optimize annotations canonical of
88 |     Right localGraph ->
89 |       Right localGraph
90 | 
91 |     Left errors ->
92 |       Left (E.BadMains (Localizer.fromModule modul) errors)
93 | 


--------------------------------------------------------------------------------
/hints/type-annotations.md:
--------------------------------------------------------------------------------
 1 | 
 2 | # Hints for Type Annotation Problems
 3 | 
 4 | At 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.
 5 | 
 6 | This document is going to outline the various things that can go wrong and show some examples.
 7 | 
 8 | 
 9 | ## Annotation vs. Definition
10 | 
11 | The most common issue is with user-defined type variables that are too general. So let's say you have defined a function like this:
12 | 
13 | ```elm
14 | addPair : (a, a) -> a
15 | addPair (x, y) =
16 |   x + y
17 | ```
18 | 
19 | The 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:
20 | 
21 | ```elm
22 | addPair : (number, number) -> number
23 | ```
24 | 
25 | So 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.
26 | 
27 | In cases like this, you want to go with whatever the compiler inferred. It is good at figuring this kind of stuff out ;)
28 | 
29 | 
30 | ## Annotation vs. Itself
31 | 
32 | It 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:
33 | 
34 | ```elm
35 | addPair : (Int, Int) -> number
36 | addPair (x, y) =
37 |   x + y
38 | ```
39 | 
40 | In 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`.
41 | 
42 | 
43 | ## Annotation vs. Internal Annotation
44 | 
45 | A quite tricky case is when an outer type annotation clashes with an inner type annotation. Here is an example of this:
46 | 
47 | ```elm
48 | filter : (a -> Bool) -> List a -> List a
49 | filter isOkay list =
50 |   let
51 |     keepIfOkay : a -> Maybe a
52 |     keepIfOkay x =
53 |       if isOkay x then Just x else Nothing
54 |   in
55 |     List.filterMap keepIfOkay list
56 | ```
57 | 
58 | This 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.
59 | 
60 | For 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.
61 | 


--------------------------------------------------------------------------------
/compiler/src/Data/Index.hs:
--------------------------------------------------------------------------------
  1 | module Data.Index
  2 |   ( ZeroBased
  3 |   , first
  4 |   , second
  5 |   , third
  6 |   , next
  7 |   , toMachine
  8 |   , toHuman
  9 |   , indexedMap
 10 |   , indexedTraverse
 11 |   , indexedForA
 12 |   , VerifiedList(..)
 13 |   , indexedZipWith
 14 |   , indexedZipWithA
 15 |   )
 16 |   where
 17 | 
 18 | 
 19 | import Control.Monad (liftM)
 20 | import Data.Binary
 21 | 
 22 | 
 23 | 
 24 | -- ZERO BASED
 25 | 
 26 | 
 27 | newtype ZeroBased = ZeroBased Int
 28 |   deriving (Eq, Ord)
 29 | 
 30 | 
 31 | first :: ZeroBased
 32 | first =
 33 |   ZeroBased 0
 34 | 
 35 | 
 36 | second :: ZeroBased
 37 | second =
 38 |   ZeroBased 1
 39 | 
 40 | 
 41 | third :: ZeroBased
 42 | third =
 43 |   ZeroBased 2
 44 | 
 45 | 
 46 | {-# INLINE next #-}
 47 | next :: ZeroBased -> ZeroBased
 48 | next (ZeroBased i) =
 49 |   ZeroBased (i + 1)
 50 | 
 51 | 
 52 | 
 53 | -- DESTRUCT
 54 | 
 55 | 
 56 | toMachine :: ZeroBased -> Int
 57 | toMachine (ZeroBased index) =
 58 |   index
 59 | 
 60 | 
 61 | toHuman :: ZeroBased -> Int
 62 | toHuman (ZeroBased index) =
 63 |   index + 1
 64 | 
 65 | 
 66 | 
 67 | -- INDEXED MAP
 68 | 
 69 | 
 70 | {-# INLINE indexedMap #-}
 71 | indexedMap :: (ZeroBased -> a -> b) -> [a] -> [b]
 72 | indexedMap func xs =
 73 |   zipWith func (map ZeroBased [0 .. length xs]) xs
 74 | 
 75 | 
 76 | {-# INLINE indexedTraverse #-}
 77 | indexedTraverse :: (Applicative f) => (ZeroBased -> a -> f b) -> [a] -> f [b]
 78 | indexedTraverse func xs =
 79 |   sequenceA (indexedMap func xs)
 80 | 
 81 | 
 82 | {-# INLINE indexedForA #-}
 83 | indexedForA :: (Applicative f) => [a] -> (ZeroBased -> a -> f b) -> f [b]
 84 | indexedForA xs func =
 85 |   sequenceA (indexedMap func xs)
 86 | 
 87 | 
 88 | 
 89 | -- VERIFIED/INDEXED ZIP
 90 | 
 91 | 
 92 | data VerifiedList a
 93 |   = LengthMatch [a]
 94 |   | LengthMismatch Int Int
 95 | 
 96 | 
 97 | indexedZipWith :: (ZeroBased -> a -> b -> c) -> [a] -> [b] -> VerifiedList c
 98 | indexedZipWith func listX listY =
 99 |   indexedZipWithHelp func 0 listX listY []
100 | 
101 | 
102 | indexedZipWithHelp :: (ZeroBased -> a -> b -> c) -> Int -> [a] -> [b] -> [c] -> VerifiedList c
103 | indexedZipWithHelp func index listX listY revListZ =
104 |   case (listX, listY) of
105 |     ([], []) ->
106 |       LengthMatch (reverse revListZ)
107 | 
108 |     (x:xs, y:ys) ->
109 |       indexedZipWithHelp func (index + 1) xs ys $
110 |         func (ZeroBased index) x y : revListZ
111 | 
112 |     (_, _) ->
113 |       LengthMismatch (index + length listX) (index + length listY)
114 | 
115 | 
116 | indexedZipWithA :: (Applicative f) => (ZeroBased -> a -> b -> f c) -> [a] -> [b] -> f (VerifiedList c)
117 | indexedZipWithA func listX listY =
118 |   case indexedZipWith func listX listY of
119 |     LengthMatch xs ->
120 |       LengthMatch <$> sequenceA xs
121 | 
122 |     LengthMismatch x y ->
123 |       pure (LengthMismatch x y)
124 | 
125 | 
126 | 
127 | -- BINARY
128 | 
129 | 
130 | instance Binary ZeroBased where
131 |   get = liftM ZeroBased get
132 |   put (ZeroBased n) = put n
133 | 


--------------------------------------------------------------------------------
/hints/optimize.md:
--------------------------------------------------------------------------------
 1 | 
 2 | # How to optimize Elm code
 3 | 
 4 | When you are serving a website, there are two kinds of optimizations you want to do:
 5 | 
 6 | 1. **Asset Size** — How can we send as few bits as possible?
 7 | 2. **Performance** — How can those bits run as quickly as possible?
 8 | 
 9 | It 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.
10 | 
11 | Okay, but how do we get those numbers?
12 | 
13 | 
14 | ## Instructions
15 | 
16 | Step one is to compile with the `--optimize` flag. This does things like shortening record field names and unboxing values.
17 | 
18 | Step 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!
19 | 
20 | Putting those together, here is how I would optimize `src/Main.elm` with two terminal commands:
21 | 
22 | ```bash
23 | elm make src/Main.elm --optimize --output=elm.js
24 | uglifyjs 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
25 | ```
26 | 
27 | After this you will have an `elm.js` and a significantly smaller `elm.min.js` file!
28 | 
29 | **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.
30 | 
31 | **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/).
32 | 
33 | ## Scripts
34 | 
35 | It is hard to remember all that, so it is probably a good idea to write a script that does it.
36 | 
37 | I 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:
38 | 
39 | ```bash
40 | #!/bin/sh
41 | 
42 | set -e
43 | 
44 | js="elm.js"
45 | min="elm.min.js"
46 | 
47 | elm make --optimize --output=$js $@
48 | 
49 | uglifyjs $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
50 | 
51 | echo "Initial size: $(cat $js | wc -c) bytes  ($js)"
52 | echo "Minified size:$(cat $min | wc -c) bytes  ($min)"
53 | echo "Gzipped size: $(cat $min | gzip -c | wc -c) bytes"
54 | ```
55 | 
56 | It 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.
57 | 
58 | Again, 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.
59 | 
60 | 


--------------------------------------------------------------------------------
/installers/npm/download.js:
--------------------------------------------------------------------------------
 1 | var fs = require('fs');
 2 | var package = require('./package.json');
 3 | var path = require('path');
 4 | var request = require('request');
 5 | var zlib = require('zlib');
 6 | 
 7 | 
 8 | 
 9 | // MAIN
10 | //
11 | // This function is used by install.js and by the bin/elm backup that gets
12 | // called when --ignore-scripts is enabled. That's why install.js is so weird.
13 | 
14 | 
15 | module.exports = function(callback)
16 | {
17 | 	// figure out URL of binary
18 | 	var version = package.version.replace(/^(\d+\.\d+\.\d+).*$/, '$1'); // turn '1.2.3-alpha' into '1.2.3'
19 | 	var os = { 'darwin': 'mac', 'win32': 'windows', 'linux': 'linux' }[process.platform];
20 | 	var arch = { 'x64': '64-bit', 'ia32': '32-bit' }[process.arch];
21 | 	var url = 'https://github.com/elm/compiler/releases/download/' + version + '/binary-for-' + os + '-' + arch + '.gz';
22 | 
23 | 	reportDownload(version, url);
24 | 
25 | 	// figure out where to put the binary (calls path.resolve() to get path separators right on Windows)
26 | 	var binaryPath = path.resolve(__dirname, package.bin.elm) + (process.platform === 'win32' ? '.exe' : '');
27 | 
28 | 	// set up handler for request failure
29 | 	function reportDownloadFailure(error)
30 | 	{
31 | 		exitFailure(url,'Something went wrong while fetching the following URL:\n\n' + url + '\n\nIt is saying:\n\n' + error);
32 | 	}
33 | 
34 | 	// set up decompression pipe
35 | 	var gunzip = zlib.createGunzip().on('error', function(error) {
36 | 		exitFailure(url, 'I ran into trouble decompressing the downloaded binary. It is saying:\n\n' + error);
37 | 	});
38 | 
39 | 	// set up file write pipe
40 | 	var write = fs.createWriteStream(binaryPath, {
41 | 		encoding: 'binary',
42 | 		mode: 0o755
43 | 	}).on('finish', callback).on('error', function(error) {
44 | 		exitFailure(url, 'I had some trouble writing file to disk. It is saying:\n\n' + error);
45 | 	});
46 | 
47 | 	// put it all together
48 | 	request(url).on('error', reportDownloadFailure).pipe(gunzip).pipe(write);
49 | }
50 | 
51 | 
52 | 
53 | // EXIT FAILURE
54 | 
55 | 
56 | function exitFailure(url, message)
57 | {
58 | 	console.error(
59 | 		'-- ERROR -----------------------------------------------------------------------\n\n'
60 | 		+ message
61 | 		+ '\n\nNOTE: You can avoid npm entirely by downloading directly from:\n'
62 | 		+ url + '\nAll this package does is download that file and put it somewhere.\n\n'
63 | 		+ '--------------------------------------------------------------------------------\n'
64 | 	);
65 | 	process.exit(1);
66 | }
67 | 
68 | 
69 | 
70 | // REPORT DOWNLOAD
71 | 
72 | 
73 | function reportDownload(version, url)
74 | {
75 | 	console.log(
76 | 		'--------------------------------------------------------------------------------\n\n'
77 | 		+ 'Downloading Elm ' + version + ' from GitHub.'
78 | 		+ '\n\nNOTE: You can avoid npm entirely by downloading directly from:\n'
79 | 		+ url + '\nAll this package does is download that file and put it somewhere.\n\n'
80 | 		+ '--------------------------------------------------------------------------------\n'
81 | 	);
82 | }
83 | 


--------------------------------------------------------------------------------
/compiler/src/Reporting/Result.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | {-# LANGUAGE Rank2Types #-}
  3 | module Reporting.Result
  4 |   ( Result(..)
  5 |   , run
  6 |   , ok
  7 |   , warn
  8 |   , throw
  9 |   , mapError
 10 |   )
 11 |   where
 12 | 
 13 | 
 14 | import qualified Data.OneOrMore as OneOrMore
 15 | import qualified Reporting.Warning as Warning
 16 | 
 17 | 
 18 | 
 19 | -- RESULT
 20 | 
 21 | 
 22 | newtype Result info warnings error a =
 23 |   Result (
 24 |     forall result.
 25 |       info
 26 |       -> warnings
 27 |       -> (info -> warnings -> OneOrMore.OneOrMore error -> result)
 28 |       -> (info -> warnings -> a -> result)
 29 |       -> result
 30 |   )
 31 | 
 32 | 
 33 | run :: Result () [w] e a -> ([w], Either (OneOrMore.OneOrMore e) a)
 34 | run (Result k) =
 35 |   k () []
 36 |     (\() w e -> (reverse w, Left e))
 37 |     (\() w a -> (reverse w, Right a))
 38 | 
 39 | 
 40 | 
 41 | -- HELPERS
 42 | 
 43 | 
 44 | ok :: a -> Result i w e a
 45 | ok a =
 46 |   Result $ \i w _ good ->
 47 |     good i w a
 48 | 
 49 | 
 50 | warn :: Warning.Warning -> Result i [Warning.Warning] e ()
 51 | warn warning =
 52 |   Result $ \i warnings _ good ->
 53 |     good i (warning:warnings) ()
 54 | 
 55 | 
 56 | throw :: e -> Result i w e a
 57 | throw e =
 58 |   Result $ \i w bad _ ->
 59 |     bad i w (OneOrMore.one e)
 60 | 
 61 | 
 62 | mapError :: (e -> e') -> Result i w e a -> Result i w e' a
 63 | mapError func (Result k) =
 64 |   Result $ \i w bad good ->
 65 |     let
 66 |       bad1 i1 w1 e1 =
 67 |         bad i1 w1 (OneOrMore.map func e1)
 68 |     in
 69 |     k i w bad1 good
 70 | 
 71 | 
 72 | 
 73 | -- FANCY INSTANCE STUFF
 74 | 
 75 | 
 76 | instance Functor (Result i w e) where
 77 |   fmap func (Result k) =
 78 |     Result $ \i w bad good ->
 79 |       let
 80 |         good1 i1 w1 value =
 81 |           good i1 w1 (func value)
 82 |       in
 83 |       k i w bad good1
 84 | 
 85 | 
 86 | instance Applicative (Result i w e) where
 87 |   pure = ok
 88 | 
 89 |   (<*>) (Result kf) (Result kv) =
 90 |     Result $ \i w bad good ->
 91 |       let
 92 |         bad1 i1 w1 e1 =
 93 |           let
 94 |             bad2 i2 w2 e2 = bad i2 w2 (OneOrMore.more e1 e2)
 95 |             good2 i2 w2 _value = bad i2 w2 e1
 96 |           in
 97 |           kv i1 w1 bad2 good2
 98 | 
 99 |         good1 i1 w1 func =
100 |           let
101 |             bad2 i2 w2 e2 = bad i2 w2 e2
102 |             good2 i2 w2 value = good i2 w2 (func value)
103 |           in
104 |           kv i1 w1 bad2 good2
105 |       in
106 |       kf i w bad1 good1
107 | 
108 | 
109 | instance Monad (Result i w e) where
110 |   return = ok
111 | 
112 |   (>>=) (Result ka) callback =
113 |     Result $ \i w bad good ->
114 |       let
115 |         good1 i1 w1 a =
116 |           case callback a of
117 |             Result kb -> kb i1 w1 bad good
118 |       in
119 |       ka i w bad good1
120 | 
121 |   (>>) (Result ka) (Result kb) =
122 |     Result $ \i w bad good ->
123 |       let
124 |         good1 i1 w1 _ =
125 |           kb i1 w1 bad good
126 |       in
127 |       ka i w bad good1
128 | 
129 |   -- PERF add INLINE to these?
130 | 


--------------------------------------------------------------------------------
/hints/port-modules.md:
--------------------------------------------------------------------------------
 1 | 
 2 | # No Ports in Packages
 3 | 
 4 | The package ecosystem is one of the most important parts of Elm. Right now, our ecosystem has some compelling benefits:
 5 | 
 6 |   - There are many obvious default packages that work well.
 7 |   - Adding dependencies cannot introduce runtime exceptions.
 8 |   - Patch changes cannot lead to surprise build failures.
 9 | 
10 | These are really important factors if you want to *quickly* create *reliable* applications. The Elm community thinks this is valuable.
11 | 
12 | Other 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.
13 | 
14 | 
15 | ## So what about ports?
16 | 
17 | Imagine 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...
18 | 
19 | Okay, 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.
20 | 
21 | **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.
22 | 
23 | So “ports in packages” would impose an enormous cost on application developers, and in the end, we would have a less reliable package ecosystem overall.
24 | 
25 | 
26 | ## Conclusion
27 | 
28 | Our 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.
29 | 
30 | Now 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!
31 | 
32 | If 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.
33 | 


--------------------------------------------------------------------------------
/compiler/src/Reporting/Render/Type/Localizer.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | {-# LANGUAGE OverloadedStrings #-}
  3 | module Reporting.Render.Type.Localizer
  4 |   ( Localizer
  5 |   , toDoc
  6 |   , toChars
  7 |   , empty
  8 |   , fromNames
  9 |   , fromModule
 10 |   )
 11 |   where
 12 | 
 13 | 
 14 | import qualified Data.Map as Map
 15 | import qualified Data.Name as Name
 16 | import qualified Data.Set as Set
 17 | 
 18 | import qualified AST.Source as Src
 19 | import qualified Elm.ModuleName as ModuleName
 20 | import Reporting.Doc ((<>))
 21 | import qualified Reporting.Doc as D
 22 | import qualified Reporting.Annotation as A
 23 | 
 24 | 
 25 | 
 26 | -- LOCALIZER
 27 | 
 28 | 
 29 | newtype Localizer =
 30 |   Localizer (Map.Map Name.Name Import)
 31 | 
 32 | 
 33 | data Import =
 34 |   Import
 35 |     { _alias :: Maybe Name.Name
 36 |     , _exposing :: Exposing
 37 |     }
 38 | 
 39 | 
 40 | data Exposing
 41 |   = All
 42 |   | Only (Set.Set Name.Name)
 43 | 
 44 | 
 45 | empty :: Localizer
 46 | empty =
 47 |   Localizer Map.empty
 48 | 
 49 | 
 50 | 
 51 | -- LOCALIZE
 52 | 
 53 | 
 54 | toDoc :: Localizer -> ModuleName.Canonical -> Name.Name -> D.Doc
 55 | toDoc localizer home name =
 56 |   D.fromChars (toChars localizer home name)
 57 | 
 58 | 
 59 | toChars :: Localizer -> ModuleName.Canonical -> Name.Name -> String
 60 | toChars (Localizer localizer) moduleName@(ModuleName.Canonical _ home) name =
 61 |   case Map.lookup home localizer of
 62 |     Nothing ->
 63 |       Name.toChars home <> "." <> Name.toChars name
 64 | 
 65 |     Just (Import alias exposing) ->
 66 |       case exposing of
 67 |         All ->
 68 |           Name.toChars name
 69 | 
 70 |         Only set ->
 71 |           if Set.member name set then
 72 |             Name.toChars name
 73 |           else if name == Name.list && moduleName == ModuleName.list then
 74 |             "List"
 75 |           else
 76 |             Name.toChars (maybe home id alias) <> "." <> Name.toChars name
 77 | 
 78 | 
 79 | 
 80 | -- FROM NAMES
 81 | 
 82 | 
 83 | fromNames :: Map.Map Name.Name a -> Localizer
 84 | fromNames names =
 85 |   Localizer $ Map.map (\_ -> Import Nothing All) names
 86 | 
 87 | 
 88 | 
 89 | -- FROM MODULE
 90 | 
 91 | 
 92 | fromModule :: Src.Module -> Localizer
 93 | fromModule modul@(Src.Module _ _ _ imports _ _ _ _ _) =
 94 |   Localizer $ Map.fromList $
 95 |     (Src.getName modul, Import Nothing All) : map toPair imports
 96 | 
 97 | 
 98 | toPair :: Src.Import -> (Name.Name, Import)
 99 | toPair (Src.Import (A.At _ name) alias exposing) =
100 |   ( name
101 |   , Import alias (toExposing exposing)
102 |   )
103 | 
104 | 
105 | toExposing :: Src.Exposing -> Exposing
106 | toExposing exposing =
107 |   case exposing of
108 |     Src.Open ->
109 |       All
110 | 
111 |     Src.Explicit exposedList ->
112 |       Only (foldr addType Set.empty exposedList)
113 | 
114 | 
115 | addType :: Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name
116 | addType exposed types =
117 |   case exposed of
118 |     Src.Lower _               -> types
119 |     Src.Upper (A.At _ name) _ -> Set.insert name types
120 |     Src.Operator _ _          -> types
121 | 


--------------------------------------------------------------------------------
/compiler/src/Nitpick/Debug.hs:
--------------------------------------------------------------------------------
 1 | module Nitpick.Debug
 2 |   ( hasDebugUses
 3 |   )
 4 |   where
 5 | 
 6 | 
 7 | import qualified Data.Map.Utils as Map
 8 | 
 9 | import qualified AST.Optimized as Opt
10 | 
11 | 
12 | 
13 | -- HAS DEBUG USES
14 | 
15 | 
16 | hasDebugUses :: Opt.LocalGraph -> Bool
17 | hasDebugUses (Opt.LocalGraph _ graph _) =
18 |   Map.any nodeHasDebug graph
19 | 
20 | 
21 | nodeHasDebug :: Opt.Node -> Bool
22 | nodeHasDebug node =
23 |   case node of
24 |     Opt.Define expr _           -> hasDebug expr
25 |     Opt.DefineTailFunc _ expr _ -> hasDebug expr
26 |     Opt.Ctor _ _                -> False
27 |     Opt.Enum _                  -> False
28 |     Opt.Box                     -> False
29 |     Opt.Link _                  -> False
30 |     Opt.Cycle _ vs fs _         -> any (hasDebug . snd) vs || any defHasDebug fs
31 |     Opt.Manager _               -> False
32 |     Opt.Kernel _ _              -> False
33 |     Opt.PortIncoming expr _     -> hasDebug expr
34 |     Opt.PortOutgoing expr _     -> hasDebug expr
35 | 
36 | 
37 | hasDebug :: Opt.Expr -> Bool
38 | hasDebug expression =
39 |   case expression of
40 |     Opt.Bool _           -> False
41 |     Opt.Chr _            -> False
42 |     Opt.Str _            -> False
43 |     Opt.Int _            -> False
44 |     Opt.Float _          -> False
45 |     Opt.VarLocal _       -> False
46 |     Opt.VarGlobal _      -> False
47 |     Opt.VarEnum _ _      -> False
48 |     Opt.VarBox _         -> False
49 |     Opt.VarCycle _ _     -> False
50 |     Opt.VarDebug _ _ _ _ -> True
51 |     Opt.VarKernel _ _    -> False
52 |     Opt.List exprs       -> any hasDebug exprs
53 |     Opt.Function _ expr  -> hasDebug expr
54 |     Opt.Call e es        -> hasDebug e || any hasDebug es
55 |     Opt.TailCall _ args  -> any (hasDebug . snd) args
56 |     Opt.If conds finally -> any (\(c,e) -> hasDebug c || hasDebug e) conds || hasDebug finally
57 |     Opt.Let def body     -> defHasDebug def || hasDebug body
58 |     Opt.Destruct _ expr  -> hasDebug expr
59 |     Opt.Case _ _ d jumps -> deciderHasDebug d || any (hasDebug . snd) jumps
60 |     Opt.Accessor _       -> False
61 |     Opt.Access r _       -> hasDebug r
62 |     Opt.Update r fs      -> hasDebug r || any hasDebug fs
63 |     Opt.Record fs        -> any hasDebug fs
64 |     Opt.Unit             -> False
65 |     Opt.Tuple a b c      -> hasDebug a || hasDebug b || maybe False hasDebug c
66 |     Opt.Shader _ _ _     -> False
67 | 
68 | 
69 | defHasDebug :: Opt.Def -> Bool
70 | defHasDebug def =
71 |   case def of
72 |     Opt.Def _ expr       -> hasDebug expr
73 |     Opt.TailDef _ _ expr -> hasDebug expr
74 | 
75 | 
76 | deciderHasDebug :: Opt.Decider Opt.Choice -> Bool
77 | deciderHasDebug decider =
78 |   case decider of
79 |     Opt.Leaf (Opt.Inline expr)  -> hasDebug expr
80 |     Opt.Leaf (Opt.Jump _)       -> False
81 |     Opt.Chain _ success failure -> deciderHasDebug success || deciderHasDebug failure
82 |     Opt.FanOut _ tests fallback -> any (deciderHasDebug . snd) tests || deciderHasDebug fallback
83 | 
84 | 
85 | 
86 | -- TODO: FIND GLOBALLY UNUSED DEFINITIONS?
87 | -- TODO: FIND PACKAGE USAGE STATS? (e.g. elm/core = 142, author/project = 2, etc.)
88 | 


--------------------------------------------------------------------------------
/compiler/src/Generate/JavaScript/Functions.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
 2 | module Generate.JavaScript.Functions
 3 |   ( functions
 4 |   )
 5 |   where
 6 | 
 7 | 
 8 | import qualified Data.ByteString.Builder as B
 9 | import Text.RawString.QQ (r)
10 | 
11 | 
12 | 
13 | -- FUNCTIONS
14 | 
15 | 
16 | functions :: B.Builder
17 | functions = [r|
18 | 
19 | function F(arity, fun, wrapper) {
20 |   wrapper.a = arity;
21 |   wrapper.f = fun;
22 |   return wrapper;
23 | }
24 | 
25 | function F2(fun) {
26 |   return F(2, fun, function(a) { return function(b) { return fun(a,b); }; })
27 | }
28 | function F3(fun) {
29 |   return F(3, fun, function(a) {
30 |     return function(b) { return function(c) { return fun(a, b, c); }; };
31 |   });
32 | }
33 | function F4(fun) {
34 |   return F(4, fun, function(a) { return function(b) { return function(c) {
35 |     return function(d) { return fun(a, b, c, d); }; }; };
36 |   });
37 | }
38 | function F5(fun) {
39 |   return F(5, fun, function(a) { return function(b) { return function(c) {
40 |     return function(d) { return function(e) { return fun(a, b, c, d, e); }; }; }; };
41 |   });
42 | }
43 | function F6(fun) {
44 |   return F(6, fun, function(a) { return function(b) { return function(c) {
45 |     return function(d) { return function(e) { return function(f) {
46 |     return fun(a, b, c, d, e, f); }; }; }; }; };
47 |   });
48 | }
49 | function F7(fun) {
50 |   return F(7, fun, function(a) { return function(b) { return function(c) {
51 |     return function(d) { return function(e) { return function(f) {
52 |     return function(g) { return fun(a, b, c, d, e, f, g); }; }; }; }; }; };
53 |   });
54 | }
55 | function F8(fun) {
56 |   return F(8, fun, function(a) { return function(b) { return function(c) {
57 |     return function(d) { return function(e) { return function(f) {
58 |     return function(g) { return function(h) {
59 |     return fun(a, b, c, d, e, f, g, h); }; }; }; }; }; }; };
60 |   });
61 | }
62 | function F9(fun) {
63 |   return F(9, fun, function(a) { return function(b) { return function(c) {
64 |     return function(d) { return function(e) { return function(f) {
65 |     return function(g) { return function(h) { return function(i) {
66 |     return fun(a, b, c, d, e, f, g, h, i); }; }; }; }; }; }; }; };
67 |   });
68 | }
69 | 
70 | function A2(fun, a, b) {
71 |   return fun.a === 2 ? fun.f(a, b) : fun(a)(b);
72 | }
73 | function A3(fun, a, b, c) {
74 |   return fun.a === 3 ? fun.f(a, b, c) : fun(a)(b)(c);
75 | }
76 | function A4(fun, a, b, c, d) {
77 |   return fun.a === 4 ? fun.f(a, b, c, d) : fun(a)(b)(c)(d);
78 | }
79 | function A5(fun, a, b, c, d, e) {
80 |   return fun.a === 5 ? fun.f(a, b, c, d, e) : fun(a)(b)(c)(d)(e);
81 | }
82 | function A6(fun, a, b, c, d, e, f) {
83 |   return fun.a === 6 ? fun.f(a, b, c, d, e, f) : fun(a)(b)(c)(d)(e)(f);
84 | }
85 | function A7(fun, a, b, c, d, e, f, g) {
86 |   return fun.a === 7 ? fun.f(a, b, c, d, e, f, g) : fun(a)(b)(c)(d)(e)(f)(g);
87 | }
88 | function A8(fun, a, b, c, d, e, f, g, h) {
89 |   return fun.a === 8 ? fun.f(a, b, c, d, e, f, g, h) : fun(a)(b)(c)(d)(e)(f)(g)(h);
90 | }
91 | function A9(fun, a, b, c, d, e, f, g, h, i) {
92 |   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);
93 | }
94 | 
95 | |]
96 | 


--------------------------------------------------------------------------------
/compiler/src/Canonicalize/Environment/Dups.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | {-# LANGUAGE OverloadedStrings #-}
  3 | module Canonicalize.Environment.Dups
  4 |   ( detect
  5 |   , checkFields
  6 |   , checkFields'
  7 |   , Dict
  8 |   , none
  9 |   , one
 10 |   , insert
 11 |   , union
 12 |   , unions
 13 |   )
 14 |   where
 15 | 
 16 | 
 17 | import qualified Data.Map as Map
 18 | import qualified Data.Name as Name
 19 | 
 20 | import qualified Data.OneOrMore as OneOrMore
 21 | import qualified Reporting.Annotation as A
 22 | import qualified Reporting.Error.Canonicalize as Error
 23 | import qualified Reporting.Result as Result
 24 | 
 25 | 
 26 | 
 27 | -- DUPLICATE TRACKER
 28 | 
 29 | 
 30 | type Dict value =
 31 |   Map.Map Name.Name (OneOrMore.OneOrMore (Info value))
 32 | 
 33 | 
 34 | data Info value =
 35 |   Info
 36 |     { _region :: A.Region
 37 |     , _value :: value
 38 |     }
 39 | 
 40 | 
 41 | 
 42 | -- DETECT
 43 | 
 44 | 
 45 | type ToError =
 46 |   Name.Name -> A.Region -> A.Region -> Error.Error
 47 | 
 48 | 
 49 | detect :: ToError -> Dict a -> Result.Result i w Error.Error (Map.Map Name.Name a)
 50 | detect toError dict =
 51 |   Map.traverseWithKey (detectHelp toError) dict
 52 | 
 53 | 
 54 | detectHelp :: ToError -> Name.Name -> OneOrMore.OneOrMore (Info a) -> Result.Result i w Error.Error a
 55 | detectHelp toError name values =
 56 |   case values of
 57 |     OneOrMore.One (Info _ value) ->
 58 |       return value
 59 | 
 60 |     OneOrMore.More left right ->
 61 |       let
 62 |         (Info r1 _, Info r2 _) =
 63 |           OneOrMore.getFirstTwo left right
 64 |       in
 65 |       Result.throw (toError name r1 r2)
 66 | 
 67 | 
 68 | 
 69 | -- CHECK FIELDS
 70 | 
 71 | 
 72 | checkFields :: [(A.Located Name.Name, a)] -> Result.Result i w Error.Error (Map.Map Name.Name a)
 73 | checkFields fields =
 74 |   detect Error.DuplicateField (foldr addField none fields)
 75 | 
 76 | 
 77 | addField :: (A.Located Name.Name, a) -> Dict a -> Dict a
 78 | addField (A.At region name, value) dups =
 79 |   Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dups
 80 | 
 81 | 
 82 | checkFields' :: (A.Region -> a -> b) -> [(A.Located Name.Name, a)] -> Result.Result i w Error.Error (Map.Map Name.Name b)
 83 | checkFields' toValue fields =
 84 |   detect Error.DuplicateField (foldr (addField' toValue) none fields)
 85 | 
 86 | 
 87 | addField' :: (A.Region -> a -> b) -> (A.Located Name.Name, a) -> Dict b -> Dict b
 88 | addField' toValue (A.At region name, value) dups =
 89 |   Map.insertWith OneOrMore.more name (OneOrMore.one (Info region (toValue region value))) dups
 90 | 
 91 | 
 92 | 
 93 | -- BUILDING DICTIONARIES
 94 | 
 95 | 
 96 | none :: Dict a
 97 | none =
 98 |   Map.empty
 99 | 
100 | 
101 | one :: Name.Name -> A.Region -> value -> Dict value
102 | one name region value =
103 |   Map.singleton name (OneOrMore.one (Info region value))
104 | 
105 | 
106 | insert :: Name.Name -> A.Region -> a -> Dict a -> Dict a
107 | insert name region value dict =
108 |   Map.insertWith (\new old -> OneOrMore.more old new) name (OneOrMore.one (Info region value)) dict
109 | 
110 | 
111 | union :: Dict a -> Dict a -> Dict a
112 | union a b =
113 |   Map.unionWith OneOrMore.more a b
114 | 
115 | 
116 | unions :: [Dict a] -> Dict a
117 | unions dicts =
118 |   Map.unionsWith OneOrMore.more dicts
119 | 


--------------------------------------------------------------------------------
/hints/implicit-casts.md:
--------------------------------------------------------------------------------
 1 | 
 2 | # Implicit Casts
 3 | 
 4 | Many 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).
 5 | 
 6 | Languages that will add in implicit casts for addition include:
 7 | 
 8 |   - JavaScript
 9 |   - Python
10 |   - Ruby
11 |   - C
12 |   - C++
13 |   - C#
14 |   - Java
15 |   - Scala
16 | 
17 | These languages generally agree that an `Int` may be implicitly cast to a `Float` when necessary. So everyone is doing it, why not Elm?!
18 | 
19 | > **Note:** Ruby does not follow the trend. They implicitly cast a `Float` to an `Int`, truncating all the decimal points!
20 | 
21 | 
22 | ## Type Inference + Implicit Casts
23 | 
24 | Elm comes from the ML-family of languages. Languages in the ML-family that **never** do implicit casts include:
25 | 
26 |   - Standard ML
27 |   - OCaml
28 |   - Elm
29 |   - F#
30 |   - Haskell
31 | 
32 | Why would so many languages from this lineage require explicit conversions though?
33 | 
34 | Well, 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.
35 | 
36 | For 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.
37 | 
38 | So 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?!
39 | 
40 |   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.
41 | 
42 |   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.
43 | 
44 | This 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.
45 | 
46 | 
47 | ## Conclusion
48 | 
49 | First, 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.
50 | 
51 | Second, Elm very much favors explicit code, so this also fits in with the overall spirit of the language and libraries.
52 | 
53 | I 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!
54 | 


--------------------------------------------------------------------------------
/installers/npm/troubleshooting.md:
--------------------------------------------------------------------------------
 1 | # Troubleshooting
 2 | 
 3 | I very highly recommend asking for help on [the Elm slack](https://elmlang.herokuapp.com).
 4 | 
 5 | There 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!
 6 | 
 7 | This document goes through a couple options that may help you out.
 8 | 
 9 | 

10 | 
11 | 
12 | ## Can you skip npm entirely?
13 | 
14 | The most reliable way to get Elm installed using the official installers for Mac and Windows [here][download].
15 | 
16 | You can also download the binaries directly. On Linux, you could do it in the terminal like this:
17 | 
18 | ```bash
19 | cd ~/Desktop/
20 | curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz
21 | gunzip elm.gz                # unzip the file
22 | chmod +x elm                 # make the file executable
23 | sudo mv elm /usr/local/bin/  # put the executable in a directory likely to be listed in your PATH variable
24 | ```
25 | 
26 | If these exact commands do not work for you, you can try to do the same thing by hand.
27 | 
28 | Read the section below on `PATH` variables if you are not sure what that is!
29 | 
30 | [download]: https://github.com/elm/compiler/releases/tag/0.19.1
31 | 
32 | 

33 | 
34 | 
35 | ## Do you need to use npm for some reason?
36 | 
37 | The 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.
38 | 
39 | ### Firewalls
40 | 
41 | Some companies have a firewall.
42 | 
43 | These companies usually have set the `HTTP_PROXY` or `HTTPS_PROXY` environment variable on your computer. This is more common with Windows computers.
44 | 
45 | The result is that the request for `https://github.com/elm/compiler/releases/download/0.19.1/binary-for-windows-64-bit.gz` is 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.
46 | 
47 | It 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:
48 | 
49 | ```
50 | # Mac and Linux
51 | HTTPS_PROXY=http://proxy.example.com npm install -g elm
52 | 
53 | # Windows
54 | set HTTPS_PROXY=http://proxy.example.com
55 | npm install -g elm
56 | ```
57 | 
58 | Check out [this document](https://www.npmjs.com/package/request#controlling-proxy-behaviour-using-environment-variables) for more information on how environment variables like `NO_PROXY`, `HTTP_PROXY`, and `HTTPS_PROXY` are handled by the npm.
59 | 
60 | 

61 | 
62 | 
63 | ## Do you know what a `PATH` variable is?
64 | 
65 | When you run a command like `elm make src/Main.elm`, your computer starts by trying to find a file called `elm`.
66 | 
67 | The `PATH` is a list of directories to search within. On Mac and Linux, you can see these directories by running:
68 | 
69 | ```
70 | $ echo $PATH
71 | /usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/local/git/bin
72 | ```
73 | 
74 | The 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.
75 | 
76 | Is `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.
77 | 


--------------------------------------------------------------------------------
/hints/shadowing.md:
--------------------------------------------------------------------------------
 1 | 
 2 | # Variable Shadowing
 3 | 
 4 | Variable shadowing is when you define the same variable name twice in an ambiguous way. Here is a pretty reasonable use of shadowing:
 5 | 
 6 | ```elm
 7 | viewName : Maybe String -> Html msg
 8 | viewName name =
 9 |   case name of
10 |     Nothing ->
11 |       ...
12 | 
13 |     Just name ->
14 |       ...
15 | ```
16 | 
17 | I 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.
18 | 
19 | Most linters produce warnings on variable shadowing, so Elm makes “best practices” the default. Just rename the first one to `maybeName` and move on.
20 | 
21 | This choice is relatively uncommon in programming languages though, so I want to provide the reasoning behind it.
22 | 
23 | 
24 | ## The Cost of Shadowing
25 | 
26 | The 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.
27 | 
28 | In 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:
29 | 
30 | ```elm
31 | name : String
32 | name =
33 |   "Tom"
34 | 
35 | -- hundreds of lines
36 | 
37 | viewName : String -> Html msg
38 | viewName name =
39 |   ... name ... name ... name ...
40 | ```
41 | 
42 | Okay, 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:
43 | 
44 | ```elm
45 | viewName : String -> String -> Html msg
46 | viewName firstName lastName =
47 |   ... name ... name ... name ...
48 | ```
49 | 
50 | The 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.
51 | 
52 | > 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.
53 | 
54 | Basically, a bunch of time gets wasted on something that could easily be detected by the compiler. But this bug is rare, right?
55 | 
56 | 
57 | ## Aggregate Cost
58 | 
59 | Thinking of a unique and helpful name takes some extra time. Maybe 30 seconds. But it means that:
60 | 
61 |   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)`.
62 | 
63 |   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.
64 | 
65 | If 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!
66 | 
67 | 
68 | ## Summary
69 | 
70 | Without 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!
71 | 


--------------------------------------------------------------------------------
/hints/comparing-records.md:
--------------------------------------------------------------------------------
 1 | # Comparing Records
 2 | 
 3 | The 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?
 4 | 
 5 | This page aims to catalog these scenarios and offer alternative paths that can get you unstuck.
 6 | 
 7 | 
 8 | ## Sorting Records
 9 | 
10 | Say we want a `view` function that can show a list of students sorted by different characteristics.
11 | 
12 | We could create something like this:
13 | 
14 | ```elm
15 | import Html exposing (..)
16 | 
17 | type alias Student =
18 |   { name : String
19 |   , age : Int
20 |   , gpa : Float
21 |   }
22 | 
23 | type Order = Name | Age | GPA
24 | 
25 | viewStudents : Order -> List Student -> Html msg
26 | viewStudents order students =
27 |   let
28 |     orderlyStudents =
29 |       case order of
30 |         Name -> List.sortBy .name students
31 |         Age -> List.sortBy .age students
32 |         GPA -> List.sortBy .gpa students
33 |   in
34 |   ul [] (List.map viewStudent orderlyStudents)
35 | 
36 | viewStudent : Student -> Html msg
37 | viewStudent student =
38 |   li [] [ text student.name ]
39 | ```
40 | 
41 | If 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:
42 | 
43 | ```elm
44 | import Html exposing (..)
45 | import Html.Lazy exposing (lazy)
46 | import Html.Keyed as Keyed
47 | 
48 | type Order = Name | Age | GPA
49 | 
50 | type alias Student =
51 |   { name : String
52 |   , age : Int
53 |   , gpa : Float
54 |   }
55 | 
56 | viewStudents : Order -> List Student -> Html msg
57 | viewStudents order students =
58 |   let
59 |     orderlyStudents =
60 |       case order of
61 |         Name -> List.sortBy .name students
62 |         Age -> List.sortBy .age students
63 |         GPA -> List.sortBy .gpa students
64 |   in
65 |   Keyed.ul [] (List.map viewKeyedStudent orderlyStudents)
66 | 
67 | viewKeyedStudent : Student -> (String, Html msg)
68 | viewKeyedStudent student =
69 |   ( student.name, lazy viewStudent student )
70 | 
71 | viewStudent : Student -> Html msg
72 | viewStudent student =
73 |   li [] [ text student.name ]
74 | ```
75 | 
76 | By 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.
77 | 
78 | > **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!
79 | >
80 | > 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.
81 | 
82 | 
83 | ## Something else?
84 | 
85 | If 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!
86 | 


--------------------------------------------------------------------------------
/docs/elm.json/package.md:
--------------------------------------------------------------------------------
 1 | # `elm.json` for packages
 2 | 
 3 | This is roughly `elm.json` for the `elm/json` package:
 4 | 
 5 | ```json
 6 | {
 7 |     "type": "package",
 8 |     "name": "elm/json",
 9 |     "summary": "Encode and decode JSON values",
10 |     "license": "BSD-3-Clause",
11 |     "version": "1.0.0",
12 |     "exposed-modules": [
13 |         "Json.Decode",
14 |         "Json.Encode"
15 |     ],
16 |     "elm-version": "0.19.0 <= v < 0.20.0",
17 |     "dependencies": {
18 |         "elm/core": "1.0.0 <= v < 2.0.0"
19 |     },
20 |     "test-dependencies": {}
21 | }
22 | ```
23 | 
24 | 

25 | 
26 | 
27 | ## `"type"`
28 | 
29 | Either `"application"` or `"package"`. All the other fields are based on this choice.
30 | 
31 | 

32 | 
33 | 
34 | ## `"name"`
35 | 
36 | The name of a GitHub repo like `"elm-lang/core"` or `"rtfeldman/elm-css"`.
37 | 
38 | > **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.
39 | 
40 | 

41 | 
42 | 
43 | ## `"summary"`
44 | 
45 | A 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.
46 | 
47 | 

48 | 
49 | 
50 | ## `"license"`
51 | 
52 | An 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/).
53 | 
54 | 

55 | 
56 | 
57 | ## `"version"`
58 | 
59 | All packages start at `"1.0.0"` and from there, Elm automatically enforces semantic versioning by comparing API changes.
60 | 
61 | So 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.
62 | 
63 | 

64 | 
65 | 
66 | ## `"exposed-modules"`
67 | 
68 | A 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/).
69 | 
70 | **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.
71 | 
72 | 

73 | 
74 | 
75 | ## `"elm-version"`
76 | 
77 | The 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.
78 | 
79 | 

80 | 
81 | 
82 | ## `"dependencies"`
83 | 
84 | A 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!
85 | 
86 | > **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.
87 | 
88 | 

89 | 
90 | 
91 | ## `"test-dependencies"`
92 | 
93 | Dependencies that are only used in the `tests/` directory by `elm test`. Values from these packages will not appear in any final build artifacts.
94 | 


--------------------------------------------------------------------------------
/compiler/src/Elm/String.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
  2 | {-# LANGUAGE BangPatterns, EmptyDataDecls, FlexibleInstances #-}
  3 | module Elm.String
  4 |   ( String
  5 |   , toChars
  6 |   , toBuilder
  7 |   , Chunk(..)
  8 |   , fromChunks
  9 |   )
 10 |   where
 11 | 
 12 | 
 13 | import Prelude hiding (String)
 14 | import Data.Binary (Binary, get, put)
 15 | import Data.Bits ((.&.), shiftR)
 16 | import qualified Data.ByteString.Builder as B
 17 | import qualified Data.Utf8 as Utf8
 18 | import Data.Utf8 (MBA, newByteArray, copyFromPtr, freeze, writeWord8)
 19 | import GHC.Exts (RealWorld, Ptr)
 20 | import GHC.IO (stToIO, unsafeDupablePerformIO)
 21 | import GHC.ST (ST)
 22 | import GHC.Word (Word8)
 23 | 
 24 | 
 25 | 
 26 | -- STRINGS
 27 | 
 28 | 
 29 | type String =
 30 |   Utf8.Utf8 ELM_STRING
 31 | 
 32 | 
 33 | data ELM_STRING
 34 | 
 35 | 
 36 | 
 37 | -- HELPERS
 38 | 
 39 | 
 40 | toChars :: String -> [Char]
 41 | toChars =
 42 |   Utf8.toChars
 43 | 
 44 | 
 45 | {-# INLINE toBuilder #-}
 46 | toBuilder :: String -> B.Builder
 47 | toBuilder =
 48 |   Utf8.toBuilder
 49 | 
 50 | 
 51 | 
 52 | -- FROM CHUNKS
 53 | 
 54 | 
 55 | data Chunk
 56 |   = Slice (Ptr Word8) Int
 57 |   | Escape Word8
 58 |   | CodePoint Int
 59 | 
 60 | 
 61 | fromChunks :: [Chunk] -> String
 62 | fromChunks chunks =
 63 |   unsafeDupablePerformIO (stToIO (
 64 |     do  let !len = sum (map chunkToWidth chunks)
 65 |         mba <- newByteArray len
 66 |         writeChunks mba 0 chunks
 67 |         freeze mba
 68 |   ))
 69 | 
 70 | 
 71 | chunkToWidth :: Chunk -> Int
 72 | chunkToWidth chunk =
 73 |   case chunk of
 74 |     Slice _ len -> len
 75 |     Escape _    -> 2
 76 |     CodePoint c -> if c < 0xFFFF then 6 else 12
 77 | 
 78 | 
 79 | writeChunks :: MBA RealWorld -> Int -> [Chunk] -> ST RealWorld ()
 80 | writeChunks mba offset chunks =
 81 |   case chunks of
 82 |     [] ->
 83 |       return ()
 84 | 
 85 |     chunk : chunks ->
 86 |       case chunk of
 87 |         Slice ptr len ->
 88 |           do  copyFromPtr ptr mba offset len
 89 |               let !newOffset = offset + len
 90 |               writeChunks mba newOffset chunks
 91 | 
 92 |         Escape word ->
 93 |           do  writeWord8 mba offset 0x5C {- \ -}
 94 |               writeWord8 mba (offset + 1) word
 95 |               let !newOffset = offset + 2
 96 |               writeChunks mba newOffset chunks
 97 | 
 98 |         CodePoint code ->
 99 |           if code < 0xFFFF then
100 |             do  writeCode mba offset code
101 |                 let !newOffset = offset + 6
102 |                 writeChunks mba newOffset chunks
103 |           else
104 |             do  let (hi,lo) = divMod (code - 0x10000) 0x400
105 |                 writeCode mba (offset    ) (hi + 0xD800)
106 |                 writeCode mba (offset + 6) (lo + 0xDC00)
107 |                 let !newOffset = offset + 12
108 |                 writeChunks mba newOffset chunks
109 | 
110 | 
111 | writeCode :: MBA RealWorld -> Int -> Int -> ST RealWorld ()
112 | writeCode mba offset code =
113 |   do  writeWord8 mba offset 0x5C {- \ -}
114 |       writeWord8 mba (offset + 1) 0x75 {- u -}
115 |       writeHex mba (offset + 2) (shiftR code 12)
116 |       writeHex mba (offset + 3) (shiftR code 8)
117 |       writeHex mba (offset + 4) (shiftR code 4)
118 |       writeHex mba (offset + 5) code
119 | 
120 | 
121 | writeHex :: MBA RealWorld -> Int -> Int -> ST RealWorld ()
122 | writeHex mba !offset !bits =
123 |   do  let !n = fromIntegral bits .&. 0x0F
124 |       writeWord8 mba offset (if n < 10 then 0x30 + n else 0x37 + n)
125 | 
126 | 
127 | 
128 | -- BINARY
129 | 
130 | 
131 | instance Binary (Utf8.Utf8 ELM_STRING) where
132 |   get = Utf8.getVeryLong
133 |   put = Utf8.putVeryLong
134 | 


--------------------------------------------------------------------------------
/terminal/src/Main.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE OverloadedStrings #-}
  2 | module Main
  3 |   ( main
  4 |   )
  5 |   where
  6 | 
  7 | 
  8 | import Prelude hiding (init)
  9 | import qualified Data.List as List
 10 | import qualified Text.PrettyPrint.ANSI.Leijen as P
 11 | import Text.PrettyPrint.ANSI.Leijen ((<>))
 12 | import Text.Read (readMaybe)
 13 | 
 14 | import qualified Elm.Version as V
 15 | import Terminal
 16 | import Terminal.Helpers
 17 | 
 18 | import qualified Make
 19 | 
 20 | 
 21 | 
 22 | 
 23 | -- MAIN
 24 | 
 25 | 
 26 | main :: IO ()
 27 | main =
 28 |   Terminal.app intro outro make
 29 | 
 30 | intro :: P.Doc
 31 | intro =
 32 |   P.vcat
 33 |     [ P.fillSep
 34 |         ["Hi,","thank","you","for","trying","out"
 35 |         ,P.green "elm2node"
 36 |         ,P.green (P.text (V.toChars V.compiler)) <> "."
 37 |         ,"I hope you like it!"
 38 |         ]
 39 |     , ""
 40 |     , P.black "-------------------------------------------------------------------------------"
 41 |     , P.black "This is a modified elm compiler to produce a Node.js module exposing pure"
 42 |     , P.black "functions."
 43 |     , P.black "-------------------------------------------------------------------------------"
 44 |     ]
 45 | 
 46 | 
 47 | outro :: P.Doc
 48 | outro =
 49 |   P.fillSep $ map P.text $ words $
 50 |     "Be sure to ask on the Elm slack if you run into trouble! Folks are friendly and\
 51 |     \ happy to help out. They hang out there because it is fun, so be kind to get the\
 52 |     \ best results!"
 53 | 
 54 | 
 55 | -- MAKE
 56 | 
 57 | 
 58 | make :: Terminal.Command
 59 | make =
 60 |   let
 61 |     details =
 62 |       "Compiles Elm code into Node.js module:"
 63 | 
 64 |     example =
 65 |       stack
 66 |         [ reflow
 67 |             "For example:"
 68 |         , P.indent 4 $ P.green "elm2node src/Main.elm"
 69 |         , reflow
 70 |             "This tries to compile an Elm file named src/Main.elm, generating an elm.js\
 71 |             \ Node.js module if possible. This Node.js module will expose the same values\
 72 |             \ exposed in the `Main.elm` file. Some restrictions:"
 73 |         , P.indent 4 $ P.vcat
 74 |           [ reflow "* only \"static\" values or functions with one argument can be exposed"
 75 |           , P.text "* the only accepted types in exposed values are:"
 76 |           , P.indent 4 $
 77 |               P.hcat $
 78 |                 List.intersperse (P.text ", ") $
 79 |                   List.map P.green
 80 |                     ["Int", "Float", "String", "Maybe", "Records", "List", "Array", "Json.Value"]
 81 |             
 82 |           , reflow "* exposed user defined types are silently ignored."
 83 |           ]
 84 |         ]
 85 | 
 86 |     makeFlags =
 87 |       flags Make.Flags      
 88 |         |-- 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!"
 89 |         |-- 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!"
 90 |         |-- 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."
 91 | 
 92 |   in
 93 |   Terminal.Command "make" Uncommon details example (oneOrMore elmFile) makeFlags Make.run
 94 | 
 95 | 
 96 | 
 97 | 
 98 | -- HELPERS
 99 | 
100 | 
101 | stack :: [P.Doc] -> P.Doc
102 | stack docs =
103 |   P.vcat $ List.intersperse "" docs
104 | 
105 | 
106 | reflow :: String -> P.Doc
107 | reflow string =
108 |   P.fillSep $ map P.text $ words string
109 | 


--------------------------------------------------------------------------------
/hints/comparing-custom-types.md:
--------------------------------------------------------------------------------
 1 | # Comparing Custom Types
 2 | 
 3 | The 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?
 4 | 
 5 | This page aims to catalog these scenarios and offer alternative paths that can get you unstuck.
 6 | 
 7 | 
 8 | ## Wrapped Types
 9 | 
10 | It is common to try to get some extra type safety by creating really simple custom types:
11 | 
12 | ```elm
13 | type Id = Id Int
14 | type Age = Age Int
15 | 
16 | type Comment = Comment String
17 | type Description = Description String
18 | ```
19 | 
20 | By 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!
21 | 
22 | The 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.
23 | 
24 | Instead of creating a `Dict Id Info` type, one thing you can do is create a custom data structure like this:
25 | 
26 | ```elm
27 | module User exposing (Id, Table, empty, get, add)
28 | 
29 | import Dict exposing (Dict)
30 | 
31 | 
32 | -- USER
33 | 
34 | type Id = Id Int
35 | 
36 | 
37 | -- TABLE
38 | 
39 | type Table info =
40 |   Table Int (Dict Int info)
41 | 
42 | empty : Table info
43 | empty =
44 |   Table 0 Dict.empty
45 | 
46 | get : Id -> Table info -> Maybe info
47 | get (Id id) (Table _ dict) =
48 |   Dict.get id dict
49 | 
50 | add : info -> Table info -> (Table info, Id)
51 | add info (Table nextId dict) =
52 |   ( Table (nextId + 1) (Dict.insert nextId info dict)
53 |   , Id nextId
54 |   )
55 | ```
56 | 
57 | There are a couple nice things about this approach:
58 | 
59 | 1. The only way to get a new `User.Id` is to `add` information to a `User.Table`.
60 | 2. 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.
61 | 3. 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.
62 | 
63 | So 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.
64 | 
65 | 
66 | ## Enumerations to Ints
67 | 
68 | Say you need to define a `trafficLightToInt` function:
69 | 
70 | ```elm
71 | type TrafficLight = Green | Yellow | Red
72 | 
73 | trafficLightToInt : TrafficLight -> Int
74 | trafficLightToInt trafficLight =
75 |   ???
76 | ```
77 | 
78 | We 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.
79 | 
80 | I would recommend using a `case` expression though:
81 | 
82 | ```elm
83 | type TrafficLight = Green | Yellow | Red
84 | 
85 | trafficLightToInt : TrafficLight -> Int
86 | trafficLightToInt trafficLight =
87 |   case trafficLight of
88 |     Green  -> 1
89 |     Yellow -> 2
90 |     Red    -> 3
91 | ```
92 | 
93 | This is really straight-forward while avoiding questions like “is `Green` less than or greater than `Red`?”
94 | 
95 | 
96 | ## Something else?
97 | 
98 | If 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!
99 | 


--------------------------------------------------------------------------------
/compiler/src/Reporting/Warning.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | {-# LANGUAGE OverloadedStrings #-}
  3 | module Reporting.Warning
  4 |   ( Warning(..)
  5 |   , Context(..)
  6 |   , toReport
  7 |   )
  8 |   where
  9 | 
 10 | 
 11 | import Data.Monoid ((<>))
 12 | import qualified Data.Name as Name
 13 | 
 14 | import qualified AST.Canonical as Can
 15 | import qualified AST.Utils.Type as Type
 16 | import qualified Reporting.Annotation as A
 17 | import qualified Reporting.Doc as D
 18 | import qualified Reporting.Report as Report
 19 | import qualified Reporting.Render.Code as Code
 20 | import qualified Reporting.Render.Type as RT
 21 | import qualified Reporting.Render.Type.Localizer as L
 22 | 
 23 | 
 24 | 
 25 | -- ALL POSSIBLE WARNINGS
 26 | 
 27 | 
 28 | data Warning
 29 |   = UnusedImport A.Region Name.Name
 30 |   | UnusedVariable A.Region Context Name.Name
 31 |   | MissingTypeAnnotation A.Region Name.Name Can.Type
 32 | 
 33 | 
 34 | data Context = Def | Pattern
 35 | 
 36 | 
 37 | 
 38 | -- TO REPORT
 39 | 
 40 | 
 41 | toReport :: L.Localizer -> Code.Source -> Warning -> Report.Report
 42 | toReport localizer source warning =
 43 |   case warning of
 44 |     UnusedImport region moduleName ->
 45 |       Report.Report "unused import" region [] $
 46 |         Code.toSnippet source region Nothing
 47 |           (
 48 |             D.reflow $
 49 |               "Nothing from the `" <> Name.toChars moduleName <> "` module is used in this file."
 50 |           ,
 51 |             "I recommend removing unused imports."
 52 |           )
 53 | 
 54 |     UnusedVariable region context name ->
 55 |       let title = defOrPat context "unused definition" "unused variable" in
 56 |       Report.Report title region [] $
 57 |         Code.toSnippet source region Nothing
 58 |           (
 59 |             D.reflow $
 60 |               "You are not using `" <> Name.toChars name <> "` anywhere."
 61 |           ,
 62 |             D.stack
 63 |               [ D.reflow $
 64 |                   "Is there a typo? Maybe you intended to use `" <> Name.toChars name
 65 |                   <> "` somewhere but typed another name instead?"
 66 |               , D.reflow $
 67 |                   defOrPat context
 68 |                     ( "If you are sure there is no typo, remove the definition.\
 69 |                       \ This way future readers will not have to wonder why it is there!"
 70 |                     )
 71 |                     ( "If you are sure there is no typo, replace `" <> Name.toChars name
 72 |                       <> "` with _ so future readers will not have to wonder why it is there!"
 73 |                     )
 74 |               ]
 75 |           )
 76 | 
 77 |     MissingTypeAnnotation region name inferredType ->
 78 |         Report.Report "missing type annotation" region [] $
 79 |           Code.toSnippet source region Nothing
 80 |             (
 81 |               D.reflow $
 82 |                 case Type.deepDealias inferredType of
 83 |                   Can.TLambda _ _ ->
 84 |                     "The `" <> Name.toChars name <> "` function has no type annotation."
 85 | 
 86 |                   _ ->
 87 |                     "The `" <> Name.toChars name <> "` definition has no type annotation."
 88 |             ,
 89 |               D.stack
 90 |                 [ "I inferred the type annotation myself though! You can copy it into your code:"
 91 |                 , D.green $ D.hang 4 $ D.sep $
 92 |                     [ D.fromName name <> " :"
 93 |                     , RT.canToDoc localizer RT.None inferredType
 94 |                     ]
 95 |                 ]
 96 |             )
 97 | 
 98 | 
 99 | defOrPat :: Context -> a -> a -> a
100 | defOrPat context def pat =
101 |   case context of
102 |     Def -> def
103 |     Pattern -> pat
104 | 
105 | 


--------------------------------------------------------------------------------
/compiler/src/AST/Utils/Type.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | {-# LANGUAGE OverloadedStrings #-}
  3 | module AST.Utils.Type
  4 |   ( delambda
  5 |   , dealias
  6 |   , deepDealias
  7 |   , iteratedDealias
  8 |   , FunctionType(..)
  9 |   , toFunctionType
 10 |   )
 11 |   where
 12 | 
 13 | 
 14 | import qualified Data.Map as Map
 15 | import qualified Data.Name as Name
 16 | 
 17 | import AST.Canonical (Type(..), AliasType(..), FieldType(..), Annotation(..), FreeVars)
 18 | 
 19 | 
 20 | 
 21 | -- DELAMBDA
 22 | 
 23 | 
 24 | delambda :: Type -> [Type]
 25 | delambda tipe =
 26 |   case tipe of
 27 |     TLambda arg result ->
 28 |       arg : delambda result
 29 | 
 30 |     _ ->
 31 |       [tipe]
 32 | 
 33 | 
 34 | 
 35 | -- DEALIAS
 36 | 
 37 | 
 38 | dealias :: [(Name.Name, Type)] -> AliasType -> Type
 39 | dealias args aliasType =
 40 |   case aliasType of
 41 |     Holey tipe ->
 42 |       dealiasHelp (Map.fromList args) tipe
 43 | 
 44 |     Filled tipe ->
 45 |       tipe
 46 | 
 47 | 
 48 | dealiasHelp :: Map.Map Name.Name Type -> Type -> Type
 49 | dealiasHelp typeTable tipe =
 50 |   case tipe of
 51 |     TLambda a b ->
 52 |       TLambda
 53 |         (dealiasHelp typeTable a)
 54 |         (dealiasHelp typeTable b)
 55 | 
 56 |     TVar x ->
 57 |       Map.findWithDefault tipe x typeTable
 58 | 
 59 |     TRecord fields ext ->
 60 |       TRecord (Map.map (dealiasField typeTable) fields) ext
 61 | 
 62 |     TAlias home name args t' ->
 63 |       TAlias home name (map (fmap (dealiasHelp typeTable)) args) t'
 64 | 
 65 |     TType home name args ->
 66 |       TType home name (map (dealiasHelp typeTable) args)
 67 | 
 68 |     TUnit ->
 69 |       TUnit
 70 | 
 71 |     TTuple a b maybeC ->
 72 |       TTuple
 73 |         (dealiasHelp typeTable a)
 74 |         (dealiasHelp typeTable b)
 75 |         (fmap (dealiasHelp typeTable) maybeC)
 76 | 
 77 | 
 78 | dealiasField :: Map.Map Name.Name Type -> FieldType -> FieldType
 79 | dealiasField typeTable (FieldType index tipe) =
 80 |   FieldType index (dealiasHelp typeTable tipe)
 81 | 
 82 | 
 83 | 
 84 | -- DEEP DEALIAS
 85 | 
 86 | 
 87 | deepDealias :: Type -> Type
 88 | deepDealias tipe =
 89 |   case tipe of
 90 |     TLambda a b ->
 91 |       TLambda (deepDealias a) (deepDealias b)
 92 | 
 93 |     TVar _ ->
 94 |       tipe
 95 | 
 96 |     TRecord fields ext ->
 97 |       TRecord (Map.map deepDealiasField fields) ext
 98 | 
 99 |     TAlias _ _ args tipe' ->
100 |       deepDealias (dealias args tipe')
101 | 
102 |     TType home name args ->
103 |       TType home name (map deepDealias args)
104 | 
105 |     TUnit ->
106 |       TUnit
107 | 
108 |     TTuple a b c ->
109 |       TTuple (deepDealias a) (deepDealias b) (fmap deepDealias c)
110 | 
111 | 
112 | deepDealiasField :: FieldType -> FieldType
113 | deepDealiasField (FieldType index tipe) =
114 |   FieldType index (deepDealias tipe)
115 | 
116 | 
117 | 
118 | -- ITERATED DEALIAS
119 | 
120 | 
121 | iteratedDealias :: Type -> Type
122 | iteratedDealias tipe =
123 |   case tipe of
124 |     TAlias _ _ args realType ->
125 |       iteratedDealias (dealias args realType)
126 | 
127 |     _ ->
128 |       tipe
129 | 
130 | 
131 | 
132 | -- FUNCTION TYPE
133 | 
134 | data FunctionType =
135 |   FunctionType
136 |     { _f_freeVars :: FreeVars
137 |     , _resultType :: Type
138 |     , _args :: [Type]
139 |     }
140 | 
141 | toFunctionType :: Annotation -> FunctionType
142 | toFunctionType (Forall freeVars tipe) =
143 |   let
144 |     (res, args) = 
145 |       gatherArgs tipe
146 |   in
147 |   FunctionType freeVars res args
148 |     
149 | 
150 | gatherArgs :: Type -> (Type, [Type])
151 | gatherArgs tipe =
152 |   case tipe of
153 |     TLambda arg res ->
154 |       let
155 |         (res2, args) =
156 |           gatherArgs res
157 |       in
158 |       (res2, arg : args)
159 |   
160 |     _ ->
161 |       (tipe, [])
162 | 


--------------------------------------------------------------------------------
/hints/init.md:
--------------------------------------------------------------------------------
 1 | 
 2 | # Creating an Elm project
 3 | 
 4 | The main goal of `elm init` is to get you to this page!
 5 | 
 6 | It just creates an `elm.json` file and a `src/` directory for your code.
 7 | 
 8 | 
 9 | ## What is `elm.json`?
10 | 
11 | This 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).
12 | 
13 | You 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`.
14 | 
15 | 
16 | ## What goes in `src/`?
17 | 
18 | This 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.
19 | 
20 | 
21 | ## How do I compile it?
22 | 
23 | Run `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!
24 | 
25 | If 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.
26 | 
27 | 
28 | ## How do I structure my directories?
29 | 
30 | Many 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!
31 | 
32 | So 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.
33 | 
34 | The 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.
35 | 
36 | 
37 | ## How do I write tests?
38 | 
39 | Elm 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_.
40 | 
41 | From 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!
42 | 
43 | 
44 | ## How do I start fancier projects?
45 | 
46 | I 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:
47 | 
48 | ```bash
49 | git clone https://github.com/evancz/elm-todomvc.git
50 | git clone https://github.com/rtfeldman/elm-spa-example.git
51 | ```
52 | 
53 | The 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.
54 | 
55 | But 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!
56 | 


--------------------------------------------------------------------------------
/installers/mac/README.md:
--------------------------------------------------------------------------------
 1 | # Install Instructions
 2 | 
 3 | The 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)!
 4 | 
 5 | But it is also possible to install by running the following commands in your terminal:
 6 | 
 7 | ```bash
 8 | # Move to your Desktop so you can see what is going on easier.
 9 | #
10 | cd ~/Desktop/
11 | 
12 | # Download the 0.19.1 binary for Linux.
13 | #
14 | # +-----------+----------------------+
15 | # | FLAG      | MEANING              |
16 | # +-----------+----------------------+
17 | # | -L        | follow redirects     |
18 | # | -o elm.gz | name the file elm.gz |
19 | # +-----------+----------------------+
20 | #
21 | curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-mac-64-bit.gz
22 | 
23 | # There should now be a file named `elm.gz` on your Desktop.
24 | #
25 | # The downloaded file is compressed to make it faster to download.
26 | # This next command decompresses it, replacing `elm.gz` with `elm`.
27 | #
28 | gunzip elm.gz
29 | 
30 | # There should now be a file named `elm` on your Desktop!
31 | #
32 | # Every file has "permissions" about whether it can be read, written, or executed.
33 | # So before we use this file, we need to mark this file as executable:
34 | #
35 | chmod +x elm
36 | 
37 | # The `elm` file is now executable. That means running `~/Desktop/elm --help`
38 | # should work. Saying `./elm --help` works the same.
39 | #
40 | # But we want to be able to say `elm --help` without specifying the full file
41 | # path every time. We can do this by moving the `elm` binary to one of the
42 | # directories listed in your `PATH` environment variable:
43 | #
44 | sudo mv elm /usr/local/bin/
45 | 
46 | # Now it should be possible to run the `elm` binary just by saying its name!
47 | #
48 | elm --help
49 | ```
50 | 
51 | 

52 | 
53 | ## What is the `PATH` variable?
54 | 
55 | When you run a command like `elm make src/Main.elm`, your computer starts by trying to find an executable file called `elm`.
56 | 
57 | The `PATH` is the list of directories that get searched. You can see these directories by running:
58 | 
59 | ```bash
60 | echo $PATH
61 | ```
62 | 
63 | This 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.
64 | 
65 | When 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.
66 | 
67 | So 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.
68 | 
69 | So 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`.
70 | 
71 | **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.
72 | 
73 | 
74 | 

75 | 
76 | ## Uninstall
77 | 
78 | The following commands should remove everything:
79 | 
80 | ```bash
81 | # Remove the `elm` executable.
82 | #
83 | sudo rm /usr/local/bin/elm
84 | 
85 | # Remove any cached files. The files here reduce compile times when
86 | # starting new projects and make it possible to work offline in more
87 | # cases. No need to keep it around if you are uninstalling though!
88 | #
89 | rm -r ~/.elm/
90 | ```
91 | 
92 | If you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.
93 | 
94 | 


--------------------------------------------------------------------------------
/terminal/impl/Terminal/Helpers.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE OverloadedStrings #-}
  2 | module Terminal.Helpers
  3 |   ( version
  4 |   , elmFile
  5 |   , package
  6 |   )
  7 |   where
  8 | 
  9 | 
 10 | import qualified Data.ByteString.UTF8 as BS_UTF8
 11 | import qualified Data.Char as Char
 12 | import qualified Data.List as List
 13 | import qualified Data.Map as Map
 14 | import qualified Data.Utf8 as Utf8
 15 | import qualified System.FilePath as FP
 16 | 
 17 | import Terminal (Parser(..))
 18 | import qualified Deps.Registry as Registry
 19 | import qualified Elm.Package as Pkg
 20 | import qualified Elm.Version as V
 21 | import qualified Parse.Primitives as P
 22 | import qualified Stuff
 23 | import qualified Reporting.Suggest as Suggest
 24 | 
 25 | 
 26 | 
 27 | -- VERSION
 28 | 
 29 | 
 30 | version :: Parser V.Version
 31 | version =
 32 |   Parser
 33 |     { _singular = "version"
 34 |     , _plural = "versions"
 35 |     , _parser = parseVersion
 36 |     , _suggest = suggestVersion
 37 |     , _examples = return . exampleVersions
 38 |     }
 39 | 
 40 | 
 41 | parseVersion :: String -> Maybe V.Version
 42 | parseVersion chars =
 43 |   case P.fromByteString V.parser (,) (BS_UTF8.fromString chars) of
 44 |     Right vsn -> Just vsn
 45 |     Left _    -> Nothing
 46 | 
 47 | 
 48 | suggestVersion :: String -> IO [String]
 49 | suggestVersion _ =
 50 |   return []
 51 | 
 52 | 
 53 | exampleVersions :: String -> [String]
 54 | exampleVersions chars =
 55 |   let
 56 |     chunks = map Utf8.toChars (Utf8.split 0x2E {-.-} (Utf8.fromChars chars))
 57 |     isNumber cs = not (null cs) && all Char.isDigit cs
 58 |   in
 59 |   if all isNumber chunks then
 60 |     case chunks of
 61 |       [x]     -> [ x ++ ".0.0" ]
 62 |       [x,y]   -> [ x ++ "." ++ y ++ ".0" ]
 63 |       x:y:z:_ -> [ x ++ "." ++ y ++ "." ++ z ]
 64 |       _       -> ["1.0.0", "2.0.3"]
 65 | 
 66 |   else
 67 |     ["1.0.0", "2.0.3"]
 68 | 
 69 | 
 70 | 
 71 | -- ELM FILE
 72 | 
 73 | 
 74 | elmFile :: Parser FilePath
 75 | elmFile =
 76 |   Parser
 77 |     { _singular = "elm file"
 78 |     , _plural = "elm files"
 79 |     , _parser = parseElmFile
 80 |     , _suggest = \_ -> return []
 81 |     , _examples = exampleElmFiles
 82 |     }
 83 | 
 84 | 
 85 | parseElmFile :: String -> Maybe FilePath
 86 | parseElmFile chars =
 87 |   if FP.takeExtension chars == ".elm" then
 88 |     Just chars
 89 |   else
 90 |     Nothing
 91 | 
 92 | 
 93 | exampleElmFiles :: String -> IO [String]
 94 | exampleElmFiles _ =
 95 |   return ["Main.elm","src/Main.elm"]
 96 | 
 97 | 
 98 | 
 99 | -- PACKAGE
100 | 
101 | 
102 | package :: Parser Pkg.Name
103 | package =
104 |   Parser
105 |     { _singular = "package"
106 |     , _plural = "packages"
107 |     , _parser = parsePackage
108 |     , _suggest = suggestPackages
109 |     , _examples = examplePackages
110 |     }
111 | 
112 | 
113 | parsePackage :: String -> Maybe Pkg.Name
114 | parsePackage chars =
115 |   case P.fromByteString Pkg.parser (,) (BS_UTF8.fromString chars) of
116 |     Right pkg -> Just pkg
117 |     Left _    -> Nothing
118 | 
119 | 
120 | suggestPackages :: String -> IO [String]
121 | suggestPackages given =
122 |   do  cache <- Stuff.getPackageCache
123 |       maybeRegistry <- Registry.read cache
124 |       return $
125 |         case maybeRegistry of
126 |           Nothing ->
127 |             []
128 | 
129 |           Just (Registry.Registry _ versions) ->
130 |             filter (List.isPrefixOf given) $
131 |               map Pkg.toChars (Map.keys versions)
132 | 
133 | 
134 | examplePackages :: String -> IO [String]
135 | examplePackages given =
136 |   do  cache <- Stuff.getPackageCache
137 |       maybeRegistry <- Registry.read cache
138 |       return $
139 |         case maybeRegistry of
140 |           Nothing ->
141 |             [ "elm/json"
142 |             , "elm/http"
143 |             , "elm/random"
144 |             ]
145 | 
146 |           Just (Registry.Registry _ versions) ->
147 |             map Pkg.toChars $ take 4 $
148 |               Suggest.sort given Pkg.toChars (Map.keys versions)
149 | 


--------------------------------------------------------------------------------
/installers/linux/README.md:
--------------------------------------------------------------------------------
 1 | # Install Instructions
 2 | 
 3 | The pre-compiled binary for Linux works on a very wide range of distributions.
 4 | 
 5 | It should be possible to install it by running the following commands in your terminal:
 6 | 
 7 | ```bash
 8 | # Move to your Desktop so you can see what is going on easier.
 9 | #
10 | cd ~/Desktop/
11 | 
12 | # Download the 0.1.0 binary for Linux.
13 | #
14 | # +----------------+---------------------------+
15 | # | FLAG           | MEANING                   |
16 | # +----------------+---------------------------+
17 | # | -L             | follow redirects          |
18 | # | -o elm2node.gz | name the file elm2node.gz |
19 | # +----------------+---------------------------+
20 | #
21 | curl -L -o elm2node.gz https://github.com/sebsheep/elm2node/releases/download/0.1.0-alpha-2/elm2node.gz
22 | 
23 | # There should now be a file named `elm2node.gz` on your Desktop.
24 | #
25 | # The downloaded file is compressed to make it faster to download.
26 | # This next command decompresses it, replacing `elm.gz` with `elm`.
27 | #
28 | gunzip elm2node.gz
29 | 
30 | # There should now be a file named `elm2node` on your Desktop!
31 | #
32 | # Every file has "permissions" about whether it can be read, written, or executed.
33 | # So before we use this file, we need to mark this file as executable:
34 | #
35 | chmod +x elm2node
36 | 
37 | # The `elm2node` file is now executable. That means running `~/Desktop/elm2node --help`
38 | # should work. Saying `./elm2node --help` works the same.
39 | #
40 | # But we want to be able to say `elm2node --help` without specifying the full file
41 | # path every time. We can do this by moving the `elm2node` binary to one of the
42 | # directories listed in your `PATH` environment variable:
43 | #
44 | sudo mv elm2node /usr/local/bin/
45 | 
46 | # Now it should be possible to run the `elm2node` binary just by saying its name!
47 | #
48 | elm2node --help
49 | ```
50 | 
51 | 

52 | 
53 | ## Wait, what is the `PATH` variable?
54 | 
55 | When you run a command like `elm2node src/Main.elm`, your computer starts by trying to find an executable file called `elm2node`.
56 | 
57 | The `PATH` is the list of directories that get searched. You can see these directories by running:
58 | 
59 | ```bash
60 | echo $PATH
61 | ```
62 | 
63 | This 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.
64 | 
65 | When I run `elm2node src/Main.elm`, my terminal starts by searching these five directories for an executable file named `elm2node`. It finds `/usr/local/bin/elm2node` and then runs `/usr/local/bin/elm2node src/Main.elm` with whatever arguments I gave.
66 | 
67 | So 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.
68 | 
69 | So the point of running `sudo mv elm2node /usr/local/bin/` is to turn the `elm` binary into a terminal command, allowing us to call it just like `ls` and `cd`.
70 | 
71 | **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.
72 | 
73 | 
74 | 

75 | 
76 | ## Uninstall
77 | 
78 | The following command should remove everything:
79 | 
80 | ```bash
81 | # Remove the `elm2node` executable.
82 | #
83 | sudo rm /usr/local/bin/elm2node
84 | ```
85 | 
86 | 

87 | 
88 | ## I did'nt write these instructions!
89 | 
90 | These instructions are almost the same than [the ones to install the official elm compiler](https://github.com/elm/compiler/blob/master/installers/linux/README.md),
91 | I've just replace `elm` by `elm2node` at some places.
92 | 
93 | I think these instructions are very well written and would looooove that all install instructions
94 | being so nice and instructive, instead of cryptic bash commands!
95 | 
96 | So thank you Evan for those wonderfull instructions!


--------------------------------------------------------------------------------
/compiler/src/Reporting/Error/Main.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | {-# LANGUAGE OverloadedStrings #-}
  3 | module Reporting.Error.Main
  4 |   ( Error(..)
  5 |   , toReport
  6 |   )
  7 |   where
  8 | 
  9 | 
 10 | import qualified Data.Name as Name
 11 | 
 12 | import qualified AST.Canonical as Can
 13 | import qualified Reporting.Annotation as A
 14 | import qualified Reporting.Doc as D
 15 | import qualified Reporting.Error.Canonicalize as E
 16 | import qualified Reporting.Render.Code as Code
 17 | import qualified Reporting.Render.Type as RT
 18 | import qualified Reporting.Render.Type.Localizer as L
 19 | import qualified Reporting.Report as Report
 20 | 
 21 | 
 22 | 
 23 | -- ERROR
 24 | 
 25 | 
 26 | data Error
 27 |   = BadType A.Region Can.Type
 28 |   | BadCycle A.Region Name.Name [Name.Name]
 29 |   | BadFlags A.Region Can.Type E.InvalidPayload
 30 | 
 31 | 
 32 | 
 33 | -- TO REPORT
 34 | 
 35 | 
 36 | toReport :: L.Localizer -> Code.Source -> Error -> Report.Report
 37 | toReport localizer source err =
 38 |   case err of
 39 |     BadType region tipe ->
 40 |       Report.Report "BAD MAIN TYPE" region [] $
 41 |         Code.toSnippet source region Nothing
 42 |           (
 43 |             "I cannot handle this type of `main` value:"
 44 |           ,
 45 |             D.stack
 46 |               [ "The type of `main` value I am seeing is:"
 47 |               , D.indent 4 $ D.dullyellow $ RT.canToDoc localizer RT.None tipe
 48 |               , D.reflow $
 49 |                   "I only know how to handle Html, Svg, and Programs\
 50 |                   \ though. Modify `main` to be one of those types of values!"
 51 |               ]
 52 |           )
 53 | 
 54 |     BadCycle region name names ->
 55 |       Report.Report "BAD MAIN" region [] $
 56 |         Code.toSnippet source region Nothing
 57 |           (
 58 |             "A `main` definition cannot be defined in terms of itself."
 59 |           ,
 60 |             D.stack
 61 |               [ D.reflow $
 62 |                   "It should be a boring value with no recursion. But\
 63 |                   \ instead it is involved in this cycle of definitions:"
 64 |               , D.cycle 4 name names
 65 |               ]
 66 |           )
 67 | 
 68 |     BadFlags region _badType invalidPayload ->
 69 |       let
 70 |         formatDetails (aBadKindOfThing, butThatIsNoGood) =
 71 |           Report.Report "BAD FLAGS" region [] $
 72 |             Code.toSnippet source region Nothing
 73 |               (
 74 |                 D.reflow $
 75 |                   "Your `main` program wants " ++ aBadKindOfThing ++ " from JavaScript."
 76 |               ,
 77 |                 butThatIsNoGood
 78 |               )
 79 |       in
 80 |       formatDetails $
 81 |         case invalidPayload of
 82 |           E.ExtendedRecord ->
 83 |             (
 84 |               "an extended record"
 85 |             ,
 86 |               D.reflow $
 87 |                 "But the exact shape of the record must be known at compile time. No type variables!"
 88 |             )
 89 | 
 90 |           E.Function ->
 91 |             (
 92 |               "a function"
 93 |             ,
 94 |               D.reflow $
 95 |                 "But if I allowed functions from JS, it would be possible to sneak\
 96 |                 \ side-effects and runtime exceptions into Elm!"
 97 |             )
 98 | 
 99 |           E.TypeVariable name ->
100 |             (
101 |               "an unspecified type"
102 |             ,
103 |               D.reflow $
104 |                 "But type variables like `" ++ Name.toChars name ++ "` cannot be given as flags.\
105 |                 \ I need to know exactly what type of data I am getting, so I can guarantee that\
106 |                 \ unexpected data cannot sneak in and crash the Elm program."
107 |             )
108 | 
109 |           E.UnsupportedType name ->
110 |             (
111 |               "a `" ++ Name.toChars name ++ "` value"
112 |             ,
113 |               D.stack
114 |                 [ D.reflow $ "I cannot handle that. The types that CAN be in flags include:"
115 |                 , D.indent 4 $
116 |                     D.reflow $
117 |                       "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\
118 |                       \ tuples, records, and JSON values."
119 |                 , D.reflow $
120 |                     "Since JSON values can flow through, you can use JSON encoders and decoders\
121 |                     \ to allow other types through as well. More advanced users often just do\
122 |                     \ everything with encoders and decoders for more control and better errors."
123 |                 ]
124 |             )
125 | 


--------------------------------------------------------------------------------
/compiler/src/AST/Source.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | module AST.Source
  3 |   ( Expr, Expr_(..), VarType(..)
  4 |   , Def(..)
  5 |   , Pattern, Pattern_(..)
  6 |   , Type, Type_(..)
  7 |   , Module(..)
  8 |   , getName
  9 |   , getImportName
 10 |   , Import(..)
 11 |   , Value(..)
 12 |   , Union(..)
 13 |   , Alias(..)
 14 |   , Infix(..)
 15 |   , Port(..)
 16 |   , Effects(..)
 17 |   , Manager(..)
 18 |   , Docs(..)
 19 |   , Comment(..)
 20 |   , Exposing(..)
 21 |   , Exposed(..)
 22 |   , Privacy(..)
 23 |   )
 24 |   where
 25 | 
 26 | 
 27 | import Data.Name (Name)
 28 | import qualified Data.Name as Name
 29 | 
 30 | import qualified AST.Utils.Binop as Binop
 31 | import qualified AST.Utils.Shader as Shader
 32 | import qualified Elm.Float as EF
 33 | import qualified Elm.String as ES
 34 | import qualified Parse.Primitives as P
 35 | import qualified Reporting.Annotation as A
 36 | 
 37 | 
 38 | 
 39 | -- EXPRESSIONS
 40 | 
 41 | 
 42 | type Expr = A.Located Expr_
 43 | 
 44 | 
 45 | data Expr_
 46 |   = Chr ES.String
 47 |   | Str ES.String
 48 |   | Int Int
 49 |   | Float EF.Float
 50 |   | Var VarType Name
 51 |   | VarQual VarType Name Name
 52 |   | List [Expr]
 53 |   | Op Name
 54 |   | Negate Expr
 55 |   | Binops [(Expr, A.Located Name)] Expr
 56 |   | Lambda [Pattern] Expr
 57 |   | Call Expr [Expr]
 58 |   | If [(Expr, Expr)] Expr
 59 |   | Let [A.Located Def] Expr
 60 |   | Case Expr [(Pattern, Expr)]
 61 |   | Accessor Name
 62 |   | Access Expr (A.Located Name)
 63 |   | Update (A.Located Name) [(A.Located Name, Expr)]
 64 |   | Record [(A.Located Name, Expr)]
 65 |   | Unit
 66 |   | Tuple Expr Expr [Expr]
 67 |   | Shader Shader.Source Shader.Types
 68 | 
 69 | 
 70 | data VarType = LowVar | CapVar
 71 | 
 72 | 
 73 | 
 74 | -- DEFINITIONS
 75 | 
 76 | 
 77 | data Def
 78 |   = Define (A.Located Name) [Pattern] Expr (Maybe Type)
 79 |   | Destruct Pattern Expr
 80 | 
 81 | 
 82 | 
 83 | -- PATTERN
 84 | 
 85 | 
 86 | type Pattern = A.Located Pattern_
 87 | 
 88 | 
 89 | data Pattern_
 90 |   = PAnything
 91 |   | PVar Name
 92 |   | PRecord [A.Located Name]
 93 |   | PAlias Pattern (A.Located Name)
 94 |   | PUnit
 95 |   | PTuple Pattern Pattern [Pattern]
 96 |   | PCtor A.Region Name [Pattern]
 97 |   | PCtorQual A.Region Name Name [Pattern]
 98 |   | PList [Pattern]
 99 |   | PCons Pattern Pattern
100 |   | PChr ES.String
101 |   | PStr ES.String
102 |   | PInt Int
103 | 
104 | 
105 | 
106 | -- TYPE
107 | 
108 | 
109 | type Type =
110 |     A.Located Type_
111 | 
112 | 
113 | data Type_
114 |   = TLambda Type Type
115 |   | TVar Name
116 |   | TType A.Region Name [Type]
117 |   | TTypeQual A.Region Name Name [Type]
118 |   | TRecord [(A.Located Name, Type)] (Maybe (A.Located Name))
119 |   | TUnit
120 |   | TTuple Type Type [Type]
121 | 
122 | 
123 | 
124 | -- MODULE
125 | 
126 | 
127 | data Module =
128 |   Module
129 |     { _name    :: Maybe (A.Located Name)
130 |     , _exports :: A.Located Exposing
131 |     , _docs    :: Docs
132 |     , _imports :: [Import]
133 |     , _values  :: [A.Located Value]
134 |     , _unions  :: [A.Located Union]
135 |     , _aliases :: [A.Located Alias]
136 |     , _binops  :: [A.Located Infix]
137 |     , _effects :: Effects
138 |     }
139 | 
140 | 
141 | getName :: Module -> Name
142 | getName (Module maybeName _ _ _ _ _ _ _ _) =
143 |   case maybeName of
144 |     Just (A.At _ name) ->
145 |       name
146 | 
147 |     Nothing ->
148 |       Name._Main
149 | 
150 | 
151 | getImportName :: Import -> Name
152 | getImportName (Import (A.At _ name) _ _) =
153 |   name
154 | 
155 | 
156 | data Import =
157 |   Import
158 |     { _import :: A.Located Name
159 |     , _alias :: Maybe Name
160 |     , _exposing :: Exposing
161 |     }
162 | 
163 | 
164 | data Value = Value (A.Located Name) [Pattern] Expr (Maybe Type)
165 | data Union = Union (A.Located Name) [A.Located Name] [(A.Located Name, [Type])]
166 | data Alias = Alias (A.Located Name) [A.Located Name] Type
167 | data Infix = Infix Name Binop.Associativity Binop.Precedence Name
168 | data Port = Port (A.Located Name) Type
169 | 
170 | 
171 | data Effects
172 |   = NoEffects
173 |   | Ports [Port]
174 |   | Manager A.Region Manager
175 | 
176 | 
177 | data Manager
178 |   = Cmd (A.Located Name)
179 |   | Sub (A.Located Name)
180 |   | Fx (A.Located Name) (A.Located Name)
181 | 
182 | 
183 | data Docs
184 |   = NoDocs A.Region
185 |   | YesDocs Comment [(Name, Comment)]
186 | 
187 | 
188 | newtype Comment =
189 |   Comment P.Snippet
190 | 
191 | 
192 | 
193 | -- EXPOSING
194 | 
195 | 
196 | data Exposing
197 |   = Open
198 |   | Explicit [Exposed]
199 | 
200 | 
201 | data Exposed
202 |   = Lower (A.Located Name)
203 |   | Upper (A.Located Name) Privacy
204 |   | Operator A.Region Name
205 | 
206 | 
207 | data Privacy
208 |   = Public A.Region
209 |   | Private
210 | 


--------------------------------------------------------------------------------
/hints/missing-patterns.md:
--------------------------------------------------------------------------------
  1 | 
  2 | # Hints for Missing Patterns
  3 | 
  4 | Elm 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.
  5 | 
  6 | There are a couple techniques for making this work for you in every scenario.
  7 | 
  8 | 
  9 | ## The danger of wildcard patterns
 10 | 
 11 | A 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:
 12 | 
 13 | ```elm
 14 | type User
 15 |   = Regular String Int
 16 |   | Anonymous
 17 | 
 18 | toName : User -> String
 19 | toName user =
 20 |   case user of
 21 |     Regular name _ ->
 22 |       name
 23 | 
 24 |     _ ->
 25 |       "anonymous"
 26 | ```
 27 | 
 28 | Notice 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!
 29 | 
 30 | So instead, it is better to explicitly list all possible variants, like this:
 31 | 
 32 | ```elm
 33 | type User
 34 |   = Regular String Int
 35 |   | Visitor String
 36 |   | Anonymous
 37 | 
 38 | toName : User -> String
 39 | toName user =
 40 |   case user of
 41 |     Regular name _ ->
 42 |       name
 43 | 
 44 |     Anonymous ->
 45 |       "anonymous"
 46 | ```
 47 | 
 48 | Now 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!
 49 | 
 50 | 
 51 | ## I want to go fast!
 52 | 
 53 | Imagine 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.
 54 | 
 55 | In 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:
 56 | 
 57 | ```elm
 58 | type User
 59 |   = Regular String Int
 60 |   | Visitor String
 61 |   | Anonymous
 62 | 
 63 | toName : User -> String
 64 | toName user =
 65 |   case user of
 66 |     Regular name _ ->
 67 |       name
 68 | 
 69 |     Visitor _ ->
 70 |       Debug.todo "give the visitor name"
 71 | 
 72 |     Anonymous ->
 73 |       "anonymous"
 74 | 
 75 | -- and maybe a bunch of other things
 76 | ```
 77 | 
 78 | In 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.
 79 | 
 80 | The 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:
 81 | 
 82 |   1. The name of the module that contains the code.
 83 |   2. The line numbers of the `case` containing the TODO.
 84 |   3. The particular value that led to this TODO.
 85 | 
 86 | From that information you have a pretty good idea of what went wrong and can go fix it.
 87 | 
 88 | I 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.
 89 | 
 90 | 
 91 | ## A list that definitely is not empty
 92 | 
 93 | This can come up from time to time, but Elm **will not** let you write code like this:
 94 | 
 95 | ```elm
 96 | last : List a -> a
 97 | last list =
 98 |   case list of
 99 |     [x] ->
100 |         x
101 | 
102 |     _ :: rest ->
103 |         last rest
104 | ```
105 | 
106 | This 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:
107 | 
108 | ```elm
109 | last : List a -> Maybe a
110 | last list =
111 |   case list of
112 |     [] ->
113 |         Nothing
114 | 
115 |     [x] ->
116 |         Just x
117 | 
118 |     _ :: rest ->
119 |         last rest
120 | ```
121 | 
122 | This is nice because it lets users know that there might be a failure, so they can recover from it however they want.
123 | 
124 | The other option is to “unroll the list” one level to ensure that no one can ever provide an empty list in the first place:
125 | 
126 | ```elm
127 | last : a -> List a -> a
128 | last first rest =
129 |   case rest of
130 |     [] ->
131 |       first
132 | 
133 |     newFirst :: newRest ->
134 |       last newFirst newRest
135 | ```
136 | 
137 | By demanding the first element of the list as an argument, it becomes impossible to call this function if you have an empty list!
138 | 
139 | This “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!
140 | 


--------------------------------------------------------------------------------
/worker/src/Artifacts.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | module Artifacts
  3 |   ( Artifacts(..)
  4 |   , loadCompile
  5 |   , loadRepl
  6 |   , toDepsInfo
  7 |   )
  8 |   where
  9 | 
 10 | 
 11 | import Control.Concurrent (readMVar)
 12 | import Control.Monad (liftM2)
 13 | import qualified Data.ByteString as BS
 14 | import qualified Data.ByteString.Builder as B
 15 | import qualified Data.ByteString.Lazy as LBS
 16 | import qualified Data.Map as Map
 17 | import qualified Data.Name as N
 18 | import qualified Data.OneOrMore as OneOrMore
 19 | import qualified System.Directory as Dir
 20 | import System.FilePath (())
 21 | 
 22 | import qualified AST.Canonical as Can
 23 | import qualified AST.Optimized as Opt
 24 | import qualified BackgroundWriter as BW
 25 | import qualified Elm.Details as Details
 26 | import qualified Elm.Interface as I
 27 | import qualified Elm.ModuleName as ModuleName
 28 | import qualified Elm.Package as Pkg
 29 | import Json.Encode ((==>))
 30 | import qualified Json.Encode as E
 31 | import qualified Json.String as Json
 32 | import qualified Reporting
 33 | 
 34 | 
 35 | 
 36 | -- ARTIFACTS
 37 | 
 38 | 
 39 | data Artifacts =
 40 |   Artifacts
 41 |     { _ifaces :: Map.Map ModuleName.Raw I.Interface
 42 |     , _graph :: Opt.GlobalGraph
 43 |     }
 44 | 
 45 | 
 46 | loadCompile :: IO Artifacts
 47 | loadCompile =
 48 |   load ("outlines"  "compile")
 49 | 
 50 | 
 51 | loadRepl :: IO Artifacts
 52 | loadRepl =
 53 |   load ("outlines"  "repl")
 54 | 
 55 | 
 56 | 
 57 | -- LOAD
 58 | 
 59 | 
 60 | load :: FilePath -> IO Artifacts
 61 | load dir =
 62 |   BW.withScope $ \scope ->
 63 |   do  putStrLn $ "Loading " ++ dir  "elm.json"
 64 |       style <- Reporting.terminal
 65 |       root <- fmap ( dir) Dir.getCurrentDirectory
 66 |       result <- Details.load style scope root
 67 |       case result of
 68 |         Left _ ->
 69 |           error $ "Ran into some problem loading elm.json\nTry running `elm make` in: " ++ dir
 70 | 
 71 |         Right details ->
 72 |           do  omvar <- Details.loadObjects root details
 73 |               imvar <- Details.loadInterfaces root details
 74 |               mdeps <- readMVar imvar
 75 |               mobjs <- readMVar omvar
 76 |               case liftM2 (,) mdeps mobjs of
 77 |                 Nothing ->
 78 |                   error $ "Ran into some weird problem loading elm.json\nTry running `elm make` in: " ++ dir
 79 | 
 80 |                 Just (deps, objs) ->
 81 |                   return $ Artifacts (toInterfaces deps) objs
 82 | 
 83 | 
 84 | toInterfaces :: Map.Map ModuleName.Canonical I.DependencyInterface -> Map.Map ModuleName.Raw I.Interface
 85 | toInterfaces deps =
 86 |   Map.mapMaybe toUnique $ Map.fromListWith OneOrMore.more $
 87 |     Map.elems (Map.mapMaybeWithKey getPublic deps)
 88 | 
 89 | 
 90 | getPublic :: ModuleName.Canonical -> I.DependencyInterface -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore I.Interface)
 91 | getPublic (ModuleName.Canonical _ name) dep =
 92 |   case dep of
 93 |     I.Public  iface -> Just (name, OneOrMore.one iface)
 94 |     I.Private _ _ _ -> Nothing
 95 | 
 96 | 
 97 | toUnique :: OneOrMore.OneOrMore a -> Maybe a
 98 | toUnique oneOrMore =
 99 |   case oneOrMore of
100 |     OneOrMore.One value -> Just value
101 |     OneOrMore.More _ _  -> Nothing
102 | 
103 | 
104 | 
105 | -- TO DEPS INFO
106 | 
107 | 
108 | toDepsInfo :: Artifacts -> BS.ByteString
109 | toDepsInfo (Artifacts ifaces _) =
110 |   LBS.toStrict $ B.toLazyByteString $ E.encodeUgly $ encode ifaces
111 | 
112 | 
113 | 
114 | -- ENCODE
115 | 
116 | 
117 | encode :: Map.Map ModuleName.Raw I.Interface -> E.Value
118 | encode ifaces =
119 |   E.dict Json.fromName encodeInterface ifaces
120 | 
121 | 
122 | encodeInterface :: I.Interface -> E.Value
123 | encodeInterface (I.Interface pkg values unions aliases binops) =
124 |   E.object
125 |     [ "pkg" ==> E.chars (Pkg.toChars pkg)
126 |     , "ops" ==> E.list E.name (Map.keys binops)
127 |     , "values" ==> E.list E.name (Map.keys values)
128 |     , "aliases" ==> E.list E.name (Map.keys (Map.filter isPublicAlias aliases))
129 |     , "types" ==> E.dict Json.fromName (E.list E.name) (Map.mapMaybe toPublicUnion unions)
130 |     ]
131 | 
132 | 
133 | isPublicAlias :: I.Alias -> Bool
134 | isPublicAlias alias =
135 |   case alias of
136 |     I.PublicAlias  _ -> True
137 |     I.PrivateAlias _ -> False
138 | 
139 | 
140 | toPublicUnion :: I.Union -> Maybe [N.Name]
141 | toPublicUnion union =
142 |   case union of
143 |     I.OpenUnion (Can.Union _ variants _ _) ->
144 |       Just (map getVariantName variants)
145 | 
146 |     I.ClosedUnion _ ->
147 |       Just []
148 | 
149 |     I.PrivateUnion _ ->
150 |       Nothing
151 | 
152 | 
153 | getVariantName :: Can.Ctor -> N.Name
154 | getVariantName (Can.Ctor name _ _ _) =
155 |   name
156 | 


--------------------------------------------------------------------------------
/compiler/src/Type/UnionFind.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -funbox-strict-fields #-}
  2 | {-# LANGUAGE BangPatterns #-}
  3 | module Type.UnionFind
  4 |   ( Point
  5 |   , fresh
  6 |   , union
  7 |   , equivalent
  8 |   , redundant
  9 |   , get
 10 |   , set
 11 |   , modify
 12 |   )
 13 |   where
 14 | 
 15 | 
 16 | {- This is based on the following implementations:
 17 | 
 18 |   - https://hackage.haskell.org/package/union-find-0.2/docs/src/Data-UnionFind-IO.html
 19 |   - http://yann.regis-gianas.org/public/mini/code_UnionFind.html
 20 | 
 21 | It seems like the OCaml one came first, but I am not sure.
 22 | 
 23 | Compared to the Haskell implementation, the major changes here include:
 24 | 
 25 |   1. No more reallocating PointInfo when changing the weight
 26 |   2. Using the strict modifyIORef
 27 | 
 28 | -}
 29 | 
 30 | 
 31 | import Control.Monad ( when )
 32 | import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef)
 33 | import Data.Word (Word32)
 34 | 
 35 | 
 36 | 
 37 | -- POINT
 38 | 
 39 | 
 40 | newtype Point a =
 41 |   Pt (IORef (PointInfo a))
 42 |   deriving Eq
 43 | 
 44 | 
 45 | data PointInfo a
 46 |   = Info {-# UNPACK #-} !(IORef Word32) {-# UNPACK #-} !(IORef a)
 47 |   | Link {-# UNPACK #-} !(Point a)
 48 | 
 49 | 
 50 | 
 51 | -- HELPERS
 52 | 
 53 | 
 54 | fresh :: a -> IO (Point a)
 55 | fresh value =
 56 |   do  weight <- newIORef 1
 57 |       desc <- newIORef value
 58 |       link <- newIORef (Info weight desc)
 59 |       return (Pt link)
 60 | 
 61 | 
 62 | repr :: Point a -> IO (Point a)
 63 | repr point@(Pt ref) =
 64 |   do  pInfo <- readIORef ref
 65 |       case pInfo of
 66 |         Info _ _ ->
 67 |           return point
 68 | 
 69 |         Link point1@(Pt ref1) ->
 70 |           do  point2 <- repr point1
 71 |               when (point2 /= point1) $
 72 |                 do  pInfo1 <- readIORef ref1
 73 |                     writeIORef ref pInfo1
 74 |               return point2
 75 | 
 76 | 
 77 | get :: Point a -> IO a
 78 | get point@(Pt ref) =
 79 |   do  pInfo <- readIORef ref
 80 |       case pInfo of
 81 |         Info _ descRef ->
 82 |           readIORef descRef
 83 | 
 84 |         Link (Pt ref1) ->
 85 |           do  link' <- readIORef ref1
 86 |               case link' of
 87 |                 Info _ descRef ->
 88 |                   readIORef descRef
 89 | 
 90 |                 Link _ ->
 91 |                   get =<< repr point
 92 | 
 93 | 
 94 | set :: Point a -> a -> IO ()
 95 | set point@(Pt ref) newDesc =
 96 |   do  pInfo <- readIORef ref
 97 |       case pInfo of
 98 |         Info _ descRef ->
 99 |           writeIORef descRef newDesc
100 | 
101 |         Link (Pt ref1) ->
102 |           do  link' <- readIORef ref1
103 |               case link' of
104 |                 Info _ descRef ->
105 |                   writeIORef descRef newDesc
106 | 
107 |                 Link _ ->
108 |                   do  newPoint <- repr point
109 |                       set newPoint newDesc
110 | 
111 | 
112 | modify :: Point a -> (a -> a) -> IO ()
113 | modify point@(Pt ref) func =
114 |   do  pInfo <- readIORef ref
115 |       case pInfo of
116 |         Info _ descRef ->
117 |           modifyIORef' descRef func
118 | 
119 |         Link (Pt ref1) ->
120 |           do  link' <- readIORef ref1
121 |               case link' of
122 |                 Info _ descRef ->
123 |                   modifyIORef' descRef func
124 | 
125 |                 Link _ ->
126 |                   do  newPoint <- repr point
127 |                       modify newPoint func
128 | 
129 | 
130 | union :: Point a -> Point a -> a -> IO ()
131 | union p1 p2 newDesc =
132 |   do  point1@(Pt ref1) <- repr p1
133 |       point2@(Pt ref2) <- repr p2
134 | 
135 |       Info w1 d1 <- readIORef ref1
136 |       Info w2 d2 <- readIORef ref2
137 | 
138 |       if point1 == point2
139 |         then writeIORef d1 newDesc
140 |         else do
141 |           weight1 <- readIORef w1
142 |           weight2 <- readIORef w2
143 | 
144 |           let !newWeight = weight1 + weight2
145 | 
146 |           if weight1 >= weight2
147 |             then
148 |               do  writeIORef ref2 (Link point1)
149 |                   writeIORef w1 newWeight
150 |                   writeIORef d1 newDesc
151 |             else
152 |               do  writeIORef ref1 (Link point2)
153 |                   writeIORef w2 newWeight
154 |                   writeIORef d2 newDesc
155 | 
156 | 
157 | equivalent :: Point a -> Point a -> IO Bool
158 | equivalent p1 p2 =
159 |   do  v1 <- repr p1
160 |       v2 <- repr p2
161 |       return (v1 == v2)
162 | 
163 | 
164 | redundant :: Point a -> IO Bool
165 | redundant (Pt ref) =
166 |   do  pInfo <- readIORef ref
167 |       case pInfo of
168 |         Info _ _ ->
169 |           return False
170 | 
171 |         Link _ ->
172 |           return True
173 | 


--------------------------------------------------------------------------------
/compiler/src/Elm/Version.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | {-# LANGUAGE BangPatterns, UnboxedTuples #-}
  3 | module Elm.Version
  4 |   ( Version(..)
  5 |   , one
  6 |   , max
  7 |   , compiler
  8 |   , bumpPatch
  9 |   , bumpMinor
 10 |   , bumpMajor
 11 |   , toChars
 12 |   --
 13 |   , decoder
 14 |   , encode
 15 |   --
 16 |   , parser
 17 |   )
 18 |   where
 19 | 
 20 | 
 21 | import Prelude hiding (max)
 22 | import Control.Monad (liftM3)
 23 | import Data.Binary (Binary, get, put, getWord8, putWord8)
 24 | import qualified Data.Version as Version
 25 | import Data.Word (Word8, Word16)
 26 | import Foreign.Ptr (Ptr, plusPtr, minusPtr)
 27 | import qualified Paths_elm2node
 28 | 
 29 | import qualified Json.Decode as D
 30 | import qualified Json.Encode as E
 31 | import qualified Parse.Primitives as P
 32 | import Parse.Primitives (Row, Col)
 33 | 
 34 | 
 35 | 
 36 | -- VERSION
 37 | 
 38 | 
 39 | data Version =
 40 |   Version
 41 |     { _major :: {-# UNPACK #-} !Word16
 42 |     , _minor :: {-# UNPACK #-} !Word16
 43 |     , _patch :: {-# UNPACK #-} !Word16
 44 |     }
 45 |     deriving (Eq, Ord)
 46 | 
 47 | 
 48 | one :: Version
 49 | one =
 50 |   Version 1 0 0
 51 | 
 52 | 
 53 | max :: Version
 54 | max =
 55 |   Version maxBound 0 0
 56 | 
 57 | 
 58 | compiler :: Version
 59 | compiler =
 60 |   case map fromIntegral (Version.versionBranch Paths_elm2node.version) of
 61 |     major : minor : patch : _ ->
 62 |       Version major minor patch
 63 | 
 64 |     [major, minor] ->
 65 |       Version major minor 0
 66 | 
 67 |     [major] ->
 68 |       Version major 0 0
 69 | 
 70 |     [] ->
 71 |       error "could not detect version of elm-compiler you are using"
 72 | 
 73 | 
 74 | 
 75 | -- BUMP
 76 | 
 77 | 
 78 | bumpPatch :: Version -> Version
 79 | bumpPatch (Version major minor patch) =
 80 |   Version major minor (patch + 1)
 81 | 
 82 | 
 83 | bumpMinor :: Version -> Version
 84 | bumpMinor (Version major minor _patch) =
 85 |   Version major (minor + 1) 0
 86 | 
 87 | 
 88 | bumpMajor :: Version -> Version
 89 | bumpMajor (Version major _minor _patch) =
 90 |   Version (major + 1) 0 0
 91 | 
 92 | 
 93 | 
 94 | -- TO CHARS
 95 | 
 96 | 
 97 | toChars :: Version -> [Char]
 98 | toChars (Version major minor patch) =
 99 |   show major ++ '.' : show minor ++ '.' : show patch
100 | 
101 | 
102 | 
103 | -- JSON
104 | 
105 | 
106 | decoder :: D.Decoder (Row, Col) Version
107 | decoder =
108 |   D.customString parser (,)
109 | 
110 | 
111 | encode :: Version -> E.Value
112 | encode version =
113 |   E.chars (toChars version)
114 | 
115 | 
116 | 
117 | -- BINARY
118 | 
119 | 
120 | instance Binary Version where
121 |   get =
122 |     do  word <- getWord8
123 |         if word == 255
124 |           then liftM3 Version get get get
125 |           else
126 |             do  minor <- getWord8
127 |                 patch <- getWord8
128 |                 return (Version (fromIntegral word) (fromIntegral minor) (fromIntegral patch))
129 | 
130 |   put (Version major minor patch) =
131 |     if major < 255 && minor < 256 && patch < 256 then
132 |       do  putWord8 (fromIntegral major)
133 |           putWord8 (fromIntegral minor)
134 |           putWord8 (fromIntegral patch)
135 |     else
136 |       do  putWord8 255
137 |           put major
138 |           put minor
139 |           put patch
140 | 
141 | 
142 | 
143 | -- PARSER
144 | 
145 | 
146 | parser :: P.Parser (Row, Col) Version
147 | parser =
148 |   do  major <- numberParser
149 |       P.word1 0x2E {-.-} (,)
150 |       minor <- numberParser
151 |       P.word1 0x2E {-.-} (,)
152 |       patch <- numberParser
153 |       return (Version major minor patch)
154 | 
155 | 
156 | numberParser :: P.Parser (Row, Col) Word16
157 | numberParser =
158 |   P.Parser $ \(P.State src pos end indent row col) cok _ _ eerr ->
159 |     if pos >= end then
160 |       eerr row col (,)
161 |     else
162 |       let !word = P.unsafeIndex pos in
163 |       if word == 0x30 {-0-} then
164 | 
165 |         let
166 |           !newState = P.State src (plusPtr pos 1) end indent row (col + 1)
167 |         in
168 |         cok 0 newState
169 | 
170 |       else if isDigit word then
171 | 
172 |         let
173 |           (# total, newPos #) = chompWord16 (plusPtr pos 1) end (fromIntegral (word - 0x30))
174 |           !newState = P.State src newPos end indent row (col + fromIntegral (minusPtr newPos pos))
175 |         in
176 |         cok total newState
177 | 
178 |       else
179 |         eerr row col (,)
180 | 
181 | 
182 | chompWord16 :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Word16, Ptr Word8 #)
183 | chompWord16 pos end total =
184 |   if pos >= end then
185 |     (# total, pos #)
186 |   else
187 |     let !word = P.unsafeIndex pos in
188 |     if isDigit word then
189 |       chompWord16 (plusPtr pos 1) end (10 * total + fromIntegral (word - 0x30))
190 |     else
191 |       (# total, pos #)
192 | 
193 | 
194 | isDigit :: Word8 -> Bool
195 | isDigit word =
196 |   0x30 {-0-} <= word && word <= 0x39 {-9-}
197 | 


--------------------------------------------------------------------------------
/compiler/src/Json/String.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
  2 | {-# LANGUAGE BangPatterns, EmptyDataDecls #-}
  3 | module Json.String
  4 |   ( String
  5 |   , isEmpty
  6 |   --
  7 |   , fromPtr
  8 |   , fromName
  9 |   , fromChars
 10 |   , fromSnippet
 11 |   , fromComment
 12 |   --
 13 |   , toChars
 14 |   , toBuilder
 15 |   )
 16 |   where
 17 | 
 18 | 
 19 | import Prelude hiding (String)
 20 | import qualified Data.ByteString.Builder as B
 21 | import qualified Data.Coerce as Coerce
 22 | import qualified Data.Name as Name
 23 | import qualified Data.Utf8 as Utf8
 24 | import Data.Utf8 (MBA, newByteArray, copyFromPtr, freeze, writeWord8)
 25 | import Data.Word (Word8)
 26 | import Foreign.Ptr (Ptr, plusPtr, minusPtr)
 27 | import Foreign.ForeignPtr (withForeignPtr)
 28 | import GHC.Exts (RealWorld)
 29 | import GHC.IO (stToIO, unsafeDupablePerformIO, unsafePerformIO)
 30 | import GHC.ST (ST)
 31 | 
 32 | import qualified Parse.Primitives as P
 33 | 
 34 | 
 35 | 
 36 | -- JSON STRINGS
 37 | 
 38 | 
 39 | -- INVARIANT: any Json.String is appropriately escaped already
 40 | -- PERF: is this the right representation for Json.String? Maybe ByteString instead?
 41 | --
 42 | type String =
 43 |   Utf8.Utf8 JSON_STRING
 44 | 
 45 | 
 46 | data JSON_STRING
 47 | 
 48 | 
 49 | isEmpty :: String -> Bool
 50 | isEmpty =
 51 |   Utf8.isEmpty
 52 | 
 53 | 
 54 | 
 55 | -- FROM
 56 | 
 57 | 
 58 | fromPtr :: Ptr Word8 -> Ptr Word8 -> String
 59 | fromPtr =
 60 |   Utf8.fromPtr
 61 | 
 62 | 
 63 | fromChars :: [Char] -> String
 64 | fromChars =
 65 |   Utf8.fromChars
 66 | 
 67 | 
 68 | fromSnippet :: P.Snippet -> String
 69 | fromSnippet =
 70 |   Utf8.fromSnippet
 71 | 
 72 | 
 73 | fromName :: Name.Name -> String
 74 | fromName =
 75 |   Coerce.coerce
 76 | 
 77 | 
 78 | 
 79 | -- TO
 80 | 
 81 | 
 82 | toChars :: String -> [Char]
 83 | toChars =
 84 |   Utf8.toChars
 85 | 
 86 | 
 87 | {-# INLINE toBuilder #-}
 88 | toBuilder :: String -> B.Builder
 89 | toBuilder =
 90 |   Utf8.toBuilder
 91 | 
 92 | 
 93 | 
 94 | -- FROM COMMENT
 95 | 
 96 | 
 97 | fromComment :: P.Snippet -> String
 98 | fromComment (P.Snippet fptr off len _ _) =
 99 |   unsafePerformIO $ withForeignPtr fptr $ \ptr ->
100 |     let
101 |       !pos = plusPtr ptr off
102 |       !end = plusPtr pos len
103 |       !str = fromChunks (chompChunks pos end pos [])
104 |     in
105 |     return str
106 | 
107 | 
108 | chompChunks :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
109 | chompChunks pos end start revChunks =
110 |   if pos >= end then
111 |     reverse (addSlice start end revChunks)
112 |   else
113 |     let
114 |       !word = P.unsafeIndex pos
115 |     in
116 |     case word of
117 |       0x0A {-\n-} -> chompEscape 0x6E {-n-} pos end start revChunks
118 |       0x22 {-"-}  -> chompEscape 0x22 {-"-} pos end start revChunks
119 |       0x5C {-\-}  -> chompEscape 0x5C {-\-} pos end start revChunks
120 |       0x0D {-\r-} ->
121 |         let
122 |           !newPos = plusPtr pos 1
123 |         in
124 |         chompChunks newPos end newPos (addSlice start pos revChunks)
125 | 
126 |       _ ->
127 |         let
128 |           !width = P.getCharWidth word
129 |           !newPos = plusPtr pos width
130 |         in
131 |         chompChunks newPos end start revChunks
132 | 
133 | 
134 | chompEscape :: Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
135 | chompEscape escape pos end start revChunks =
136 |   let
137 |     !pos1 = plusPtr pos 1
138 |   in
139 |   chompChunks pos1 end pos1 (Escape escape : addSlice start pos revChunks)
140 | 
141 | 
142 | addSlice :: Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
143 | addSlice start end revChunks =
144 |   if start == end
145 |     then revChunks
146 |     else Slice start (minusPtr end start) : revChunks
147 | 
148 | 
149 | 
150 | -- FROM CHUNKS
151 | 
152 | 
153 | data Chunk
154 |   = Slice (Ptr Word8) Int
155 |   | Escape Word8
156 | 
157 | 
158 | fromChunks :: [Chunk] -> String
159 | fromChunks chunks =
160 |   unsafeDupablePerformIO (stToIO (
161 |     do  let !len = sum (map chunkToWidth chunks)
162 |         mba <- newByteArray len
163 |         writeChunks mba 0 chunks
164 |         freeze mba
165 |   ))
166 | 
167 | 
168 | chunkToWidth :: Chunk -> Int
169 | chunkToWidth chunk =
170 |   case chunk of
171 |     Slice _ len -> len
172 |     Escape _    -> 2
173 | 
174 | 
175 | writeChunks :: MBA RealWorld -> Int -> [Chunk] -> ST RealWorld ()
176 | writeChunks mba offset chunks =
177 |   case chunks of
178 |     [] ->
179 |       return ()
180 | 
181 |     chunk : chunks ->
182 |       case chunk of
183 |         Slice ptr len ->
184 |           do  copyFromPtr ptr mba offset len
185 |               let !newOffset = offset + len
186 |               writeChunks mba newOffset chunks
187 | 
188 |         Escape word ->
189 |           do  writeWord8 mba offset 0x5C {- \ -}
190 |               writeWord8 mba (offset + 1) word
191 |               let !newOffset = offset + 2
192 |               writeChunks mba newOffset chunks
193 | 


--------------------------------------------------------------------------------
/compiler/src/Optimize/Case.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | module Optimize.Case
  3 |   ( optimize
  4 |   )
  5 |   where
  6 | 
  7 | 
  8 | import Control.Arrow (second)
  9 | import qualified Data.Map as Map
 10 | import Data.Map ((!))
 11 | import qualified Data.Maybe as Maybe
 12 | import qualified Data.Name as Name
 13 | 
 14 | import qualified AST.Canonical as Can
 15 | import qualified AST.Optimized as Opt
 16 | import qualified Optimize.DecisionTree as DT
 17 | 
 18 | 
 19 | 
 20 | -- OPTIMIZE A CASE EXPRESSION
 21 | 
 22 | 
 23 | optimize :: Name.Name -> Name.Name -> [(Can.Pattern, Opt.Expr)] -> Opt.Expr
 24 | optimize temp root optBranches =
 25 |   let
 26 |     (patterns, indexedBranches) =
 27 |       unzip (zipWith indexify [0..] optBranches)
 28 | 
 29 |     decider = treeToDecider (DT.compile patterns)
 30 |     targetCounts = countTargets decider
 31 | 
 32 |     (choices, maybeJumps) =
 33 |         unzip (map (createChoices targetCounts) indexedBranches)
 34 |   in
 35 |   Opt.Case temp root
 36 |     (insertChoices (Map.fromList choices) decider)
 37 |     (Maybe.catMaybes maybeJumps)
 38 | 
 39 | 
 40 | indexify :: Int -> (a,b) -> ((a,Int), (Int,b))
 41 | indexify index (pattern, branch) =
 42 |     ( (pattern, index)
 43 |     , (index, branch)
 44 |     )
 45 | 
 46 | 
 47 | 
 48 | -- TREE TO DECIDER
 49 | --
 50 | -- Decision trees may have some redundancies, so we convert them to a Decider
 51 | -- which has special constructs to avoid code duplication when possible.
 52 | 
 53 | 
 54 | treeToDecider :: DT.DecisionTree -> Opt.Decider Int
 55 | treeToDecider tree =
 56 |   case tree of
 57 |     DT.Match target ->
 58 |         Opt.Leaf target
 59 | 
 60 |     -- zero options
 61 |     DT.Decision _ [] Nothing ->
 62 |         error "compiler bug, somehow created an empty decision tree"
 63 | 
 64 |     -- one option
 65 |     DT.Decision _ [(_, subTree)] Nothing ->
 66 |         treeToDecider subTree
 67 | 
 68 |     DT.Decision _ [] (Just subTree) ->
 69 |         treeToDecider subTree
 70 | 
 71 |     -- two options
 72 |     DT.Decision path [(test, successTree)] (Just failureTree) ->
 73 |         toChain path test successTree failureTree
 74 | 
 75 |     DT.Decision path [(test, successTree), (_, failureTree)] Nothing ->
 76 |         toChain path test successTree failureTree
 77 | 
 78 |     -- many options
 79 |     DT.Decision path edges Nothing ->
 80 |         let
 81 |           (necessaryTests, fallback) =
 82 |               (init edges, snd (last edges))
 83 |         in
 84 |           Opt.FanOut
 85 |             path
 86 |             (map (second treeToDecider) necessaryTests)
 87 |             (treeToDecider fallback)
 88 | 
 89 |     DT.Decision path edges (Just fallback) ->
 90 |         Opt.FanOut path (map (second treeToDecider) edges) (treeToDecider fallback)
 91 | 
 92 | 
 93 | toChain :: DT.Path -> DT.Test -> DT.DecisionTree -> DT.DecisionTree -> Opt.Decider Int
 94 | toChain path test successTree failureTree =
 95 |   let
 96 |     failure =
 97 |       treeToDecider failureTree
 98 |   in
 99 |     case treeToDecider successTree of
100 |       Opt.Chain testChain success subFailure | failure == subFailure ->
101 |           Opt.Chain ((path, test) : testChain) success failure
102 | 
103 |       success ->
104 |           Opt.Chain [(path, test)] success failure
105 | 
106 | 
107 | 
108 | -- INSERT CHOICES
109 | --
110 | -- If a target appears exactly once in a Decider, the corresponding expression
111 | -- can be inlined. Whether things are inlined or jumps is called a "choice".
112 | 
113 | 
114 | countTargets :: Opt.Decider Int -> Map.Map Int Int
115 | countTargets decisionTree =
116 |   case decisionTree of
117 |     Opt.Leaf target ->
118 |         Map.singleton target 1
119 | 
120 |     Opt.Chain _ success failure ->
121 |         Map.unionWith (+) (countTargets success) (countTargets failure)
122 | 
123 |     Opt.FanOut _ tests fallback ->
124 |         Map.unionsWith (+) (map countTargets (fallback : map snd tests))
125 | 
126 | 
127 | createChoices
128 |     :: Map.Map Int Int
129 |     -> (Int, Opt.Expr)
130 |     -> ( (Int, Opt.Choice), Maybe (Int, Opt.Expr) )
131 | createChoices targetCounts (target, branch) =
132 |     if targetCounts ! target == 1 then
133 |         ( (target, Opt.Inline branch)
134 |         , Nothing
135 |         )
136 | 
137 |     else
138 |         ( (target, Opt.Jump target)
139 |         , Just (target, branch)
140 |         )
141 | 
142 | 
143 | insertChoices
144 |     :: Map.Map Int Opt.Choice
145 |     -> Opt.Decider Int
146 |     -> Opt.Decider Opt.Choice
147 | insertChoices choiceDict decider =
148 |   let
149 |     go =
150 |       insertChoices choiceDict
151 |   in
152 |     case decider of
153 |       Opt.Leaf target ->
154 |           Opt.Leaf (choiceDict ! target)
155 | 
156 |       Opt.Chain testChain success failure ->
157 |           Opt.Chain testChain (go success) (go failure)
158 | 
159 |       Opt.FanOut path tests fallback ->
160 |           Opt.FanOut path (map (second go) tests) (go fallback)
161 | 
162 | 


--------------------------------------------------------------------------------
/compiler/src/Optimize/Names.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | {-# LANGUAGE OverloadedStrings #-}
  3 | {-# LANGUAGE Rank2Types #-}
  4 | module Optimize.Names
  5 |   ( Tracker
  6 |   , run
  7 |   , generate
  8 |   , registerKernel
  9 |   , registerGlobal
 10 |   , registerDebug
 11 |   , registerCtor
 12 |   , registerField
 13 |   , registerFieldDict
 14 |   , registerFieldList
 15 |   )
 16 |   where
 17 | 
 18 | 
 19 | import qualified Data.Map as Map
 20 | import qualified Data.Name as Name
 21 | import qualified Data.Set as Set
 22 | 
 23 | import qualified AST.Canonical as Can
 24 | import qualified AST.Optimized as Opt
 25 | import qualified Data.Index as Index
 26 | import qualified Elm.ModuleName as ModuleName
 27 | import qualified Reporting.Annotation as A
 28 | 
 29 | 
 30 | 
 31 | -- GENERATOR
 32 | 
 33 | 
 34 | newtype Tracker a =
 35 |   Tracker (
 36 |     forall r.
 37 |       Int
 38 |       -> Set.Set Opt.Global
 39 |       -> Map.Map Name.Name Int
 40 |       -> (Int -> Set.Set Opt.Global -> Map.Map Name.Name Int -> a -> r)
 41 |       -> r
 42 |   )
 43 | 
 44 | 
 45 | run :: Tracker a -> (Set.Set Opt.Global, Map.Map Name.Name Int, a)
 46 | run (Tracker k) =
 47 |   k 0 Set.empty Map.empty
 48 |     (\_uid deps fields value -> (deps, fields, value))
 49 | 
 50 | 
 51 | generate :: Tracker Name.Name
 52 | generate =
 53 |   Tracker $ \uid deps fields ok ->
 54 |     ok (uid + 1) deps fields (Name.fromVarIndex uid)
 55 | 
 56 | 
 57 | registerKernel :: Name.Name -> a -> Tracker a
 58 | registerKernel home value =
 59 |   Tracker $ \uid deps fields ok ->
 60 |     ok uid (Set.insert (Opt.toKernelGlobal home) deps) fields value
 61 | 
 62 | 
 63 | registerGlobal :: ModuleName.Canonical -> Name.Name -> Tracker Opt.Expr
 64 | registerGlobal home name =
 65 |   Tracker $ \uid deps fields ok ->
 66 |     let global = Opt.Global home name in
 67 |     ok uid (Set.insert global deps) fields (Opt.VarGlobal global)
 68 | 
 69 | 
 70 | registerDebug :: Name.Name -> ModuleName.Canonical -> A.Region -> Tracker Opt.Expr
 71 | registerDebug name home region =
 72 |   Tracker $ \uid deps fields ok ->
 73 |     let global = Opt.Global ModuleName.debug name in
 74 |     ok uid (Set.insert global deps) fields (Opt.VarDebug name home region Nothing)
 75 | 
 76 | 
 77 | registerCtor :: ModuleName.Canonical -> Name.Name -> Index.ZeroBased -> Can.CtorOpts -> Tracker Opt.Expr
 78 | registerCtor home name index opts =
 79 |   Tracker $ \uid deps fields ok ->
 80 |     let
 81 |       global = Opt.Global home name
 82 |       newDeps = Set.insert global deps
 83 |     in
 84 |     case opts of
 85 |       Can.Normal ->
 86 |         ok uid newDeps fields (Opt.VarGlobal global)
 87 | 
 88 |       Can.Enum ->
 89 |         ok uid newDeps fields $
 90 |           case name of
 91 |             "True"  | home == ModuleName.basics -> Opt.Bool True
 92 |             "False" | home == ModuleName.basics -> Opt.Bool False
 93 |             _ -> Opt.VarEnum global index
 94 | 
 95 |       Can.Unbox ->
 96 |         ok uid (Set.insert identity newDeps) fields (Opt.VarBox global)
 97 | 
 98 | 
 99 | identity :: Opt.Global
100 | identity =
101 |   Opt.Global ModuleName.basics Name.identity
102 | 
103 | 
104 | registerField :: Name.Name -> a -> Tracker a
105 | registerField name value =
106 |   Tracker $ \uid d fields ok ->
107 |     ok uid d (Map.insertWith (+) name 1 fields) value
108 | 
109 | 
110 | registerFieldDict :: Map.Map Name.Name v -> a -> Tracker a
111 | registerFieldDict newFields value =
112 |   Tracker $ \uid d fields ok ->
113 |     ok uid d (Map.unionWith (+) fields (Map.map toOne newFields)) value
114 | 
115 | 
116 | toOne :: a -> Int
117 | toOne _ = 1
118 | 
119 | 
120 | registerFieldList :: [Name.Name] -> a -> Tracker a
121 | registerFieldList names value =
122 |   Tracker $ \uid deps fields ok ->
123 |     ok uid deps (foldr addOne fields names) value
124 | 
125 | 
126 | addOne :: Name.Name -> Map.Map Name.Name Int -> Map.Map Name.Name Int
127 | addOne name fields =
128 |   Map.insertWith (+) name 1 fields
129 | 
130 | 
131 | 
132 | -- INSTANCES
133 | 
134 | 
135 | instance Functor Tracker where
136 |   fmap func (Tracker kv) =
137 |     Tracker $ \n d f ok ->
138 |       let
139 |         ok1 n1 d1 f1 value =
140 |           ok n1 d1 f1 (func value)
141 |       in
142 |       kv n d f ok1
143 | 
144 | 
145 | instance Applicative Tracker where
146 |   {-# INLINE pure #-}
147 |   pure value =
148 |     Tracker $ \n d f ok -> ok n d f value
149 | 
150 |   (<*>) (Tracker kf) (Tracker kv) =
151 |     Tracker $ \n d f ok ->
152 |       let
153 |         ok1 n1 d1 f1 func =
154 |           let
155 |             ok2 n2 d2 f2 value =
156 |               ok n2 d2 f2 (func value)
157 |           in
158 |           kv n1 d1 f1 ok2
159 |       in
160 |       kf n d f ok1
161 | 
162 | 
163 | instance Monad Tracker where
164 |   return = pure
165 | 
166 |   (>>=) (Tracker k) callback =
167 |     Tracker $ \n d f ok ->
168 |       let
169 |         ok1 n1 d1 f1 a =
170 |           case callback a of
171 |             Tracker kb -> kb n1 d1 f1 ok
172 |       in
173 |       k n d f ok1
174 | 


--------------------------------------------------------------------------------
/compiler/src/Elm/Compiler/Type.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | {-# LANGUAGE OverloadedStrings #-}
  3 | module Elm.Compiler.Type
  4 |   ( Type(..)
  5 |   , RT.Context(..)
  6 |   , toDoc
  7 |   , DebugMetadata(..)
  8 |   , Alias(..)
  9 |   , Union(..)
 10 |   , encode
 11 |   , decoder
 12 |   , encodeMetadata
 13 |   )
 14 |   where
 15 | 
 16 | 
 17 | import qualified Data.Name as Name
 18 | 
 19 | import qualified AST.Source as Src
 20 | import qualified Json.Decode as D
 21 | import qualified Json.Encode as E
 22 | import Json.Encode ((==>))
 23 | import qualified Json.String as Json
 24 | import qualified Parse.Primitives as P
 25 | import qualified Parse.Type as Type
 26 | import qualified Reporting.Annotation as A
 27 | import qualified Reporting.Doc as D
 28 | import qualified Reporting.Render.Type as RT
 29 | import qualified Reporting.Render.Type.Localizer as L
 30 | 
 31 | 
 32 | 
 33 | -- TYPES
 34 | 
 35 | 
 36 | data Type
 37 |   = Lambda Type Type
 38 |   | Var Name.Name
 39 |   | Type Name.Name [Type]
 40 |   | Record [(Name.Name, Type)] (Maybe Name.Name)
 41 |   | Unit
 42 |   | Tuple Type Type [Type]
 43 | 
 44 | 
 45 | data DebugMetadata =
 46 |   DebugMetadata
 47 |     { _message :: Type
 48 |     , _aliases :: [Alias]
 49 |     , _unions :: [Union]
 50 |     }
 51 | 
 52 | 
 53 | data Alias = Alias Name.Name [Name.Name] Type
 54 | data Union = Union Name.Name [Name.Name] [(Name.Name, [Type])]
 55 | 
 56 | 
 57 | 
 58 | -- TO DOC
 59 | 
 60 | 
 61 | toDoc :: L.Localizer -> RT.Context -> Type -> D.Doc
 62 | toDoc localizer context tipe =
 63 |   case tipe of
 64 |     Lambda _ _ ->
 65 |       let
 66 |         a:b:cs =
 67 |           map (toDoc localizer RT.Func) (collectLambdas tipe)
 68 |       in
 69 |       RT.lambda context a b cs
 70 | 
 71 |     Var name ->
 72 |       D.fromName name
 73 | 
 74 |     Unit ->
 75 |       "()"
 76 | 
 77 |     Tuple a b cs ->
 78 |       RT.tuple
 79 |         (toDoc localizer RT.None a)
 80 |         (toDoc localizer RT.None b)
 81 |         (map (toDoc localizer RT.None) cs)
 82 | 
 83 |     Type name args ->
 84 |       RT.apply
 85 |         context
 86 |         (D.fromName name)
 87 |         (map (toDoc localizer RT.App) args)
 88 | 
 89 |     Record fields ext ->
 90 |       RT.record
 91 |         (map (entryToDoc localizer) fields)
 92 |         (fmap D.fromName ext)
 93 | 
 94 | 
 95 | entryToDoc :: L.Localizer -> (Name.Name, Type) -> (D.Doc, D.Doc)
 96 | entryToDoc localizer (field, fieldType) =
 97 |   ( D.fromName field, toDoc localizer RT.None fieldType )
 98 | 
 99 | 
100 | collectLambdas :: Type -> [Type]
101 | collectLambdas tipe =
102 |   case tipe of
103 |     Lambda arg body ->
104 |       arg : collectLambdas body
105 | 
106 |     _ ->
107 |       [tipe]
108 | 
109 | 
110 | 
111 | -- JSON for TYPE
112 | 
113 | 
114 | encode :: Type -> E.Value
115 | encode tipe =
116 |   E.chars $ D.toLine (toDoc L.empty RT.None tipe)
117 | 
118 | 
119 | decoder :: D.Decoder () Type
120 | decoder =
121 |   let
122 |     parser =
123 |       P.specialize (\_ _ _ -> ()) (fromRawType . fst <$> Type.expression)
124 |   in
125 |   D.customString parser (\_ _ -> ())
126 | 
127 | 
128 | fromRawType :: Src.Type -> Type
129 | fromRawType (A.At _ astType) =
130 |   case astType of
131 |     Src.TLambda t1 t2 ->
132 |         Lambda (fromRawType t1) (fromRawType t2)
133 | 
134 |     Src.TVar x ->
135 |         Var x
136 | 
137 |     Src.TUnit ->
138 |         Unit
139 | 
140 |     Src.TTuple a b cs ->
141 |         Tuple
142 |           (fromRawType a)
143 |           (fromRawType b)
144 |           (map fromRawType cs)
145 | 
146 |     Src.TType _ name args ->
147 |         Type name (map fromRawType args)
148 | 
149 |     Src.TTypeQual _ _ name args ->
150 |         Type name (map fromRawType args)
151 | 
152 |     Src.TRecord fields ext ->
153 |         let fromField (A.At _ field, tipe) = (field, fromRawType tipe) in
154 |         Record
155 |           (map fromField fields)
156 |           (fmap A.toValue ext)
157 | 
158 | 
159 | 
160 | -- JSON for PROGRAM
161 | 
162 | 
163 | encodeMetadata :: DebugMetadata -> E.Value
164 | encodeMetadata (DebugMetadata msg aliases unions) =
165 |   E.object
166 |     [ "message" ==> encode msg
167 |     , "aliases" ==> E.object (map toTypeAliasField aliases)
168 |     , "unions" ==> E.object (map toCustomTypeField unions)
169 |     ]
170 | 
171 | 
172 | toTypeAliasField :: Alias -> ( Json.String, E.Value )
173 | toTypeAliasField (Alias name args tipe) =
174 |   ( Json.fromName name
175 |   , E.object
176 |       [ "args" ==> E.list E.name args
177 |       , "type" ==> encode tipe
178 |       ]
179 |   )
180 | 
181 | 
182 | toCustomTypeField :: Union -> ( Json.String, E.Value )
183 | toCustomTypeField (Union name args constructors) =
184 |   ( Json.fromName name
185 |   , E.object
186 |       [ "args" ==> E.list E.name args
187 |       , "tags" ==> E.object (map toVariantObject constructors)
188 |       ]
189 |   )
190 | 
191 | 
192 | toVariantObject :: (Name.Name, [Type]) -> ( Json.String, E.Value )
193 | toVariantObject (name, args) =
194 |   ( Json.fromName name, E.list encode args )
195 | 


--------------------------------------------------------------------------------
/compiler/src/Canonicalize/Type.hs:
--------------------------------------------------------------------------------
  1 | {-# OPTIONS_GHC -Wall #-}
  2 | {-# LANGUAGE OverloadedStrings #-}
  3 | module Canonicalize.Type
  4 |   ( toAnnotation
  5 |   , canonicalize
  6 |   )
  7 |   where
  8 | 
  9 | 
 10 | import qualified Data.List as List
 11 | import qualified Data.Map as Map
 12 | import qualified Data.Name as Name
 13 | 
 14 | import qualified AST.Canonical as Can
 15 | import qualified AST.Source as Src
 16 | import qualified Canonicalize.Environment as Env
 17 | import qualified Canonicalize.Environment.Dups as Dups
 18 | import qualified Reporting.Annotation as A
 19 | import qualified Reporting.Error.Canonicalize as Error
 20 | import qualified Reporting.Result as Result
 21 | 
 22 | 
 23 | 
 24 | -- RESULT
 25 | 
 26 | 
 27 | type Result i w a =
 28 |   Result.Result i w Error.Error a
 29 | 
 30 | 
 31 | 
 32 | -- TO ANNOTATION
 33 | 
 34 | 
 35 | toAnnotation :: Env.Env -> Src.Type -> Result i w Can.Annotation
 36 | toAnnotation env srcType =
 37 |   do  tipe <- canonicalize env srcType
 38 |       Result.ok $ Can.Forall (addFreeVars Map.empty tipe) tipe
 39 | 
 40 | 
 41 | 
 42 | -- CANONICALIZE TYPES
 43 | 
 44 | 
 45 | canonicalize :: Env.Env -> Src.Type -> Result i w Can.Type
 46 | canonicalize env (A.At typeRegion tipe) =
 47 |   case tipe of
 48 |     Src.TVar x ->
 49 |         Result.ok (Can.TVar x)
 50 | 
 51 |     Src.TType region name args ->
 52 |         canonicalizeType env typeRegion name args =<<
 53 |           Env.findType region env name
 54 | 
 55 |     Src.TTypeQual region home name args ->
 56 |         canonicalizeType env typeRegion name args =<<
 57 |           Env.findTypeQual region env home name
 58 | 
 59 |     Src.TLambda a b ->
 60 |         Can.TLambda
 61 |           <$> canonicalize env a
 62 |           <*> canonicalize env b
 63 | 
 64 |     Src.TRecord fields ext ->
 65 |         do  cfields <- sequenceA =<< Dups.checkFields (canonicalizeFields env fields)
 66 |             return $ Can.TRecord cfields (fmap A.toValue ext)
 67 | 
 68 |     Src.TUnit ->
 69 |         Result.ok Can.TUnit
 70 | 
 71 |     Src.TTuple a b cs ->
 72 |         Can.TTuple
 73 |           <$> canonicalize env a
 74 |           <*> canonicalize env b
 75 |           <*>
 76 |             case cs of
 77 |               [] ->
 78 |                 Result.ok Nothing
 79 | 
 80 |               [c] ->
 81 |                 Just <$> canonicalize env c
 82 | 
 83 |               _ ->
 84 |                 Result.throw $ Error.TupleLargerThanThree typeRegion
 85 | 
 86 | 
 87 | canonicalizeFields :: Env.Env -> [(A.Located Name.Name, Src.Type)] -> [(A.Located Name.Name, Result i w Can.FieldType)]
 88 | canonicalizeFields env fields =
 89 |   let
 90 |     len = fromIntegral (length fields)
 91 |     canonicalizeField index (name, srcType) =
 92 |       (name, Can.FieldType index <$> canonicalize env srcType)
 93 |   in
 94 |   zipWith canonicalizeField [0..len] fields
 95 | 
 96 | 
 97 | 
 98 | -- CANONICALIZE TYPE
 99 | 
100 | 
101 | canonicalizeType :: Env.Env -> A.Region -> Name.Name -> [Src.Type] -> Env.Type -> Result i w Can.Type
102 | canonicalizeType env region name args info =
103 |   do  cargs <- traverse (canonicalize env) args
104 |       case info of
105 |         Env.Alias arity home argNames aliasedType ->
106 |           checkArity arity region name args $
107 |             Can.TAlias home name (zip argNames cargs) (Can.Holey aliasedType)
108 | 
109 |         Env.Union arity home ->
110 |           checkArity arity region name args $
111 |             Can.TType home name cargs
112 | 
113 | 
114 | checkArity :: Int -> A.Region -> Name.Name -> [A.Located arg] -> answer -> Result i w answer
115 | checkArity expected region name args answer =
116 |   let actual = length args in
117 |   if expected == actual then
118 |     Result.ok answer
119 |   else
120 |     Result.throw (Error.BadArity region Error.TypeArity name expected actual)
121 | 
122 | 
123 | 
124 | -- ADD FREE VARS
125 | 
126 | 
127 | addFreeVars :: Map.Map Name.Name () -> Can.Type -> Map.Map Name.Name ()
128 | addFreeVars freeVars tipe =
129 |   case tipe of
130 |     Can.TLambda arg result ->
131 |       addFreeVars (addFreeVars freeVars result) arg
132 | 
133 |     Can.TVar var ->
134 |       Map.insert var () freeVars
135 | 
136 |     Can.TType _ _ args ->
137 |       List.foldl' addFreeVars freeVars args
138 | 
139 |     Can.TRecord fields Nothing ->
140 |       Map.foldl addFieldFreeVars freeVars fields
141 | 
142 |     Can.TRecord fields (Just ext) ->
143 |       Map.foldl addFieldFreeVars (Map.insert ext () freeVars) fields
144 | 
145 |     Can.TUnit ->
146 |       freeVars
147 | 
148 |     Can.TTuple a b maybeC ->
149 |       case maybeC of
150 |         Nothing ->
151 |           addFreeVars (addFreeVars freeVars a) b
152 | 
153 |         Just c ->
154 |           addFreeVars (addFreeVars (addFreeVars freeVars a) b) c
155 | 
156 |     Can.TAlias _ _ args _ ->
157 |       List.foldl' (\fvs (_,arg) -> addFreeVars fvs arg) freeVars args
158 | 
159 | 
160 | addFieldFreeVars :: Map.Map Name.Name () -> Can.FieldType -> Map.Map Name.Name ()
161 | addFieldFreeVars freeVars (Can.FieldType _ tipe) =
162 |   addFreeVars freeVars tipe
163 | 


--------------------------------------------------------------------------------
/hints/recursive-alias.md:
--------------------------------------------------------------------------------
  1 | 
  2 | # Hints for Recursive Type Aliases
  3 | 
  4 | At the root of this issue is the distinction between a `type` and a `type alias`.
  5 | 
  6 | 
  7 | ## What is a type alias?
  8 | 
  9 | When you create a type alias, you are just creating a shorthand to refer to an existing type. So when you say the following:
 10 | 
 11 | ```elm
 12 | type alias Time = Float
 13 | 
 14 | type alias Degree = Float
 15 | 
 16 | type alias Weight = Float
 17 | ```
 18 | 
 19 | You 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:
 20 | 
 21 | ```elm
 22 | add : Time -> Degree -> Weight
 23 | add time degree =
 24 |   time + degree
 25 | ```
 26 | 
 27 | This 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:
 28 | 
 29 | ```elm
 30 | type alias Person =
 31 |   { name : String
 32 |   , age : Int
 33 |   , height : Float
 34 |   }
 35 | ```
 36 | 
 37 | It 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.
 38 | 
 39 | 
 40 | ## Recursive type aliases?
 41 | 
 42 | Okay, 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:
 43 | 
 44 | ```elm
 45 | type alias Comment =
 46 |   { message : String
 47 |   , upvotes : Int
 48 |   , downvotes : Int
 49 |   , responses : List Comment
 50 |   }
 51 | ```
 52 | 
 53 | Now 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.
 54 | 
 55 | ```elm
 56 |   { message : String
 57 |   , upvotes : Int
 58 |   , downvotes : Int
 59 |   , responses :
 60 |       List
 61 |         { message : String
 62 |         , upvotes : Int
 63 |         , downvotes : Int
 64 |         , responses :
 65 |             List
 66 |               { message : String
 67 |               , upvotes : Int
 68 |               , downvotes : Int
 69 |               , responses : List ...
 70 |               }
 71 |         }
 72 |   }
 73 | ```
 74 | 
 75 | The compiler cannot deal with values like this. It would just keep expanding forever.
 76 | 
 77 | 
 78 | ## Recursive types!
 79 | 
 80 | In 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:
 81 | 
 82 | ```elm
 83 | type List
 84 |     = Empty
 85 |     | Node Int List
 86 | ```
 87 | 
 88 | No 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.
 89 | 
 90 | So let's return to wanting to represent a `Comment` that may have responses. There are a couple ways to do this:
 91 | 
 92 | 
 93 | ### Obvious, but kind of annoying
 94 | 
 95 | ```elm
 96 | type Comment =
 97 |    Comment
 98 |       { message : String
 99 |       , upvotes : Int
100 |       , downvotes : Int
101 |       , responses : List Comment
102 |       }
103 | ```
104 | 
105 | Now let's say you want to register an upvote on a comment:
106 | 
107 | ```elm
108 | upvote : Comment -> Comment
109 | upvote (Comment comment) =
110 |   Comment { comment | upvotes = 1 + comment.upvotes }
111 | ```
112 | 
113 | It is kind of annoying that we now have to unwrap and wrap the record to do anything with it.
114 | 
115 | 
116 | ### Less obvious, but nicer
117 | 
118 | ```elm
119 | type alias Comment =
120 |   { message : String
121 |   , upvotes : Int
122 |   , downvotes : Int
123 |   , responses : Responses
124 |   }
125 | 
126 | type Responses = Responses (List Comment)
127 | ```
128 | 
129 | In 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:
130 | 
131 | ```elm
132 | upvote : Comment -> Comment
133 | upvote comment =
134 |   { comment | upvotes = 1 + comment.upvotes }
135 | ```
136 | 
137 | So 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.
138 | 
139 | 
140 | ## Mutually recursive type aliases
141 | 
142 | It is also possible to build type aliases that are *mutually* recursive. That might be something like this:
143 | 
144 | ```elm
145 | type alias Comment =
146 |   { message : String
147 |   , upvotes : Int
148 |   , downvotes : Int
149 |   , responses : Responses
150 |   }
151 | 
152 | type alias Responses =
153 |   { sortBy : SortBy
154 |   , responses : List Comment
155 |   }
156 | 
157 | type SortBy = Time | Score | MostResponses
158 | ```
159 | 
160 | When you try to expand `Comment` you have to expand `Responses` which needs to expand `Comment` which needs to expand `Responses`, etc.
161 | 
162 | So 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.
163 | 


--------------------------------------------------------------------------------