This question already has an answer here:
How to make an interactive program?
(1 answer)
Closed 5 years ago.
I need to process user input from stdin with ocaml. User will enter commands until he types quit and then the program finishes. How to do this? I know how to program in imperative, but I want to learn functional. The user is supposed to manipulate data from a stack based on his commands. Also I want to do like a parser to process user commands.
Really appreciate your help!
Here is a sketch of something you could write using OCaml stack library. It's far from perfect and it could be improved in many ways, but the general structure is here.
The most important part as far as your question is concerned is the loop function. It reads a line from the standard input, and uses a pattern-matching to either end the program, or evaluate the given and command, and recursively call itself to wait for another command.
The eval function uses a pattern-matching on the given arguments to do the right thing. You can find documentation for the Stack module here.
let stack = Stack.create ()
let eval args =
match args with
| ["push"; v] -> Stack.push v stack
| ["pop"] -> begin try print_endline (Stack.pop stack) with
| Stack.Empty -> print_endline "Stack is empty"
end
| ["show"] -> Stack.iter print_endline stack
| _ -> print_endline "Unrecognized command"
let rec loop () =
match read_line () with
| "quit" -> print_endline "Bye"
| _ as command -> eval (String.split_on_char ' ' command); loop ()
let () =
loop ()
Note: I usually don't really like the idea of giving a full solution to a question that doesn't show a lot of research, but hey, you have to start somewhere when you're new to functional programming.
Note 2: This code will only work for string stacks. If you intend to store a different type, say ints, or if you want it to be polymorphic, you'll need to tweak that code a little bit.
EDIT: According to a remark made in the comments, below is an improved version of the above code, which doesn't use a global variable stack.
let eval s args =
match args with
| ["push"; v] -> Stack.push v s
| ["pop"] -> begin try print_endline (Stack.pop s) with
| Stack.Empty -> print_endline "Stack is empty"
end
| ["show"] -> Stack.iter print_endline s
| _ -> print_endline "Unrecognized command"
let rec loop s =
match read_line () with
| "quit" -> print_endline "Bye"
| _ as command -> eval s (String.split_on_char ' ' command); loop s
let () =
loop (Stack.create ())
Related
I'm trying to parallelize work. I'm trying to have subprocesses each take a piece of the work, then wait for the work to complete from the parent process.
The following solution seems to work for small examples:
let par_iter (items: 'i list) ~(f: 'i -> unit): unit =
let orig_pid = Unix.getpid () in
let rec loop = function
| [] -> ()
| h :: t ->
match Unix.fork () with
| 0 -> f h
| _ -> loop t
in
loop items;
if Unix.getpid () = orig_pid then
List.iter items ~f:(fun _ -> ignore ## Unix.wait ())
else
exit 0
Usage:
let () =
par_iter [1; 2; 3; 4] ~f:do_something_with_an_int;
The contract of Unix.wait when there are multiple subprocesses is not very clear to me. Here I'm relying on the behavior where waiting n times will wait for all and only n subprocesses to finish.
Does this solution rely on undefined behavior? Is there an alternative way to correctly implement par_iter such that it spawns work on child processes and waits for the work to finish?
tested on OCaml 4.14.0
If the original parent process already had some subprocesses, this can fail. Thus, IMHO it's not usable as a general library. You should use Unix.waitpid to wait specifically for the processes you created.
I have a Haskell application which uses optparse-applicative library for CLI arguments parsing. My data type for CLI arguments contains FilePaths (both files and directories), Doubles and etc. optparse-applicative can handle parse errors but I want to ensure that some files and some directories exist (or don't exist), numbers are >= 0 and etc.
What can be done is an implementation of a bunch of helper functions like these ones:
exitIfM :: IO Bool -> Text -> IO ()
exitIfM predicateM errorMessage = whenM predicateM $ putTextLn errorMessage >> exitFailure
exitIfNotM :: IO Bool -> Text -> IO ()
exitIfNotM predicateM errorMessage = unlessM predicateM $ putTextLn errorMessage >> exitFailure
And then I use it like this:
body :: Options -> IO ()
body (Options path1 path2 path3 count) = do
exitIfNotM (doesFileExist path1) ("File " <> (toText ledgerPath) <> " does not exist")
exitIfNotM (doesDirectoryExist path2) ("Directory " <> (toText skKeysPath) <> " does not exist")
exitIfM (doesFileExist path3) ("File " <> (toText nodeExe) <> " already exist")
exitIf (count <= 0) ("--counter should be positive")
This looks too ad-hoc and ugly to me. Also, I need similar functionality for almost every application I write. Are there some idiomatic ways to deal with this sort of programming pattern when I want to do a bunch of checks before actually doing something with data type? The less boilerplate involved the better it is :)
Instead of validating the options record after it has been constructed, perhaps we could use applicative functor composition to combine argument parsing and validation:
import Control.Monad
import Data.Functor.Compose
import Control.Lens ((<&>)) -- flipped fmap
import Control.Applicative.Lift (runErrors,failure) -- form transformers
import qualified Options.Applicative as O
import System.Directory -- from directory
data Options = Options { path :: FilePath, count :: Int } deriving Show
main :: IO ()
main = do
let pathOption = Compose (Compose (O.argument O.str (O.metavar "FILE") <&> \file ->
do exists <- doesPathExist file
pure $ if exists
then pure file
else failure ["Could not find file."]))
countOption = Compose (Compose (O.argument O.auto (O.metavar "INT") <&> \i ->
do pure $ if i < 10
then pure i
else failure ["Incorrect number."]))
Compose (Compose parsy) = Options <$> pathOption <*> countOption
io <- O.execParser $ O.info parsy mempty
errs <- io
case runErrors errs of
Left msgs -> print msgs
Right r -> print r
The composed parser has type Compose (Compose Parser IO) (Errors [String]) Options. The IO layer is for performing file existence checks, while Errors is a validation-like Applicative from transformers that accumulates error messages. Running the parser produces an IO action that, when run, produces an Errors [String] Options value.
The code is a bit verbose but those argument parsers could be packed in a library and reused.
Some examples form the repl:
Λ :main "/tmp" 2
Options {path = "/tmp", count = 2}
Λ :main "/tmpx" 2
["Could not find file."]
Λ :main "/tmpx" 22
["Could not find file.","Incorrect number."]
I am converting the OCaml Format module to F# and tracked a problem back to a use of the OCaml Pervasives at_exit.
val at_exit : (unit -> unit) -> unit
Register the given function to be called at program termination time. The functions registered with at_exit will be called when the program executes exit, or terminates, either normally or because of an uncaught exception. The functions are called in "last in, first out" order: the function most recently added with at_exit is called first.
In the process of conversion I commented out the line as the compiler did not flag it as being needed and I was not expecting an event in the code.
I checked the FSharp.PowerPack.Compatibility.PervasivesModule for at_exit using VS Object Browser and found none.
I did find how to run code "at_exit"? and How do I write an exit handler for an F# application?
The OCaml line is
at_exit print_flush
with print_flush signature: val print_flush : (unit -> unit)
Also in looking at the use of it during a debug session of the OCaml code, it looks like at_exit is called both at the end of initialization and at the end of each use of a call to the module.
Any suggestions, hints on how to do this. This will be my first event in F#.
EDIT
Here is some of what I have learned about the Format module that should shed some light on the problem.
The Format module is a library of functions for basic pretty printer commands of simple OCaml values such as int, bool, string. The format module has commands like print_string, but also some commands to say put the next line in a bounded box, think new set of left and right margins. So one could write:
print_string "Hello"
or
open_box 0; print_string "<<";
open_box 0; print_string "p \/ q ==> r"; close_box();
print_string ">>"; close_box()
The commands such as open_box and print_string are handled by a loop that interprets the commands and then decides wither to print on the current line or advance to the next line. The commands are held in a queue and there is a state record to hold mutable values such as left and right margin.
The queue and state needs to be primed, which from debugging the test cases against working OCaml code appears to be done at the end of initialization of the module but before the first call is made to any function in the Format module. The queue and state is cleaned up and primed again for the next set of commands by the use of mechanisms for at_exit that recognize that the last matching frame for the initial call to the format modules has been removed thus triggering the call to at_exit which pushes out any remaining command in the queue and re-initializes the queue and state.
So the sequencing of the calls to print_flush is critical and appears to be at more than what the OCaml documentation states.
This should do it:
module Pervasives =
open System
open System.Threading
//
let mutable private exitFunctions : (unit -> unit) list = List.empty
//
let mutable private exitFunctionsExecutedFlag = 0
//
let private tryExecuteExitFunctions _ =
if Interlocked.CompareExchange (&exitFunctionsExecutedFlag, 1, 0) = 0 then
// Run the exit functions in last-in-first-out order.
exitFunctions
|> List.iter (fun f -> f ())
// Register handlers for events which fire when the process exits cleanly
// or due to an exception being thrown.
do
AppDomain.CurrentDomain.ProcessExit.Add tryExecuteExitFunctions
AppDomain.CurrentDomain.UnhandledException.Add tryExecuteExitFunctions
//
let at_exit f =
// TODO : This function should be re-written using atomic operations
// for thread-safety!
exitFunctions <- f :: exitFunctions
And some code to test it:
open System
// Register a couple of handlers to test our code.
Pervasives.at_exit <| fun () ->
Console.WriteLine "The first registered function has fired!"
Pervasives.at_exit <| fun () ->
Console.WriteLine "The second registered function has fired!"
TimeSpan.FromSeconds 1.0
|> System.Threading.Thread.Sleep
Console.WriteLine "Exiting the second registered function!"
Pervasives.at_exit <| fun () ->
Console.WriteLine "The third registered function has fired!"
// Do some stuff in our program
printfn "blah"
printfn "foo"
printfn "bar"
(* The functions we registered with at_exit should be fired here. *)
// Uncomment this to see that our handlers work even when the
// program crashes due to an unhandled exception.
//failwith "Uh oh!"
I really often use:
try
try
with
finally
so I'm interesting if is possible to make new syntax operator to not write "try" two times.
let mytry foo bar foobar =
try
try
foo
with
| _ -> bar // weird part here, I want to have a match
finally foobar
mytry
<| foo
<| | :? SocketException ->
| _ -> // ok it looks funny but how to realize it?
<| foobar
the problems I see here are
non-common syntax, in mytry there is no try with finally keywords, just <| <| <| for each, but it's lesser trouble I guess
with: I don't know how can I realize this part. even how it will look if I can realize it...
The question is whether you really need try/finally. Most of the time try/finally is used for disposing resources even when exceptions occur. But you can always replace it by the use keyword.
For example:
open System.IO
let openFile(url: string) =
let fileStream = File.OpenText(url)
try
try
let readline = fileStream.ReadLine()
printfn "Readline: %s" readline
with
| :? IOException as ex ->
printfn "IOException: %A" ex
| ex -> printfn "Another exception: %A" ex
finally
fileStream.Dispose()
can be rewritten as:
let openFile(url: string) =
use fileStream = File.OpenText(url)
try
let readline = fileStream.ReadLine()
printfn "Readline: %s" readline
with
| :? IOException as ex ->
printfn "IOException: %A" ex
| ex -> printfn "Another exception: %A" ex
For the learning purpose, you can define mytry using high-order functions as follows:
let mytry foo bar foobar =
try
try
foo ()
with
| exn -> bar exn
finally foobar ()
But it doesn't look really nice on above example:
let myOpenFile(url: string) =
let fileStream = File.OpenText(url)
mytry (fun () -> let readline = fileStream.ReadLine()
printfn "Readline: %s" readline)
(fun ex -> match ex with
| :? IOException ->
printfn "IOException: %A" ex
| _ -> printfn "Another exception: %A" ex)
(fun () -> fileStream.Dispose())
You can write a higher-order function that takes the three parts as separate function. The body of the try would be a function unit -> 'R where 'R is the result. The exception handler will need to handle only some exceptions, so you can return option to say whether you handled the result or if you want the exception to be rethrown. The type of handler will be exn -> 'R option. The finalizer is then simply a function unit -> unit.
The usage is not as elegant as using built-in language feature, but it does the trick:
tryWithFinally
(fun () ->
1/0 ) // The nested body
(function
| :? DivideByZeroException -> Some -1 // Handle division by zero
| _ -> None ) // Rethrow any other exceptions
(fun () ->
printfn "done" )
The implementation is quite easy once you know the structure, but for completeness, here it is:
let tryWithFinally f handler finalizer =
try
try f()
with e ->
match handler e with
| Some r -> r
| None -> reraise()
finally
finalizer()
Anyway, I agree with #pad that in most of the cases, you should be fine with just use and try .. with.
I've tried this:
main = do
hSetBuffering stdin NoBuffering
c <- getChar
but it waits until the enter is pressed, which is not what I want. I want to read the character immediately after user presses it.
I am using ghc v6.12.1 on Windows 7.
EDIT: workaround for me was moving from GHC to WinHugs, which supports this correctly.
Yes, it's a bug. Here's a workaround to save folks clicking and scrolling:
{-# LANGUAGE ForeignFunctionInterface #-}
import Data.Char
import Foreign.C.Types
getHiddenChar = fmap (chr.fromEnum) c_getch
foreign import ccall unsafe "conio.h getch"
c_getch :: IO CInt
So you can replace calls to getChar with calls to getHiddenChar.
Note this is a workaround just for ghc/ghci on Windows. For example, winhugs doesn't have the bug and this code doesn't work in winhugs.
Might be a bug:
http://hackage.haskell.org/trac/ghc/ticket/2189
The following program repeats inputted characters until the escape key is pressed.
import IO
import Monad
import Char
main :: IO ()
main = do hSetBuffering stdin NoBuffering
inputLoop
inputLoop :: IO ()
inputLoop = do i <- getContents
mapM_ putChar $ takeWhile ((/= 27) . ord) i
Because of the hSetBuffering stdin NoBuffering line it should not be necessary to press the enter key between keystrokes. This program works correctly in WinHugs (sep 2006 version). However, GHC 6.8.2 does not repeat the characters until the enter key is pressed. The problem was reproduced with all GHC executables (ghci, ghc, runghc, runhaskell), using both cmd.exe and command.com on Windows XP Professional...
Hmm.. Actually I can't see this feature to be a bug. When you read stdin that means that you want to work with a "file" and when you turn of buffering you are saying that there is no need for read buffer. But that doesn't mean that application which is emulating that "file" should not use write buffer. For linux if your terminal is in "icanon" mode it doesn't send any input until some special event will occur (like Enter pressed or Ctrl+D). Probably console in Windows have some similar modes.
The Haskeline package worked for me.
If you need it for individual characters, then just change the sample slightly.
getInputLine becomes getInputChar
"quit" becomes 'q'
++ input becomes ++ [input]
main = runInputT defaultSettings loop
where
loop :: InputT IO ()
loop = do
minput <- getInputChar "% "
case minput of
Nothing -> return ()
Just 'q' -> return ()
Just input -> do outputStrLn $ "Input was: " ++ [input]
loop
From comment of #Richard Cook:
Use hidden-char: Provides cross-platform getHiddenChar function.
I used the haskeline package, suggested in other answers, to put together this simple alternative to getChar. It requests input again in the case that getInputChar returns Nothing. This worked for me to get past the issue; modify as needed.
import System.Console.Haskeline
( runInputT
, defaultSettings
, getInputChar
)
betterInputChar :: IO Char
betterInputChar = do
mc <- runInputT defaultSettings (getInputChar "")
case mc of
Nothing -> betterInputChar
(Just c) -> return c