I tried the example on http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Strict.html#v:alterF , and had an error in repl:
interactiveAlter :: Int -> Map Int String -> IO (Map Int String)
interactiveAlter k m = alterF f k m where
f Nothing -> do
putStrLn $ show k ++
" was not found in the map. Would you like to add it?"
getUserResponse1 :: IO (Maybe String)
f (Just old) -> do
putStrLn "The key is currently bound to " ++ show old ++
". Would you like to change or delete it?"
getUserresponse2 :: IO (Maybe String)
error:
parse error on input ‘->’
f Nothing -> blah...
^^
I noticed the alterF is not existed in other version of Data.Map.Strict.
Does this relate to the version of GHC? If so, how can I get the version of my compiler?
What should I change to use this alertF in my project? I just want to use this alterF pattern to do something.
It's just because the sample has a syntax error.
To fix that, assign f with =.
In addition, the sample has several other errors.
Fixing all of them, it'd be:
interactiveAlter :: Int -> Map Int String -> IO (Map Int String)
interactiveAlter k m = alterF f k m where
f Nothing = do
putStrLn $ show k
++ " was not found in the map. Would you like to add it?"
getUserResponse1 :: IO (Maybe String)
f (Just old) = do
putStrLn $ "The key is currently bound to "
++ show old ++ ". Would you like to change or delete it?"
getUserResponse2 :: IO (Maybe String)
But remember you must define getUserResponse1 and getUserResponse2 by yourself to actually run the code above.
Related
I'm currently learning about free monads and I was toying with probably the simplest and most common example out there – Teletype:
{-# LANGUAGE DeriveFunctor #-}
import Control.Monad.Free
data TeletypeF a = Put String a
| Get (String -> a)
deriving Functor
type Teletype = Free TeletypeF
Many tutorials interpret Teletype programs in the IO monad. For example:
-- Utilities
get = liftF $ Get id
put s = liftF $ Put s ()
-- Sample programs
echo :: Teletype ()
echo = do word <- get
if word == "\04" -- Ctrl-D
then return ()
else put word >> echo
hello :: Teletype ()
hello = do put "What is your name?"
name <- get
put "What is your age?"
age <- get
put ("Hello, " ++ name ++ "!")
put ("You are " ++ age ++ " years old!")
-- Interpret to IO
interpIO :: Teletype a -> IO a
interpIO = foldFree lift
where
lift (Put s a) = putStrLn s >> return a
lift (Get f) = getLine >>= return . f
I was trying to interpret it in a different monad, namely the RWS monad.
This idea was motivated by the last exercise from this assignment.
I'm using the RWS datatype to fetch input from the Reader part and accumulate output in the State part.
But, unfortunately, I'm not able to get it working. Here is my attempt so far:
import Control.Monad.Trans.RWS.Lazy hiding (get, put)
type TeletypeRWS = RWS [String] () [String]
-- Interpret to TeletypeRWS
interpRWS :: Teletype a -> TeletypeRWS a
interpRWS = foldFree lift
where
lift (Put s a) = state (\t -> ((), t ++ [s])) >> return a
lift (Get f) = reader head >>= local tail . return . f -- This is wrong
mockConsole :: Teletype a -> [String] -> (a, [String])
mockConsole p inp = (a, s)
where
(a, s, _) = runRWS (interpRWS p) inp []
When running the TeletypeRWS "programs", the first value in the environment is not removed:
*Main> mockConsole hello ["john", "18"]
((),["What is your name?","What is your age?","Hello, john!","You are john years old!"])
I am a bit uneasy about updating the Reader, but I don't know how else I can access the next value in the list. The type of TeletypeRWS was chosen based on the exercise mentioned above – so I assume it should be possible to implement interpRWS.
We can't use foldFree: it needs to be parametric in the continuation, so we can't apply local there. In contrast, iterM explicitly gives us the actual continuation without generalization, so this will work.
interpRWS = iterM lift where
lift (Put s a) = modify (\t -> t ++ [s]) >> a
lift (Get f) = reader head >>= local tail . f
Using Parsec how does one indicate an error at a specific position if a semantic rule is violated. I know typically we don't want to do such things, but consider the example grammar.
<foo> ::= <bar> | ...
<bar> ::= a positive integer power of two
The <bar> rule is a finite set (my example is arbitrary), and a pure approach to the above could be a careful application of the choice combinator, but this might be impractical in space and time. In recursive descent or toolkit-generated parsers the standard trick is to parse an integer (a more relaxed grammar) and then semantically check the harder constraints. For Parsec, I could use a natural parser and check the result calling fail when that doesn't match or unexpected or whatever. But if we do that, the default error location is the wrong one. Somehow I need to raise the error at the earlier state.
I tried a brute force solution and wrote a combinator that uses getPosition and setPosition as illustrated by this very similar question. Of course, I was also unsuccessful (the error location is, of course wrong). I've run into this pattern many times. I am kind of looking for this type of combinator:
withPredicate :: (a -> Bool) -> String -> P a -> P a
withPredicate pred lbl p = do
ok <- lookAhead $ fmap pred (try p) <|> return False -- peek ahead
if ok then p -- consume the input if the value passed the predicate
else fail lbl -- otherwise raise the error at the *start* of this token
pPowerOfTwo = withPredicate isPowerOfTwo "power of two" natural
where isPowerOfTwo = (`elem` [2^i | i<-[1..20]])
The above does not work. (I tried variants on this as well.) Somehow the parser backtracks a says it's expecting a digit. I assume it's returning the error that made it the furthest. Even {get,set}ParserState fails erase that memory.
Am I handling this syntactic pattern wrong? How would all you Parsec users approach these type of problems?
Thanks!
I think both your ideas are OK. The other two answers deal with Parsec, but I'd like to note that in both
cases Megaparsec just does the right thing:
{-# LANGUAGE TypeApplications #-}
module Main (main) where
import Control.Monad
import Data.Void
import Text.Megaparsec
import qualified Text.Megaparsec.Char.Lexer as L
type Parser = Parsec Void String
withPredicate1 :: (a -> Bool) -> String -> Parser a -> Parser a
withPredicate1 f msg p = do
r <- lookAhead p
if f r
then p
else fail msg
withPredicate2 :: (a -> Bool) -> String -> Parser a -> Parser a
withPredicate2 f msg p = do
mpos <- getNextTokenPosition -- †
r <- p
if f r
then return r
else do
forM_ mpos setPosition
fail msg
main :: IO ()
main = do
let msg = "I only like numbers greater than 42!"
parseTest' (withPredicate1 #Integer (> 42) msg L.decimal) "11"
parseTest' (withPredicate2 #Integer (> 42) msg L.decimal) "22"
If I run it:
The next big Haskell project is about to start!
λ> :main
1:1:
|
1 | 11
| ^
I only like numbers greater than 42!
1:1:
|
1 | 22
| ^
I only like numbers greater than 42!
λ>
Try it for yourself! Works as expected.
† getNextTokenPosition is more correct than getPosition for streams where tokens contain position of their beginning and end in themselves. This may or may not be important in your case.
It's not a solution I like, but you can hypnotize Parsec into believing it's had a single failure with consumption:
failAt pos msg = mkPT (\_ -> return (Consumed (return $ Error $ newErrorMessage (Expect msg) pos)))
Here's a complete example:
import Control.Monad
import Text.Parsec
import Text.Parsec.Char
import Text.Parsec.Error
import Text.Parsec.Prim
import Debug.Trace
failAt pos msg = mkPT (\_ -> return (Consumed (return $ Error $ newErrorMessage (Expect msg) pos)))
type P a = Parsec String () a
withPredicate :: (a -> Bool) -> String -> P a -> P a
withPredicate pred msg p = do
pos <- getPosition
x <- p
unless (pred x) $ failAt pos msg
return x
natural = read <$> many1 digit
pPowerOfTwo = withPredicate isPowerOfTwo "power of two" natural
where isPowerOfTwo = (`elem` [2^i | i<-[1..20]])
main = print $ runParser pPowerOfTwo () "myinput" "4095"
When run, it results in:
Left "myinput" (line 1, column 1):
expecting power of two
I think the problem stems from how Parsec picks the "best error" in the non-deterministic setting. See Text.Parsec.Error.mergeError. Specifically, this selects the longest match when choosing which error is the error to report. I think we need some way to make Parsec order errors differently, which may be too obscure for us solving this problem.
In my case, I here's how I worked around the problem:
I solved stacked an Exception monad within my ParsecT type.
type P m = P.ParsecT String ParSt (ExceptT Diagnostic m)
Then I introduced a pair of combinators:
(Note: Loc is my internal location type)
-- stops hard on an error (no backtracking)
-- which is why I say "semantic" instead of "syntax" error
throwSemanticError :: (MonadTrans t, Monad m) => Loc -> String -> t (ExceptT Diagnostic m) a
throwSemanticError loc msg = throwSemanticErrorDiag $! Diagnostic loc msg
withLoc :: Monad m => (Loc -> P m a) -> P m a
withLoc pa = getLoc >>= pa
Now in parsing I can write:
parsePrimeNumber = withLoc $ \loc ->
i <- parseInt
unless (isPrime i) $ throwSemanticError loc "number is not prime!"
return i
The top level interface to run one of these monads is really nasty.
runP :: Monad m
=> ParseOpts
-> P m a
-> String
-> m (ParseResult a)
runP pos pma inp =
case runExceptT (P.runParserT pma (initPSt pos) "" inp) of
mea -> do
ea <- mea
case ea of
-- semantic error (throwSemanticError)
Left err -> return $! PError err
-- regular parse error
Right (Left err) -> return $ PError (errToDiag err)
-- success
Right (Right a) -> return (PSuccess a [])
I'm not terribly happy with this solution and desire something better.
I wish parsec had a:
semanticCheck :: (a -> Parsec Bool) -> Parsec a -> Parsec a
semanticCheck pred p =
a <- p
z <- pred a
unless z $
... somehow raise the error from the beginning of this token/parse
rather than the end ... and when propagating the error up,
use the end parse position, so this parse error beats out other
failed parsers that make it past the beginning of this token
(but not to the end)
return a
Using lookAhead, we can run a parser without consuming any input or registering any new errors, but record the state that we end up in. We can then apply a guard to the result of the parser. The guard can fail in whatever manner it desires if the value does not pass the semantic check. If the guard fails, then the error is located at the initial position. If the guard succeeds, we reset the parser to the recorded state, avoiding the need to re-execute p.
guardP :: Stream s m t => (a -> ParsecT s u m ()) -> ParsecT s u m a -> ParsecT s u m a
guardP guard p = do
(a, s) <- try . lookAhead $ do
a <- p
s <- getParserState
return (a, s)
guard a
setParserState s
return a
We can now implement pPowerOfTwo:
pPowerOfTwo :: Stream s m Char => ParsecT s u m Integer
pPowerOfTwo = guardP guardPowerOfTwo natural <?> "power of two"
where guardPowerOfTwo s = unless (s `elem` [2^i | i <- [1..20]]) . unexpected $ show s
I have a type called PartialDate
Then I have a function
readPartialDate :: String -> Maybe PartialDate
Bit of test code
main = do
[d] <- getArgs
return $ show $ readPartialDate d
runhaskell PartialDate.hs "12-2-2010"
"Just 12-2-2010"
All OK
Then I create a read simply by dispatching on readPartialDate:
instance Read PartialDate where
readsPrec _ s = case (readPartialDate s) of
Nothing -> []
Just p -> [(p, s)]
Test code:
main = do
[d] <- getArgs
return $ show $ ((read d) :: PartialDate)
runHaskell PartialDate.hs 12-2-2010
PartialDate.hs: Prelude.read: no parse
Does anyone know why putting a working function into a read might give rise to a parse error?
readPartialDate uses Parsec, and also uses reverse, so might there be a laziness issue here?
The problem is that in the definition of readsPrec,
readsPrec _ s = case (readPartialDate s) of
Nothing -> []
Just p -> [(p, s)]
you give the input String itself as the second component of the readsPrec result pair. read requires that the reads result have the second component empty, meaning that the entire input has been consumed to determine the value (in general, when you write Read instances, make sure you don't forget to consume trailing whitespace). Change the instance to
readsPrec _ s = case (readPartialDate s) of
Nothing -> []
Just p -> [(p, "")]
and it should work.
I'm completely new to Yesod (and not very experienced in haskell) and I'm trying to build my first handler. I scraffolded my app using default parameters (I'm using Yesod 0.9.4.1 version and choose postgresql in scraffolding) and now I'm trying to retrieve some data from a table using selectList. I defined a new table (let's call it Foo) in models config file:
Foo
xStart Int
yStart Int
and want to pass a list of FooId's and some other Foo attributes so I defined a route:
/foos/#Int/#Int/*FooId FoosReturnR GET
and a handler:
module Handler.FoosReturn where
import Import
selectWindowSize :: Int
selectWindowSize = 10000
getFoosReturnR :: Int -> Int -> [FooId] -> Handler RepPlain
getFoosReturnR x y withoutIds = do
foos <- runDB $ selectList [FooId /<-. withoutIds,
FooXStart <. x + selectWindowSize,
FooXStart >=. x - selectWindowSize,
FooYStart <. y + selectWindowSize,
FooYStart >=. y - selectWindowSize] []
return $ RepPlain $ toContent $ show foos
I imported the handler in Application.hs and added it to cabal file and now when I'm trying to run it I receive an error saying that FooId is not an instance of MultiPiece - but when I try to make it an instance there is an error saying that FooId is a type synonym and cannot be an instance of MultiPiece - how to resolve this problem?
EDIT:
Daniel: well, actually I don't know what exactly is FooId - it's a part of Yesod's magic which I don't fully understand so far - it's generated automatically from the table definition - but it's a some kind of a number.
Because I don't know how to use MultiPiece I switched to simpler solution and modified:
route: /foos/#Int/#Int/#String FoosReturnR GET
handler: [added also some logging]
module Handler.FoosReturn where
import Import
import Data.List.Split
import qualified Data.Text.Lazy as TL
selectWindowSize :: Int
selectWindowSize = 10000
getFoosReturnR :: Int -> Int -> String -> Handler RepPlain
getFoosReturnR x y withoutIds = do
app <- getYesod
liftIO $ logLazyText (getLogger app) ("getFoosReturnR('" `TL.append` (TL.pack $ (show x) ++ "', '" ++ (show y) ++ "', '" ++ withoutIds ++ "') "))
foos <- runDB $ selectList [FooId /<-. (map (\a -> read a :: FooId) $ splitOn "," withoutIds),
FooXStart <. x + selectWindowSize,
FooXStart >=. x - selectWindowSize,
FooYStart <. y + selectWindowSize,
FooYStart >=. y - selectWindowSize] []
return $ RepPlain $ toContent $ show foos
and now it is compiling but when I browse to: http://localhost:3000/sectors/1/1/1,2 I get a page containing only:
Internal Server Error
Prelude.read: no parse
Well, I don't fully understand what is FooId here - how to create such a list of FooId's from list of strings containing numbers?
And of course a solution of how to make the FooId an instance of MultiPiece is most wanted.
EDIT:
Daniel and svachalek, thanks for your posts - I tried your (Daniel's) solution but then I was receiving errors saying that [FooId] is expected (as in the handler function declaration) but FooId type was given and this lead me to the following solution:
data FooIds = FooIds [FooId] deriving (Show, Read, Eq)
instance MultiPiece FooIds where
toMultiPiece (FooIds fooList) = map (Data.Text.pack . show) fooList
fromMultiPiece texts =
if length (filter isNothing listOfMaybeFooId) > 0
then Nothing
else Just $ FooIds $ map fromJust listOfMaybeFooId
where
listOfMaybeFooId = map constructMaybeFooId texts
constructMaybeFooId :: Text -> Maybe FooId
constructMaybeFooId x = case reads (Data.Text.unpack x) :: [(FooId,String)] of
[(foo,_)] -> Just foo
_ -> Nothing
of course I changed the route to: /foos/#Int/#Int/*FooIds FoosReturnR GET
and the handler to:
getFoosReturnR :: Int -> Int -> FooIds -> Handler RepPlain
getFoosReturnR coordX coordY (FooIds withoutIds) = do
and now I don't get any errors during compilation nor runtime, and the only not satisfying thing is that I always receive Not Found as a result, even if I supply parameters that should give me some results - so now I have to figure out how to determine what SQL was exactly sent to the database
EDIT:
Now I see that the "Not Found" is connected to the problem and that the above edit is not a solution - when I browse to localhost:3000/foos/4930000/3360000 then I get the results (but then the FooIds is empty) - but when I add something like: localhost:3000/sectors/4930000/3360000/1 then I always get "Not Found" - so it's still not working..
Wish I could help, but yesod has something to do with web applications, as far as I know, hence I've never really looked at it. So I can just try a stab in the air, maybe I hit something.
Hayoo leads to
class MultiPiece s where
fromMultiPiece :: [Text] -> Maybe s
toMultiPiece :: s -> [Text]
in Yesod.Dispatch. Since FooId seems to have a Read instance and probably a Show instance, you could try
{-# LANGUAGE TypeSynonymInstances #-}
-- maybe also FlexibleInstances
instance MultiPiece FooId where
toMultiPiece foo = [Text.pack $ show foo]
fromMultiPiece texts =
case reads (unpack $ Text.concat texts) :: [(FooId,String)] of
[(foo,_)] -> Just foo
_ -> Nothing
I have no idea whether that is close to the right thing, and I would have posted it as a comment, but it's too long and there's not much formatting in comments. If it doesn't help I will delete it to not give the impression your question already has an answer when it hasn't.
The problem is solved:)
You could either use my implementation from one of the last edits of the question and browse to URL like: http://localhost:3000/foos/4930000/3360000/Key {unKey = PersistInt64 3}/Key {unKey = PersistInt64 4}
The Key type derives Read but not in a very friendly (and expected) way:)
Or change the implementation of fromMultiPiece to:
instance MultiPiece FooIds where
toMultiPiece (FooIds fooList) = map (Data.Text.pack . show) fooList
fromMultiPiece texts =
if length (filter isNothing listOfMaybeFooId) > 0
then Nothing
else Just $ FooIds $ map fromJust listOfMaybeFooId
where
listOfMaybeFooId = map constructMaybeFooId texts
constructMaybeFooId :: Text -> Maybe FooId
constructMaybeFooId x = case TR.decimal x of
Left err -> Nothing
Right (el,_) -> Just $ Key (PersistInt64 el)
and use URLs like: http://localhost:3000/foos/4930000/3360000/1/2
Many thanks to David McBride from the Yesod Web Framework Google Group
EDIT: the above solution had only one disadvantage - using the PersistInt64 type - it's not a good practice to use such a details of implementation, but it can be repaired by using fromPersistValue and toPersistValue functions from Database.Persist as follows:
instance MultiPiece FooIds where
toMultiPiece (FooIds fooList) = map (persistValuetoText . unKey) fooList
where
persistValuetoText x = case fromPersistValue x of
Left _ -> Data.Text.pack ""
Right val -> Data.Text.pack $ show (val::Int)
fromMultiPiece texts =
if length (filter isNothing listOfMaybeFooId) > 0
then Nothing
else Just $ FooIds $ map fromJust listOfMaybeFooId
where
listOfMaybeFooId = map constructMaybeFooId texts
constructMaybeFooId :: Text -> Maybe FooId
constructMaybeFooId x = case TR.decimal x of
Left _ -> Nothing
Right (el,_) -> Just $ Key (toPersistValue (el :: Int))
Again, big thanks to David McBride also for this!
I'm also fairly new to Yesod and I gave in and added -XTypeSynonymInstances to the ghc-options in my .cabal file, and so far it's made life a lot easier for me. I'm not sure if it's the most elegant answer to this particular problem, but otherwise I predict you'll run into that instance-of-alias error pretty frequently. P.S. try id = (Key (PersistInt 64 n))
Given the below program, I am having issues dealing with monads.
module Main
where
import System.Environment
import System.Directory
import System.IO
import Text.CSV
--------------------------------------------------
exister :: String -> IO Bool
exister path = do
fileexist <- doesFileExist path
direxist <- doesDirectoryExist path
return (fileexist || direxist )
--------------------------------------------------
slurp :: String -> IO String
slurp path = do
withFile path ReadMode (\handle -> do
contents <- hGetContents handle
last contents `seq` return contents )
--------------------------------------------------
main :: IO ()
main = do
[csv_filename] <- getArgs
putStrLn (show csv_filename)
csv_raw <- slurp csv_filename
let csv_data = parseCSV csv_filename csv_raw
printCSV csv_data -- unable to compile.
csv_data is an Either (parseerror) CSV type, and printCSV takes only CSV data.
Here's the ediff between the working version and the broken version.
***************
*** 27,30 ****
csv_raw <- slurp csv_filename
let csv_data = parseCSV csv_filename csv_raw
! printCSV csv_data -- unable to compile.
\ No newline at end of file
--- 27,35 ----
csv_raw <- slurp csv_filename
let csv_data = parseCSV csv_filename csv_raw
! case csv_data of
! Left error -> putStrLn $ show error
! Right csv_data -> putStrLn $ printCSV csv_data
!
! putStrLn "done"
!
reference: http://hackage.haskell.org/packages/archive/csv/0.1.2/doc/html/Text-CSV.html
Regarding monads:
Yes, Either a is a monad. So simplifying the problem, you are basically asking for this:
main = print $ magicMonadUnwrap v
v :: Either String Int
v = Right 3
magicMonadUnwrap :: (Monad m) => m a -> a
magicMonadUnwrap = undefined
How do you define magicMonadUnwrap? Well, you see, it's different for each monad. Each one needs its own unwrapper. Many of these have the word "run" in them, for example, runST, runCont, or runEval. However, for some monads, it might not be safe to unwrap them (hence the need for differing unwrappers).
One implementation for lists would be head. But what if the list is empty? An unwrapper for Maybe is fromJust, but what if it's Nothing?
Similarly, the unwrapper for the Either monad would be something like:
fromRight :: Either a b -> b
fromRight (Right x) = x
But this unwrapper isn't safe: what if you had a Left value instead? (Left usually represents an error state, in your case, a parse error). So the best way to act upon an Either value it is to use the either function, or else use a case statement matching Right and Left, as Daniel Wagner illustrated.
tl;dr: there is no magicMonadUnwrap. If you're inside that same monad, you can use <-, but to truly extract the value from a monad...well...how you do it depends on which monad you're dealing with.
Use case.
main = do
...
case csv_data of
Left err -> {- whatever you're going to do with an error -- print it, throw it as an exception, etc. -}
Right csv -> printCSV csv
The either function is shorter (syntax-wise), but boils down to the same thing.
main = do
...
either ({- error condition function -}) printCSV csv_data
You must unlearn what you have learned.
Master Yoda.
Instead of thinking about, or searching for ways to "free", "liberate", "release", "unwrap" or "extract" normal Haskell values from effect-centric (usually monadic) contexts, learn how to use one of Haskell's more distinctive features - functions are first-class values:
you can use functions like values of other types e.g. like Bool, Char, Int, Integer etc:
arithOps :: [(String, Int -> Int -> Int)]
arithOps = zip ["PLUS","MINUS", "MULT", "QUOT", "REM"]
[(+), (-), (*), quot, rem]
For your purposes, what's more important is that functions can also be used as arguments e.g:
map :: (a -> b) -> [a] -> [b]
map f xs = [ f x | x <- xs ]
filter :: (a -> Bool) -> [a] -> [a]
filter p xs = [ x | x <- xs, p x ]
These higher-order functions are even available for use in effect-bearing contexts e.g:
import Control.Monad
liftM :: Monad m => (a -> b) -> (m a -> m b)
liftM2 :: Monad m => (a -> b -> c) -> (m a -> m b -> m c)
liftM3 :: Monad m => (a -> b -> c -> d) -> (m a -> m b -> m c -> m d)
...etc, which you can use to lift your regular Haskell functions:
do .
.
.
val <- liftM3 calculate this_M that_M other_M
.
.
.
Of course, the direct approach also works:
do .
.
.
x <- this_M
y <- that_M
z <- other_M
let val = calculate x y z
.
.
.
As your skills develop, you'll find yourself delegating more and more code to ordinary functions and leaving the effects to a vanishingly-small set of entities defined in terms of functors, applicatives, monads, arrows, etc as you progress towards Haskell mastery.
You're not convinced? Well, here's a brief note of how effects used to be handled in Haskell - there's also a longer description of how Haskell arrived at the monadic interface. Alternately, you could look at Standard ML, OCaml, and other similar languages - who knows, maybe you'll be happier with using them...