while the following code:
postImportR = do
fi <- lookupFiles "file"
fc <- lift $ fileSource (fi !! 0) $$ consume
seems to work (at least can I "liftIO $ print fc), splitting it off to a function for iterating doesn't:
process :: [FileInfo] -> [String]
process [] = []
process (f:r) = do
fn <- fileName f
fc <- lift $ fileSource f $$ consume
([fn] : (process r))
postImportR = do
fi <- lookupFiles "file"
process fi
or even with a lambda function:
files <- L.map (\f -> (fileName f, lift $ fileSource f $$ consume)) fi
in the Handler it gives me a type error I don't understand.
Where's my fault -- liked to generate content for database import from the file's lines (and to learn some more Haskell, of course).
You have
fileName :: FileInfo -> Text
so you can't directly use fileName in a do-block like
fn <- fileName f
That would need to be a let-binding
let fn = fileName f
The next thing is what makes process :: [FileInfo] -> [String] impossible(1),
fileSource :: FileInfo -> Source (ResourceT IO) ByteString
so with
fc <- lift $ fileSource f $$ consume
you are in a do-block whose Monad is a MonadIO, and you can't get out of a Monad that can wrap arbitrary IO-actions, just like you can't get out of IO itself.
What you can have is
process :: (SomeFiendishConstraint m) => [FileInfo] -> m [Text]
process [] = return []
process (f:r) = do
let fn = fileName f
lift $ fileSource f $$ consume
fs <- process r
return (fn : fs)
or, more succinctly,
process = mapM (\f -> lift $ fileSource f $$ consume >> return fileName f)
and then
postImportR = do
fi <- lookupFiles "file"
process fi
(1) Barring unsafePerformIO.
Related
I have the following function:
main = do xs <- getContents
edLines <- ed $ lines xs
putStr $ unlines edLines
Firstly I used the working version main = interact (unlines . ed . lines) but changed the signature of ed since. Now it returns IO [String] instead of just [String] so I can't use this convenient definition any more.
The problem is that now my function ed is still getting evaluated partly but nothing is displayed till I close the stdin via CTRL + D.
Definition of ed:
ed :: Bool -> [EdCmdLine] -> IO EdLines
ed xs = concatM $ map toLinesExt $ scanl (flip $ edLine defHs) (return [Leaf ""]) xs where
toLinesExt :: IO [EdState] -> IO EdLines
toLinesExt rsIO = do
rs#(r:_) <- rsIO -- todo add fallback pattern with (error)
return $ fromEd r ++ [" "]
The scanl is definitely evaluated lazy because edLine is getting evaluated for sure (observable by the side effects).
I think it could have to do with concatM:
concatM :: (Foldable t, Monad m) => t (m [a]) -> m [a]
concatM xsIO = foldr (\accIO xIO -> do {x <- xIO; acc <- accIO; return $ acc ++ x}) (return []) xsIO
All I/O in Haskell is explicitly ordered. The last two lines of your main function desugar into something like
ed (lines xs) >>= (\edLines -> putStr $ unlines edLines)
>>= sequences all of the I/O effects on the left before all of those on the right. You're constructing an I/O action of the form generate line 1 >> ... >> generate line n >> output line 1 >> ... >> output line n.
This isn't really an evaluation order issue, it's a correctness issue. An implementation is free to evaluate in any order it wants, but it can't change the ordering of I/O actions that you specified, any more than it can reorder the elements of a list.
Here's a toy example showing what you need to do:
lineProducingActions :: [IO String]
lineProducingActions = replicate 10 getLine
wrongOrder, correctOrder :: IO ()
wrongOrder = do
xs <- sequence lineProducingActions
mapM_ putStrLn xs
correctOrder = do
let xs = [x >>= putStrLn | x <- lineProducingActions]
sequence_ xs
Note that you can decouple the producer and consumer while getting the ordering you want. You just need to avoid combining the I/O actions in the producer. I/O actions are pure values that can be manipulated just like any other values. They aren't side-effectful expressions that happen immediately as they're written. They happen, rather, in whatever order you glue them together in.
You would need to use unsafeInterleaveIO to schedule some of your IO actions for later. Beware that the IO actions may then be executed in a different order than you might first expect!
However, I strongly recommend not doing that. Change your IO [String] action to print each line as it's produced instead.
Alternately, if you really want to maintain the computation-as-pipeline view, check out one of the many streaming libraries available on Hackage (streamly, pipes, iteratees, conduit, machines, and probably half a dozen others).
Thanks to #benrg answer I was able to solve the issue with the following code:
ed :: [EdCmdLine] -> [IO EdLines]
ed cmds = map (>>= return . toLines . head) $ edHistIO where
toLines :: EdState -> EdLines
toLines r = fromEd r ++ [" "]
edHistIO = edRec defHs cmds (return [initState])
edRec :: [HandleHandler] -> [EdCmdLine] -> IO EdHistory -> [IO EdHistory]
edRec _ [] hist = [hist] -- if CTRL + D
edRec defHs (cmd:cmds) hist = let next = edLine defHs cmd hist in next : edRec defHs cmds next
main = getContents >>= mapM_ (>>= (putStr . unlines)) . ed . lines
I have a program that depending on the arguments given works in different ways:
If there are 2 arguments - it takes 2nd argument as a filename, reads from it and then simply prints it out.
If there is 1 argument - it reads from stdin and also prints it out.
Here is the code:
main :: IO ()
main = do
-- Read given arguments
args <- getArgs
-- If file containing gramma was given
if length args == 2 then do
hfile <- openFile (last args) ReadMode
content <- hGetContents hfile
let inGramma = getGramma content
doJob (head args) inGramma
hClose hfile
return ()
-- If no file was given - reads from stdin
else if length args == 1 then do
content <- getContents
let inGramma = getGramma content
doJob (head args) inGramma
return ()
else do putStrLn "Invalid count of arguments!"
The problem is, when it reads from stdin, after every new line (enter pressed), it prints that line and than reads next. I need it to wait for the whole input and than print it out (after Ctrl+D).
Here are the functions used in that code:
-- | Structure of gramma
data GrammaStruct = Gramma
{ nonTerminals :: NonTerminals
, terminals :: Terminals
, start :: Start
, rules :: Rules
} deriving (Eq)
-- | Representation of gramma
instance Show GrammaStruct where
show (Gramma n t s r) =
init (showSplit n) ++
"\n" ++ init (showSplit t) ++
"\n" ++ showStart s ++
"\n" ++ init (showRules r)
-- | Print gramma
showGramma :: GrammaStruct -> IO ()
showGramma gr = do
putStrLn $ show gr
-- | Transforms string given from file of stdin into gramma representation in app
getGramma :: String -> GrammaStruct
getGramma hIn = procLns (lines hIn)
-- | Depending on option given, provides required functionality
doJob :: String -> GrammaStruct -> IO ()
doJob op gramma
| op == "-i" = showGramma gramma
Thank you.
The problem here is that getContents uses lazy IO, making the input stream to be processed line-by-line. If you want to force it to read the whole input before starting performing the job you can use the following hack:
...
if length args == 1 then do
content <- getContents
length content `seq` return () -- force the input to be fully read now
let inGramma = getGramma content
doJob (head args) inGramma
return ()
Alternatively, use evaluate, or look in Hackage for a strict IO module providing a strict getContents. For instance, I just found the strict-io package providing System.IO.Strict.getContents. Using that you should be able to write (untested)
import qualified System.IO.Strict as S
...
if length args == 1 then do
content <- run S.getContents
...
That's not answering the question but instead of testing the length of the arguments, you can pattern match against it and return the correct content
main = do
let (opt, contentM) = case getArgs of
[opt] -> (op, getContent)
[opt, file] -> (op, hGetContent file)
_ -> error ("Invalid count of argument")
inGramma <- fmap getGramma contentM
doJob opt inGramma
I want to lazily read user input and do something with it line by line. But if user ends a line with , (comma) followed by any number of spaces (including zero), I want give him opportunity to finish his input on the next line.
And here is what I've got:
import System.IO
import Data.Char
chop :: String -> [String]
chop = f . map (++ "\n") . lines
where f [] = []
f [x] = [x]
f (x : y : xs) = if (p . tr) x
then f ((x ++ y) : xs)
else x : f (y : xs)
p x = (not . null) x && ((== ',') . last) x
tr xs | all isSpace xs = ""
tr (x : xs) = x :tr xs
main :: IO ()
main =
do putStrLn "Welcome to hell, version 0.1.3!"
putPrompt
mapM_ process . takeWhile (/= "quit\n") . chop =<< getContents
where process str = putStr str >> putPrompt
putPrompt = putStr ">>> " >> hFlush stdout
Sorry, it doesn't work at all. Bloody mess.
P.S. I want to preserve \n characters on end of every chunk. Currently I add them manually with map (++ "\n") after lines.
How about changing the type of chop a little:
readMultiLine :: IO [String]
readMultiLine = do
ln <- getLine
if (endswith (rstrip ln) ",") then
liftM (ln:) readMultiLine
else
return [ln]
Now you know that if the last list is not empty, then the user didn't finish typing (the last input ended with ',').
Of course, either import Data.String.Utils, or write your own. Could be as simple as:
endswith xs ys = (length xs >= length ys)
&& (and $ zipWith (==) (reverse xs) (reverse ys))
rstrip = reverse . dropWhile isSpace . reverse
But I missed the point at first. Here's the actual thing.
unfoldM :: (Monad m) => (a -> Maybe (m b, m a)) -> a -> m [b]
unfoldM f z = case f z of
Nothing -> return []
Just (x, y) -> liftM2 (:) x $ y >>= unfoldM f
main = unfoldM (\x -> if (x == ["quit"]) then Nothing
else Just (print x, readMultiLine)) =<< readMultiLine
The reason is, you need to be able to insert the "action" to be done on input between reading one multi-line input and the next. Here print x is the action inserted between two readMultiLine
Since you have questions about getContents, let me add. Even though getContents provides a lazy String, its effectful changes to the world are ordered with the subsequent effects of processing the list. But the processing of the list attempts to insert effects between effects of reading particular list items. To do that, you need a function that exposes the chain of effects, so you can insert your own effects between them.
You can do this using pipes, preserving the laziness of the user's input
import Data.Char (isSpace)
import Pipes
import qualified Pipes.Prelude as Pipes
endsWithComma :: String -> Bool
endsWithComma str =
case (dropWhile isSpace $ reverse str) of
',':_ -> True
_ -> False
finish :: Monad m => Pipe String String m ()
finish = do
str <- await
yield str
if endsWithComma str
then do
str' <- await
yield str'
else finish
user :: Producer String IO ()
user = Pipes.stdinLn >-> finish
You can then hook up the user Producer to any downstream Consumer. For example, to echo the stream back out you can write:
main = runEffect (user >-> Pipes.stdoutLn)
To learn more about pipes you can read the tutorial.
Sorry, I wrote something wrong in a comment and I thought that now that I understood what you were trying to do, I'd give an answer with a little more substance. The core idea is that you're going to need a state buffer while you loop through the string, as far as I can tell. You have f :: [String] -> [String] but you'll need an extra string of buffer before you can solve this puzzle.
So let me assume an answer which looks like:
chop = joinCommas "" . map (++ "\n") . lines
Then the structure of joinCommas is going to look like:
import Data.List (isSuffixOf)
-- override with however you want to handle the ",\n" between lines.
joinLines = (++)
incomplete = isSuffixOf ",\n"
joinCommas :: String -> [String] -> [String]
joinCommas prefix (line : rest)
| incomplete prefix = joinCommas (joinLines prefix line) rest
| otherwise = prefix : joinCommas line rest
joinCommas prefix []
| incomplete prefix = error "Incomplete input"
| otherwise = [prefix]
The prefix stores up lines until it doesn't end with ",\n" at which point it emits the prefix and continues with the rest of the lines. On EOF we process the last line unless that line is incomplete.
I have the following code:
import System.Environment
import System.Directory
import System.IO
import Data.List
dispatch :: [(String, [String] -> IO ())]
dispatch = [ ("add", add)
, ("view", view)
, ("remove", remove)
, ("bump", bump)
]
main = do
(command:args) <- getArgs
let result = lookup command dispatch
if result == Nothing then
errorExit
else do
let (Just action) = result
action args
errorExit :: IO ()
errorExit = do
putStrLn "Incorrect command"
add :: [String] -> IO ()
add [fileName, todoItem] = appendFile fileName (todoItem ++ "\n")
view :: [String] -> IO ()
view [fileName] = do
contents <- readFile fileName
let todoTasks = lines contents
numberedTasks = zipWith (\n line -> show n ++ " - " ++ line) [0..] todoTasks
putStr $ unlines numberedTasks
remove :: [String] -> IO ()
remove [fileName, numberString] = do
handle <- openFile fileName ReadMode
(tempName, tempHandle) <- openTempFile "." "temp"
contents <- hGetContents handle
let number = read numberString
todoTasks = lines contents
newTodoItems = delete (todoTasks !! number) todoTasks
hPutStr tempHandle $ unlines newTodoItems
hClose handle
hClose tempHandle
removeFile fileName
renameFile tempName fileName
bump :: [String] -> IO ()
bump [fileName, numberString] = do
handle <- openFile fileName ReadMode
(tempName, tempHandle) <- openTempFile "." "temp"
contents <- hGetContents handle
let number = read numberString
todoTasks = lines contents
bumpedItem = todoTasks !! number
newTodoItems = [bumpedItem] ++ delete bumpedItem todoTasks
hPutStr tempHandle $ unlines newTodoItems
hClose handle
hClose tempHandle
removeFile fileName
renameFile tempName fileName
Trying to compile it gives me the following error:
$ ghc --make todo
[1 of 1] Compiling Main ( todo.hs, todo.o )
todo.hs:16:15:
No instance for (Eq ([[Char]] -> IO ()))
arising from a use of `=='
Possible fix:
add an instance declaration for (Eq ([[Char]] -> IO ()))
In the expression: result == Nothing
In a stmt of a 'do' block:
if result == Nothing then
errorExit
else
do { let (Just action) = ...;
action args }
In the expression:
do { (command : args) <- getArgs;
let result = lookup command dispatch;
if result == Nothing then
errorExit
else
do { let ...;
.... } }
I don't get why is that since lookup returns Maybe a, which I'm surely can compare to Nothing.
The type of the (==) operator is Eq a => a -> a -> Bool. What this means is that you can only compare objects for equality if they're of a type which is an instance of Eq. And functions aren't comparable for equality: how would you write (==) :: (a -> b) -> (a -> b) -> Bool? There's no way to do it.1 And while clearly Nothing == Nothing and Just x /= Nothing, it's the case that Just x == Just y if and only if x == y; thus, there's no way to write (==) for Maybe a unless you can write (==) for a.
There best solution here is to use pattern matching. In general, I don't find myself using that many if statements in my Haskell code. You can instead write:
main = do (command:args) <- getArgs
case lookup command dispatch of
Just action -> action args
Nothing -> errorExit
This is better code for a couple of reasons. First, it's shorter, which is always nice. Second, while you simply can't use (==) here, suppose that dispatch instead held lists. The case statement remains just as efficient (constant time), but comparing Just x and Just y becomes very expensive. Second, you don't have to rebind result with let (Just action) = result; this makes the code shorter and doesn't introduce a potential pattern-match failure (which is bad, although you do know it can't fail here).
1:: In fact, it's impossible to write (==) while preserving referential transparency. In Haskell, f = (\x -> x + x) :: Integer -> Integer and g = (* 2) :: Integer -> Integer ought to be considered equal because f x = g x for all x :: Integer; however, proving that two functions are equal in this way is in general undecidable (since it requires enumerating an infinite number of inputs). And you can't just say that \x -> x + x only equals syntactically identical functions, because then you could distinguish f and g even though they do the same thing.
The Maybe a type has an Eq instance only if a has one - that's why you get No instance for (Eq ([[Char]] -> IO ())) (a function can't be compared to another function).
Maybe the maybe function is what you're looking for. I can't test this at the moment, but it should be something like this:
maybe errorExit (\action -> action args) result
That is, if result is Nothing, return errorExit, but if result is Just action, apply the lambda function on action.
In the following Haskell code:
data Cmd =
CmdExit |
CmdOther
deriving (Read, Show)
guiString2Cmd s =
(return (read s :: Cmd)) `catch` \(e :: SomeException) -> return CmdExit
If I do:
guiString2Cmd "CmdOther"
it all works fine. However if I do:
guiString2Cmd "some wrong string"
the code crashes instead of evaluating to CmdExit.
How can I make the code handle the exception instead of crashing?
Use the reads function, which is total, and wrap the failure case as a Maybe, like so:
maybeRead :: Read a => String -> Maybe a
maybeRead s = case reads s of
[(x, "")] -> Just x
_ -> Nothing
maybeRead is quite a versatile way to do safe parsing.
A solution is to simply use reads instead.
There exists an idiom of reading inside a monad:
readM :: (Monad m, Read a) => String -> m a
readM s | [x] <- [x | (x, "") <- reads s] = return x
-- or #[x] <- [x | (x, _) <- reads s] = return x#
-- to allow the garbage at the end of parsed string
| otherwise = fail $ "Failed to parse: \"" ++ s ++ "\""
it's unsafe for the IO monad:
> readM "CmdOther" :: IO Cmd
CmdOther
> readM "Cmd?Other" :: IO Cmd
*** Exception: user error (Failed to parse: "Cmd?Other")
because fail throws an IOError exception in the case of IO, which, however, can be handled:
*Main> (readM "Cmd?Other" :: IO Cmd) `catch` const (return CmdOther)
CmdOther
And safe in the case of Maybe monad:
> readM "CmdOther" :: Maybe Cmd
Just CmdOther
> readM "Cmd?Other" :: Maybe Cmd
Nothing
because fail is const Nothing in this case.
Anyway, if you want a total function guiString2Cmd with a signature String -> Cmd you can write it just like readM:
guiString2Cmd :: String -> Cmd
guiString2Cmd s | [x] <- [x | (x, "") <- reads s] = x
| otherwise = CmdExit
and then:
> guiString2Cmd "CmdOther"
CmdOther
> guiString2Cmd "Cmd?Other"
CmdExit
Slightly more generic approach.
For * kinds:
class Failable0 t where
fail0 :: t
readG0 :: (Failable0 t, Read t) => String -> t
readG0 s | [x] <- [x | (x, "") <- reads s] = x
| otherwise = fail0
then:
instance Failable0 Cmd where
fail0 = CmdExit
For * -> * kinds:
class Failable f where
fail :: String -> f a
class Functor f => Pointed f where
pure :: a -> f a
readG :: (Failable f, Pointed f, Read a) => String -> f a
readG s | [x] <- [x | (x, "") <- reads s] = pure x
| otherwise = fail $ "Failed to parse: \"" ++ s ++ "\""
I would personally recommend using readMay from the safe package:
readMay :: Read a => String -> Maybe a
Then you can either pattern-match on the 'Maybe a' result, use 'maybe', or even use the 'Maybe' monad to handle the result.