diff options
-rw-r--r-- | zoo/.ghci (renamed from website/sandbox/shift-time/.ghci) | 1 | ||||
-rw-r--r-- | zoo/Main.hs (renamed from website/sandbox/shift-time/Main.hs) | 34 | ||||
-rw-r--r-- | zoo/Spec.hs (renamed from website/sandbox/shift-time/Spec.hs) | 0 | ||||
-rw-r--r-- | zoo/default.nix (renamed from website/sandbox/shift-time/default.nix) | 17 | ||||
-rw-r--r-- | zoo/shell.nix (renamed from website/sandbox/shift-time/shell.nix) | 1 |
5 files changed, 30 insertions, 23 deletions
diff --git a/website/sandbox/shift-time/.ghci b/zoo/.ghci index 19a1e8f5ec3f..fcae90c2987d 100644 --- a/website/sandbox/shift-time/.ghci +++ b/zoo/.ghci @@ -2,3 +2,4 @@ :set -Wall :set -XOverloadedStrings :set -XRecordWildCards +:set -XTypeApplications diff --git a/website/sandbox/shift-time/Main.hs b/zoo/Main.hs index f33ac54a115a..cb9f5fbf4e9d 100644 --- a/website/sandbox/shift-time/Main.hs +++ b/zoo/Main.hs @@ -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 diff --git a/website/sandbox/shift-time/Spec.hs b/zoo/Spec.hs index ba3f71d7c754..ba3f71d7c754 100644 --- a/website/sandbox/shift-time/Spec.hs +++ b/zoo/Spec.hs diff --git a/website/sandbox/shift-time/default.nix b/zoo/default.nix index 356c250c7134..35de24d9c2cc 100644 --- a/website/sandbox/shift-time/default.nix +++ b/zoo/default.nix @@ -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 ]; } diff --git a/website/sandbox/shift-time/shell.nix b/zoo/shell.nix index dab0be4ba267..465f0b05c1ba 100644 --- a/website/sandbox/shift-time/shell.nix +++ b/zoo/shell.nix @@ -5,5 +5,6 @@ in briefcase.buildHaskell.shell { hspec rio string-conversions + servant-server ]; } |