Data commit

Task/Jump-anywhere/Haskell/jump-anywhere-1.hs

@@ -0,0 +1,13 @@
+import Control.Monad.Cont
+
+data LabelT r m = LabelT (ContT r m ())
+
+label :: ContT r m (LabelT r m)
+label = callCC subprog
+  where subprog lbl = let l = LabelT (lbl l) in return l
+
+goto :: LabelT r m -> ContT r m b
+goto (LabelT l) = const undefined <$> l
+
+runProgram :: Monad m => ContT r m r -> m r
+runProgram program = runContT program return

Task/Jump-anywhere/Haskell/jump-anywhere-2.hs

@@ -0,0 +1,9 @@
+main = runProgram $
+  do
+    start <- label
+    lift $ putStrLn "Enter your name, please"
+    name <- lift $ getLine
+    if name == ""
+      then do lift $ putStrLn "Name can't be empty!"
+              goto start
+      else lift $ putStrLn ("Hello, " ++ name)

Task/Jump-anywhere/Haskell/jump-anywhere-3.hs

@@ -0,0 +1,6 @@
+import Data.IORef
+
+readInt = lift $ readLn >>= newIORef
+get ref = lift $ readIORef ref
+set ref expr = lift $ modifyIORef ref (const expr)
+output expr = lift $ putStrLn expr

Task/Jump-anywhere/Haskell/jump-anywhere-4.hs

@@ -0,0 +1,19 @@
+gcdProg = runProgram $ callCC $ \exit ->          -- <--------+
+  do                                              --          |
+    start <- label                                -- <-----+  |
+    output "Enter two integers, or zero to exit"  --       |  |
+    nr <- readInt                                 --       |  |
+    n <- get nr                                   --       |  |
+    when (n == 0) $                               --       |  |
+      do output "Exiting"                         --       |  |
+         exit ()                                  -- ---------+
+    mr <- readInt                                 --       |
+    loop <- label                                 -- <--+  |
+    n <- get nr                                   --    |  |
+    m <- get mr                                   --    |  |
+    when (n == m) $                               --    |  |
+      do output ("GCD: " ++ show n)               --    |  |
+         goto start                               -- ------+
+    when (n > m) $ set nr (n - m)                 --    |
+    when (m > n) $ set mr (m - n)                 --    |
+    goto loop                                     -- ---+

Task/Jump-anywhere/Haskell/jump-anywhere-5.hs

@@ -0,0 +1,17 @@
+gcdFProg = start
+  where
+    start = do
+      putStrLn "Enter two integers, or zero to exit"
+      n <- readLn
+      if n == 0
+        then
+          putStrLn "Exiting"
+        else do
+          m <- readLn
+          putStrLn $ "GCD: " ++ show (loop n m)
+          start
+
+loop n m
+  | n == m = n
+  | n < m  = loop n (m-n)
+  | n > m  = loop (n-m) m

Task/Jump-anywhere/Haskell/jump-anywhere-6.hs

@@ -0,0 +1,12 @@
+import Control.Applicative
+import Control.Monad.Trans.Maybe
+
+gcdFProg2 = forever mainLoop <|> putStrLn "Exiting"
+  where
+    mainLoop = putStrLn "Enter two integers, or zero to exit" >>
+               runMaybeT process >>=
+               maybe empty (\r -> putStrLn ("GCD: " ++ show r))
+
+    process = gcd <$> (lift readLn >>= exitOn 0) <*> lift readLn
+
+    exitOn n x = if x == n then empty else pure x