PureScript FFI to mocha - mocha.js

I am trying to write mocha bindings into PureScript and am completely baffled by Control.Monad.Eff
describe(function(){
//do stuff
});
Describe is a function that takes nothing and returns IO, or Eff or something that means (side-effect happened no value returned).
My attempts so far
foreign import describe
"function describe(n){ \
\ return function(){ \
\ window.describe(n); \
\ }; \
\}" :: forall eff a. Eff eff a -> Eff eff
foreign import describe "describe" :: forall eff a. Eff eff a -> Eff eff
foreign import describe "describe" :: Eff -> Eff
foreign import describe "describe" :: forall eff a. (a -> Eff eff) -> Eff eff
Clearly missing something here. Please help.

The foreign function interface of PureScript is actually very simple. For example suppose you have the following JavaScript function:
function si(p) {
return function (r) {
return function (t) {
return p * r * t / 100;
};
};
}
You could import it as follows:
foreign import si :: Number -> Number -> Number -> Number
You could also inline the function as follows:
foreign import si
"function si(p) {\
\ return function (r) {\
\ return function (t) {\
\ return p * r * t / 100;\
\ };\
\ };\
\}" :: Number -> Number -> Number -> Number
For side effects PureScript doesn't use the IO monad. Instead it makes use of the Eff monad.
From what I understand the Eff monad is the same as the IO monad with an extra type parameter: a row of effects.
For example, in Haskell the print function has the following type:
print :: Show a => a -> IO ()
In PureScript the print function has the following type:
print :: Show a => a -> Eff (trace :: Trace | r) Unit
So what do we understand from this?
IO is similar to Eff e where e is a row of effects.
Unit is similar to ().
The print function has the trace effect which is of the type Trace.
In addition, the print function can be combined with an other effect. Row polymorphism. This means that it is composable.
An Eff value by itself is called an action. For example print "Hello World!" which is of the type Eff (trace :: Trace | r) Unit is an action.
An Eff value which is an argument to a function is called a handler. It can be thought of as a higher-order effectful function with no parameters.
An Eff value with no side-effects is known as a pure value:
type Pure a = forall e. Eff e a
runPure :: Pure a -> a
Since the row of effects (i.e. e) is polymorphic (or in other words empty, a black hole), PureScript assumes that the function has no side-effects. However it also means that it can be composed with other effectful functions.
The Eff monad is a contract between the programmer and the compiler in which the programmer promises the compiler that the given Eff value will only have the stated row of effects and no more.
Coming to your describe function:
Describe is a function that takes nothing and returns IO, or Eff or something that means (side-effect happened no value returned).
Actually this is wrong. Your describe function does take a function as an argument:
describe(function(){
//do stuff
});
In addition the function that it takes has no arguments, which means that it is an effectful function. Hence it must be of the type Eff e a where e and a can be any row of effects and any return value respectively.
Thus your describe function must be of the type:
describe :: Eff e a -> Eff (describe :: Describe | e) {}
In Haskell it would be written as follows:
describe :: IO a -> IO ()
PureScript is just more explicit than Haskell. Anyway, Describe is a new effect type that you create which distinguishes it from other effect types such as Trace:
foreign import data Describe :: !
You would then import describe as follows:
foreign import describe
"function describe(f) {\
\ return function () {\
\ window.describe(f);\
\ };\
\}" :: forall e a. Eff e a -> Eff (describe :: Describe | e) {}
Finally you can use it as follows:
main = do
describe $ print "Hello World!"
The entire code is as follows:
module Main where
import Control.Monad.Eff
import Debug.Trace
foreign import data Describe :: !
foreign import describe
"function describe(f) {\
\ return function () {\
\ window.describe(f);\
\ };\
\}" :: forall e a. Eff e a -> Eff (describe :: Describe | e) {}
main = do
describe $ print "Hello World!"
It would produce the following JavaScript:
var PS = PS || {};
PS.Main = (function () {
"use strict";
var Prelude = PS.Prelude;
var Debug_Trace = PS.Debug_Trace;
function describe(f) {
return function () {
window.describe(f);
};
}
var print = Debug_Trace.print(Prelude.showString({}));
var main = describe(print("Hello World!"));
return {
main: main,
describe: describe
};
}());
Hope that helps.

