about summary refs log tree commit diff
path: root/website/sandbox/shift-time/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'website/sandbox/shift-time/Main.hs')
-rw-r--r--website/sandbox/shift-time/Main.hs140
1 files changed, 0 insertions, 140 deletions
diff --git a/website/sandbox/shift-time/Main.hs b/website/sandbox/shift-time/Main.hs
deleted file mode 100644
index f33ac54a115a..000000000000
--- a/website/sandbox/shift-time/Main.hs
+++ /dev/null
@@ -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