Support parsing second shifts
Parse inputs like -10s into 10 second shifts back in time.
This commit is contained in:
parent
81aa32fe71
commit
5fd79ce0ff
5 changed files with 125 additions and 0 deletions
3
website/sandbox/shift-time/.ghci
Normal file
3
website/sandbox/shift-time/.ghci
Normal file
|
@ -0,0 +1,3 @@
|
|||
:set prompt "> "
|
||||
:set -Wall
|
||||
:set -XOverloadedStrings
|
69
website/sandbox/shift-time/Main.hs
Normal file
69
website/sandbox/shift-time/Main.hs
Normal file
|
@ -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!"
|
17
website/sandbox/shift-time/Spec.hs
Normal file
17
website/sandbox/shift-time/Spec.hs
Normal file
|
@ -0,0 +1,17 @@
|
|||
--------------------------------------------------------------------------------
|
||||
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 })
|
28
website/sandbox/shift-time/default.nix
Normal file
28
website/sandbox/shift-time/default.nix
Normal file
|
@ -0,0 +1,28 @@
|
|||
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
|
||||
];
|
||||
}
|
8
website/sandbox/shift-time/shell.nix
Normal file
8
website/sandbox/shift-time/shell.nix
Normal file
|
@ -0,0 +1,8 @@
|
|||
let
|
||||
briefcase = import /home/wpcarro/briefcase {};
|
||||
in briefcase.buildHaskell.shell {
|
||||
deps = hpkgs: with hpkgs; [
|
||||
hspec
|
||||
rio
|
||||
];
|
||||
}
|
Loading…
Reference in a new issue