Related

EscapedSkolem error implementing websocket reconnection in PureScript and Halogen

I'm trying to implement Websocket reconnection in PureScript and am at a complete loss at how to proceed. I've added the reconnection code at the top level due to the use of Aff; I think this is the correct place but I'm not sure.
I've tried to implement it as I might in Haskell but I can't make it typecheck due to an EscapedSkolem error in runWs. I get the impression I can fix this by adding a type signature but I can't for the life of me work out what the signature might be!
So I have three questions:
Is this the correct way of implementing reconnection?
What is the type of runWs (any hints on how I might work this out for myself would be fantastic)?
If adding a type signature doesn't fix the EscapedSkolem error how would I go about fixing it?
And finally, I'm a complete newb when it comes to PureScript so if anything's unclear please point that out and I'll try and clarify.
EDIT: Added the error compiler output and changed the title slightly.
module Main where
import Prelude
import Control.Coroutine (Producer, Consumer, runProcess, consumer, ($$))
import Control.Coroutine.Aff (produce)
import Control.Monad.Aff (Aff, delay)
import Control.Monad.Aff.AVar (AVAR)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Eff.Ref (REF)
import Control.Monad.Eff.Var (($=), get)
import DOM (DOM)
import DOM.Websocket.Event.CloseEvent (reason)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Time.Duration (Milliseconds(..))
import Halogen as H
import Halogen.Aff (HalogenEffects, awaitBody, runHalogenAff)
import Halogen.VDom.Driver (runUI)
import Log (Query(..), component)
import WebSocket (Connection(..), URL(..), WEBSOCKET, newWebSocket, runMessage, runURL, runMessageEvent)
wsURI :: URL
wsURI = URL "ws://localhost:6385"
reconnectionDelay :: Milliseconds
reconnectionDelay = Milliseconds 10000.0
main :: forall eff. Eff (HalogenEffects (console :: CONSOLE, err :: EXCEPTION , avar :: AVAR , dom :: DOM , exception :: EXCEPTION , ref :: REF , ws :: WEBSOCKET | eff)) Unit
main = do
runHalogenAff do
body <- awaitBody
driver <- runUI component unit body
---> Replace this: <---
runProcess (wsProducer $$ wsConsumer driver.query)
---> with this: <---
-- runWs driver
-- -------------------------------------------------
-- -------------------------------------------------
--
-- Reconnection function
-- runWs :: ????????
runWs p = go
where
go = do
runProcess (wsProducer $$ wsConsumer p)
delay reconnectionDelay
go
-- -------------------------------------------------
-- -------------------------------------------------
wsProducer :: forall eff. Producer String (Aff (console :: CONSOLE, err :: EXCEPTION , ws :: WEBSOCKET , avar :: AVAR | eff)) Unit
wsProducer = produce \emit -> do
Connection socket <- newWebSocket wsURI []
socket.onopen $= \event -> do
log "onopen: Connection opened"
log <<< runURL =<< get socket.url
socket.onmessage $= \event -> do
emit $ Left $ runMessage (runMessageEvent event)
socket.onclose $= \event -> do
log $ "Socket Closed, returning to runHalogenAff: " <> reason event
emit $ Right unit
socket.onerror $= \event -> do
log "Error."
emit $ Right unit
wsConsumer :: forall eff . (Query ~> Aff (HalogenEffects eff)) -> Consumer String (Aff (HalogenEffects eff)) Unit
wsConsumer driver = consumer \msg -> do
driver $ H.action $ AddMessage msg
pure Nothing
And the compiler output is:
Compiling Main
[1/1 MissingTypeDeclaration] src/Main.purs:54:1
v
54 runWs p = go
55 where
56 go = do
57 runProcess (wsProducer $$ wsConsumer p)
58 delay reconnectionDelay
59 go
^
No type declaration was provided for the top-level declaration of runWs.
It is good practice to provide type declarations as a form of documentation.
The inferred type of runWs was:
forall t110 t120.
(Query a0
-> Aff
( avar :: AVAR
, ref :: REF
, exception :: EXCEPTION
, dom :: DOM
, console :: CONSOLE
, err :: EXCEPTION
, ws :: WEBSOCKET
| t120
)
a0
)
-> Aff
( console :: CONSOLE
, err :: EXCEPTION
, ws :: WEBSOCKET
, avar :: AVAR
, dom :: DOM
, exception :: EXCEPTION
, ref :: REF
| t120
)
t110
where a0 is a rigid type variable
bound at line 57, column 44 - line 57, column 45
[1/1 EscapedSkolem] src/Main.purs:54:1
v
54 runWs p = go
55 where
56 go = do
57 runProcess (wsProducer $$ wsConsumer p)
58 delay reconnectionDelay
59 go
^
The type variable a, bound at
/home/rgh/dev/purescript/translate/sidebar/src/Main.purs line 57, column 44 - line 57, column 45
has escaped its scope, appearing in the type
(Query a2
-> Aff
( avar :: AVAR
, ref :: REF
, exception :: EXCEPTION
, dom :: DOM
, console :: CONSOLE
, err :: EXCEPTION
, ws :: WEBSOCKET
| t120
)
a2
)
-> Aff
( console :: CONSOLE
, err :: EXCEPTION
, ws :: WEBSOCKET
, avar :: AVAR
, dom :: DOM
, exception :: EXCEPTION
, ref :: REF
| t120
)
t110
in the expression \p ->
let
go = ...
in go
in value declaration runWs
Src Lib All
Warnings 1 0 1
Errors 1 0 1
* Failed to rebuild; try to fix the compile errors
Compiler error messages may be hard to decrypt sometimes, but in this case it turns out to be the answer you're looking for. Let's look at your do block here:
do
runHalogenAff do
body <- awaitBody
driver <- runUI component unit body
runWs driver.query -- < assuming you made a small mistake here
I usually start by desugaring, I find it makes it easier to follow the types, but ymmv:
runHalogenAff $
awaitBody >>= \body ->
runUI component unit body >>= \driver ->
runWs driver.query
Looking at the signature of runHalogenAff, we can see that it accepts an argument of type Aff (HalogenEffects eff) x, meaning the following term must evaluate to a value of that type. It must be then that runWs returns a value of that type.
Now let's turn to runWs. Its argument is a natural transformation f ~> m which in your example takes your query algebra into the Aff monad. We can write this down and ask the compiler to figure out the rest for us:
runWs :: (Query ~> Aff _) -> Aff _ Unit
That will build successfully and give you what you can fill these holes with. Here is the final signature:
runWs :: forall eff.
(Query ~> Aff (HalogenEffects
( console :: CONSOLE
, err :: EXCEPTION
, ws :: WEBSOCKET
| eff
)))
-> Aff (HalogenEffects
( console :: CONSOLE
, err :: EXCEPTION
, ws :: WEBSOCKET
| eff
)) Unit
Indeed that is exactly what the compiler output gives you. I am assuming the error message "the type variable a has escaped its scope" is because of the universal quantifier in the definition of a natural transformation.

