* code cleanup

frameworks/Haskell/yesod-postgres/bench/src/Main.hs

@@ -15,43 +15,28 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Main (main, resourcesApp, Widget, WorldId) where
-import           Blaze.ByteString.Builder
-import           Control.Applicative           (liftA2)
 import           Control.Concurrent            (runInUnboundThread)
-import           Control.Monad                 (replicateM, forM)
+import           Control.Monad                 (forM)
 import           Control.Monad.Logger          (runNoLoggingT)
 import           Control.Monad.Primitive       (PrimState)
-import           Control.Monad.Reader          (ReaderT)
 import           Control.Monad.Trans.Resource  (InternalState)
-import           Data.Aeson                    (encode)
-import qualified Data.ByteString          as BS
 import qualified Data.ByteString.Char8 as C8
-import           Data.Pool                     (Pool, createPool)
-import           Data.Int                      (Int64)
+import           Data.Pool                     (Pool)
 import           Data.IORef                    (newIORef)
 import           Data.Function                 (on)
 import           Data.List                     (sortBy)
-import           Data.Pool                     (withResource)
 import           Data.Text                     (Text)
-import           Database.Persist              (Key, PersistEntity,
-                                                PersistEntityBackend,
-                                                PersistStore, get, update,
-                                                (=.))
+import           Database.Persist             
 import qualified Database.Persist.Postgresql    as Pg
 import Database.Persist.Sql
 import           Database.Persist.TH           (mkPersist, mpsGeneric,
                                                 persistLowerCase, sqlSettings)
-import           Network                       (PortID (PortNumber))
-import           Network.HTTP.Types
-import           Network.Wai
 import qualified Network.Wai.Handler.Warp      as Warp
 import           System.Environment            (getArgs)
 import           System.IO.Unsafe              (unsafePerformIO)
 import qualified System.Random.MWC             as R
-import           Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
 import Text.Blaze.Html
 import           Yesod
-import           Data.Text.Read
 import Data.Maybe (fromJust)
 
 mkPersist sqlSettings { mpsGeneric = True } [persistLowerCase|
@@ -78,35 +63,17 @@ data App = App
     , appDbPool   :: !(Pool Pg.SqlBackend)
     }
 
--- | Not actually using the non-raw mongoDB.
--- persistent-mongoDB expects a field of '_id', not 'id'
--- mkYesod "App" [parseRoutes|
--- /json               JsonR     GET
-
--- /db                 DbR       GET
--- /dbs/#Int           DbsR      GET
--- !/dbs/#Text         DbsDefaultR  GET
-
--- /mongo/raw/db       MongoRawDbR  GET
--- /mongo/raw/dbs/#Int MongoRawDbsR GET
--- !/mongo/raw/dbs/#Text MongoRawDbsDefaultR GET
-
--- /updates/#Int       UpdatesR     GET
--- !/updates/#Text     UpdatesDefaultR GET
-
--- /fortunes           FortunesR    GET
-
--- /plaintext          PlaintextR   GET
--- |]
-
 
 mkYesod "App" [parseRoutes|
 /json               JsonR     GET
 /plaintext          PlaintextR   GET
 /db                 DbR          GET
+
 /queries/#Int       QueriesR     GET
 !/queries/#Text      DefaultQueriesR     GET
+
 /fortunes           FortunesR    GET
+
 /updates/#Int       UpdatesR     GET
 !/updates/#Text     DefaultUpdatesR GET
 |]
@@ -163,7 +130,7 @@ getQueriesR cnt = do
       | otherwise = cnt
 
 getDefaultQueriesR :: Text -> Handler Value
-getDefaultQueriesR txt = getQueriesR 1
+getDefaultQueriesR _ = getQueriesR 1
 
 getFortunesR :: Handler Html
 getFortunesR = do
@@ -206,169 +173,9 @@ getUpdatesR cnt = do
 getDefaultUpdatesR :: Text -> Handler Value
 getDefaultUpdatesR _ = getUpdatesR 1
 
