about summary refs log tree commit diff
path: root/website/sandbox/shift-time/Main.hs
diff options
context:
space:
mode:
authorWilliam Carroll <wpcarro@gmail.com>2020-08-13T19·53+0100
committerWilliam Carroll <wpcarro@gmail.com>2020-08-20T10·26+0100
commit5fd79ce0ffd27f860d754edf398895c1f84a8e0b (patch)
treef263c22cfe5d0870c8edebcf28b6c32efa25cc31 /website/sandbox/shift-time/Main.hs
parent81aa32fe71a0b8a822673b36a2ded9a427855286 (diff)
Support parsing second shifts
Parse inputs like -10s into 10 second shifts back in time.
Diffstat (limited to 'website/sandbox/shift-time/Main.hs')
-rw-r--r--website/sandbox/shift-time/Main.hs69
1 files changed, 69 insertions, 0 deletions
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!"