Programming pattern or library (i.e. idiomatic way) to handle CLI arguments semantic errors?

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."]

What is the minimum code required to produce random numbers in Elm?

I just want to see a random number. So here's an example straight out of the docs for the Random library. I expect Random.generate to accept a generator and a seed and return a tuple containing a random value and a new seed, as in:
generate : Generator a -> Seed -> (a, Seed)
-- Main.elm
import Random
seed0 = Random.initialSeed 31415
randomNumber = Random.generate (Random.int 0 10) seed0
main =
-- print result of randomNumber here
The compiler errors show two type mismatches:
-- TYPE MISMATCH ---------------------------------------------------- -----------
The 2nd argument to function `generate` is causing a mismatch.
5| Random.generate (Random.int 0 10) seed0
^^^^^
Function `generate` is expecting the 2nd argument to be:
Random.Generator a
But it is:
Random.Seed
The 1st argument to function `generate` is causing a mismatch.
5| Random.generate (Random.int 0 10) seed0
^^^^^^^^^^^^^^^
Function `generate` is expecting the 1st argument to be:
a -> b
But it is:
Random.Generator Int
What am I missing here?
The version of the docs you refer to is Core 1.0.0, which is old. Current version of Core is 4.0.5. (docs for Random here)
The function with the signature you are looking for is now named step:
step : Generator a -> Seed -> (a, Seed)
So your refactored code would look something like this:
import Html exposing (text)
import Random
seed0 = Random.initialSeed 31415
(randomNumber, nextSeed) = Random.step (Random.int 0 10) seed0
main =
text <| toString randomNumber
Here is the shortest example I can think of.
Because it is giving a constant seed, it will return same boolean.
If you need random number get produced at runtime, then you
have to use Random.generate which produces Cmd
so that elm runtime can get the randomness.
In this case, some form of Platform.Program
is needed because it is the only way to run Cmd.
import Html exposing (text)
import Random exposing (..)
main =
text <| toString <| Tuple.first <| step bool (initialSeed 1)
Elm 2022 (v0.19) answer:
Here's an absolute minimal example for generating a number between 0 and 1000 in Elm 0.19.1, and a runnable Ellie, which depends on elm/random. You wouldn't usually have all the () littered throughout, and instead you'd have Msg and Model, but in the interest of minimizing code:
module Main exposing (main)
import Browser
import Html
import Random
view : () -> Html.Html ()
view model =
let
-- this generates the rng number
generator =
Random.int 0 1000
-- used to seed the generator
seed =
Random.initialSeed 12345
-- Random.step returns the generated value, and a new seed.
-- Usually you store the newSeed on your model so you don't always generate the same value
( value, newSeed ) =
Random.step
generator
seed
in
Html.text <| String.fromInt value
main : Program () () ()
main =
Browser.sandbox
{ init = ()
, view = view
, update = \msg model -> model
}
Other best practices include storing some global seed on the model:
type alias Model = { globalSeed : Random.Seed }
and then using it and updating the one on the model after:
update : Msg -> Model -> (Model, Cmd.none)
update msg model =
case msg of
GenerateValue ->
let
(newValue, newSeed) =
Random.step (Random.int 0 1000) model.globalSeed
_ =
Debug.log "generated a new value" newValue
in
( {model | globalSeed = newSeed}, Cmd.none)

