- Beginners - Haskell.org

sqlite+json: code improvement request
by jjinkou syoujyo 12 Sep '11

12 Sep '11

Hello, i'm trying to implement this code which works but I would like to have advices to refactor this code to be more functionnal. This code receives an http request such as get?tab=urds,json={...}, converts the string json to a json structure. Then it translates it to an sqlite3 requests and sends back a json structure. since i will have several tables (urds, labos ... an so on ) i don't believe this code is optimal. there's a bunch of "case ..." that i really dislike. Though i know that i may try use ReadT monad, i don't really know how to use it with HDBCerrorhandler. here is the code: thank you for your help. ================ import Network.CGI import Database.HDBC import Database.HDBC.Sqlite3 import Data.Maybe (fromJust) import Library import Text.JSON import Control.Applicative data UrdTyp = UrdVal { urdID::String, urd::String, urdlaboID::String } deriving (Eq,Show) data LaboTyp = LaboVal { laboID::String, labo::String } deriving (Eq,Show) instance JSON UrdTyp where showJSON urds = makeObj [("urdID", showJSON $ urdID urds) ,("urd", showJSON $ urd urds) ,("laboID", showJSON $ urdlaboID urds)] readJSON urds = do obj <- readJSON urds UrdVal <$> valFromObj "urdID" obj <*> valFromObj "urd" obj <*> valFromObj "laboID" obj instance JSON LaboTyp where showJSON labos = makeObj [("laboID", showJSON $ laboID labos) ,("labo", showJSON $ labo labos)] readJSON labos = do obj <- readJSON labos LaboVal <$> valFromObj "laboID" obj <*> valFromObj "labo" obj sql2UrdVal::[(String,SqlValue)]->Maybe UrdTyp sql2UrdVal = toUrdVal . map (\(x,y)-> (x,fromSql y::String)) where toUrdVal obj= UrdVal <$> lookup "UrdID" obj <*> lookup "Urd" obj <*> lookup "LaboID" obj sql2LaboVal::[(String,SqlValue)]->Maybe LaboTyp sql2LaboVal = toLaboVal . map (\(x,y)-> (x,fromSql y::String)) where toLaboVal obj= LaboVal <$> lookup "LaboID" obj <*> lookup "Labo" obj sqlReadAll :: String ->IO [[(String,SqlValue)]] sqlReadAll table = do handle <- connectSqlite3 "fm.db" stmt <- prepare handle $ "SELECT * FROM " ++ table execute stmt [] entryRows <- fetchAllRowsAL' stmt disconnect handle return entryRows sqlReadOne:: String -> String -> Int -> IO [[(String,SqlValue)]] sqlReadOne table column eid = do handle <- connectSqlite3 "fm.db" stmt <- prepare handle $ "SELECT * FROM " ++ table ++ " where " ++ column ++" = ?" execute stmt [toSql eid] entryRows <- fetchAllRowsAL' stmt disconnect handle return entryRows queryAll:: CGI CGIResult queryAll = do Just table <- getInput "tab" entryRows <- liftIO $sqlReadAll table case table of "urds" -> do let sqlUrds = map sql2UrdVal entryRows let listUrds=map (encode.showJSON.fromJust) sqlUrds let toStr=foldr (\a b -> a++","++b) [] listUrds setHeader "Content-type" "application/x-javascript" output $ "{\"list\":" ++ "[" ++ toStr ++ "]" ++ "}" "labos" -> do let sqlLabos = map sql2LaboVal entryRows let listLabos=map (encode.showJSON.fromJust) sqlLabos let toStr=foldr (\a b -> a++","++b) [] listLabos setHeader "Content-type" "application/x-javascript" output $ "{\"list\":" ++ "[" ++ toStr ++ "]" ++ "}" queryOne:: CGI CGIResult queryOne = do jsonString <- getInput "json" Just table <- getInput "tab" case table of "urds" -> do let (Ok j) = (decode.fromJust) jsonString::Result UrdTyp let idjson = (read.urdID) j ::Int entryRows <- liftIO $sqlReadOne "urds" "urdID" idjson let sqlUrds = map sql2UrdVal entryRows let val=head.map (encode.showJSON.fromJust) $sqlUrds setHeader "Content-type" "application/x-javascript" output $"{\"data\":"++ val ++"}" "labos" -> do let (Ok j) = (decode.fromJust) jsonString::Result LaboTyp let idjson = (read.laboID) j ::Int entryRows <- liftIO $sqlReadOne "labos" "laboID" idjson let sqlLabos = map sql2LaboVal entryRows let val=head.map (encode.showJSON.fromJust) $sqlLabos setHeader "Content-type" "application/x-javascript" output $"{\"data\":"++ val ++"}" addEntrySql :: CGI CGIResult addEntrySql = do jsonString<- getInput "json" Just table <- getInput "tab" case table of "urds" -> do let (Ok j) = (decode.fromJust) jsonString::Result UrdTyp dbh <- liftIO $ connectSqlite3 "fm.db" adEJson <-liftIO $ addUrd dbh j liftIO $ commit dbh liftIO $ disconnect dbh setHeader "Content-type" "application/x-javascript" output $ "{\"entry\": " ++ "\"added\"" ++",\n\"data\": "++ encode adEJson ++"}" "labos" -> do let (Ok j) = (decode.fromJust) jsonString::Result LaboTyp dbh <- liftIO $ connectSqlite3 "fm.db" adEJson <-liftIO $ addLabo dbh j liftIO $ commit dbh liftIO $ disconnect dbh setHeader "Content-type" "application/x-javascript" output $ "{\"entry\": " ++ "\"added\"" ++",\n\"data\": " ++ encode adEJson ++"}" addUrd :: (IConnection conn) => conn -> UrdTyp -> IO UrdTyp addUrd dbh urdJs = handleSql errorHandler $ do run dbh "insert into urds (urd,LaboID) values (?,?)" $ map toSql [urd urdJs, urdlaboID urdJs] r <- quickQuery' dbh "select urdID from urds where urd=?" [toSql (urd urdJs)] case r of [[x]] -> return urdJs {urdID= fromSql x} y -> fail $ "addentry: unexpected result: " ++ show y where errorHandler e = do fail $ "problem addentry: "++ show e addLabo :: (IConnection conn) => conn -> LaboTyp -> IO LaboTyp addLabo dbh laboJs = handleSql errorHandler $ do run dbh "insert into labos (labo) values (?)" $ map toSql [labo laboJs] r <- quickQuery' dbh "select laboID from labos where labo=?" [toSql (labo laboJs)] case r of [[x]] -> return laboJs {laboID= fromSql x} y -> fail $ "addentry: unexpected result: " ++ show y where errorHandler e = do fail $ "problem addentry: "++ show e updateEntrySql :: CGI CGIResult updateEntrySql = do jsonString<- getInput "json" Just table <- getInput "tab" case table of "urds" -> do let (Ok j) = (decode.fromJust) jsonString::Result UrdTyp let entryId = urdID j dbh <- liftIO $ connectSqlite3 "fm.db" liftIO $ updateUrd dbh j entryId liftIO $ commit dbh liftIO $ disconnect dbh setHeader "Content-type" "application/x-javascript" output $ "{\"entry\": " ++ "\"modified\"" ++"}" "labos" -> do let (Ok j) = (decode.fromJust) jsonString::Result LaboTyp let entryId = laboID j dbh <- liftIO $ connectSqlite3 "fm.db" liftIO $ updateLabo dbh j entryId liftIO $ commit dbh liftIO $ disconnect dbh setHeader "Content-type" "application/x-javascript" output $ "{\"entry\": " ++ "\"modified\"" ++"}" updateUrd :: (IConnection conn) => conn -> UrdTyp -> String -> IO () updateUrd dbh urdJs entryId = handleSql errorHandler $ do r <- quickQuery' dbh "select urdID from urds where urdID=?" [toSql entryId] case r of [[x]] -> run dbh "UPDATE urds SET urd=?, laboID=? WHERE urdID=?" (map toSql [urd urdJs, urdlaboID urdJs, entryId]) >> return () y -> fail $ "updateUrd: no such urdID : " ++ show y where errorHandler e = do fail $ "problem updateUrd: "++ show e updateLabo :: (IConnection conn) => conn -> LaboTyp -> String -> IO () updateLabo dbh laboJs entryId = handleSql errorHandler $ do r <- quickQuery' dbh "select laboID from labos where laboID=?" [toSql entryId] case r of [[x]] -> run dbh "UPDATE labos SET labo=? WHERE laboID=?" (map toSql [labo laboJs, entryId]) >> return () y -> fail $ "updateLabo: no such laboID : " ++ show y where errorHandler e = do fail $ "problem updatelabo: "++ show e removeEntrySql :: CGI CGIResult removeEntrySql = do jsonString<- getInput "json" Just table <- getInput "tab" case table of "urds" -> do let (Ok j) = (decode.fromJust) jsonString::Result UrdTyp dbh <- liftIO $ connectSqlite3 "fm.db" liftIO $ removeUrd dbh (read(urdID j)::Int) liftIO $ commit dbh liftIO $ disconnect dbh setHeader "Content-type" "application/x-javascript" output $ "{\"entry\": " ++ "\"deleted\"" ++",\n\"EntryId\": "++ show (urdID j) ++"}" "labos" -> do let (Ok j) = (decode.fromJust) jsonString::Result LaboTyp dbh <- liftIO $ connectSqlite3 "fm.db" liftIO $ removeLabo dbh (read(laboID j)::Int) liftIO $ commit dbh liftIO $ disconnect dbh setHeader "Content-type" "application/x-javascript" output $ "{\"entry\": " ++ "\"deleted\"" ++",\n\"EntryId\": "++ show (laboID j) ++"}" removeUrd :: (IConnection conn) => conn -> Int -> IO () removeUrd dbh entryId = handleSql errorHandler $ do r <- quickQuery' dbh "select urdID from urds where urdID=?" [toSql entryId] case r of [[x]] -> run dbh "DELETE FROM urds WHERE urdID=?" [toSql (entryId)] >> return () y -> fail $ "removeUrd: no such urdID : " ++ show y where errorHandler e = do fail $ "problem removeUrd: "++ show e removeLabo :: (IConnection conn) => conn -> Int -> IO () removeLabo dbh entryId = handleSql errorHandler $ do r <- quickQuery' dbh "select LaboID from labos where laboID=?" [toSql entryId] case r of [[x]] -> run dbh "DELETE FROM labos WHERE laboID=?" [toSql (entryId)] >> return () y -> fail $ "removeLabo: no such laboID : " ++ show y where errorHandler e = do fail $ "problem removeLabo: "++ show e queryCommand :: CGI CGIResult queryCommand = do commandString <- getInput "command" case (fromJust commandString) of "Get" -> queryOne "GetAll" -> queryAll "AddEntry" -> addEntrySql "Modify" -> updateEntrySql "Remove" -> removeEntrySql _ -> do setHeader "Content-type" "application/x-javascript" output $ "{\"command\":\"rien compris du tout\"}" main = runCGI (handleErrors queryCommand )

