├── .gitattributes ├── .github └── workflows │ ├── docs.yaml │ └── main.yml ├── .gitignore ├── Dockerfile ├── docs ├── api │ └── index.html ├── examples │ └── index.html ├── index.html ├── index.js ├── install.md ├── readme.md └── style.css ├── examples ├── 01-hello-world.hell ├── 02-interaction.hell ├── 03-press-any-key.hell ├── 04-writing-files.hell ├── 05-lists.hell ├── 06-polymorphism.hell ├── 07-loops.hell ├── 08-tuples.hell ├── 09-processes.hell ├── 10-current-directory.hell ├── 11-env-vars.hell ├── 12-fib.hell ├── 13-concurrency.hell ├── 14-text.hell ├── 15-type-classes.hell ├── 16-if.hell ├── 17-reuse.hell ├── 18-monads.hell ├── 19-blog-generator.hell ├── 20-dollar.hell ├── 21-json.hell ├── 22-records.hell ├── 23-args.hell ├── 24-exitcode.hell ├── 25-sum-types.hell ├── 26-reference-other-types.hell ├── 27-discussion-64.hell ├── 28-trees.hell ├── 29-temp-files.hell ├── 30-process-handlers.hell ├── 31-open-file-handle.hell ├── 32-optparse.hell ├── 33-null-stream.hell ├── 34-field-puns.hell ├── 35-type-sigs.hell ├── 36-these.hell ├── 37-readshow.hell ├── 38-integer.hell ├── 39-day.hell └── 40-utctime.hell ├── flake.lock ├── flake.nix ├── hell.cabal ├── package.yaml ├── scripts ├── check-docs.hell ├── check-examples.hell ├── check.hell ├── gen-docs.hell ├── install-hell.hell ├── readme.md └── static-build.hell ├── src └── Hell.hs ├── stack.yaml └── stack.yaml.lock /.gitattributes: -------------------------------------------------------------------------------- 1 | *.hell linguist-language=Haskell 2 | -------------------------------------------------------------------------------- /.github/workflows/docs.yaml: -------------------------------------------------------------------------------- 1 | name: "Generate homepage" 2 | 3 | permissions: 4 | contents: read 5 | pages: write 6 | id-token: write 7 | 8 | on: 9 | push: 10 | branches: [ "main" ] 11 | 12 | # Allows you to run this workflow manually from the Actions tab 13 | workflow_dispatch: 14 | 15 | jobs: 16 | build: 17 | runs-on: ubuntu-latest 18 | steps: 19 | - uses: actions/checkout@v4 20 | - uses: actions/configure-pages@v4 21 | - uses: actions/upload-pages-artifact@v3 22 | with: 23 | path: "./docs" 24 | - uses: actions/deploy-pages@v4 25 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: "Build" 2 | 3 | permissions: 4 | contents: read 5 | pages: write 6 | id-token: write 7 | 8 | on: 9 | push: 10 | branches: [ "main" ] 11 | pull_request: 12 | branches: [ "main" ] 13 | 14 | # Allows you to run this workflow manually from the Actions tab 15 | workflow_dispatch: 16 | 17 | jobs: 18 | build: 19 | runs-on: ubuntu-latest 20 | container: 21 | image: "docker://ghcr.io/chrisdone/hell-build:2025-03-04@sha256:ca21e3be038cf1f10fa18306123b4d5f0e2009fe8938cea3afcef7f900bbea71" 22 | 23 | env: 24 | # For the ~/.stack root. 25 | HOME: /root/ 26 | STACK_ROOT: /root/.stack 27 | 28 | # This can be both of these, depending on whether it's a PR or 29 | # main. GitHub Actions is weird. 30 | # 31 | # * "GIT_BRANCH=refs/heads/main" 32 | # * "GIT_BRANCH=cd/2024-08-28-check-examples" 33 | # 34 | GIT_BRANCH: ${{ github.head_ref || github.ref }} 35 | 36 | steps: 37 | - run: | 38 | git clone https://github.com/chrisdone/hell /tmp/hell && \ 39 | cd /tmp/hell && \ 40 | git checkout $GIT_BRANCH 41 | - run: | 42 | cd /tmp/hell && stack build --fast 43 | - run: | 44 | cd /tmp/hell && stack exec hell scripts/check-examples.hell 45 | - run: | 46 | cd /tmp/hell && HOME=/home/chris/ stack exec hell scripts/check-docs.hell 47 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work 2 | result 3 | dist-newstyle 4 | hell-linux-x86-64bit 5 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | # docker run -d --name hell -it -v`pwd`:`pwd` -w`pwd` ghcr.io/chrisdone/hell-build:2025-03-04 sh 2 | 3 | FROM alpine:20250108 4 | 5 | RUN apk add stack ghc 6 | 7 | ADD stack.yaml /stack.yaml 8 | ADD package.yaml /package.yaml 9 | 10 | RUN stack setup && stack update 11 | 12 | ADD src/Hell.hs /src/Hell.hs 13 | 14 | RUN apk add musl-dev 15 | 16 | RUN stack build 17 | 18 | RUN apk add pandoc 19 | 20 | RUN apk add gmp-static 21 | 22 | RUN apk add git 23 | -------------------------------------------------------------------------------- /docs/api/index.html: -------------------------------------------------------------------------------- 1 | Hell's API

Hell's API

Version: 2025-06-09

Back to homepage

Types

Terms

$

<$>

<**>

<*>

<>

Alternative

Applicative

Argument

Async

Bool

ByteString

Concurrent

Day

Directory

Double

Either

Environment

Eq

Error

Exit

Flag

Function

Functor

IO

Int

Integer

Json

List

Map

Maybe

Monad

Option

Options

Ord

Process

Record

Set

Show

Temp

Text

These

TimeOfDay

Timeout

Tree

Tuple

UTCTime

Vector

-------------------------------------------------------------------------------- /docs/examples/index.html: -------------------------------------------------------------------------------- 1 |

Hell examples

Back to homepage

01-hello-world.hell

#!/usr/bin/env hell
 23 | main = Text.putStrLn "Hello, World!"
24 |

02-interaction.hell

main = do
 26 |   Text.putStrLn "Please enter your name and hit ENTER:"
 27 |   name <- Text.getLine
 28 |   Text.putStrLn "Thanks, your name is: "
 29 |   Text.putStrLn name
30 |

03-press-any-key.hell

main = do
 32 |   IO.hSetBuffering IO.stdin IO.NoBuffering
 33 |   IO.hSetBuffering IO.stdout IO.NoBuffering
 34 | 
 35 |   Text.putStr "Please press any key ... "
 36 |   chunk <- ByteString.hGet IO.stdin 1
 37 | 
 38 |   IO.hSetBuffering IO.stdout IO.LineBuffering
 39 |   Text.putStrLn "OK!"
40 |

04-writing-files.hell

main = do
 42 |   let fp = "foo.txt"
 43 |   Text.writeFile fp "Hello, "
 44 |   Text.appendFile fp "World!"
 45 |   text <- Text.readFile fp
 46 |   Text.putStrLn text
47 |

05-lists.hell

main = do
 49 |   let is = List.iterate' (Int.plus 1) 0
 50 |   let xs = ["Hello, ", "World!"]
 51 |   Text.putStrLn "OK!"
 52 |   Monad.forM_ (List.zip is xs) \(i,x) -> do
 53 |     IO.print i
 54 |     Text.putStrLn x
 55 |   IO.print $ List.foldl' Int.plus 0 $ List.take 10 is
56 |

06-polymorphism.hell

main = do
 58 |   let x = "Hello!"
 59 |   Text.putStrLn (Function.id x)
 60 |   let lengths = List.map Text.length ["foo", "mu"]
 61 |   IO.mapM_ (\i -> Text.putStrLn (Int.show i)) lengths
62 |

07-loops.hell

main = do
 64 |   IO.mapM_ Text.putStrLn ["Hello, ", "World!"]
 65 | 
 66 |   Function.fix (\(loop :: IO ()) -> do
 67 |     Text.putStrLn "Ahhhhh! More?"
 68 |     l <- Text.getLine
 69 |     loop)
70 |

08-tuples.hell

main = do
 72 |   let demo = \(x, y) -> y
 73 |   let foobar = (123, "foo")
 74 |   Text.putStrLn (demo foobar)
 75 | 
 76 |   let (foo,bar) = (123, "foo")
 77 |   Text.putStrLn bar
 78 | 
 79 |   let typeSigsWork :: () = ()
 80 | 
 81 |   Monad.return ()
82 |

09-processes.hell

main = do
 84 |   Text.putStrLn "OK"
 85 |   (code, out, err) <- ByteString.readProcess (Process.proc "ls" ["-al"])
 86 |   ByteString.hPutStr IO.stdout out
 87 |   ByteString.hPutStr IO.stdout err
 88 | 
 89 |   (out, err) <- Text.readProcess_ (Process.proc "df" ["-h", "/"])
 90 |   Text.hPutStr IO.stdout out
 91 |   Text.hPutStr IO.stdout err
 92 | 
 93 |   code <- Process.runProcess (Process.proc "false" [])
 94 | 
 95 |   Process.runProcess_ (Process.proc "echo" ["Hello, World!"])
 96 | 
 97 |   let config = Process.proc "false" []
 98 |   code <- Process.runProcess config
 99 | 
100 |   Process.runProcess $ Process.setWorkingDir "/etc/" $ Process.proc "pwd" []
101 | 
102 |   Text.putStrLn "Done."
103 |

10-current-directory.hell

main = do
105 |   dir <- Directory.getCurrentDirectory
106 |   Text.putStrLn dir
107 |   Directory.setCurrentDirectory dir
108 |

11-env-vars.hell

main = do
110 |   env <- Environment.getEnvironment
111 |   (out, err) <-
112 |     Text.readProcess_ (
113 |       Process.setEnv (List.cons ("HELL_DEMO", "wibble") env)
114 |         (Process.proc "env" [])
115 |     )
116 |   Text.hPutStr IO.stdout out
117 |

12-fib.hell

main = do
119 |   Text.putStrLn (Int.show (Main.fib 30))
120 | 
121 | fib =
122 |   Function.fix
123 |     (\fib i ->
124 |       Bool.bool
125 |         (Bool.bool
126 |            (Int.plus (fib (Int.subtract 1 i))
127 |                      (fib (Int.subtract 2 i)))
128 |            1
129 |            (Int.eq i 1))
130 |         0
131 |         (Int.eq i 0)
132 |     )
133 |

13-concurrency.hell

main = do
135 | 
136 |   -- Run two things concurrently and return both results
137 |   (left, right) <-
138 |     Async.concurrently
139 |        (Main.curl "https://worldtimeapi.org/api/timezone/Europe/London")
140 |        (Main.curl "https://worldtimeapi.org/api/timezone/Europe/Rome")
141 |   Text.putStrLn left
142 |   Text.putStrLn right
143 | 
144 |   -- Run two things concurrently and return the one that completes first
145 |   result <-
146 |     Async.race
147 |        (Main.curl "https://worldtimeapi.org/api/timezone/Europe/London")
148 |        (Main.curl "https://worldtimeapi.org/api/timezone/Europe/Rome")
149 |   Either.either Text.putStrLn Text.putStrLn result
150 | 
151 | curl = \url -> do
152 |   (out, err) <- Text.readProcess_ (Process.proc "curl" [url])
153 |   IO.pure out
154 |

14-text.hell

main = do
156 |   Text.putStrLn (Text.concat ["Hello, ", "World!"])
157 |   Text.putStrLn (Text.take 3 "Hello, World!")
158 |   Text.putStrLn (Text.drop 3 "Hello, World!")
159 |   Text.putStrLn (Text.strip "  Hello, World!   ")
160 |   Text.putStrLn (Text.intercalate ", " ["Hello","World!"])
161 |

15-type-classes.hell

main = do
163 |   Text.putStrLn (Show.show 123)
164 |   Text.putStrLn (Show.show Bool.True)
165 | 
166 |   env <- Environment.getEnvironment
167 |   Maybe.maybe
168 |     (Text.putStrLn "Seems the environment variable is not there.")
169 |     (\path -> Text.putStrLn (Text.concat ["HOME is ", path]))
170 |     (List.lookup "HOME" env)
171 |

16-if.hell

main = do
173 |   if List.and [Eq.eq (Int.plus 1 1) 2,
174 |                Ord.lt (Int.plus 1 1) 3,
175 |                Eq.eq (Text.concat ["Hello, World!"]) "Hello, World!"]
176 |      then Text.putStrLn "OK, List.and works."
177 |      else Text.putStrLn "Uh, oh?"
178 | 
179 |   if List.or [Eq.eq 1 2,
180 |               Eq.eq "x" "x"]
181 |      then Text.putStrLn "OK, List.or works."
182 |      else Text.putStrLn "Uh, oh?"
183 | 
184 |   if Bool.not (Eq.eq 1 2)
185 |      then Text.putStrLn "OK, Bool.not works."
186 |      else Text.putStrLn "Uh, oh?"
187 |

17-reuse.hell

-- Technically you're not supposed to be able to do code re-use in
189 | -- Hell, but presently the desugarer inlines everything into `main`
190 | -- prior to type-checking, and ignores declarations that aren't
191 | -- reachable by main.
192 | 
193 | main = do
194 |   Main.foo 1
195 |   Main.foo "blah"
196 | foo = \x -> Text.putStrLn (Show.show x)
197 | bar = Int.plus 4 "hi"
198 |

18-monads.hell

main = do
200 |   env <- Environment.getEnvironment
201 | 
202 |   -- Maybe monad works!
203 |   Maybe.maybe (Text.putStrLn "Oops!") Text.putStrLn
204 |      (do path <- List.lookup "PATH" env
205 |          home <- Functor.fmap Text.reverse $ List.lookup "HOME" env
206 |          Monad.return (Text.concat [path, " and ", home]))
207 | 
208 |   -- Either monad works!
209 |   Either.either Text.putStrLn Text.putStrLn
210 |     (do x <- Main.parse "foo"
211 |         y <- Main.parse "foo"
212 |         Monad.return (Text.concat [x,y]))
213 | 
214 | parse = \s ->
215 |   if Eq.eq s "foo"
216 |      then Either.Right "foooo :-)"
217 |      else Either.Left "oh noes!"
218 |

19-blog-generator.hell