PureScript Halogen and websockets

I'm trying to use purescript-halogen in combination with websockets, but after several attempts I'm unable to make them work together.
I've seen this question on Thermite and websockets and Phil's answer regarding the Driver function. Halogen also has a Driver function, but I need to run the Driver function with the Aff effect, while purescript-websockets-simple uses the Eff effect.
I've no idea how to transform the synchronous callbacks of the websocket package to asynchronous code running in the Aff monad. Do I need to use an AVar? Do I need purescript-coroutines-aff? If so, how do I hook up these parts together?
Thanks in advance for any pointers in the right direction!
In this case you would indeed want to use purescript-aff-coroutines. That will get you a coroutine Producer that you can then hook up to a Consumer that pushes messages into the driver:
module Main where
import Prelude
import Control.Coroutine (Producer, Consumer, consumer, runProcess, ($$))
import Control.Coroutine.Aff (produce)
import Control.Monad.Aff (Aff)
import Control.Monad.Aff.AVar (AVAR)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Eff.Var (($=))
import Data.Array as Array
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Halogen as H
import Halogen.HTML.Indexed as HH
import Halogen.Util (runHalogenAff, awaitBody)
import WebSocket (WEBSOCKET, Connection(..), Message(..), URL(..), runMessageEvent, runMessage, newWebSocket)
----------------------------------------------------------------------------
-- Halogen component. This just displays a list of messages and has a query
-- to accept new messages.
----------------------------------------------------------------------------
type State = { messages :: Array String }
initialState :: State
initialState = { messages: [] }
data Query a = AddMessage String a
ui :: forall g. H.Component State Query g
ui = H.component { render, eval }
where
render :: State -> H.ComponentHTML Query
render state =
HH.ol_ $ map (\msg -> HH.li_ [ HH.text msg ]) state.messages
eval :: Query ~> H.ComponentDSL State Query g
eval (AddMessage msg next) = do
H.modify \st -> { messages: st.messages `Array.snoc` msg }
pure next
----------------------------------------------------------------------------
-- Websocket coroutine producer. This uses `purescript-aff-coroutines` to
-- create a producer of messages from a websocket.
----------------------------------------------------------------------------
wsProducer :: forall eff. Producer String (Aff (avar :: AVAR, err :: EXCEPTION, ws :: WEBSOCKET | eff)) Unit
wsProducer = produce \emit -> do
Connection socket <- newWebSocket (URL "ws://echo.websocket.org") []
-- This part is probably unnecessary in the real world, but it gives us
-- some messages to consume when using the echo service
socket.onopen $= \event -> do
socket.send (Message "hello")
socket.send (Message "something")
socket.send (Message "goodbye")
socket.onmessage $= \event -> do
emit $ Left $ runMessage (runMessageEvent event)
----------------------------------------------------------------------------
-- Coroutine consumer. This accepts a Halogen driver function and sends
-- `AddMessage` queries in when the coroutine consumes an input.
----------------------------------------------------------------------------
wsConsumer
:: forall eff
. (Query ~> Aff (H.HalogenEffects (ws :: WEBSOCKET | eff)))
-> Consumer String (Aff (H.HalogenEffects (ws :: WEBSOCKET | eff))) Unit
wsConsumer driver = consumer \msg -> do
driver $ H.action $ AddMessage msg
pure Nothing
----------------------------------------------------------------------------
-- Normal Halogen-style `main`, the only addition is a use of `runProcess`
-- to connect the producer and consumer and start sending messages to the
-- Halogen component.
----------------------------------------------------------------------------
main :: forall eff. Eff (H.HalogenEffects (ws :: WEBSOCKET | eff)) Unit
main = runHalogenAff do
body <- awaitBody
driver <- H.runUI ui initialState body
runProcess (wsProducer $$ wsConsumer driver)
pure unit
This should give you a page that almost immediately prints:
hello
something
goodbye
But it is doing everything you need, honest! If you use the producer with a "real" source you'll get something more like what you need.

