{-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} module Main where import Data.Text import Okapi import Control.Monad.IO.Class import Control.Monad.Trans.Class import Data.IORef import Data.Map import GHC.Generics import Data.List.NonEmpty import Database.SQLite.Simple import Database.SQLite.Simple.FromField import Database.SQLite.Simple.ToField import Text.InterpolatedString.Perl6 import Control.Monad.Combinators import Web.Internal.HttpApiData import Web.Internal.FormUrlEncoded import Data.ByteString import System.Random data Make = Toyota | Ford | Honda | Mercedes | BMW deriving (Eq, Show) instance ToHttpApiData Make where toQueryParam = \case Toyota -> "toyota" Ford -> "ford" Honda -> "honda" Mercedes -> "mercedes" BMW -> "bmw" instance FromHttpApiData Make where parseQueryParam = \case "toyota" -> Right Toyota "ford" -> Right Ford "honda" -> Right Honda "mercedes" -> Right Mercedes "bmw" -> Right BMW _ -> Left "Couldn't parse car make" data Car = Car { carMake :: Make , carYear :: Int , carMiles :: Int , carPrice :: Float } deriving (Eq, Show, Generic, FromForm) pattern HomeRoute = (GET, []) pattern QueryCarsRoute = (GET, ["cars"]) pattern PostCarsRoute = (POST, ["cars"]) pattern PostSuccessRoute = (GET, ["cars", "post", "success"]) pattern PostFailureRoute = (GET, ["cars", "post", "failure"]) renderURL :: (Method, Path) -> Text renderURL (_, p) = renderPath p renderFormAttrs :: (Method, Path) -> Text renderFormAttrs (m, p) = renderAction p <> " " <> renderMethod m where renderAction p = "action=\"" <> renderPath p <> "\"" renderMethod = \case POST -> "method=\"" <> "post" <> "\"" _ -> "method=\"" <> "get" <> "\"" -- ^ method="get" is the default method for forms methodAndPathParser :: MonadOkapi m => m (Method, Path) methodAndPathParser = do m <- method p <- path return (m, p) methodAndPathDispatcher :: (MonadOkapi m, MonadIO m) => IORef [Car] -> (Method, Path) -> m Response methodAndPathDispatcher database = \case HomeRoute -> do let html = [qq|
Make | Year | Miles | Price |
---|