quotes-api/app/Main.hs

74 lines
1.9 KiB
Haskell
Raw Normal View History

2023-02-03 22:40:28 +00:00
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-}
2023-02-27 18:16:29 +00:00
{-# LANGUAGE TypeOperators #-}
2023-02-03 13:45:16 +00:00
module Main where
2023-03-05 11:16:56 +00:00
import Database.SQLite.Simple hiding ((:.))
2023-02-03 22:40:28 +00:00
import Database.SQLite.Simple.QQ
import Network.Wai.Handler.Warp
import Data.Proxy
import Servant
import Control.Monad.IO.Class
2023-03-05 09:38:02 +00:00
import Servant.HTML.Blaze
2023-03-05 11:16:56 +00:00
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.ByteString.Lazy (fromStrict)
2023-02-03 22:40:28 +00:00
2023-02-27 18:16:29 +00:00
import Api.Types
import qualified Parsers.KOReader as KO
import qualified Parsers.Readwise as RW
2023-03-05 09:38:02 +00:00
import Config
import Options.Applicative
2023-04-13 21:43:39 +00:00
import Database
2023-02-03 13:45:16 +00:00
2023-03-05 09:38:02 +00:00
type API = Get '[HTML] Quote
:<|> "quotes" :> Get '[JSON] [Quote]
2023-02-27 18:16:29 +00:00
:<|> "quote" :> "random" :> Get '[JSON] Quote
2023-03-05 09:38:02 +00:00
:<|> "today" :> Get '[HTML] Quote
2023-04-13 21:46:43 +00:00
2023-03-05 11:16:56 +00:00
2023-02-03 22:40:28 +00:00
api :: Proxy API
api = Proxy
2023-11-09 21:29:32 +00:00
2023-02-27 18:16:29 +00:00
-- | TODO: readerT
2023-02-03 22:40:28 +00:00
server :: FilePath -> Server API
2023-04-11 09:02:42 +00:00
server dbf = randomQuote dbf
:<|> listQuotes dbf
:<|> randomQuote dbf
:<|> randomQuote dbf
2023-03-05 11:16:56 +00:00
2023-02-27 18:16:29 +00:00
-- | API begins here
randomQuote :: FilePath -> Handler Quote
randomQuote db = do
2023-03-05 11:16:56 +00:00
qts <- liftIO $ withConnection db $ \c -> query_ c qry
case length qts of
2023-02-27 18:16:29 +00:00
0 -> undefined
_ -> pure (head qts)
where
qry = [sql|SELECT * FROM quotes ORDER BY RANDOM();|]
2023-02-03 22:40:28 +00:00
listQuotes :: FilePath -> Handler [Quote]
listQuotes db = liftIO $ withConnection db $ \conn -> query_ conn [sql|SELECT * FROM quotes;|]
2023-02-27 18:16:29 +00:00
addKoReader :: FilePath -> KO.KoHighlight -> Handler NoContent
addKoReader db hl = do
2023-04-13 21:43:39 +00:00
liftIO $ insertQts db (KO.parse hl)
2023-02-27 18:16:29 +00:00
pure NoContent
addReadwise :: FilePath -> T.Text -> Handler NoContent
addReadwise db hl = do
let
qts = RW.parse (fromStrict $ encodeUtf8 hl)
liftIO $ print $ show qts
pure NoContent
2023-03-05 09:38:02 +00:00
runApp :: AppConfig -> IO ()
runApp c = run (appPort c) (serve api $ server (appDbFile c))
2023-03-05 09:38:02 +00:00
main :: IO ()
main = do
conf <- execParser parserOpts
putStrLn $ "running with conf" <> show conf
initDb (appDbFile conf)
runApp conf