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!

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
   ];
 }