1 0

matrix vector product
by kolli kolli 12 Sep '11

12 Sep '11

Hi, Can anyone help me with the matrix vector product?

2 1

Re: [Haskell-beginners] Question about lazy evaluation
by Zhi-Qiang Lei 12 Sep '11

12 Sep '11

On Sep 9, 2011, at 1:36 PM, Brandon Allbery wrote: > On Thu, Sep 8, 2011 at 23:41, Zhi-Qiang Lei <zhiqiang.lei(a)gmail.com> wrote: > But the final result is "foobar", so when you said it has completely forgotten about the 'f', were you just meaning in or after that special recursion step, and the 'f' is stored in somewhere else? What is the difference here between Haskell and other imperative language? Thanks. > > The 'f' has been passed up to the caller, and is no longer known within *this* computation. Assuming something else isn't holding onto a reference to the computation this one was passed as a parameter, the "cell" that bound the 'f' to the rest of it can be garbage collected immediately and the 'f' will be garbage collected whenever the caller is done with it. > > Maybe the part you're missing is that it's effectively incremental. Instead of computing and returning the whole thing, it's done one element at a time and (unless it is forced to be strict somehow) the whole "foobar" isn't ever created as such. (Unless the caller simply re-concatenates the individual elements.) Instead of returning the whole thing, any computation "yield"s (see Python, Ruby, or Icon "generators") the current element and holds on to the rest for the next time it's invoked. So flow of control is not linear; it follows the exact datum needed at any given step and does that and no more. > > Strict: compute "foobar" and return to caller > > Lazy: Each line below is a subsequent return of control from the caller. > > 1. Compute ('f' : ('o' : ("o" ++ "bar"))), yield 'f' to caller, holding onto the tail > 2. Compute ('o' : ("o" ++ "bar"")), yield 'o' > The outermost computation is now the (++), so we do that first. The standard expansion of (++) is > > > [] ++ ys = ys > > (x:xs) ++ ys = x : (xs ++ ys) > > This is designed to be lazy: the first case just yields up the second parameter to be processed directly, since nothing else can be done with it; the second case picks the first parameter apart one element at a time, yielding each one, then ultimately falls into the first case once the first parameter has been emptied. So: > > 3. Compute ('o' : ("" ++ "bar")) by second case of (++), yield 'o' > 4. Compute "bar" by first case of (++), yield 'b', holding the tail ('a' : 'r' : []) > 5. Compute ('a' : ('r' : [])), yield 'a' > 6. Compute ('r' : []), yield 'r' > 7. Return [] > > Getting technical: everything (except unboxed values, which you won't see in normal Haskell) is represented as a "thunk", a chunk of code ("computation") which yields up values each time it is invoked until it is exhausted. Values are yielded by evaluating to "weak head normal form", that is, until we reach a data constructor tag. In this case, the constructor for a character constant internally looks something like (C# 'f'#), where C# is the constructor and 'f'# is a raw ("unboxed") Unicode code point stored as a 32-bit machine word. (The (:) is a constructor as well.) This is how we evaluate "through" the (++) to produce a value in step 4; since (++) doesn't produce something in WHNF (when it "returns" ys, it is returning an unevaluated thunk that represents the second parameter), evaluation continues inward until it does (on the next low-level evaluation step, when that anonymous function is invoked). > > In normal Haskell, everything is "boxed" (wrapped in a constructor), which is what enables laziness; almost always, what's passed around isn't a value but an anonymous function which computes that value. The stuff that can do the final step of reaching inside a constructor to get at the actual value is hidden inside the runtime code. Much of it is tied to the IO monad, but not all: (+) for a primitive data type such as Int is strict, and reaches inside the constructors of its parameters when evaluated. > > Sometimes you want lazy addition, though; often enough that there are a number of packages on Hackage that implement Peano numbers in the type system, aka "type-level naturals". I'll go through one of the simpler implementations this as another example of laziness: > > > data Nat = Z | S Nat > > > > (+') :: Nat -> Nat -> Nat > > Z +' ys = ys -- compare to [] case for (++) earlier > > (S xs) +' ys = x +' S ys -- compare to the other case > > The first parameter to (+') is always evaluated to WHNF (because we're pattern matching on it, which is strict); this makes it either Z (zero) or (S x) for an x that is not itself evaluated yet. Beyond that, nothing is evaluated; the result has both x and y unevaluated, and simply moves a constructor inward. Comparing to (++) above, we have (S xs) here vs. (x : xs) above (this is sometimes referred to as a "functional list" since it's a list built via function/constructor application instead of via the list constructor (:)). The other difference is that there's only one non-"empty list" value in the Peano numbers (S) whereas a general list can contain any boxed value (x). > > (There is a temptation to "optimize" the above definition by adding in between the two cases > > > xs +' Z = xs > > This is *not* an optimization in a lazy language! It's forcing the second parameter to be evaluated to WHNF (to see if it's Z or (S x)) when it needn't be; this ends up making (+') strict instead of lazy, and the result is just a painfully slow version of the strict (+). It may be (at least when the full case is expensive) an optimization in a strict language, but in a lazy language you want to avoid these kinds of unnecessary tests; lazy incremental evaluation means the runtime may never need to evaluate the second parameter at all, so why force it?) > > I hope this makes things a little clearer. > > -- > brandon s allbery allbery.b(a)gmail.com > wandering unix systems administrator (available) (412) 475-9364 vm/sms > That's much clearer. I appreciate everyone in this thread. Best regards, Zhi-Qiang Lei zhiqiang.lei(a)gmail.com

1 0

error handling approaches
by Michael Litchard 12 Sep '11

12 Sep '11

Here's the gist of the code I am looking to incorporate error handling into > worldHandler :: ProcessState -> JobCount -> IO () > worldHandler world jCount = do > putStrLn "Entered worldHandler" > jcount <- takeMVar jCount > if jcount > 0 > then incrementThenDone jcount > else doJobProcessing jcount > where incrementThenDone jcount = do > putMVar jCount (jcount+1) > doJobProcessing jcount = do > putMVar jCount (jcount+1) > preProcess world > initiateJob world > makeChart world Here's main > main :: IO () > main = do > world <- (newEmptyMVar :: IO ProcessState) > jCount <- (newMVar 0 :: IO JobCount) > installHandler userDefinedSignal1 (Catch $ worldHandler world jCount) Nothing > forever (threadDelay 10000) the functions preProcess, initiateJob, and makeChart is where I need be concerned with errors. The idea is that if any of those functions fail, I decrement jCount. call logError, and continue waiting for the next signal. each of these functions will be starting another process, readProcessWithExitCode looks like what I want. I will then use the exit code to determine success or failure. General ideas about how to approach this, and any questions that come to mind would be appreciated.

1 2

Implementing Read
by Peter Hall 12 Sep '11

12 Sep '11

I'm having some trouble defining an implementation for "Read". I know I could model a card more simply as an unconstrained tuplet, but I'm trying to learn new things about haskell as I go. module Card.Card ( Suit(..) ,Card(..) ) where data Suit = Club | Spade | Diamond | Heart deriving (Eq, Ord, Show, Read, Bounded, Enum) data Card = Card { suit :: Suit , rank :: Int } deriving (Ord, Bounded, Eq) instance Show Card where show Card { suit = Club, rank = a } = show a ++ "c" show Card { suit = Spade, rank = a } = show a ++ "s" show Card { suit = Heart, rank = a } = show a ++ "h" show Card { suit = Diamond, rank = a } = show a ++ "d" instance Read Card where readsPrec (a:b) = Card{ suit=(toSuit a), rank=(read b) } where toSuit s | s=='c' = Club | s=='s' = Spade | s=='d' = Diamond | s=='h' = Heart The error is: Card/Card.hs:24:12: Couldn't match expected type `Int' against inferred type `[a]' In the pattern: a : b In the definition of `readsPrec': readsPrec (a : b) = Card {suit = (toSuit a), rank = (read b)} where toSuit s | s == 'c' = Club | s == 's' = Spade | s == 'd' = Diamond | s == 'h' = Heart In the instance declaration for `Read Card' Where am I going wrong? Thanks, Peter

3 5

How do I define data types with arbitrary content?
by Alexander Raasch 11 Sep '11

11 Sep '11

Hi, just for the sake of deepening my understanding of Haskell types, I'm looking for a way to define a data type, like list or tree, that takes arbitrary values as its content. In Java, I would write class Tree { Object node; Tree left; Tree right; } and that allows me to put Integers, Strings, or anything into the tree, since they all inherit from Object. How would I go about defining such a type in Haskell? I'm reading www.learnyouahasell.com and all of the examples use only a single type parameter as in data Tree a = Nil | Node a (Tree a) (Tree a) so you can't mix Integers and Strings for example. Alex

2 1

Attoparsec and multiline comments
by Alexander.Vladislav.Popov 10 Sep '11

10 Sep '11

Dear haskellers, Help me to parse multiline comments (like /* ... */ or even like /*- ... -*/) using attoparsec. Thanks in advance, Alexander.

1 0

Re: [Haskell-beginners] forkIO and signal handlers
by Michael Litchard 09 Sep '11

09 Sep '11

Thanks for the reply. The problem isn't signal handling, nor is it using forkIO. It's using both of them together. On Fri, Sep 9, 2011 at 12:14 PM, Tim Perry <tim.perry(a)lifetime.oregonstate.edu> wrote: > There is an example of forking processes in the "Real World Haskell" book in > chapter 20 - Systems Programming. > http://book.realworldhaskell.org/read/systems-programming-in-haskell.html > > Unfortunately I don't think it covers catching signals. I hope this helps. > Tim > ________________________________ > From: Michael Litchard <michael(a)schmong.org> > To: beginners(a)haskell.org > Sent: Friday, September 9, 2011 12:06 PM > Subject: [Haskell-beginners] forkIO and signal handlers > > I am trying to use installHandler with forkIO. > I'd like to fork a process in Main when a signal is caught, having > trouble with the types and I'm sure there is a convention I'm not > familiar with. > Could I see an example of how this is done? > > _______________________________________________ > Beginners mailing list > Beginners(a)haskell.org > http://www.haskell.org/mailman/listinfo/beginners > > >

3 4

forkIO and signal handlers
by Michael Litchard 09 Sep '11

09 Sep '11

I am trying to use installHandler with forkIO. I'd like to fork a process in Main when a signal is caught, having trouble with the types and I'm sure there is a convention I'm not familiar with. Could I see an example of how this is done?

1 0

Re: [Haskell-beginners] a parse error....i can't fix it
by anyzhen 09 Sep '11

09 Sep '11

thank you ------------------ Original ------------------ From: "Luca Ciciriello"; Date: 2011年9月9日(星期五) 晚上11:12 To: "anyzhen"; Cc: "Beginners"; Subject: Re: [Haskell-beginners] a parse error....i can't fix it Formatted in this way should be compile: linerFind :: [Int] -> Int -> MaxSA -> MaxSA --MaxSA is MaximumSubarray linerFind xs len ms1@(MaxSA l h m) -- (MaxSA leftPosition rightPosition maxsum) | h<len = keepFind ms1 | otherwise = ms1 where keepFind ms'@(MaxSA l' h' m') = let ms2@(MaxSA l2 h2 m2)= find' xs l' (h'+1) in if m < m2 then linerFind xs len ms2 else keepFind ms2 Bye Luca. On Sep 9, 2011, at 4:53 PM, anyzhen wrote: sorry and please forget the name and what it is meaning for. just look at in syntax aspect the error : "parse error on input `|' Failed, modules loaded: none." linerFind :: [Int] -> Int -> MaxSA -> MaxSA --MaxSA is MaximumSubarray linerFind xs len ms1@(MaxSA l h m) -- (MaxSA leftPosition rightPosition maxsum) | h<len = keepFind ms1 where keepFind ms'@(MaxSA l' h' m')= let ms2@(MaxSA l2 h2 m2)= find' xs l' (h'+1) in if m < m2 then linerFind xs len ms2 else keepFind ms2 |otherwise = ms1 --compiler say error is in this line _______________________________________________ Beginners mailing list Beginners(a)haskell.org http://www.haskell.org/mailman/listinfo/beginners

1 0