--- Getmongorawdbr :: Handler Value
--- getMongoRawDbR = getDb rawMongoIntQuery
-
--- getDbsR :: Int -> Handler Value
--- getDbsR cnt = do
---     App {..} <- getYesod
---     multiRandomHandler randomNumber (intQuery runMySQL My.toSqlKey) cnt'
---   where
---     cnt' | cnt < 1 = 1
---          | cnt > 500 = 500
---          | otherwise = cnt
-
--- getDbsDefaultR :: Text -> Handler Value
--- getDbsDefaultR _ = getDbsR 1
-
--- getMongoRawDbsR :: Int -> Handler Value
--- getMongoRawDbsR cnt = multiRandomHandler randomNumber rawMongoIntQuery cnt'
---   where
---     cnt' | cnt < 1 = 1
---          | cnt > 500 = 500
---          | otherwise = cnt
-
--- getMongoRawDbsDefaultR :: Text -> Handler Value
--- getMongoRawDbsDefaultR _ = getMongoRawDbsR 1
-
--- getUpdatesR :: Int -> Handler Value
--- getUpdatesR cnt = multiRandomHandler randomPair go cnt'
---   where
---     cnt' | cnt < 1 = 1
---          | cnt > 500 = 500
---          | otherwise = cnt
---     go = uncurry (intUpdate runMySQL My.toSqlKey)
-
--- getUpdatesDefaultR :: Text -> Handler Value
--- getUpdatesDefaultR _ = getUpdatesR 1
-
--- randomNumber :: R.Gen (PrimState IO) -> IO Int64
--- randomNumber appGen = R.uniformR (1, 10000) appGen
-
--- randomPair :: R.Gen (PrimState IO) -> IO (Int64, Int64)
--- randomPair appGen = liftA2 (,) (randomNumber appGen) (randomNumber appGen)
-
--- getDb :: (Int64 -> Handler Value) -> Handler Value
--- getDb query = do
---     app <- getYesod
---     i <- liftIO (randomNumber (appGen app))
---     value <- query i
---     sendWaiResponse
---         $ responseBuilder
---             status200
---             [("Content-Type", simpleContentType typeJson)]
---         $ copyByteString
---         $ L.toSfortfortunestrict
---         $ encode value
-
-
--- runMongoDB :: Mongo.Action Handler b -> Handler b
--- runMongoDB f = do
---   App {..} <- getYesod
---   withResource mongoDBPool $ \pipe ->
---     Mongo.access pipe Mongo.ReadStaleOk "hello_world" f
-
--- runMySQL :: My.SqlPersistT Handler b -> Handler b
--- runMySQL f = do
---   App {..} <- getYesod
---   My.runSqlPool f mySqlPool
-
--- intQuery :: (MonadIO m, PersistEntity val, PersistStore backend
---             , backend ~ PersistEntityBackend val
---             ) =>
---            (ReaderT backend m (Maybe val) -> m (Maybe (WorldGeneric backend)))
---            -> (Int64 -> Key val)
---            -> Int64 -> m Value
--- intQuery db toKey i = do
---     Just x <- db $ get $ toKey i
---     return $ jsonResult (worldRandomNumber x)
---   where
---     jsonResult :: Int -> Value
---     jsonResult n = object ["id" .= i, "randomNumber" .= n]
-
--- rawMongoIntQuery :: Mongo.Val v => v -> Handler Value
--- rawMongoIntQuery i = do
---     Just x <- runMongoDB $ Mongo.findOne (Mongo.select ["id" =: i] "World")
---     return $ documentToJson x
-
--- intUpdate :: (Functor m, Monad m, MonadIO m
---              , PersistStore backend) =>
---              (ReaderT backend m (Maybe (WorldGeneric backend))
---                 -> m (Maybe (WorldGeneric backend)))
---              -> (Int64 -> Key (WorldGeneric backend))
---              -> Int64 -> Int64 -> m Value
--- intUpdate db toKey i v = do
---     Just x <- db $ get k
---     _ <- db $ fmap (const Nothing) $
---              update k [WorldRandomNumber =. fromIntegral v]
---     return $ object ["id" .= i, "randomNumber" .= v]
---   where
---     k = toKey i
-
--- multiRandomHandler :: ToJSON a
---                    => (R.Gen (PrimState IO) -> IO b)
---                    -> (b -> Handler a)
---                    -> Int
---                    -> Handler Value
--- multiRandomHandler rand operation cnt = do
---     App {..} <- getYesod
---     nums <- liftIO $ replicateM cnt (rand appGen)
---     return . array =<< mapM operation nums
-
--- documentToJson :: [Field] -> Value
--- documentToJson = object . map toAssoc
---   where
---     toAssoc :: Field -> (Text, Value)
---     toAssoc ("_id" := v) = ("id", toJSON v)
---     toAssoc (l := v) = (l, toJSON v)
-
--- instance ToJSON Mongo.Value where
---   toJSON (Mongo.Int32 i)  = toJSON i
---   toJSON (Mongo.Int64 i)  = toJSON i
---   toJSON (Mongo.Float f)  = toJSON f
---   toJSON (Mongo.Doc d)   = documentToJson d
---   toJSON s = error $ "no convert for: " ++ show s
-
--- getFortunesR :: Handler ()
--- getFortunesR = do
---     es <- runMySQL $ My.selectList [] []
---     sendWaiResponse
---         $ responseBuilder status200 [("Content-type", typeHtml)]
---         $ fortuneTemplate (messages es)
---   where
---     messages es = sortBy (compare `on` snd)
---         ((0, "Additional fortune added at request time.") : map stripEntity es)
---     stripEntity e =
---         (My.fromSqlKey (My.entityKey e), fortuneMessage . My.entityVal $ e)
-
 getPlaintextR :: Handler Text
 getPlaintextR = return "Hello, World!"
 
--- sendWaiResponse
---   $ responseBuilder
---   status200
---   [("Content-Type", simpleContentType typePlain)]
---   $ copyByteString 
-
--- fortuneTemplate :: [(Int64, Text)] -> Builder
--- fortuneTemplate messages = renderHtmlBuilder $ [shamlet|
--- $doctype 5
--- <html>
---     <head>
---         <title>Fortunes
---     <body>
---         <table>
---             <tr>
---                 <th>id
---                 <th>message
---             $forall message <- messages
---                 <tr>
---                     <td>#{fst message}
---                     <td>#{snd message}
--- |]
-
-
-
 main :: IO ()
 main = R.withSystemRandom $ \gen -> do
     [cores, host] <- getArgs