Move shift-time into top-level //zoo

I'm still unsure whether or not this is a good idea, but experimenting is a good
way to find out!
This commit is contained in:
William Carroll 2020-08-13 22:22:39 +01:00
parent 3fdfa14355
commit f895cb417a
5 changed files with 30 additions and 23 deletions

View file

@ -2,3 +2,4 @@
:set -Wall
:set -XOverloadedStrings
:set -XRecordWildCards
:set -XTypeApplications

View file

@ -1,16 +1,35 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
--------------------------------------------------------------------------------
module Main where
--------------------------------------------------------------------------------
import RIO
import RIO hiding (Handler)
import RIO.Text
import RIO.Time
import Data.String.Conversions (cs)
import Servant
import Data.Time.Clock.POSIX
import Prelude (putStrLn, putStr, print, getLine, read)
import Prelude (read)
import Text.ParserCombinators.ReadP
import qualified Network.Wai.Handler.Warp as Warp
--------------------------------------------------------------------------------
type Api = "run"
:> QueryParam' '[Required] "offset" Text
:> Get '[JSON] UTCTime
server :: Server Api
server = compute
where
compute :: Text -> Handler UTCTime
compute x = do
case parseInput x of
Nothing -> throwError err401
Just req -> do
res <- liftIO $ shiftTime req
pure res
data ShiftTimeRequest = ShiftTimeRequest
{ shiftSeconds :: Int
, shiftMinutes :: Int
@ -130,11 +149,4 @@ parseInput x =
_ -> Nothing
main :: IO ()
main = do
putStr "Enter an offset (e.g. -10d-30s): "
x <- getLine
case parseInput (cs x) of
Nothing -> putStrLn "Try again!" >> main
Just req -> do
t <- shiftTime req
putStrLn $ show t
main = Warp.run 8000 $ serve (Proxy @ Api) server

View file

@ -1,10 +1,10 @@
let
briefcase = import /home/wpcarro/briefcase {};
in briefcase.buildHaskell.program {
name = "shift-time";
{ briefcase, ... }:
briefcase.buildHaskell.program {
name = "zoo";
srcs = builtins.path {
path = ./.;
name = "shift-time-src";
name = "zoo-src";
};
ghcExtensions = [
"OverloadedStrings"
@ -15,14 +15,7 @@ in briefcase.buildHaskell.program {
deps = hpkgs: with hpkgs; [
servant-server
aeson
wai-cors
warp
jwt
unordered-containers
base64
http-conduit
rio
envy
req
];
}

View file

@ -5,5 +5,6 @@ in briefcase.buildHaskell.shell {
hspec
rio
string-conversions
servant-server
];
}