Streaming recursive descent of a directory in Haskell

I am trying to do a recursive descent of a directory structure using Haskell. I would like to only retrieve the child directories and files as needed (lazily).
I wrote the following code, but when I run it, the trace shows that all directories are visited before the first file:
module Main where
import Control.Monad ( forM, forM_, liftM )
import Debug.Trace ( trace )
import System.Directory ( doesDirectoryExist, getDirectoryContents )
import System.Environment ( getArgs )
import System.FilePath ( (</>) )
-- From Real World Haskell, p. 214
getRecursiveContents :: FilePath -> IO [FilePath]
getRecursiveContents topPath = do
names <- getDirectoryContents topPath
let
properNames =
filter (`notElem` [".", ".."]) $
trace ("Processing " ++ topPath) names
paths <- forM properNames $ \name -> do
let path = topPath </> name
isDirectory <- doesDirectoryExist path
if isDirectory
then getRecursiveContents path
else return [path]
return (concat paths)
main :: IO ()
main = do
[path] <- getArgs
files <- getRecursiveContents path
forM_ files $ \file -> putStrLn $ "Found file " ++ file
How can I interleave the file processing with the descent? Is the problem that the files <- getRecursiveContents path action gets performed before the following forM_ in main?
This is exactly the kind of problem that iteratees/coroutines were designed to solve.
You can easily do this with pipes. The only change I made to your getRecursiveContents was to make it a Producer of FilePaths and to respond with the file name instead of returning it. This lets downstream handle the file name immediately instead of waiting for getRecursiveContents complete.
module Main where
import Control.Monad ( forM_, liftM )
import Control.Proxy
import System.Directory ( doesDirectoryExist, getDirectoryContents )
import System.Environment ( getArgs )
import System.FilePath ( (</>) )
getRecursiveContents :: (Proxy p) => FilePath -> () -> Producer p FilePath IO ()
getRecursiveContents topPath () = runIdentityP $ do
names <- lift $ getDirectoryContents topPath
let properNames = filter (`notElem` [".", ".."]) names
forM_ properNames $ \name -> do
let path = topPath </> name
isDirectory <- lift $ doesDirectoryExist path
if isDirectory
then getRecursiveContents path ()
else respond path
main :: IO ()
main = do
[path] <- getArgs
runProxy $
getRecursiveContents path
>-> useD (\file -> putStrLn $ "Found file " ++ file)
This prints out each file immediately as it traverses the tree, and it does not require lazy IO. It's also very easy to change what you do with the file names, since all you have to do is switch out the useD stage with your actual file handling logic.
To learn more about pipes, I highly recommend you read Control.Proxy.Tutorial.
Using lazy IO / unsafe... is not a good way to go. Lazy IO causes many problems, including unclosed resources and executing impure actions within pure code. (See also The problem with lazy I/O on Haskell Wiki.)
A safe way is to use some iteratee/enumerator library. (Replacing problematic lazy IO was the motivation for developing these concepts.) Your getRecursiveContents would become a source of data (AKA enumerator). And the data will be consumed by some iterator. (See also Enumerator and iteratee on Haskell wiki.)
There is a tutorial on the enumerator library that just gives an example of traversing and filtering directory tree, implementing a simple find utility. It implements method
enumDir :: FilePath -> Enumerator FilePath IO b
which is basically just what you need. I believe you will find it interesting.
Also there is a nice article explaining iteratees in The Monad Reader, Issue 16: Iteratee: Teaching an Old Fold New Tricks by John W. Lato, the author of the iteratee library.
Today many people prefer newer libraries such as pipes. You may be interested in a comparison: What are the pros and cons of Enumerators vs. Conduits vs. Pipes?.
Thanks to the comment by Niklas B., here is the solution that I have:
module Main where
import Control.Monad ( forM, forM_, liftM )
import Debug.Trace ( trace )
import System.Directory ( doesDirectoryExist, getDirectoryContents )
import System.Environment ( getArgs )
import System.FilePath ( (</>) )
import System.IO.Unsafe ( unsafeInterleaveIO )
-- From Real World Haskell, p. 214
getRecursiveContents :: FilePath -> IO [FilePath]
getRecursiveContents topPath = do
names <- unsafeInterleaveIO $ getDirectoryContents topPath
let
properNames =
filter (`notElem` [".", ".."]) $
trace ("Processing " ++ topPath) names
paths <- forM properNames $ \name -> do
let path = topPath </> name
isDirectory <- doesDirectoryExist path
if isDirectory
then unsafeInterleaveIO $ getRecursiveContents path
else return [path]
return (concat paths)
main :: IO ()
main = do
[path] <- getArgs
files <- unsafeInterleaveIO $ getRecursiveContents path
forM_ files $ \file -> putStrLn $ "Found file " ++ file
Is there a better way?
I was recently looking at a very similar problem, where I'm trying to do a somewhat complicated search using the IO monad, stopping after I find the file I'm interested in. While the solutions using libraries like Enumerator, Conduit, etc. seem to be the best you could do at the time those answers were posted, I just learned IO became an instance of Alternative in GHC's base library about a year ago, which opens up some new possibilities. Here's the code I wrote to try it out:
import Control.Applicative (empty)
import Data.Foldable (asum)
import Data.List (isSuffixOf)
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath ((</>))
searchFiles :: (FilePath -> IO a) -> FilePath -> IO a
searchFiles f fp = do
isDir <- doesDirectoryExist fp
if isDir
then do
entries <- listDirectory fp
asum $ map (searchFiles f . (fp </>)) entries
else f fp
matchFile :: String -> FilePath -> IO ()
matchFile name fp
| name `isSuffixOf` fp = putStrLn $ "Found " ++ fp
| otherwise = empty
The searchFiles function does a depth-first search of a directory tree, stopping when it finds what you're looking for, as determined by the function passed as the first argument. The matchFile function is just there to show how to construct a suitable function to use as the first argument for searchFiles; in real life you'd probably do something more complicated.
The interesting thing here is that now you can use empty to make an IO computation "give up" without returning a result, and you can chain computations together with asum (which is just foldr (<|>) empty) to keep trying computations until one of them succeeds.
I find it a little unnerving that the type signature of an IO action no longer reflects the fact that it may deliberately not produce a result, but it sure simplifies the code. I was previously trying to use types like IO (Maybe a), but doing so made it very hard to compose actions.
IMHO there's no longer much reason to use a type like IO (Maybe a), but if you need to interface with code that uses a type like that, it's easy to convert between the two types. To convert IO a to IO (Maybe a), you can just use Control.Applicative.optional, and going the other way, you can use something like this:
maybeEmpty :: IO (Maybe a) -> IO a
maybeEmpty m = m >>= maybe empty pure

Resources