From 5fd79ce0ffd27f860d754edf398895c1f84a8e0b Mon Sep 17 00:00:00 2001
From: William Carroll <wpcarro@gmail.com>
Date: Thu, 13 Aug 2020 20:53:11 +0100
Subject: Support parsing second shifts

Parse inputs like -10s into 10 second shifts back in time.
---
 website/sandbox/shift-time/Main.hs | 69 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 69 insertions(+)
 create mode 100644 website/sandbox/shift-time/Main.hs

(limited to 'website/sandbox/shift-time/Main.hs')

diff --git a/website/sandbox/shift-time/Main.hs b/website/sandbox/shift-time/Main.hs
new file mode 100644
index 000000000000..80663d797be7
--- /dev/null
+++ b/website/sandbox/shift-time/Main.hs
@@ -0,0 +1,69 @@
+--------------------------------------------------------------------------------
+module Main where
+--------------------------------------------------------------------------------
+import RIO
+import RIO.Text
+import Prelude (putStrLn, read)
+import Text.ParserCombinators.ReadP
+
+import qualified Data.Time.Clock as Clock
+--------------------------------------------------------------------------------
+
+-- type Api = "run"
+--            :> ReqBody '[JSON] Request
+--            :> Post '[JSON] Response
+
+data ShiftTimeRequest = ShiftTimeRequest
+  { shiftSeconds :: Int
+  , shiftMinutes :: Int
+  , shiftHours :: Int
+  , shiftDays :: Int
+  , shiftWeeks :: Int
+  , shiftMonths :: Int
+  , shiftQuarters :: Int
+  , shiftYears :: Int
+  } deriving (Eq, Show)
+
+defaultShiftTimeRequest :: ShiftTimeRequest
+defaultShiftTimeRequest = ShiftTimeRequest
+  { shiftSeconds = 0
+  , shiftMinutes = 0
+  , shiftHours = 0
+  , shiftDays = 0
+  , shiftWeeks = 0
+  , shiftMonths = 0
+  , shiftQuarters = 0
+  , shiftYears = 0
+  }
+
+-- shiftTime :: Maybe Request -> IO Clock.UTCTime
+-- shiftTime = Clock.getCurrentTime
+
+data Unit = Second
+
+digit :: ReadP Char
+digit =
+  satisfy (\c -> c >= '0' && c <= '9')
+
+unit :: ReadP Unit
+unit = do
+  _ <- char 's'
+  pure Second
+
+request :: ReadP ShiftTimeRequest
+request = do
+  negative <- option Nothing $ fmap Just (satisfy (== '-'))
+  n <- read <$> many1 digit
+  _ <- unit
+  case negative of
+    Nothing -> pure $ defaultShiftTimeRequest { shiftSeconds = n }
+    Just _  -> pure $ defaultShiftTimeRequest { shiftSeconds = -1 * n }
+
+parseTime :: Text -> Maybe ShiftTimeRequest
+parseTime x =
+  case readP_to_S request (unpack x) of
+    [(res, "")] -> Just res
+    _ -> Nothing
+
+main :: IO ()
+main = putStrLn "Working!"
-- 
cgit 1.4.1