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!

website/sandbox/shift-time/.ghci

@@ -1,4 +0,0 @@
-:set prompt "> "
-:set -Wall
-:set -XOverloadedStrings
-:set -XRecordWildCards

website/sandbox/shift-time/Main.hs

@@ -1,140 +0,0 @@
-{-# LANGUAGE DeriveAnyClass #-}
---------------------------------------------------------------------------------
-module Main where
---------------------------------------------------------------------------------
-import RIO
-import RIO.Text
-import RIO.Time
-import Data.String.Conversions (cs)
-import Data.Time.Clock.POSIX
-import Prelude (putStrLn, putStr, print, getLine, read)
-import Text.ParserCombinators.ReadP
---------------------------------------------------------------------------------
-
-data ShiftTimeRequest = ShiftTimeRequest
-  { shiftSeconds :: Int
-  , shiftMinutes :: Int
-  , shiftHours :: Int
-  , shiftDays :: Int
-  , shiftWeeks :: Int
-  , shiftMonths :: Int
-  , shiftQuarters :: Int
-  , shiftYears :: Int
-  } deriving (Eq, Show)
-
-instance Semigroup ShiftTimeRequest where
-  (ShiftTimeRequest as am ah ad aw amonths aq ay) <> (ShiftTimeRequest bs bm bh bd bw bmonths bq by) =
-    ShiftTimeRequest
-    { shiftSeconds = as + bs
-    , shiftMinutes = am + bm
-    , shiftHours = ah + bh
-    , shiftDays = ad + bd
-    , shiftWeeks = aw + bw
-    , shiftMonths = amonths + bmonths
-    , shiftQuarters = aq + bq
-    , shiftYears = ay + by
-    }
-
-instance Monoid ShiftTimeRequest where
-  mempty = defaultShiftTimeRequest
-
-defaultShiftTimeRequest :: ShiftTimeRequest
-defaultShiftTimeRequest = ShiftTimeRequest
-  { shiftSeconds = 0
-  , shiftMinutes = 0
-  , shiftHours = 0
-  , shiftDays = 0
-  , shiftWeeks = 0
-  , shiftMonths = 0
-  , shiftQuarters = 0
-  , shiftYears = 0
-  }
-
--- This basically broken because it doesn't account for:
--- Exhales... time stuff
---   - Leap seconds, leap days, leap years...
---   - Months like February having 28 days and others having 31
---   - other things that I'm probably not considering
-toSeconds :: ShiftTimeRequest -> NominalDiffTime
-toSeconds ShiftTimeRequest{..} = do
-  let minutes = 60
-      hours = minutes * 60
-      days = hours * 24
-      weeks = days * 7
-      months = weeks * 4
-      quarters = months * 3
-      years = days * 365
-  fromIntegral $ shiftSeconds +
-    shiftMinutes * minutes +
-    shiftHours * hours +
-    shiftDays * days +
-    shiftWeeks * weeks +
-    shiftMonths * months +
-    shiftQuarters * quarters +
-    shiftYears * years
-
-shiftTime :: ShiftTimeRequest -> IO UTCTime
-shiftTime req = do
-  t <- getPOSIXTime
-  let t' = t + toSeconds req
-  pure $ posixSecondsToUTCTime t'
-
-data Unit = Second
-          | Minute
-          | Hour
-          | Day
-          | Week
-          | Month
-          | Quarter
-          | Year
-  deriving (Eq, Show)
-
-digit :: ReadP Char
-digit =
-  satisfy (\c -> c >= '0' && c <= '9')
-
-unit :: ReadP Unit
-unit = do
-  c <- get
-  case c of
-    's' -> pure Second
-    'm' -> pure Minute
-    'h' -> pure Hour
-    'd' -> pure Day
-    'w' -> pure Week
-    'M' -> pure Month
-    'q' -> pure Quarter
-    'y' -> pure Year
-    _ -> fail $ "We don't support this unit: " ++ show c
-
-request :: ReadP ShiftTimeRequest
-request = do
-  negative <- option Nothing $ fmap Just (satisfy (== '-'))
-  n <- read <$> many1 digit
-  u <- unit
-  let amt = if isJust negative then -1 * n else n
-  case u of
-    Second  -> pure $ defaultShiftTimeRequest { shiftSeconds = amt }
-    Minute  -> pure $ defaultShiftTimeRequest { shiftMinutes = amt }
-    Hour    -> pure $ defaultShiftTimeRequest { shiftHours = amt }
-    Day     -> pure $ defaultShiftTimeRequest { shiftDays = amt }
-    Week    -> pure $ defaultShiftTimeRequest { shiftWeeks = amt }
-    Month   -> pure $ defaultShiftTimeRequest { shiftMonths = amt }
-    Quarter -> pure $ defaultShiftTimeRequest { shiftQuarters = amt }
-    Year    -> pure $ defaultShiftTimeRequest { shiftYears = amt }
-
-parseInput :: Text -> Maybe ShiftTimeRequest
-parseInput x =
-  case readP_to_S (manyTill request eof) (unpack x) of
-    [(xs, "")] -> Just $ mconcat xs
-    _ -> 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

website/sandbox/shift-time/Spec.hs

@@ -1,54 +0,0 @@
---------------------------------------------------------------------------------
-module Spec where
---------------------------------------------------------------------------------
-import RIO
-import Test.Hspec
-import Test.QuickCheck
-import Main hiding (main)
-
-import qualified RIO.Text as Text
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = hspec $ do
-  describe "Main" $ do
-    it "handles seconds" $ do
-      property $ \x -> parseTime (Text.concat [x & show & Text.pack, "s"]) ==
-        (Just defaultShiftTimeRequest { shiftSeconds = x })
-
-    it "handles minutes" $ do
-      property $ \x -> parseTime (Text.concat [x & show & Text.pack, "m"]) ==
-        (Just defaultShiftTimeRequest { shiftMinutes = x })
-
-    it "handles hours" $ do
-      property $ \x -> parseTime (Text.concat [x & show & Text.pack, "h"]) ==
-        (Just defaultShiftTimeRequest { shiftHours = x })
-
-    it "handles days" $ do
-      property $ \x -> parseTime (Text.concat [x & show & Text.pack, "d"]) ==
-        (Just defaultShiftTimeRequest { shiftDays = x })
-
-    it "handles weeks" $ do
-      property $ \x -> parseTime (Text.concat [x & show & Text.pack, "w"]) ==
-        (Just defaultShiftTimeRequest { shiftWeeks = x })
-
-    it "handles months" $ do
-      property $ \x -> parseTime (Text.concat [x & show & Text.pack, "M"]) ==
-        (Just defaultShiftTimeRequest { shiftMonths = x })
-
-    it "handles quarters" $ do
-      property $ \x -> parseTime (Text.concat [x & show & Text.pack, "q"]) ==
-        (Just defaultShiftTimeRequest { shiftQuarters = x })
-
-    it "handles multiple shifts" $ do
-      parseTime "1s-20m5h0d-4w100M-3y2q" ==
-        (Just $ ShiftTimeRequest
-          { shiftSeconds = 1
-          , shiftMinutes = -20
-          , shiftHours = 5
-          , shiftDays = 0
-          , shiftWeeks = -4
-          , shiftMonths = 100
-          , shiftQuarters = 2
-          , shiftYears = -3
-          })

website/sandbox/shift-time/default.nix

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

website/sandbox/shift-time/shell.nix

@@ -1,9 +0,0 @@
-let
-  briefcase = import /home/wpcarro/briefcase {};
-in briefcase.buildHaskell.shell {
-  deps = hpkgs: with hpkgs; [
-    hspec
-    rio
-    string-conversions
-  ];
-}