Commit a0893cb1 authored by Oscar Leijendekker's avatar Oscar Leijendekker

Work on ch.5

parent bcd1519b
Pipeline #92604366 failed with stage
in 2 minutes and 6 seconds
......@@ -2,3 +2,5 @@ FROM postgres:latest
ENV POSTGRES_USER "Haskell-student"
ENV POSTGRES_PASSWORD "Why-are-you-putting-credentials-in-code?-You-absolute-potato!"
COPY docker-entrypoint-initdb.d/ ./docker-entrypoint-initdb.d/
CREATE DATABASE todolists;
\connect todolists
CREATE TABLE todolist_ch5 (
task TEXT NOT NULL,
done BOOLEAN NOT NULL
);
INSERT INTO todolist_ch5 (
task,
done
)
VALUES
( 'create todo list', TRUE ),
( 'put todo list in database', TRUE ),
( 'invent terror drones', FALSE ),
( 'achieve world domination', FALSE );
......@@ -25,7 +25,8 @@ dependencies:
- wai >= 3.2.2.1 && < 4
- http-types >= 0.12.3 && < 0.13
- utf8-string >= 1.0.1.1 && < 2
- hasql >= 1.3.0.6 && < 2
- hasql == 1.3.0.6
- text >= 1.2.3.1 && < 2
library:
source-dirs: src
......
......@@ -10,41 +10,82 @@ import Network.HTTP.Types.Status (status200)
import qualified Data.ByteString.Lazy.UTF8 as UTF8 (fromString, toString)
import qualified Data.ByteString.UTF8 as StrictUTF8 (fromString, toString)
import qualified Hasql.Connection
import qualified Hasql.Session
import qualified Hasql.Statement
import qualified Hasql.Encoders
import qualified Hasql.Decoders
import qualified Data.Text
someFunc :: IO ()
someFunc = do
connectToDB
run 8080 requestHandler
requestHandler :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
requestHandler request respond =
let
htmlPage = UTF8.fromString $ toHTMLPage myTodoList
response = responseLBS status200 [] htmlPage
htmlPage htmlAble = UTF8.fromString $ toHTMLPage htmlAble
response tasks = responseLBS status200 [] $ htmlPage tasks
in
do
taskList <- fetchFromDB
putStrLn "Received an HTTP request!"
respond response
respond $ response taskList
connectToDB :: IO ()
connectToDB =
fetchFromDB :: IO [Task]
fetchFromDB =
let
connectionSettings :: Hasql.Connection.Settings
connectionSettings =
Hasql.Connection.settings
"localhost"
(toEnum 5432)
(fromInteger 5432)
"Haskell-student"
"Why-are-you-putting-credentials-in-code?-You-absolute-potato!"
""
"todolists"
in do
connectionResult <- Hasql.Connection.acquire connectionSettings
case connectionResult of
Left (Just errMsg) -> error $ StrictUTF8.toString errMsg
Left Nothing -> error "Unspecified connection error"
Right connection ->
Hasql.Connection.withLibPQConnection connection (\_ -> putStrLn "Acquired connection!")
Right connection -> do
queryResult <- Hasql.Session.run selectTasksSession connection
Hasql.Connection.release connection
case queryResult of
Right result -> return result
Left err -> error $ show err
selectTasksSession :: Hasql.Session.Session [Task]
selectTasksSession = Hasql.Session.statement () selectTasksStatement
selectTasksStatement :: Hasql.Statement.Statement () [Task]
selectTasksStatement =
Hasql.Statement.Statement
"SELECT * FROM todolist_ch5"
Hasql.Encoders.unit
tasksDecoder
True
tasksDecoder :: Hasql.Decoders.Result [Task]
tasksDecoder = Hasql.Decoders.rowList taskDecoder
boolToTaskStatus :: Bool -> TaskStatus
boolToTaskStatus True = Done
boolToTaskStatus False = NotDone
taskStatusDecoder :: Hasql.Decoders.Value TaskStatus
taskStatusDecoder = fmap boolToTaskStatus Hasql.Decoders.bool
stringDecoder :: Hasql.Decoders.Value String
stringDecoder = fmap Data.Text.unpack Hasql.Decoders.text
stringDecoder_row :: Hasql.Decoders.Row String
stringDecoder_row = Hasql.Decoders.column stringDecoder
taskStatusDecoder_row :: Hasql.Decoders.Row TaskStatus
taskStatusDecoder_row = Hasql.Decoders.column taskStatusDecoder
taskDecoder :: Hasql.Decoders.Row Task
taskDecoder = Task <$> stringDecoder_row <*> taskStatusDecoder_row
data TaskStatus = Done | NotDone
......
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