-- This is a copy of the script that generates my blog.
220 | 
221 | -- Dependencies:
222 | --
223 | -- hell-2024-02-07
224 | -- pandoc-3.1.11.1
225 | 
226 | -- Main entry point just generates the complete blog every time.
227 | --
228 | --
229 | main = Main.generate
230 | 
231 | -- The posts are listed under ./posts in this format:
232 | --
233 | -- dijkstra-haskell-java.markdown
234 | -- reasoning-violently.md
235 | -- god-mode.markdown
236 | -- emacs-mail.markdown
237 | --
238 | -- .md or .markdown files, the extension doesn't matter.
239 | --
240 | generate = do
241 |   posts <- Main.generatePosts
242 |   Main.generateArchive posts
243 |   Main.generateRSS posts
244 | 
245 | -- Write out posts/$post/index.html per $post.
246 | --
247 | generatePosts = do
248 |   posts <- Directory.listDirectory "posts"
249 |   Text.putStrLn $ Text.concat ["Generating ", Show.show (List.length posts), " posts ..."]
250 |   Async.pooledForConcurrently posts \post -> do
251 |     contents <- Text.readFile $ Text.concat ["posts/", post]
252 |     Maybe.maybe
253 |       (Error.error "Couldn't parse the article!")
254 |       (\(date, title) -> do
255 |         rendered <- Main.render post
256 |         Monad.return (post, date, title, rendered))
257 |       $ Main.parse contents
258 | 
259 | -- Generate the /posts/ page.
260 | --
261 | generateArchive = \posts -> do
262 |   Text.putStrLn "Generating archive ..."
263 |   let rows =
264 |         Text.concat
265 |           $ List.map
266 |             (\(post, date, title, content) ->
267 |               Text.concat [
268 |                  "<tr><td><a href='",
269 |                  Main.filename post,
270 |                  "'>",
271 |                  Main.strip title,
272 |                  "</td><td>",
273 |                  date,
274 |                  "</td></tr>"
275 |                ])
276 |             $ List.reverse
277 |             $ List.sortOn (\(post, date, title, content) -> date)
278 |             $ posts
279 |   let table = Text.concat [
280 |         "---\n",
281 |         "title: Archive\n",
282 |         "---\n",
283 |         "<table id='archive' style='line-height:2em'>",
284 |         rows,
285 |         "</table>"
286 |         ]
287 |   (out, err) <-
288 |     Text.readProcess_
289 |       $ Text.setStdin table
290 |       $ Process.proc "pandoc" ["--standalone","--template","templates/posts.html"]
291 |   Text.writeFile "webroot/posts/index.html" out
292 | 
293 | -- Contents of an article looks like this:
294 | --
295 | -- ---
296 | -- date: 2011-04-10
297 | -- title: ‘amb’ operator and the list monad
298 | -- description: ‘amb’ operator and the list monad
299 | -- author: Chris Done
300 | -- tags: haskell, designs
301 | -- ---
302 | --
303 | -- We're only interested in the date and the title. The rest is
304 | -- redundant.
305 | --
306 | parse = \article -> do
307 |   sansPrefix <- Text.stripPrefix "---" article
308 |   let (preamble, _content) = Text.breakOn "---" sansPrefix
309 |   let lines = Text.splitOn "\n" preamble
310 |   let pairs = List.map (\line -> do let (key, value) = Text.breakOn ":" line
311 |                                     (key, Text.strip (Text.drop 1 value)))
312 |                        lines
313 |   date <- List.lookup "date" pairs
314 |   title <- List.lookup "title" pairs
315 |   Monad.return (date, title)
316 | 
317 | -- A post consists of a date, title and markdown.
318 | --
319 | -- Rendering them is easy, just run pandoc and apply an HTML template.
320 | render = \post -> do
321 |   let targetDir =
322 |         Text.concat ["webroot/posts/", Main.filename post]
323 |   let targetFile = Text.concat [targetDir, "/index.html"]
324 |   (out, err) <- Text.readProcess_ (Process.proc "pandoc" ["--standalone","--template","templates/post.html",Text.concat ["posts/", post]])
325 |   Directory.createDirectoryIfMissing Bool.True targetDir
326 |   Text.writeFile targetFile out
327 |   Monad.return out
328 | 
329 | -- Filename stripped of .md/.markdown.
330 | filename = \post -> Text.replace ".md" "" (Text.replace ".markdown" "" post)
331 | 
332 | -- Strip out quotes from "foo".
333 | strip = \title ->
334 |   Maybe.maybe title Function.id do
335 |     title' <- Text.stripPrefix "\"" title
336 |     Text.stripSuffix "\"" title'
337 | 
338 | -- Generate the /rss.xml page.
339 | --
340 | generateRSS = \posts0 -> do
341 |   let posts1 = List.reverse $ List.sortOn (\(post, date, title, content) -> date) posts0
342 |   posts <- Monad.forM posts1 \(post, date, title, content) -> do
343 |     date' <- Text.readProcessStdout_ $ Text.setStdin date $ Process.proc "date" ["-R", "-f", "/dev/stdin"]
344 |     Monad.return (post, date', title, content)
345 |   Text.putStrLn "Generating rss.xml ..."
346 |   let items =
347 |         Text.unlines
348 |           $ List.map
349 |             (\(post, date, title, content) ->
350 |               Text.concat [
351 |                  "<item>",
352 |                  "<title><![CDATA[", Main.strip title, "]]></title>",
353 |                  "<link>https://chrisdone.com/posts/", Main.filename post, "</link>",
354 |                  "<guid>https://chrisdone.com/posts/", Main.filename post, "</guid>",
355 |                  "<description><![CDATA[", content, "]]></description>",
356 |                  "<pubDate>", date, "</pubDate>",
357 |                  "<dc:creator>Chris Done</dc:creator>",
358 |                  "</item>"
359 |                ])
360 |             posts
361 |   let xml = Text.unlines [
362 |         "<?xml version=\"1.0\" encoding=\"utf-8\"?>",
363 |         "<rss version=\"2.0\" xmlns:atom=\"http://www.w3.org/2005/Atom\" xmlns:dc=\"http://purl.org/dc/elements/1.1/\">",
364 |         "<channel>",
365 |         "<title>Chris Done's Blog</title>",
366 |         "<link>https://chrisdone.com</link>",
367 |         "<description><![CDATA[Blog all about programming, especially in Haskell since 2008!]]></description>",
368 |         "<atom:link href=\"https://chrisdone.com/rss.xml\" rel=\"self\" type=\"application/rss+xml\" />",
369 |         "<lastBuildDate>Wed, 22 Dec 2021 00:00:00 UT</lastBuildDate>",
370 |         items,
371 |         "</channel>",
372 |         "</rss>"
373 |         ]
374 |   Text.writeFile "webroot/rss.xml" xml
375 |

20-dollar.hell

main = Text.putStrLn . Text.reverse $ "Foo!"
377 |

21-json.hell

main = do
379 |   ByteString.writeFile "demo.json" $
380 |     Json.encode $
381 |       Json.Object $ Map.fromList [
382 |         ("name", Json.String "Chris"),
383 |         ("age", Json.Number 99.123)
384 |        ]
385 |   bytes <- ByteString.readFile "demo.json"
386 |   ByteString.hPutStr IO.stdout bytes
387 |   Text.putStrLn $
388 |     Maybe.maybe "Bad parse."
389 |       (Json.value
390 |         "null"
391 |         (\str -> Text.concat ["bool", Show.show str])
392 |         (\str -> Text.concat ["str", Show.show str])
393 |         (\dub -> Text.concat ["dub", Show.show dub])
394 |         (\arr -> "Array!")
395 |         (\obj -> "Object."))
396 |        $ Json.decode bytes
397 |   Directory.removeFile "demo.json"
398 |

22-records.hell

data Person = Person { age :: Int, name :: Text }
400 | 
401 | main = do
402 |   Text.putStrLn $ Record.get @"name" Main.person
403 |   Text.putStrLn $ Record.get @"name" $ Record.set @"name" "Mary" Main.person
404 |   Text.putStrLn $ Record.get @"name" $ Record.modify @"name" Text.reverse Main.person
405 | 
406 | person =
407 |  Main.Person { name = "Chris", age = 23 }
408 |

23-args.hell

main = do
410 |   args <- Environment.getArgs
411 |   Monad.forM_ args IO.print
412 |

24-exitcode.hell

main = do
414 |   (code, out, err) <- ByteString.readProcess (Process.proc "ls" ["-al"])
415 | 
416 |   -- Accessor style
417 |   Exit.exitCode
418 |     (Text.putStrLn "All good!")
419 |     (\i -> IO.print i)
420 |     code
421 | 
422 |   -- Validation style
423 |   if Eq.eq code Exit.ExitSuccess
424 |      then Text.putStrLn "OK, good!"
425 |      else Text.putStrLn "Oh, sad."
426 |

25-sum-types.hell

data Value = Text Text | Number Int
428 | 
429 | data Rating = Good | Bad | Ugly
430 | 
431 | main = do
432 |   let printIt = \x ->
433 |         Text.putStrLn case x of
434 |           Number i -> Show.show i
435 |           Text t -> t
436 |   printIt $ Main.Number 123
437 |   printIt $ Main.Text "abc"
438 |   Monad.mapM_ printIt [Main.Number 123,Main.Text "abc"]
439 |   Text.putStrLn $ case Main.Good of
440 |     Good -> "Good!"
441 |     Bad -> "Bad!"
442 |     Ugly -> "Ugly!"
443 |

26-reference-other-types.hell

-- User-defined types can reference other types now.
445 | data Person = Person {
446 |   name :: Text,
447 |   address :: Main.Address,
448 |   status :: Main.Status
449 |   }
450 | data Status = Retired | Working
451 | data Address = Address {
452 |   line1 :: Text, line2 :: Text
453 | }
454 | main = do
455 |   let p :: Main.Person = Main.Person {
456 |         name = "Chris",
457 |         address = Main.Address { line1 = "1 North Pole", line2 = "Earth" },
458 |         status = Main.Retired
459 |        }
460 |   Text.putStrLn $ Record.get @"name" p
461 |   Text.putStrLn $
462 |     Record.get @"line1" $
463 |       Record.get @"address" @Main.Address p
464 |       --                    ^ Unfortunately this is needed or else the
465 |       --                    nested access causes an ambiguous type
466 |       --                    variable. But it's not too bad.
467 |   case Record.get @"status" @Main.Status p of
468 |     Retired -> Text.putStrLn "Retired"
469 |     Working -> Text.putStrLn "Working"
470 |

27-discussion-64.hell

-- <https://github.com/chrisdone/hell/discussions/64>
472 | --
473 | -- Previously:
474 | --
475 | -- hell: Unification error: Couldn't match type
476 | 
477 | --   "Main.MySum"
478 | 
479 | -- against type
480 | 
481 | --   "MySum"
482 | 
483 | data MyRecord = MyRecord {sum :: Main.MySum}
484 | 
485 | data MySum = MySumL | MySumR
486 | 
487 | main = do
488 |   let myRecord = Main.MyRecord {sum = Main.MySumR}
489 |   Text.putStrLn "hello world"
490 |

28-trees.hell

-- Basic example of a tree data structure.
492 | main = do
493 |   let tree =
494 |         Tree.Node "1" [
495 |           Tree.Node "1.a" [],
496 |           Tree.Node "1.b" [
497 |             Tree.Node "1.b.x" []
498 |           ]
499 |         ]
500 |   -- Do a trivial map, include the length of the tag in the nodes.
501 |   let tree' = Tree.map (\a -> (a, Text.length a)) tree
502 |   -- Write the tree out in a Lisp syntax.
503 |   Tree.foldTree
504 |     (\(a, len) children -> do
505 |       Text.putStr "("
506 |       Text.putStr a
507 |       Text.putStr " "
508 |       Text.putStr $ Show.show len
509 |       Monad.forM_ children (\m -> do Text.putStr " "; m)
510 |       Text.putStr ")")
511 |     tree'
512 |

29-temp-files.hell

main = do
514 |   Temp.withSystemTempDirectory "example" \dirPath -> do
515 |     Text.putStrLn $ Text.concat ["Created temp directory ", dirPath]
516 |   
517 |   Temp.withSystemTempFile "example" \filePath handle -> do
518 |     Text.putStrLn $ Text.concat ["Created temp file ", filePath]
519 |

30-process-handlers.hell

main = do
521 |   -- 1. close the handle after the process
522 |   Temp.withSystemTempFile "example" \filePath handle -> do
523 |     Text.putStrLn $ Text.concat ["Created temp file ", filePath]
524 |     let proc = Process.setStdout (Process.useHandleClose handle) $ 
525 |          Process.proc "ls" ["-al"]
526 |     Process.runProcess_ proc
527 |     contents <- Text.readFile filePath
528 |     Text.putStrLn contents
529 | 
530 |   -- 2. keep the handle open after the process
531 |   Temp.withSystemTempFile "example-open" \filePath handle -> do
532 |     Text.putStrLn $ Text.concat ["Created temp file ", filePath]
533 |     let proc0 = Process.setStdout (Process.useHandleOpen handle) $ 
534 |          Process.proc "echo" ["hello"]
535 |     -- second time around we we make sure to close the handle 
536 |     -- so we can then read the file later
537 |     let proc1 = Process.setStdout (Process.useHandleClose handle) $ 
538 |          Process.proc "echo" ["world"]
539 |     Process.runProcess_ proc0
540 |     Process.runProcess_ proc1
541 |     contents <- Text.readFile filePath
542 |     Text.putStrLn contents
543 | 
544 |   -- 3. manually close the handle
545 |   Temp.withSystemTempFile "example-manual-close" \filePath handle -> do
546 |     Text.putStrLn $ Text.concat ["Created temp file ", filePath]
547 |     let proc = Process.setStdout (Process.useHandleOpen handle) $ 
548 |          Process.proc "echo" ["hello"]
549 |     Process.runProcess_ proc
550 |     -- manually close the handle so we can open the file to be read
551 |     IO.hClose handle
552 |     contents <- Text.readFile filePath
553 |     Text.putStrLn contents
554 |

31-open-file-handle.hell

main = do
556 |   let filepath = "out.txt"
557 |   handle <- IO.openFile filepath IO.WriteMode
558 |   let proc = Process.setStdout (Process.useHandleClose handle) $ 
559 |          Process.proc "ls" ["-al"]
560 |   Process.runProcess_ proc
561 |   IO.hClose handle
562 | 
563 |   contents <- Text.readFile filepath
564 |   Text.putStrLn contents
565 |

32-optparse.hell

-- Includes example of Semigroup.
567 | data Opts = Opts {
568 |   quiet :: Bool,
569 |   filePath :: Maybe Text
570 |  }
571 | options =
572 |   (\quiet path -> Main.Opts { quiet = quiet, filePath = path })
573 |        <$> Options.switch (Flag.long "quiet" <> Flag.help "Be quiet?")
574 |        <*> (Alternative.optional $ Options.strOption (Option.long "path" <> Option.help "The filepath to export"))
575 | main = do
576 |   opts <- Options.execParser (Options.info (Main.options <**> Options.helper) Options.fullDesc)
577 |   Text.putStrLn $ Maybe.maybe "No file path" Function.id (Record.get @"filePath" opts)
578 |   Text.putStrLn $ Show.show @Bool $ Record.get @"quiet" opts
579 |

33-null-stream.hell

main = do
581 |   -- discard stdout
582 |   Process.runProcess_ $ Process.setStdout Process.nullStream $ Process.proc "ls" []
583 |

34-field-puns.hell

data Foo = Foo { bar, mu :: Int }
585 | main = do
586 |   let bar = 123
587 |   let mu = 666
588 |   let r = Main.Foo{bar,mu}
589 |   IO.print $ Record.get @"bar" @Int r
590 |

35-type-sigs.hell

data Foo = Foo { bar, mu :: Int }
592 | main :: IO () =
593 |   Main.foo
594 | 
595 | foo = do
596 |   let bar = 123
597 |   let mu = 666
598 |   let r = Main.Foo{bar,mu}
599 |   IO.print $ (Record.get @"bar" r :: Int)
600 |

36-these.hell

main = do
602 |   let things = [These.This 1, These.That "hello", These.These 2 "bonjour"]
603 | 
604 |   Monad.forM_  things $ \thing -> Text.putStrLn $
605 |     These.these
606 |       (\i -> Show.show i)
607 |       (\s -> s)
608 |       (\i s -> Text.concat [Show.show i, " ", s])
609 |       thing
610 |

37-readshow.hell

-- Reading and showing numbers
612 | 
613 | main = do
614 |   -- Reading ints and floats
615 | 
616 |   let mint = Int.readMaybe "123"
617 |   let mdouble = Double.readMaybe "123.456"
618 |   Maybe.maybe (IO.pure ()) IO.print mint
619 |   Maybe.maybe (IO.pure ()) IO.print mdouble
620 | 
621 |   Text.putStrLn "Generic"
622 |   Text.putStrLn $ Double.show 123456789.123456789
623 |   Text.putStrLn $ Double.show 123.0
624 |   Text.putStrLn "Scientific"
625 |   Text.putStrLn $ Double.showEFloat Maybe.Nothing 123.0 ""
626 |   Text.putStrLn $ Double.showEFloat Maybe.Nothing 123456789.123456789 ""
627 |   Text.putStrLn $ Double.showEFloat (Maybe.Just 3) 123456789.123456789 ""
628 |   Text.putStrLn "Decimal"
629 |   Text.putStrLn $ Double.showFFloat Maybe.Nothing 123456789.123456789 ""
630 |   Text.putStrLn $ Double.showFFloat (Maybe.Just 3) 123456789.123456789 ""
631 |   Text.putStrLn $ Double.showFFloat (Maybe.Just 3) 123456789.0 ""
632 |   Text.putStrLn $ Double.showFFloat Maybe.Nothing 123456789.0 ""
633 |

38-integer.hell

-- prints: 18446744073709551614
635 | main = do
636 |   IO.print $
637 |     Integer.plus
638 |       (Int.toInteger 9223372036854775807)
639 |       (Int.toInteger 9223372036854775807)
640 |

39-day.hell

main = do
642 |   day1 :: Day <-
643 |     Maybe.maybe (Error.error "Invalid") IO.pure $ Day.fromGregorianValid (Int.toInteger 2025) 08 09
644 |   day2 <- Maybe.maybe (Error.error "Invalid") IO.pure $ Day.iso8601ParseM "2025-08-09"
645 |   IO.print $ Eq.eq day1 day2 -- True
646 |   Text.putStrLn $ Day.iso8601Show day1 -- 2025-08-09
647 |

40-utctime.hell

main = do
649 |   now <- UTCTime.getCurrentTime
650 |   Text.putStrLn "Current time:"
651 |   IO.print now
652 | 
653 |   Text.putStrLn "ISO8601:"
654 |   Text.putStrLn $ UTCTime.iso8601Show now
655 | 
656 |   Text.putStrLn "Parsed:"
657 |   Maybe.maybe (Error.error "Impossible!") IO.print $ UTCTime.iso8601ParseM "2025-05-30T11:18:26.195147084Z"
658 | 
659 |   Text.putStrLn "Increased:"
660 |   IO.print $ UTCTime.addUTCTime (Double.mult 60.0 60.0) now
661 | 
662 |   Text.putStrLn "Parts:"
663 |   IO.print $ TimeOfDay.timeToTimeOfDay $ UTCTime.utctDayTime now
664 |   IO.print $ UTCTime.utctDay now
665 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | Hell: Shell scripting Haskell dialect 7 | 96 | 97 | 98 |
99 |
100 |

Hell: Shell scripting Haskell dialect

101 | 102 | 106 |
107 |

Hell is a shell 108 | scripting language that is a tiny dialect of Haskell that I wrote for my 109 | own shell scripting purposes.

110 | 111 | 
#!/usr/bin/env hell
113 | main = do
114 |   Text.putStrLn "Please enter your name and hit ENTER:"
115 |   name <- Text.getLine
116 |   Text.putStrLn "Thanks, your name is: "
117 |   Text.putStrLn name
118 | 119 |

Overview

120 | 131 | 132 |

To read more, see my blog post about Hell.

134 | 135 | 142 | 143 |
144 | 145 | 146 | -------------------------------------------------------------------------------- /docs/index.js: -------------------------------------------------------------------------------- 1 | // parse the json in the index 2 | const indexEl = document.getElementById("searchIndex"); 3 | const index = JSON.parse(indexEl.textContent); 4 | 5 | function hideItem(item) { 6 | item.style.display = "none"; 7 | item.classList.add("hidden"); 8 | } 9 | 10 | function showItem(item) { 11 | item.style.display = "block"; 12 | item.classList.remove("hidden"); 13 | } 14 | 15 | function hideSearchable() { 16 | const allItems = document.querySelectorAll(".searchable"); 17 | // hide all items 18 | allItems.forEach((item) => { 19 | hideItem(item); 20 | }); 21 | } 22 | 23 | function showSearchable() { 24 | const allItems = document.querySelectorAll(".searchable"); 25 | // show all items 26 | allItems.forEach((item) => { 27 | showItem(item); 28 | }); 29 | } 30 | 31 | function showUsedHeadings() { 32 | // fancy query which selects any headings which have 33 | // non hidden children 34 | const els = document.querySelectorAll( 35 | ".searchableHeading:has(+ul li:not(.hidden))", 36 | ); 37 | els.forEach((el) => { 38 | el.style.display = "block"; 39 | }); 40 | } 41 | 42 | function hideAllHeadings() { 43 | const els = document.querySelectorAll(".searchableHeading"); 44 | els.forEach((el) => { 45 | el.style.display = "none"; 46 | }); 47 | } 48 | 49 | function showAllHeadings() { 50 | const els = document.querySelectorAll(".searchableHeading"); 51 | els.forEach((el) => { 52 | el.style.display = "block"; 53 | }); 54 | } 55 | 56 | function search(query) { 57 | if (query === "" || query === null) { 58 | showAllHeadings(); 59 | showSearchable(); 60 | return; 61 | } 62 | 63 | // 64 | const results = index.filter((item) => { 65 | return item.text.toLowerCase().includes(query.toLowerCase()); 66 | }); 67 | const resultIds = results.map((item) => item.elementId); 68 | 69 | // hide everything (we will show relevant things next) 70 | hideSearchable(); 71 | hideAllHeadings(); 72 | // show the items that match the search 73 | resultIds.forEach((id) => { 74 | const item = document.getElementById(id); 75 | showItem(item); 76 | }); 77 | showUsedHeadings(); 78 | } 79 | 80 | // when the search changes, hide non-matching elements 81 | const searchInput = document.getElementById("search"); 82 | searchInput.addEventListener("input", function (event) { 83 | const value = event.target.value; 84 | search(value); 85 | }); 86 | -------------------------------------------------------------------------------- /docs/install.md: -------------------------------------------------------------------------------- 1 | Bootstrap (do this once): 2 | 3 | $ stack build 4 | $ cp .stack-work/dist/x86_64-linux/ghc-9.4.8/build/hell/hell ./hell-linux-x86-64bit 5 | $ sudo ./hell-linux-x86-64bit scripts/install-hell.hell 6 | 7 | Build static binary (do from docker image): 8 | 9 | hell scripts/static-build.hell 10 | 11 | Install static binary to /usr/bin/ (do from host OS): 12 | 13 | sudo ./hell-linux-x86-64bit scripts/install-hell.hell 14 | -------------------------------------------------------------------------------- /docs/readme.md: -------------------------------------------------------------------------------- 1 | # hell 😈 2 | 3 | Hell is a shell scripting language that is a tiny dialect of Haskell. 4 | 5 | 6 | See [homepage](https://chrisdone.github.io/hell/) for documentation, downloads, architecture, etc. 7 | -------------------------------------------------------------------------------- /docs/style.css: -------------------------------------------------------------------------------- 1 | body {max-width: 40em; margin: .5in auto;} 2 | h1,h2,h3,h4,h5,h6 {font-family: Helvetica;} 3 | a {color: #1a6e8e} 4 | pre, code {font-size: 16px; word-wrap: break-word;} 5 | pre.sourceCode span.st {color: #366354} 6 | pre.sourceCode span.kw {color: #397460} 7 | pre.sourceCode span.fu {color: #8f4e8b} 8 | pre.sourceCode span.ot {color: #2e659c} 9 | pre.sourceCode span.dt {color: #4F4371} 10 | pre.sourceCode span.co {color: #666} 11 | 12 | @media(max-width:767px){ 13 | body { margin: 1px 4px; } 14 | h1, h2, .menu { margin: 0; } 15 | h1 { font-size: 1.5em; } 16 | h2 { font-size: 1.125em; } 17 | h3 { font-size: 1.0125em; } 18 | } 19 | 20 | li { line-height: 2em } 21 | -------------------------------------------------------------------------------- /examples/01-hello-world.hell: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env hell 2 | main = Text.putStrLn "Hello, World!" 3 | -------------------------------------------------------------------------------- /examples/02-interaction.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | Text.putStrLn "Please enter your name and hit ENTER:" 3 | name <- Text.getLine 4 | Text.putStrLn "Thanks, your name is: " 5 | Text.putStrLn name 6 | -------------------------------------------------------------------------------- /examples/03-press-any-key.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | IO.hSetBuffering IO.stdin IO.NoBuffering 3 | IO.hSetBuffering IO.stdout IO.NoBuffering 4 | 5 | Text.putStr "Please press any key ... " 6 | chunk <- ByteString.hGet IO.stdin 1 7 | 8 | IO.hSetBuffering IO.stdout IO.LineBuffering 9 | Text.putStrLn "OK!" 10 | -------------------------------------------------------------------------------- /examples/04-writing-files.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | let fp = "foo.txt" 3 | Text.writeFile fp "Hello, " 4 | Text.appendFile fp "World!" 5 | text <- Text.readFile fp 6 | Text.putStrLn text 7 | -------------------------------------------------------------------------------- /examples/05-lists.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | let is = List.iterate' (Int.plus 1) 0 3 | let xs = ["Hello, ", "World!"] 4 | Text.putStrLn "OK!" 5 | Monad.forM_ (List.zip is xs) \(i,x) -> do 6 | IO.print i 7 | Text.putStrLn x 8 | IO.print $ List.foldl' Int.plus 0 $ List.take 10 is 9 | -------------------------------------------------------------------------------- /examples/06-polymorphism.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | let x = "Hello!" 3 | Text.putStrLn (Function.id x) 4 | let lengths = List.map Text.length ["foo", "mu"] 5 | IO.mapM_ (\i -> Text.putStrLn (Int.show i)) lengths 6 | -------------------------------------------------------------------------------- /examples/07-loops.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | IO.mapM_ Text.putStrLn ["Hello, ", "World!"] 3 | 4 | Function.fix (\(loop :: IO ()) -> do 5 | Text.putStrLn "Ahhhhh! More?" 6 | l <- Text.getLine 7 | loop) 8 | -------------------------------------------------------------------------------- /examples/08-tuples.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | let demo = \(x, y) -> y 3 | let foobar = (123, "foo") 4 | Text.putStrLn (demo foobar) 5 | 6 | let (foo,bar) = (123, "foo") 7 | Text.putStrLn bar 8 | 9 | let typeSigsWork :: () = () 10 | 11 | Monad.return () 12 | -------------------------------------------------------------------------------- /examples/09-processes.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | Text.putStrLn "OK" 3 | (code, out, err) <- ByteString.readProcess (Process.proc "ls" ["-al"]) 4 | ByteString.hPutStr IO.stdout out 5 | ByteString.hPutStr IO.stdout err 6 | 7 | (out, err) <- Text.readProcess_ (Process.proc "df" ["-h", "/"]) 8 | Text.hPutStr IO.stdout out 9 | Text.hPutStr IO.stdout err 10 | 11 | code <- Process.runProcess (Process.proc "false" []) 12 | 13 | Process.runProcess_ (Process.proc "echo" ["Hello, World!"]) 14 | 15 | let config = Process.proc "false" [] 16 | code <- Process.runProcess config 17 | 18 | Process.runProcess $ Process.setWorkingDir "/etc/" $ Process.proc "pwd" [] 19 | 20 | Text.putStrLn "Done." 21 | -------------------------------------------------------------------------------- /examples/10-current-directory.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | dir <- Directory.getCurrentDirectory 3 | Text.putStrLn dir 4 | Directory.setCurrentDirectory dir 5 | -------------------------------------------------------------------------------- /examples/11-env-vars.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | env <- Environment.getEnvironment 3 | (out, err) <- 4 | Text.readProcess_ ( 5 | Process.setEnv (List.cons ("HELL_DEMO", "wibble") env) 6 | (Process.proc "env" []) 7 | ) 8 | Text.hPutStr IO.stdout out 9 | -------------------------------------------------------------------------------- /examples/12-fib.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | Text.putStrLn (Int.show (Main.fib 30)) 3 | 4 | fib = 5 | Function.fix 6 | (\fib i -> 7 | Bool.bool 8 | (Bool.bool 9 | (Int.plus (fib (Int.subtract 1 i)) 10 | (fib (Int.subtract 2 i))) 11 | 1 12 | (Int.eq i 1)) 13 | 0 14 | (Int.eq i 0) 15 | ) 16 | -------------------------------------------------------------------------------- /examples/13-concurrency.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | 3 | -- Run two things concurrently and return both results 4 | (left, right) <- 5 | Async.concurrently 6 | (Main.curl "https://worldtimeapi.org/api/timezone/Europe/London") 7 | (Main.curl "https://worldtimeapi.org/api/timezone/Europe/Rome") 8 | Text.putStrLn left 9 | Text.putStrLn right 10 | 11 | -- Run two things concurrently and return the one that completes first 12 | result <- 13 | Async.race 14 | (Main.curl "https://worldtimeapi.org/api/timezone/Europe/London") 15 | (Main.curl "https://worldtimeapi.org/api/timezone/Europe/Rome") 16 | Either.either Text.putStrLn Text.putStrLn result 17 | 18 | curl = \url -> do 19 | (out, err) <- Text.readProcess_ (Process.proc "curl" [url]) 20 | IO.pure out 21 | -------------------------------------------------------------------------------- /examples/14-text.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | Text.putStrLn (Text.concat ["Hello, ", "World!"]) 3 | Text.putStrLn (Text.take 3 "Hello, World!") 4 | Text.putStrLn (Text.drop 3 "Hello, World!") 5 | Text.putStrLn (Text.strip " Hello, World! ") 6 | Text.putStrLn (Text.intercalate ", " ["Hello","World!"]) 7 | -------------------------------------------------------------------------------- /examples/15-type-classes.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | Text.putStrLn (Show.show 123) 3 | Text.putStrLn (Show.show Bool.True) 4 | 5 | env <- Environment.getEnvironment 6 | Maybe.maybe 7 | (Text.putStrLn "Seems the environment variable is not there.") 8 | (\path -> Text.putStrLn (Text.concat ["HOME is ", path])) 9 | (List.lookup "HOME" env) 10 | -------------------------------------------------------------------------------- /examples/16-if.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | if List.and [Eq.eq (Int.plus 1 1) 2, 3 | Ord.lt (Int.plus 1 1) 3, 4 | Eq.eq (Text.concat ["Hello, World!"]) "Hello, World!"] 5 | then Text.putStrLn "OK, List.and works." 6 | else Text.putStrLn "Uh, oh?" 7 | 8 | if List.or [Eq.eq 1 2, 9 | Eq.eq "x" "x"] 10 | then Text.putStrLn "OK, List.or works." 11 | else Text.putStrLn "Uh, oh?" 12 | 13 | if Bool.not (Eq.eq 1 2) 14 | then Text.putStrLn "OK, Bool.not works." 15 | else Text.putStrLn "Uh, oh?" 16 | -------------------------------------------------------------------------------- /examples/17-reuse.hell: -------------------------------------------------------------------------------- 1 | -- Technically you're not supposed to be able to do code re-use in 2 | -- Hell, but presently the desugarer inlines everything into `main` 3 | -- prior to type-checking, and ignores declarations that aren't 4 | -- reachable by main. 5 | 6 | main = do 7 | Main.foo 1 8 | Main.foo "blah" 9 | foo = \x -> Text.putStrLn (Show.show x) 10 | bar = Int.plus 4 "hi" 11 | -------------------------------------------------------------------------------- /examples/18-monads.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | env <- Environment.getEnvironment 3 | 4 | -- Maybe monad works! 5 | Maybe.maybe (Text.putStrLn "Oops!") Text.putStrLn 6 | (do path <- List.lookup "PATH" env 7 | home <- Functor.fmap Text.reverse $ List.lookup "HOME" env 8 | Monad.return (Text.concat [path, " and ", home])) 9 | 10 | -- Either monad works! 11 | Either.either Text.putStrLn Text.putStrLn 12 | (do x <- Main.parse "foo" 13 | y <- Main.parse "foo" 14 | Monad.return (Text.concat [x,y])) 15 | 16 | parse = \s -> 17 | if Eq.eq s "foo" 18 | then Either.Right "foooo :-)" 19 | else Either.Left "oh noes!" 20 | -------------------------------------------------------------------------------- /examples/19-blog-generator.hell: -------------------------------------------------------------------------------- 1 | -- This is a copy of the script that generates my blog. 2 | 3 | -- Dependencies: 4 | -- 5 | -- hell-2024-02-07 6 | -- pandoc-3.1.11.1 7 | 8 | -- Main entry point just generates the complete blog every time. 9 | -- 10 | -- 11 | main = Main.generate 12 | 13 | -- The posts are listed under ./posts in this format: 14 | -- 15 | -- dijkstra-haskell-java.markdown 16 | -- reasoning-violently.md 17 | -- god-mode.markdown 18 | -- emacs-mail.markdown 19 | -- 20 | -- .md or .markdown files, the extension doesn't matter. 21 | -- 22 | generate = do 23 | posts <- Main.generatePosts 24 | Main.generateArchive posts 25 | Main.generateRSS posts 26 | 27 | -- Write out posts/$post/index.html per $post. 28 | -- 29 | generatePosts = do 30 | posts <- Directory.listDirectory "posts" 31 | Text.putStrLn $ Text.concat ["Generating ", Show.show (List.length posts), " posts ..."] 32 | Async.pooledForConcurrently posts \post -> do 33 | contents <- Text.readFile $ Text.concat ["posts/", post] 34 | Maybe.maybe 35 | (Error.error "Couldn't parse the article!") 36 | (\(date, title) -> do 37 | rendered <- Main.render post 38 | Monad.return (post, date, title, rendered)) 39 | $ Main.parse contents 40 | 41 | -- Generate the /posts/ page. 42 | -- 43 | generateArchive = \posts -> do 44 | Text.putStrLn "Generating archive ..." 45 | let rows = 46 | Text.concat 47 | $ List.map 48 | (\(post, date, title, content) -> 49 | Text.concat [ 50 | "", 53 | Main.strip title, 54 | "", 55 | date, 56 | "" 57 | ]) 58 | $ List.reverse 59 | $ List.sortOn (\(post, date, title, content) -> date) 60 | $ posts 61 | let table = Text.concat [ 62 | "---\n", 63 | "title: Archive\n", 64 | "---\n", 65 | "", 66 | rows, 67 | "
" 68 | ] 69 | (out, err) <- 70 | Text.readProcess_ 71 | $ Text.setStdin table 72 | $ Process.proc "pandoc" ["--standalone","--template","templates/posts.html"] 73 | Text.writeFile "webroot/posts/index.html" out 74 | 75 | -- Contents of an article looks like this: 76 | -- 77 | -- --- 78 | -- date: 2011-04-10 79 | -- title: ‘amb’ operator and the list monad 80 | -- description: ‘amb’ operator and the list monad 81 | -- author: Chris Done 82 | -- tags: haskell, designs 83 | -- --- 84 | -- 85 | -- We're only interested in the date and the title. The rest is 86 | -- redundant. 87 | -- 88 | parse = \article -> do 89 | sansPrefix <- Text.stripPrefix "---" article 90 | let (preamble, _content) = Text.breakOn "---" sansPrefix 91 | let lines = Text.splitOn "\n" preamble 92 | let pairs = List.map (\line -> do let (key, value) = Text.breakOn ":" line 93 | (key, Text.strip (Text.drop 1 value))) 94 | lines 95 | date <- List.lookup "date" pairs 96 | title <- List.lookup "title" pairs 97 | Monad.return (date, title) 98 | 99 | -- A post consists of a date, title and markdown. 100 | -- 101 | -- Rendering them is easy, just run pandoc and apply an HTML template. 102 | render = \post -> do 103 | let targetDir = 104 | Text.concat ["webroot/posts/", Main.filename post] 105 | let targetFile = Text.concat [targetDir, "/index.html"] 106 | (out, err) <- Text.readProcess_ (Process.proc "pandoc" ["--standalone","--template","templates/post.html",Text.concat ["posts/", post]]) 107 | Directory.createDirectoryIfMissing Bool.True targetDir 108 | Text.writeFile targetFile out 109 | Monad.return out 110 | 111 | -- Filename stripped of .md/.markdown. 112 | filename = \post -> Text.replace ".md" "" (Text.replace ".markdown" "" post) 113 | 114 | -- Strip out quotes from "foo". 115 | strip = \title -> 116 | Maybe.maybe title Function.id do 117 | title' <- Text.stripPrefix "\"" title 118 | Text.stripSuffix "\"" title' 119 | 120 | -- Generate the /rss.xml page. 121 | -- 122 | generateRSS = \posts0 -> do 123 | let posts1 = List.reverse $ List.sortOn (\(post, date, title, content) -> date) posts0 124 | posts <- Monad.forM posts1 \(post, date, title, content) -> do 125 | date' <- Text.readProcessStdout_ $ Text.setStdin date $ Process.proc "date" ["-R", "-f", "/dev/stdin"] 126 | Monad.return (post, date', title, content) 127 | Text.putStrLn "Generating rss.xml ..." 128 | let items = 129 | Text.unlines 130 | $ List.map 131 | (\(post, date, title, content) -> 132 | Text.concat [ 133 | "", 134 | "<![CDATA[", Main.strip title, "]]>", 135 | "https://chrisdone.com/posts/", Main.filename post, "", 136 | "https://chrisdone.com/posts/", Main.filename post, "", 137 | "", 138 | "", date, "", 139 | "Chris Done", 140 | "" 141 | ]) 142 | posts 143 | let xml = Text.unlines [ 144 | "", 145 | "", 146 | "", 147 | "Chris Done's Blog", 148 | "https://chrisdone.com", 149 | "", 150 | "", 151 | "Wed, 22 Dec 2021 00:00:00 UT", 152 | items, 153 | "", 154 | "" 155 | ] 156 | Text.writeFile "webroot/rss.xml" xml 157 | -------------------------------------------------------------------------------- /examples/20-dollar.hell: -------------------------------------------------------------------------------- 1 | main = Text.putStrLn . Text.reverse $ "Foo!" 2 | -------------------------------------------------------------------------------- /examples/21-json.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | ByteString.writeFile "demo.json" $ 3 | Json.encode $ 4 | Json.Object $ Map.fromList [ 5 | ("name", Json.String "Chris"), 6 | ("age", Json.Number 99.123) 7 | ] 8 | bytes <- ByteString.readFile "demo.json" 9 | ByteString.hPutStr IO.stdout bytes 10 | Text.putStrLn $ 11 | Maybe.maybe "Bad parse." 12 | (Json.value 13 | "null" 14 | (\str -> Text.concat ["bool", Show.show str]) 15 | (\str -> Text.concat ["str", Show.show str]) 16 | (\dub -> Text.concat ["dub", Show.show dub]) 17 | (\arr -> "Array!") 18 | (\obj -> "Object.")) 19 | $ Json.decode bytes 20 | Directory.removeFile "demo.json" 21 | -------------------------------------------------------------------------------- /examples/22-records.hell: -------------------------------------------------------------------------------- 1 | data Person = Person { age :: Int, name :: Text } 2 | 3 | main = do 4 | Text.putStrLn $ Record.get @"name" Main.person 5 | Text.putStrLn $ Record.get @"name" $ Record.set @"name" "Mary" Main.person 6 | Text.putStrLn $ Record.get @"name" $ Record.modify @"name" Text.reverse Main.person 7 | 8 | person = 9 | Main.Person { name = "Chris", age = 23 } 10 | -------------------------------------------------------------------------------- /examples/23-args.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | args <- Environment.getArgs 3 | Monad.forM_ args IO.print 4 | -------------------------------------------------------------------------------- /examples/24-exitcode.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | (code, out, err) <- ByteString.readProcess (Process.proc "ls" ["-al"]) 3 | 4 | -- Accessor style 5 | Exit.exitCode 6 | (Text.putStrLn "All good!") 7 | (\i -> IO.print i) 8 | code 9 | 10 | -- Validation style 11 | if Eq.eq code Exit.ExitSuccess 12 | then Text.putStrLn "OK, good!" 13 | else Text.putStrLn "Oh, sad." 14 | -------------------------------------------------------------------------------- /examples/25-sum-types.hell: -------------------------------------------------------------------------------- 1 | data Value = Text Text | Number Int 2 | 3 | data Rating = Good | Bad | Ugly 4 | 5 | main = do 6 | let printIt = \x -> 7 | Text.putStrLn case x of 8 | Number i -> Show.show i 9 | Text t -> t 10 | printIt $ Main.Number 123 11 | printIt $ Main.Text "abc" 12 | Monad.mapM_ printIt [Main.Number 123,Main.Text "abc"] 13 | Text.putStrLn $ case Main.Good of 14 | Good -> "Good!" 15 | Bad -> "Bad!" 16 | Ugly -> "Ugly!" 17 | -------------------------------------------------------------------------------- /examples/26-reference-other-types.hell: -------------------------------------------------------------------------------- 1 | -- User-defined types can reference other types now. 2 | data Person = Person { 3 | name :: Text, 4 | address :: Main.Address, 5 | status :: Main.Status 6 | } 7 | data Status = Retired | Working 8 | data Address = Address { 9 | line1 :: Text, line2 :: Text 10 | } 11 | main = do 12 | let p :: Main.Person = Main.Person { 13 | name = "Chris", 14 | address = Main.Address { line1 = "1 North Pole", line2 = "Earth" }, 15 | status = Main.Retired 16 | } 17 | Text.putStrLn $ Record.get @"name" p 18 | Text.putStrLn $ 19 | Record.get @"line1" $ 20 | Record.get @"address" @Main.Address p 21 | -- ^ Unfortunately this is needed or else the 22 | -- nested access causes an ambiguous type 23 | -- variable. But it's not too bad. 24 | case Record.get @"status" @Main.Status p of 25 | Retired -> Text.putStrLn "Retired" 26 | Working -> Text.putStrLn "Working" 27 | -------------------------------------------------------------------------------- /examples/27-discussion-64.hell: -------------------------------------------------------------------------------- 1 | -- 2 | -- 3 | -- Previously: 4 | -- 5 | -- hell: Unification error: Couldn't match type 6 | 7 | -- "Main.MySum" 8 | 9 | -- against type 10 | 11 | -- "MySum" 12 | 13 | data MyRecord = MyRecord {sum :: Main.MySum} 14 | 15 | data MySum = MySumL | MySumR 16 | 17 | main = do 18 | let myRecord = Main.MyRecord {sum = Main.MySumR} 19 | Text.putStrLn "hello world" 20 | -------------------------------------------------------------------------------- /examples/28-trees.hell: -------------------------------------------------------------------------------- 1 | -- Basic example of a tree data structure. 2 | main = do 3 | let tree = 4 | Tree.Node "1" [ 5 | Tree.Node "1.a" [], 6 | Tree.Node "1.b" [ 7 | Tree.Node "1.b.x" [] 8 | ] 9 | ] 10 | -- Do a trivial map, include the length of the tag in the nodes. 11 | let tree' = Tree.map (\a -> (a, Text.length a)) tree 12 | -- Write the tree out in a Lisp syntax. 13 | Tree.foldTree 14 | (\(a, len) children -> do 15 | Text.putStr "(" 16 | Text.putStr a 17 | Text.putStr " " 18 | Text.putStr $ Show.show len 19 | Monad.forM_ children (\m -> do Text.putStr " "; m) 20 | Text.putStr ")") 21 | tree' 22 | -------------------------------------------------------------------------------- /examples/29-temp-files.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | Temp.withSystemTempDirectory "example" \dirPath -> do 3 | Text.putStrLn $ Text.concat ["Created temp directory ", dirPath] 4 | 5 | Temp.withSystemTempFile "example" \filePath handle -> do 6 | Text.putStrLn $ Text.concat ["Created temp file ", filePath] 7 | -------------------------------------------------------------------------------- /examples/30-process-handlers.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | -- 1. close the handle after the process 3 | Temp.withSystemTempFile "example" \filePath handle -> do 4 | Text.putStrLn $ Text.concat ["Created temp file ", filePath] 5 | let proc = Process.setStdout (Process.useHandleClose handle) $ 6 | Process.proc "ls" ["-al"] 7 | Process.runProcess_ proc 8 | contents <- Text.readFile filePath 9 | Text.putStrLn contents 10 | 11 | -- 2. keep the handle open after the process 12 | Temp.withSystemTempFile "example-open" \filePath handle -> do 13 | Text.putStrLn $ Text.concat ["Created temp file ", filePath] 14 | let proc0 = Process.setStdout (Process.useHandleOpen handle) $ 15 | Process.proc "echo" ["hello"] 16 | -- second time around we we make sure to close the handle 17 | -- so we can then read the file later 18 | let proc1 = Process.setStdout (Process.useHandleClose handle) $ 19 | Process.proc "echo" ["world"] 20 | Process.runProcess_ proc0 21 | Process.runProcess_ proc1 22 | contents <- Text.readFile filePath 23 | Text.putStrLn contents 24 | 25 | -- 3. manually close the handle 26 | Temp.withSystemTempFile "example-manual-close" \filePath handle -> do 27 | Text.putStrLn $ Text.concat ["Created temp file ", filePath] 28 | let proc = Process.setStdout (Process.useHandleOpen handle) $ 29 | Process.proc "echo" ["hello"] 30 | Process.runProcess_ proc 31 | -- manually close the handle so we can open the file to be read 32 | IO.hClose handle 33 | contents <- Text.readFile filePath 34 | Text.putStrLn contents 35 | -------------------------------------------------------------------------------- /examples/31-open-file-handle.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | let filepath = "out.txt" 3 | handle <- IO.openFile filepath IO.WriteMode 4 | let proc = Process.setStdout (Process.useHandleClose handle) $ 5 | Process.proc "ls" ["-al"] 6 | Process.runProcess_ proc 7 | IO.hClose handle 8 | 9 | contents <- Text.readFile filepath 10 | Text.putStrLn contents 11 | -------------------------------------------------------------------------------- /examples/32-optparse.hell: -------------------------------------------------------------------------------- 1 | -- Includes example of Semigroup. 2 | data Opts = Opts { 3 | quiet :: Bool, 4 | filePath :: Maybe Text 5 | } 6 | options = 7 | (\quiet path -> Main.Opts { quiet = quiet, filePath = path }) 8 | <$> Options.switch (Flag.long "quiet" <> Flag.help "Be quiet?") 9 | <*> (Alternative.optional $ Options.strOption (Option.long "path" <> Option.help "The filepath to export")) 10 | main = do 11 | opts <- Options.execParser (Options.info (Main.options <**> Options.helper) Options.fullDesc) 12 | Text.putStrLn $ Maybe.maybe "No file path" Function.id (Record.get @"filePath" opts) 13 | Text.putStrLn $ Show.show @Bool $ Record.get @"quiet" opts 14 | -------------------------------------------------------------------------------- /examples/33-null-stream.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | -- discard stdout 3 | Process.runProcess_ $ Process.setStdout Process.nullStream $ Process.proc "ls" [] 4 | -------------------------------------------------------------------------------- /examples/34-field-puns.hell: -------------------------------------------------------------------------------- 1 | data Foo = Foo { bar, mu :: Int } 2 | main = do 3 | let bar = 123 4 | let mu = 666 5 | let r = Main.Foo{bar,mu} 6 | IO.print $ Record.get @"bar" @Int r 7 | -------------------------------------------------------------------------------- /examples/35-type-sigs.hell: -------------------------------------------------------------------------------- 1 | data Foo = Foo { bar, mu :: Int } 2 | main :: IO () = 3 | Main.foo 4 | 5 | foo = do 6 | let bar = 123 7 | let mu = 666 8 | let r = Main.Foo{bar,mu} 9 | IO.print $ (Record.get @"bar" r :: Int) 10 | -------------------------------------------------------------------------------- /examples/36-these.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | let things = [These.This 1, These.That "hello", These.These 2 "bonjour"] 3 | 4 | Monad.forM_ things $ \thing -> Text.putStrLn $ 5 | These.these 6 | (\i -> Show.show i) 7 | (\s -> s) 8 | (\i s -> Text.concat [Show.show i, " ", s]) 9 | thing 10 | -------------------------------------------------------------------------------- /examples/37-readshow.hell: -------------------------------------------------------------------------------- 1 | -- Reading and showing numbers 2 | 3 | main = do 4 | -- Reading ints and floats 5 | 6 | let mint = Int.readMaybe "123" 7 | let mdouble = Double.readMaybe "123.456" 8 | Maybe.maybe (IO.pure ()) IO.print mint 9 | Maybe.maybe (IO.pure ()) IO.print mdouble 10 | 11 | Text.putStrLn "Generic" 12 | Text.putStrLn $ Double.show 123456789.123456789 13 | Text.putStrLn $ Double.show 123.0 14 | Text.putStrLn "Scientific" 15 | Text.putStrLn $ Double.showEFloat Maybe.Nothing 123.0 "" 16 | Text.putStrLn $ Double.showEFloat Maybe.Nothing 123456789.123456789 "" 17 | Text.putStrLn $ Double.showEFloat (Maybe.Just 3) 123456789.123456789 "" 18 | Text.putStrLn "Decimal" 19 | Text.putStrLn $ Double.showFFloat Maybe.Nothing 123456789.123456789 "" 20 | Text.putStrLn $ Double.showFFloat (Maybe.Just 3) 123456789.123456789 "" 21 | Text.putStrLn $ Double.showFFloat (Maybe.Just 3) 123456789.0 "" 22 | Text.putStrLn $ Double.showFFloat Maybe.Nothing 123456789.0 "" 23 | -------------------------------------------------------------------------------- /examples/38-integer.hell: -------------------------------------------------------------------------------- 1 | -- prints: 18446744073709551614 2 | main = do 3 | IO.print $ 4 | Integer.plus 5 | (Int.toInteger 9223372036854775807) 6 | (Int.toInteger 9223372036854775807) 7 | -------------------------------------------------------------------------------- /examples/39-day.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | day1 :: Day <- 3 | Maybe.maybe (Error.error "Invalid") IO.pure $ Day.fromGregorianValid (Int.toInteger 2025) 08 09 4 | day2 <- Maybe.maybe (Error.error "Invalid") IO.pure $ Day.iso8601ParseM "2025-08-09" 5 | IO.print $ Eq.eq day1 day2 -- True 6 | Text.putStrLn $ Day.iso8601Show day1 -- 2025-08-09 7 | -------------------------------------------------------------------------------- /examples/40-utctime.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | now <- UTCTime.getCurrentTime 3 | Text.putStrLn "Current time:" 4 | IO.print now 5 | 6 | Text.putStrLn "ISO8601:" 7 | Text.putStrLn $ UTCTime.iso8601Show now 8 | 9 | Text.putStrLn "Parsed:" 10 | Maybe.maybe (Error.error "Impossible!") IO.print $ UTCTime.iso8601ParseM "2025-05-30T11:18:26.195147084Z" 11 | 12 | Text.putStrLn "Increased:" 13 | IO.print $ UTCTime.addUTCTime (Double.mult 60.0 60.0) now 14 | 15 | Text.putStrLn "Parts:" 16 | IO.print $ TimeOfDay.timeToTimeOfDay $ UTCTime.utctDayTime now 17 | IO.print $ UTCTime.utctDay now 18 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-utils": { 4 | "inputs": { 5 | "systems": "systems" 6 | }, 7 | "locked": { 8 | "lastModified": 1726560853, 9 | "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=", 10 | "owner": "numtide", 11 | "repo": "flake-utils", 12 | "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a", 13 | "type": "github" 14 | }, 15 | "original": { 16 | "owner": "numtide", 17 | "repo": "flake-utils", 18 | "type": "github" 19 | } 20 | }, 21 | "nixpkgs": { 22 | "locked": { 23 | "lastModified": 1741037377, 24 | "narHash": "sha256-SvtvVKHaUX4Owb+PasySwZsoc5VUeTf1px34BByiOxw=", 25 | "owner": "NixOS", 26 | "repo": "nixpkgs", 27 | "rev": "02032da4af073d0f6110540c8677f16d4be0117f", 28 | "type": "github" 29 | }, 30 | "original": { 31 | "owner": "NixOS", 32 | "ref": "nixpkgs-unstable", 33 | "repo": "nixpkgs", 34 | "type": "github" 35 | } 36 | }, 37 | "root": { 38 | "inputs": { 39 | "flake-utils": "flake-utils", 40 | "nixpkgs": "nixpkgs" 41 | } 42 | }, 43 | "systems": { 44 | "locked": { 45 | "lastModified": 1681028828, 46 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 47 | "owner": "nix-systems", 48 | "repo": "default", 49 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 50 | "type": "github" 51 | }, 52 | "original": { 53 | "owner": "nix-systems", 54 | "repo": "default", 55 | "type": "github" 56 | } 57 | } 58 | }, 59 | "root": "root", 60 | "version": 7 61 | } 62 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | inputs = { 3 | nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable"; 4 | flake-utils.url = "github:numtide/flake-utils"; 5 | }; 6 | 7 | outputs = { self, nixpkgs, flake-utils }: 8 | flake-utils.lib.eachDefaultSystem (system: 9 | let 10 | pkgs = nixpkgs.legacyPackages.${system}; 11 | overlay = final: prev: { 12 | hell = prev.callCabal2nix "hell" ./. { }; 13 | }; 14 | haskellPackages = pkgs.haskell.packages.ghc910.extend overlay; 15 | in 16 | { 17 | # nix build 18 | packages.default = haskellPackages.hell; 19 | 20 | # nix develop 21 | devShells.default = haskellPackages.shellFor { 22 | packages = p: [ p.hell ]; 23 | buildInputs = with haskellPackages; [ 24 | stack 25 | cabal-install 26 | haskell-language-server 27 | pandoc-cli 28 | ]; 29 | }; 30 | } 31 | ); 32 | } 33 | -------------------------------------------------------------------------------- /hell.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.37.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: hell 8 | version: 666.20250113 9 | synopsis: Haskell-based shell scripting language 10 | author: Chris Done 11 | maintainer: Chris Done 12 | copyright: 2023 Chris Done 13 | license: BSD3 14 | build-type: Simple 15 | 16 | executable hell 17 | main-is: src/Hell.hs 18 | other-modules: 19 | Paths_hell 20 | ghc-options: -Wall -Wno-missing-pattern-synonym-signatures -O2 -threaded -rtsopts 21 | build-depends: 22 | QuickCheck 23 | , aeson 24 | , async 25 | , base 26 | , bytestring 27 | , constraints 28 | , containers 29 | , directory 30 | , ghc-prim 31 | , haskell-src-exts 32 | , hspec 33 | , lucid2 34 | , mtl 35 | , optparse-applicative 36 | , syb 37 | , template-haskell 38 | , temporary 39 | , text 40 | , th-lift 41 | , th-orphans 42 | , these 43 | , time 44 | , typed-process 45 | , unliftio 46 | , vector 47 | default-language: Haskell2010 48 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: hell 2 | version: 666.20250113 3 | license: BSD3 4 | author: "Chris Done" 5 | copyright: "2023 Chris Done" 6 | synopsis: "Haskell-based shell scripting language" 7 | dependencies: 8 | - base 9 | - haskell-src-exts 10 | - ghc-prim 11 | - containers 12 | - text 13 | - bytestring 14 | - async 15 | - mtl 16 | - directory 17 | - syb 18 | - constraints 19 | - typed-process 20 | - optparse-applicative 21 | - hspec 22 | - QuickCheck 23 | - template-haskell 24 | - unliftio 25 | - vector 26 | - lucid2 27 | - th-lift 28 | - th-orphans 29 | - aeson 30 | - temporary 31 | - these 32 | - time 33 | 34 | ghc-options: 35 | - -Wall 36 | - -Wno-missing-pattern-synonym-signatures 37 | - -O2 38 | 39 | executables: 40 | hell: 41 | main: src/Hell.hs 42 | ghc-options: 43 | - -threaded 44 | - -rtsopts 45 | -------------------------------------------------------------------------------- /scripts/check-docs.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | Text.putStrLn "Checking docs are up to date ..." 3 | Directory.copyFile "docs/api/index.html" "docs/api/index.html-prev" 4 | Process.runProcess_ $ Process.proc "hell" ["scripts/gen-docs.hell"] 5 | Process.runProcess_ $ 6 | Process.proc "diff" ["docs/api/index.html", "docs/api/index.html-prev", "-q"] 7 | Text.putStrLn "Docs are up to date." 8 | -------------------------------------------------------------------------------- /scripts/check-examples.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | examples <- Directory.listDirectory "examples/" 3 | let check = \fp -> do 4 | Text.putStrLn $ Text.concat ["Checking ", fp] 5 | Process.runProcess_ (Process.proc "hell" ["--check", fp]) 6 | Monad.forM_ examples \example -> do 7 | check $ Text.concat ["examples/", example] 8 | check "scripts/static-build.hell" 9 | check "scripts/install-hell.hell" 10 | Text.putStrLn "All OK." 11 | -------------------------------------------------------------------------------- /scripts/check.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | examples <- Directory.listDirectory "examples/" 3 | let check = \fp -> do 4 | Text.putStrLn $ Text.concat ["Checking ", fp] 5 | Process.runProcess_ (Process.proc "hell" ["--check", fp]) 6 | Monad.forM_ examples \example -> do 7 | check $ Text.concat ["examples/", example] 8 | check "scripts/static-build.hell" 9 | check "scripts/install-hell.hell" 10 | Text.putStrLn "All OK." 11 | -------------------------------------------------------------------------------- /scripts/gen-docs.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | Text.putStrLn "Generating docs ..." 3 | let script = Text.unlines [":l src/Hell.hs", "_generateApiDocs", ":quit"] 4 | _out <- ByteString.readProcess_ 5 | (Text.setStdin script 6 | (Process.proc "stack" ["ghci","--no-load"])) 7 | examples <- Directory.listDirectory "examples/" 8 | let render = \fp -> do 9 | Text.putStrLn $ Text.concat ["Rendering ", fp] 10 | text <- Text.readFile fp 11 | Text.readProcessStdout_ $ Text.setStdin (Text.unlines ["```haskell",text,"```"]) (Process.proc "pandoc" ["--from","markdown","--to","html"]) 12 | frags <- Monad.forM (List.sort examples) \example -> do 13 | out <- render $ Text.concat ["examples/", example] 14 | Monad.return (example, out) 15 | css <- Text.readFile "docs/style.css" 16 | Text.writeFile "docs/examples/index.html" $ Text.concat [ 17 | "", 18 | "", 19 | "", 20 | "", 21 | "", 22 | "", 23 | "

Hell examples

", 24 | "

Back to homepage

", 25 | Text.concat $ List.map (\(fp, frag) -> Text.concat ["

", fp, "

", frag]) frags, 26 | "" 27 | ] 28 | Text.putStrLn "Generated docs." 29 | -------------------------------------------------------------------------------- /scripts/install-hell.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | Directory.copyFile "hell-linux-x86-64bit" "/usr/bin/hell" 3 | -------------------------------------------------------------------------------- /scripts/readme.md: -------------------------------------------------------------------------------- 1 | ## Build a distributable 2 | 3 | This builds a fully static musl x86-64 Linux binary. 4 | 5 | Outside of docker (because it uses Docker): 6 | 7 | hell scripts/static-build.hell 8 | 9 | At the end you should have: 10 | 11 | hell-linux-x86-64bit 12 | 13 | ## Docs 14 | 15 | Regenerate docs: 16 | 17 | stack run scripts/gen-docs.hell 18 | 19 | Or within the docker container: 20 | 21 | docker exec hell stack run scripts/gen-docs.hell 22 | 23 | Example: 24 | 25 | 25-03-04 21:41:39.839 $ docker exec hell stack run scripts/gen-docs.hell 26 | Generating docs ... 27 | Rendering examples/01-hello-world.hell 28 | Rendering examples/02-interaction.hell 29 | Rendering examples/03-press-any-key.hell 30 | Rendering examples/04-writing-files.hell 31 | Rendering examples/05-lists.hell 32 | Rendering examples/06-polymorphism.hell 33 | Rendering examples/07-loops.hell 34 | Rendering examples/08-tuples.hell 35 | Rendering examples/09-processes.hell 36 | Rendering examples/10-current-directory.hell 37 | Rendering examples/11-env-vars.hell 38 | Rendering examples/12-fib.hell 39 | Rendering examples/13-concurrency.hell 40 | Rendering examples/14-text.hell 41 | Rendering examples/15-type-classes.hell 42 | Rendering examples/16-if.hell 43 | Rendering examples/17-reuse.hell 44 | Rendering examples/18-monads.hell 45 | Rendering examples/19-blog-generator.hell 46 | Rendering examples/20-dollar.hell 47 | Rendering examples/21-json.hell 48 | Rendering examples/22-records.hell 49 | Rendering examples/23-args.hell 50 | Rendering examples/24-exitcode.hell 51 | Rendering examples/25-sum-types.hell 52 | Rendering examples/26-reference-other-types.hell 53 | Rendering examples/27-discussion-64.hell 54 | Rendering examples/28-trees.hell 55 | Rendering examples/29-temp-files.hell 56 | Rendering examples/30-process-handlers.hell 57 | Rendering examples/31-open-file-handle.hell 58 | Rendering examples/32-optparse.hell 59 | Rendering examples/33-null-stream.hell 60 | Rendering examples/34-field-puns.hell 61 | Rendering examples/35-type-sigs.hell 62 | Generated docs. 63 | -------------------------------------------------------------------------------- /scripts/static-build.hell: -------------------------------------------------------------------------------- 1 | main = do 2 | Process.runProcess_ (Process.proc "docker" ["exec", "hell", "stack", "build","--ghc-options", "-static -optl-static -fforce-recomp", "--force-dirty"]) 3 | Directory.copyFile ".stack-work/dist/x86_64-linux/ghc-9.8.2/build/hell/hell" "hell-linux-x86-64bit" 4 | Process.runProcess_ (Process.proc "strip" ["hell-linux-x86-64bit"]) 5 | pwd <- Directory.getCurrentDirectory 6 | env <- Environment.getEnvironment 7 | path <- Environment.getEnv "PATH" 8 | Process.runProcess_ $ 9 | Process.setEnv 10 | (List.cons 11 | ("PATH", 12 | Text.concat 13 | [pwd, 14 | "/.stack-work/dist/x86_64-linux/ghc-9.8.2/build/hell/", 15 | ":", 16 | path]) 17 | env) $ 18 | Process.proc "hell" ["scripts/check.hell"] 19 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: nightly-2024-10-21 2 | system-ghc: true 3 | allow-different-user: true # delete this line for Dockerfile cache re-use 4 | ghc-options: 5 | "$everything": "-split-sections -j" 6 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: 867086a789eaf6da9f48a56bb5e8bfd6df27b120023c144cc7bbec5c95717915 10 | size: 669588 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2024/10/21.yaml 12 | original: nightly-2024-10-21 13 | --------------------------------------------------------------------------------