├── generic ├── reimport-main │ └── Main.hs ├── README.md ├── test-gloss │ └── TestGloss.hs └── test-io │ └── TestIO.hs ├── cabal.project ├── fourmolu.yaml ├── diffs └── koans │ ├── basic │ ├── 1 │ │ ├── 2-fix-the-bug │ │ │ └── diff.txt │ │ ├── 4-compose │ │ │ └── diff.txt │ │ ├── 5-compose-more │ │ │ └── diff.txt │ │ ├── 8-compose-on-different-clocks │ │ │ └── diff.txt │ │ ├── 6-compose-signal-functions-and-clocks │ │ │ └── diff.txt │ │ ├── 3-faster │ │ │ └── diff.txt │ │ ├── 1-hello-rhine │ │ │ └── diff.txt │ │ └── 7-compose-on-the-same-clock │ │ │ └── diff.txt │ ├── 2 │ │ ├── 8-dont-count-everything │ │ │ └── diff.txt │ │ ├── 3-count-the-lines │ │ │ └── diff.txt │ │ ├── 1-input │ │ │ └── diff.txt │ │ ├── 2-count-the-words │ │ │ └── diff.txt │ │ ├── 5-count-all-the-chars │ │ │ └── diff.txt │ │ ├── 4-count-all-the-words │ │ │ └── diff.txt │ │ ├── 7-count-everything-nicer │ │ │ └── diff.txt │ │ ├── 6-count-everything │ │ │ └── diff.txt │ │ └── 9-modularize │ │ │ └── diff.txt │ └── 3 │ │ ├── 1-exceptions │ │ └── diff.txt │ │ ├── 2-state │ │ └── diff.txt │ │ └── 3-asynchronize │ │ └── diff.txt │ └── ui │ └── 1-gloss │ ├── 6-control-flow │ └── diff.txt │ ├── 1-circle │ └── diff.txt │ ├── 2-move │ └── diff.txt │ ├── 4-user-input │ └── diff.txt │ ├── 5-randomness │ └── diff.txt │ └── 3-modularize │ └── diff.txt ├── presentation ├── presentation.pdf ├── default.nix └── presentation.md ├── CHANGELOG.md ├── .github ├── dependabot.yml └── workflows │ ├── update-flake-lock.yml │ └── ci.yml ├── koans ├── ui │ └── 1-gloss │ │ ├── 1-circle │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ │ ├── 2-move │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ │ ├── 4-user-input │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ │ ├── 3-modularize │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ │ ├── 5-randomness │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ │ └── 6-control-flow │ │ ├── test │ │ └── Test.hs │ │ └── Koan.hs └── basic │ ├── 1 │ ├── 4-compose │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ ├── 2-fix-the-bug │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ ├── 8-compose-on-different-clocks │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ ├── 1-hello-rhine │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ ├── 5-compose-more │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ ├── 7-compose-on-the-same-clock │ │ ├── test │ │ │ └── Test.hs │ │ ├── solution │ │ │ └── Koan.hs │ │ └── Koan.hs │ ├── 3-faster │ │ ├── Koan.hs │ │ ├── solution │ │ │ └── Koan.hs │ │ └── test │ │ │ └── Test.hs │ └── 6-compose-signal-functions-and-clocks │ │ ├── test │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ └── Koan.hs │ ├── 2 │ ├── 1-input │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ ├── 3-count-the-lines │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ ├── 2-count-the-words │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ ├── 6-count-everything │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ ├── 7-count-everything-nicer │ │ ├── test │ │ │ └── Test.hs │ │ ├── solution │ │ │ └── Koan.hs │ │ └── Koan.hs │ ├── 9-modularize │ │ ├── test │ │ │ └── Test.hs │ │ ├── solution │ │ │ └── Koan.hs │ │ └── Koan.hs │ ├── 8-dont-count-everything │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ ├── 5-count-all-the-chars │ │ ├── test │ │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ │ └── Koan.hs │ └── 4-count-all-the-words │ │ ├── test │ │ └── Test.hs │ │ ├── Koan.hs │ │ └── solution │ │ └── Koan.hs │ └── 3 │ ├── 1-exceptions │ ├── test │ │ └── Test.hs │ ├── Koan.hs │ └── solution │ │ └── Koan.hs │ ├── 2-state │ ├── test │ │ └── Test.hs │ ├── Koan.hs │ └── solution │ │ └── Koan.hs │ └── 3-asynchronize │ ├── test │ └── Test.hs │ ├── Koan.hs │ └── solution │ └── Koan.hs ├── .gitignore ├── check_diffs.sh ├── TODO.md ├── LICENSE ├── flake.lock ├── README.md └── flake.nix /generic/reimport-main/Main.hs: -------------------------------------------------------------------------------- 1 | import Koan (main) 2 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | test-show-details: direct 2 | packages: rhine-koans.cabal 3 | -------------------------------------------------------------------------------- /fourmolu.yaml: -------------------------------------------------------------------------------- 1 | indentation: 2 2 | indent-wheres: true 3 | record-brace-space: true 4 | -------------------------------------------------------------------------------- /diffs/koans/basic/2/8-dont-count-everything/diff.txt: -------------------------------------------------------------------------------- 1 | < if _ 2 | > if lineCount `mod` 1000 == 0 3 | -------------------------------------------------------------------------------- /presentation/presentation.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/turion/rhine-koans/HEAD/presentation/presentation.pdf -------------------------------------------------------------------------------- /diffs/koans/basic/1/2-fix-the-bug/diff.txt: -------------------------------------------------------------------------------- 1 | < everySecond :: Millisecond 2345 2 | > everySecond :: Millisecond 1000 3 | -------------------------------------------------------------------------------- /diffs/koans/basic/2/3-count-the-lines/diff.txt: -------------------------------------------------------------------------------- 1 | < main = flow _ 2 | > main = flow $ printLineCount @@ StdinClock 3 | -------------------------------------------------------------------------------- /diffs/koans/basic/1/4-compose/diff.txt: -------------------------------------------------------------------------------- 1 | < mainComponent = _ >-> _ 2 | > mainComponent = produceMessage >-> printMessage 3 | -------------------------------------------------------------------------------- /diffs/koans/basic/2/1-input/diff.txt: -------------------------------------------------------------------------------- 1 | < parrot = userInput >-> _ Text.putStrLn 2 | > parrot = userInput >-> arrMCl Text.putStrLn 3 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for rhine-koans 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /diffs/koans/basic/1/5-compose-more/diff.txt: -------------------------------------------------------------------------------- 1 | < mainComponent = _ >>> _ >>> _ 2 | > mainComponent = produceMessage >>> exclamate >>> printMessage 3 | -------------------------------------------------------------------------------- /generic/README.md: -------------------------------------------------------------------------------- 1 | # Generic helper files 2 | 3 | These files are only here to create the structure of the Koans. 4 | You will never need to touch them 5 | -------------------------------------------------------------------------------- /diffs/koans/basic/2/2-count-the-words/diff.txt: -------------------------------------------------------------------------------- 1 | < wordCount = userInput >-> _ (Text.words >>> length) 2 | > wordCount = userInput >-> arr (Text.words >>> length) 3 | -------------------------------------------------------------------------------- /diffs/koans/basic/1/8-compose-on-different-clocks/diff.txt: -------------------------------------------------------------------------------- 1 | < mainRhine = produceRhine >-- _ --> printRhine 2 | > mainRhine = produceRhine >-- fiveToOne --> printRhine 3 | -------------------------------------------------------------------------------- /diffs/koans/ui/1-gloss/6-control-flow/diff.txt: -------------------------------------------------------------------------------- 1 | < _ 2 | > try $ liftClSF snakeAndApples >>> throwOnCond (fst >>> illegal) () >>> arr Just 3 | > safe $ pure Nothing 4 | -------------------------------------------------------------------------------- /diffs/koans/basic/1/6-compose-signal-functions-and-clocks/diff.txt: -------------------------------------------------------------------------------- 1 | < mainRhine = produceMessage >>> exclamate >>> printMessage @@ everySecond 2 | > mainRhine = produceMessage >-> exclamate >-> printMessage @@ everySecond 3 | -------------------------------------------------------------------------------- /diffs/koans/basic/2/5-count-all-the-chars/diff.txt: -------------------------------------------------------------------------------- 1 | < totalCharCount = charCount >-> _ 2 | > totalCharCount = charCount >-> sumClSF 3 | < totalWordAndCharCount = _ &&& _ 4 | > totalWordAndCharCount = totalWordCount &&& totalCharCount 5 | -------------------------------------------------------------------------------- /diffs/koans/basic/1/3-faster/diff.txt: -------------------------------------------------------------------------------- 1 | < {- | The clock _type_ specifies the rate of the clock. 2 | < type TenPerSecond = Millisecond _ 3 | < -} 4 | > -- | The clock _type_ specifies the rate of the clock. 5 | > type TenPerSecond = Millisecond 100 6 | -------------------------------------------------------------------------------- /diffs/koans/ui/1-gloss/1-circle/diff.txt: -------------------------------------------------------------------------------- 1 | < constMCl (paintAllIO _) -- paintAllIO clears the drawing canvas and draws the given image 2 | > constMCl (paintAllIO (circleSolid 10)) -- paintAllIO clears the drawing canvas and draws the given image 3 | -------------------------------------------------------------------------------- /diffs/koans/basic/1/1-hello-rhine/diff.txt: -------------------------------------------------------------------------------- 1 | < (Text.putStrLn _) -- This is the side effect to perform. Insert your message in the hole! 2 | > (Text.putStrLn "Hello Rhine!") -- This is the side effect to perform. Insert your message in the hole! 3 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | 4 | - package-ecosystem: github-actions 5 | directory: "/" 6 | schedule: 7 | interval: daily 8 | time: '00:00' 9 | timezone: UTC 10 | open-pull-requests-limit: 10 11 | -------------------------------------------------------------------------------- /diffs/koans/ui/1-gloss/2-move/diff.txt: -------------------------------------------------------------------------------- 1 | < rhine = sinceInitS >-> arrMCl (\t -> translate 0 (10 * t) $ paintAllIO $ circleSolid 10) @@ GlossSimClockIO 2 | > rhine = sinceInitS >-> arrMCl (\t -> paintAllIO $ translate 0 (10 * t) $ circleSolid 10) @@ GlossSimClockIO 3 | -------------------------------------------------------------------------------- /diffs/koans/basic/2/4-count-all-the-words/diff.txt: -------------------------------------------------------------------------------- 1 | < nextSum = _ -- What should be the state after a further line of input has arrived? 2 | > nextSum = currentInput + currentSum -- What should be the state after a further line of input has arrived? 3 | < (_, nextSum) 4 | > (nextSum, nextSum) 5 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/1-circle/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- rhine-gloss 4 | import FRP.Rhine.Gloss 5 | 6 | -- test-gloss 7 | import TestGloss 8 | 9 | -- koan 10 | import Koan (rhine) 11 | 12 | main :: IO () 13 | main = do 14 | [pic] <- stepGlossRhine rhine [1] 15 | expectPic pic [circleSolid 10] 16 | -------------------------------------------------------------------------------- /diffs/koans/basic/3/1-exceptions/diff.txt: -------------------------------------------------------------------------------- 1 | < { unhoistedClock = _ 2 | > { unhoistedClock = StdinClock 3 | < monadMorphism = _ 4 | > monadMorphism = ExceptT . Exception.try 5 | < Left e <- runExceptT $ flow $ printAllCounts @@ stdinWithEOF 6 | > Left (e :: IOError) <- runExceptT $ flow $ printAllCounts @@ stdinWithEOF 7 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-* 3 | cabal-dev 4 | *.o 5 | *.hi 6 | *.hie 7 | *.chi 8 | *.chs.h 9 | *.dyn_o 10 | *.dyn_hi 11 | .hpc 12 | .hsenv 13 | .cabal-sandbox/ 14 | cabal.sandbox.config 15 | *.prof 16 | *.aux 17 | *.hp 18 | *.eventlog 19 | .stack-work/ 20 | cabal.project.local 21 | cabal.project.local~ 22 | .HTF/ 23 | .ghc.environment.* 24 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/2-move/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- rhine-gloss 4 | import FRP.Rhine.Gloss 5 | 6 | -- test-gloss 7 | import TestGloss 8 | 9 | -- koan 10 | import Koan (rhine) 11 | 12 | main :: IO () 13 | main = do 14 | pics <- stepGlossRhine rhine [0, 1] 15 | expectPics pics [[translate 0 0 $ circleSolid 10], [translate 0 10 $ circleSolid 10]] 16 | -------------------------------------------------------------------------------- /diffs/koans/basic/1/7-compose-on-the-same-clock/diff.txt: -------------------------------------------------------------------------------- 1 | < produceMessage :: ClSF IO (Millisecond 2345) () Text 2 | > produceMessage :: ClSF IO EverySecond () Text 3 | < exclamate :: (Monad m) => ClSF m (Millisecond 3456) Text Text 4 | > exclamate :: (Monad m) => ClSF m EverySecond Text Text 5 | < printMessage :: ClSF IO (Millisecond 4567) Text () 6 | > printMessage :: ClSF IO EverySecond Text () 7 | -------------------------------------------------------------------------------- /diffs/koans/basic/2/7-count-everything-nicer/diff.txt: -------------------------------------------------------------------------------- 1 | < {-# LANGUAGE CPP #-} 2 | < 3 | < -- Disabling formatter and linter because it would fail on the syntax error otherwise. 4 | < #ifndef __HLINT__ 5 | < {- FOURMOLU_DISABLE -} 6 | < 7 | < -- Start reading here 8 | < -- vvvvvvvvvvvvvvvvvv 9 | > {-# LANGUAGE Arrows #-} 10 | < arrMCl print -< _ -- Which one is missing here? 11 | > arrMCl print -< totalCharCount 12 | < 13 | < -- Ignore the next line ;) 14 | < #endif 15 | -------------------------------------------------------------------------------- /koans/basic/1/4-compose/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- rhine-koan 4 | import Koan qualified (main) 5 | 6 | -- test-io 7 | import TestIO 8 | 9 | main :: IO () 10 | main = testForSeconds 2 Koan.main $ \output -> 11 | case length (filter (== "Hello Rhine!") output) of 12 | 2 -> [] 13 | 1 -> ["Your program seems to be running a bit slow."] 14 | 0 -> ["Your program didn't produce the line \"Hello Rhine!\" in time. Maybe a typo?"] 15 | _ -> ["It seems the clock is ticking too fast..?"] 16 | -------------------------------------------------------------------------------- /diffs/koans/basic/2/6-count-everything/diff.txt: -------------------------------------------------------------------------------- 1 | < totalCount :: ClSF IO StdinClock () _ -- What will the type of this be? 2 | < totalCount = _ &&& _ &&& _ 3 | > totalCount :: ClSF IO StdinClock () (Integer, (Int, Int)) -- What will the type of this be? 4 | > totalCount = lineCount &&& totalWordCount &&& totalCharCount 5 | < printAllCounts = totalCount >-> arrMCl (\_ -> print lines_ >> print words_ >> print chars) 6 | > printAllCounts = totalCount >-> arrMCl (\(lines_, (words_, chars)) -> print lines_ >> print words_ >> print chars) 7 | -------------------------------------------------------------------------------- /diffs/koans/ui/1-gloss/4-user-input/diff.txt: -------------------------------------------------------------------------------- 1 | < _ -> _ 2 | > (EventKey (SpecialKey KeyRight) Down _ _) -> Just TurnRight 3 | > (EventKey (SpecialKey KeyLeft) Down _ _) -> Just TurnLeft 4 | > _ -> Nothing 5 | < let newDirection = _ 6 | < newPosition = _ 7 | < in Result _ _ 8 | > let newDirection = maybe direction (`changeDirection` direction) turnMaybe 9 | > newPosition = stepPosition newDirection position 10 | > in Result (newPosition, newDirection) newPosition 11 | -------------------------------------------------------------------------------- /check_diffs.sh: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env bash 2 | 3 | set -e 4 | 5 | for koan in $(ls koans/*/*/*/Koan.hs) 6 | do 7 | mkdir -p diffs/$(dirname $koan) 8 | diff --unchanged-line-format="" --old-line-format="< %L" --new-line-format="> %L" $koan $(dirname $koan)/solution/$(basename $koan) > diffs/$(dirname $koan)/diff.txt || true 9 | done 10 | 11 | # Check that we didn't forget to check in diffs 12 | test -z "$(git ls-files --others --exclude-standard -- diffs)" 13 | 14 | # Check that the diffs haven't changed 15 | git diff --exit-code 16 | -------------------------------------------------------------------------------- /koans/basic/1/2-fix-the-bug/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- koan 4 | import Koan qualified (main) 5 | 6 | -- test-io 7 | import TestIO 8 | 9 | main :: IO () 10 | main = testForSeconds 2 Koan.main $ \output -> 11 | case length (filter (== "Hello Rhine!") output) of 12 | 2 -> [] 13 | 1 -> ["Your program seems to be running a bit slow."] 14 | 0 -> ["Your program didn't produce the line \"Hello Rhine!\" in time. Maybe a typo, or the clock is ticking too slow?"] 15 | _ -> ["It seems the clock is ticking too fast."] 16 | -------------------------------------------------------------------------------- /.github/workflows/update-flake-lock.yml: -------------------------------------------------------------------------------- 1 | name: update-flake-lock 2 | on: 3 | schedule: 4 | - cron: '0 15 * * 2' # runs weekly on Tuesday at 15:00 5 | 6 | jobs: 7 | lockfile: 8 | runs-on: ubuntu-latest 9 | steps: 10 | - name: Checkout repository 11 | uses: actions/checkout@v6 12 | - name: Install Nix 13 | uses: cachix/install-nix-action@v31 14 | - name: Update flake.lock 15 | uses: DeterminateSystems/update-flake-lock@v28 16 | with: 17 | token: ${{ secrets.GH_TOKEN_FOR_UPDATES }} 18 | -------------------------------------------------------------------------------- /diffs/koans/ui/1-gloss/5-randomness/diff.txt: -------------------------------------------------------------------------------- 1 | < arr (Just <<< Apple) <<< _ -< (Position (-boardSize) (-boardSize), Position boardSize boardSize) 2 | > arr (Just <<< Apple) <<< getRandomRS -< (Position (-boardSize) (-boardSize), Position boardSize boardSize) 3 | < addedApple <- _ -< () 4 | > addedApple <- evalRandIOS' newApple -< () 5 | < game = _ 6 | > game = feedback DontEat $ proc (turn, eat) -> do 7 | > snake <- snakeSF -< (turn, eat) 8 | > (apples, eatNext) <- applesSF -< head $ body snake 9 | > returnA -< ((snake, apples), eatNext) 10 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | # Structure 2 | 3 | * The test should maybe show a green check mark 4 | * Each Koan should have a Haddocked substructure 5 | * If bug in HLS can't be solved, provide my own hie.yaml 6 | 7 | ## CI 8 | 9 | * Check cabal outdated 10 | * Check in diffs between solution and problem and make sure it is stable (such that every fix in a solution gets propagated to the problem and vice versa) 11 | 12 | ## UI 13 | 14 | * square that rotates with time 15 | * paint, clear, paintAll: Maybe more complicated program with several paint calls, picture builds up if you forget to call clear 16 | -------------------------------------------------------------------------------- /koans/basic/2/1-input/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text 5 | 6 | -- koan 7 | import Koan qualified (main) 8 | 9 | -- test-io 10 | import TestIO 11 | 12 | testLines :: [Text] 13 | testLines = 14 | [ "Hello" 15 | , "Rhine" 16 | , "this" 17 | , "is" 18 | , "a" 19 | , "test" 20 | ] 21 | 22 | main :: IO () 23 | main = testForSecondsInput 1 testLines Koan.main $ \output -> 24 | case output of 25 | [] -> ["Weird, your program didn't produce any output!"] 26 | _ | output == testLines -> [] 27 | _ -> ["The program produced output, but it was different from the input."] 28 | -------------------------------------------------------------------------------- /koans/basic/2/3-count-the-lines/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text (Text) 5 | 6 | -- koan 7 | import Koan qualified (main) 8 | 9 | -- test-io 10 | import TestIO 11 | 12 | testLines :: [Text] 13 | testLines = 14 | [ "Hello Rhine" 15 | , "this is a" 16 | , "test" 17 | ] 18 | 19 | main :: IO () 20 | main = testForSecondsInput 1 testLines Koan.main $ \output -> 21 | case output of 22 | [] -> ["Weird, your program didn't produce any output!"] 23 | _ | output == take (length testLines) (tshow @Int <$> [1 ..]) -> [] 24 | _ -> ["The program produced output, but it wasn't quite right."] 25 | -------------------------------------------------------------------------------- /koans/basic/1/8-compose-on-different-clocks/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- rhine-koan 4 | import Koan qualified (main) 5 | 6 | -- test-io 7 | import TestIO 8 | 9 | main :: IO () 10 | main = testForSeconds 2 Koan.main $ \output -> 11 | case length (filter (== "Hello Rhine!") output) of 12 | 10 -> [] 13 | 0 -> ["Your program didn't produce the line \"Hello Rhine!\" in time. Maybe a typo?"] 14 | n 15 | | n < 10 -> 16 | [ "Your program seems to be running a bit slow." 17 | , "Only " <> tshow n <> " messages arrived." 18 | ] 19 | _ -> ["It seems the clock is ticking too fast."] 20 | -------------------------------------------------------------------------------- /koans/basic/1/1-hello-rhine/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- rhine-koan 4 | import Koan qualified (main) 5 | 6 | -- test-io 7 | import TestIO 8 | 9 | main :: IO () 10 | main = testForSeconds 2 Koan.main $ \output -> 11 | case (length output, length (filter (== "Hello Rhine!") output)) of 12 | (_, 2) -> [] 13 | (_, 1) -> ["Your program seems to be running a bit slow."] 14 | (0, 0) -> ["Your program didn't produce any output."] 15 | (_, 0) -> ["Your program produced output, but not the line \"Hello Rhine!\" in time. Maybe a typo?"] 16 | _ -> ["It seems the clock is ticking too fast..? Try only changing the message."] 17 | -------------------------------------------------------------------------------- /koans/basic/2/2-count-the-words/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text (Text) 5 | import Data.Text as Text (words) 6 | 7 | -- koan 8 | import Koan qualified (main) 9 | 10 | -- test-io 11 | import TestIO 12 | 13 | testLines :: [Text] 14 | testLines = 15 | [ "Hello Rhine" 16 | , "this is a" 17 | , "test" 18 | ] 19 | 20 | main :: IO () 21 | main = testForSecondsInput 1 testLines Koan.main $ \output -> 22 | case output of 23 | [] -> ["Weird, your program didn't produce any output!"] 24 | _ | output == (tshow . length . Text.words <$> testLines) -> [] 25 | _ -> ["The program produced output, but the lines had the wrong lengths."] 26 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/4-user-input/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- base 4 | import Control.Monad (when) 5 | import Data.List (nub) 6 | import System.Exit (exitFailure) 7 | 8 | -- gloss 9 | import Graphics.Gloss.Data.Picture 10 | 11 | -- test-gloss 12 | import TestGloss 13 | 14 | -- koan 15 | import Koan (rhine) 16 | 17 | main :: IO () 18 | main = do 19 | pics <- nub <$> stepGlossRhineWithInput rhine ((/ 30) <$> [0, 1 .. 30]) [keyRight, keyLeft] 20 | let expected = [Scale 20.0 20.0 Blank, Scale 20.0 20.0 (Translate 1.0 0.0 (ThickCircle 0.3 0.6)), Scale 20.0 20.0 (Translate 1.0 1.0 (ThickCircle 0.3 0.6))] 21 | when (pics /= expected) $ 22 | do 23 | putStrLn $ "Unexpected pictures: " ++ show pics 24 | exitFailure 25 | -------------------------------------------------------------------------------- /diffs/koans/basic/3/2-state/diff.txt: -------------------------------------------------------------------------------- 1 | < import Control.Exception qualified as Exception () 2 | > import Control.Exception qualified as Exception 3 | < import Control.Monad.Trans.Class () 4 | < import Control.Monad.Trans.State.Strict (StateT (runStateT)) 5 | > import Control.Monad.Trans.Class (lift) 6 | > import Control.Monad.Trans.State.Strict (StateT (runStateT), get, put) 7 | < monadMorphism = _ 8 | > monadMorphism = ExceptT . lift . Exception.try 9 | < _ -< _ 10 | > arrMCl $ lift . put -< (lineCount, totalWordCount, totalCharCount) 11 | < counts@(lineCount, _, _) <- constMCl _ -< () 12 | > counts@(lineCount, _, _) <- constMCl $ lift get -< () 13 | < _ @@ stdinWithEOF 14 | > putAllCounts >-> printAllCounts @@ stdinWithEOF 15 | -------------------------------------------------------------------------------- /diffs/koans/basic/3/3-asynchronize/diff.txt: -------------------------------------------------------------------------------- 1 | < let nChars = _ 2 | < nWords = _ 3 | < nLines = _ 4 | > let nChars = Text.length userInput + 1 5 | > nWords = length $ Text.words userInput 6 | > nLines = 1 7 | < arrMCl $ lift . _ 8 | > arrMCl $ lift . add 9 | < TimeInfo {} <- timeInfo -< () 10 | < arrMCl $ liftIO . print -< _ 11 | < arrMCl $ liftIO . print -< _ 12 | > TimeInfo {absolute, sinceInit} <- timeInfo -< () 13 | > arrMCl $ liftIO . print -< absolute 14 | > arrMCl $ liftIO . print -< sinceInit 15 | < counts <- constMCl $ lift _ -< () 16 | > counts <- constMCl $ lift look -< () 17 | < allCounts @@ stdinWithEOF |@| printCounts @@ _ waitClock 18 | > allCounts @@ stdinWithEOF |@| printCounts @@ ioClock waitClock 19 | -------------------------------------------------------------------------------- /koans/basic/1/2-fix-the-bug/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Fix the bug! 2 | 3 | The second task is nearly the same as the first task: 4 | Your program should again output the message "Hello Rhine!" every second. 5 | But now, there is a bug in the code somewhere, preventing the program to compile! 6 | Can you spot it and fix it? 7 | -} 8 | module Koan where 9 | 10 | -- text 11 | import Data.Text.IO as Text (putStrLn) 12 | 13 | -- rhine 14 | import FRP.Rhine 15 | 16 | -- | A clock that ticks every second. 17 | everySecond :: Millisecond 2345 18 | everySecond = waitClock 19 | 20 | -- | A component of the whole signal network. 21 | message :: ClSF IO (Millisecond 1000) () () 22 | message = constMCl (Text.putStrLn "Hello Rhine!") 23 | 24 | main :: IO () 25 | main = flow $ message @@ everySecond 26 | -------------------------------------------------------------------------------- /koans/basic/1/2-fix-the-bug/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Fix the bug! 2 | 3 | The second task is nearly the same as the first task: 4 | Your program should again output the message "Hello Rhine!" every second. 5 | But now, there is a bug in the code somewhere, preventing the program to compile! 6 | Can you spot it and fix it? 7 | -} 8 | module Koan where 9 | 10 | -- text 11 | import Data.Text.IO as Text (putStrLn) 12 | 13 | -- rhine 14 | import FRP.Rhine 15 | 16 | -- | A clock that ticks every second. 17 | everySecond :: Millisecond 1000 18 | everySecond = waitClock 19 | 20 | -- | A component of the whole signal network. 21 | message :: ClSF IO (Millisecond 1000) () () 22 | message = constMCl (Text.putStrLn "Hello Rhine!") 23 | 24 | main :: IO () 25 | main = flow $ message @@ everySecond 26 | -------------------------------------------------------------------------------- /koans/basic/2/6-count-everything/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text as Text 5 | 6 | -- koan 7 | import Koan qualified (main) 8 | 9 | -- test-io 10 | import TestIO 11 | 12 | testLines :: [Text] 13 | testLines = 14 | [ "Hello Rhine" 15 | , "this is a" 16 | , "test" 17 | ] 18 | 19 | main :: IO () 20 | main = testForSecondsInput 1 testLines Koan.main $ \output -> 21 | case output of 22 | [] -> ["Weird, your program didn't produce any output!"] 23 | _ | output == (tshow @Int <$> [1, 2, 12, 2, 5, 22, 3, 6, 27]) -> [] 24 | _ -> 25 | [ "The program produced output, but it wasn't quite right." 26 | , "It received the following input:" 27 | ] 28 | ++ testLines 29 | ++ ["And it returned:"] 30 | ++ output 31 | -------------------------------------------------------------------------------- /koans/basic/2/7-count-everything-nicer/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text as Text 5 | 6 | -- koan 7 | import Koan qualified (main) 8 | 9 | -- test-io 10 | import TestIO 11 | 12 | testLines :: [Text] 13 | testLines = 14 | [ "Hello Rhine" 15 | , "this is a" 16 | , "test" 17 | ] 18 | 19 | main :: IO () 20 | main = testForSecondsInput 1 testLines Koan.main $ \output -> 21 | case output of 22 | [] -> ["Weird, your program didn't produce any output!"] 23 | _ | output == (tshow @Int <$> [1, 2, 12, 2, 5, 22, 3, 6, 27]) -> [] 24 | _ -> 25 | [ "The program produced output, but it wasn't quite right." 26 | , "It received the following input:" 27 | ] 28 | ++ testLines 29 | ++ ["And it returned:"] 30 | ++ output 31 | -------------------------------------------------------------------------------- /diffs/koans/ui/1-gloss/3-modularize/diff.txt: -------------------------------------------------------------------------------- 1 | > -- base 2 | > import GHC.Float (double2Float) 3 | > 4 | < movingCircle = sinceInitS >-> arr (\t -> translate 0 (10 * t) $ circleSolid 10) -- realToFrac works as well! 5 | > movingCircle = sinceInitS >-> arr (\t -> translate 0 (10 * double2Float t) $ circleSolid 10) -- realToFrac works as well! 6 | < _ (Millisecond 500) 7 | > GlossConcTClock IO (Millisecond 500) 8 | < gameClock = _ waitClock 9 | > gameClock = glossConcTClock waitClock 10 | < _ _ GlossSimClockIO 11 | > GlossClockUTC IO GlossSimClockIO 12 | < visualizationClock = _ GlossSimClockIO 13 | > visualizationClock = glossClockUTC GlossSimClockIO 14 | < rhine = movingCircle @@ gameClock >-- _ blank --> visualize @@ visualizationClock 15 | > rhine = movingCircle @@ gameClock >-- keepLast blank --> visualize @@ visualizationClock 16 | -------------------------------------------------------------------------------- /koans/basic/2/9-modularize/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text as Text (Text) 5 | 6 | -- koan 7 | import Koan qualified (main) 8 | 9 | -- test-io 10 | import TestIO 11 | 12 | testLines :: [Text] 13 | testLines = 14 | [ "Hello Rhine" 15 | , "this is a" 16 | , "test" 17 | ] 18 | 19 | main :: IO () 20 | main = testForSecondsInput 1 (concat $ replicate 1000 testLines) Koan.main $ \output -> 21 | case output of 22 | [] -> ["Weird, your program didn't produce any output!"] 23 | _ | output == (tshow @Int <$> [1000, 2000, 9003, 2000, 4001, 18004, 3000, 6000, 27000]) -> [] 24 | _ -> 25 | [ "The program produced output, but it wasn't quite right." 26 | , "It received the following input a 1000 times:" 27 | ] 28 | ++ testLines 29 | ++ ["And it returned:"] 30 | ++ output 31 | -------------------------------------------------------------------------------- /koans/basic/2/8-dont-count-everything/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text as Text (Text) 5 | 6 | -- koan 7 | import Koan qualified (main) 8 | 9 | -- test-io 10 | import TestIO 11 | 12 | testLines :: [Text] 13 | testLines = 14 | [ "Hello Rhine" 15 | , "this is a" 16 | , "test" 17 | ] 18 | 19 | main :: IO () 20 | main = testForSecondsInput 1 (concat $ replicate 1000 testLines) Koan.main $ \output -> 21 | case output of 22 | [] -> ["Weird, your program didn't produce any output!"] 23 | _ | output == (tshow @Int <$> [1000, 2000, 9003, 2000, 4001, 18004, 3000, 6000, 27000]) -> [] 24 | _ -> 25 | [ "The program produced output, but it wasn't quite right." 26 | , "It received the following input a 1000 times:" 27 | ] 28 | ++ testLines 29 | ++ ["And it returned:"] 30 | ++ output 31 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/3-modularize/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- base 4 | import Control.Monad (when) 5 | import Data.List (nub) 6 | import System.Exit (exitFailure) 7 | 8 | -- gloss 9 | import Graphics.Gloss.Data.Picture 10 | 11 | -- test-gloss 12 | import TestGloss 13 | 14 | -- koan 15 | import Koan (rhine) 16 | 17 | main :: IO () 18 | main = do 19 | pics <- stepGlossRhine rhine $ (/ 30) <$> [0, 1 .. 30] 20 | case nub pics of 21 | [Blank, Translate 0 fiveish (ThickCircle 5.0 10.0), Translate 0 tenish (ThickCircle 5.0 10.0)] -> 22 | when (fiveish < 5 || fiveish > 6 || tenish < 10 || tenish > 11) $ do 23 | putStrLn "Those were the right pictures, but the speed at which they moved seems off." 24 | exitFailure 25 | unexpectedPics -> do 26 | putStrLn $ "Unexpected pictures: " ++ show unexpectedPics 27 | exitFailure 28 | -------------------------------------------------------------------------------- /koans/basic/1/5-compose-more/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- rhine-koan 4 | import Koan qualified (main) 5 | 6 | -- test-io 7 | import TestIO 8 | 9 | main :: IO () 10 | main = testForSeconds 2 Koan.main $ \output -> 11 | let errorsWithExcl = case length (filter (== "Hello Rhine!") output) of 12 | 2 -> [] 13 | 1 -> ["Your program seems to be running a bit slow."] 14 | 0 -> ["Your program didn't produce the line \"Hello Rhine!\" in time. Maybe a typo?"] 15 | _ -> ["It seems the clock is ticking too fast."] 16 | errorsWithoutExcl = case length (filter (== "Hello Rhine") output) of 17 | 0 -> [] 18 | _ -> 19 | [ "Your program produced the line \"Hello Rhine\", _without_ the exclamation mark!" 20 | , "Try adding it with the exclamate function" 21 | ] 22 | in errorsWithExcl <> errorsWithoutExcl 23 | -------------------------------------------------------------------------------- /koans/basic/1/7-compose-on-the-same-clock/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- rhine-koan 4 | import Koan qualified (main) 5 | 6 | -- test-io 7 | import TestIO 8 | 9 | main :: IO () 10 | main = testForSeconds 2 Koan.main $ \output -> 11 | let errorsWithExcl = case length (filter (== "Hello Rhine!") output) of 12 | 2 -> [] 13 | 1 -> ["Your program seems to be running a bit slow."] 14 | 0 -> ["Your program didn't produce the line \"Hello Rhine!\" in time. Maybe a typo?"] 15 | _ -> ["It seems the clock is ticking too fast."] 16 | errorsWithoutExcl = case length (filter (== "Hello Rhine") output) of 17 | 0 -> [] 18 | _ -> 19 | [ "Your program produced the line \"Hello Rhine\", _without_ the exclamation mark!" 20 | , "Try adding it with the exclamate function" 21 | ] 22 | in errorsWithExcl <> errorsWithoutExcl 23 | -------------------------------------------------------------------------------- /koans/basic/2/3-count-the-lines/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Count the lines. 2 | 3 | Signal functions can have information about the past by storing internal state. 4 | For example, we can count the number of lines that have been entered so far. 5 | -} 6 | module Koan where 7 | 8 | -- rhine 9 | import FRP.Rhine 10 | 11 | {- | The number of lines of input so far. 12 | 13 | The 'count' signal function has internal state, the current count. 14 | Every time it is called (because 'StdinClock' has ticked), 15 | the count is incremented and returned. 16 | -} 17 | lineCount :: ClSF IO StdinClock () Int 18 | lineCount = count -- This is part of the library! 19 | 20 | -- | Print the number of the line that was just entered. 21 | printLineCount :: ClSF IO StdinClock () () 22 | printLineCount = lineCount >-> arrMCl print 23 | 24 | main :: IO () 25 | -- Recap: Do you remember how to make a 'Rhine' from a 'ClSF'? 26 | main = flow _ 27 | -------------------------------------------------------------------------------- /koans/basic/2/2-count-the-words/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Count the words. 2 | 3 | With any clock, you can treat the 'Tag' like any other data. 4 | For example, you can apply any function to the console input. 5 | -} 6 | module Koan where 7 | 8 | -- text 9 | import Data.Text (Text) 10 | import Data.Text as Text (words) 11 | 12 | -- rhine 13 | import FRP.Rhine 14 | 15 | -- | A line of user input. 16 | userInput :: ClSF IO StdinClock () Text 17 | userInput = tagS 18 | 19 | -- | Output the number of words of the line that was just entered. 20 | wordCount :: ClSF IO StdinClock () Int 21 | -- Do you remember how to convert a pure function into a ClSF? 22 | wordCount = userInput >-> _ (Text.words >>> length) 23 | 24 | -- | Print the number of words of the line that was just entered. 25 | printWordCount :: ClSF IO StdinClock () () 26 | printWordCount = wordCount >-> arrMCl print 27 | 28 | main :: IO () 29 | main = flow $ printWordCount @@ StdinClock 30 | -------------------------------------------------------------------------------- /koans/basic/2/2-count-the-words/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Count the words. 2 | 3 | With any clock, you can treat the 'Tag' like any other data. 4 | For example, you can apply any function to the console input. 5 | -} 6 | module Koan where 7 | 8 | -- text 9 | import Data.Text (Text) 10 | import Data.Text as Text (words) 11 | 12 | -- rhine 13 | import FRP.Rhine 14 | 15 | -- | A line of user input. 16 | userInput :: ClSF IO StdinClock () Text 17 | userInput = tagS 18 | 19 | -- | Output the number of words of the line that was just entered. 20 | wordCount :: ClSF IO StdinClock () Int 21 | -- Do you remember how to convert a pure function into a ClSF? 22 | wordCount = userInput >-> arr (Text.words >>> length) 23 | 24 | -- | Print the number of words of the line that was just entered. 25 | printWordCount :: ClSF IO StdinClock () () 26 | printWordCount = wordCount >-> arrMCl print 27 | 28 | main :: IO () 29 | main = flow $ printWordCount @@ StdinClock 30 | -------------------------------------------------------------------------------- /koans/basic/2/3-count-the-lines/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Count the lines. 2 | 3 | Signal functions can have information about the past by storing internal state. 4 | For example, we can count the number of lines that have been entered so far. 5 | -} 6 | module Koan where 7 | 8 | -- rhine 9 | import FRP.Rhine 10 | 11 | {- | The number of lines of input so far. 12 | 13 | The 'count' signal function has internal state, the current count. 14 | Every time it is called (because 'StdinClock' has ticked), 15 | the count is incremented and returned. 16 | -} 17 | lineCount :: ClSF IO StdinClock () Int 18 | lineCount = count -- This is part of the library! 19 | 20 | -- | Print the number of the line that was just entered. 21 | printLineCount :: ClSF IO StdinClock () () 22 | printLineCount = lineCount >-> arrMCl print 23 | 24 | main :: IO () 25 | -- Recap: Do you remember how to make a 'Rhine' from a 'ClSF'? 26 | main = flow $ printLineCount @@ StdinClock 27 | -------------------------------------------------------------------------------- /koans/basic/2/5-count-all-the-chars/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text as Text 5 | 6 | -- koan 7 | import Koan qualified (main) 8 | 9 | -- test-io 10 | import TestIO 11 | 12 | testLines :: [Text] 13 | testLines = 14 | [ "Hello Rhine" 15 | , "this is a" 16 | , "test" 17 | ] 18 | 19 | main :: IO () 20 | main = testForSecondsInput 1 testLines Koan.main $ \output -> 21 | case output of 22 | [] -> ["Weird, your program didn't produce any output!"] 23 | _ | output == (tshow @Int <$> [2, 12, 5, 22, 6, 27]) -> [] 24 | _ 25 | | output == (tshow @Int <$> [12, 2, 22, 5, 27, 6]) -> 26 | ["Nearly there, it seems you've swapped characters and words around."] 27 | _ -> 28 | [ "The program produced output, but it wasn't quite right." 29 | , "It received the following input:" 30 | ] 31 | ++ testLines 32 | ++ ["And it returned:"] 33 | ++ output 34 | -------------------------------------------------------------------------------- /koans/basic/2/4-count-all-the-words/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text 5 | 6 | -- koan 7 | import Koan qualified (main) 8 | 9 | -- test-io 10 | import TestIO 11 | 12 | testLines :: [Text] 13 | testLines = 14 | [ "Hello Rhine" 15 | , "this is a" 16 | , "test" 17 | ] 18 | 19 | main :: IO () 20 | main = testForSecondsInput 1 testLines Koan.main $ \output -> 21 | case output of 22 | [] -> ["Weird, your program didn't produce any output!"] 23 | _ | output == (tshow @Int <$> [2, 5, 6]) -> [] 24 | _ 25 | | output == (tshow @Int <$> [0, 2, 5]) -> 26 | [ "Your program seems to be counting the words, but only the past ones!" 27 | , "Can you make sure it includes the current line as well?" 28 | ] 29 | _ | output == (tshow @Int <$> [2, 3, 1]) -> ["Your program seems to be counting the words, but it doesn't return their sum!"] 30 | _ -> ["The program produced output, but it wasn't quite right."] 31 | -------------------------------------------------------------------------------- /koans/basic/3/1-exceptions/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text as Text (Text) 5 | 6 | -- koan 7 | import Koan qualified (main) 8 | 9 | -- test-io 10 | import TestIO 11 | 12 | testLines :: [Text] 13 | testLines = 14 | [ "Hello Rhine" 15 | , "this is a" 16 | , "test" 17 | ] 18 | 19 | main :: IO () 20 | main = testForSecondsInput 1 (concat $ replicate 1000 testLines) Koan.main $ \output -> 21 | case output of 22 | [] -> ["Weird, your program didn't produce any output!"] 23 | _ 24 | | output 25 | == (tshow @Int <$> [1000, 2000, 9003, 2000, 4001, 18004, 3000, 6000, 27000]) 26 | ++ ["The following error occurred: : hGetLine: end of file"] -> 27 | [] 28 | _ -> 29 | [ "The program produced output, but it wasn't quite right." 30 | , "It received the following input a 1000 times:" 31 | ] 32 | ++ testLines 33 | ++ ["And it returned:"] 34 | ++ output 35 | -------------------------------------------------------------------------------- /koans/basic/1/3-faster/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Faster! 2 | 3 | Maybe you've already noticed: In Rhine, clock rates are specified _on the type level_. 4 | This means, that we can write clock types in a type signature, or also in a type synonym. 5 | Often, the code becomes more readable if we use type synonyms. 6 | 7 | Now, can you output the message "Hello Rhine!" _ten times_ per second? 8 | -} 9 | module Koan where 10 | 11 | -- text 12 | import Data.Text.IO as Text (putStrLn) 13 | 14 | -- rhine 15 | import FRP.Rhine 16 | 17 | -- Can you complete this? 18 | 19 | {- | The clock _type_ specifies the rate of the clock. 20 | type TenPerSecond = Millisecond _ 21 | -} 22 | 23 | -- | A clock that ticks 10 times second. 24 | tenPerSecond :: TenPerSecond 25 | tenPerSecond = waitClock 26 | 27 | -- | A component of the whole signal network. 28 | message :: ClSF IO TenPerSecond () () 29 | message = constMCl (Text.putStrLn "Hello Rhine!") 30 | 31 | main :: IO () 32 | main = flow $ message @@ tenPerSecond 33 | -------------------------------------------------------------------------------- /koans/basic/1/3-faster/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Faster! 2 | 3 | Maybe you've already noticed: In Rhine, clock rates are specified _on the type level_. 4 | This means, that we can write clock types in a type signature, or also in a type synonym. 5 | Often, the code becomes more readable if we use type synonyms. 6 | 7 | Now, can you output the message "Hello Rhine!" _ten times_ per second? 8 | -} 9 | module Koan where 10 | 11 | -- text 12 | import Data.Text.IO as Text (putStrLn) 13 | 14 | -- rhine 15 | import FRP.Rhine 16 | 17 | -- Can you complete this? 18 | 19 | -- | The clock _type_ specifies the rate of the clock. 20 | type TenPerSecond = Millisecond 100 21 | 22 | -- | A clock that ticks 10 times second. 23 | tenPerSecond :: TenPerSecond 24 | tenPerSecond = waitClock 25 | 26 | -- | A component of the whole signal network. 27 | message :: ClSF IO TenPerSecond () () 28 | message = constMCl (Text.putStrLn "Hello Rhine!") 29 | 30 | main :: IO () 31 | main = flow $ message @@ tenPerSecond 32 | -------------------------------------------------------------------------------- /koans/basic/1/6-compose-signal-functions-and-clocks/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text as Text (pack) 5 | 6 | -- rhine-koan 7 | import Koan qualified (main) 8 | 9 | -- test-io 10 | import TestIO 11 | 12 | main :: IO () 13 | main = testForSeconds 2 Koan.main $ \output -> 14 | let errorsWithExcl = case length (filter (== "Hello Rhine!") output) of 15 | 2 -> [] 16 | 1 -> ["Your program seems to be running a bit slow."] 17 | 0 -> ["Your program didn't produce the line \"Hello Rhine!\" in time. Maybe a typo?"] 18 | n -> ["It seems the clock is ticking too fast.", "In two seconds, it ticked " <> Text.pack (show n) <> " times!"] 19 | errorsWithoutExcl = case length (filter (== "Hello Rhine") output) of 20 | 0 -> [] 21 | _ -> 22 | [ "Your program produced the line \"Hello Rhine\", _without_ the exclamation mark!" 23 | , "Try adding it with the exclamate function" 24 | ] 25 | in errorsWithExcl <> errorsWithoutExcl 26 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2023 Manuel Bärenz 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /koans/basic/2/8-dont-count-everything/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | Don't count everything. 4 | 5 | Arrow notation can have case expressions, and also if-then-else syntax. 6 | You can use it to conditionally execute an effectful stream function. 7 | -} 8 | module Koan where 9 | 10 | -- text 11 | import Data.Text qualified as Text (length, words) 12 | 13 | -- rhine 14 | import FRP.Rhine hiding (currentInput) 15 | 16 | -- | On every 1000th line, print the number of total lines, words and characters so far. 17 | printAllCounts :: ClSF IO StdinClock () () 18 | printAllCounts = proc () -> do 19 | userInput <- tagS -< () 20 | 21 | let wordCount = length $ Text.words userInput 22 | charCount = Text.length userInput + 1 23 | 24 | lineCount <- count @Int -< () 25 | totalWordCount <- sumN -< wordCount 26 | totalCharCount <- sumN -< charCount 27 | 28 | -- Only trigger the then-branch on every 1000th line! 29 | if _ 30 | then do 31 | arrMCl print -< lineCount 32 | arrMCl print -< totalWordCount 33 | arrMCl print -< totalCharCount 34 | else returnA -< () 35 | 36 | main :: IO () 37 | main = flow $ printAllCounts @@ StdinClock 38 | -------------------------------------------------------------------------------- /koans/basic/2/8-dont-count-everything/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | Don't count everything. 4 | 5 | Arrow notation can have case expressions, and also if-then-else syntax. 6 | You can use it to conditionally execute an effectful stream function. 7 | -} 8 | module Koan where 9 | 10 | -- text 11 | import Data.Text qualified as Text (length, words) 12 | 13 | -- rhine 14 | import FRP.Rhine hiding (currentInput) 15 | 16 | -- | On every 1000th line, print the number of total lines, words and characters so far. 17 | printAllCounts :: ClSF IO StdinClock () () 18 | printAllCounts = proc () -> do 19 | userInput <- tagS -< () 20 | 21 | let wordCount = length $ Text.words userInput 22 | charCount = Text.length userInput + 1 23 | 24 | lineCount <- count @Int -< () 25 | totalWordCount <- sumN -< wordCount 26 | totalCharCount <- sumN -< charCount 27 | 28 | -- Only trigger the then-branch on every 1000th line! 29 | if lineCount `mod` 1000 == 0 30 | then do 31 | arrMCl print -< lineCount 32 | arrMCl print -< totalWordCount 33 | arrMCl print -< totalCharCount 34 | else returnA -< () 35 | 36 | main :: IO () 37 | main = flow $ printAllCounts @@ StdinClock 38 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/2-move/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Move. 2 | 3 | One central idea of Functional Reactive Animation (Conal Elliot & Paul Hudak, ICFP 1997) 4 | is that an animation is a picture parametrised by time. 5 | This idea is continued in Yampa and Rhine by providing knowledge of time as a builtin effect, 6 | which can then be used to parametrise everything the program does. 7 | 8 | In Rhine, one way to access time is to use ['sinceInitS'](https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-ClSF-Util.html#v:sinceInitS), 9 | which outputs the time since clock initialisation (which happens at the beginning of 'flow'). 10 | When you use this time to translate the position of the circle, it will move! 11 | -} 12 | module Koan where 13 | 14 | -- rhine 15 | import FRP.Rhine 16 | 17 | -- rhine-gloss 18 | import FRP.Rhine.Gloss 19 | 20 | -- | The main 'Rhine' of this program. 21 | rhine :: Rhine GlossConc GlossSimClockIO () () 22 | -- Somehow the order of these functions is wrong. Can you fix it? 23 | rhine = sinceInitS >-> arrMCl (\t -> translate 0 (10 * t) $ paintAllIO $ circleSolid 10) @@ GlossSimClockIO 24 | 25 | main :: IO () 26 | -- Make sure to keep this definition here as it is: The tests depend on it. 27 | main = flowGlossIO defaultSettings rhine 28 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/2-move/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Move. 2 | 3 | One central idea of Functional Reactive Animation (Conal Elliot & Paul Hudak, ICFP 1997) 4 | is that an animation is a picture parametrised by time. 5 | This idea is continued in Yampa and Rhine by providing knowledge of time as a builtin effect, 6 | which can then be used to parametrise everything the program does. 7 | 8 | In Rhine, one way to access time is to use ['sinceInitS'](https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-ClSF-Util.html#v:sinceInitS), 9 | which outputs the time since clock initialisation (which happens at the beginning of 'flow'). 10 | When you use this time to translate the position of the circle, it will move! 11 | -} 12 | module Koan where 13 | 14 | -- rhine 15 | import FRP.Rhine 16 | 17 | -- rhine-gloss 18 | import FRP.Rhine.Gloss 19 | 20 | -- | The main 'Rhine' of this program. 21 | rhine :: Rhine GlossConc GlossSimClockIO () () 22 | -- Somehow the order of these functions is wrong. Can you fix it? 23 | rhine = sinceInitS >-> arrMCl (\t -> paintAllIO $ translate 0 (10 * t) $ circleSolid 10) @@ GlossSimClockIO 24 | 25 | main :: IO () 26 | -- Make sure to keep this definition here as it is: The tests depend on it. 27 | main = flowGlossIO defaultSettings rhine 28 | -------------------------------------------------------------------------------- /presentation/default.nix: -------------------------------------------------------------------------------- 1 | { pkgs, nix-mkPandoc }: 2 | 3 | let 4 | inherit (pkgs) lib; 5 | inherit (lib.debug) traceVal; 6 | mkPandoc = import nix-mkPandoc { 7 | inherit pkgs; 8 | }; 9 | title = "presentation"; 10 | opts = { 11 | src = ./.; 12 | documentFile = ./. + "/${title}.md"; 13 | version = "0.1.0"; 14 | incremental = true; 15 | }; 16 | myMkPandoc = specificOpts: mkPandoc (specificOpts // opts); 17 | beamer = myMkPandoc { 18 | name = "${title}.pdf"; 19 | texlivePackages = { 20 | inherit (pkgs.texlive) 21 | fancyvrb 22 | beamer 23 | xcolor; 24 | }; 25 | to = "beamer"; 26 | variables = { 27 | theme = "Frankfurt"; 28 | colortheme = "beaver"; 29 | }; 30 | }; 31 | revealjs = myMkPandoc { 32 | name = "${title}.html"; 33 | to = "revealjs"; 34 | variables = { 35 | theme = "serif"; 36 | revealjs-url = builtins.fetchTarball { 37 | url = "https://registry.npmjs.org/reveal.js/-/reveal.js-4.1.3.tgz"; 38 | sha256 = "0a93vxd49y2g0wsafghgqcpj6gszzjvv9lql5zrwrw26lc02x465"; 39 | }; 40 | standalone = true; 41 | embed-resources = true; 42 | }; 43 | }; 44 | in 45 | pkgs.linkFarmFromDrvs title [ beamer ] 46 | -------------------------------------------------------------------------------- /koans/basic/1/3-faster/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- koan 4 | import Koan qualified (main) 5 | 6 | -- test-io 7 | import TestIO 8 | 9 | main :: IO () 10 | main = testForSeconds 2 Koan.main $ \output -> 11 | case length (filter (== "Hello Rhine!") output) of 12 | n 13 | | 19 <= n && n <= 21 -> [] 14 | 0 -> ["Your program didn't produce the line \"Hello Rhine!\" in time. Maybe a typo, or the clock is ticking too slow?"] 15 | n 16 | | 190 <= n && n <= 210 -> 17 | [ "It seems the clock is ticking ten times too fast." 18 | , "(Hint: If you write 'Millisecond 10', it means that 10 ms pass between two ticks." 19 | , "A second has 1000 milliseconds, so your clock ticked about a 100 times per second.)" 20 | ] 21 | n 22 | | n < 190 -> 23 | [ "The clock ticked and the program produced the right output, but it was too slow:" 24 | , avgLengthMsg n 25 | ] 26 | n -> 27 | [ "The clock ticked and the program produced the right output, but it was too fast." 28 | , avgLengthMsg n 29 | ] 30 | where 31 | avgLengthMsg n = "The average length between two ticks was " <> tshow (round (2000 / fromIntegral n :: Double) :: Int) <> " milliseconds." 32 | -------------------------------------------------------------------------------- /koans/basic/1/7-compose-on-the-same-clock/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Compose on the same clock. 2 | 3 | You have seen before how important it is to get the rate of a clock right. 4 | What if we tried to compose components that are specified to run at different rates? 5 | This cannot work correctly! And therefore, it is forbidden in Rhine. 6 | See the type error for yourself! 7 | Can you fix the program such that all components run at one message per second again? 8 | -} 9 | module Koan where 10 | 11 | -- text 12 | import Data.Text (Text) 13 | import Data.Text.IO as Text (putStrLn) 14 | 15 | -- rhine 16 | import FRP.Rhine 17 | 18 | -- | We will react every second. 19 | type EverySecond = Millisecond 1000 20 | 21 | -- | The clock value for our clock. 22 | everySecond :: EverySecond 23 | everySecond = waitClock 24 | 25 | -- | Produce an incomplete message. 26 | produceMessage :: ClSF IO EverySecond () Text 27 | produceMessage = arr $ const "Hello Rhine" 28 | 29 | -- | Add an exclamation mark ("!") to a Text. 30 | exclamate :: (Monad m) => ClSF m EverySecond Text Text 31 | exclamate = arr (<> "!") 32 | 33 | -- | Outputs a message every second. 34 | printMessage :: ClSF IO EverySecond Text () 35 | printMessage = arrMCl Text.putStrLn 36 | 37 | -- | A complete Rhine program that prints "Hello Rhine!" every second. 38 | mainRhine :: Rhine IO EverySecond () () 39 | mainRhine = produceMessage >-> exclamate >-> printMessage @@ everySecond 40 | 41 | main :: IO () 42 | main = flow mainRhine 43 | -------------------------------------------------------------------------------- /koans/basic/1/7-compose-on-the-same-clock/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Compose on the same clock. 2 | 3 | You have seen before how important it is to get the rate of a clock right. 4 | What if we tried to compose components that are specified to run at different rates? 5 | This cannot work correctly! And therefore, it is forbidden in Rhine. 6 | See the type error for yourself! 7 | Can you fix the program such that all components run at one message per second again? 8 | -} 9 | module Koan where 10 | 11 | -- text 12 | import Data.Text (Text) 13 | import Data.Text.IO as Text (putStrLn) 14 | 15 | -- rhine 16 | import FRP.Rhine 17 | 18 | -- | We will react every second. 19 | type EverySecond = Millisecond 1000 20 | 21 | -- | The clock value for our clock. 22 | everySecond :: EverySecond 23 | everySecond = waitClock 24 | 25 | -- | Produce an incomplete message. 26 | produceMessage :: ClSF IO (Millisecond 2345) () Text 27 | produceMessage = arr $ const "Hello Rhine" 28 | 29 | -- | Add an exclamation mark ("!") to a Text. 30 | exclamate :: (Monad m) => ClSF m (Millisecond 3456) Text Text 31 | exclamate = arr (<> "!") 32 | 33 | -- | Outputs a message every second. 34 | printMessage :: ClSF IO (Millisecond 4567) Text () 35 | printMessage = arrMCl Text.putStrLn 36 | 37 | -- | A complete Rhine program that prints "Hello Rhine!" every second. 38 | mainRhine :: Rhine IO EverySecond () () 39 | mainRhine = produceMessage >-> exclamate >-> printMessage @@ everySecond 40 | 41 | main :: IO () 42 | main = flow mainRhine 43 | -------------------------------------------------------------------------------- /koans/basic/2/9-modularize/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | Modularize. 4 | 5 | Let's clean up the code. Ideally, we don't have one big monolithic function, 6 | but rather several reusable, independent ones. 7 | A typical pattern is to separate computations from side effects, so let us do that here! 8 | -} 9 | module Koan where 10 | 11 | -- text 12 | import Data.Text qualified as Text (length, words) 13 | 14 | -- rhine 15 | import FRP.Rhine hiding (currentInput) 16 | 17 | -- | Count the number of lines, words and chars. 18 | allCounts :: ClSF IO StdinClock () (Int, Int, Int) 19 | allCounts = proc () -> do 20 | userInput <- tagS -< () 21 | 22 | let wordCount = length $ Text.words userInput 23 | charCount = Text.length userInput + 1 24 | 25 | lineCount <- count @Int -< () 26 | totalWordCount <- sumN -< wordCount 27 | totalCharCount <- sumN -< charCount 28 | returnA -< (lineCount, totalWordCount, totalCharCount) 29 | 30 | -- | Print the three counts. 31 | printCounts :: ClSF IO StdinClock (Int, Int, Int) () 32 | printCounts = proc (lineCount, totalWordCount, totalCharCount) -> do 33 | arrMCl print -< lineCount 34 | arrMCl print -< totalWordCount 35 | arrMCl print -< totalCharCount 36 | 37 | -- | On every 1000th line, print the number of total lines, words and characters so far. 38 | printAllCounts :: ClSF IO StdinClock () () 39 | printAllCounts = proc () -> do 40 | counts@(lineCount, _, _) <- allCounts -< () 41 | if lineCount `mod` 1000 == 0 42 | then printCounts -< counts 43 | else returnA -< () 44 | 45 | main :: IO () 46 | main = flow $ printAllCounts @@ StdinClock 47 | -------------------------------------------------------------------------------- /diffs/koans/basic/2/9-modularize/diff.txt: -------------------------------------------------------------------------------- 1 | < allCounts = _ 2 | < 3 | < -- | Print the three counts. 4 | < printCounts :: ClSF IO StdinClock (Int, Int, Int) () 5 | < printCounts = proc (lineCount, totalWordCount, totalCharCount) -> do 6 | < _ -< _ 7 | < 8 | < -- | On every 1000th line, print the number of total lines, words and characters so far. 9 | < printAllCounts :: ClSF IO StdinClock () () 10 | < printAllCounts = proc () -> do 11 | < counts@(lineCount, _, _) <- _ -< () 12 | < if lineCount `mod` 1000 == 0 13 | < then _ -< counts 14 | < else returnA -< () 15 | < 16 | < -- For reference, here is the previous implementation. 17 | < -- Can you reuse its pieces to implement the holes above? 18 | < 19 | < -- | On every 1000th line, print the number of total lines, words and characters so far. 20 | < printAllCountsMonolith :: ClSF IO StdinClock () () 21 | < printAllCountsMonolith = proc () -> do 22 | > allCounts = proc () -> do 23 | > returnA -< (lineCount, totalWordCount, totalCharCount) 24 | > -- | Print the three counts. 25 | > printCounts :: ClSF IO StdinClock (Int, Int, Int) () 26 | > printCounts = proc (lineCount, totalWordCount, totalCharCount) -> do 27 | > arrMCl print -< lineCount 28 | > arrMCl print -< totalWordCount 29 | > arrMCl print -< totalCharCount 30 | > 31 | > -- | On every 1000th line, print the number of total lines, words and characters so far. 32 | > printAllCounts :: ClSF IO StdinClock () () 33 | > printAllCounts = proc () -> do 34 | > counts@(lineCount, _, _) <- allCounts -< () 35 | < then do 36 | < arrMCl print -< lineCount 37 | < arrMCl print -< totalWordCount 38 | < arrMCl print -< totalCharCount 39 | > then printCounts -< counts 40 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/1-circle/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Circle. 2 | 3 | Let's draw something! 4 | Rhine connects to the famous gloss library for 2d graphics. 5 | Have a look at https://hackage.haskell.org/package/gloss to learn more about it! 6 | 7 | The connection between Rhine and gloss is provided by the library https://hackage.haskell.org/package/rhine-gloss, 8 | which encapsulates the effects of drawing pictures in gloss in a monad, 'GlossConcT', 9 | and provides several clocks to interact with the gloss system. 10 | 11 | To warm up, let's just draw a circle. 12 | -} 13 | module Koan where 14 | 15 | -- rhine 16 | import FRP.Rhine 17 | 18 | -- rhine-gloss 19 | import FRP.Rhine.Gloss 20 | 21 | {- | The main 'Rhine' of this program. 22 | 23 | /--- We use effects in 'GlossConc' to draw images. 24 | | 25 | | /--- This clock ticks whenever an image is drawn on the screen by the gloss backend. 26 | | | 27 | v v 28 | -} 29 | rhine :: Rhine GlossConc GlossSimClockIO () () 30 | -- Can you create a solid circle of radius 10 here? 31 | -- Have a look at https://hackage.haskell.org/package/gloss/docs/Graphics-Gloss-Data-Picture.html for inspiration. 32 | rhine = 33 | constMCl (paintAllIO _) -- paintAllIO clears the drawing canvas and draws the given image 34 | @@ GlossSimClockIO -- The singleton value of GlossSimClockIO. 35 | 36 | main :: IO () 37 | -- Make sure to keep this definition here as it is: The tests depend on it. 38 | main = 39 | flowGlossIO -- This function can replace 'flow' when you're using the gloss backend. 40 | defaultSettings -- Settings for the gloss window context such as size, title, and background colour. 41 | rhine 42 | -------------------------------------------------------------------------------- /koans/basic/3/2-state/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- text 4 | import Data.Text as Text (Text) 5 | 6 | -- koan 7 | import Koan qualified (main) 8 | 9 | -- test-io 10 | import TestIO 11 | 12 | testLines :: [Text] 13 | testLines = 14 | [ "Hello Rhine" 15 | , "this is a" 16 | , "test" 17 | ] 18 | 19 | main :: IO () 20 | main = testForSecondsInput 1 (concat $ replicate 1000 testLines) Koan.main $ \output -> 21 | case output of 22 | [] -> ["Weird, your program didn't produce any output!"] 23 | _ 24 | | output == (tshow @Int <$> [1000, 2000, 9003, 2000, 4001, 18004, 3000, 6000, 27000]) ++ ["The following output: (3000,6000,27000)"] -> [] 25 | | output == (tshow @Int <$> replicate 9000 0) ++ ["The following output: (0,0,0)"] -> 26 | [ "Your program produced output, but it didn't count the lines!" 27 | , "Did you include putAllCounts in your final program?" 28 | ] 29 | | output 30 | == (tshow @Int <$> [0, 0, 0, 1000, 2000, 9003, 2000, 4001, 18004]) 31 | ++ ["The following output: (3000,6000,27000)"] -> 32 | [ "Your program counted lines, but too few!" 33 | , "It seems the order of the ClSFs is wrong." 34 | , "Keep in mind that StateT is a noncommutative effect, and order matters!" 35 | ] 36 | | output == ["The following output: (3000,6000,27000)"] -> 37 | [ "Your program counted lines, but it didn't output a running count!" 38 | , "Did you forget to include printAllCounts?" 39 | ] 40 | _ -> 41 | [ "The program produced output, but it wasn't quite right." 42 | , "It received the following input a 1000 times:" 43 | ] 44 | ++ testLines 45 | ++ ["And it returned:"] 46 | ++ output 47 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/1-circle/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Circle. 2 | 3 | Let's draw something! 4 | Rhine connects to the famous gloss library for 2d graphics. 5 | Have a look at https://hackage.haskell.org/package/gloss to learn more about it! 6 | 7 | The connection between Rhine and gloss is provided by the library https://hackage.haskell.org/package/rhine-gloss, 8 | which encapsulates the effects of drawing pictures in gloss in a monad, 'GlossConcT', 9 | and provides several clocks to interact with the gloss system. 10 | 11 | To warm up, let's just draw a circle. 12 | -} 13 | module Koan where 14 | 15 | -- rhine 16 | import FRP.Rhine 17 | 18 | -- rhine-gloss 19 | import FRP.Rhine.Gloss 20 | 21 | {- | The main 'Rhine' of this program. 22 | 23 | /--- We use effects in 'GlossConc' to draw images. 24 | | 25 | | /--- This clock ticks whenever an image is drawn on the screen by the gloss backend. 26 | | | 27 | v v 28 | -} 29 | rhine :: Rhine GlossConc GlossSimClockIO () () 30 | -- Can you create a solid circle of radius 10 here? 31 | -- Have a look at https://hackage.haskell.org/package/gloss/docs/Graphics-Gloss-Data-Picture.html for inspiration. 32 | rhine = 33 | constMCl (paintAllIO (circleSolid 10)) -- paintAllIO clears the drawing canvas and draws the given image 34 | @@ GlossSimClockIO -- The singleton value of GlossSimClockIO. 35 | 36 | main :: IO () 37 | -- Make sure to keep this definition here as it is: The tests depend on it. 38 | main = 39 | flowGlossIO -- This function can replace 'flow' when you're using the gloss backend. 40 | defaultSettings -- Settings for the gloss window context such as size, title, and background colour. 41 | rhine 42 | -------------------------------------------------------------------------------- /koans/basic/2/1-input/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Input! 2 | 3 | We want to react to user input. For this track, let's allow the program to interact on the console. 4 | To do this, meditate about the follow sentence: 5 | 6 | Events in Rhine come from event clocks. 7 | 8 | An event happens when an event clock ticks. 9 | For example, to react every time when a line is entered on the standard input, 10 | you have to add the 'StdinClock' event clock to your main Rhine. 11 | 12 | Events are handled just like any other kind of data. 13 | The difference between event clocks and clocks like 'Millisecond n' is only conceptual: 14 | A fixed rate clock ticks at predictable intervals, 15 | whereas it depends on the user or another external influence when an event clock ticks. 16 | The frameworks handles them in the same way. 17 | 18 | The next Koans are about the event that is triggered when a line of text is entered on the standard input. 19 | -} 20 | module Koan where 21 | 22 | -- text 23 | import Data.Text (Text) 24 | import Data.Text.IO as Text (putStrLn) 25 | 26 | -- rhine 27 | import FRP.Rhine 28 | 29 | {- | A line of user input. 30 | 31 | The 'StdinClock' clock ticks every time a line is entered on StdinClock. 32 | 33 | The information _what_ was typed can be retrieved with a special signal function: 'tagS'. 34 | This signal function is a "sensor" (it has no input, only output), 35 | and it produces different data depending on the clock. 36 | For 'StdinClock', it is one line of standard input. 37 | -} 38 | userInput :: ClSF IO StdinClock () Text 39 | userInput = tagS 40 | 41 | -- | Output the same line that was just entered. 42 | parrot :: ClSF IO StdinClock () () 43 | -- Do you remember how to convert an effectful function into a ClSF? 44 | parrot = userInput >-> _ Text.putStrLn 45 | 46 | main :: IO () 47 | main = flow $ parrot @@ StdinClock 48 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "nix-mkPandoc": { 4 | "flake": false, 5 | "locked": { 6 | "lastModified": 1636045594, 7 | "narHash": "sha256-sdJaDmdMyRhkJheIrVx60dYyB3pVdNEQ7409v8BCyOI=", 8 | "owner": "chisui", 9 | "repo": "nix-mkPandoc", 10 | "rev": "9f462382efdca2eeb28735176311dbf84a6ffa34", 11 | "type": "github" 12 | }, 13 | "original": { 14 | "owner": "chisui", 15 | "repo": "nix-mkPandoc", 16 | "type": "github" 17 | } 18 | }, 19 | "nixpkgs": { 20 | "locked": { 21 | "lastModified": 1758012326, 22 | "narHash": "sha256-5xX26DjtxxFAw4IyZATzUs2UYghdmcpyZ93whojp828=", 23 | "owner": "NixOS", 24 | "repo": "nixpkgs", 25 | "rev": "1bc4de0728f2eb1602fc5cce4122f2e999bc9d35", 26 | "type": "github" 27 | }, 28 | "original": { 29 | "owner": "NixOS", 30 | "ref": "nixos-unstable-small", 31 | "repo": "nixpkgs", 32 | "type": "github" 33 | } 34 | }, 35 | "rhine": { 36 | "inputs": { 37 | "nixpkgs": [ 38 | "nixpkgs" 39 | ] 40 | }, 41 | "locked": { 42 | "lastModified": 1757421790, 43 | "narHash": "sha256-4IWl4OisV8Yz5qenkViC0K6cOrv42FJ4rjq2pofRlsk=", 44 | "owner": "turion", 45 | "repo": "rhine", 46 | "rev": "aa08675ad0353ff100ada9d33080c8094c78cd2f", 47 | "type": "github" 48 | }, 49 | "original": { 50 | "owner": "turion", 51 | "repo": "rhine", 52 | "type": "github" 53 | } 54 | }, 55 | "root": { 56 | "inputs": { 57 | "nix-mkPandoc": "nix-mkPandoc", 58 | "nixpkgs": "nixpkgs", 59 | "rhine": "rhine" 60 | } 61 | } 62 | }, 63 | "root": "root", 64 | "version": 7 65 | } 66 | -------------------------------------------------------------------------------- /koans/basic/2/1-input/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Input! 2 | 3 | We want to react to user input. For this track, let's allow the program to interact on the console. 4 | To do this, meditate about the follow sentence: 5 | 6 | Events in Rhine come from event clocks. 7 | 8 | An event happens when an event clock ticks. 9 | For example, to react every time when a line is entered on the standard input, 10 | you have to add the 'StdinClock' event clock to your main Rhine. 11 | 12 | Events are handled just like any other kind of data. 13 | The difference between event clocks and clocks like 'Millisecond n' is only conceptual: 14 | A fixed rate clock ticks at predictable intervals, 15 | whereas it depends on the user or another external influence when an event clock ticks. 16 | The frameworks handles them in the same way. 17 | 18 | The next Koans are about the event that is triggered when a line of text is entered on the standard input. 19 | -} 20 | module Koan where 21 | 22 | -- text 23 | import Data.Text (Text) 24 | import Data.Text.IO as Text (putStrLn) 25 | 26 | -- rhine 27 | import FRP.Rhine 28 | 29 | {- | A line of user input. 30 | 31 | The 'StdinClock' clock ticks every time a line is entered on StdinClock. 32 | 33 | The information _what_ was typed can be retrieved with a special signal function: 'tagS'. 34 | This signal function is a "sensor" (it has no input, only output), 35 | and it produces different data depending on the clock. 36 | For 'StdinClock', it is one line of standard input. 37 | -} 38 | userInput :: ClSF IO StdinClock () Text 39 | userInput = tagS 40 | 41 | -- | Output the same line that was just entered. 42 | parrot :: ClSF IO StdinClock () () 43 | -- Do you remember how to convert an effectful function into a ClSF? 44 | parrot = userInput >-> arrMCl Text.putStrLn 45 | 46 | main :: IO () 47 | main = flow $ parrot @@ StdinClock 48 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/5-randomness/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- base 4 | import Control.Monad (when) 5 | import Data.List (nub) 6 | import Data.List.NonEmpty (NonEmpty ((:|))) 7 | import System.Exit (exitFailure) 8 | 9 | -- gloss 10 | import Graphics.Gloss.Data.Picture 11 | 12 | -- test-gloss 13 | import TestGloss 14 | 15 | -- koan 16 | 17 | import Control.Monad.Random (mkStdGen, setStdGen) 18 | import Data.Set (singleton) 19 | import Koan (Apple (Apple), Direction (North), Position (..), Snake (..), render, rhine, snek) 20 | 21 | main :: IO () 22 | main = do 23 | setStdGen $ mkStdGen 0 24 | pics <- fmap nub $ stepGlossRhineWithInput rhine ((/ 30) <$> [0, 1 .. 150]) $ cycle [keyRight, keyLeft] 25 | let apple = Apple $ Position {x = 4, y = 4} -- By fixing the stdgen the apple will always be here 26 | beforeEating = 27 | (,singleton apple) . snek North 28 | <$> [ Position {x = 1, y = 0} 29 | , Position {x = 1, y = 1} 30 | , Position {x = 2, y = 1} 31 | , Position {x = 2, y = 2} 32 | , Position {x = 3, y = 2} 33 | , Position {x = 3, y = 3} 34 | , Position {x = 4, y = 3} 35 | ] 36 | afterEating = 37 | (,mempty) 38 | <$> [ Snake {direction = North, body = Position {x = 4, y = 4} :| []} 39 | , Snake {direction = North, body = Position {x = 5, y = 4} :| [Position {x = 4, y = 4}]} 40 | , Snake {direction = North, body = Position {x = 5, y = 5} :| [Position {x = 5, y = 4}]} 41 | ] 42 | expected = map (scale 20 20) $ blank : map render (beforeEating ++ afterEating) 43 | when (pics /= expected) $ 44 | do 45 | putStrLn $ "Unexpected pictures:\n" ++ unlines (show <$> pics) 46 | putStrLn $ "Expected:\n" ++ unlines (show <$> expected) 47 | exitFailure 48 | -------------------------------------------------------------------------------- /koans/basic/2/9-modularize/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | Modularize. 4 | 5 | Let's clean up the code. Ideally, we don't have one big monolithic function, 6 | but rather several reusable, independent ones. 7 | A typical pattern is to separate computations from side effects, so let us do that here! 8 | -} 9 | module Koan where 10 | 11 | -- text 12 | import Data.Text qualified as Text (length, words) 13 | 14 | -- rhine 15 | import FRP.Rhine hiding (currentInput) 16 | 17 | -- | Count the number of lines, words and chars. 18 | allCounts :: ClSF IO StdinClock () (Int, Int, Int) 19 | allCounts = _ 20 | 21 | -- | Print the three counts. 22 | printCounts :: ClSF IO StdinClock (Int, Int, Int) () 23 | printCounts = proc (lineCount, totalWordCount, totalCharCount) -> do 24 | _ -< _ 25 | 26 | -- | On every 1000th line, print the number of total lines, words and characters so far. 27 | printAllCounts :: ClSF IO StdinClock () () 28 | printAllCounts = proc () -> do 29 | counts@(lineCount, _, _) <- _ -< () 30 | if lineCount `mod` 1000 == 0 31 | then _ -< counts 32 | else returnA -< () 33 | 34 | -- For reference, here is the previous implementation. 35 | -- Can you reuse its pieces to implement the holes above? 36 | 37 | -- | On every 1000th line, print the number of total lines, words and characters so far. 38 | printAllCountsMonolith :: ClSF IO StdinClock () () 39 | printAllCountsMonolith = proc () -> do 40 | userInput <- tagS -< () 41 | 42 | let wordCount = length $ Text.words userInput 43 | charCount = Text.length userInput + 1 44 | 45 | lineCount <- count @Int -< () 46 | totalWordCount <- sumN -< wordCount 47 | totalCharCount <- sumN -< charCount 48 | 49 | if lineCount `mod` 1000 == 0 50 | then do 51 | arrMCl print -< lineCount 52 | arrMCl print -< totalWordCount 53 | arrMCl print -< totalCharCount 54 | else returnA -< () 55 | 56 | main :: IO () 57 | main = flow $ printAllCounts @@ StdinClock 58 | -------------------------------------------------------------------------------- /generic/test-gloss/TestGloss.hs: -------------------------------------------------------------------------------- 1 | module TestGloss where 2 | 3 | -- base 4 | import Control.Concurrent 5 | import Control.Monad 6 | import Data.IORef 7 | import System.Exit 8 | 9 | -- rhine-gloss 10 | import FRP.Rhine.Gloss 11 | 12 | expectPic :: Picture -> [Picture] -> IO () 13 | expectPic received expected = expectPics [received] [expected] 14 | 15 | expectPics :: [Picture] -> [[Picture]] -> IO () 16 | expectPics receiveds expecteds = do 17 | forM_ (zip receiveds expecteds) $ \(received, expected) -> do 18 | let flattened = flattenPictures received 19 | when (flattened /= expected) $ do 20 | putStrLn $ "Expected: " ++ show expected 21 | putStrLn $ "Received: " ++ show flattened 22 | exitFailure 23 | putStrLn "Well done!" 24 | 25 | flattenPictures :: Picture -> [Picture] 26 | flattenPictures (Pictures ps) = ps >>= flattenPictures 27 | flattenPictures Blank = [] 28 | flattenPictures picture = [picture] 29 | 30 | stepGlossRhine :: (Clock GlossConc cl, Time cl ~ Time (Out cl), Time cl ~ Time (In cl), GetClockProxy cl) => Rhine GlossConc cl () () -> [Float] -> IO [Picture] 31 | stepGlossRhine rhine timestamps = stepGlossRhineWithInput rhine timestamps [] 32 | 33 | stepGlossRhineWithInput :: (Clock GlossConc cl, Time cl ~ Time (Out cl), Time cl ~ Time (In cl), GetClockProxy cl) => Rhine GlossConc cl () () -> [Float] -> [Event] -> IO [Picture] 34 | stepGlossRhineWithInput rhine timestamps events = do 35 | vars <- makeGlossEnv 36 | void $ forkIO $ forM_ events $ putMVar $ eventVar vars 37 | void $ forkIO $ runGlossConcT (flow rhine) vars 38 | forM timestamps $ \timestamp -> do 39 | putMVar (timeVar vars) timestamp 40 | threadDelay 33333 41 | readIORef (picRef vars) 42 | 43 | specialKey :: SpecialKey -> Event 44 | specialKey key = EventKey (SpecialKey key) Down (Modifiers Down Down Down) (0, 0) 45 | 46 | keyRight :: Event 47 | keyRight = specialKey KeyRight 48 | 49 | keyLeft :: Event 50 | keyLeft = specialKey KeyLeft 51 | -------------------------------------------------------------------------------- /koans/basic/1/1-hello-rhine/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Hello Rhine! 2 | 3 | Welcome! As your first task, can you complete the code below 4 | such that it outputs the message "Hello Rhine!" every second? 5 | -} 6 | module Koan where 7 | 8 | -- text 9 | import Data.Text.IO as Text (putStrLn) 10 | 11 | -- rhine 12 | import FRP.Rhine 13 | 14 | {- | A clock that ticks every second. 15 | 16 | This is a clock value. It chooses a particular implementation of a running clock. 17 | | 18 | | This type ensures that the clock runs in real time, and ticks at a given regular interval. 19 | | | 20 | | | The number of milliseconds between two clock ticks. 21 | | | | (Yes, numbers can appear in type signatures!) 22 | v v v 23 | -} 24 | everySecond :: Millisecond 1000 25 | everySecond = waitClock -- A particular implementation of this clock that waits until the specified interval is over. 26 | 27 | {- | A component of the whole signal network. 28 | 29 | "ClSF" stands for "Clocked Signal Function". These are one type of components that can occur in `rhine`. 30 | | 31 | | The component is allowed to produce side effects in IO, for example printing a message 32 | | | 33 | | | The component is required run every 1000 milliseconds, i.e. every second. 34 | | | | 35 | | | | This component produces no data output and consumes no input. 36 | | | | | | 37 | v v v v v 38 | -} 39 | message :: ClSF IO (Millisecond 1000) () () 40 | message = 41 | constMCl -- Perform the following side effect every time the clock ticks. 42 | (Text.putStrLn _) -- This is the side effect to perform. Insert your message in the hole! 43 | 44 | main :: IO () 45 | main = 46 | flow $ -- The program runs the given "Rhine", which follows in the next lines. 47 | message @@ everySecond -- Run the message component every second 48 | -------------------------------------------------------------------------------- /koans/basic/1/1-hello-rhine/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Hello Rhine! 2 | 3 | Welcome! As your first task, can you complete the code below 4 | such that it outputs the message "Hello Rhine!" every second? 5 | -} 6 | module Koan where 7 | 8 | -- text 9 | import Data.Text.IO as Text (putStrLn) 10 | 11 | -- rhine 12 | import FRP.Rhine 13 | 14 | {- | A clock that ticks every second. 15 | 16 | This is a clock value. It chooses a particular implementation of a running clock. 17 | | 18 | | This type ensures that the clock runs in real time, and ticks at a given regular interval. 19 | | | 20 | | | The number of milliseconds between two clock ticks. 21 | | | | (Yes, numbers can appear in type signatures!) 22 | v v v 23 | -} 24 | everySecond :: Millisecond 1000 25 | everySecond = waitClock -- A particular implementation of this clock that waits until the specified interval is over. 26 | 27 | {- | A component of the whole signal network. 28 | 29 | "ClSF" stands for "Clocked Signal Function". These are one type of components that can occur in `rhine`. 30 | | 31 | | The component is allowed to produce side effects in IO, for example printing a message 32 | | | 33 | | | The component is required run every 1000 milliseconds, i.e. every second. 34 | | | | 35 | | | | This component produces no data output and consumes no input. 36 | | | | | | 37 | v v v v v 38 | -} 39 | message :: ClSF IO (Millisecond 1000) () () 40 | message = 41 | constMCl -- Perform the following side effect every time the clock ticks. 42 | (Text.putStrLn "Hello Rhine!") -- This is the side effect to perform. Insert your message in the hole! 43 | 44 | main :: IO () 45 | main = 46 | flow $ -- The program runs the given "Rhine", which follows in the next lines. 47 | message @@ everySecond -- Run the message component every second 48 | -------------------------------------------------------------------------------- /koans/basic/1/5-compose-more/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Compose more! 2 | 3 | A typical pattern you will encounter a lot in Functional Reactive Programming 4 | is the composition of 3 types of signal functions: 5 | 6 | * _Sensors_ produce data, often through the use of side effects. 7 | * _Functions_ are pure (they have no side effects), they consume _and_ produce data. 8 | * _Actuators_ consume data, acting it out as side effects. 9 | 10 | Then these will be composed as `sensor >-> function >-> actuator`. 11 | -} 12 | module Koan where 13 | 14 | -- text 15 | import Data.Text (Text) 16 | import Data.Text.IO as Text (putStrLn) 17 | 18 | -- rhine 19 | import FRP.Rhine 20 | 21 | -- | We will react every second. 22 | type EverySecond = Millisecond 1000 23 | 24 | -- | The clock value for our clock. 25 | everySecond :: EverySecond 26 | everySecond = waitClock 27 | 28 | {- | Produce an incomplete message. 29 | 30 | Since this component only produces data, it is a _sensor_. 31 | 32 | (Yes, we don't really use IO here, but we could if we wanted!) 33 | -} 34 | produceMessage :: ClSF IO EverySecond () Text 35 | produceMessage = arr $ const "Hello Rhine" -- Hmm, this is lacking something... 36 | 37 | {- | Add an exclamation mark ("!") to a Text. 38 | 39 | This is a pure signal function, it has no side effects! 40 | 41 | This component can be run in _any_ monad m, so it is pure. 42 | | 43 | v 44 | -} 45 | exclamate :: (Monad m) => ClSF m EverySecond Text Text 46 | exclamate = arr (<> "!") 47 | 48 | {- | Outputs a message every second. 49 | 50 | Since this component only consumes data 51 | (and converts it into side effects in IO), 52 | it is an _actuator_. 53 | -} 54 | printMessage :: ClSF IO EverySecond Text () 55 | printMessage = arrMCl Text.putStrLn 56 | 57 | -- | Print "Hello Rhine!" every second. 58 | mainComponent :: ClSF IO EverySecond () () 59 | -- Can you fill in the _three_ components from above, 60 | -- in the order sensor, function, actuator? 61 | mainComponent = _ >>> _ >>> _ 62 | 63 | -- Huh, it seems we can often use >>> instead of >-> as well! 64 | 65 | main :: IO () 66 | main = flow $ mainComponent @@ everySecond 67 | -------------------------------------------------------------------------------- /koans/basic/2/6-count-everything/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Count everything! 2 | 3 | If we can count words, characters, and lines, let's just put it all together. 4 | This is a bit finicky, but give it a try nevertheless! 5 | Remember the combinator for parallel composition: 6 | 7 | @ 8 | (&&&) :: Monad m => ClSF m cl a b -> ClSF m cl a c -> ClSF m cl a (b, c) 9 | @ 10 | -} 11 | module Koan where 12 | 13 | -- text 14 | import Data.Text (Text) 15 | import Data.Text qualified as Text (length, words) 16 | 17 | -- rhine 18 | import FRP.Rhine hiding (currentInput) 19 | 20 | -- | A line of user input. 21 | userInput :: ClSF IO StdinClock () Text 22 | userInput = tagS 23 | 24 | -- | Output the number of words of the line that was just entered. 25 | wordCount :: ClSF IO StdinClock () Int 26 | wordCount = userInput >-> arr (Text.words >>> length) 27 | 28 | {- | Output the number of characters of the line that was just entered. 29 | 30 | The newline character is not part of 'userInput', 31 | therefore +1 is added for it. 32 | -} 33 | charCount :: ClSF IO StdinClock () Int 34 | -- Yes, you can use >>> to compose ordinary functions as well! 35 | charCount = userInput >-> arr (Text.length >>> (+ 1)) 36 | 37 | -- | The number of lines of input so far. 38 | lineCount :: ClSF IO StdinClock () Integer 39 | lineCount = count 40 | 41 | -- | The number of words of input so far. 42 | totalWordCount :: ClSF IO StdinClock () Int 43 | -- Your sumClSF is actually included in the library, as sumN! 44 | totalWordCount = wordCount >-> sumN 45 | 46 | -- | The number of characters of input so far. 47 | totalCharCount :: ClSF IO StdinClock () Int 48 | totalCharCount = charCount >-> sumN 49 | 50 | -- | The number of total lines, words and characters so far. 51 | totalCount :: ClSF IO StdinClock () _ -- What will the type of this be? 52 | totalCount = _ &&& _ &&& _ 53 | 54 | -- | Print the number of total lines, words and characters so far. 55 | printAllCounts :: ClSF IO StdinClock () () 56 | -- On what do you need to pattern match here to bring lines_, words_ and chars into scope? 57 | printAllCounts = totalCount >-> arrMCl (\_ -> print lines_ >> print words_ >> print chars) 58 | 59 | main :: IO () 60 | main = flow $ printAllCounts @@ StdinClock 61 | -------------------------------------------------------------------------------- /koans/basic/1/5-compose-more/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Compose more! 2 | 3 | A typical pattern you will encounter a lot in Functional Reactive Programming 4 | is the composition of 3 types of signal functions: 5 | 6 | * _Sensors_ produce data, often through the use of side effects. 7 | * _Functions_ are pure (they have no side effects), they consume _and_ produce data. 8 | * _Actuators_ consume data, acting it out as side effects. 9 | 10 | Then these will be composed as `sensor >-> function >-> actuator`. 11 | -} 12 | module Koan where 13 | 14 | -- text 15 | import Data.Text (Text) 16 | import Data.Text.IO as Text (putStrLn) 17 | 18 | -- rhine 19 | import FRP.Rhine 20 | 21 | -- | We will react every second. 22 | type EverySecond = Millisecond 1000 23 | 24 | -- | The clock value for our clock. 25 | everySecond :: EverySecond 26 | everySecond = waitClock 27 | 28 | {- | Produce an incomplete message. 29 | 30 | Since this component only produces data, it is a _sensor_. 31 | 32 | (Yes, we don't really use IO here, but we could if we wanted!) 33 | -} 34 | produceMessage :: ClSF IO EverySecond () Text 35 | produceMessage = arr $ const "Hello Rhine" -- Hmm, this is lacking something... 36 | 37 | {- | Add an exclamation mark ("!") to a Text. 38 | 39 | This is a pure signal function, it has no side effects! 40 | 41 | This component can be run in _any_ monad m, so it is pure. 42 | | 43 | v 44 | -} 45 | exclamate :: (Monad m) => ClSF m EverySecond Text Text 46 | exclamate = arr (<> "!") 47 | 48 | {- | Outputs a message every second. 49 | 50 | Since this component only consumes data 51 | (and converts it into side effects in IO), 52 | it is an _actuator_. 53 | -} 54 | printMessage :: ClSF IO EverySecond Text () 55 | printMessage = arrMCl Text.putStrLn 56 | 57 | -- | Print "Hello Rhine!" every second. 58 | mainComponent :: ClSF IO EverySecond () () 59 | -- Can you fill in the _three_ components from above, 60 | -- in the order sensor, function, actuator? 61 | mainComponent = produceMessage >>> exclamate >>> printMessage 62 | 63 | -- Huh, it seems we can often use >>> instead of >-> as well! 64 | 65 | main :: IO () 66 | main = flow $ mainComponent @@ everySecond 67 | -------------------------------------------------------------------------------- /koans/basic/2/6-count-everything/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Count everything! 2 | 3 | If we can count words, characters, and lines, let's just put it all together. 4 | This is a bit finicky, but give it a try nevertheless! 5 | Remember the combinator for parallel composition: 6 | 7 | @ 8 | (&&&) :: Monad m => ClSF m cl a b -> ClSF m cl a c -> ClSF m cl a (b, c) 9 | @ 10 | -} 11 | module Koan where 12 | 13 | -- text 14 | import Data.Text (Text) 15 | import Data.Text qualified as Text (length, words) 16 | 17 | -- rhine 18 | import FRP.Rhine hiding (currentInput) 19 | 20 | -- | A line of user input. 21 | userInput :: ClSF IO StdinClock () Text 22 | userInput = tagS 23 | 24 | -- | Output the number of words of the line that was just entered. 25 | wordCount :: ClSF IO StdinClock () Int 26 | wordCount = userInput >-> arr (Text.words >>> length) 27 | 28 | {- | Output the number of characters of the line that was just entered. 29 | 30 | The newline character is not part of 'userInput', 31 | therefore +1 is added for it. 32 | -} 33 | charCount :: ClSF IO StdinClock () Int 34 | -- Yes, you can use >>> to compose ordinary functions as well! 35 | charCount = userInput >-> arr (Text.length >>> (+ 1)) 36 | 37 | -- | The number of lines of input so far. 38 | lineCount :: ClSF IO StdinClock () Integer 39 | lineCount = count 40 | 41 | -- | The number of words of input so far. 42 | totalWordCount :: ClSF IO StdinClock () Int 43 | -- Your sumClSF is actually included in the library, as sumN! 44 | totalWordCount = wordCount >-> sumN 45 | 46 | -- | The number of characters of input so far. 47 | totalCharCount :: ClSF IO StdinClock () Int 48 | totalCharCount = charCount >-> sumN 49 | 50 | -- | The number of total lines, words and characters so far. 51 | totalCount :: ClSF IO StdinClock () (Integer, (Int, Int)) -- What will the type of this be? 52 | totalCount = lineCount &&& totalWordCount &&& totalCharCount 53 | 54 | -- | Print the number of total lines, words and characters so far. 55 | printAllCounts :: ClSF IO StdinClock () () 56 | -- On what do you need to pattern match here to bring lines_, words_ and chars into scope? 57 | printAllCounts = totalCount >-> arrMCl (\(lines_, (words_, chars)) -> print lines_ >> print words_ >> print chars) 58 | 59 | main :: IO () 60 | main = flow $ printAllCounts @@ StdinClock 61 | -------------------------------------------------------------------------------- /koans/basic/1/4-compose/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Compose. 2 | 3 | Functional programming is a lot about composing smaller pieces to bigger programs. 4 | Rhine gives you many ways to compose! 5 | 6 | One of them is this operator: >-> 7 | 8 | A composition is written as `sf1 >-> sf2`, where `sf1` and `sf2` are clocked signal functions (`ClSF`s). 9 | For two `ClSF`s to be composable, the _output_ type of the first one has to match the _input_ type of the second one! 10 | -} 11 | module Koan where 12 | 13 | -- text 14 | import Data.Text (Text) 15 | import Data.Text.IO as Text (putStrLn) 16 | 17 | -- rhine 18 | import FRP.Rhine 19 | 20 | -- | We will react every second. 21 | type EverySecond = Millisecond 1000 22 | 23 | -- | The clock value for our clock. 24 | everySecond :: EverySecond 25 | everySecond = waitClock 26 | 27 | {- | Produce a message every second. 28 | 29 | This component consumes no input. 30 | | 31 | | But it produces output of type `Text`. 32 | | | 33 | v v 34 | -} 35 | produceMessage :: ClSF IO EverySecond () Text 36 | produceMessage = 37 | arr $ -- Convert a pure function (of type a -> b) into a ClSF. 38 | const "Hello Rhine!" -- Discard the trivial input and produce a message. 39 | -- By the way, if you try this in your own project, make sure to activate the OverloadedStrings extension! 40 | 41 | {- | Outputs a message every second. 42 | 43 | This component consumes `Text` as input. 44 | | 45 | | But it produces no output. 46 | | | 47 | v v 48 | -} 49 | printMessage :: ClSF IO EverySecond Text () 50 | printMessage = 51 | arrMCl -- Convert an effectful function (of type a -> m b) into a ClSF 52 | Text.putStrLn -- This has type Text -> IO () 53 | 54 | -- | Print "Hello Rhine!" every second. 55 | mainComponent :: ClSF IO EverySecond () () 56 | -- Can you fill in the two components from above, 57 | -- one to the right and one to the left of the composition operator? 58 | mainComponent = _ >-> _ 59 | 60 | main :: IO () 61 | main = flow $ mainComponent @@ everySecond 62 | -------------------------------------------------------------------------------- /koans/basic/3/3-asynchronize/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- base 4 | import Control.Monad (unless) 5 | import Data.Bifunctor (first) 6 | import Data.Either (fromLeft) 7 | import Text.Read (readEither) 8 | 9 | -- text 10 | import Data.Text as Text (Text, unpack) 11 | import Data.Text qualified as Text (take) 12 | 13 | -- koan 14 | import Koan (WordCount (..)) 15 | import Koan qualified (main) 16 | 17 | -- test-io 18 | import TestIO 19 | 20 | testLines :: [Text] 21 | testLines = 22 | [ "Hello Rhine" 23 | , "this is a" 24 | , "test" 25 | ] 26 | 27 | main :: IO () 28 | main = do 29 | putStrLn "No worries, this will take 10-20 seconds..." 30 | testForSecondsInput 10 (concat $ replicate 32500 testLines) Koan.main $ \output -> 31 | case output of 32 | [] -> ["Weird, your program didn't produce any output!"] 33 | _ -> fromLeft [] $ do 34 | (sinceInitText, countText) <- case take 3 output of 35 | [_, sinceInitText, countText] -> return (sinceInitText, countText) 36 | thing -> Left $ "Somehow there wasn't enough output:" : thing ++ ["Did you not include printCounts?"] 37 | (sinceInit :: Double) <- first (const ["Tried to parse sinceInit = ", sinceInitText, " but failed"]) $ readEither $ unpack sinceInitText 38 | (count :: WordCount) <- first (const ["Tried to parse count = ", countText, " but failed"]) $ readEither $ unpack countText 39 | let expected = WordCount {nChars = 877500, nWords = 195000, nLines = 97500} 40 | unless (Text.take 13 (last output) == "Final result:") $ Left ["Didn't find a 'Final result: ...' section."] 41 | unless (last output == "Final result: " <> tshow expected) $ Left ["Wrong count:", last output] 42 | unless 43 | ( nChars count <= nChars expected 44 | && nWords count <= nWords expected 45 | && nLines count <= nLines expected 46 | ) 47 | $ Left ["The count seems too high:", tshow count] 48 | unless 49 | ( nChars count > 0 50 | && nWords count > 0 51 | && nLines count > 0 52 | ) 53 | $ Left ["The count was 0:", tshow count] 54 | unless 55 | ( sinceInit > 0 56 | && sinceInit < 2 57 | ) 58 | $ Left ["There was no count message after one second, but after: " <> tshow sinceInit] 59 | -------------------------------------------------------------------------------- /koans/basic/1/4-compose/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Compose. 2 | 3 | Functional programming is a lot about composing smaller pieces to bigger programs. 4 | Rhine gives you many ways to compose! 5 | 6 | One of them is this operator: >-> 7 | 8 | A composition is written as `sf1 >-> sf2`, where `sf1` and `sf2` are clocked signal functions (`ClSF`s). 9 | For two `ClSF`s to be composable, the _output_ type of the first one has to match the _input_ type of the second one! 10 | -} 11 | module Koan where 12 | 13 | -- text 14 | import Data.Text (Text) 15 | import Data.Text.IO as Text (putStrLn) 16 | 17 | -- rhine 18 | import FRP.Rhine 19 | 20 | -- | We will react every second. 21 | type EverySecond = Millisecond 1000 22 | 23 | -- | The clock value for our clock. 24 | everySecond :: EverySecond 25 | everySecond = waitClock 26 | 27 | {- | Produce a message every second. 28 | 29 | This component consumes no input. 30 | | 31 | | But it produces output of type `Text`. 32 | | | 33 | v v 34 | -} 35 | produceMessage :: ClSF IO EverySecond () Text 36 | produceMessage = 37 | arr $ -- Convert a pure function (of type a -> b) into a ClSF. 38 | const "Hello Rhine!" -- Discard the trivial input and produce a message. 39 | -- By the way, if you try this in your own project, make sure to activate the OverloadedStrings extension! 40 | 41 | {- | Outputs a message every second. 42 | 43 | This component consumes `Text` as input. 44 | | 45 | | But it produces no output. 46 | | | 47 | v v 48 | -} 49 | printMessage :: ClSF IO EverySecond Text () 50 | printMessage = 51 | arrMCl -- Convert an effectful function (of type a -> m b) into a ClSF 52 | Text.putStrLn -- This has type Text -> IO () 53 | 54 | -- | Print "Hello Rhine!" every second. 55 | mainComponent :: ClSF IO EverySecond () () 56 | -- Can you fill in the two components from above, 57 | -- one to the right and one to the left of the composition operator? 58 | mainComponent = produceMessage >-> printMessage 59 | 60 | main :: IO () 61 | main = flow $ mainComponent @@ everySecond 62 | -------------------------------------------------------------------------------- /koans/basic/1/6-compose-signal-functions-and-clocks/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Compose signal functions with clocks. 2 | 3 | So far, we always had one clock, and added it to our program right at the end with the @@ operator. 4 | But what actually happens when we apply @@? 5 | 6 | * On its left side, it expects a clocked signal function. 7 | * The right side must be a clock value. 8 | * The clock types of both sides have to match. 9 | * The output of @@ is a type we haven't seen explicitly yet: it's called 'Rhine'! 10 | 11 | We end up with a complete program that consists of a signal function which produces, processes, and consumes data, 12 | and a clock which drives the signal function at a specific rate. 13 | 14 | But unfortunately, some very strange error messages have crept in. 15 | This is because we have used the general composition operator >>> instead of the Rhine-specific operator >->, 16 | and the type checker is confused which of @@ and >>> to apply first. 17 | Can you fix it? 18 | -} 19 | module Koan where 20 | 21 | -- text 22 | import Data.Text (Text) 23 | import Data.Text.IO as Text (putStrLn) 24 | 25 | -- rhine 26 | import FRP.Rhine 27 | 28 | -- | We will react every second. 29 | type EverySecond = Millisecond 1000 30 | 31 | -- | The clock value for our clock. 32 | everySecond :: EverySecond 33 | everySecond = waitClock 34 | 35 | -- | Produce an incomplete message. 36 | produceMessage :: ClSF IO EverySecond () Text 37 | produceMessage = arr $ const "Hello Rhine" 38 | 39 | -- | Add an exclamation mark ("!") to a Text. 40 | exclamate :: (Monad m) => ClSF m EverySecond Text Text 41 | exclamate = arr (<> "!") 42 | 43 | -- | Outputs a message every second. 44 | printMessage :: ClSF IO EverySecond Text () 45 | printMessage = arrMCl Text.putStrLn 46 | 47 | {- | A complete Rhine program that prints "Hello Rhine!" every second. 48 | 49 | The Rhine can perform side effects in IO. 50 | | 51 | | It ticks every second. 52 | | | 53 | | | It consumes and produces no data. 54 | | | | | 55 | v v v v 56 | -} 57 | mainRhine :: Rhine IO EverySecond () () 58 | -- The operators >>> and @@ don't combine well. Try brackets, or the >-> operator! 59 | mainRhine = produceMessage >>> exclamate >>> printMessage @@ everySecond 60 | 61 | main :: IO () 62 | main = 63 | flow -- Run a 'Rhine'. The general type of this function is 'Rhine m cl () () -> m ()'. 64 | mainRhine 65 | -------------------------------------------------------------------------------- /koans/basic/1/6-compose-signal-functions-and-clocks/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Compose signal functions with clocks. 2 | 3 | So far, we always had one clock, and added it to our program right at the end with the @@ operator. 4 | But what actually happens when we apply @@? 5 | 6 | * On its left side, it expects a clocked signal function. 7 | * The right side must be a clock value. 8 | * The clock types of both sides have to match. 9 | * The output of @@ is a type we haven't seen explicitly yet: it's called 'Rhine'! 10 | 11 | We end up with a complete program that consists of a signal function which produces, processes, and consumes data, 12 | and a clock which drives the signal function at a specific rate. 13 | 14 | But unfortunately, some very strange error messages have crept in. 15 | This is because we have used the general composition operator >>> instead of the Rhine-specific operator >->, 16 | and the type checker is confused which of @@ and >>> to apply first. 17 | Can you fix it? 18 | -} 19 | module Koan where 20 | 21 | -- text 22 | import Data.Text (Text) 23 | import Data.Text.IO as Text (putStrLn) 24 | 25 | -- rhine 26 | import FRP.Rhine 27 | 28 | -- | We will react every second. 29 | type EverySecond = Millisecond 1000 30 | 31 | -- | The clock value for our clock. 32 | everySecond :: EverySecond 33 | everySecond = waitClock 34 | 35 | -- | Produce an incomplete message. 36 | produceMessage :: ClSF IO EverySecond () Text 37 | produceMessage = arr $ const "Hello Rhine" 38 | 39 | -- | Add an exclamation mark ("!") to a Text. 40 | exclamate :: (Monad m) => ClSF m EverySecond Text Text 41 | exclamate = arr (<> "!") 42 | 43 | -- | Outputs a message every second. 44 | printMessage :: ClSF IO EverySecond Text () 45 | printMessage = arrMCl Text.putStrLn 46 | 47 | {- | A complete Rhine program that prints "Hello Rhine!" every second. 48 | 49 | The Rhine can perform side effects in IO. 50 | | 51 | | It ticks every second. 52 | | | 53 | | | It consumes and produces no data. 54 | | | | | 55 | v v v v 56 | -} 57 | mainRhine :: Rhine IO EverySecond () () 58 | -- The operators >>> and @@ don't combine well. Try brackets, or the >-> operator! 59 | mainRhine = produceMessage >-> exclamate >-> printMessage @@ everySecond 60 | 61 | main :: IO () 62 | main = 63 | flow -- Run a 'Rhine'. The general type of this function is 'Rhine m cl () () -> m ()'. 64 | mainRhine 65 | -------------------------------------------------------------------------------- /koans/basic/2/7-count-everything-nicer/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | Count everything nicer. 4 | 5 | The last problem got quite verbose, and fiddling around with nested tuples isn't fun. 6 | Fortunately, Haskell has a language extension that provides very useful syntax 7 | for data flow constructs like signal functions! 8 | It is called "arrow notation", and you can read a bit more about it here: https://www.haskell.org/arrows/. 9 | Have a look how the code of the previous koan can be cleaned up with it. 10 | -} 11 | module Koan where 12 | 13 | -- text 14 | import Data.Text qualified as Text (length, words) 15 | 16 | -- rhine 17 | import FRP.Rhine hiding (currentInput) 18 | 19 | -- | Print the number of total lines, words and characters so far. 20 | printAllCounts :: ClSF IO StdinClock () () 21 | -- proc is a keyword. Think of it like a lambda expression! 22 | -- But why does GHC spit out a nasty parse error here? 23 | -- Read through the following to find out! 24 | printAllCounts = proc () -> do 25 | -- This is nearly like do notation, except it also has syntax for input, the -<. 26 | 27 | -- /------/--- Everything left from a <- is the output _signal_ of a signal function. 28 | -- /| | It is a value that can depend on the current tick of the clock. 29 | -- /| | 30 | -- /| | /--- Signal functions can be used between <- and -<. 31 | -- /| | | 32 | -- /| | | /--- This is the input to the signal function. (tagS needs none.) 33 | -- /| | | | 34 | -- v v v v 35 | userInput <- tagS -< () 36 | 37 | -- We can apply ordinary functions to signals. 38 | let wordCount = length $ Text.words userInput 39 | charCount = Text.length userInput + 1 40 | 41 | lineCount <- count @Int -< () 42 | 43 | -- Signals can be inputs to signal functions. 44 | -- This way we can aggregate signals. 45 | totalWordCount <- sumN -< wordCount 46 | totalCharCount <- sumN -< charCount 47 | 48 | -- If a signal function has trivial output (), the <- is not needed. 49 | arrMCl print -< lineCount 50 | arrMCl print -< totalWordCount 51 | arrMCl print -< totalCharCount 52 | 53 | -- As you've seen, arrow notation introduces two new syntactic constructions, 54 | -- the proc keyword an the -< operator. 55 | -- You need to turn on a GHC language extension so that they can be parsed! 56 | -- Can you uncomment the following line, and move to the top of the file? 57 | -- {-# LANGUAGE Arrows #-} 58 | 59 | main :: IO () 60 | main = flow $ printAllCounts @@ StdinClock 61 | -------------------------------------------------------------------------------- /koans/basic/2/4-count-all-the-words/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Count the all the words! 2 | 3 | There are a number of ways how you can create internal state yourself. 4 | One of them is 'feedback'. Let's look at its type signature: 5 | 6 | @ 7 | feedback :: s -> ClSF m (a, s) (b, s) -> ClSF m a b 8 | @ 9 | 10 | 'feedback' takes an internal state @s@, 11 | and a signal function with two inputs and two outputs. 12 | The two inputs are @a@ and the current internal state @s@. 13 | The two outputs are @b@ and the modified internal state. 14 | 'feedback' then hides this state, which is why at the end, 15 | the return type is @ClSF m a b@. 16 | 17 | If you call 'feedback', you can pass an arbitrary signal function as second argument. 18 | It allows you to use and modify the internal state. 19 | -} 20 | module Koan where 21 | 22 | -- text 23 | import Data.Text (Text) 24 | import Data.Text as Text (words) 25 | 26 | -- rhine 27 | import FRP.Rhine hiding (currentInput) 28 | 29 | -- | A line of user input. 30 | userInput :: ClSF IO StdinClock () Text 31 | userInput = tagS 32 | 33 | -- | Output the number of words of the line that was just entered. 34 | wordCount :: ClSF IO StdinClock () Int 35 | wordCount = userInput >-> arr (Text.words >>> length) 36 | 37 | {- | Compute the sum of all input numbers so far, including the current one. 38 | 39 | /----------/--/-- Let's solve this problem in general, for any number type, any monad and any clock. 40 | | | | 41 | v v v 42 | -} 43 | sumClSF :: (Monad m, Num a) => ClSF m cl a a 44 | sumClSF = 45 | feedback -- We're using internal state 46 | 0 -- As long as no input has arrived, this is the internal state we start with 47 | $ arr aggregator -- No side effects or further state needed: We manipulate the state with a pure function. 48 | where 49 | aggregator :: (Num a) => (a, a) -> (a, a) 50 | aggregator (currentInput, currentSum) = 51 | let 52 | nextSum = _ -- What should be the state after a further line of input has arrived? 53 | in 54 | -- The missing part is the final output of the signal function. 55 | -- If we have summed up to a certain number, what should it be? 56 | (_, nextSum) 57 | 58 | -- | The number of words of input so far. 59 | totalWordCount :: ClSF IO StdinClock () Int 60 | totalWordCount = wordCount >-> sumClSF 61 | 62 | -- | Print the number of total words so far. 63 | printTotalWordCount :: ClSF IO StdinClock () () 64 | printTotalWordCount = totalWordCount >-> arrMCl print 65 | 66 | main :: IO () 67 | main = flow $ printTotalWordCount @@ StdinClock 68 | -------------------------------------------------------------------------------- /koans/basic/2/4-count-all-the-words/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Count the all the words! 2 | 3 | There are a number of ways how you can create internal state yourself. 4 | One of them is 'feedback'. Let's look at its type signature: 5 | 6 | @ 7 | feedback :: s -> ClSF m (a, s) (b, s) -> ClSF m a b 8 | @ 9 | 10 | 'feedback' takes an internal state @s@, 11 | and a signal function with two inputs and two outputs. 12 | The two inputs are @a@ and the current internal state @s@. 13 | The two outputs are @b@ and the modified internal state. 14 | 'feedback' then hides this state, which is why at the end, 15 | the return type is @ClSF m a b@. 16 | 17 | If you call 'feedback', you can pass an arbitrary signal function as second argument. 18 | It allows you to use and modify the internal state. 19 | -} 20 | module Koan where 21 | 22 | -- text 23 | import Data.Text (Text) 24 | import Data.Text as Text (words) 25 | 26 | -- rhine 27 | import FRP.Rhine hiding (currentInput) 28 | 29 | -- | A line of user input. 30 | userInput :: ClSF IO StdinClock () Text 31 | userInput = tagS 32 | 33 | -- | Output the number of words of the line that was just entered. 34 | wordCount :: ClSF IO StdinClock () Int 35 | wordCount = userInput >-> arr (Text.words >>> length) 36 | 37 | {- | Compute the sum of all input numbers so far, including the current one. 38 | 39 | /----------/--/-- Let's solve this problem in general, for any number type, any monad and any clock. 40 | | | | 41 | v v v 42 | -} 43 | sumClSF :: (Monad m, Num a) => ClSF m cl a a 44 | sumClSF = 45 | feedback -- We're using internal state 46 | 0 -- As long as no input has arrived, this is the internal state we start with 47 | $ arr aggregator -- No side effects or further state needed: We manipulate the state with a pure function. 48 | where 49 | aggregator :: (Num a) => (a, a) -> (a, a) 50 | aggregator (currentInput, currentSum) = 51 | let 52 | nextSum = currentInput + currentSum -- What should be the state after a further line of input has arrived? 53 | in 54 | -- The missing part is the final output of the signal function. 55 | -- If we have summed up to a certain number, what should it be? 56 | (nextSum, nextSum) 57 | 58 | -- | The number of words of input so far. 59 | totalWordCount :: ClSF IO StdinClock () Int 60 | totalWordCount = wordCount >-> sumClSF 61 | 62 | -- | Print the number of total words so far. 63 | printTotalWordCount :: ClSF IO StdinClock () () 64 | printTotalWordCount = totalWordCount >-> arrMCl print 65 | 66 | main :: IO () 67 | main = flow $ printTotalWordCount @@ StdinClock 68 | -------------------------------------------------------------------------------- /koans/basic/2/5-count-all-the-chars/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Count the all the chars! 2 | 3 | If we can count words, we surely can count characters as well. 4 | But how do we output them _both_? 5 | 6 | 'ClSF's have an instance for the 'Arrow' type class. 7 | This means that they can be composed sequentially (as you did already with '>>>'), 8 | but also in parallel. 9 | Let's look at one combinator that allows this: 10 | 11 | @ 12 | (&&&) :: Monad m => ClSF m cl a b -> ClSF m cl a c -> ClSF m cl a (b, c) 13 | @ 14 | 15 | If two signal functions are on the same monad, the same clock, and receive the same input, 16 | we can combine them in parallel and execute both after each other. 17 | Both outputs are combined in a tuple. 18 | -} 19 | module Koan where 20 | 21 | -- text 22 | import Data.Text (Text) 23 | import Data.Text qualified as Text (length, words) 24 | 25 | -- rhine 26 | import FRP.Rhine hiding (currentInput) 27 | 28 | -- | A line of user input. 29 | userInput :: ClSF IO StdinClock () Text 30 | userInput = tagS 31 | 32 | -- | Output the number of words of the line that was just entered. 33 | wordCount :: ClSF IO StdinClock () Int 34 | wordCount = userInput >-> arr (Text.words >>> length) 35 | 36 | {- | Output the number of characters of the line that was just entered. 37 | 38 | The newline character is not part of 'userInput', 39 | therefore +1 is added for it. 40 | -} 41 | charCount :: ClSF IO StdinClock () Int 42 | -- Yes, you can use >>> to compose ordinary functions as well! 43 | charCount = userInput >-> arr (Text.length >>> (+ 1)) 44 | 45 | -- | Compute the sum of all input numbers so far, including the current one. 46 | sumClSF :: (Monad m, Num a) => ClSF m cl a a 47 | sumClSF = feedback 0 $ arr aggregator 48 | where 49 | aggregator :: (Num a) => (a, a) -> (a, a) 50 | aggregator (currentInput, currentSum) = 51 | let 52 | nextSum = currentInput + currentSum 53 | in 54 | (nextSum, nextSum) 55 | 56 | -- | The number of words of input so far. 57 | totalWordCount :: ClSF IO StdinClock () Int 58 | totalWordCount = wordCount >-> sumClSF 59 | 60 | -- | The number of characters of input so far. 61 | totalCharCount :: ClSF IO StdinClock () Int 62 | -- Reuse your sum utility! 63 | totalCharCount = charCount >-> _ 64 | 65 | -- | The number of total words and characters so far. 66 | totalWordAndCharCount :: ClSF IO StdinClock () (Int, Int) 67 | totalWordAndCharCount = _ &&& _ 68 | 69 | -- | Print the number of total words and characters so far. 70 | printAllCounts :: ClSF IO StdinClock () () 71 | printAllCounts = totalWordAndCharCount >-> arrMCl (\(words_, chars) -> print words_ >> print chars) 72 | 73 | main :: IO () 74 | main = flow $ printAllCounts @@ StdinClock 75 | -------------------------------------------------------------------------------- /generic/test-io/TestIO.hs: -------------------------------------------------------------------------------- 1 | module TestIO where 2 | 3 | -- base 4 | import Control.Concurrent 5 | import Control.Monad 6 | import GHC.IO.Handle (hDuplicate, hDuplicateTo) 7 | import System.Exit 8 | import System.IO (Handle, IOMode (..), hFlush, stderr, stdin, withFile) 9 | import Prelude hiding (lines, putStrLn, unlines, writeFile) 10 | 11 | -- text 12 | import Data.Text (Text, lines, pack, unlines) 13 | import Data.Text.IO 14 | 15 | -- silently 16 | import System.IO.Silently 17 | 18 | -- temporary 19 | import System.IO.Temp 20 | 21 | -- | Integration test a main function 22 | testForSeconds :: 23 | -- | How many seconds the test should run 24 | Int -> 25 | -- | The main function to test 26 | IO () -> 27 | -- | The property to test on the produced output ([] = test passes) 28 | ([Text] -> [Text]) -> 29 | IO () 30 | testForSeconds nSeconds mainFunction testFunction = testForSecondsErrHandle nSeconds mainFunction testFunction stderr 31 | 32 | -- Like testForSeconds, but with custom stderr handle 33 | testForSecondsErrHandle :: Int -> IO () -> ([Text] -> [Text]) -> Handle -> IO () 34 | testForSecondsErrHandle nSeconds mainFunction testFunction stderrOld = do 35 | putStrLn "---------------------------" 36 | output <- capture_ $ do 37 | void $ forkIO mainFunction 38 | hPutStr stderrOld "Testing" 39 | forM_ [(1 :: Int) .. 20] $ const $ hPutStr stderrOld "." >> threadDelay (50000 * nSeconds) >> hFlush stderrOld 40 | putStrLn "\n---------------------------\n" 41 | case testFunction $ lines $ pack output of 42 | [] -> putStrLn "Well done!" 43 | errors -> do 44 | putStrLn "Oh no!" 45 | forM_ errors putStrLn 46 | putStrLn "" 47 | exitFailure 48 | 49 | -- | Integration test a main function, providing input 50 | testForSecondsInput :: 51 | -- | How many seconds the test should run 52 | Int -> 53 | -- | The standard input to supply 54 | [Text] -> 55 | -- | The main function to test 56 | IO () -> 57 | -- | The property to test on the produced output ([] = test passes) 58 | ([Text] -> [Text]) -> 59 | IO () 60 | testForSecondsInput nSeconds input mainFunction testFunction = do 61 | inputFileName <- emptySystemTempFile "input.txt" 62 | writeFile inputFileName $ unlines input 63 | withFile inputFileName ReadMode $ \stdinFile -> do 64 | hDuplicateTo stdinFile stdin 65 | stderrOld <- hDuplicate stderr 66 | withSystemTempFile "stderr.txt" $ \_path stderrFile -> do 67 | hDuplicateTo stderrFile stderr -- silence stderr to avoid "hGetLine: end of file" message 68 | testForSecondsErrHandle nSeconds mainFunction testFunction stderrOld 69 | 70 | -- | Like 'show', but for 'Text' 71 | tshow :: (Show a) => a -> Text 72 | tshow = pack . show 73 | -------------------------------------------------------------------------------- /koans/basic/2/5-count-all-the-chars/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Count the all the chars! 2 | 3 | If we can count words, we surely can count characters as well. 4 | But how do we output them _both_? 5 | 6 | 'ClSF's have an instance for the 'Arrow' type class. 7 | This means that they can be composed sequentially (as you did already with '>>>'), 8 | but also in parallel. 9 | Let's look at one combinator that allows this: 10 | 11 | @ 12 | (&&&) :: Monad m => ClSF m cl a b -> ClSF m cl a c -> ClSF m cl a (b, c) 13 | @ 14 | 15 | If two signal functions are on the same monad, the same clock, and receive the same input, 16 | we can combine them in parallel and execute both after each other. 17 | Both outputs are combined in a tuple. 18 | -} 19 | module Koan where 20 | 21 | -- text 22 | import Data.Text (Text) 23 | import Data.Text qualified as Text (length, words) 24 | 25 | -- rhine 26 | import FRP.Rhine hiding (currentInput) 27 | 28 | -- | A line of user input. 29 | userInput :: ClSF IO StdinClock () Text 30 | userInput = tagS 31 | 32 | -- | Output the number of words of the line that was just entered. 33 | wordCount :: ClSF IO StdinClock () Int 34 | wordCount = userInput >-> arr (Text.words >>> length) 35 | 36 | {- | Output the number of characters of the line that was just entered. 37 | 38 | The newline character is not part of 'userInput', 39 | therefore +1 is added for it. 40 | -} 41 | charCount :: ClSF IO StdinClock () Int 42 | -- Yes, you can use >>> to compose ordinary functions as well! 43 | charCount = userInput >-> arr (Text.length >>> (+ 1)) 44 | 45 | -- | Compute the sum of all input numbers so far, including the current one. 46 | sumClSF :: (Monad m, Num a) => ClSF m cl a a 47 | sumClSF = feedback 0 $ arr aggregator 48 | where 49 | aggregator :: (Num a) => (a, a) -> (a, a) 50 | aggregator (currentInput, currentSum) = 51 | let 52 | nextSum = currentInput + currentSum 53 | in 54 | (nextSum, nextSum) 55 | 56 | -- | The number of words of input so far. 57 | totalWordCount :: ClSF IO StdinClock () Int 58 | totalWordCount = wordCount >-> sumClSF 59 | 60 | -- | The number of characters of input so far. 61 | totalCharCount :: ClSF IO StdinClock () Int 62 | -- Reuse your sum utility! 63 | totalCharCount = charCount >-> sumClSF 64 | 65 | -- | The number of total words and characters so far. 66 | totalWordAndCharCount :: ClSF IO StdinClock () (Int, Int) 67 | totalWordAndCharCount = totalWordCount &&& totalCharCount 68 | 69 | -- | Print the number of total words and characters so far. 70 | printAllCounts :: ClSF IO StdinClock () () 71 | printAllCounts = totalWordAndCharCount >-> arrMCl (\(words_, chars) -> print words_ >> print chars) 72 | 73 | main :: IO () 74 | main = flow $ printAllCounts @@ StdinClock 75 | -------------------------------------------------------------------------------- /koans/basic/2/7-count-everything-nicer/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | -- Disabling formatter and linter because it would fail on the syntax error otherwise. 4 | #ifndef __HLINT__ 5 | {- FOURMOLU_DISABLE -} 6 | 7 | -- Start reading here 8 | -- vvvvvvvvvvvvvvvvvv 9 | 10 | {- | Count everything nicer. 11 | 12 | The last problem got quite verbose, and fiddling around with nested tuples isn't fun. 13 | Fortunately, Haskell has a language extension that provides very useful syntax 14 | for data flow constructs like signal functions! 15 | It is called "arrow notation", and you can read a bit more about it here: https://www.haskell.org/arrows/. 16 | Have a look how the code of the previous koan can be cleaned up with it. 17 | -} 18 | module Koan where 19 | 20 | -- text 21 | import Data.Text qualified as Text (length, words) 22 | 23 | -- rhine 24 | import FRP.Rhine hiding (currentInput) 25 | 26 | -- | Print the number of total lines, words and characters so far. 27 | printAllCounts :: ClSF IO StdinClock () () 28 | -- proc is a keyword. Think of it like a lambda expression! 29 | -- But why does GHC spit out a nasty parse error here? 30 | -- Read through the following to find out! 31 | printAllCounts = proc () -> do 32 | -- This is nearly like do notation, except it also has syntax for input, the -<. 33 | 34 | -- /------/--- Everything left from a <- is the output _signal_ of a signal function. 35 | -- /| | It is a value that can depend on the current tick of the clock. 36 | -- /| | 37 | -- /| | /--- Signal functions can be used between <- and -<. 38 | -- /| | | 39 | -- /| | | /--- This is the input to the signal function. (tagS needs none.) 40 | -- /| | | | 41 | -- v v v v 42 | userInput <- tagS -< () 43 | 44 | -- We can apply ordinary functions to signals. 45 | let wordCount = length $ Text.words userInput 46 | charCount = Text.length userInput + 1 47 | 48 | lineCount <- count @Int -< () 49 | 50 | -- Signals can be inputs to signal functions. 51 | -- This way we can aggregate signals. 52 | totalWordCount <- sumN -< wordCount 53 | totalCharCount <- sumN -< charCount 54 | 55 | -- If a signal function has trivial output (), the <- is not needed. 56 | arrMCl print -< lineCount 57 | arrMCl print -< totalWordCount 58 | arrMCl print -< _ -- Which one is missing here? 59 | 60 | -- As you've seen, arrow notation introduces two new syntactic constructions, 61 | -- the proc keyword an the -< operator. 62 | -- You need to turn on a GHC language extension so that they can be parsed! 63 | -- Can you uncomment the following line, and move to the top of the file? 64 | -- {-# LANGUAGE Arrows #-} 65 | 66 | main :: IO () 67 | main = flow $ printAllCounts @@ StdinClock 68 | 69 | -- Ignore the next line ;) 70 | #endif 71 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/6-control-flow/test/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- base 4 | import Control.Monad (when) 5 | import Data.List (nub) 6 | import Data.List.NonEmpty (NonEmpty ((:|))) 7 | import Data.Set (singleton) 8 | import System.Exit (exitFailure) 9 | 10 | -- MonadRandom 11 | import Control.Monad.Random (mkStdGen, setStdGen) 12 | 13 | -- gloss 14 | import Graphics.Gloss.Data.Picture 15 | 16 | -- test-gloss 17 | import TestGloss 18 | 19 | -- koan 20 | import Koan (Apple (Apple), Direction (North), Position (..), Snake (..), render, rhine, snek) 21 | 22 | main :: IO () 23 | main = do 24 | putStrLn "Don't worry, this will take half a minute :) ..." 25 | setStdGen $ mkStdGen 0 26 | pics <- fmap nub $ stepGlossRhineWithInput rhine ((/ 30) <$> [0, 1 .. 360]) $ cycle [keyRight, keyLeft] 27 | let apple = Apple Position {x = 4, y = 4} -- By fixing the stdgen the apple will always be here 28 | beforeEating = 29 | (,singleton apple) . snek North 30 | <$> [ Position {x = 1, y = 0} 31 | , Position {x = 1, y = 1} 32 | , Position {x = 2, y = 1} 33 | , Position {x = 2, y = 2} 34 | , Position {x = 3, y = 2} 35 | , Position {x = 3, y = 3} 36 | , Position {x = 4, y = 3} 37 | ] 38 | afterEating = 39 | (,mempty) 40 | <$> [ Snake {direction = North, body = Position {x = 4, y = 4} :| []} 41 | , Snake {direction = North, body = Position {x = 5, y = 4} :| [Position {x = 4, y = 4}]} 42 | , Snake {direction = North, body = Position {x = 5, y = 5} :| [Position {x = 5, y = 4}]} 43 | ] 44 | secondApple = 45 | (,singleton $ Apple Position {x = -9, y = -7}) 46 | <$> [ Snake {direction = North, body = Position {x = 6, y = 5} :| [Position {x = 5, y = 5}]} 47 | , Snake {direction = North, body = Position {x = 6, y = 6} :| [Position {x = 6, y = 5}]} 48 | , Snake {direction = North, body = Position {x = 7, y = 6} :| [Position {x = 6, y = 6}]} 49 | , Snake {direction = North, body = Position {x = 7, y = 7} :| [Position {x = 7, y = 6}]} 50 | , Snake {direction = North, body = Position {x = 8, y = 7} :| [Position {x = 7, y = 7}]} 51 | , Snake {direction = North, body = Position {x = 8, y = 8} :| [Position {x = 8, y = 7}]} 52 | , Snake {direction = North, body = Position {x = 9, y = 8} :| [Position {x = 8, y = 8}]} 53 | , Snake {direction = North, body = Position {x = 9, y = 9} :| [Position {x = 9, y = 8}]} 54 | ] 55 | expected = map (scale 20 20) $ blank : map render ((Just <$> beforeEating ++ afterEating ++ secondApple) ++ [Nothing]) 56 | when (pics /= expected) $ 57 | do 58 | putStrLn $ "Unexpected pictures:\n" ++ unlines (show <$> pics) 59 | putStrLn $ "Expected:\n" ++ unlines (show <$> expected) 60 | exitFailure 61 | -------------------------------------------------------------------------------- /koans/basic/3/2-state/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | State. 4 | 5 | So we have a handle on exceptions. 6 | Nevertheless, once the exception occurs, even if we handle it gracefully, the current word count is gone. 7 | Let's fix that! 8 | 9 | Continuing to use the koan as a console application, 10 | we want to output the final word count of a text file at the end, 11 | as well as an intermediate count every 1000 lines. 12 | -} 13 | module Koan where 14 | 15 | -- base 16 | import Control.Exception qualified as Exception () 17 | 18 | -- transformers 19 | import Control.Monad.Trans.Class () 20 | import Control.Monad.Trans.State.Strict (StateT (runStateT)) 21 | 22 | -- text 23 | import Data.Text qualified as Text (length, words) 24 | 25 | -- rhine 26 | import FRP.Rhine hiding (get, put) 27 | 28 | {- | The monad of effects for this application, consisting of state and exceptions. 29 | 30 | Note: It's important that 'StateT' is the inner transformer. 31 | After all, we want to keep the final state after the exception has been thrown. 32 | (Changing the order would discard the state upon an exception.) 33 | -} 34 | type App = ExceptT IOError (StateT (Int, Int, Int) IO) 35 | 36 | -- | 'StdinClock' lifted to our application monad. 37 | type StdinWithEOF = HoistClock IO App StdinClock 38 | 39 | stdinWithEOF :: StdinWithEOF 40 | stdinWithEOF = 41 | HoistClock 42 | { unhoistedClock = StdinClock 43 | , -- Puzzle: Catch the exception, then hoist to both StateT and ExceptT. 44 | monadMorphism = _ 45 | -- Hint: You need the following ingredients: ExceptT, lift, Exception.try 46 | } 47 | 48 | -- | Count the number of lines, words and chars. 49 | putAllCounts :: ClSF App StdinWithEOF () () 50 | putAllCounts = proc () -> do 51 | userInput <- tagS -< () 52 | 53 | let wordCount = length $ Text.words userInput 54 | charCount = Text.length userInput + 1 55 | 56 | lineCount <- count @Int -< () 57 | totalWordCount <- sumN -< wordCount 58 | totalCharCount <- sumN -< charCount 59 | -- Instead of returning the counts, store them in the StateT monad! 60 | _ -< _ 61 | 62 | -- | Print the three counts. 63 | printCounts :: ClSF App StdinWithEOF (Int, Int, Int) () 64 | printCounts = proc (lineCount, totalWordCount, totalCharCount) -> do 65 | arrMCl $ liftIO . print -< lineCount 66 | arrMCl $ liftIO . print -< totalWordCount 67 | arrMCl $ liftIO . print -< totalCharCount 68 | 69 | -- | On every 1000th line, print the number of total lines, words and characters so far. 70 | printAllCounts :: ClSF App StdinWithEOF () () 71 | printAllCounts = proc () -> do 72 | counts@(lineCount, _, _) <- constMCl _ -< () 73 | if lineCount `mod` 1000 == 0 74 | then printCounts -< counts 75 | else returnA -< () 76 | 77 | main :: IO () 78 | main = do 79 | (Left (_ :: IOError), result) <- 80 | flip runStateT (0, 0, 0) $ 81 | runExceptT $ 82 | -- Don't worry about the ambiguous type here, it will vanish as soon as you solve the following hole. 83 | flow $ 84 | -- Something of type ClSF App StdinWithEOF () () should go here, but what? 85 | _ @@ stdinWithEOF 86 | putStrLn $ "The following output: " ++ show result 87 | -------------------------------------------------------------------------------- /koans/basic/3/2-state/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | State. 4 | 5 | So we have a handle on exceptions. 6 | Nevertheless, once the exception occurs, even if we handle it gracefully, the current word count is gone. 7 | Let's fix that! 8 | 9 | Continuing to use the koan as a console application, 10 | we want to output the final word count of a text file at the end, 11 | as well as an intermediate count every 1000 lines. 12 | -} 13 | module Koan where 14 | 15 | -- base 16 | import Control.Exception qualified as Exception 17 | 18 | -- transformers 19 | import Control.Monad.Trans.Class (lift) 20 | import Control.Monad.Trans.State.Strict (StateT (runStateT), get, put) 21 | 22 | -- text 23 | import Data.Text qualified as Text (length, words) 24 | 25 | -- rhine 26 | import FRP.Rhine hiding (get, put) 27 | 28 | {- | The monad of effects for this application, consisting of state and exceptions. 29 | 30 | Note: It's important that 'StateT' is the inner transformer. 31 | After all, we want to keep the final state after the exception has been thrown. 32 | (Changing the order would discard the state upon an exception.) 33 | -} 34 | type App = ExceptT IOError (StateT (Int, Int, Int) IO) 35 | 36 | -- | 'StdinClock' lifted to our application monad. 37 | type StdinWithEOF = HoistClock IO App StdinClock 38 | 39 | stdinWithEOF :: StdinWithEOF 40 | stdinWithEOF = 41 | HoistClock 42 | { unhoistedClock = StdinClock 43 | , -- Puzzle: Catch the exception, then hoist to both StateT and ExceptT. 44 | monadMorphism = ExceptT . lift . Exception.try 45 | -- Hint: You need the following ingredients: ExceptT, lift, Exception.try 46 | } 47 | 48 | -- | Count the number of lines, words and chars. 49 | putAllCounts :: ClSF App StdinWithEOF () () 50 | putAllCounts = proc () -> do 51 | userInput <- tagS -< () 52 | 53 | let wordCount = length $ Text.words userInput 54 | charCount = Text.length userInput + 1 55 | 56 | lineCount <- count @Int -< () 57 | totalWordCount <- sumN -< wordCount 58 | totalCharCount <- sumN -< charCount 59 | -- Instead of returning the counts, store them in the StateT monad! 60 | arrMCl $ lift . put -< (lineCount, totalWordCount, totalCharCount) 61 | 62 | -- | Print the three counts. 63 | printCounts :: ClSF App StdinWithEOF (Int, Int, Int) () 64 | printCounts = proc (lineCount, totalWordCount, totalCharCount) -> do 65 | arrMCl $ liftIO . print -< lineCount 66 | arrMCl $ liftIO . print -< totalWordCount 67 | arrMCl $ liftIO . print -< totalCharCount 68 | 69 | -- | On every 1000th line, print the number of total lines, words and characters so far. 70 | printAllCounts :: ClSF App StdinWithEOF () () 71 | printAllCounts = proc () -> do 72 | counts@(lineCount, _, _) <- constMCl $ lift get -< () 73 | if lineCount `mod` 1000 == 0 74 | then printCounts -< counts 75 | else returnA -< () 76 | 77 | main :: IO () 78 | main = do 79 | (Left (_ :: IOError), result) <- 80 | flip runStateT (0, 0, 0) $ 81 | runExceptT $ 82 | -- Don't worry about the ambiguous type here, it will vanish as soon as you solve the following hole. 83 | flow $ 84 | -- Something of type ClSF App StdinWithEOF () () should go here, but what? 85 | putAllCounts >-> printAllCounts @@ stdinWithEOF 86 | putStrLn $ "The following output: " ++ show result 87 | -------------------------------------------------------------------------------- /koans/basic/1/8-compose-on-different-clocks/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Compose on different clocks. 2 | 3 | Clocked signal functions on the same clock type can be composed, 4 | and they can be run with a value of that clock type. 5 | But often we want to run different components at different rates! 6 | 7 | To compose parts with different clocks, 8 | Rhine has the concept of a 'ResamplingBuffer'. 9 | This is a basic component that consumes and produces data on two different clocks. 10 | 11 | Two 'Rhine's can be composed with a resampling buffer if all clock types and data types match. 12 | -} 13 | module Koan where 14 | 15 | -- text 16 | import Data.Text (Text) 17 | import Data.Text as Text (unlines) 18 | import Data.Text.IO as Text (putStrLn) 19 | 20 | -- rhine 21 | import FRP.Rhine 22 | 23 | -- * Clocks 24 | 25 | -- | One part of the program is activated every second. 26 | type EverySecond = Millisecond 1000 27 | 28 | everySecond :: EverySecond 29 | everySecond = waitClock 30 | 31 | -- | Another part is activated 5 times per second. 32 | type FivePerSecond = Millisecond 200 33 | 34 | -- | This clock works like 'everySecond', but it is 5 times faster! 35 | fivePerSecond :: FivePerSecond 36 | fivePerSecond = waitClock -- waitClock works for different clock rate! 37 | 38 | -- * Components 39 | 40 | -- | Produce a message 5 times per second. 41 | produceMessage :: (Monad m) => ClSF m FivePerSecond () Text 42 | produceMessage = arr $ const "Hello Rhine!" 43 | 44 | -- | Outputs several messages every second. 45 | printMessage :: ClSF IO EverySecond [Text] () 46 | printMessage = arrMCl $ Text.putStrLn . Text.unlines 47 | 48 | {- | A resampling buffer that consumes 'Text' at 5 times per second, 49 | and outputs all collected 'Text's as a list every second. 50 | 51 | The clock on which input arrives 52 | | 53 | | The clock on which output is produced 54 | | | 55 | | | Input type 56 | | | | 57 | | | | Output type 58 | | | | | 59 | v v v v 60 | -} 61 | fiveToOne :: (Monad m) => ResamplingBuffer m FivePerSecond EverySecond Text [Text] 62 | fiveToOne = collect 63 | 64 | -- * Main program 65 | 66 | {- | The complete program will run on _two_ clocks simultaneously. 67 | This is the composed clock. 68 | 69 | One part is activated on this clock 70 | | 71 | | The other part is activated on this clock 72 | | | 73 | v v 74 | -} 75 | type MainClock = SequentialClock FivePerSecond EverySecond 76 | 77 | -- | Produce "Hello Rhine!" five times per second. 78 | produceRhine :: (Monad m) => Rhine m FivePerSecond () Text 79 | produceRhine = produceMessage @@ fivePerSecond 80 | 81 | -- | Print a list of 'Text's every second. 82 | printRhine :: Rhine IO EverySecond [Text] () 83 | printRhine = printMessage @@ everySecond 84 | 85 | {- | Print five messages every second. 86 | 87 | The messages are produced every 200 ms, collected, and printed every second. 88 | 89 | The operators >-- and --> compose two rhines on the left and right, 90 | and a resampling buffer in the middle. 91 | Can you fill the gap? 92 | -} 93 | mainRhine :: Rhine IO MainClock () () 94 | mainRhine = produceRhine >-- _ --> printRhine 95 | 96 | main :: IO () 97 | main = flow mainRhine 98 | -------------------------------------------------------------------------------- /koans/basic/1/8-compose-on-different-clocks/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Compose on different clocks. 2 | 3 | Clocked signal functions on the same clock type can be composed, 4 | and they can be run with a value of that clock type. 5 | But often we want to run different components at different rates! 6 | 7 | To compose parts with different clocks, 8 | Rhine has the concept of a 'ResamplingBuffer'. 9 | This is a basic component that consumes and produces data on two different clocks. 10 | 11 | Two 'Rhine's can be composed with a resampling buffer if all clock types and data types match. 12 | -} 13 | module Koan where 14 | 15 | -- text 16 | import Data.Text (Text) 17 | import Data.Text as Text (unlines) 18 | import Data.Text.IO as Text (putStrLn) 19 | 20 | -- rhine 21 | import FRP.Rhine 22 | 23 | -- * Clocks 24 | 25 | -- | One part of the program is activated every second. 26 | type EverySecond = Millisecond 1000 27 | 28 | everySecond :: EverySecond 29 | everySecond = waitClock 30 | 31 | -- | Another part is activated 5 times per second. 32 | type FivePerSecond = Millisecond 200 33 | 34 | -- | This clock works like 'everySecond', but it is 5 times faster! 35 | fivePerSecond :: FivePerSecond 36 | fivePerSecond = waitClock -- waitClock works for different clock rate! 37 | 38 | -- * Components 39 | 40 | -- | Produce a message 5 times per second. 41 | produceMessage :: (Monad m) => ClSF m FivePerSecond () Text 42 | produceMessage = arr $ const "Hello Rhine!" 43 | 44 | -- | Outputs several messages every second. 45 | printMessage :: ClSF IO EverySecond [Text] () 46 | printMessage = arrMCl $ Text.putStrLn . Text.unlines 47 | 48 | {- | A resampling buffer that consumes 'Text' at 5 times per second, 49 | and outputs all collected 'Text's as a list every second. 50 | 51 | The clock on which input arrives 52 | | 53 | | The clock on which output is produced 54 | | | 55 | | | Input type 56 | | | | 57 | | | | Output type 58 | | | | | 59 | v v v v 60 | -} 61 | fiveToOne :: (Monad m) => ResamplingBuffer m FivePerSecond EverySecond Text [Text] 62 | fiveToOne = collect 63 | 64 | -- * Main program 65 | 66 | {- | The complete program will run on _two_ clocks simultaneously. 67 | This is the composed clock. 68 | 69 | One part is activated on this clock 70 | | 71 | | The other part is activated on this clock 72 | | | 73 | v v 74 | -} 75 | type MainClock = SequentialClock FivePerSecond EverySecond 76 | 77 | -- | Produce "Hello Rhine!" five times per second. 78 | produceRhine :: (Monad m) => Rhine m FivePerSecond () Text 79 | produceRhine = produceMessage @@ fivePerSecond 80 | 81 | -- | Print a list of 'Text's every second. 82 | printRhine :: Rhine IO EverySecond [Text] () 83 | printRhine = printMessage @@ everySecond 84 | 85 | {- | Print five messages every second. 86 | 87 | The messages are produced every 200 ms, collected, and printed every second. 88 | 89 | The operators >-- and --> compose two rhines on the left and right, 90 | and a resampling buffer in the middle. 91 | Can you fill the gap? 92 | -} 93 | mainRhine :: Rhine IO MainClock () () 94 | mainRhine = produceRhine >-- fiveToOne --> printRhine 95 | 96 | main :: IO () 97 | main = flow mainRhine 98 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/3-modularize/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Modularize. 2 | 3 | To make a round-based game, we need to encode the rounds in some way. 4 | The most natural way to do this in Rhine is to define a separate clock where each tick corresponds to one round! 5 | 6 | Let's do this here. 7 | For the rest of this track, we will just assume that a round lasts half a second. 8 | So we should use a @'Millisecond' 500@ clock! 9 | 10 | The devil is in the details, though. 11 | We now have two different components, the game clock and the visualization clock. 12 | But they run on different monads and time domains! 13 | You will have to translate between them in order to make everything flow together. 14 | 15 | Some background on monads and time domains: 16 | Have a look at https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-Clock.html#t:Clock. 17 | * The type variable @m@ in @Clock m cl@ is the monad in which the clock takes side effects while ticking. 18 | It also determines how multiple clocks are scheduled. 19 | A clock can be tied to a particular monad, or be polymorphic in it. 20 | You can also change the monad with a 'HoistClock' (https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-Clock.html#t:HoistClock). 21 | * The associated type @Time cl@ is called the /time domain/. 22 | It is the type of time stamps that the clock emits while ticking. 23 | A clock always has one fixed time domain. 24 | To change it, you need to create a new clock, by applying a clock rescaling: 25 | https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-Clock.html#t:RescaledClock 26 | -} 27 | module Koan where 28 | 29 | -- rhine 30 | import FRP.Rhine 31 | 32 | -- rhine-gloss 33 | import FRP.Rhine.Gloss 34 | 35 | -- * Game logic 36 | 37 | {- | A circle that moves upwards by 10 pixels every second. 38 | 39 | Its type signature ensures that it will be run on the 'GameClock'. 40 | -} 41 | movingCircle :: ClSF GlossConc GameClock () Picture 42 | -- The cryptic type error wants to tell us that the time since clock initialisation is in Double, but gloss expects a Float! 43 | -- Can you convert one to the other? 44 | movingCircle = sinceInitS >-> arr (\t -> translate 0 (10 * t) $ circleSolid 10) -- realToFrac works as well! 45 | 46 | -- | A clock that ticks at every round of the game. 47 | type GameClock = 48 | -- Actually we just want a Millisecond 500 clock, but that is in the 'IO' monad, 49 | -- while the gloss backend expects a particular monad, 'GlossConc' or 'GlossConcT'. 50 | -- Luckily there is also a utility to lift any 'IO' clock to it! 51 | -- Have a look at https://hackage.haskell.org/package/rhine-gloss/docs/FRP-Rhine-Gloss-IO.html. 52 | _ (Millisecond 500) 53 | 54 | gameClock :: GameClock 55 | -- The clock type lifting function from above also has a corresponding value level function! 56 | gameClock = _ waitClock 57 | 58 | -- * Visualization 59 | 60 | -- | Paint a gloss picture 61 | visualize :: BehaviourF GlossConc UTCTime Picture () 62 | visualize = arrMCl paintAllIO 63 | 64 | -- | Draw at every tick of the gloss backend 65 | type VisualizationClock = 66 | -- The gloss backend has the TimeDomain Float, 67 | -- but we want to use UTCTime instead! 68 | -- Again, in https://hackage.haskell.org/package/rhine-gloss/docs/FRP-Rhine-Gloss-IO.html 69 | -- you will find a type operator that rescales a gloss clock to UTC. 70 | _ _ GlossSimClockIO 71 | 72 | visualizationClock :: VisualizationClock 73 | visualizationClock = _ GlossSimClockIO 74 | 75 | rhine :: Rhine GlossConc (GameClock `SequentialClock` VisualizationClock) () () 76 | -- Find the right resampling buffer to transport the rendered image from the game clock to the visualization clock. 77 | -- It should have two properties: 78 | -- 1. It should always output the newest image. 79 | -- 2. At startup, before the first round of the game has started, a blank image should be displayed. 80 | rhine = movingCircle @@ gameClock >-- _ blank --> visualize @@ visualizationClock 81 | 82 | main :: IO () 83 | -- Make sure to keep this definition here as it is: The tests depend on it. 84 | main = flowGlossIO defaultSettings rhine 85 | -------------------------------------------------------------------------------- /koans/basic/3/1-exceptions/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | Exceptions. 4 | 5 | Have you ever tried to use the word count application you worked with in chapter 2 as a standalone console application? 6 | If not, now is the time to do so! 7 | How about counting the number of lines in the source code of one of the koans? 8 | Try this (assuming you have a Unix-like system): 9 | 10 | ``` 11 | cat koans/basic/3/1-exceptions/solution/Koan.hs | cabal run basic-2-9-modularize 12 | ``` 13 | 14 | Unfortunately, this will throw an exception: 15 | 16 | ``` 17 | basic-2-9-modularize: : hGetLine: end of file 18 | ``` 19 | 20 | The reason is that 'StdinClock' itself throws this 'IOError' as soon as the end of the file is reached. 21 | The goal of this koan is to catch this error and handle it gracefully instead of letting it crash through. 22 | 23 | Test it as a console application! 24 | 25 | ``` 26 | cat koans/basic/3/1-exceptions/solution/Koan.hs | cabal run basic-3-1-exceptions 27 | ``` 28 | -} 29 | module Koan where 30 | 31 | -- base 32 | import Control.Exception qualified as Exception 33 | 34 | -- text 35 | import Data.Text qualified as Text (length, words) 36 | 37 | -- rhine 38 | import FRP.Rhine hiding (put) 39 | 40 | type AppT = ExceptT IOError 41 | type App = AppT IO 42 | 43 | {- | 'StdinClock' lifted to the 'ExceptT' monad transformer. 44 | /--- A clock is lifted to a monad transformer 45 | | 46 | | /--- The base monad in which the clock originally ran 47 | | | 48 | | | /--- The monad transformer applied to it 49 | | | | 50 | | | | /--- The original clock 51 | | | | | 52 | v v v v 53 | -} 54 | type StdinWithEOF = LiftClock IO AppT StdinClock 55 | 56 | -- | A 'StdinClock' that raises any 'IOError' algebraically in 'ExceptT'. 57 | stdinWithEOF :: StdinWithEOF 58 | stdinWithEOF = 59 | -- LiftClock is in fact a type synonym for HoistClock, 60 | -- which hoists a clock from one monad to another, using any monad morphism (not just lift). 61 | HoistClock 62 | { unhoistedClock = _ 63 | , -- Your goal is to first catch the IOError, and then wrap it in the ExceptT transformer. 64 | monadMorphism = _ 65 | -- Hint 1: Have a look at https://hackage.haskell.org/package/base/docs/Control-Exception-Base.html#v:try 66 | -- Hint 2: Have a look at https://hackage.haskell.org/package/transformers/docs/Control-Monad-Trans-Except.html 67 | } 68 | 69 | -- | Count the number of lines, words and chars. 70 | allCounts :: ClSF App StdinWithEOF () (Int, Int, Int) 71 | allCounts = proc () -> do 72 | userInput <- tagS -< () 73 | 74 | let wordCount = length $ Text.words userInput 75 | charCount = Text.length userInput + 1 76 | 77 | lineCount <- count @Int -< () 78 | totalWordCount <- sumN -< wordCount 79 | totalCharCount <- sumN -< charCount 80 | returnA -< (lineCount, totalWordCount, totalCharCount) 81 | 82 | -- | Print the three counts. 83 | printCounts :: ClSF App StdinWithEOF (Int, Int, Int) () 84 | printCounts = proc (lineCount, totalWordCount, totalCharCount) -> do 85 | arrMCl $ liftIO . print -< lineCount 86 | arrMCl $ liftIO . print -< totalWordCount 87 | arrMCl $ liftIO . print -< totalCharCount 88 | 89 | -- | On every 1000th line, print the number of total lines, words and characters so far. 90 | printAllCounts :: ClSF App StdinWithEOF () () 91 | printAllCounts = proc () -> do 92 | counts@(lineCount, _, _) <- allCounts -< () 93 | if lineCount `mod` 1000 == 0 94 | then printCounts -< counts 95 | else returnA -< () 96 | 97 | main :: IO () 98 | main = do 99 | -- The type is ambiguous because GHC cannot infer what e is. 100 | -- Give it a type signature to help it! 101 | Left e <- runExceptT $ flow $ printAllCounts @@ stdinWithEOF 102 | putStrLn $ "The following error occurred: " ++ show e 103 | -------------------------------------------------------------------------------- /koans/basic/3/1-exceptions/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | Exceptions. 4 | 5 | Have you ever tried to use the word count application you worked with in chapter 2 as a standalone console application? 6 | If not, now is the time to do so! 7 | How about counting the number of lines in the source code of one of the koans? 8 | Try this (assuming you have a Unix-like system): 9 | 10 | ``` 11 | cat koans/basic/3/1-exceptions/solution/Koan.hs | cabal run basic-2-9-modularize 12 | ``` 13 | 14 | Unfortunately, this will throw an exception: 15 | 16 | ``` 17 | basic-2-9-modularize: : hGetLine: end of file 18 | ``` 19 | 20 | The reason is that 'StdinClock' itself throws this 'IOError' as soon as the end of the file is reached. 21 | The goal of this koan is to catch this error and handle it gracefully instead of letting it crash through. 22 | 23 | Test it as a console application! 24 | 25 | ``` 26 | cat koans/basic/3/1-exceptions/solution/Koan.hs | cabal run basic-3-1-exceptions 27 | ``` 28 | -} 29 | module Koan where 30 | 31 | -- base 32 | import Control.Exception qualified as Exception 33 | 34 | -- text 35 | import Data.Text qualified as Text (length, words) 36 | 37 | -- rhine 38 | import FRP.Rhine hiding (put) 39 | 40 | type AppT = ExceptT IOError 41 | type App = AppT IO 42 | 43 | {- | 'StdinClock' lifted to the 'ExceptT' monad transformer. 44 | /--- A clock is lifted to a monad transformer 45 | | 46 | | /--- The base monad in which the clock originally ran 47 | | | 48 | | | /--- The monad transformer applied to it 49 | | | | 50 | | | | /--- The original clock 51 | | | | | 52 | v v v v 53 | -} 54 | type StdinWithEOF = LiftClock IO AppT StdinClock 55 | 56 | -- | A 'StdinClock' that raises any 'IOError' algebraically in 'ExceptT'. 57 | stdinWithEOF :: StdinWithEOF 58 | stdinWithEOF = 59 | -- LiftClock is in fact a type synonym for HoistClock, 60 | -- which hoists a clock from one monad to another, using any monad morphism (not just lift). 61 | HoistClock 62 | { unhoistedClock = StdinClock 63 | , -- Your goal is to first catch the IOError, and then wrap it in the ExceptT transformer. 64 | monadMorphism = ExceptT . Exception.try 65 | -- Hint 1: Have a look at https://hackage.haskell.org/package/base/docs/Control-Exception-Base.html#v:try 66 | -- Hint 2: Have a look at https://hackage.haskell.org/package/transformers/docs/Control-Monad-Trans-Except.html 67 | } 68 | 69 | -- | Count the number of lines, words and chars. 70 | allCounts :: ClSF App StdinWithEOF () (Int, Int, Int) 71 | allCounts = proc () -> do 72 | userInput <- tagS -< () 73 | 74 | let wordCount = length $ Text.words userInput 75 | charCount = Text.length userInput + 1 76 | 77 | lineCount <- count @Int -< () 78 | totalWordCount <- sumN -< wordCount 79 | totalCharCount <- sumN -< charCount 80 | returnA -< (lineCount, totalWordCount, totalCharCount) 81 | 82 | -- | Print the three counts. 83 | printCounts :: ClSF App StdinWithEOF (Int, Int, Int) () 84 | printCounts = proc (lineCount, totalWordCount, totalCharCount) -> do 85 | arrMCl $ liftIO . print -< lineCount 86 | arrMCl $ liftIO . print -< totalWordCount 87 | arrMCl $ liftIO . print -< totalCharCount 88 | 89 | -- | On every 1000th line, print the number of total lines, words and characters so far. 90 | printAllCounts :: ClSF App StdinWithEOF () () 91 | printAllCounts = proc () -> do 92 | counts@(lineCount, _, _) <- allCounts -< () 93 | if lineCount `mod` 1000 == 0 94 | then printCounts -< counts 95 | else returnA -< () 96 | 97 | main :: IO () 98 | main = do 99 | -- The type is ambiguous because GHC cannot infer what e is. 100 | -- Give it a type signature to help it! 101 | Left (e :: IOError) <- runExceptT $ flow $ printAllCounts @@ stdinWithEOF 102 | putStrLn $ "The following error occurred: " ++ show e 103 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/3-modularize/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | Modularize. 2 | 3 | To make a round-based game, we need to encode the rounds in some way. 4 | The most natural way to do this in Rhine is to define a separate clock where each tick corresponds to one round! 5 | 6 | Let's do this here. 7 | For the rest of this track, we will just assume that a round lasts half a second. 8 | So we should use a @'Millisecond' 500@ clock! 9 | 10 | The devil is in the details, though. 11 | We now have two different components, the game clock and the visualization clock. 12 | But they run on different monads and time domains! 13 | You will have to translate between them in order to make everything flow together. 14 | 15 | Some background on monads and time domains: 16 | Have a look at https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-Clock.html#t:Clock. 17 | * The type variable @m@ in @Clock m cl@ is the monad in which the clock takes side effects while ticking. 18 | It also determines how multiple clocks are scheduled. 19 | A clock can be tied to a particular monad, or be polymorphic in it. 20 | You can also change the monad with a 'HoistClock' (https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-Clock.html#t:HoistClock). 21 | * The associated type @Time cl@ is called the /time domain/. 22 | It is the type of time stamps that the clock emits while ticking. 23 | A clock always has one fixed time domain. 24 | To change it, you need to create a new clock, by applying a clock rescaling: 25 | https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-Clock.html#t:RescaledClock 26 | -} 27 | module Koan where 28 | 29 | -- base 30 | import GHC.Float (double2Float) 31 | 32 | -- rhine 33 | import FRP.Rhine 34 | 35 | -- rhine-gloss 36 | import FRP.Rhine.Gloss 37 | 38 | -- * Game logic 39 | 40 | {- | A circle that moves upwards by 10 pixels every second. 41 | 42 | Its type signature ensures that it will be run on the 'GameClock'. 43 | -} 44 | movingCircle :: ClSF GlossConc GameClock () Picture 45 | -- The cryptic type error wants to tell us that the time since clock initialisation is in Double, but gloss expects a Float! 46 | -- Can you convert one to the other? 47 | movingCircle = sinceInitS >-> arr (\t -> translate 0 (10 * double2Float t) $ circleSolid 10) -- realToFrac works as well! 48 | 49 | -- | A clock that ticks at every round of the game. 50 | type GameClock = 51 | -- Actually we just want a Millisecond 500 clock, but that is in the 'IO' monad, 52 | -- while the gloss backend expects a particular monad, 'GlossConc' or 'GlossConcT'. 53 | -- Luckily there is also a utility to lift any 'IO' clock to it! 54 | -- Have a look at https://hackage.haskell.org/package/rhine-gloss/docs/FRP-Rhine-Gloss-IO.html. 55 | GlossConcTClock IO (Millisecond 500) 56 | 57 | gameClock :: GameClock 58 | -- The clock type lifting function from above also has a corresponding value level function! 59 | gameClock = glossConcTClock waitClock 60 | 61 | -- * Visualization 62 | 63 | -- | Paint a gloss picture 64 | visualize :: BehaviourF GlossConc UTCTime Picture () 65 | visualize = arrMCl paintAllIO 66 | 67 | -- | Draw at every tick of the gloss backend 68 | type VisualizationClock = 69 | -- The gloss backend has the TimeDomain Float, 70 | -- but we want to use UTCTime instead! 71 | -- Again, in https://hackage.haskell.org/package/rhine-gloss/docs/FRP-Rhine-Gloss-IO.html 72 | -- you will find a type operator that rescales a gloss clock to UTC. 73 | GlossClockUTC IO GlossSimClockIO 74 | 75 | visualizationClock :: VisualizationClock 76 | visualizationClock = glossClockUTC GlossSimClockIO 77 | 78 | rhine :: Rhine GlossConc (GameClock `SequentialClock` VisualizationClock) () () 79 | -- Find the right resampling buffer to transport the rendered image from the game clock to the visualization clock. 80 | -- It should have two properties: 81 | -- 1. It should always output the newest image. 82 | -- 2. At startup, before the first round of the game has started, a blank image should be displayed. 83 | rhine = movingCircle @@ gameClock >-- keepLast blank --> visualize @@ visualizationClock 84 | 85 | main :: IO () 86 | -- Make sure to keep this definition here as it is: The tests depend on it. 87 | main = flowGlossIO defaultSettings rhine 88 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Learn rhine with koans 2 | 3 | This repository is a playground to learn the Functional Reactive Programming (FRP) framework [`rhine`](https://hackage.haskell.org/package/rhine). 4 | 5 | By solving many small, self-contained exercises, 6 | you can learn about all the fundamentals, and some advanced topic of `rhine`, 7 | a Haskell library for reactive programming with type level clocks. 8 | 9 | ## How do I do this? 10 | 11 | ### Prerequisites 12 | 13 | You should have Haskell and cabal installed. 14 | Stack is not required. 15 | Haskell Language Server is highly recommended. 16 | Have a look at https://www.haskell.org/downloads/ for installation instructions. 17 | 18 | If you have `nix` installed, all you need to do is: 19 | 20 | ``` 21 | nix develop 22 | ``` 23 | 24 | ### Get started 25 | 26 | Clone this repository and enter it on a console. 27 | Then run this command: 28 | 29 | ``` 30 | cabal test basic-1-1-hello-rhine-test 31 | ``` 32 | 33 | It will fail! And it is your task now to fix it. 34 | The error message tells you which file to edit. 35 | By reading through the file, and filling in the missing part, 36 | you will learn a bit about `rhine`. 37 | 38 | ### How to go on 39 | 40 | If the previous test now passes, you're ready to tackle the next task! 41 | 42 | Run this command: 43 | 44 | ``` 45 | cabal test basic-1-2-fix-the-bug-test 46 | ``` 47 | 48 | Again it will fail, and again it is your job to fix it and learn something in the process. 49 | 50 | This way, you can go on step by step, increasing the track, chapter number and koan number (see below). 51 | 52 | There are many small programs for you to edit and fix, 53 | each of which will teach you something new. 54 | All programs are organised by _tracks_, 55 | which in turn are subdivided into a few chapters. 56 | Tracks have names (like `basic`), chapters and koans have numbers: 57 | ``` 58 | # /--- The track 59 | # | 60 | # | /--- The chapter 61 | # | | 62 | # | | /--- The koan number 63 | # | | | 64 | # v v v 65 | cabal test basic-1-2-fix-the-bug-test 66 | ``` 67 | 68 | ### What tracks are there? 69 | 70 | * `basic`: Write some simple Rhine programs. Start here. 71 | Learn about signal functions, clocks, and resampling buffers. 72 | * `ui`: Create a clone of the classic Snake game by using `rhine-gloss`. 73 | 74 | #### Install system dependencies for the `ui` track 75 | 76 | ##### `nix` 77 | 78 | If you have `nix` installed (recommended), simply do: 79 | 80 | ``` 81 | nix develop 82 | ``` 83 | 84 | See `flake.nix` for more options, 85 | for example you could do `nix develop .#ghc98` to run the koans with GHC 9.8. 86 | 87 | ##### Debian, Ubuntu, ... 88 | 89 | In Debian-based systems, do: 90 | 91 | ``` 92 | sudo apt-get install -y libgl1-mesa-dev libglu1-mesa-dev freeglut3-dev 93 | ``` 94 | 95 | ### Stuck? 96 | 97 | #### Want to figure out what your program is doing? 98 | Instead of running the test straight ahead, 99 | you can also run your program you've been writing directly, for example: 100 | ``` 101 | cabal run basic-1-2-fix-the-bug 102 | ``` 103 | 104 | #### Can't find the solution? 105 | Have a look at the file `koans/your-track-here/your-chapter-number/your-koan-number-koan-title/solution/Koan.hs`. 106 | For example, if you can't get `cabal test basic-1-2-fix-the-bug-test` to work, 107 | you'd be looking for the file `koans/basic/1/2-fix-the-bug/solution/Koan.hs`. 108 | It contains the solution to this task. 109 | You can also run the solution by adding the `solution` cabal flag: 110 | ``` 111 | cabal run basic-1-2-fix-the-bug -fsolution 112 | ``` 113 | You can even test the solution: 114 | ``` 115 | cabal test basic-1-2-fix-the-bug-test -fsolution 116 | ``` 117 | 118 | #### Maybe something is wrong in the `rhine-koans` repo? 119 | We're glad to hear from you in this case! 120 | Feel free to file an issue here: 121 | https://github.com/turion/rhine-koans/issues/new 122 | 123 | ## I'd rather read about `rhine` first 124 | 125 | You're heartily invited! Have a look at https://github.com/turion/rhine?tab=readme-ov-file#learn-rhine for all the resources available. 126 | 127 | ## I'm attending/I was attending Zurihac '24 128 | 129 | That's great! The slides for [the workshop](https://zfoh.ch/zurihac2024/#track-frp) are here: 130 | 131 | https://github.com/turion/rhine-koans/blob/main/presentation/presentation.pdf 132 | -------------------------------------------------------------------------------- /koans/basic/3/3-asynchronize/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE StrictData #-} 3 | 4 | {- | Asynchronize. 5 | 6 | Our word count application is somewhat usable now, 7 | but so far it was forced to be single threaded because of the use of 'StateT'. 8 | Adding further clocks to it is not possible in a general state monad. 9 | 10 | Luckily, there are other monads that can be scheduled concurrently in Rhine 11 | which give us all the capability we need. 12 | To track the total number of lines, words and characters, 13 | we keep a central accumulation state which we update for every new line with an increment. 14 | Such a state is modelled well as a monoid, so we can use the 'AccumT' monad transformer for it! 15 | In case you haven't heard of it yet, now is a good time to familiarise yourself with it: 16 | https://hackage.haskell.org/package/transformers/docs/Control-Monad-Trans-Accum.html 17 | 18 | The advantage of 'AccumT' is that it is an instance of 'MonadSchedule', 19 | so we can use several clocks in this monad and schedule them. 20 | Let's use this to change the word count application slightly such that it doesn't output a running count on every 1000 lines, 21 | but instead every second! This means adding a Millisecond 1000 clock, and printing on every tick of it. 22 | -} 23 | module Koan where 24 | 25 | -- base 26 | import Control.Exception qualified as Exception 27 | 28 | -- transformers 29 | import Control.Monad.Trans.Accum (AccumT (..), add, look, runAccumT) 30 | import Control.Monad.Trans.Class (MonadTrans (lift)) 31 | 32 | -- text 33 | import Data.Text qualified as Text (length, words) 34 | 35 | -- rhine 36 | import FRP.Rhine hiding (add) 37 | 38 | {- | A count of chars, words and lines. 39 | 40 | This is the central state of our application. 41 | -} 42 | data WordCount = WordCount 43 | { nChars :: Int 44 | , nWords :: Int 45 | , nLines :: Int 46 | } 47 | deriving (Show, Read) 48 | 49 | instance Semigroup WordCount where 50 | WordCount c1 w1 l1 <> WordCount c2 w2 l2 = 51 | WordCount 52 | { nChars = c1 + c2 53 | , nWords = w1 + w2 54 | , nLines = l1 + l2 55 | } 56 | 57 | instance Monoid WordCount where 58 | mempty = WordCount 0 0 0 59 | 60 | -- | The application monad with exceptions and accumulation state 61 | type App = ExceptT IOError (AccumT WordCount IO) 62 | 63 | type StdinWithEOF = HoistClock IO App StdinClock 64 | 65 | stdinWithEOF :: StdinWithEOF 66 | stdinWithEOF = 67 | HoistClock 68 | { unhoistedClock = StdinClock 69 | , monadMorphism = ExceptT . lift . Exception.try 70 | } 71 | 72 | -- | Count the number of lines, words and chars. 73 | allCounts :: ClSF App StdinWithEOF () () 74 | allCounts = proc () -> do 75 | userInput <- tagS -< () 76 | 77 | -- Caution: In AccumT, we only add increments to the state, we don't set the whole state. 78 | let nChars = _ 79 | nWords = _ 80 | nLines = _ 81 | 82 | -- Have a look at https://hackage.haskell.org/package/transformers-0.6.1.0/docs/Control-Monad-Trans-Accum.html#g:3 83 | -- which operation is used to add an increment to the state. 84 | arrMCl $ lift . _ 85 | -< 86 | WordCount 87 | { nLines 88 | , nWords 89 | , nChars 90 | } 91 | 92 | -- | Print the three counts. 93 | printCounts :: ClSF App (IOClock App (Millisecond 1000)) () () 94 | printCounts = proc () -> do 95 | -- To understand the runtime behaviour better, let's also output the absolute time and the time since clock initialisation. 96 | -- These are part of the TimeInfo which is always available in a ClSF. 97 | -- See https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-Clock.html#t:TimeInfo for details. 98 | -- Can you match on the corresponding record fields and print them? 99 | TimeInfo {} <- timeInfo -< () 100 | arrMCl $ liftIO . print -< _ 101 | arrMCl $ liftIO . print -< _ 102 | 103 | -- Have a look at https://hackage.haskell.org/package/transformers-0.6.1.0/docs/Control-Monad-Trans-Accum.html#g:3 104 | -- which operation is used to look up the current state. 105 | counts <- constMCl $ lift _ -< () 106 | arrMCl $ liftIO . print -< counts 107 | 108 | main :: IO () 109 | main = do 110 | (Left (_ :: IOError), result :: WordCount) <- 111 | flip runAccumT mempty $ 112 | runExceptT $ 113 | flow $ 114 | -- The |@| operator combines two Rhines parallely in time. 115 | -- They will be executed concurrently, but share the same monad. 116 | -- Our App monad is an instance of MonadIO. 117 | -- Have a look in https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-Clock.html 118 | -- for a function that lifts waitClock to an arbitrary MonadIO. 119 | allCounts @@ stdinWithEOF |@| printCounts @@ _ waitClock 120 | putStrLn $ "Final result: " ++ show result 121 | -------------------------------------------------------------------------------- /koans/basic/3/3-asynchronize/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE StrictData #-} 3 | 4 | {- | Asynchronize. 5 | 6 | Our word count application is somewhat usable now, 7 | but so far it was forced to be single threaded because of the use of 'StateT'. 8 | Adding further clocks to it is not possible in a general state monad. 9 | 10 | Luckily, there are other monads that can be scheduled concurrently in Rhine 11 | which give us all the capability we need. 12 | To track the total number of lines, words and characters, 13 | we keep a central accumulation state which we update for every new line with an increment. 14 | Such a state is modelled well as a monoid, so we can use the 'AccumT' monad transformer for it! 15 | In case you haven't heard of it yet, now is a good time to familiarise yourself with it: 16 | https://hackage.haskell.org/package/transformers/docs/Control-Monad-Trans-Accum.html 17 | 18 | The advantage of 'AccumT' is that it is an instance of 'MonadSchedule', 19 | so we can use several clocks in this monad and schedule them. 20 | Let's use this to change the word count application slightly such that it doesn't output a running count on every 1000 lines, 21 | but instead every second! This means adding a Millisecond 1000 clock, and printing on every tick of it. 22 | -} 23 | module Koan where 24 | 25 | -- base 26 | import Control.Exception qualified as Exception 27 | 28 | -- transformers 29 | import Control.Monad.Trans.Accum (AccumT (..), add, look, runAccumT) 30 | import Control.Monad.Trans.Class (MonadTrans (lift)) 31 | 32 | -- text 33 | import Data.Text qualified as Text (length, words) 34 | 35 | -- rhine 36 | import FRP.Rhine hiding (add) 37 | 38 | {- | A count of chars, words and lines. 39 | 40 | This is the central state of our application. 41 | -} 42 | data WordCount = WordCount 43 | { nChars :: Int 44 | , nWords :: Int 45 | , nLines :: Int 46 | } 47 | deriving (Show, Read) 48 | 49 | instance Semigroup WordCount where 50 | WordCount c1 w1 l1 <> WordCount c2 w2 l2 = 51 | WordCount 52 | { nChars = c1 + c2 53 | , nWords = w1 + w2 54 | , nLines = l1 + l2 55 | } 56 | 57 | instance Monoid WordCount where 58 | mempty = WordCount 0 0 0 59 | 60 | -- | The application monad with exceptions and accumulation state 61 | type App = ExceptT IOError (AccumT WordCount IO) 62 | 63 | type StdinWithEOF = HoistClock IO App StdinClock 64 | 65 | stdinWithEOF :: StdinWithEOF 66 | stdinWithEOF = 67 | HoistClock 68 | { unhoistedClock = StdinClock 69 | , monadMorphism = ExceptT . lift . Exception.try 70 | } 71 | 72 | -- | Count the number of lines, words and chars. 73 | allCounts :: ClSF App StdinWithEOF () () 74 | allCounts = proc () -> do 75 | userInput <- tagS -< () 76 | 77 | -- Caution: In AccumT, we only add increments to the state, we don't set the whole state. 78 | let nChars = Text.length userInput + 1 79 | nWords = length $ Text.words userInput 80 | nLines = 1 81 | 82 | -- Have a look at https://hackage.haskell.org/package/transformers-0.6.1.0/docs/Control-Monad-Trans-Accum.html#g:3 83 | -- which operation is used to add an increment to the state. 84 | arrMCl $ lift . add 85 | -< 86 | WordCount 87 | { nLines 88 | , nWords 89 | , nChars 90 | } 91 | 92 | -- | Print the three counts. 93 | printCounts :: ClSF App (IOClock App (Millisecond 1000)) () () 94 | printCounts = proc () -> do 95 | -- To understand the runtime behaviour better, let's also output the absolute time and the time since clock initialisation. 96 | -- These are part of the TimeInfo which is always available in a ClSF. 97 | -- See https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-Clock.html#t:TimeInfo for details. 98 | -- Can you match on the corresponding record fields and print them? 99 | TimeInfo {absolute, sinceInit} <- timeInfo -< () 100 | arrMCl $ liftIO . print -< absolute 101 | arrMCl $ liftIO . print -< sinceInit 102 | 103 | -- Have a look at https://hackage.haskell.org/package/transformers-0.6.1.0/docs/Control-Monad-Trans-Accum.html#g:3 104 | -- which operation is used to look up the current state. 105 | counts <- constMCl $ lift look -< () 106 | arrMCl $ liftIO . print -< counts 107 | 108 | main :: IO () 109 | main = do 110 | (Left (_ :: IOError), result :: WordCount) <- 111 | flip runAccumT mempty $ 112 | runExceptT $ 113 | flow $ 114 | -- The |@| operator combines two Rhines parallely in time. 115 | -- They will be executed concurrently, but share the same monad. 116 | -- Our App monad is an instance of MonadIO. 117 | -- Have a look in https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-Clock.html 118 | -- for a function that lifts waitClock to an arbitrary MonadIO. 119 | allCounts @@ stdinWithEOF |@| printCounts @@ ioClock waitClock 120 | putStrLn $ "Final result: " ++ show result 121 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "Rhine-koans presentation"; 3 | 4 | nixConfig = { 5 | extra-substituters = [ 6 | "https://rhine-koans.cachix.org" 7 | "https://rhine.cachix.org" 8 | ]; 9 | extra-trusted-public-keys = [ 10 | "rhine-koans.cachix.org-1:cglDz0vWVge7HGENYsJRB6yU7+jZNXJyZ0Ud9Z0uW54=" 11 | "rhine.cachix.org-1:oFsONI6lXn3XG4aVmIURDa2Rn0dW5XTPy6eJWROIs8k=" 12 | ]; 13 | }; 14 | 15 | inputs = { 16 | nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable-small"; 17 | 18 | nix-mkPandoc = { 19 | url = "github:chisui/nix-mkPandoc"; 20 | flake = false; 21 | }; 22 | 23 | rhine = { 24 | url = "github:turion/rhine"; 25 | inputs.nixpkgs.follows = "nixpkgs"; 26 | }; 27 | }; 28 | 29 | outputs = inputs@{ self, nixpkgs, nix-mkPandoc, rhine }: 30 | with builtins; 31 | let 32 | lib = inputs.nixpkgs.lib; 33 | # All GHC versions that this project is tested with. 34 | # To be kept in sync with the `tested-with:` section in rhine-koans.cabal. 35 | # To do: Automated check whether this is the same as what get-tested returns. 36 | # Currently blocked on https://github.com/Kleidukos/get-tested/issues/39 37 | supportedGhcs = [ 38 | "ghc94" 39 | "ghc96" 40 | "ghc98" 41 | "ghc910" 42 | ]; 43 | # The Haskell packages set, for every supported GHC version 44 | hpsFor = pkgs: 45 | lib.genAttrs supportedGhcs (ghc: pkgs.haskell.packages.${ghc}) 46 | // { default = pkgs.haskellPackages; }; 47 | 48 | # A nixpkgs overlay containing everything defined in this repo, for reuse in downstream projects 49 | localOverlay = final: prev: 50 | let 51 | # A haskellPackages overlay containing everything defined in this repo 52 | haskellPackagesOverlay = hfinal: hprev: { 53 | rhine-koans = prev.haskell.lib.compose.enableCabalFlag "solution" (hfinal.callCabal2nix "rhine-koans" ./. { }); 54 | }; 55 | 56 | hps = hpsFor final; 57 | 58 | # Overrides that are necessary because of dependencies not being up to date or fixed yet in nixpkgs. 59 | # Check on nixpkgs bumps whether some of these can be removed. 60 | temporaryHaskellOverrides = with prev.haskell.lib.compose; [ 61 | (hfinal: hprev: { 62 | time-domain = doJailbreak hprev.time-domain; 63 | }) 64 | ]; 65 | in 66 | { 67 | # The Haskell package set containing the packages defined in this repo 68 | haskell = prev.haskell // { 69 | packageOverrides = lib.composeManyExtensions ([ 70 | prev.haskell.packageOverrides 71 | haskellPackagesOverlay 72 | ] 73 | ++ temporaryHaskellOverrides 74 | ); 75 | }; 76 | 77 | rhine-koans-all = prev.symlinkJoin { 78 | name = "rhine-koans-all"; 79 | paths = map (hp: hp.rhine-koans) (attrValues hps); 80 | }; 81 | }; 82 | 83 | overlay = lib.composeManyExtensions [ 84 | rhine.overlays.dependenciesOverlay 85 | localOverlay 86 | ]; 87 | 88 | 89 | # Helper to build a flake output for all systems that are defined in nixpkgs 90 | forAllPlatforms = f: 91 | mapAttrs (system: pkgs: f system pkgs) inputs.nixpkgs.legacyPackages; 92 | 93 | in 94 | { 95 | # Reexport the overlay so other downstream flakes can use it to develop rhine-koans projects with low effort. 96 | overlays.default = overlay; 97 | 98 | # Usage: nix fmt 99 | formatter = forAllPlatforms (system: pkgs: pkgs.nixpkgs-fmt); 100 | 101 | # Build the presentation or rhine-koans executables on all GHCs, as well as docs and sdist 102 | # Usage: 103 | # - nix build 104 | # - nix build .#rhine-koans-all 105 | packages = forAllPlatforms (system: pkgs: { 106 | inherit (pkgs) rhine-koans-all; 107 | presentation = import ./presentation { inherit pkgs nix-mkPandoc; }; 108 | } // lib.mapAttrs (ghcVersion: haskellPackages: haskellPackages.rhine-koans) (hpsFor (pkgs.extend overlay))); 109 | 110 | # We re-export the entire nixpkgs package set with our overlay. 111 | # Usage examples: 112 | # - nix build .#haskellPackages.rhine-koans 113 | # - nix build .#haskell.packages.ghc98.rhine-koans 114 | legacyPackages = forAllPlatforms (system: pkgs: pkgs.extend overlay); 115 | 116 | # Usage: nix develop (will use the default GHC) 117 | # Alternatively, specify the GHC: nix develop .#ghc98 118 | devShells = forAllPlatforms (systems: pkgs: mapAttrs 119 | (_: hp: hp.shellFor { 120 | packages = ps: [ ps.rhine-koans ]; 121 | nativeBuildInputs = (with hp; [ 122 | haskell-language-server 123 | ]) ++ (with pkgs; with haskellPackages; [ 124 | cabal-gild 125 | cabal-install 126 | fourmolu 127 | ]); 128 | }) 129 | (hpsFor (pkgs.extend overlay))); 130 | 131 | inherit supportedGhcs; 132 | }; 133 | } 134 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/4-user-input/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | User input. 2 | 3 | The game moves forward every half a second. 4 | The gloss pictures are drawn at a fixed frame rate of 30 frames per second. 5 | User input, however, arrives at unpredictable times! 6 | This means that user input events constitute a separate clock. 7 | 8 | rhine-gloss provides such a clock, 'GlossEventClockIO', but it ticks at every event that the gloss backend emits. 9 | In our game of snake, we are only interested in those events where the player presses the right arrow key or the left arrow key. 10 | Every time this happens, the event should be forwarded to the game logic, 11 | where it should turn the direction into which the snake is heading. 12 | -} 13 | module Koan where 14 | 15 | -- rhine 16 | import FRP.Rhine 17 | 18 | -- rhine-gloss 19 | import FRP.Rhine.Gloss 20 | 21 | -- * Grid positions on the playing board 22 | 23 | -- | Currently, a snake will have size 1, so its body is defined by a single position. 24 | data Position = Position 25 | { x :: Int 26 | , y :: Int 27 | } 28 | deriving (Eq, Ord) 29 | 30 | instance Semigroup Position where 31 | Position x1 y1 <> Position x2 y2 = Position (x1 + x2) (y1 + y2) 32 | 33 | instance Monoid Position where 34 | mempty = Position 0 0 35 | 36 | renderPosition :: Position -> Picture 37 | renderPosition Position {x, y} = translate (fromIntegral x) (fromIntegral y) $ circleSolid 0.6 38 | 39 | -- | Directions in which the snake can head 40 | data Direction = East | North | West | South 41 | deriving (Enum) 42 | 43 | -- | A position changes by a direction in one step 44 | stepPosition :: Direction -> Position -> Position 45 | stepPosition East = (<> Position 1 0) 46 | stepPosition North = (<> Position 0 1) 47 | stepPosition West = (<> Position (-1) 0) 48 | stepPosition South = (<> Position 0 (-1)) 49 | 50 | -- * User input 51 | 52 | -- | The user can change the direction of the snake 53 | data Turn 54 | = -- | Turn right (clockwise) when the right arrow is pressed. 55 | TurnRight 56 | | -- | Turn left (counterclockwise) when the left arrow is pressed. 57 | TurnLeft 58 | deriving (Show) 59 | 60 | -- | Select only those input events that correspond to turns of the snake 61 | type UserClock = GlossClockUTC IO (SelectClock GlossEventClockIO Turn) 62 | 63 | -- | Ticks whenever the user wants to turn right or left 64 | userClock :: UserClock 65 | userClock = 66 | glossClockUTC $ 67 | SelectClock 68 | { mainClock = GlossEventClockIO 69 | , -- Select only those events here that are relevant for the game, the right arrow key and the left arrow key. 70 | -- Have a look at https://hackage.haskell.org/package/gloss/docs/Graphics-Gloss-Interface-IO-Interact.html#t:Event. 71 | -- All other events should be mapped to Nothing. 72 | select = \case 73 | _ -> _ 74 | -- Hint: The important bits are KeyLeft and KeyRight! 75 | } 76 | 77 | -- | User input to turn the snake 78 | user :: ClSF GlossConc UserClock () Turn 79 | user = tagS -- This simply returns the value of the current event, that is, the selected turn. 80 | 81 | -- * Game logic 82 | 83 | -- | Applying a turn to the current direction can give a new direction, shifted clockwise or counterclockwise. 84 | changeDirection :: Turn -> Direction -> Direction 85 | changeDirection TurnRight direction = toEnum $ (fromEnum direction - 1) `mod` 4 86 | changeDirection TurnLeft direction = toEnum $ (fromEnum direction + 1) `mod` 4 87 | 88 | type GameClock = GlossConcTClock IO (Millisecond 500) 89 | 90 | gameClock :: GameClock 91 | gameClock = glossConcTClock waitClock 92 | 93 | -- | The current position of the tiny snake, reacting to turns of the player. 94 | game :: ClSF GlossConc GameClock (Maybe Turn) Position 95 | -- unfold takes a starting state and a step function to create a signal function. 96 | game = unfold (mempty, North) $ \turnMaybe (position, direction) -> 97 | -- Use helper functions defined above to calculate the new position and direction! 98 | let newDirection = _ 99 | newPosition = _ 100 | in Result _ _ 101 | 102 | -- * Visualization 103 | 104 | -- | Scale and paint a gloss picture 105 | visualize :: BehaviourF GlossConc UTCTime Picture () 106 | visualize = arrMCl $ scale 20 20 >>> paintAllIO 107 | 108 | -- | Draw at 30 FPS 109 | type VisualizationClock = GlossClockUTC IO GlossSimClockIO 110 | 111 | visualizationClock :: VisualizationClock 112 | visualizationClock = glossClockUTC GlossSimClockIO 113 | 114 | -- * The whole program 115 | 116 | rhine :: Rhine GlossConc (UserClock `SequentialClock` (GameClock `SequentialClock` VisualizationClock)) () () 117 | rhine = 118 | user 119 | @@ userClock 120 | -- The choice of resampling buffer here has a big influence on the game play. 121 | -- A FIFO buffer will make sure that no user input is lost, but it also means that only one turn is performed per step. 122 | >-- fifoBounded 1000 123 | --> (game >-> arr renderPosition @@ gameClock) 124 | >-- keepLast mempty 125 | --> visualize 126 | @@ visualizationClock 127 | 128 | main :: IO () 129 | -- Make sure to keep this definition here as it is: The tests depend on it. 130 | main = flowGlossIO defaultSettings rhine 131 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/4-user-input/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {- | User input. 2 | 3 | The game moves forward every half a second. 4 | The gloss pictures are drawn at a fixed frame rate of 30 frames per second. 5 | User input, however, arrives at unpredictable times! 6 | This means that user input events constitute a separate clock. 7 | 8 | rhine-gloss provides such a clock, 'GlossEventClockIO', but it ticks at every event that the gloss backend emits. 9 | In our game of snake, we are only interested in those events where the player presses the right arrow key or the left arrow key. 10 | Every time this happens, the event should be forwarded to the game logic, 11 | where it should turn the direction into which the snake is heading. 12 | -} 13 | module Koan where 14 | 15 | -- rhine 16 | import FRP.Rhine 17 | 18 | -- rhine-gloss 19 | import FRP.Rhine.Gloss 20 | 21 | -- * Grid positions on the playing board 22 | 23 | -- | Currently, a snake will have size 1, so its body is defined by a single position. 24 | data Position = Position 25 | { x :: Int 26 | , y :: Int 27 | } 28 | deriving (Eq, Ord) 29 | 30 | instance Semigroup Position where 31 | Position x1 y1 <> Position x2 y2 = Position (x1 + x2) (y1 + y2) 32 | 33 | instance Monoid Position where 34 | mempty = Position 0 0 35 | 36 | renderPosition :: Position -> Picture 37 | renderPosition Position {x, y} = translate (fromIntegral x) (fromIntegral y) $ circleSolid 0.6 38 | 39 | -- | Directions in which the snake can head 40 | data Direction = East | North | West | South 41 | deriving (Enum) 42 | 43 | -- | A position changes by a direction in one step 44 | stepPosition :: Direction -> Position -> Position 45 | stepPosition East = (<> Position 1 0) 46 | stepPosition North = (<> Position 0 1) 47 | stepPosition West = (<> Position (-1) 0) 48 | stepPosition South = (<> Position 0 (-1)) 49 | 50 | -- * User input 51 | 52 | -- | The user can change the direction of the snake 53 | data Turn 54 | = -- | Turn right (clockwise) when the right arrow is pressed. 55 | TurnRight 56 | | -- | Turn left (counterclockwise) when the left arrow is pressed. 57 | TurnLeft 58 | deriving (Show) 59 | 60 | -- | Select only those input events that correspond to turns of the snake 61 | type UserClock = GlossClockUTC IO (SelectClock GlossEventClockIO Turn) 62 | 63 | -- | Ticks whenever the user wants to turn right or left 64 | userClock :: UserClock 65 | userClock = 66 | glossClockUTC $ 67 | SelectClock 68 | { mainClock = GlossEventClockIO 69 | , -- Select only those events here that are relevant for the game, the right arrow key and the left arrow key. 70 | -- Have a look at https://hackage.haskell.org/package/gloss/docs/Graphics-Gloss-Interface-IO-Interact.html#t:Event. 71 | -- All other events should be mapped to Nothing. 72 | select = \case 73 | (EventKey (SpecialKey KeyRight) Down _ _) -> Just TurnRight 74 | (EventKey (SpecialKey KeyLeft) Down _ _) -> Just TurnLeft 75 | _ -> Nothing 76 | -- Hint: The important bits are KeyLeft and KeyRight! 77 | } 78 | 79 | -- | User input to turn the snake 80 | user :: ClSF GlossConc UserClock () Turn 81 | user = tagS -- This simply returns the value of the current event, that is, the selected turn. 82 | 83 | -- * Game logic 84 | 85 | -- | Applying a turn to the current direction can give a new direction, shifted clockwise or counterclockwise. 86 | changeDirection :: Turn -> Direction -> Direction 87 | changeDirection TurnRight direction = toEnum $ (fromEnum direction - 1) `mod` 4 88 | changeDirection TurnLeft direction = toEnum $ (fromEnum direction + 1) `mod` 4 89 | 90 | type GameClock = GlossConcTClock IO (Millisecond 500) 91 | 92 | gameClock :: GameClock 93 | gameClock = glossConcTClock waitClock 94 | 95 | -- | The current position of the tiny snake, reacting to turns of the player. 96 | game :: ClSF GlossConc GameClock (Maybe Turn) Position 97 | -- unfold takes a starting state and a step function to create a signal function. 98 | game = unfold (mempty, North) $ \turnMaybe (position, direction) -> 99 | -- Use helper functions defined above to calculate the new position and direction! 100 | let newDirection = maybe direction (`changeDirection` direction) turnMaybe 101 | newPosition = stepPosition newDirection position 102 | in Result (newPosition, newDirection) newPosition 103 | 104 | -- * Visualization 105 | 106 | -- | Scale and paint a gloss picture 107 | visualize :: BehaviourF GlossConc UTCTime Picture () 108 | visualize = arrMCl $ scale 20 20 >>> paintAllIO 109 | 110 | -- | Draw at 30 FPS 111 | type VisualizationClock = GlossClockUTC IO GlossSimClockIO 112 | 113 | visualizationClock :: VisualizationClock 114 | visualizationClock = glossClockUTC GlossSimClockIO 115 | 116 | -- * The whole program 117 | 118 | rhine :: Rhine GlossConc (UserClock `SequentialClock` (GameClock `SequentialClock` VisualizationClock)) () () 119 | rhine = 120 | user 121 | @@ userClock 122 | -- The choice of resampling buffer here has a big influence on the game play. 123 | -- A FIFO buffer will make sure that no user input is lost, but it also means that only one turn is performed per step. 124 | >-- fifoBounded 1000 125 | --> (game >-> arr renderPosition @@ gameClock) 126 | >-- keepLast mempty 127 | --> visualize 128 | @@ visualizationClock 129 | 130 | main :: IO () 131 | -- Make sure to keep this definition here as it is: The tests depend on it. 132 | main = flowGlossIO defaultSettings rhine 133 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | on: 2 | workflow_dispatch: 3 | pull_request: 4 | push: 5 | branches: 6 | - main 7 | schedule: 8 | - cron: '23 14 * * 2' 9 | release: 10 | 11 | name: build 12 | 13 | jobs: 14 | lint: 15 | name: "Run hlint" 16 | runs-on: ubuntu-latest 17 | steps: 18 | - uses: actions/checkout@v6 19 | 20 | - name: Set up HLint 21 | uses: haskell-actions/hlint-setup@v2 22 | 23 | - name: Run HLint 24 | uses: haskell-actions/hlint-run@v2 25 | with: 26 | fail-on: warning 27 | 28 | fourmolu: 29 | name: "Run fourmolu" 30 | runs-on: ubuntu-latest 31 | steps: 32 | - uses: actions/checkout@v6 33 | - uses: haskell-actions/run-fourmolu@v11 34 | with: 35 | version: "0.14.0.0" 36 | 37 | generateMatrix: 38 | name: "Generate matrix from cabal" 39 | runs-on: ubuntu-latest 40 | outputs: 41 | matrix: ${{ steps.set-matrix.outputs.matrix }} 42 | steps: 43 | - name: Checkout base repo 44 | uses: actions/checkout@v6 45 | - name: Extract the tested GHC versions 46 | id: set-matrix 47 | run: | 48 | wget https://github.com/Kleidukos/get-tested/releases/download/v0.1.5.0/get-tested-0.1.5.0-linux-amd64 -O get-tested 49 | chmod +x get-tested 50 | ./get-tested --ubuntu rhine-koans.cabal >> $GITHUB_OUTPUT 51 | 52 | build-cabal: 53 | runs-on: ubuntu-latest 54 | needs: generateMatrix 55 | strategy: 56 | matrix: ${{ fromJSON(needs.generateMatrix.outputs.matrix) }} 57 | name: Haskell GHC ${{ matrix.ghc }} cabal 58 | steps: 59 | - uses: actions/checkout@v6 60 | - uses: haskell-actions/setup@v2 61 | id: setup 62 | with: 63 | ghc-version: ${{ matrix.ghc }} 64 | 65 | - name: Install system dependencies 66 | run: | 67 | sudo apt-get update 68 | sudo apt-get install -y libgl1-mesa-dev libglu1-mesa-dev freeglut3-dev 69 | 70 | - name: Configure the build 71 | run: | 72 | cabal configure --enable-tests --enable-benchmarks --disable-documentation 73 | cabal build all --dry-run 74 | # The last step generates dist-newstyle/cache/plan.json for the cache key. 75 | 76 | - name: Restore cached dependencies 77 | uses: actions/cache/restore@v5 78 | id: cache 79 | env: 80 | key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }} 81 | with: 82 | path: ${{ steps.setup.outputs.cabal-store }} 83 | key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }} 84 | restore-keys: | 85 | ${{ env.key }}- 86 | 87 | - name: Install dependencies 88 | # If we had an exact cache hit, the dependencies will be up to date. 89 | if: steps.cache.outputs.cache-hit != 'true' 90 | run: cabal build all --only-dependencies 91 | 92 | # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail. 93 | - name: Save cached dependencies 94 | uses: actions/cache/save@v5 95 | # If we had an exact cache hit, trying to save the cache would error because of key clash. 96 | if: steps.cache.outputs.cache-hit != 'true' 97 | with: 98 | path: ${{ steps.setup.outputs.cabal-store }} 99 | key: ${{ steps.cache.outputs.cache-primary-key }} 100 | 101 | - name: Cabal build dependencies 102 | run: cabal build all --enable-tests --only-dependencies 103 | 104 | - name: Cabal build solutions 105 | run: cabal build all --enable-tests -fdev -fsolution 106 | 107 | - name: Cabal test solutions 108 | run: cabal test all --enable-tests --test-show-details=Always -fsolution 109 | 110 | generate-flake-ghc-matrix: 111 | name: Generate GHC versions for nix flake build matrix 112 | runs-on: ubuntu-latest 113 | outputs: 114 | versions: ${{ steps.generate-versions.outputs.versions }} 115 | steps: 116 | - uses: actions/checkout@v6 117 | - uses: cachix/install-nix-action@v31 118 | - name: Generate versions 119 | id: generate-versions 120 | run: | 121 | echo -n "versions=" >> "$GITHUB_OUTPUT" 122 | nix eval .#supportedGhcs --json >> "$GITHUB_OUTPUT" 123 | 124 | build-flake: 125 | name: Nix Flake 126 | needs: generate-flake-ghc-matrix 127 | strategy: 128 | matrix: 129 | version: ${{ fromJSON(needs.generate-flake-ghc-matrix.outputs.versions) }} 130 | fail-fast: false # So the cache is still filled 131 | runs-on: ubuntu-latest 132 | steps: 133 | - uses: actions/checkout@v6 134 | - uses: cachix/install-nix-action@v31 135 | - uses: cachix/cachix-action@v16 136 | with: 137 | name: rhine-koans 138 | authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' 139 | - name: Check whether .nix files are formatted 140 | run: | 141 | nix fmt 142 | git diff --exit-code 143 | - name: Build executables 144 | run: nix build .#${{ matrix.version }} --accept-flake-config 145 | - name: Run tests 146 | run: | 147 | nix develop .#${{ matrix.version }} --accept-flake-config -c cabal update 148 | nix develop .#${{ matrix.version }} --accept-flake-config -c cabal test all -fsolution 149 | 150 | presentation: 151 | name: Build presentation 152 | runs-on: ubuntu-latest 153 | steps: 154 | - uses: actions/checkout@v6 155 | - uses: cachix/install-nix-action@v31 156 | - uses: cachix/cachix-action@v16 157 | with: 158 | name: rhine-koans 159 | authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' 160 | - name: Build presentation 161 | run: nix build .#presentation --accept-flake-config 162 | - name: Install pdftotext 163 | run: nix profile add nixpkgs#poppler-utils 164 | - name: Compare presentation to checked in version 165 | run: diff <(pdftotext -layout presentation/presentation.pdf /dev/stdout) <(pdftotext -layout result/presentation.pdf /dev/stdout) 166 | 167 | diffs: 168 | name: Check whether diffs between solution and problem have changed 169 | runs-on: ubuntu-latest 170 | steps: 171 | - uses: actions/checkout@v6 172 | - name: Check diffs 173 | run: ./check_diffs.sh 174 | 175 | success: 176 | name: All GHCs built successfully 177 | runs-on: ubuntu-latest 178 | needs: 179 | - build-cabal 180 | - build-flake 181 | steps: 182 | - name: Success 183 | run: echo "Success" 184 | -------------------------------------------------------------------------------- /presentation/presentation.md: -------------------------------------------------------------------------------- 1 | --- 2 | author: Manuel Bärenz 3 | title: Rhine, FRP with type-level clocks 4 | subtitle: Functional Reactive Programming for Zurihac '24 5 | date: June 8, 2024 6 | --- 7 | 8 | # Functional Reactive Programming with Rhine 9 | 10 | ## What's this now? 11 | 12 | * I'm Manuel Bärenz (he/him) 13 | * We'll do https://github.com/turion/rhine-koans/ 14 | 15 | ## Plan for this session 16 | 17 | * 14:35 I'll briefly talk about FRP & Rhine (<15 minutes) 18 | * 14:50 If you haven't already, you'll clone the rhine-koans repo 19 | (Or find someone to pair program with!) 20 | * 14:50 I'll show you how it works & walk you through the first koan 21 | * 14:55 You'll solve the basic track, I'll come around and answer your questions 22 | * 15:30 We'll collect & discuss the biggest questions & hardest problems that occurred so far 23 | * 15:40 You'll start on the UI track, or on your own project, I'll come around and answer questions 24 | 25 | # Let me tell you a tale... 26 | 27 | ## ...but don't worry! 28 | 29 | You don't need to memorise everything. 30 | Lean back & relax :) 31 | 32 | # About Functional Reactive Programming 33 | 34 | ## What is Functional Reactive Programming? 35 | 36 | * Ivan Perez/Conal Elliot: FRP is about time. 37 | * Use awareness of time in the program. 38 | * _When_ do computations & effects happen? 39 | 40 | ## Is this here Functional Reactive Programming? 41 | 42 | * It's a workshop on one specific, opinionated framework (https://github.com/turion/rhine) 43 | * There are many other frameworks around that work similarly or quite differently 44 | 45 | # Monadic/effectful streaming 46 | 47 | * Centered around a "main loop" which constantly consumes & produces data, and performs side effects 48 | * "Synchronous": One output per input 49 | * dunai, automaton, essence-of-live-coding, machines, varying, netwire, ... 50 | * __Monadic stream function__: 51 | ```haskell 52 | data MSF m a b = MSF (a -> m (b, MSF m a b)) 53 | ``` 54 | 55 | * "Asynchronous": Many outputs per many inputs 56 | * pipes, conduit, streamly, streaming, machines, ... 57 | 58 | # Functional reactive programming paradigms 59 | 60 | * "Classic" FRP: __Behaviours__ & __events__ 61 | * Morally `type Behaviour a = Time -> a` 62 | * Computations happen all the time! 63 | * Morally `type Event a = [(Time, a)]` 64 | * A computation happens on every event 65 | * FRAN, frpnow, reactive-banana, reflex, ... 66 | * Arrowized FRP: __Signal functions__ 67 | * Morally `type SF a b = Behaviour a -> Behaviour b` 68 | * Yampa, dunai, bearriver, Rhine 69 | * Effectful FRP: "Monadic signal functions" 70 | * `type SF m a b = MSF (ReaderT Time m) a b` 71 | * bearriver, Rhine 72 | 73 | # Rhine: Arrowized FRP with type level clocks 74 | 75 | ## How to organize bigger FRP applications? 76 | 77 | * Different components are activated at different times 78 | * E.g. game simulation at one frame rate, video and audio at other rates, user input as an event source 79 | * Make these differences visible as _type level clocks_ 80 | * Compose synchronous (1-1) and asynchronous (many-many) components safely 81 | * Accidental synchronisation becomes a type error 82 | * Framework to answer the question "_When_ do computations & effects happen?" 83 | 84 | # Rhine concepts 85 | 86 | ## Clock types and values 87 | 88 | ```haskell 89 | class Clock m cl where 90 | type Time cl -- The type of timestamps 91 | type Tag cl -- Additional info about the tick 92 | ... 93 | 94 | -- Ticks every 10 milliseconds. 95 | waitClock :: Millisecond 10 96 | waitClock = ... 97 | instance Clock IO (Millisecond 10) where ... 98 | 99 | -- Ticks for every line entered on stdin. (An "event") 100 | data StdinClock = StdinClock 101 | instance Clock IO StdinClock where 102 | type Tag StdinClock = Text 103 | ... 104 | ``` 105 | 106 | # Rhine concepts 107 | 108 | ## Running example 109 | github.com/turion/rhine/blob/master/rhine-examples/src/Ball.hs 110 | 111 | ## Clocked signal functions (`ClSF`) 112 | 113 | ```haskell 114 | type Ball = (Double, Double, Double) 115 | type BallVel = (Double, Double, Double) 116 | 117 | startVel :: ClSF IO StdinClock () BallVel 118 | startVel = arrMCl $ const $ do 119 | velX <- randomRIO (-10, 10) 120 | velY <- randomRIO (-10, 10) 121 | velZ <- randomRIO (3, 10) 122 | return (velX, velY, velZ) 123 | ``` 124 | 125 | # Rhine concepts 126 | 127 | ## Behaviours: Clock-independent signal functions 128 | 129 | ```haskell 130 | freeFall :: (Monad m) => BallVel -> 131 | BehaviourF m UTCTime () Ball 132 | freeFall v0 = 133 | arr (const (0, 0, -9.81)) 134 | >>> integralFrom v0 135 | >>> integral 136 | ``` 137 | 138 | ## Arrow syntax 139 | 140 | ```haskell 141 | height :: (Monad m) => BallVel -> 142 | BehaviourF m UTCTime () Double 143 | height v0 = proc _ -> do 144 | pos <- freeFall v0 -< () 145 | let (_, _, height) = pos 146 | returnA -< height 147 | ``` 148 | 149 | # Rhine concepts 150 | 151 | ```haskell 152 | throwMaybe :: (Monad m) => 153 | ClSF (ExceptT e m) cl (Maybe e) (Maybe a) 154 | ``` 155 | 156 | ## Throwing exceptions 157 | 158 | ```haskell 159 | falling :: (Monad m) => BallVel -> ClSF (ExceptT () m) 160 | (Millisecond 10) (Maybe BallVel) Ball 161 | falling v0 = proc _ -> do 162 | pos <- freeFall v0 -< () 163 | let (_, _, height) = pos 164 | throwMaybe -< guard $ height < 0 165 | returnA -< pos 166 | 167 | waiting :: (Monad m) => ClSF (ExceptT BallVel m) 168 | (Millisecond 10) (Maybe BallVel) Ball 169 | waiting = throwMaybe >>> arr (const zeroVector) 170 | ``` 171 | 172 | # Rhine concepts 173 | 174 | ```haskell 175 | data ClSFExcept clock input output monad exception 176 | ``` 177 | 178 | ## Handling exceptions 179 | 180 | ```haskell 181 | ballModes :: ClSFExcept (Millisecond 10) 182 | (Maybe BallVel) Ball IO void 183 | ballModes = do 184 | v0 <- try waiting 185 | once_ $ putStrLn "Catch!" 186 | try $ falling v0 187 | once_ $ putStrLn "Caught!" 188 | ballModes 189 | 190 | ball :: ClSF IO (Millisecond 10) (Maybe BallVel) Ball 191 | ball = safely ballModes 192 | ``` 193 | 194 | # Rhine concepts 195 | 196 | ## Top level programs: `Rhine` 197 | 198 | ```haskell 199 | startVelRh :: Rhine IO StdinClock () BallVel 200 | startVelRh = startVel @@ StdinClock 201 | 202 | resample :: ResamplingBuffer IO 203 | StdinClock (Millisecond 10) BallVel (Maybe BallVel) 204 | resample = fifoUnbounded 205 | 206 | ballRh :: Rhine IO (Millisecond 10) (Maybe BallVel) Ball 207 | ballRh = ball @@ waitClock 208 | 209 | mainRhine :: Rhine IO 210 | (SeqClock StdinClock (Millisecond 10)) () () 211 | mainRhine = startVelRh >-- resample --> ballRh 212 | 213 | main = flow mainRhine 214 | ``` 215 | 216 | # Basic track (until 14:00) 217 | 218 | ## Let's get it off the ground! 219 | 220 | ``` 221 | git clone git@github.com:turion/rhine-koans.git 222 | cabal update 223 | cabal run basic-1-1-hello-rhine 224 | cabal test basic-1-1-hello-rhine-test 225 | ``` 226 | 227 | ## Slides 228 | 229 | github.com/turion/rhine-koans/blob/main/presentation/presentation.pdf 230 | 231 | ## Ask me anything :) 232 | 233 | Manuel (he/him), turion on Discord/Discourse/Github/..., turion@types.pl on Mastodon 234 | 235 | # Advanced track 236 | 237 | ## Let's dive in! 238 | 239 | ``` 240 | cabal test ui-1-gloss-1-circle-test 241 | ``` 242 | 243 | ## Ask me anything :) 244 | 245 | Manuel (he/him), turion on Discord/Discourse/Github/..., turion@types.pl on Mastodon 246 | 247 | ## Some project ideas 248 | 249 | * Websocket clock: `https://hackage.haskell.org/package/wuss` 250 | * Webserver: `https://hackage.haskell.org/package/wai` 251 | * Machine learning: `https://hackage.haskell.org/package/rhine-bayes` 252 | * Port the snake to `rhine-terminal` 253 | * Challenge: Rhine entry in https://github.com/gelisam/frp-zoo 254 | 255 | # Thanks! 256 | 257 | * Malte Ott: Alpha testing 258 | * Alex Drake: Invitation to Zurihac, many `rhine-*` libraries 259 | * Jun Matsushita: `rhine-terminal` 260 | * Ivan Perez: Discussions on FRP, dunai & Rhine 261 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/5-randomness/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | Randomness. 4 | 5 | The classic game of snake has apples appearing at random places on the playing grid, 6 | and the snake can move to eat them, growing larger every time it consumes one. 7 | -} 8 | module Koan where 9 | 10 | -- base 11 | import Data.List.NonEmpty hiding (insert, unfold) 12 | import GHC.Generics 13 | import Prelude hiding (head) 14 | 15 | -- random 16 | import System.Random 17 | import System.Random.Stateful (UniformRange (..)) 18 | 19 | -- MonadRandom 20 | import Control.Monad.Random 21 | 22 | -- containers 23 | import Data.Set hiding (toList) 24 | 25 | -- rhine 26 | import FRP.Rhine 27 | 28 | -- rhine-gloss 29 | import FRP.Rhine.Gloss 30 | 31 | -- * Grid positions on the playing board 32 | 33 | boardSize :: Int 34 | boardSize = 9 35 | 36 | -- | A grid position on which a part of the snake body, or an apple, may be. 37 | data Position = Position 38 | { x :: Int 39 | , y :: Int 40 | } 41 | deriving (Generic, Eq, Ord) 42 | 43 | instance Semigroup Position where 44 | Position x1 y1 <> Position x2 y2 = Position (x1 + x2) (y1 + y2) 45 | 46 | instance Monoid Position where 47 | mempty = Position 0 0 48 | 49 | -- | To generate random apple positions 50 | instance Uniform Position 51 | 52 | instance UniformRange Position where 53 | uniformRM (Position xLow yLow, Position xHigh yHigh) g = Position <$> uniformRM (xLow, xHigh) g <*> uniformRM (yLow, yHigh) g 54 | 55 | instance Random Position 56 | 57 | renderPosition :: Position -> Picture 58 | renderPosition Position {x, y} = translate (fromIntegral x) (fromIntegral y) $ circleSolid 0.6 59 | 60 | -- * Directions in which the snake can head 61 | 62 | data Direction = East | North | West | South 63 | deriving (Enum) 64 | 65 | -- | A position changes by a direction in one step 66 | stepPosition :: Direction -> Position -> Position 67 | stepPosition East = (<> Position 1 0) 68 | stepPosition North = (<> Position 0 1) 69 | stepPosition West = (<> Position (-1) 0) 70 | stepPosition South = (<> Position 0 (-1)) 71 | 72 | -- * User input 73 | 74 | -- | The user can change the direction of the snake 75 | data Turn 76 | = -- | Turn right (clockwise) when the right arrow is pressed. 77 | TurnRight 78 | | -- | Turn left (counterclockwise) when the left arrow is pressed. 79 | TurnLeft 80 | deriving (Show) 81 | 82 | -- | Select only those input events that correspond to turns of the snake 83 | type UserClock = GlossClockUTC IO (SelectClock GlossEventClockIO Turn) 84 | 85 | userClock :: UserClock 86 | userClock = 87 | glossClockUTC $ 88 | SelectClock 89 | { mainClock = GlossEventClockIO 90 | , select = \case 91 | (EventKey (SpecialKey KeyRight) Down _ _) -> Just TurnRight 92 | (EventKey (SpecialKey KeyLeft) Down _ _) -> Just TurnLeft 93 | _ -> Nothing 94 | } 95 | 96 | -- | User input to turn the snake 97 | user :: ClSF GlossConc UserClock () Turn 98 | user = tagS 99 | 100 | -- * Game logic 101 | 102 | -- ** Snake 103 | 104 | -- | Applying a turn to the current direction can give a new direction, shifted clockwise or counterclockwise. 105 | changeDirection :: Turn -> Direction -> Direction 106 | changeDirection TurnRight direction = toEnum $ (fromEnum direction - 1) `mod` 4 107 | changeDirection TurnLeft direction = toEnum $ (fromEnum direction + 1) `mod` 4 108 | 109 | -- | Whether the snake currently eats an apple. 110 | data Eat = Eat | DontEat 111 | 112 | data Snake = Snake 113 | { direction :: Direction 114 | , body :: NonEmpty Position 115 | } 116 | 117 | -- | A small snake. 118 | snek :: Direction -> Position -> Snake 119 | snek direction tinyBody = 120 | Snake 121 | { direction 122 | , body = pure tinyBody 123 | } 124 | 125 | -- | On every step, a snake can make a turn, and possibly eat an apple 126 | stepSnake :: Maybe Turn -> Eat -> Snake -> Snake 127 | stepSnake turnMaybe eat snake = 128 | let 129 | newDirection = maybe (direction snake) (`changeDirection` direction snake) turnMaybe 130 | newHead = stepPosition newDirection $ Data.List.NonEmpty.head $ body snake 131 | newTail = tailAfterMeal eat snake 132 | in 133 | Snake 134 | { direction = newDirection 135 | , body = newHead :| newTail 136 | } 137 | where 138 | tailAfterMeal :: Eat -> Snake -> [Position] 139 | tailAfterMeal DontEat = Data.List.NonEmpty.init . body 140 | tailAfterMeal Eat = toList . body 141 | 142 | renderSnake :: Snake -> Picture 143 | renderSnake = foldMap renderPosition . body 144 | 145 | -- ** Apples 146 | 147 | newtype Apple = Apple {getApple :: Position} 148 | deriving (Eq, Ord) 149 | 150 | -- | Randomly generate a new apple every 10 steps, anywhere on the playing board. 151 | newApple :: (Monad m) => ClSF (RandT StdGen m) GameClock () (Maybe Apple) 152 | newApple = proc _ -> do 153 | nSteps :: Int <- count -< () 154 | if nSteps `mod` 10 == 1 155 | then -- Create a new random position for an apple, within a given range. 156 | -- See https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-ClSF-Random.html 157 | -- and keep in mind that RandT gives an instance of MonadRandom. 158 | arr (Just <<< Apple) <<< _ -< (Position (-boardSize) (-boardSize), Position boardSize boardSize) 159 | else returnA -< Nothing 160 | 161 | type Apples = Set Apple 162 | 163 | addAndEatApple :: 164 | -- | Possibly a new apple appeared 165 | Maybe Apple -> 166 | -- | On this position the snake attempted to eat the apple 167 | Position -> 168 | -- | The previous collection of apples 169 | Apples -> 170 | (Apples, Eat) 171 | addAndEatApple addedApple eatPosition oldApples = 172 | let addedApples = maybe oldApples (`insert` oldApples) addedApple 173 | newApples = delete (Apple eatPosition) addedApples 174 | in (newApples, if size newApples < size addedApples then Eat else DontEat) 175 | 176 | renderApple :: Apple -> Picture 177 | renderApple = color red . renderPosition . getApple 178 | 179 | -- ** Combining snake and apples 180 | 181 | type GameClock = GlossConcTClock IO (Millisecond 500) 182 | 183 | gameClock :: GameClock 184 | gameClock = glossConcTClock waitClock 185 | 186 | {- | Given the current user input and whether an apple was eaten in the last round, 187 | output the current snake. 188 | -} 189 | snakeSF :: ClSF GlossConc GameClock (Maybe Turn, Eat) Snake 190 | snakeSF = unfold_ (snek North mempty) $ \(turn, eat) s -> stepSnake turn eat s 191 | 192 | {- | Given the current position of the snake head, 193 | output the set of apples, and whether an apple is currently being eaten 194 | -} 195 | applesSF :: ClSF GlossConc GameClock Position (Apples, Eat) 196 | applesSF = feedback empty $ proc (eatPosition, oldApples) -> do 197 | -- We want to reuse newApple from above to occasionally add new apples. 198 | -- But it's not in the GlossConc monad! 199 | -- Have a look again at https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-ClSF-Random.html 200 | -- to find a way to run newApple in GlossConc by interpreting the RandT monad transformer. 201 | addedApple <- _ -< () 202 | let (newApples, eat) = addAndEatApple addedApple eatPosition oldApples 203 | returnA -< ((newApples, eat), newApples) 204 | 205 | -- | Given the current user input, output the current snake and the apples 206 | game :: ClSF GlossConc GameClock (Maybe Turn) (Snake, Apples) 207 | -- Tie the big knot! Combine snakeSF and applesSF, but take care: 208 | -- Each needs input from the other. 209 | -- snakeSF needs to know whether an apple was eaten in the last round, 210 | -- and applesSF needs to know where the head of the snake is now. 211 | game = _ 212 | 213 | -- Hint 1: Have a look back at the koan basic-2-4-count-all-the-words! 214 | -- Hint 2: Save the information of whether an apple is currently being eaten as internal state, 215 | -- so you will know in the next step whether one was eaten in the last round. 216 | -- Start like this: 217 | -- feedback DontEat _ 218 | 219 | render :: (Snake, Apples) -> Picture 220 | render (snake, apples) = renderSnake snake <> foldMap renderApple apples 221 | 222 | -- * Visualization 223 | 224 | -- | Scale and paint a gloss picture 225 | visualize :: BehaviourF GlossConc UTCTime Picture () 226 | visualize = arrMCl $ scale 20 20 >>> paintAllIO 227 | 228 | -- | Draw at 30 FPS 229 | type VisualizationClock = GlossClockUTC IO GlossSimClockIO 230 | 231 | visualizationClock :: VisualizationClock 232 | visualizationClock = glossClockUTC GlossSimClockIO 233 | 234 | -- * The whole program 235 | 236 | rhine :: Rhine GlossConc (UserClock `SequentialClock` (GameClock `SequentialClock` VisualizationClock)) () () 237 | rhine = 238 | user 239 | @@ userClock 240 | >-- fifoBounded 1000 241 | --> (game >-> arr render @@ gameClock) 242 | >-- keepLast mempty 243 | --> visualize 244 | @@ visualizationClock 245 | 246 | main :: IO () 247 | -- Make sure to keep this definition here as it is: The tests depend on it. 248 | main = flowGlossIO defaultSettings rhine 249 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/5-randomness/solution/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | Randomness. 4 | 5 | The classic game of snake has apples appearing at random places on the playing grid, 6 | and the snake can move to eat them, growing larger every time it consumes one. 7 | -} 8 | module Koan where 9 | 10 | -- base 11 | import Data.List.NonEmpty hiding (insert, unfold) 12 | import GHC.Generics 13 | import Prelude hiding (head) 14 | 15 | -- random 16 | import System.Random 17 | import System.Random.Stateful (UniformRange (..)) 18 | 19 | -- MonadRandom 20 | import Control.Monad.Random 21 | 22 | -- containers 23 | import Data.Set hiding (toList) 24 | 25 | -- rhine 26 | import FRP.Rhine 27 | 28 | -- rhine-gloss 29 | import FRP.Rhine.Gloss 30 | 31 | -- * Grid positions on the playing board 32 | 33 | boardSize :: Int 34 | boardSize = 9 35 | 36 | -- | A grid position on which a part of the snake body, or an apple, may be. 37 | data Position = Position 38 | { x :: Int 39 | , y :: Int 40 | } 41 | deriving (Generic, Eq, Ord) 42 | 43 | instance Semigroup Position where 44 | Position x1 y1 <> Position x2 y2 = Position (x1 + x2) (y1 + y2) 45 | 46 | instance Monoid Position where 47 | mempty = Position 0 0 48 | 49 | -- | To generate random apple positions 50 | instance Uniform Position 51 | 52 | instance UniformRange Position where 53 | uniformRM (Position xLow yLow, Position xHigh yHigh) g = Position <$> uniformRM (xLow, xHigh) g <*> uniformRM (yLow, yHigh) g 54 | 55 | instance Random Position 56 | 57 | renderPosition :: Position -> Picture 58 | renderPosition Position {x, y} = translate (fromIntegral x) (fromIntegral y) $ circleSolid 0.6 59 | 60 | -- * Directions in which the snake can head 61 | 62 | data Direction = East | North | West | South 63 | deriving (Enum) 64 | 65 | -- | A position changes by a direction in one step 66 | stepPosition :: Direction -> Position -> Position 67 | stepPosition East = (<> Position 1 0) 68 | stepPosition North = (<> Position 0 1) 69 | stepPosition West = (<> Position (-1) 0) 70 | stepPosition South = (<> Position 0 (-1)) 71 | 72 | -- * User input 73 | 74 | -- | The user can change the direction of the snake 75 | data Turn 76 | = -- | Turn right (clockwise) when the right arrow is pressed. 77 | TurnRight 78 | | -- | Turn left (counterclockwise) when the left arrow is pressed. 79 | TurnLeft 80 | deriving (Show) 81 | 82 | -- | Select only those input events that correspond to turns of the snake 83 | type UserClock = GlossClockUTC IO (SelectClock GlossEventClockIO Turn) 84 | 85 | userClock :: UserClock 86 | userClock = 87 | glossClockUTC $ 88 | SelectClock 89 | { mainClock = GlossEventClockIO 90 | , select = \case 91 | (EventKey (SpecialKey KeyRight) Down _ _) -> Just TurnRight 92 | (EventKey (SpecialKey KeyLeft) Down _ _) -> Just TurnLeft 93 | _ -> Nothing 94 | } 95 | 96 | -- | User input to turn the snake 97 | user :: ClSF GlossConc UserClock () Turn 98 | user = tagS 99 | 100 | -- * Game logic 101 | 102 | -- ** Snake 103 | 104 | -- | Applying a turn to the current direction can give a new direction, shifted clockwise or counterclockwise. 105 | changeDirection :: Turn -> Direction -> Direction 106 | changeDirection TurnRight direction = toEnum $ (fromEnum direction - 1) `mod` 4 107 | changeDirection TurnLeft direction = toEnum $ (fromEnum direction + 1) `mod` 4 108 | 109 | -- | Whether the snake currently eats an apple. 110 | data Eat = Eat | DontEat 111 | 112 | data Snake = Snake 113 | { direction :: Direction 114 | , body :: NonEmpty Position 115 | } 116 | 117 | -- | A small snake. 118 | snek :: Direction -> Position -> Snake 119 | snek direction tinyBody = 120 | Snake 121 | { direction 122 | , body = pure tinyBody 123 | } 124 | 125 | -- | On every step, a snake can make a turn, and possibly eat an apple 126 | stepSnake :: Maybe Turn -> Eat -> Snake -> Snake 127 | stepSnake turnMaybe eat snake = 128 | let 129 | newDirection = maybe (direction snake) (`changeDirection` direction snake) turnMaybe 130 | newHead = stepPosition newDirection $ Data.List.NonEmpty.head $ body snake 131 | newTail = tailAfterMeal eat snake 132 | in 133 | Snake 134 | { direction = newDirection 135 | , body = newHead :| newTail 136 | } 137 | where 138 | tailAfterMeal :: Eat -> Snake -> [Position] 139 | tailAfterMeal DontEat = Data.List.NonEmpty.init . body 140 | tailAfterMeal Eat = toList . body 141 | 142 | renderSnake :: Snake -> Picture 143 | renderSnake = foldMap renderPosition . body 144 | 145 | -- ** Apples 146 | 147 | newtype Apple = Apple {getApple :: Position} 148 | deriving (Eq, Ord) 149 | 150 | -- | Randomly generate a new apple every 10 steps, anywhere on the playing board. 151 | newApple :: (Monad m) => ClSF (RandT StdGen m) GameClock () (Maybe Apple) 152 | newApple = proc _ -> do 153 | nSteps :: Int <- count -< () 154 | if nSteps `mod` 10 == 1 155 | then -- Create a new random position for an apple, within a given range. 156 | -- See https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-ClSF-Random.html 157 | -- and keep in mind that RandT gives an instance of MonadRandom. 158 | arr (Just <<< Apple) <<< getRandomRS -< (Position (-boardSize) (-boardSize), Position boardSize boardSize) 159 | else returnA -< Nothing 160 | 161 | type Apples = Set Apple 162 | 163 | addAndEatApple :: 164 | -- | Possibly a new apple appeared 165 | Maybe Apple -> 166 | -- | On this position the snake attempted to eat the apple 167 | Position -> 168 | -- | The previous collection of apples 169 | Apples -> 170 | (Apples, Eat) 171 | addAndEatApple addedApple eatPosition oldApples = 172 | let addedApples = maybe oldApples (`insert` oldApples) addedApple 173 | newApples = delete (Apple eatPosition) addedApples 174 | in (newApples, if size newApples < size addedApples then Eat else DontEat) 175 | 176 | renderApple :: Apple -> Picture 177 | renderApple = color red . renderPosition . getApple 178 | 179 | -- ** Combining snake and apples 180 | 181 | type GameClock = GlossConcTClock IO (Millisecond 500) 182 | 183 | gameClock :: GameClock 184 | gameClock = glossConcTClock waitClock 185 | 186 | {- | Given the current user input and whether an apple was eaten in the last round, 187 | output the current snake. 188 | -} 189 | snakeSF :: ClSF GlossConc GameClock (Maybe Turn, Eat) Snake 190 | snakeSF = unfold_ (snek North mempty) $ \(turn, eat) s -> stepSnake turn eat s 191 | 192 | {- | Given the current position of the snake head, 193 | output the set of apples, and whether an apple is currently being eaten 194 | -} 195 | applesSF :: ClSF GlossConc GameClock Position (Apples, Eat) 196 | applesSF = feedback empty $ proc (eatPosition, oldApples) -> do 197 | -- We want to reuse newApple from above to occasionally add new apples. 198 | -- But it's not in the GlossConc monad! 199 | -- Have a look again at https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-ClSF-Random.html 200 | -- to find a way to run newApple in GlossConc by interpreting the RandT monad transformer. 201 | addedApple <- evalRandIOS' newApple -< () 202 | let (newApples, eat) = addAndEatApple addedApple eatPosition oldApples 203 | returnA -< ((newApples, eat), newApples) 204 | 205 | -- | Given the current user input, output the current snake and the apples 206 | game :: ClSF GlossConc GameClock (Maybe Turn) (Snake, Apples) 207 | -- Tie the big knot! Combine snakeSF and applesSF, but take care: 208 | -- Each needs input from the other. 209 | -- snakeSF needs to know whether an apple was eaten in the last round, 210 | -- and applesSF needs to know where the head of the snake is now. 211 | game = feedback DontEat $ proc (turn, eat) -> do 212 | snake <- snakeSF -< (turn, eat) 213 | (apples, eatNext) <- applesSF -< head $ body snake 214 | returnA -< ((snake, apples), eatNext) 215 | 216 | -- Hint 1: Have a look back at the koan basic-2-4-count-all-the-words! 217 | -- Hint 2: Save the information of whether an apple is currently being eaten as internal state, 218 | -- so you will know in the next step whether one was eaten in the last round. 219 | -- Start like this: 220 | -- feedback DontEat _ 221 | 222 | render :: (Snake, Apples) -> Picture 223 | render (snake, apples) = renderSnake snake <> foldMap renderApple apples 224 | 225 | -- * Visualization 226 | 227 | -- | Scale and paint a gloss picture 228 | visualize :: BehaviourF GlossConc UTCTime Picture () 229 | visualize = arrMCl $ scale 20 20 >>> paintAllIO 230 | 231 | -- | Draw at 30 FPS 232 | type VisualizationClock = GlossClockUTC IO GlossSimClockIO 233 | 234 | visualizationClock :: VisualizationClock 235 | visualizationClock = glossClockUTC GlossSimClockIO 236 | 237 | -- * The whole program 238 | 239 | rhine :: Rhine GlossConc (UserClock `SequentialClock` (GameClock `SequentialClock` VisualizationClock)) () () 240 | rhine = 241 | user 242 | @@ userClock 243 | >-- fifoBounded 1000 244 | --> (game >-> arr render @@ gameClock) 245 | >-- keepLast mempty 246 | --> visualize 247 | @@ visualizationClock 248 | 249 | main :: IO () 250 | -- Make sure to keep this definition here as it is: The tests depend on it. 251 | main = flowGlossIO defaultSettings rhine 252 | -------------------------------------------------------------------------------- /koans/ui/1-gloss/6-control-flow/Koan.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | Control flow. 4 | 5 | Sometimes you might want to change the game. 6 | In Rhine (and other frameworks based on monadic stream functions like dunai, bearriver, and essence-of-live-coding), 7 | we throw and catch exceptions to switch between different signal functions. 8 | To do this, there is a monad interface for exception-throwing signal functions, 'ClSFExcept'. 9 | 10 | In short: 11 | 12 | * Exceptions are effects in the 'ExceptT' monad transformer, which is added to the monad stack of the 'ClSF'. 13 | * To enter the new 'ClSFExcept' monad context, you can use: 14 | * 'try :: ClSF (ExceptT e m) cl a b -> ClSFExcept cl a b m e' for switching to a 'ClSF' that may throw an exception 15 | * 'safe :: ClSF m cl a b -> ClSFExcept cl a b m void' for finally switching to a 'ClSF' that will never throw an exception 16 | * To handle exceptions, use do notation: 17 | A 'ClSFExcept' value returns its exception, and you can then switch to the next signal function by adding a statement to the do block. 18 | * To leave the 'ClSFExcept' context after all exceptions have been handled, use 'safely :: ClSFExcept cl a b m Void -> ClSF m cl a b' 19 | 20 | See https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-ClSF-Except.html 21 | and section 4.2 of the original research article https://www.manuelbaerenz.de/files/Rhine.pdf for more details. 22 | 23 | With these ingredients, we can change the game to be over! 24 | Fix the code such that if the snake hits the boundaries or itself, the game will change to a special gameover state. 25 | -} 26 | module Koan where 27 | 28 | -- base 29 | import Data.List.NonEmpty hiding (insert, unfold) 30 | import GHC.Generics 31 | import Prelude hiding (head) 32 | 33 | -- random 34 | import System.Random 35 | import System.Random.Stateful (UniformRange (..)) 36 | 37 | -- MonadRandom 38 | import Control.Monad.Random 39 | 40 | -- containers 41 | import Data.Set hiding (toList) 42 | 43 | -- rhine 44 | import FRP.Rhine 45 | 46 | -- rhine-gloss 47 | import FRP.Rhine.Gloss 48 | 49 | -- * Grid positions on the playing board 50 | 51 | boardSize :: Int 52 | boardSize = 9 53 | 54 | -- | A grid position on which a part of the snake body, or an apple, may be. 55 | data Position = Position 56 | { x :: Int 57 | , y :: Int 58 | } 59 | deriving (Generic, Eq, Ord) 60 | 61 | instance Semigroup Position where 62 | Position x1 y1 <> Position x2 y2 = Position (x1 + x2) (y1 + y2) 63 | 64 | instance Monoid Position where 65 | mempty = Position 0 0 66 | 67 | -- | To generate random apple positions 68 | instance Uniform Position 69 | 70 | instance UniformRange Position where 71 | uniformRM (Position xLow yLow, Position xHigh yHigh) g = Position <$> uniformRM (xLow, xHigh) g <*> uniformRM (yLow, yHigh) g 72 | 73 | instance Random Position 74 | 75 | renderPosition :: Position -> Picture 76 | renderPosition Position {x, y} = translate (fromIntegral x) (fromIntegral y) $ circleSolid 0.6 77 | 78 | -- * Directions in which the snake can head 79 | 80 | data Direction = East | North | West | South 81 | deriving (Enum) 82 | 83 | -- | A position changes by a direction in one step 84 | stepPosition :: Direction -> Position -> Position 85 | stepPosition East = (<> Position 1 0) 86 | stepPosition North = (<> Position 0 1) 87 | stepPosition West = (<> Position (-1) 0) 88 | stepPosition South = (<> Position 0 (-1)) 89 | 90 | -- | The user can change the direction of the snake 91 | data Turn 92 | = -- | Turn right (clockwise) when the right arrow is pressed. 93 | TurnRight 94 | | -- | Turn left (counterclockwise) when the left arrow is pressed. 95 | TurnLeft 96 | deriving (Show) 97 | 98 | changeDirection :: Turn -> Direction -> Direction 99 | changeDirection TurnRight direction = toEnum $ (fromEnum direction - 1) `mod` 4 100 | changeDirection TurnLeft direction = toEnum $ (fromEnum direction + 1) `mod` 4 101 | 102 | -- | Whether the snake currently eats an apple. 103 | data Eat = Eat | DontEat 104 | 105 | data Snake = Snake 106 | { direction :: Direction 107 | , body :: NonEmpty Position 108 | } 109 | 110 | -- | A small snake. 111 | snek :: Direction -> Position -> Snake 112 | snek direction tinyBody = 113 | Snake 114 | { direction 115 | , body = pure tinyBody 116 | } 117 | 118 | -- | On every step, a snake can make a turn, and possibly eat an apple 119 | stepSnake :: Maybe Turn -> Eat -> Snake -> Snake 120 | stepSnake turnMaybe eat snake = 121 | let 122 | newDirection = maybe (direction snake) (`changeDirection` direction snake) turnMaybe 123 | newHead = stepPosition newDirection $ Data.List.NonEmpty.head $ body snake 124 | newTail = tailAfterMeal eat snake 125 | in 126 | Snake 127 | { direction = newDirection 128 | , body = newHead :| newTail 129 | } 130 | where 131 | tailAfterMeal :: Eat -> Snake -> [Position] 132 | tailAfterMeal DontEat = Data.List.NonEmpty.init . body 133 | tailAfterMeal Eat = toList . body 134 | 135 | renderSnake :: Snake -> Picture 136 | renderSnake = foldMap renderPosition . body 137 | 138 | newtype Apple = Apple {getApple :: Position} 139 | deriving (Eq, Ord) 140 | 141 | newApple :: (MonadRandom m) => ClSF m GameClock () (Maybe Apple) 142 | newApple = proc _ -> do 143 | nSteps :: Int <- count -< () 144 | if nSteps `mod` 10 == 1 145 | then arr (Just <<< Apple) <<< getRandomRS -< (Position (-boardSize) (-boardSize), Position boardSize boardSize) 146 | else returnA -< Nothing 147 | 148 | type Apples = Set Apple 149 | 150 | addAndEatApple :: 151 | -- | Possibly a new apple appeared 152 | Maybe Apple -> 153 | -- | On this position the snake attempted to eat the apple 154 | Position -> 155 | -- | The previous collection of apples 156 | Apples -> 157 | (Apples, Eat) 158 | addAndEatApple addedApple eatPosition oldApples = 159 | let addedApples = maybe oldApples (`insert` oldApples) addedApple 160 | newApples = delete (Apple eatPosition) addedApples 161 | in (newApples, if size newApples < size addedApples then Eat else DontEat) 162 | 163 | renderApple :: Apple -> Picture 164 | renderApple = color red . renderPosition . getApple 165 | 166 | type GameClock = GlossConcTClock IO (Millisecond 500) 167 | 168 | gameClock :: GameClock 169 | gameClock = glossConcTClock waitClock 170 | 171 | snakeSF :: ClSF GlossConc GameClock (Maybe Turn, Eat) Snake 172 | snakeSF = unfold_ (snek North mempty) $ \(turn, eat) s -> stepSnake turn eat s 173 | 174 | applesSF :: ClSF GlossConc GameClock Position (Apples, Eat) 175 | applesSF = feedback empty $ proc (eatPosition, oldApples) -> do 176 | addedApple <- evalRandIOS' newApple -< () 177 | let (newApples, eat) = addAndEatApple addedApple eatPosition oldApples 178 | returnA -< ((newApples, eat), newApples) 179 | 180 | snakeAndApples :: ClSF GlossConc GameClock (Maybe Turn) (Snake, Apples) 181 | snakeAndApples = feedback DontEat $ proc (turn, eat) -> do 182 | snake <- snakeSF -< (turn, eat) 183 | (apples, eatNext) <- applesSF -< head $ body snake 184 | returnA -< ((snake, apples), eatNext) 185 | 186 | -- | Whether a snake hits the boundaries or bites itself 187 | illegal :: Snake -> Bool 188 | illegal Snake {body = head_@Position {x, y} :| tail_} = 189 | head_ `elem` tail_ 190 | || x < (-boardSize) 191 | || x > boardSize 192 | || y < (-boardSize) 193 | || y > boardSize 194 | 195 | -- | Play snake until the snake is in an illegal state 196 | game :: ClSF GlossConc GameClock (Maybe Turn) (Maybe (Snake, Apples)) 197 | game = safely $ do 198 | _ 199 | 200 | -- Have a look at https://hackage.haskell.org/package/rhine/docs/FRP-Rhine-ClSF-Except.html. 201 | -- We first want to play 'snakeAndApples' until the 'illegal' function returns 'True' on the current snake. 202 | -- This has to throw an exception. 203 | -- Catch the exception by outputting 'Nothing' forever. 204 | 205 | -- Hint 1: Combine the following building blocks (plus a few things from base) to solve the puzzle: 206 | -- try, liftClSF, snakeAndApples, throwOnCond, illegal, safe 207 | -- Hint 2: The functions you need to combine are already in the right order 208 | -- Hint 3: The do notation has to have 2 statements in total 209 | -- Hint 4: These are the base functions and constructors you might also need: 210 | -- $ (several times), >>> (several times), fst, arr, Just, pure, Nothing 211 | 212 | render :: Maybe (Snake, Apples) -> Picture 213 | render (Just (snake, apples)) = renderSnake snake <> foldMap renderApple apples 214 | render Nothing = gameover 215 | 216 | gameover :: Picture 217 | gameover = translate (-3.5) 0 $ scale 0.01 0.01 $ text "Game over!" 218 | 219 | -- | Scale and paint a gloss picture 220 | visualize :: BehaviourF GlossConc UTCTime Picture () 221 | visualize = arrMCl $ scale 20 20 >>> paintAllIO 222 | 223 | -- | Draw at 30 FPS 224 | type VisualizationClock = GlossClockUTC IO GlossSimClockIO 225 | 226 | visualizationClock :: VisualizationClock 227 | visualizationClock = glossClockUTC GlossSimClockIO 228 | 229 | -- | Select only those input events that correspond to turns of the snake 230 | type UserClock = GlossClockUTC IO (SelectClock GlossEventClockIO Turn) 231 | 232 | userClock :: UserClock 233 | userClock = 234 | glossClockUTC $ 235 | SelectClock 236 | { mainClock = GlossEventClockIO 237 | , select = \case 238 | (EventKey (SpecialKey KeyRight) Down _ _) -> Just TurnRight 239 | (EventKey (SpecialKey KeyLeft) Down _ _) -> Just TurnLeft 240 | _ -> Nothing 241 | } 242 | 243 | -- | User input to turn the snake 244 | user :: ClSF GlossConc UserClock () Turn 245 | user = tagS 246 | 247 | rhine :: Rhine GlossConc (UserClock `SequentialClock` (GameClock `SequentialClock` VisualizationClock)) () () 248 | rhine = user @@ userClock >-- fifoBounded 1000 --> (game >-> arr render @@ gameClock) >-- keepLast mempty --> visualize @@ visualizationClock 249 | 250 | main :: IO () 251 | -- Make sure to keep this definition here as it is: The tests depend on it. 252 | main = flowGlossIO defaultSettings rhine 253 | --------------------------------------------------------------------------------