Support parsing second shifts

Parse inputs like -10s into 10 second shifts back in time.
This commit is contained in:
William Carroll 2020-08-13 20:53:11 +01:00
parent 81aa32fe71
commit 5fd79ce0ff
5 changed files with 125 additions and 0 deletions

View file

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

View 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!"

View 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 })

View 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
];
}

View file

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