├── .gitattributes ├── .gitignore ├── README.md ├── elm.json ├── examples ├── CheckGitStatus.elm ├── CopyFile.elm ├── CreateFileInSubdirectory.elm ├── CreateSubdirectory.elm ├── CreateTempDirectory.elm ├── DeleteFile.elm ├── EnsureSubdirectory.elm ├── ForEach.elm ├── GetCurrentTime.elm ├── GetElmVersion.elm ├── HelloWorld.elm ├── LineCounts.elm ├── ListRecursive.elm ├── Miscellaneous.elm ├── MoveFile.elm ├── ObliterateSubdirectory.elm ├── PathChecking.elm ├── PowerShellTest.elm ├── PrintEnvironmentVariables.elm ├── ReadFile.elm ├── RemoveSubdirectory.elm ├── Test │ └── NestedModule.elm ├── TestCompilation.elm ├── Tests.elm ├── UsuallyFails.elm ├── WithRetry.elm ├── WriteFile.elm ├── elm.json └── test.txt ├── runner └── main.js ├── scripts ├── Common.elm ├── CopyNewVersion.elm └── elm.json └── src ├── Script.elm └── Script ├── Directory.elm ├── Environment.elm ├── File.elm ├── FileInfo.elm ├── Http.elm ├── Internal.elm ├── Path.elm ├── Permissions.elm └── Platform.elm /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff 2 | examples/*.js 3 | examples/elm-script 4 | examples/elm-script.cmd 5 | scripts/elm-script 6 | scripts/elm-script.cmd 7 | node_modules 8 | examples/reversed.txt 9 | elm.exe 10 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## ianmackenzie/elm-script 2 | 3 | **EXPERIMENTAL** - expect breaking changes, missing functionality, incomplete 4 | documentation etc. 5 | 6 | This package allows you define command-line scripts in Elm that can 7 | 8 | - Read and write files 9 | - Accept command-line arguments 10 | - Read environment variables 11 | - Make HTTP requests 12 | - Run subprocesses 13 | 14 | Here's a complete "Hello World" program ([examples/HelloWorld.elm](https://github.com/ianmackenzie/elm-script/blob/master/examples/HelloWorld.elm)): 15 | 16 | ```elm 17 | module HelloWorld exposing (main) 18 | 19 | import Script exposing (Script) 20 | 21 | 22 | script : Script.Init -> Script String () 23 | script {} = 24 | Script.printLine "Hello World!" 25 | 26 | 27 | main : Script.Program 28 | main = 29 | Script.program script 30 | ``` 31 | 32 | And here's a slightly more realistic/useful script that counts the number of 33 | lines in files given at the command line ([examples/LineCounts.elm](https://github.com/ianmackenzie/elm-script/blob/master/examples/LineCounts.elm)): 34 | 35 | ```elm 36 | module LineCounts exposing (main) 37 | 38 | import Script exposing (Script) 39 | import Script.File as File exposing (File, ReadOnly) 40 | 41 | 42 | getLineCount : File ReadOnly -> Script String Int 43 | getLineCount file = 44 | File.read file 45 | |> Script.map (String.trimRight >> String.lines >> List.length) 46 | 47 | 48 | script : Script.Init -> Script String () 49 | script { arguments, userPrivileges } = 50 | List.map (File.readOnly userPrivileges) arguments 51 | |> Script.collect getLineCount 52 | |> Script.map (List.map2 Tuple.pair arguments) 53 | |> Script.thenWith 54 | (Script.each 55 | (\( fileName, lineCount ) -> 56 | Script.printLine 57 | (fileName 58 | ++ ": " 59 | ++ String.fromInt lineCount 60 | ++ " lines" 61 | ) 62 | ) 63 | ) 64 | 65 | 66 | main : Script.Program 67 | main = 68 | Script.program script 69 | ``` 70 | 71 | One of they key features of this package is very explicit control over 72 | permissions. The top-level script has full access to the file system, 73 | environment variables etc. but it can choose exactly how much access to give to 74 | helper scripts. A `Script` cannot by default do anything other than a few 75 | harmless things like getting the current time and printing to the console; in 76 | order to do anything more, it must explicitly be given read access to a 77 | particular directory, write access to a particular file, network access etc. In 78 | the above example, you can know just from the type signature of `getLineCount` 79 | that the returned script can read the file that you pass it, but it can't read 80 | any other files, it can't write to any files at all, and it can't access the 81 | network (to, say, send the contents of `passwords.txt` to an evil server 82 | somewhere). 83 | 84 | My hope is that this will make it possible to share scripting functionality via 85 | the Elm package system without worrying that some script written by a stranger 86 | is going to format your hard drive. Even when just writing your own scripts, the 87 | type system helps keep track of which parts of your code are doing file I/O (to 88 | what files, in what directories), which parts are performing network requests, 89 | which parts are running potentially dangerous subprocesses, etc. 90 | 91 | # Getting started 92 | 93 | `ianmackenzie/elm-script` has not yet been published, so right now if you 94 | want to play around with it you'll have to check out this repository. You can 95 | then either just experiment with the files in the `examples` directory, or add 96 | the `src` directory of this package to the `source-directories` field of your 97 | `elm.json`. 98 | 99 | To actually run scripts, you'll need to first install [Deno](https://deno.land/). 100 | You should then be able to [install](https://deno.land/manual/tools/script_installer) 101 | the `elm-script` command by running 102 | 103 | ``` 104 | deno install -A -n elm-script https://elm-script.github.io/latest 105 | ``` 106 | 107 | This will create a small executable file named `elm-script` that calls Deno to 108 | execute [`runner/main.js`](https://github.com/ianmackenzie/elm-script/blob/master/runner/main.js): 109 | 110 | - `-A` tells Deno to give full permissions (file system, network etc.) to 111 | `elm-script`; `elm-script` has its own permissions system (described above) 112 | to ensure that untrusted code cannot do anything malicious. 113 | - `-n elm-script` tells Deno to name the resulting file `elm-script` instead 114 | of `latest`. 115 | - You will need to also add `-f` to force Deno to overwrite an existing 116 | `elm-script` file if you are updating to a new version. 117 | 118 | If you need to use the bleeding-edge version of the runner script (either 119 | because the published version is out of date, or you've made some local 120 | modifications) you can instead run 121 | 122 | 123 | ``` 124 | deno install -A -n elm-script path/to/elm-script/runner/main.js 125 | ``` 126 | 127 | to use the locally checked-out version. However, this will also introduce a 128 | small delay when running scripts, since Deno seems to then 'recompile' `main.js` 129 | every time. 130 | 131 | Where exactly `elm-script` gets installed depends on your operating system and 132 | Deno configuration, but you will need to make sure that directory gets added to 133 | your PATH; see the [`deno install` docs](https://deno.land/manual/tools/script_installer) 134 | for details. Once that is all done, you should be able to run Elm scripts using 135 | 136 | ``` 137 | elm-script run Main.elm 138 | ``` 139 | 140 | Refer to the API documentation for more details, or check out some more 141 | [examples](examples). 142 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "ianmackenzie/elm-script", 4 | "summary": "Experimental command-line scripting in Elm", 5 | "license": "MPL-2.0", 6 | "version": "1.0.0", 7 | "exposed-modules": [ 8 | "Script", 9 | "Script.Directory", 10 | "Script.Environment", 11 | "Script.File", 12 | "Script.Platform", 13 | "Script.Http" 14 | ], 15 | "elm-version": "0.19.0 <= v < 0.20.0", 16 | "dependencies": { 17 | "elm/core": "1.0.0 <= v < 2.0.0", 18 | "elm/http": "2.0.0 <= v < 3.0.0", 19 | "elm/json": "1.0.0 <= v < 2.0.0", 20 | "elm/regex": "1.0.0 <= v < 2.0.0", 21 | "elm/time": "1.0.0 <= v < 2.0.0", 22 | "ianmackenzie/elm-units": "2.0.1 <= v < 3.0.0" 23 | }, 24 | "test-dependencies": {} 25 | } 26 | -------------------------------------------------------------------------------- /examples/CheckGitStatus.elm: -------------------------------------------------------------------------------- 1 | module CheckGitStatus exposing (main) 2 | 3 | import Script exposing (Script, UserPrivileges) 4 | import Script.Directory as Directory exposing (Directory, Writable) 5 | 6 | 7 | checkForUnpushedChanges : Directory Writable -> UserPrivileges -> Script String () 8 | checkForUnpushedChanges directory userPrivileges = 9 | Script.executeWith userPrivileges 10 | { command = "git" 11 | , arguments = [ "log", "@{push}.." ] 12 | , workingDirectory = directory 13 | } 14 | |> Script.thenWith 15 | (\output -> 16 | if String.isEmpty (String.trim output) then 17 | Script.succeed () 18 | 19 | else 20 | Script.printLine output 21 | ) 22 | 23 | 24 | checkForUncommittedChanges : Directory Writable -> UserPrivileges -> Script String () 25 | checkForUncommittedChanges directory userPrivileges = 26 | Script.executeWith userPrivileges 27 | { command = "git" 28 | , arguments = [ "status" ] 29 | , workingDirectory = directory 30 | } 31 | |> Script.thenWith 32 | (\output -> 33 | if String.contains "nothing to commit, working tree clean" output then 34 | Script.succeed () 35 | 36 | else 37 | Script.printLine output 38 | ) 39 | 40 | 41 | checkDirectory : Directory Writable -> UserPrivileges -> Script String () 42 | checkDirectory directory userPrivileges = 43 | Script.do 44 | [ Script.printLine ("Checking " ++ Directory.name directory) 45 | , checkForUnpushedChanges directory userPrivileges 46 | , checkForUncommittedChanges directory userPrivileges 47 | ] 48 | 49 | 50 | script : Script.Init -> Script String () 51 | script { arguments, userPrivileges } = 52 | case arguments of 53 | [ parentPath ] -> 54 | let 55 | parentDirectory = 56 | Directory.writable userPrivileges parentPath 57 | in 58 | Directory.listSubdirs parentDirectory 59 | |> Script.thenWith 60 | (Script.each 61 | (\directory -> 62 | Directory.checkExistence (Directory.in_ directory ".git") 63 | |> Script.thenWith 64 | (\existence -> 65 | case existence of 66 | Directory.Exists -> 67 | checkDirectory directory userPrivileges 68 | 69 | _ -> 70 | Script.succeed () 71 | ) 72 | ) 73 | ) 74 | 75 | _ -> 76 | Script.fail "Please pass a single parent directory to check within" 77 | 78 | 79 | main : Script.Program 80 | main = 81 | Script.program script 82 | -------------------------------------------------------------------------------- /examples/CopyFile.elm: -------------------------------------------------------------------------------- 1 | module CopyFile exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory 5 | import Script.File as File 6 | 7 | 8 | script : Script.Init -> Script String () 9 | script { workingDirectory } = 10 | let 11 | sourceFile = 12 | File.in_ workingDirectory "reversed.txt" 13 | 14 | destinationFile = 15 | File.in_ workingDirectory "reversed-copied.txt" 16 | in 17 | File.copy sourceFile destinationFile 18 | 19 | 20 | main : Script.Program 21 | main = 22 | Script.program script 23 | -------------------------------------------------------------------------------- /examples/CreateFileInSubdirectory.elm: -------------------------------------------------------------------------------- 1 | module CreateFileInSubdirectory exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory 5 | import Script.File as File 6 | 7 | 8 | script : Script.Init -> Script String () 9 | script { workingDirectory } = 10 | let 11 | subdirectory = 12 | Directory.in_ workingDirectory "subdirectory" 13 | 14 | file = 15 | File.in_ subdirectory "child.txt" 16 | in 17 | Directory.ensureExists subdirectory 18 | |> Script.andThen (File.writeTo file "dummy contents") 19 | 20 | 21 | main : Script.Program 22 | main = 23 | Script.program script 24 | -------------------------------------------------------------------------------- /examples/CreateSubdirectory.elm: -------------------------------------------------------------------------------- 1 | module CreateSubdirectory exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory 5 | 6 | 7 | script : Script.Init -> Script String () 8 | script { workingDirectory } = 9 | let 10 | subdirectory = 11 | Directory.in_ workingDirectory "subdirectory" 12 | in 13 | Directory.create subdirectory 14 | 15 | 16 | main : Script.Program 17 | main = 18 | Script.program script 19 | -------------------------------------------------------------------------------- /examples/CreateTempDirectory.elm: -------------------------------------------------------------------------------- 1 | module CreateTempDirectory exposing (main) 2 | 3 | import Duration 4 | import Script exposing (Script) 5 | import Script.Directory as Directory 6 | import Script.File as File 7 | 8 | 9 | script : Script.Init -> Script String () 10 | script _ = 11 | Directory.createTemporary 12 | |> Script.thenWith 13 | (\tempDirectory -> 14 | let 15 | tempFile = 16 | File.in_ tempDirectory "temp.txt" 17 | in 18 | File.writeTo tempFile "dummy contents" 19 | ) 20 | |> Script.andThen (Script.sleep (Duration.seconds 10)) 21 | 22 | 23 | main : Script.Program 24 | main = 25 | Script.program script 26 | -------------------------------------------------------------------------------- /examples/DeleteFile.elm: -------------------------------------------------------------------------------- 1 | module DeleteFile exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory 5 | import Script.File as File 6 | 7 | 8 | script : Script.Init -> Script String () 9 | script { workingDirectory } = 10 | let 11 | file = 12 | File.in_ workingDirectory "reversed.txt" 13 | in 14 | File.delete file 15 | 16 | 17 | main : Script.Program 18 | main = 19 | Script.program script 20 | -------------------------------------------------------------------------------- /examples/EnsureSubdirectory.elm: -------------------------------------------------------------------------------- 1 | module EnsureSubdirectory exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory exposing (Directory) 5 | 6 | 7 | script : Script.Init -> Script String () 8 | script { workingDirectory } = 9 | let 10 | subdirectory = 11 | Directory.in_ workingDirectory "subdirectory" 12 | in 13 | Directory.ensureExists subdirectory 14 | 15 | 16 | main : Script.Program 17 | main = 18 | Script.program script 19 | -------------------------------------------------------------------------------- /examples/ForEach.elm: -------------------------------------------------------------------------------- 1 | module ForEach exposing (main) 2 | 3 | import Script exposing (Script) 4 | 5 | 6 | script : Script.Init -> Script String () 7 | script { arguments } = 8 | arguments 9 | |> Script.each 10 | (\argument -> 11 | Script.printLine <| 12 | case String.toFloat argument of 13 | Just value -> 14 | let 15 | squared = 16 | value * value 17 | in 18 | argument 19 | ++ " squared is " 20 | ++ String.fromFloat squared 21 | 22 | Nothing -> 23 | argument ++ " is not a number!" 24 | ) 25 | 26 | 27 | main : Script.Program 28 | main = 29 | Script.program script 30 | -------------------------------------------------------------------------------- /examples/GetCurrentTime.elm: -------------------------------------------------------------------------------- 1 | module GetCurrentTime exposing (main) 2 | 3 | import Duration 4 | import Script exposing (Script) 5 | import Time 6 | 7 | 8 | script : Script.Init -> Script String () 9 | script _ = 10 | Script.getCurrentTime 11 | |> Script.thenWith 12 | (\currentTime -> 13 | let 14 | millisecondsSinceEpoch = 15 | toFloat (Time.posixToMillis currentTime) 16 | 17 | hoursSinceEpoch = 18 | Duration.milliseconds millisecondsSinceEpoch 19 | |> Duration.inHours 20 | in 21 | Script.printLine <| 22 | "Number of hours since January 1, 1970: " 23 | ++ String.fromFloat hoursSinceEpoch 24 | ) 25 | 26 | 27 | main : Script.Program 28 | main = 29 | Script.program script 30 | -------------------------------------------------------------------------------- /examples/GetElmVersion.elm: -------------------------------------------------------------------------------- 1 | module GetElmVersion exposing (main) 2 | 3 | import Script exposing (Script) 4 | 5 | 6 | script : Script.Init -> Script String () 7 | script { workingDirectory, userPrivileges } = 8 | Script.executeWith userPrivileges 9 | { command = "elm" 10 | , arguments = [ "--version" ] 11 | , workingDirectory = workingDirectory 12 | } 13 | |> Script.map String.trim 14 | |> Script.thenWith 15 | (\versionString -> 16 | Script.printLine ("Current Elm version: " ++ versionString) 17 | ) 18 | 19 | 20 | main : Script.Program 21 | main = 22 | Script.program script 23 | -------------------------------------------------------------------------------- /examples/HelloWorld.elm: -------------------------------------------------------------------------------- 1 | module HelloWorld exposing (main) 2 | 3 | import Script exposing (Script) 4 | 5 | 6 | script : Script.Init -> Script String () 7 | script {} = 8 | Script.printLine "Hello World!" 9 | 10 | 11 | main : Script.Program 12 | main = 13 | Script.program script 14 | -------------------------------------------------------------------------------- /examples/LineCounts.elm: -------------------------------------------------------------------------------- 1 | module LineCounts exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.File as File exposing (File, ReadOnly) 5 | 6 | 7 | getLineCount : File ReadOnly -> Script String Int 8 | getLineCount file = 9 | File.read file 10 | |> Script.map (String.trimRight >> String.lines >> List.length) 11 | 12 | 13 | script : Script.Init -> Script String () 14 | script { arguments, userPrivileges } = 15 | List.map (File.readOnly userPrivileges) arguments 16 | |> Script.collect getLineCount 17 | |> Script.map (List.map2 Tuple.pair arguments) 18 | |> Script.thenWith 19 | (Script.each 20 | (\( fileName, lineCount ) -> 21 | Script.printLine 22 | (fileName 23 | ++ ": " 24 | ++ String.fromInt lineCount 25 | ++ " lines" 26 | ) 27 | ) 28 | ) 29 | 30 | 31 | main : Script.Program 32 | main = 33 | Script.program script 34 | -------------------------------------------------------------------------------- /examples/ListRecursive.elm: -------------------------------------------------------------------------------- 1 | module ListRecursive exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory exposing (Directory) 5 | import Script.File as File exposing (File) 6 | 7 | 8 | listRecursively : Int -> Directory permissions -> Script String () 9 | listRecursively level directory = 10 | let 11 | indentation = 12 | String.repeat level " " 13 | in 14 | Script.do 15 | [ Directory.listSubdirs directory 16 | |> Script.thenWith 17 | (Script.each 18 | (\subdirectory -> 19 | Script.printLine (indentation ++ Directory.name subdirectory ++ "/") 20 | |> Script.andThen (listRecursively (level + 1) subdirectory) 21 | ) 22 | ) 23 | , Directory.listFiles directory 24 | |> Script.thenWith 25 | (Script.each (\file -> Script.printLine (indentation ++ File.name file))) 26 | ] 27 | 28 | 29 | script : Script.Init -> Script String () 30 | script { arguments, userPrivileges } = 31 | case arguments of 32 | [ path ] -> 33 | listRecursively 0 (Directory.readOnly userPrivileges path) 34 | 35 | _ -> 36 | Script.fail "Please supply one directory name" 37 | 38 | 39 | main : Script.Program 40 | main = 41 | Script.program script 42 | -------------------------------------------------------------------------------- /examples/Miscellaneous.elm: -------------------------------------------------------------------------------- 1 | module Miscellaneous exposing (main) 2 | 3 | import Duration 4 | import Json.Decode as Decode 5 | import Script exposing (Script) 6 | import Script.Http as Http exposing (NetworkConnection) 7 | import Time 8 | 9 | 10 | script : Script.Init -> Script String () 11 | script { networkConnection } = 12 | Script.succeed { text = "A", number = 2 } 13 | |> Script.aside 14 | (\model -> 15 | Script.do 16 | [ Script.printLine model.text 17 | , printCurrentTime networkConnection 18 | , Script.sleep (Duration.seconds 0.5) 19 | ] 20 | ) 21 | |> Script.map .number 22 | |> Script.aside 23 | (\number -> 24 | Script.do 25 | [ Script.printLine (String.fromInt number) 26 | , printCurrentTime networkConnection 27 | , Script.sleep (Duration.seconds 0.5) 28 | , getCurrentTime networkConnection |> Script.ignoreResult 29 | ] 30 | ) 31 | |> Script.thenWith 32 | (\number -> 33 | if number > 2 then 34 | Script.succeed () 35 | 36 | else 37 | Script.fail "Ugh, number is too small" 38 | ) 39 | 40 | 41 | getCurrentTime : NetworkConnection -> Script String String 42 | getCurrentTime networkConnection = 43 | let 44 | url = 45 | "http://worldtimeapi.org/api/ip" 46 | 47 | decoder = 48 | Decode.field "datetime" Decode.string 49 | in 50 | Http.get networkConnection 51 | { url = url 52 | , expect = Http.expectJson decoder 53 | } 54 | |> Script.mapError (always "HTTP request failed") 55 | 56 | 57 | printCurrentTime : NetworkConnection -> Script String () 58 | printCurrentTime networkConnection = 59 | getCurrentTime networkConnection 60 | |> Script.thenWith (\time -> Script.printLine time) 61 | 62 | 63 | main : Script.Program 64 | main = 65 | Script.program script 66 | -------------------------------------------------------------------------------- /examples/MoveFile.elm: -------------------------------------------------------------------------------- 1 | module MoveFile exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory 5 | import Script.File as File 6 | 7 | 8 | script : Script.Init -> Script String () 9 | script { workingDirectory } = 10 | let 11 | sourceFile = 12 | File.in_ workingDirectory "reversed.txt" 13 | 14 | destinationFile = 15 | File.in_ workingDirectory "reversed-moved.txt" 16 | in 17 | File.move sourceFile destinationFile 18 | 19 | 20 | main : Script.Program 21 | main = 22 | Script.program script 23 | -------------------------------------------------------------------------------- /examples/ObliterateSubdirectory.elm: -------------------------------------------------------------------------------- 1 | module ObliterateSubdirectory exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory 5 | 6 | 7 | script : Script.Init -> Script String () 8 | script { workingDirectory } = 9 | let 10 | subdirectory = 11 | Directory.in_ workingDirectory "subdirectory" 12 | in 13 | Directory.obliterate subdirectory 14 | 15 | 16 | main : Script.Program 17 | main = 18 | Script.program script 19 | -------------------------------------------------------------------------------- /examples/PathChecking.elm: -------------------------------------------------------------------------------- 1 | module PathChecking exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory exposing (Directory) 5 | import Script.File as File 6 | 7 | 8 | niceScript : Directory permissions -> Script String () 9 | niceScript directory = 10 | File.read (File.in_ directory "test.txt") 11 | |> Script.thenWith 12 | (\contents -> 13 | Script.printLine <| 14 | String.fromInt (String.length contents) 15 | ++ " characters in test.txt" 16 | ) 17 | 18 | 19 | evilScript : Directory permissions -> Script String () 20 | evilScript directory = 21 | -- Attempt to sneakily break into a parent directory 22 | File.read (File.in_ directory "subdirectory/../../test.txt") 23 | |> Script.ignoreResult 24 | 25 | 26 | script : Script.Init -> Script String () 27 | script { arguments, userPrivileges } = 28 | case arguments of 29 | [ path ] -> 30 | let 31 | directory = 32 | Directory.readOnly userPrivileges path 33 | in 34 | Script.do 35 | [ niceScript directory 36 | , evilScript directory 37 | ] 38 | 39 | _ -> 40 | Script.fail "Please supply the path of one directory to read" 41 | 42 | 43 | main : Script.Program 44 | main = 45 | Script.program script 46 | -------------------------------------------------------------------------------- /examples/PowerShellTest.elm: -------------------------------------------------------------------------------- 1 | module PowerShellTest exposing (main) 2 | 3 | import Script exposing (Script) 4 | 5 | 6 | script : Script.Init -> Script String () 7 | script { workingDirectory, userPrivileges } = 8 | Script.executeWith userPrivileges 9 | { command = "PowerShell" 10 | , arguments = [ "-Command", "Get-ChildItem", "-Name", "-Path", "*.elm" ] 11 | , workingDirectory = workingDirectory 12 | } 13 | |> Script.map String.lines 14 | |> Script.map (List.map String.trim) 15 | |> Script.map (List.filter (not << String.isEmpty)) 16 | |> Script.thenWith (Script.each (\fileName -> Script.printLine (String.toUpper fileName))) 17 | 18 | 19 | main : Script.Program 20 | main = 21 | Script.program script 22 | -------------------------------------------------------------------------------- /examples/PrintEnvironmentVariables.elm: -------------------------------------------------------------------------------- 1 | module PrintEnvironmentVariables exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Environment as Environment exposing (Environment) 5 | 6 | 7 | printEnvironmentVariable : Environment -> String -> Script x () 8 | printEnvironmentVariable environment name = 9 | let 10 | value = 11 | Environment.get name environment 12 | |> Maybe.withDefault "not defined" 13 | in 14 | Script.printLine (name ++ ": " ++ value) 15 | 16 | 17 | script : Script.Init -> Script String () 18 | script { arguments, environment } = 19 | arguments |> Script.each (printEnvironmentVariable environment) 20 | 21 | 22 | main : Script.Program 23 | main = 24 | Script.program script 25 | -------------------------------------------------------------------------------- /examples/ReadFile.elm: -------------------------------------------------------------------------------- 1 | module ReadFile exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.File as File exposing (File) 5 | 6 | 7 | script : Script.Init -> Script String () 8 | script { arguments, userPrivileges } = 9 | case arguments of 10 | [ path ] -> 11 | File.read (File.readOnly userPrivileges path) 12 | |> Script.map String.lines 13 | |> Script.map (List.filter (not << String.isEmpty)) 14 | |> Script.thenWith (Script.each (\line -> Script.printLine (String.toUpper line))) 15 | 16 | _ -> 17 | Script.fail "Please supply the path of one file to read" 18 | 19 | 20 | main : Script.Program 21 | main = 22 | Script.program script 23 | -------------------------------------------------------------------------------- /examples/RemoveSubdirectory.elm: -------------------------------------------------------------------------------- 1 | module RemoveSubdirectory exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory 5 | 6 | 7 | script : Script.Init -> Script String () 8 | script { workingDirectory } = 9 | let 10 | subdirectory = 11 | Directory.in_ workingDirectory "subdirectory" 12 | in 13 | Directory.remove subdirectory 14 | 15 | 16 | main : Script.Program 17 | main = 18 | Script.program script 19 | -------------------------------------------------------------------------------- /examples/Test/NestedModule.elm: -------------------------------------------------------------------------------- 1 | module Test.NestedModule exposing (main) 2 | 3 | import Script exposing (Script) 4 | 5 | 6 | script : Script.Init -> Script String () 7 | script _ = 8 | Script.printLine "Nested module works!" 9 | 10 | 11 | main : Script.Program 12 | main = 13 | Script.program script 14 | -------------------------------------------------------------------------------- /examples/TestCompilation.elm: -------------------------------------------------------------------------------- 1 | module TestCompilation exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory 5 | import Script.File as File 6 | 7 | 8 | script : Script.Init -> Script String () 9 | script { workingDirectory, userPrivileges } = 10 | Directory.listFiles workingDirectory 11 | |> Script.thenWith 12 | (Script.each 13 | (\file -> 14 | if File.name file |> String.endsWith ".elm" then 15 | Script.do 16 | [ Script.printLine ("Compiling " ++ File.name file) 17 | , Script.executeWith userPrivileges 18 | { command = "elm" 19 | , arguments = [ "make", "--output", "/dev/null", File.path file ] 20 | , workingDirectory = workingDirectory 21 | } 22 | |> Script.ignoreResult 23 | |> Script.onError (\_ -> Script.fail "Elm compilation failed") 24 | ] 25 | 26 | else 27 | Script.succeed () 28 | ) 29 | ) 30 | 31 | 32 | main : Script.Program 33 | main = 34 | Script.program script 35 | -------------------------------------------------------------------------------- /examples/Tests.elm: -------------------------------------------------------------------------------- 1 | module Tests exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory exposing (Directory, Writable) 5 | 6 | 7 | runTestCases : Directory Writable -> Script.UserPrivileges -> List ( String, List String, String ) -> Script String () 8 | runTestCases workingDirectory userPrivileges testCases = 9 | testCases 10 | |> Script.each 11 | (\( scriptFileName, scriptArguments, expectedOutput ) -> 12 | Script.executeWith userPrivileges 13 | { command = "deno" 14 | , arguments = 15 | [ "run", "-A", "../runner/main.js", "run", scriptFileName ] 16 | ++ scriptArguments 17 | , workingDirectory = workingDirectory 18 | } 19 | |> Script.onError 20 | (\processError -> 21 | Script.fail ("Running '" ++ scriptFileName ++ "' failed") 22 | ) 23 | |> Script.thenWith 24 | (\output -> 25 | if String.trim output == expectedOutput then 26 | Script.printLine ("PASSED: " ++ scriptFileName) 27 | 28 | else 29 | Script.fail 30 | ("FAILED: " 31 | ++ scriptFileName 32 | ++ "\n\n" 33 | ++ "Expected output:\n\n" 34 | ++ expectedOutput 35 | ++ "\n\nActual output:\n\n" 36 | ++ String.trim output 37 | ) 38 | ) 39 | ) 40 | |> Script.andThen 41 | (Script.printLine <| 42 | "Success! " 43 | ++ String.fromInt (List.length testCases) 44 | ++ " tests passed" 45 | ) 46 | 47 | 48 | script : Script.Init -> Script String () 49 | script { workingDirectory, userPrivileges } = 50 | runTestCases workingDirectory userPrivileges <| 51 | [ ( "HelloWorld.elm", [], "Hello World!" ) 52 | , ( "GetElmVersion.elm", [], "Current Elm version: 0.19.1" ) 53 | , ( "LineCounts.elm", [ "test.txt" ], "test.txt: 3 lines" ) 54 | , ( "ForEach.elm" 55 | , [ "1", "2", "undefined", "3.5" ] 56 | , "1 squared is 1\n2 squared is 4\nundefined is not a number!\n3.5 squared is 12.25" 57 | ) 58 | ] 59 | 60 | 61 | main : Script.Program 62 | main = 63 | Script.program script 64 | -------------------------------------------------------------------------------- /examples/UsuallyFails.elm: -------------------------------------------------------------------------------- 1 | module UsuallyFails exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Time 5 | 6 | 7 | script : Script.Init -> Script String () 8 | script _ = 9 | Script.getCurrentTime 10 | |> Script.thenWith 11 | (\time -> 12 | if (Time.posixToMillis time |> modBy 100) > 87 then 13 | Script.printLine "Succeeded" 14 | 15 | else 16 | Script.fail "Failed" 17 | ) 18 | 19 | 20 | main : Script.Program 21 | main = 22 | Script.program script 23 | -------------------------------------------------------------------------------- /examples/WithRetry.elm: -------------------------------------------------------------------------------- 1 | module WithRetry exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory exposing (Directory, Writable) 5 | 6 | 7 | retry : Directory Writable -> Script.UserPrivileges -> String -> List String -> Int -> Script String () 8 | retry workingDirectory userPrivileges command arguments count = 9 | Script.tryToExecuteWith userPrivileges 10 | { command = command 11 | , arguments = arguments 12 | , workingDirectory = workingDirectory 13 | } 14 | |> Script.thenWith (\output -> Script.printLine output) 15 | |> Script.onError 16 | (\error -> 17 | if count > 0 then 18 | case error of 19 | Script.ExecutableNotFound -> 20 | Script.fail "Process executable not found" 21 | 22 | Script.SubprocessExitedWithError _ -> 23 | Script.printLine "Process exited with error, retrying..." 24 | |> Script.andThen 25 | (retry 26 | workingDirectory 27 | userPrivileges 28 | command 29 | arguments 30 | (count - 1) 31 | ) 32 | 33 | Script.SubprocessWasTerminated -> 34 | Script.fail "Process was terminated" 35 | 36 | Script.SubprocessFailed message -> 37 | Script.fail ("Process could not be run: " ++ message) 38 | 39 | else 40 | Script.fail "Process failed too many times" 41 | ) 42 | 43 | 44 | script : Script.Init -> Script String () 45 | script { arguments, workingDirectory, userPrivileges } = 46 | case arguments of 47 | [] -> 48 | Script.fail "Please enter an executable to run" 49 | 50 | command :: rest -> 51 | retry workingDirectory userPrivileges command rest 5 52 | 53 | 54 | main : Script.Program 55 | main = 56 | Script.program script 57 | -------------------------------------------------------------------------------- /examples/WriteFile.elm: -------------------------------------------------------------------------------- 1 | module WriteFile exposing (main) 2 | 3 | import Script exposing (Script) 4 | import Script.Directory as Directory 5 | import Script.File as File 6 | import Script.Platform as Platform 7 | 8 | 9 | reverseLines : String -> String -> String 10 | reverseLines lineSeparator input = 11 | input 12 | -- Remove trailing newline (having one messes up String.lines) 13 | |> String.trimRight 14 | -- Split into lines 15 | |> String.lines 16 | -- Remove trailing whitespace on each line (nobody wants that) 17 | |> List.map String.trimRight 18 | -- Actually reverse lines 19 | |> List.reverse 20 | -- Join back into one string 21 | |> String.join lineSeparator 22 | -- Add back trailing newline (every good file should have one) 23 | |> (\string -> string ++ lineSeparator) 24 | 25 | 26 | script : Script.Init -> Script String () 27 | script { workingDirectory, platform } = 28 | let 29 | inputFile = 30 | File.in_ workingDirectory "test.txt" 31 | 32 | outputFile = 33 | File.in_ workingDirectory "reversed.txt" 34 | 35 | lineSeparator = 36 | Platform.lineSeparator platform 37 | in 38 | File.read inputFile 39 | |> Script.map (reverseLines lineSeparator) 40 | |> Script.thenWith (\reversedInput -> File.writeTo outputFile reversedInput) 41 | 42 | 43 | main : Script.Program 44 | main = 45 | Script.program script 46 | -------------------------------------------------------------------------------- /examples/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | ".", 5 | "../src" 6 | ], 7 | "elm-version": "0.19.1", 8 | "dependencies": { 9 | "direct": { 10 | "elm/core": "1.0.2", 11 | "elm/http": "2.0.0", 12 | "elm/json": "1.1.2", 13 | "elm/regex": "1.0.0", 14 | "elm/time": "1.0.0", 15 | "ianmackenzie/elm-units": "2.2.0" 16 | }, 17 | "indirect": { 18 | "elm/bytes": "1.0.7", 19 | "elm/file": "1.0.1" 20 | } 21 | }, 22 | "test-dependencies": { 23 | "direct": {}, 24 | "indirect": {} 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /examples/test.txt: -------------------------------------------------------------------------------- 1 | elm 2 | A delightful language for reliable scripts. 3 | Generate JavaScript with great performance and no runtime exceptions. 4 | -------------------------------------------------------------------------------- /runner/main.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | // Used by CopyNewVersion.elm 4 | const majorVersion = 0; 5 | const minorVersion = 2; 6 | 7 | const majorProtocolVersion = 9; 8 | const minorProtocolVersion = 1; 9 | 10 | import * as path from "https://deno.land/std@0.71.0/path/mod.ts"; 11 | 12 | const tempDirectoriesToRemove = []; 13 | 14 | function createTemporaryDirectory() { 15 | // Create a new temp directory 16 | const directoryPath = Deno.makeTempDirSync(); 17 | // Add it to the list of temp directories to remove when the script has 18 | // finished executing 19 | tempDirectoriesToRemove.push(directoryPath); 20 | return directoryPath; 21 | } 22 | 23 | function exit(code) { 24 | // First, clean up any temp directories created while running the script 25 | for (const directoryPath of tempDirectoriesToRemove) { 26 | try { 27 | Deno.removeSync(directoryPath, { recursive: true }); 28 | } catch (error) { 29 | // Ignore any errors that may occur when attempting to delete a 30 | // temporary directory - likely the directory was just deleted 31 | // explicitly, and even if it's some other issue (directory 32 | // somehow became read-only, in use because an antivirus program is 33 | // currently checking it etc.) it's not generally the end of the 34 | // world if the odd temp directory doesn't get deleted. (Script 35 | // authors who need to make sure sensitive data gets deleted can 36 | // always call Directory.obliterate in their script and check for 37 | // any errors resulting from it.) 38 | continue; 39 | } 40 | } 41 | // Finally, actually exit 42 | Deno.exit(code); 43 | } 44 | 45 | function resolvePath(components) { 46 | if (components.length == 0) { 47 | throw Error("Empty path given"); 48 | } 49 | 50 | let result = path.resolve(components[0]); 51 | for (var i = 1; i < components.length; i++) { 52 | const childPath = path.resolve(result, components[i]); 53 | if (path.relative(result, childPath).startsWith("..")) { 54 | throw Error(components[i] + " is not a proper relative path"); 55 | } 56 | result = childPath; 57 | } 58 | return result; 59 | } 60 | 61 | function listEntities(request, handleResponse, statsPredicate) { 62 | try { 63 | const directoryPath = resolvePath(request.value); 64 | const results = Array.from(Deno.readDirSync(directoryPath)) 65 | .filter(function (fileInfo) { 66 | return statsPredicate(fileInfo); 67 | }) 68 | .map(function (fileInfo) { 69 | return fileInfo.name; 70 | }); 71 | handleResponse(results); 72 | } catch (error) { 73 | handleResponse({ message: error.message }); 74 | } 75 | } 76 | 77 | // From https://github.com/github/fetch/issues/175#issuecomment-284787564 78 | function timeout(ms, promise) { 79 | return new Promise(function (resolve, reject) { 80 | setTimeout(function () { 81 | reject(new Error("timeout")); 82 | }, ms); 83 | promise.then(resolve, reject); 84 | }); 85 | } 86 | 87 | function findNestedModule(obj) { 88 | const nestedModules = Object.values(obj); 89 | if (nestedModules.length != 1) { 90 | console.log( 91 | `Expected exactly 1 nested module, found ${nestedModules.length}`, 92 | ); 93 | exit(1); 94 | } 95 | return nestedModules[0]; 96 | } 97 | 98 | function runCompiledJs(jsFileName, commandLineArgs) { 99 | // Read compiled JS from file 100 | const jsData = Deno.readFileSync(jsFileName); 101 | const jsText = new TextDecoder("utf-8").decode(jsData); 102 | 103 | // Add our mock XMLHttpRequest class into the global namespace 104 | // so that Elm code will use it 105 | globalThis["XMLHttpRequest"] = XMLHttpRequest; 106 | 107 | // Run Elm code to create the 'Elm' object 108 | const globalEval = eval; 109 | globalEval(jsText); 110 | 111 | // Collect flags to pass to Elm program 112 | const flags = {}; 113 | flags["arguments"] = commandLineArgs; 114 | switch (Deno.build.os) { 115 | case "mac": 116 | case "darwin": 117 | case "linux": 118 | flags["platform"] = { type: "posix", name: Deno.build.os }; 119 | break; 120 | case "windows": 121 | flags["platform"] = { type: "windows" }; 122 | break; 123 | default: 124 | console.log("Unrecognized OS '" + Deno.build.os + "'"); 125 | exit(1); 126 | } 127 | flags["environment"] = Object.entries(Deno.env.toObject()); 128 | flags["workingDirectory"] = Deno.cwd(); 129 | 130 | // Get Elm program object 131 | var module = findNestedModule(globalThis["Elm"]); 132 | while (!("init" in module)) { 133 | module = findNestedModule(module); 134 | } 135 | // Start Elm program 136 | module.init({ flags: flags }); 137 | } 138 | 139 | class XMLHttpRequest { 140 | constructor() { 141 | this.status = 200; 142 | this.statusText = "200 OK"; 143 | this.responseUrl = "/runner"; 144 | } 145 | 146 | getAllResponseHeaders() { 147 | return ""; 148 | } 149 | 150 | setRequestHeader(name, value) { 151 | return; 152 | } 153 | 154 | open(method, url, performAsync) { 155 | return; 156 | } 157 | 158 | addEventListener(name, callback) { 159 | if (name == "load") { 160 | this._callback = callback; 161 | } 162 | } 163 | 164 | async send(request) { 165 | let xhr = this; 166 | function handleResponse(response) { 167 | xhr.response = JSON.stringify(response); 168 | xhr._callback(); 169 | } 170 | request = JSON.parse(request); 171 | switch (request.name) { 172 | case "checkVersion": 173 | const requiredMajorProtocolVersion = request.value[0]; 174 | const requiredMinorProtocolVersion = request.value[1]; 175 | const describeCurrentProtocolVersion = 176 | ` (current elm-run protocol version: ${majorProtocolVersion}.${minorProtocolVersion})`; 177 | if (requiredMajorProtocolVersion !== majorProtocolVersion) { 178 | console.log( 179 | "Version mismatch: script requires elm-run major protocol version " + 180 | requiredMajorProtocolVersion + 181 | describeCurrentProtocolVersion, 182 | ); 183 | if (requiredMajorProtocolVersion > majorProtocolVersion) { 184 | console.log("Please update to a newer version of elm-run"); 185 | } else { 186 | console.log( 187 | "Please update script to use a newer version of the ianmackenzie/elm-script package", 188 | ); 189 | } 190 | exit(1); 191 | } else if (requiredMinorProtocolVersion > minorProtocolVersion) { 192 | const requiredProtocolVersionString = requiredMajorProtocolVersion + 193 | "." + requiredMinorProtocolVersion; 194 | console.log( 195 | "Version mismatch: script requires elm-run protocol version at least " + 196 | requiredProtocolVersionString + 197 | describeCurrentProtocolVersion, 198 | ); 199 | console.log("Please update to a newer version of elm-run"); 200 | exit(1); 201 | } else { 202 | handleResponse(null); 203 | } 204 | break; 205 | case "writeStdout": 206 | try { 207 | const data = new TextEncoder().encode(request.value); 208 | Deno.stdout.writeSync(data); 209 | handleResponse(null); 210 | } catch (error) { 211 | console.log("Error printing to stdout"); 212 | exit(1); 213 | } 214 | break; 215 | case "exit": 216 | exit(request.value); 217 | case "abort": 218 | const data = new TextEncoder().encode(request.value); 219 | Deno.stdout.writeSync(data); 220 | exit(1); 221 | case "readFile": 222 | try { 223 | const filePath = resolvePath(request.value); 224 | const data = Deno.readFileSync(filePath); 225 | const contents = new TextDecoder("utf-8").decode(data); 226 | handleResponse(contents); 227 | } catch (error) { 228 | handleResponse({ message: error.message }); 229 | } 230 | break; 231 | case "writeFile": 232 | try { 233 | const filePath = resolvePath(request.value.path); 234 | const contents = new TextEncoder().encode(request.value.contents); 235 | Deno.writeFileSync(filePath, contents); 236 | handleResponse(null); 237 | } catch (error) { 238 | handleResponse({ message: error.message }); 239 | } 240 | break; 241 | case "listFiles": 242 | listEntities(request, handleResponse, (fileInfo) => fileInfo.isFile); 243 | break; 244 | case "listSubdirectories": 245 | listEntities( 246 | request, 247 | handleResponse, 248 | (fileInfo) => fileInfo.isDirectory, 249 | ); 250 | break; 251 | case "execute": 252 | try { 253 | const process = Deno.run({ 254 | cmd: [request.value.command, ...request.value.arguments], 255 | cwd: resolvePath(request.value.workingDirectory), 256 | stdout: "piped", 257 | stderr: "piped", 258 | }); 259 | const outputData = await process.output(); 260 | const errorOutputData = await process.stderrOutput(); 261 | const result = await process.status(); 262 | if (result.success) { 263 | const output = new TextDecoder("utf-8").decode(outputData); 264 | handleResponse(output); 265 | } else { 266 | if (result.code !== null) { 267 | handleResponse({ error: "exited", code: result.code }); 268 | } else if (result.signal !== null) { 269 | handleResponse({ error: "terminated" }); 270 | } else { 271 | const errorOutput = new TextDecoder("utf-8").decode( 272 | errorOutputData, 273 | ); 274 | handleResponse({ error: "failed", message: errorOutput }); 275 | } 276 | } 277 | } catch (error) { 278 | if (error instanceof Deno.errors.NotFound) { 279 | handleResponse({ error: "notfound" }); 280 | } else { 281 | console.log(error); 282 | exit(1); 283 | } 284 | } 285 | break; 286 | case "copyFile": 287 | try { 288 | const sourcePath = resolvePath(request.value.sourcePath); 289 | const destinationPath = resolvePath(request.value.destinationPath); 290 | Deno.copyFileSync(sourcePath, destinationPath); 291 | handleResponse(null); 292 | } catch (error) { 293 | handleResponse({ message: error.message }); 294 | } 295 | break; 296 | case "moveFile": 297 | try { 298 | const sourcePath = resolvePath(request.value.sourcePath); 299 | const destinationPath = resolvePath(request.value.destinationPath); 300 | Deno.renameSync(sourcePath, destinationPath); 301 | handleResponse(null); 302 | } catch (error) { 303 | handleResponse({ message: error.message }); 304 | } 305 | break; 306 | case "deleteFile": 307 | try { 308 | const filePath = resolvePath(request.value); 309 | Deno.removeSync(filePath); 310 | handleResponse(null); 311 | } catch (error) { 312 | handleResponse({ message: error.message }); 313 | } 314 | break; 315 | case "stat": 316 | try { 317 | const entityPath = resolvePath(request.value); 318 | const fileInfo = Deno.statSync(entityPath); 319 | if (fileInfo.isFile) { 320 | handleResponse("file"); 321 | } else if (fileInfo.isDirectory) { 322 | handleResponse("directory"); 323 | } else { 324 | handleResponse("other"); 325 | } 326 | } catch (error) { 327 | if (error instanceof Deno.errors.NotFound) { 328 | handleResponse("nonexistent"); 329 | } else { 330 | handleResponse({ message: error.message }); 331 | } 332 | } 333 | break; 334 | case "createDirectory": 335 | try { 336 | const directoryPath = resolvePath(request.value.path); 337 | Deno.mkdirSync(directoryPath, { recursive: request.value.recursive }); 338 | handleResponse(null); 339 | } catch (error) { 340 | handleResponse({ message: error.message }); 341 | } 342 | break; 343 | case "removeDirectory": 344 | try { 345 | const directoryPath = resolvePath(request.value.path); 346 | Deno.removeSync(directoryPath, { 347 | recursive: request.value.recursive, 348 | }); 349 | handleResponse(null); 350 | } catch (error) { 351 | handleResponse({ message: error.message }); 352 | } 353 | break; 354 | case "createTemporaryDirectory": 355 | try { 356 | const directoryPath = createTemporaryDirectory(); 357 | handleResponse(directoryPath); 358 | } catch (error) { 359 | handleResponse({ message: error.message }); 360 | } 361 | break; 362 | case "http": 363 | try { 364 | let promise = fetch(request.value.url, request.value.options); 365 | if (request.value.timeout != null) { 366 | promise = timeout(request.value.timeout, promise); 367 | } 368 | const httpResponse = await promise; 369 | const responseBody = await httpResponse.text(); 370 | handleResponse({ 371 | status: httpResponse.status, 372 | body: responseBody, 373 | }); 374 | } catch (error) { 375 | let errorType = null; 376 | if (error.message == "timeout") { 377 | errorType = "Timeout"; 378 | } else { 379 | errorType = "NetworkError"; 380 | } 381 | handleResponse({ error: errorType }); 382 | } 383 | break; 384 | default: 385 | console.log(`Internal error - unexpected request ${request}`); 386 | console.log( 387 | "Try updating to newer versions of elm-run and the ianmackenzie/elm-script package", 388 | ); 389 | exit(1); 390 | } 391 | } 392 | } 393 | 394 | async function main() { 395 | if (Deno.args.length >= 2) { 396 | const subcommand = Deno.args[0]; 397 | if (subcommand !== "run") { 398 | console.log(`Run as 'elm-script run Script.elm [arguments]'`); 399 | exit(1); 400 | } 401 | var isDebug = null; 402 | var sourceFileName = null; 403 | var commandLineArgs = null; 404 | if (Deno.args[1] == "--debug") { 405 | isDebug = true; 406 | sourceFileName = Deno.args[2]; 407 | commandLineArgs = Deno.args.slice(3); 408 | } else { 409 | isDebug = false; 410 | sourceFileName = Deno.args[1]; 411 | commandLineArgs = Deno.args.slice(2); 412 | } 413 | const absolutePath = path.resolve(sourceFileName); 414 | const extension = path.extname(absolutePath); 415 | if (extension === ".js") { 416 | runCompiledJs(absolutePath, commandLineArgs); 417 | } else if (extension === ".elm") { 418 | const tempDirectory = createTemporaryDirectory(); 419 | const tempFileName = path.resolve(tempDirectory, "main.js"); 420 | const elmFileDirectory = path.dirname(absolutePath); 421 | const elmProcess = Deno.run({ 422 | cmd: [ 423 | "elm", 424 | "make", 425 | ...(isDebug ? [] : ["--optimize"]), 426 | "--output=" + tempFileName, 427 | absolutePath, 428 | ], 429 | stdout: "piped", 430 | cwd: elmFileDirectory, 431 | }); 432 | const elmResult = await elmProcess.status(); 433 | if (elmResult.success) { 434 | runCompiledJs(tempFileName, commandLineArgs); 435 | } else { 436 | // The Elm compiler will have printed out a compilation error 437 | // message, no need to add our own 438 | exit(1); 439 | } 440 | } else { 441 | console.log( 442 | `Unrecognized source file extension ${extension} (expecting.elm or.js)`, 443 | ); 444 | exit(1); 445 | } 446 | } else { 447 | console.log(`Run as 'elm-script run Script.elm [arguments]'`); 448 | exit(1); 449 | } 450 | } 451 | 452 | main(); 453 | -------------------------------------------------------------------------------- /scripts/Common.elm: -------------------------------------------------------------------------------- 1 | port module Common exposing (handleError, program) 2 | 3 | import Json.Encode exposing (Value) 4 | import Script exposing (Script) 5 | 6 | 7 | handleError : (x -> String) -> x -> Script Int a 8 | handleError toMessage error = 9 | Script.printLine ("[SCRIPT ERROR] " ++ toMessage error) 10 | |> Script.andThen (Script.fail 1) 11 | 12 | 13 | port requestPort : Value -> Cmd msg 14 | 15 | 16 | port responsePort : (Value -> msg) -> Sub msg 17 | 18 | 19 | program : (Script.Init -> Script Int ()) -> Script.Program 20 | program script = 21 | Script.program script requestPort responsePort 22 | -------------------------------------------------------------------------------- /scripts/CopyNewVersion.elm: -------------------------------------------------------------------------------- 1 | module CopyNewVersion exposing (main) 2 | 3 | import Parser exposing ((|.), (|=), Parser) 4 | import Script exposing (Script, UserPrivileges) 5 | import Script.Directory as Directory 6 | import Script.File as File exposing (File, ReadOnly, Writable) 7 | 8 | 9 | parseNewLine : Parser () 10 | parseNewLine = 11 | Parser.oneOf [ Parser.symbol "\n", Parser.symbol "\u{000D}\n" ] 12 | 13 | 14 | parseVersion : Parser ( Int, Int ) 15 | parseVersion = 16 | Parser.succeed Tuple.pair 17 | |. Parser.symbol "\"use strict\";" 18 | |. parseNewLine 19 | |. parseNewLine 20 | |. Parser.symbol "// Used by CopyNewVersion.elm" 21 | |. parseNewLine 22 | |. Parser.symbol "const majorVersion = " 23 | |= Parser.int 24 | |. Parser.symbol ";" 25 | |. parseNewLine 26 | |. Parser.symbol "const minorVersion = " 27 | |= Parser.int 28 | |. Parser.symbol ";" 29 | |. parseNewLine 30 | 31 | 32 | script : Script.Init -> Script String () 33 | script { userPrivileges } = 34 | let 35 | runnerFile = 36 | File.readOnly userPrivileges "/home/ian/git/ianmackenzie/elm-script/runner/main.js" 37 | in 38 | File.read runnerFile 39 | |> Script.thenWith 40 | (\contents -> 41 | case Parser.run parseVersion contents of 42 | Ok version -> 43 | copyVersion userPrivileges version runnerFile 44 | 45 | Err _ -> 46 | Script.fail "Failed to parse main.js" 47 | ) 48 | 49 | 50 | copyVersion : UserPrivileges -> ( Int, Int ) -> File ReadOnly -> Script String () 51 | copyVersion userPrivileges ( majorVersion, minorVersion ) runnerFile = 52 | let 53 | versionString = 54 | String.fromInt majorVersion ++ "." ++ String.fromInt minorVersion 55 | 56 | targetFile = 57 | File.writable userPrivileges 58 | ("/home/ian/git/elm-script/elm-script.github.io/" ++ versionString) 59 | in 60 | File.checkExistence targetFile 61 | |> Script.thenWith 62 | (\existence -> 63 | case existence of 64 | File.DoesNotExist -> 65 | let 66 | latestFile = 67 | File.writable userPrivileges 68 | "/home/ian/git/elm-script/elm-script.github.io/latest" 69 | in 70 | Script.do 71 | [ Script.printLine ("Copying new version " ++ versionString) 72 | , File.copy runnerFile targetFile 73 | , File.copy runnerFile latestFile 74 | ] 75 | 76 | _ -> 77 | Script.fail ("Version " ++ versionString ++ " already exists!") 78 | ) 79 | 80 | 81 | main : Script.Program 82 | main = 83 | Script.program script 84 | -------------------------------------------------------------------------------- /scripts/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | ".", 5 | "../src" 6 | ], 7 | "elm-version": "0.19.1", 8 | "dependencies": { 9 | "direct": { 10 | "elm/core": "1.0.2", 11 | "elm/http": "2.0.0", 12 | "elm/json": "1.1.2", 13 | "elm/parser": "1.1.0", 14 | "elm/regex": "1.0.0", 15 | "elm/time": "1.0.0", 16 | "ianmackenzie/elm-units": "2.2.0" 17 | }, 18 | "indirect": { 19 | "elm/bytes": "1.0.7", 20 | "elm/file": "1.0.1" 21 | } 22 | }, 23 | "test-dependencies": { 24 | "direct": {}, 25 | "indirect": {} 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /src/Script.elm: -------------------------------------------------------------------------------- 1 | module Script exposing 2 | ( Script, Init, UserPrivileges, SubprocessError(..) 3 | , Program, program, customProgram 4 | , succeed, fail 5 | , printLine, sleep, getCurrentTime 6 | , executeWith, tryToExecuteWith 7 | , map, map2, map3, map4, ignoreResult 8 | , do, each, sequence, collect, andThen, thenWith, aside 9 | , mapError, attempt, onError, ignoreError, finally 10 | ) 11 | 12 | {-| The functions in this module let you define scripts, chain them together in 13 | various ways, and turn them into runnable programs. 14 | 15 | @docs Script, Init, UserPrivileges, SubprocessError 16 | 17 | 18 | # Running 19 | 20 | @docs RequestPort, ResponsePort, Program, program, customProgram 21 | 22 | 23 | # Basics 24 | 25 | @docs succeed, fail 26 | 27 | 28 | # Utilities 29 | 30 | @docs printLine, sleep, getCurrentTime 31 | 32 | 33 | # Running external executables 34 | 35 | @docs executeWith, tryToExecuteWith 36 | 37 | 38 | # Mapping 39 | 40 | @docs map, map2, map3, map4, ignoreResult 41 | 42 | 43 | # Sequencing 44 | 45 | @docs do, each, sequence, collect, andThen, thenWith, aside 46 | 47 | 48 | # Error handling 49 | 50 | @docs mapError, attempt, onError, perform, ignoreError, finally 51 | 52 | -} 53 | 54 | import Dict exposing (Dict) 55 | import Duration exposing (Duration) 56 | import Http 57 | import Json.Decode as Decode exposing (Decoder) 58 | import Json.Encode as Encode exposing (Value) 59 | import Platform.Cmd as Cmd 60 | import Process 61 | import Script.Directory exposing (Directory) 62 | import Script.Environment exposing (Environment) 63 | import Script.File exposing (File) 64 | import Script.Http exposing (NetworkConnection) 65 | import Script.Internal as Internal exposing (Flags) 66 | import Script.Path as Path exposing (Path(..)) 67 | import Script.Permissions exposing (Writable) 68 | import Script.Platform as Platform exposing (Platform(..)) 69 | import Task exposing (Task) 70 | import Time 71 | 72 | 73 | requiredProtocolVersion : ( Int, Int ) 74 | requiredProtocolVersion = 75 | ( 9, 1 ) 76 | 77 | 78 | {-| A `Script x a` value defines a script that, when run, will either produce a 79 | value of type `a` or an error of type `x`. 80 | -} 81 | type alias Script x a = 82 | Internal.Script x a 83 | 84 | 85 | type alias Init = 86 | { arguments : List String 87 | , workingDirectory : Directory Writable 88 | , platform : Platform 89 | , environment : Environment 90 | , networkConnection : NetworkConnection 91 | , userPrivileges : UserPrivileges 92 | } 93 | 94 | 95 | type alias UserPrivileges = 96 | Internal.UserPrivileges 97 | 98 | 99 | type SubprocessError 100 | = ExecutableNotFound 101 | | SubprocessFailed String 102 | | SubprocessWasTerminated 103 | | SubprocessExitedWithError Int 104 | 105 | 106 | type Model 107 | = Running Flags (Script Int ()) 108 | | Aborting 109 | 110 | 111 | type Msg 112 | = Updated (Script Int ()) 113 | | Response (Result Http.Error Value) 114 | 115 | 116 | {-| The type of program returned by `Script.program`. 117 | -} 118 | type alias Program = 119 | Platform.Program Value Model Msg 120 | 121 | 122 | decodeFlags : Decoder Flags 123 | decodeFlags = 124 | Decode.field "platform" decodePlatform 125 | |> Decode.andThen 126 | (\platform -> 127 | Decode.map4 Flags 128 | (Decode.field "arguments" (Decode.list Decode.string)) 129 | (Decode.succeed platform) 130 | (Decode.field "environment" (decodeEnvironment platform)) 131 | (Decode.field "workingDirectory" (decodeWorkingDirectoryPath platform)) 132 | ) 133 | 134 | 135 | decodePlatform : Decoder Platform 136 | decodePlatform = 137 | Decode.field "type" Decode.string 138 | |> Decode.andThen 139 | (\platformType -> 140 | case platformType of 141 | "posix" -> 142 | Decode.map Posix (Decode.field "name" Decode.string) 143 | 144 | "darwin" -> 145 | Decode.map Posix (Decode.field "name" Decode.string) 146 | 147 | "windows" -> 148 | Decode.succeed Windows 149 | 150 | _ -> 151 | Decode.fail ("Unrecognized platform type '" ++ platformType ++ "'") 152 | ) 153 | 154 | 155 | decodeKeyValuePair : Decoder ( String, String ) 156 | decodeKeyValuePair = 157 | Decode.map2 Tuple.pair 158 | (Decode.index 0 Decode.string) 159 | (Decode.index 1 Decode.string) 160 | 161 | 162 | decodeEnvironment : Platform -> Decoder Environment 163 | decodeEnvironment platform = 164 | Decode.list decodeKeyValuePair 165 | |> Decode.map 166 | (\keyValuePairs -> 167 | Internal.Environment platform 168 | (Dict.fromList <| 169 | -- On Windows, capitalize environment variable names 170 | -- so they can be looked up case-insensitively (same 171 | -- behavior as process.env in Node) 172 | case platform of 173 | Posix _ -> 174 | keyValuePairs 175 | 176 | Windows -> 177 | List.map (Tuple.mapFirst String.toUpper) keyValuePairs 178 | ) 179 | ) 180 | 181 | 182 | decodeWorkingDirectoryPath : Platform -> Decoder Path 183 | decodeWorkingDirectoryPath platform = 184 | Decode.string |> Decode.map (Path.absolute platform) 185 | 186 | 187 | {-| Actually create a runnable script program! Your top-level script file should 188 | have `main` defined as 189 | 190 | main : Script.Program 191 | main = 192 | Script.program script requestPort responsePort 193 | 194 | The function provided as the first argument to `Script.program` must accept a 195 | `Context` value and produce a `Script String ()`. If this script succeeds with 196 | `()`, then a value of 0 will be returned to the operating system as the return 197 | value of the script. If the script fails with an `String`, then that message 198 | will be printed to the console and a value of 1 will be returned to the 199 | operating system instead. 200 | 201 | -} 202 | program : (Init -> Script String ()) -> Program 203 | program main = 204 | customProgram 205 | (\init -> 206 | main init 207 | |> onError (\message -> printLine message |> andThen (fail 1)) 208 | ) 209 | 210 | 211 | {-| Like `program`, but with a bit more control: allows you to control the 212 | integer error code returned to the operating system on failure, and does not 213 | print out anything by default (you will have to print out any error messages 214 | explicitly yourself). 215 | -} 216 | customProgram : (Init -> Script Int ()) -> Program 217 | customProgram main = 218 | let 219 | checkProtocolVersion = 220 | let 221 | ( requiredMajorProtocolVersion, requiredMinorProtocolVersion ) = 222 | requiredProtocolVersion 223 | 224 | encodedProtocolVersion = 225 | Encode.list Encode.int 226 | [ requiredMajorProtocolVersion, requiredMinorProtocolVersion ] 227 | in 228 | Internal.Invoke "checkVersion" encodedProtocolVersion <| 229 | \flags -> Decode.null (succeed ()) 230 | 231 | init flagsValue = 232 | case Decode.decodeValue decodeFlags flagsValue of 233 | Ok decodedFlags -> 234 | let 235 | workingDirectory = 236 | Internal.Directory decodedFlags.workingDirectoryPath 237 | 238 | userPrivileges = 239 | Internal.UserPrivileges decodedFlags.workingDirectoryPath 240 | 241 | runMain = 242 | main 243 | { arguments = decodedFlags.arguments 244 | , workingDirectory = workingDirectory 245 | , platform = decodedFlags.platform 246 | , environment = decodedFlags.environment 247 | , networkConnection = Internal.NetworkConnection 248 | , userPrivileges = userPrivileges 249 | } 250 | 251 | script = 252 | checkProtocolVersion |> andThen runMain 253 | in 254 | ( Running decodedFlags script, commands script ) 255 | 256 | Err _ -> 257 | abort "Failed to decode flags from JavaScript" 258 | 259 | submitRequest name value = 260 | Http.post 261 | { url = "/runner" 262 | , body = 263 | Http.jsonBody <| 264 | Encode.object 265 | [ ( "name", Encode.string name ) 266 | , ( "value", value ) 267 | ] 268 | , expect = 269 | Http.expectJson Response Decode.value 270 | } 271 | 272 | commands script = 273 | case script of 274 | Internal.Succeed () -> 275 | submitRequest "exit" (Encode.int 0) 276 | 277 | Internal.Fail errorCode -> 278 | submitRequest "exit" (Encode.int errorCode) 279 | 280 | Internal.Perform task -> 281 | Task.perform Updated task 282 | 283 | Internal.Invoke name value _ -> 284 | submitRequest name value 285 | 286 | Internal.Do command -> 287 | Cmd.map Updated command 288 | 289 | abort message = 290 | ( Aborting, submitRequest "abort" (Encode.string message) ) 291 | 292 | update message model = 293 | case model of 294 | Aborting -> 295 | ( model, Cmd.none ) 296 | 297 | Running flags current -> 298 | case message of 299 | Updated updated -> 300 | ( Running flags updated, commands updated ) 301 | 302 | Response (Ok value) -> 303 | case current of 304 | Internal.Invoke _ _ decoder -> 305 | case Decode.decodeValue (decoder flags) value of 306 | Ok updated -> 307 | ( Running flags updated, commands updated ) 308 | 309 | Err decodeError -> 310 | abort ("Failed to decode response from JavaScript: " ++ Decode.errorToString decodeError) 311 | 312 | _ -> 313 | abort ("Received unexpected response from JavaScript: " ++ Encode.encode 0 value) 314 | 315 | Response (Err _) -> 316 | abort "Internal HTTP request failed" 317 | in 318 | Platform.worker 319 | { init = init 320 | , update = update 321 | , subscriptions = always Sub.none 322 | } 323 | 324 | 325 | {-| A script that succeeds immediately with the given value. 326 | -} 327 | succeed : a -> Script x a 328 | succeed = 329 | Internal.Succeed 330 | 331 | 332 | {-| A script that fails immediately with the given value. The following script 333 | greets someone by their name given by the first command-line argument, or prints 334 | an error message and then returns an error code if no names or multiple names 335 | are given: 336 | 337 | script : List String -> Script Int () 338 | script args = 339 | case args of 340 | [ name ] -> 341 | Script.printLine ("Hello " ++ name ++ "!") 342 | 343 | [] -> 344 | Script.printLine "Please enter a name" 345 | |> Script.andThen (Script.fail 1) 346 | 347 | _ -> 348 | Script.printLine "Please enter only one name!" 349 | |> Script.andThen (Script.fail 2) 350 | 351 | -} 352 | fail : x -> Script x a 353 | fail = 354 | Internal.Fail 355 | 356 | 357 | {-| Print a line to the console. A newline will be added to the given string if 358 | it does not already have one, so all of the following are equivalent: 359 | 360 | Script.do 361 | [ Script.printLine "Hello" 362 | , Script.printLine "World" 363 | ] 364 | 365 | Script.do 366 | [ Script.printLine "Hello\n" 367 | , Script.printLine "World\n" 368 | ] 369 | 370 | Script.printLine "Hello\nWorld" 371 | 372 | Script.printLine "Hello\nWorld\n" 373 | 374 | -} 375 | printLine : String -> Script x () 376 | printLine string = 377 | let 378 | stringWithNewline = 379 | if String.endsWith "\n" string then 380 | string 381 | 382 | else 383 | string ++ "\n" 384 | in 385 | Internal.Invoke "writeStdout" (Encode.string stringWithNewline) <| 386 | \flags -> Decode.null (succeed ()) 387 | 388 | 389 | {-| Sleep (pause) for the given number of milliseconds. 390 | 391 | -- Sleep for 5 seconds 392 | Script.sleep (Duration.milliseconds 5000) 393 | 394 | -} 395 | sleep : Duration -> Script x () 396 | sleep duration = 397 | Internal.perform (Process.sleep (Duration.inMilliseconds duration)) 398 | 399 | 400 | {-| Get the current time. 401 | 402 | Script.getCurrentTime 403 | |> Script.thenWith 404 | (\currentTime -> 405 | Script.printLine <| 406 | "Number of hours since January 1, 1970: " 407 | ++ toString (Time.inHours currentTime) 408 | ) 409 | 410 | -} 411 | getCurrentTime : Script x Time.Posix 412 | getCurrentTime = 413 | Internal.perform Time.now 414 | 415 | 416 | perform : Script Never a -> Script x a 417 | perform script = 418 | script |> onError never 419 | 420 | 421 | {-| Map the value produced by a script; to get a list of lines from a file 422 | instead of the entire contents as a single string, you might do 423 | 424 | getLines : Script File.Error (List String) 425 | getLines = 426 | File.read inputFile |> Script.map String.lines 427 | 428 | -} 429 | map : (a -> b) -> Script x a -> Script x b 430 | map = 431 | Internal.map 432 | 433 | 434 | {-| Map over the values produced by two scripts. The two scripts will be run in 435 | sequence. 436 | -} 437 | map2 : 438 | (a -> b -> c) 439 | -> Script x a 440 | -> Script x b 441 | -> Script x c 442 | map2 function scriptA scriptB = 443 | scriptA |> thenWith (\valueA -> map (function valueA) scriptB) 444 | 445 | 446 | {-| Map over the values produced by three scripts. The three scripts will be run 447 | in sequence. 448 | -} 449 | map3 : 450 | (a -> b -> c -> d) 451 | -> Script x a 452 | -> Script x b 453 | -> Script x c 454 | -> Script x d 455 | map3 function scriptA scriptB scriptC = 456 | scriptA |> thenWith (\valueA -> map2 (function valueA) scriptB scriptC) 457 | 458 | 459 | {-| Map over the values produced by four scripts. The four scripts will be run 460 | in sequence. 461 | -} 462 | map4 : 463 | (a -> b -> c -> d -> e) 464 | -> Script x a 465 | -> Script x b 466 | -> Script x c 467 | -> Script x d 468 | -> Script x e 469 | map4 function scriptA scriptB scriptC scriptD = 470 | scriptA |> thenWith (\valueA -> map3 (function valueA) scriptB scriptC scriptD) 471 | 472 | 473 | {-| Explicitly ignore the value produced by a script. This is sometimes useful 474 | when using a function like `Script.do` that expects all of its arguments to have 475 | the type `Script x ()` (a script that produces no meaningful output): 476 | 477 | Script.do 478 | [ Script.printLine "Reading file..." 479 | , Script.readFile inputFile |> Script.ignoreResult 480 | , Script.printLine "Read file!" 481 | ] 482 | 483 | (Why would you want to read a file without doing anything with the output, 484 | though?) 485 | 486 | -} 487 | ignoreResult : Script x a -> Script x () 488 | ignoreResult = 489 | map (always ()) 490 | 491 | 492 | {-| Run a list of scripts in sequence. `Script.do` expects each given script to 493 | have a return type of `()` (no meaningful output), and so itself has a return 494 | type of `()`. 495 | 496 | Script.do 497 | [ Script.printLine "Reading a file..." 498 | , File.read inputFile 499 | |> Script.map String.lines 500 | |> Script.thenWith 501 | (\lines -> 502 | Script.printLine <| 503 | toString (List.length lines) 504 | ++ " lines" 505 | ) 506 | ] 507 | 508 | If you need to run a list of scripts but collect their return values, use 509 | `Script.sequence` instead. 510 | 511 | -} 512 | do : List (Script x ()) -> Script x () 513 | do scripts = 514 | case scripts of 515 | [] -> 516 | succeed () 517 | 518 | first :: rest -> 519 | first |> andThen (do rest) 520 | 521 | 522 | {-| For every value in a given list, call the given function and run the 523 | script that it creates. From `examples/Each.elm`: 524 | 525 | script : 526 | List String 527 | -> Script.WorkingDirectory 528 | -> Script.Host 529 | -> Script.UserPrivileges 530 | -> Script Int () 531 | script arguments host = 532 | arguments 533 | |> Script.each 534 | (\argument -> 535 | Script.printLine <| 536 | case String.toFloat argument of 537 | Ok value -> 538 | let 539 | squared = 540 | value * value 541 | in 542 | argument ++ " squared is " ++ toString squared 543 | 544 | Err _ -> 545 | argument ++ " is not a number!" 546 | ) 547 | 548 | Often works well with `Script.thenWith` if the previous script produces a list 549 | of values: 550 | 551 | Directory.listFiles directory 552 | |> Script.thenWith 553 | (Script.each 554 | (\file -> 555 | Script.printLine (File.name file) 556 | ) 557 | ) 558 | 559 | -} 560 | each : (a -> Script x ()) -> List a -> Script x () 561 | each function values = 562 | do (List.map function values) 563 | 564 | 565 | {-| Run a list of scripts in sequence and collect their results into a list. 566 | -} 567 | sequence : List (Script x a) -> Script x (List a) 568 | sequence scripts = 569 | case scripts of 570 | [] -> 571 | succeed [] 572 | 573 | first :: rest -> 574 | first |> thenWith (\value -> map ((::) value) (sequence rest)) 575 | 576 | 577 | {-| For every value in a given list, call the given function and run the script 578 | that it creates, then collect the results of all those scripts into a list. 579 | 580 | readAll : Script File.Error (List String) 581 | readAll = 582 | Script.collect File.read 583 | [ file1, file2, file3 ] 584 | 585 | -} 586 | collect : (a -> Script x b) -> List a -> Script x (List b) 587 | collect function values = 588 | sequence (List.map function values) 589 | 590 | 591 | {-| Take the output from one script and feed it into a second script: 592 | 593 | File.read inputFile 594 | |> Script.thenWith 595 | (\fileContents -> 596 | Script.printLine contents 597 | ) 598 | 599 | This is the most fundamental way to chain scripts together! Pretty much all 600 | other combinators in this module (`each`, `do`, `map` etc.) can be implemented 601 | in terms of `thenWith`, so if there's some custom behavior you need that is not 602 | covered by one of those functions you should be able to implement it using 603 | `thenWith`. 604 | 605 | -} 606 | thenWith : (a -> Script x b) -> Script x a -> Script x b 607 | thenWith = 608 | Internal.thenWith 609 | 610 | 611 | andThen : Script x a -> Script x () -> Script x a 612 | andThen secondScript firstScript = 613 | firstScript |> thenWith (\() -> secondScript) 614 | 615 | 616 | {-| Sometimes you can run into problems chaining scripts together using 617 | `thenWith` if you want to do 'auxiliary' things like print to the console, log 618 | to a file etc. For example, the following will **not** work: 619 | 620 | File.read inputFile 621 | |> Script.thenWith 622 | (\contents -> Script.print "OK, read file") 623 | |> Script.thenWith 624 | (\contents -> ...) 625 | 626 | `File.read inputFile` succeeds with a `String` which is passed into the first 627 | `thenWith`, but since `Script.print` succeeds with just the unit value `()` that 628 | is what gets passed into the second `thenWith`! 629 | 630 | You can use `aside` for this purpose, which lets you run a script on some 631 | produced value but then 'pass it through' to the next script: 632 | 633 | File.read inputFile 634 | |> Script.aside 635 | (\contents -> Script.print "OK, read file") 636 | |> Script.thenWith 637 | (\contents -> 638 | ... 639 | ) 640 | 641 | This is safe because `aside` enforces that the first script produces `()` - that 642 | is, it doesn't actually produce any useful output that you might want anway. 643 | 644 | -} 645 | aside : (a -> Script x ()) -> Script x a -> Script x a 646 | aside doSomething script = 647 | -- Run the given script... 648 | script 649 | |> thenWith 650 | (\value -> 651 | -- ...as an 'aside' do something with the generated value 652 | -- (logging, printing to console etc)... 653 | doSomething value 654 | -- ...and finally, succeed with the original generated value 655 | -- (not the unit return value of the 'aside' script) 656 | |> andThen (succeed value) 657 | ) 658 | 659 | 660 | mapError : (x -> y) -> Script x a -> Script y a 661 | mapError = 662 | Internal.mapError 663 | 664 | 665 | attempt : Script x a -> Script y (Result x a) 666 | attempt = 667 | map Ok >> onError (Err >> succeed) 668 | 669 | 670 | onError : (x -> Script y a) -> Script x a -> Script y a 671 | onError = 672 | Internal.onError 673 | 674 | 675 | ignoreError : Script x () -> Script y () 676 | ignoreError = 677 | onError (always (succeed ())) 678 | 679 | 680 | finally : Script Never () -> Script x a -> Script x a 681 | finally cleanup script = 682 | script 683 | |> thenWith (\result -> perform cleanup |> andThen (succeed result)) 684 | |> onError (\error -> perform cleanup |> andThen (fail error)) 685 | 686 | 687 | executeWith : 688 | UserPrivileges 689 | -> { workingDirectory : Directory Writable, command : String, arguments : List String } 690 | -> Internal.Script String String 691 | executeWith userPrivileges arguments = 692 | tryToExecuteWith userPrivileges arguments 693 | |> mapError 694 | (\error -> 695 | case error of 696 | ExecutableNotFound -> 697 | "Executable '" ++ arguments.command ++ "' not found" 698 | 699 | SubprocessFailed message -> 700 | message 701 | 702 | SubprocessWasTerminated -> 703 | "Subprocess '" ++ arguments.command ++ "' terminated" 704 | 705 | SubprocessExitedWithError code -> 706 | "Subprocess '" 707 | ++ arguments.command 708 | ++ "' exited with code " 709 | ++ String.fromInt code 710 | ) 711 | 712 | 713 | tryToExecuteWith : 714 | UserPrivileges 715 | -> { workingDirectory : Directory Writable, command : String, arguments : List String } 716 | -> Internal.Script SubprocessError String 717 | tryToExecuteWith userPrivileges { workingDirectory, command, arguments } = 718 | let 719 | (Internal.Directory workingDirectoryPath) = 720 | workingDirectory 721 | in 722 | Internal.Invoke "execute" 723 | (Encode.object 724 | [ ( "command", Encode.string command ) 725 | , ( "arguments", Encode.list Encode.string arguments ) 726 | , ( "workingDirectory", Path.encode workingDirectoryPath ) 727 | ] 728 | ) 729 | (\flags -> 730 | Decode.oneOf 731 | [ Decode.string |> Decode.map Internal.Succeed 732 | , Decode.field "error" Decode.string 733 | |> Decode.andThen 734 | (\error -> 735 | case error of 736 | "notfound" -> 737 | Decode.succeed ExecutableNotFound 738 | 739 | "failed" -> 740 | Decode.field "message" Decode.string 741 | |> Decode.map SubprocessFailed 742 | 743 | "terminated" -> 744 | Decode.succeed SubprocessWasTerminated 745 | 746 | "exited" -> 747 | Decode.field "code" Decode.int 748 | |> Decode.map SubprocessExitedWithError 749 | 750 | _ -> 751 | Decode.fail "Unexpected execution error type" 752 | ) 753 | |> Decode.map Internal.Fail 754 | ] 755 | ) 756 | -------------------------------------------------------------------------------- /src/Script/Directory.elm: -------------------------------------------------------------------------------- 1 | module Script.Directory exposing 2 | ( Directory 3 | , Existence(..) 4 | , ReadOnly 5 | , Writable 6 | , asReadOnly 7 | , checkExistence 8 | , create 9 | , createTemporary 10 | , ensureExists 11 | , in_ 12 | , listFiles 13 | , listSubdirs 14 | , name 15 | , obliterate 16 | , path 17 | , readOnly 18 | , remove 19 | , writable 20 | ) 21 | 22 | import Json.Decode as Decode exposing (Decoder) 23 | import Json.Encode as Encode 24 | import Script.File as File 25 | import Script.FileInfo as FileInfo 26 | import Script.Internal as Internal exposing (File(..), Flags, Script(..), UserPrivileges(..)) 27 | import Script.Path as Path exposing (Path) 28 | import Script.Permissions as Permissions 29 | import Script.Platform as Platform 30 | 31 | 32 | type alias Directory permissions = 33 | Internal.Directory permissions 34 | 35 | 36 | type alias ReadOnly = 37 | Permissions.ReadOnly 38 | 39 | 40 | type alias Writable = 41 | Permissions.Writable 42 | 43 | 44 | type Existence 45 | = Exists 46 | | DoesNotExist 47 | | IsNotADirectory 48 | 49 | 50 | readOnly : UserPrivileges -> String -> Directory ReadOnly 51 | readOnly (UserPrivileges workingDirectoryPath) pathString = 52 | Internal.Directory (Path.resolve workingDirectoryPath pathString) 53 | 54 | 55 | writable : UserPrivileges -> String -> Directory Writable 56 | writable (UserPrivileges workingDirectoryPath) pathString = 57 | Internal.Directory (Path.resolve workingDirectoryPath pathString) 58 | 59 | 60 | errorDecoder : Decoder String 61 | errorDecoder = 62 | Decode.field "message" Decode.string 63 | 64 | 65 | name : Directory permissions -> String 66 | name (Internal.Directory directoryPath) = 67 | Path.name directoryPath 68 | 69 | 70 | asReadOnly : Directory Writable -> Directory ReadOnly 71 | asReadOnly (Internal.Directory directoryPath) = 72 | Internal.Directory directoryPath 73 | 74 | 75 | in_ : Directory permissions -> String -> Directory permissions 76 | in_ (Internal.Directory directoryPath) relativePath = 77 | Internal.Directory (Path.append relativePath directoryPath) 78 | 79 | 80 | listFiles : Directory permissions -> Script String (List (File permissions)) 81 | listFiles ((Internal.Directory directoryPath) as directory) = 82 | Invoke "listFiles" (Path.encode directoryPath) <| 83 | \flags -> 84 | Decode.oneOf 85 | [ Decode.list Decode.string 86 | |> Decode.map (List.map (File.in_ directory)) 87 | |> Decode.map Succeed 88 | , errorDecoder |> Decode.map Fail 89 | ] 90 | 91 | 92 | listSubdirs : Directory permissions -> Script String (List (Directory permissions)) 93 | listSubdirs ((Internal.Directory directoryPath) as directory) = 94 | Invoke "listSubdirectories" (Path.encode directoryPath) <| 95 | \flags -> 96 | Decode.oneOf 97 | [ Decode.list Decode.string 98 | |> Decode.map 99 | (\names -> 100 | Succeed (List.map (in_ directory) names) 101 | ) 102 | , errorDecoder |> Decode.map Fail 103 | ] 104 | 105 | 106 | decodeNullResult : Flags -> Decoder (Script String ()) 107 | decodeNullResult flags = 108 | Decode.oneOf 109 | [ Decode.null (Succeed ()) 110 | , errorDecoder |> Decode.map Fail 111 | ] 112 | 113 | 114 | create : Directory Writable -> Script String () 115 | create = 116 | createDirectory { recursive = False } 117 | 118 | 119 | ensureExists : Directory Writable -> Script String () 120 | ensureExists = 121 | createDirectory { recursive = True } 122 | 123 | 124 | createDirectory : { recursive : Bool } -> Directory Writable -> Script String () 125 | createDirectory { recursive } (Internal.Directory directoryPath) = 126 | Invoke "createDirectory" 127 | (Encode.object 128 | [ ( "path", Path.encode directoryPath ) 129 | , ( "recursive", Encode.bool recursive ) 130 | ] 131 | ) 132 | decodeNullResult 133 | 134 | 135 | createTemporary : Script String (Directory Writable) 136 | createTemporary = 137 | Invoke "createTemporaryDirectory" Encode.null <| 138 | \flags -> 139 | Decode.oneOf 140 | [ Decode.string 141 | |> Decode.map 142 | (\pathString -> 143 | Succeed <| 144 | Internal.Directory (Path.absolute flags.platform pathString) 145 | ) 146 | , errorDecoder |> Decode.map Fail 147 | ] 148 | 149 | 150 | checkExistence : Directory permissions -> Script String Existence 151 | checkExistence (Internal.Directory directoryPath) = 152 | FileInfo.get directoryPath 153 | |> Internal.map 154 | (\fileInfo -> 155 | case fileInfo of 156 | FileInfo.Directory -> 157 | Exists 158 | 159 | FileInfo.Nonexistent -> 160 | DoesNotExist 161 | 162 | FileInfo.File -> 163 | IsNotADirectory 164 | 165 | FileInfo.Other -> 166 | IsNotADirectory 167 | ) 168 | 169 | 170 | remove : Directory Writable -> Script String () 171 | remove = 172 | removeDirectory { recursive = False } 173 | 174 | 175 | obliterate : Directory Writable -> Script String () 176 | obliterate = 177 | removeDirectory { recursive = True } 178 | 179 | 180 | removeDirectory : { recursive : Bool } -> Directory Writable -> Script String () 181 | removeDirectory { recursive } (Internal.Directory directoryPath) = 182 | Invoke "removeDirectory" 183 | (Encode.object 184 | [ ( "path", Path.encode directoryPath ) 185 | , ( "recursive", Encode.bool recursive ) 186 | ] 187 | ) 188 | decodeNullResult 189 | 190 | 191 | path : Directory permissions -> String 192 | path (Internal.Directory directoryPath) = 193 | Path.toString directoryPath 194 | -------------------------------------------------------------------------------- /src/Script/Environment.elm: -------------------------------------------------------------------------------- 1 | module Script.Environment exposing (Environment, get) 2 | 3 | import Dict exposing (Dict) 4 | import Script.Internal as Internal 5 | import Script.Platform as Platform exposing (Platform(..)) 6 | 7 | 8 | type alias Environment = 9 | Internal.Environment 10 | 11 | 12 | get : String -> Environment -> Maybe String 13 | get name (Internal.Environment platform dict) = 14 | case platform of 15 | Windows -> 16 | Dict.get (String.toUpper name) dict 17 | 18 | Posix _ -> 19 | Dict.get name dict 20 | -------------------------------------------------------------------------------- /src/Script/File.elm: -------------------------------------------------------------------------------- 1 | module Script.File exposing 2 | ( Existence(..) 3 | , File 4 | , ReadOnly 5 | , Writable 6 | , asReadOnly 7 | , checkExistence 8 | , copy 9 | , copyInto 10 | , delete 11 | , in_ 12 | , move 13 | , moveInto 14 | , name 15 | , path 16 | , read 17 | , readOnly 18 | , writable 19 | , write 20 | , writeTo 21 | ) 22 | 23 | import Json.Decode as Decode exposing (Decoder) 24 | import Json.Encode as Encode 25 | import Script.FileInfo as FileInfo 26 | import Script.Internal as Internal exposing (Directory, Flags, Script(..), UserPrivileges(..)) 27 | import Script.Path as Path 28 | import Script.Permissions as Permissions 29 | 30 | 31 | type alias File permissions = 32 | Internal.File permissions 33 | 34 | 35 | type alias ReadOnly = 36 | Permissions.ReadOnly 37 | 38 | 39 | type alias Writable = 40 | Permissions.Writable 41 | 42 | 43 | type Existence 44 | = Exists 45 | | DoesNotExist 46 | | IsNotAFile 47 | 48 | 49 | in_ : Directory permissions -> String -> File permissions 50 | in_ (Internal.Directory directoryPath) relativePath = 51 | Internal.File (Path.append relativePath directoryPath) 52 | 53 | 54 | readOnly : UserPrivileges -> String -> File ReadOnly 55 | readOnly (UserPrivileges workingDirectoryPath) pathString = 56 | Internal.File (Path.resolve workingDirectoryPath pathString) 57 | 58 | 59 | writable : UserPrivileges -> String -> File Writable 60 | writable (UserPrivileges workingDirectoryPath) pathString = 61 | Internal.File (Path.resolve workingDirectoryPath pathString) 62 | 63 | 64 | errorDecoder : Decoder String 65 | errorDecoder = 66 | Decode.field "message" Decode.string 67 | 68 | 69 | name : File permissions -> String 70 | name (Internal.File filePath) = 71 | Path.name filePath 72 | 73 | 74 | asReadOnly : File Writable -> File ReadOnly 75 | asReadOnly (Internal.File filePath) = 76 | Internal.File filePath 77 | 78 | 79 | read : File permissions -> Script String String 80 | read (Internal.File filePath) = 81 | Invoke "readFile" (Path.encode filePath) <| 82 | \flags -> 83 | Decode.oneOf 84 | [ Decode.string |> Decode.map Succeed 85 | , errorDecoder |> Decode.map Fail 86 | ] 87 | 88 | 89 | decodeNullResult : Flags -> Decoder (Script String ()) 90 | decodeNullResult flags = 91 | Decode.oneOf 92 | [ Decode.null (Succeed ()) 93 | , errorDecoder |> Decode.map Fail 94 | ] 95 | 96 | 97 | write : String -> File Writable -> Script String () 98 | write contents (Internal.File filePath) = 99 | Invoke "writeFile" 100 | (Encode.object 101 | [ ( "contents", Encode.string contents ) 102 | , ( "path", Path.encode filePath ) 103 | ] 104 | ) 105 | decodeNullResult 106 | 107 | 108 | writeTo : File Writable -> String -> Script String () 109 | writeTo file contents = 110 | write contents file 111 | 112 | 113 | copy : File permissions -> File Writable -> Script String () 114 | copy (Internal.File sourcePath) (Internal.File destinationPath) = 115 | Invoke "copyFile" 116 | (Encode.object 117 | [ ( "sourcePath", Path.encode sourcePath ) 118 | , ( "destinationPath", Path.encode destinationPath ) 119 | ] 120 | ) 121 | decodeNullResult 122 | 123 | 124 | move : File Writable -> File Writable -> Script String () 125 | move (Internal.File sourcePath) (Internal.File destinationPath) = 126 | Invoke "moveFile" 127 | (Encode.object 128 | [ ( "sourcePath", Path.encode sourcePath ) 129 | , ( "destinationPath", Path.encode destinationPath ) 130 | ] 131 | ) 132 | decodeNullResult 133 | 134 | 135 | delete : File Writable -> Script String () 136 | delete (Internal.File filePath) = 137 | Invoke "deleteFile" (Path.encode filePath) decodeNullResult 138 | 139 | 140 | copyInto : Directory Writable -> File permissions -> Script String (File Writable) 141 | copyInto directory file = 142 | let 143 | destination = 144 | in_ directory (name file) 145 | in 146 | copy file destination |> Internal.thenWith (\() -> Internal.Succeed destination) 147 | 148 | 149 | moveInto : Directory Writable -> File Writable -> Script String (File Writable) 150 | moveInto directory file = 151 | let 152 | destination = 153 | in_ directory (name file) 154 | in 155 | move file destination |> Internal.thenWith (\() -> Internal.Succeed destination) 156 | 157 | 158 | checkExistence : File permissions -> Script String Existence 159 | checkExistence (Internal.File filePath) = 160 | FileInfo.get filePath 161 | |> Internal.map 162 | (\fileInfo -> 163 | case fileInfo of 164 | FileInfo.File -> 165 | Exists 166 | 167 | FileInfo.Nonexistent -> 168 | DoesNotExist 169 | 170 | FileInfo.Directory -> 171 | IsNotAFile 172 | 173 | FileInfo.Other -> 174 | IsNotAFile 175 | ) 176 | 177 | 178 | path : File permissions -> String 179 | path (Internal.File filePath) = 180 | Path.toString filePath 181 | -------------------------------------------------------------------------------- /src/Script/FileInfo.elm: -------------------------------------------------------------------------------- 1 | module Script.FileInfo exposing (FileInfo(..), get) 2 | 3 | import Json.Decode as Decode exposing (Decoder) 4 | import Script.Internal as Internal exposing (Script(..)) 5 | import Script.Path as Path exposing (Path) 6 | 7 | 8 | type FileInfo 9 | = Nonexistent 10 | | File 11 | | Directory 12 | | Other 13 | 14 | 15 | decodeFileInfo : Decoder FileInfo 16 | decodeFileInfo = 17 | Decode.string 18 | |> Decode.andThen 19 | (\string -> 20 | case string of 21 | "nonexistent" -> 22 | Decode.succeed Nonexistent 23 | 24 | "file" -> 25 | Decode.succeed File 26 | 27 | "directory" -> 28 | Decode.succeed Directory 29 | 30 | "other" -> 31 | Decode.succeed Other 32 | 33 | _ -> 34 | Decode.fail ("Unrecognized stat value '" ++ string ++ "'") 35 | ) 36 | 37 | 38 | decodeErrorMessage : Decoder String 39 | decodeErrorMessage = 40 | Decode.field "message" Decode.string 41 | 42 | 43 | get : Path -> Script String FileInfo 44 | get path = 45 | Invoke "stat" 46 | (Path.encode path) 47 | (\flags -> 48 | Decode.oneOf 49 | [ decodeFileInfo |> Decode.map Succeed 50 | , decodeErrorMessage |> Decode.map Fail 51 | ] 52 | ) 53 | -------------------------------------------------------------------------------- /src/Script/Http.elm: -------------------------------------------------------------------------------- 1 | module Script.Http exposing 2 | ( NetworkConnection 3 | , get, post, request 4 | , Body, emptyBody, stringBody, jsonBody 5 | , Expect, expectString, expectJson, expectWhatever 6 | , Header, header 7 | , Error(..) 8 | ) 9 | 10 | {-| 11 | 12 | @docs NetworkConnection 13 | 14 | @docs get, post, request 15 | 16 | @docs Body, emptyBody, stringBody, jsonBody 17 | 18 | @docs Expect, expectString, expectJson, expectWhatever 19 | 20 | @docs Header, header 21 | 22 | @docs Error 23 | 24 | -} 25 | 26 | import Duration exposing (Duration) 27 | import Json.Decode as Decode exposing (Decoder) 28 | import Json.Encode as Encode exposing (Value) 29 | import Script.Internal as Internal exposing (Script(..)) 30 | 31 | 32 | type alias NetworkConnection = 33 | Internal.NetworkConnection 34 | 35 | 36 | get : NetworkConnection -> { url : String, expect : Expect a } -> Script Error a 37 | get networkConnection { url, expect } = 38 | request networkConnection 39 | { method = "GET" 40 | , headers = [] 41 | , url = url 42 | , body = emptyBody 43 | , timeout = Nothing 44 | , expect = expect 45 | } 46 | 47 | 48 | post : NetworkConnection -> { url : String, body : Body, expect : Expect a } -> Script Error a 49 | post networkConnection { url, body, expect } = 50 | request networkConnection 51 | { method = "POST" 52 | , headers = [] 53 | , url = url 54 | , body = body 55 | , timeout = Nothing 56 | , expect = expect 57 | } 58 | 59 | 60 | request : 61 | NetworkConnection 62 | -> 63 | { method : String 64 | , headers : List Header 65 | , url : String 66 | , body : Body 67 | , timeout : Maybe Duration 68 | , expect : Expect a 69 | } 70 | -> Script Error a 71 | request networkConnection { method, headers, url, body, timeout, expect } = 72 | let 73 | allHeaders = 74 | case body of 75 | EmptyBody -> 76 | headers 77 | 78 | StringBody mimeType content -> 79 | Header "Content-Type" mimeType :: headers 80 | 81 | encodedBody = 82 | case body of 83 | EmptyBody -> 84 | Encode.null 85 | 86 | StringBody mimeType content -> 87 | Encode.string content 88 | 89 | encodedOptions = 90 | Encode.object 91 | [ ( "method", Encode.string method ) 92 | , ( "headers", Encode.object (List.map headerField allHeaders) ) 93 | , ( "body", encodedBody ) 94 | ] 95 | 96 | encodedTimeout = 97 | case timeout of 98 | Just duration -> 99 | Encode.float (Duration.inMilliseconds duration) 100 | 101 | Nothing -> 102 | Encode.null 103 | 104 | (Expect callback) = 105 | expect 106 | in 107 | Invoke "http" 108 | (Encode.object 109 | [ ( "url", Encode.string url ) 110 | , ( "options", encodedOptions ) 111 | , ( "timeout", encodedTimeout ) 112 | ] 113 | ) 114 | (\flags -> 115 | Decode.oneOf 116 | [ Decode.map2 117 | (\status responseBody -> 118 | if status >= 200 && status < 300 then 119 | case callback responseBody of 120 | Ok value -> 121 | Succeed value 122 | 123 | Err errorMessage -> 124 | Fail (BadBody errorMessage) 125 | 126 | else 127 | Fail (BadStatus status) 128 | ) 129 | (Decode.field "status" Decode.int) 130 | (Decode.field "body" Decode.string) 131 | , Decode.field "error" Decode.string 132 | |> Decode.andThen 133 | (\errorType -> 134 | case errorType of 135 | "NetworkError" -> 136 | Decode.succeed (Fail NetworkError) 137 | 138 | "Timeout" -> 139 | Decode.succeed (Fail Timeout) 140 | 141 | _ -> 142 | Decode.fail 143 | ("Unrecognized HTTP error type '" ++ errorType ++ "'") 144 | ) 145 | ] 146 | ) 147 | 148 | 149 | headerField : Header -> ( String, Value ) 150 | headerField (Header name value) = 151 | ( name, Encode.string value ) 152 | 153 | 154 | type Body 155 | = EmptyBody 156 | | StringBody String String 157 | 158 | 159 | emptyBody : Body 160 | emptyBody = 161 | EmptyBody 162 | 163 | 164 | stringBody : String -> String -> Body 165 | stringBody = 166 | StringBody 167 | 168 | 169 | jsonBody : Value -> Body 170 | jsonBody value = 171 | StringBody "application/json" (Encode.encode 0 value) 172 | 173 | 174 | type Expect a 175 | = Expect (String -> Result String a) 176 | 177 | 178 | expectString : Expect String 179 | expectString = 180 | Expect Ok 181 | 182 | 183 | expectJson : Decoder a -> Expect a 184 | expectJson decoder = 185 | Expect (Decode.decodeString decoder >> Result.mapError Decode.errorToString) 186 | 187 | 188 | expectWhatever : Expect () 189 | expectWhatever = 190 | Expect (always (Ok ())) 191 | 192 | 193 | type Header 194 | = Header String String 195 | 196 | 197 | header : String -> String -> Header 198 | header = 199 | Header 200 | 201 | 202 | type Error 203 | = Timeout 204 | | NetworkError 205 | | BadStatus Int 206 | | BadBody String 207 | -------------------------------------------------------------------------------- /src/Script/Internal.elm: -------------------------------------------------------------------------------- 1 | module Script.Internal exposing 2 | ( Directory(..) 3 | , Environment(..) 4 | , File(..) 5 | , Flags 6 | , NetworkConnection(..) 7 | , Script(..) 8 | , UserPrivileges(..) 9 | , map 10 | , mapError 11 | , onError 12 | , perform 13 | , thenWith 14 | ) 15 | 16 | import Dict exposing (Dict) 17 | import Json.Decode as Decode exposing (Decoder, Value) 18 | import Platform.Cmd exposing (Cmd) 19 | import Script.Path exposing (Path) 20 | import Script.Platform exposing (Platform) 21 | import Task exposing (Task) 22 | 23 | 24 | type alias Flags = 25 | { arguments : List String 26 | , platform : Platform 27 | , environment : Environment 28 | , workingDirectoryPath : Path 29 | } 30 | 31 | 32 | type Script x a 33 | = Succeed a 34 | | Fail x 35 | | Perform (Task Never (Script x a)) 36 | | Invoke String Value (Flags -> Decoder (Script x a)) 37 | | Do (Cmd (Script x a)) 38 | 39 | 40 | type Directory permissions 41 | = Directory Path 42 | 43 | 44 | type File permissions 45 | = File Path 46 | 47 | 48 | type Environment 49 | = Environment Platform (Dict String String) 50 | 51 | 52 | type NetworkConnection 53 | = NetworkConnection 54 | 55 | 56 | type UserPrivileges 57 | = UserPrivileges Path 58 | 59 | 60 | thenWith : (a -> Script x b) -> Script x a -> Script x b 61 | thenWith function script = 62 | case script of 63 | Succeed value -> 64 | function value 65 | 66 | Fail error -> 67 | Fail error 68 | 69 | Perform task -> 70 | Perform (Task.map (thenWith function) task) 71 | 72 | Invoke name value decoder -> 73 | Invoke name value <| 74 | \flags -> Decode.map (thenWith function) (decoder flags) 75 | 76 | Do command -> 77 | Do (Cmd.map (thenWith function) command) 78 | 79 | 80 | map : (a -> b) -> Script x a -> Script x b 81 | map function script = 82 | script |> thenWith (\value -> Succeed (function value)) 83 | 84 | 85 | onError : (x -> Script y a) -> Script x a -> Script y a 86 | onError recover script = 87 | case script of 88 | Succeed value -> 89 | Succeed value 90 | 91 | Fail error -> 92 | recover error 93 | 94 | Perform task -> 95 | Perform (Task.map (onError recover) task) 96 | 97 | Invoke name value decoder -> 98 | Invoke name value <| 99 | \flags -> Decode.map (onError recover) (decoder flags) 100 | 101 | Do command -> 102 | Do (Cmd.map (onError recover) command) 103 | 104 | 105 | mapError : (x -> y) -> Script x a -> Script y a 106 | mapError function = 107 | onError (function >> Fail) 108 | 109 | 110 | perform : Task x a -> Script x a 111 | perform task = 112 | Perform (Task.map Succeed task |> Task.onError (Fail >> Task.succeed)) 113 | -------------------------------------------------------------------------------- /src/Script/Path.elm: -------------------------------------------------------------------------------- 1 | module Script.Path exposing 2 | ( Path(..) 3 | , absolute 4 | , append 5 | , encode 6 | , join 7 | , name 8 | , resolve 9 | , toString 10 | ) 11 | 12 | import Json.Decode as Decode exposing (Decoder) 13 | import Json.Encode as Encode exposing (Value) 14 | import Regex exposing (Regex) 15 | import Script.Platform as Platform exposing (Platform(..)) 16 | 17 | 18 | type Path 19 | = Path Platform (List String) 20 | 21 | 22 | nameRegex : Regex 23 | nameRegex = 24 | Regex.fromString "([^\\\\/]+)[\\\\/]*$" 25 | |> Maybe.withDefault Regex.never 26 | 27 | 28 | name : Path -> String 29 | name (Path platform components) = 30 | case Regex.find nameRegex (String.join "/" components) of 31 | [ { match, submatches } ] -> 32 | case submatches of 33 | [ Just name_ ] -> 34 | name_ 35 | 36 | _ -> 37 | "" 38 | 39 | _ -> 40 | "" 41 | 42 | 43 | encode : Path -> Value 44 | encode (Path platform components) = 45 | Encode.list Encode.string components 46 | 47 | 48 | append : String -> Path -> Path 49 | append component (Path platform components) = 50 | Path platform (components ++ [ component ]) 51 | 52 | 53 | absolute : Platform -> String -> Path 54 | absolute platform string = 55 | Path platform [ string ] 56 | 57 | 58 | resolve : Path -> String -> Path 59 | resolve (Path platform parentComponents) pathString = 60 | if isAbsolute platform pathString then 61 | Path platform [ pathString ] 62 | 63 | else 64 | Path platform [ join platform (parentComponents ++ [ pathString ]) ] 65 | 66 | 67 | isAbsolute : Platform -> String -> Bool 68 | isAbsolute platform pathString = 69 | case platform of 70 | Posix _ -> 71 | String.startsWith "/" pathString 72 | 73 | Windows -> 74 | String.startsWith "\\\\" pathString || startsAtWindowsDriveRoot pathString 75 | 76 | 77 | startsAtWindowsDriveRoot : String -> Bool 78 | startsAtWindowsDriveRoot pathString = 79 | case String.uncons pathString of 80 | Just ( firstCharacter, rest ) -> 81 | Char.isAlpha firstCharacter 82 | && (String.startsWith ":/" rest || String.startsWith ":\\" rest) 83 | 84 | Nothing -> 85 | False 86 | 87 | 88 | join : Platform -> List String -> String 89 | join platform components = 90 | case components of 91 | first :: rest -> 92 | let 93 | joinedComponents = 94 | String.join (Platform.pathSeparator platform) 95 | (List.concatMap pathChunks components) 96 | in 97 | if isAbsolute platform first then 98 | case platform of 99 | Posix _ -> 100 | "/" ++ joinedComponents 101 | 102 | Windows -> 103 | if String.startsWith "\\\\" first then 104 | "\\\\" ++ joinedComponents 105 | 106 | else 107 | joinedComponents 108 | 109 | else 110 | joinedComponents 111 | 112 | [] -> 113 | "" 114 | 115 | 116 | pathChunks : String -> List String 117 | pathChunks string = 118 | Regex.find pathChunk string |> List.map .match 119 | 120 | 121 | pathChunk : Regex 122 | pathChunk = 123 | Regex.fromString "[^\\\\/]+" |> Maybe.withDefault Regex.never 124 | 125 | 126 | toString : Path -> String 127 | toString (Path platform components) = 128 | join platform components 129 | -------------------------------------------------------------------------------- /src/Script/Permissions.elm: -------------------------------------------------------------------------------- 1 | module Script.Permissions exposing (ReadOnly, Writable) 2 | 3 | 4 | type Writable 5 | = Writable 6 | 7 | 8 | type ReadOnly 9 | = ReadOnly 10 | -------------------------------------------------------------------------------- /src/Script/Platform.elm: -------------------------------------------------------------------------------- 1 | module Script.Platform exposing 2 | ( Platform(..) 3 | , lineSeparator 4 | , pathSeparator 5 | ) 6 | 7 | import Json.Decode as Decode exposing (Decoder) 8 | 9 | 10 | type Platform 11 | = Posix String 12 | | Windows 13 | 14 | 15 | lineSeparator : Platform -> String 16 | lineSeparator platform = 17 | case platform of 18 | Posix _ -> 19 | "\n" 20 | 21 | Windows -> 22 | "\u{000D}\n" 23 | 24 | 25 | pathSeparator : Platform -> String 26 | pathSeparator platform = 27 | case platform of 28 | Posix _ -> 29 | "/" 30 | 31 | Windows -> 32 | "\\" 33 | --------------------------------------------------------------------------------