Send Beginners mailing list submissions to
[email protected]
To subscribe or unsubscribe via the World Wide Web, visit
http://www.haskell.org/mailman/listinfo/beginners
or, via email, send a message with subject or body 'help' to
[email protected]
You can reach the person managing the list at
[email protected]
When replying, please edit your Subject line so it is more specific
than "Re: Contents of Beginners digest..."
Today's Topics:
1. Re: matrix vector product (Brent Yorgey)
2. sqlite+json: code improvement request (jjinkou syoujyo)
----------------------------------------------------------------------
Message: 1
Date: Mon, 12 Sep 2011 08:08:50 -0400
From: Brent Yorgey <[email protected]>
Subject: Re: [Haskell-beginners] matrix vector product
To: [email protected]
Message-ID: <[email protected]>
Content-Type: text/plain; charset=us-ascii
On Sun, Sep 11, 2011 at 09:30:00PM -0600, kolli kolli wrote:
> Hi,
> Can anyone help me with the matrix vector product?
You will have to be much more specific. What exactly do you need help
with?
-Brent
------------------------------
Message: 2
Date: Mon, 12 Sep 2011 16:52:17 +0100 (BST)
From: jjinkou syoujyo <[email protected]>
Subject: [Haskell-beginners] sqlite+json: code improvement request
To: "[email protected]" <[email protected]>
Message-ID:
<[email protected]>
Content-Type: text/plain; charset="iso-8859-1"
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 )
-------------- next part --------------
An HTML attachment was scrubbed...
URL:
<http://www.haskell.org/pipermail/beginners/attachments/20110912/e5350a41/attachment.htm>
------------------------------
_______________________________________________
Beginners mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/beginners
End of Beginners Digest, Vol 39, Issue 14
*****************************************
