Commit 81daf662 authored by Oscar Leijendekker's avatar Oscar Leijendekker

Work on ch. 7

parent 01f3d976
Pipeline #95324960 passed with stage
in 4 minutes and 41 seconds
......@@ -15,6 +15,7 @@ import qualified Hasql.Encoders
import qualified Hasql.Decoders
import qualified Data.Text
import qualified Data.ByteString.UTF8 as StrictUTF8 (fromString, toString)
import Data.Functor.Contravariant (contramap)
data TaskStatus = Done | NotDone
deriving (Eq, Ord, Show, Read, Enum, Bounded)
......@@ -30,30 +31,32 @@ instance HTML Task where
NotDone -> "<p>" ++ description ++ "</p>"
Done -> "<p><strike>" ++ description ++ "</strike></p>"
fetchFromDB :: IO [Task]
fetchFromDB =
let
connectionSettings :: Hasql.Connection.Settings
connectionSettings =
Hasql.Connection.settings
"localhost"
(fromInteger 5432)
"Haskell-student"
"Why-are-you-putting-credentials-in-code?-You-absolute-potato!"
"todolists"
in do
connectionSettings :: Hasql.Connection.Settings
connectionSettings =
Hasql.Connection.settings
"localhost"
(fromInteger 5432)
"Haskell-student"
"Why-are-you-putting-credentials-in-code?-You-absolute-potato!"
"todolists"
runSessionAndClose :: Hasql.Session.Session a -> IO a
runSessionAndClose session =
do
connectionResult <- Hasql.Connection.acquire connectionSettings
case connectionResult of
Left (Just errMsg) -> error $ StrictUTF8.toString errMsg
Left Nothing -> error "Unspecified connection error"
Right connection -> do
queryResult <- Hasql.Session.run selectTasksSession connection
sessionResult <- Hasql.Session.run session connection
Hasql.Connection.release connection
case queryResult of
case sessionResult of
Right result -> return result
Left err -> error $ show err
fetchFromDB :: IO [Task]
fetchFromDB = runSessionAndClose selectTasksSession
selectTasksSession :: Hasql.Session.Session [Task]
selectTasksSession = Hasql.Session.statement () selectTasksStatement
......@@ -94,3 +97,30 @@ taskDecoder = do
taskDescription <- Hasql.Decoders.column stringDecoder
taskStatus <- Hasql.Decoders.column taskStatusDecoder
return $ Task taskDescription taskStatus
pushTaskToDB :: String -> IO ()
pushTaskToDB taskDescription =
let
session :: Hasql.Session.Session ()
session = Hasql.Session.statement taskDescription pushTaskStatement
in
runSessionAndClose session
pushTaskStatement :: Hasql.Statement.Statement String ()
pushTaskStatement =
Hasql.Statement.Statement
"INSERT INTO todolist_ch5 ( \
\ task, \
\ done \
\)\
\VALUES \
\ ( $1, FALSE );"
taskNameEncoder
Hasql.Decoders.unit
True
taskNameEncoder :: Hasql.Encoders.Params String
taskNameEncoder = Hasql.Encoders.param taskNameEncoder_value
taskNameEncoder_value :: Hasql.Encoders.Value String
taskNameEncoder_value = contramap Data.Text.pack Hasql.Encoders.text
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment