diff --git a/Makefile b/Makefile index e9f81e9..a37dcf6 100644 --- a/Makefile +++ b/Makefile @@ -37,6 +37,11 @@ test: mkdir -p .stack-work ${stack} stack test +.PHONY: test-with-coverage +test-with-coverage: + mkdir -p .stack-work + ${stack} stack test --coverage + .PHONY: format format: ${hfmt} -w app/ src/ test/ diff --git a/src/Field.hs b/src/Field.hs index c895ee9..e70ee4e 100644 --- a/src/Field.hs +++ b/src/Field.hs @@ -3,9 +3,9 @@ module Field ) where import Constraint -import Data.Char (isDigit) import Data.Maybe import Helper +import Text.Read (readMaybe) data Field = Range Int Int Int @@ -18,50 +18,40 @@ parseField text constraint | isJust valueRange = valueRange | otherwise = Nothing where - valueRange = parseRange (splitRange text) constraint + valueRange = parseRange (splitIntoTwoWords (== '/') text) constraint valueSequence = parseSequence text constraint -splitRange :: String -> [String] -splitRange text = take 2 $ wordsWhen (== '/') text ++ ["", ""] +parseRange :: (String, String) -> Constraint -> Maybe Field +parseRange (intervalText, stepText) constraint = do + (from, to) <- parseRangeInterval intervalText constraint + step <- parseRangeStep stepText + return (Range from to step) -isNumber :: String -> Bool -isNumber "" = False -isNumber text = all isDigit text - -parseRange :: [String] -> Constraint -> Maybe Field -parseRange [interval, step] constraint = do - (from, to) <- parseInterval interval constraint - step' <- parseStep step - return (Range from to step') -parseRange _ _ = Nothing - -parseInterval :: String -> Constraint -> Maybe (Int, Int) -parseInterval "*" (Constraint lo up) = Just (lo, up) -parseInterval text constraint - | isValid = Just (start, end) - | otherwise = Nothing +parseRangeInterval :: String -> Constraint -> Maybe (Int, Int) +parseRangeInterval "*" (Constraint lo up) = Just (lo, up) +parseRangeInterval text constraint = do + (from, to) <- tbind (parsedFrom, parsedTo) + if validToConstraint (from, to) + then return (from, to) + else Nothing where - pieces = take 2 $ wordsWhen (== '-') text ++ ["", ""] - isNumbers = all isNumber pieces - [start, end] = map read pieces - isValid = isNumbers && start <= end && (start, end) `inside` constraint + (textFrom, textTo) = splitIntoTwoWords (== '-') text + (parsedFrom, parsedTo) = (readMaybe textFrom, readMaybe textTo) + validToConstraint (start, end) = + start <= end && (start, end) `inside` constraint -parseStep :: String -> Maybe Int -parseStep "" = Just 1 -parseStep text - | isNumber text = Just (read text) -parseStep _ = Nothing +parseRangeStep :: String -> Maybe Int +parseRangeStep "" = Just 1 +parseRangeStep text = readMaybe text parseSequence :: String -> Constraint -> Maybe Field -parseSequence text constraint - | isValid = Just (Sequence numbers) - | otherwise = Nothing +parseSequence text constraint = do + numbers <- sequence $ map readMaybe $ wordsWhen (== ',') text + if validToConstraint numbers + then return $ Sequence numbers + else Nothing where - pieces = wordsWhen (== ',') text - isNumbers = all isNumber pieces - numbers = map read pieces - allInRange = all (`inRange` constraint) numbers - isValid = not (null pieces) && isNumbers && allInRange + validToConstraint = all (`inRange` constraint) matchField :: Field -> Int -> Bool matchField (Range f t s) n = n >= f && n <= t && n `mod` s == 0 diff --git a/src/Helper.hs b/src/Helper.hs index b3869c1..3cc949a 100644 --- a/src/Helper.hs +++ b/src/Helper.hs @@ -1,5 +1,7 @@ module Helper ( wordsWhen + , splitIntoTwoWords + , tbind ) where wordsWhen :: (Char -> Bool) -> String -> [String] @@ -8,3 +10,12 @@ wordsWhen p s = "" -> [] s' -> w : wordsWhen p s'' where (w, s'') = break p s' + +splitIntoTwoWords :: (Char -> Bool) -> String -> (String, String) +splitIntoTwoWords splitFunc text = + let (x:y:_) = take 2 $ wordsWhen splitFunc text ++ ["", ""] + in (x, y) + +tbind :: (Maybe a, Maybe b) -> Maybe (a, b) +tbind (Just x, Just y) = Just (x, y) +tbind _ = Nothing diff --git a/src/Pattern.hs b/src/Pattern.hs index f17a6fb..0dbac88 100644 --- a/src/Pattern.hs +++ b/src/Pattern.hs @@ -57,4 +57,4 @@ check ptn date = all isRight pairs , (cmonth ptn, month date) , (cweek ptn, weekdayNumber $ dateWeekDay date) ] - isRight (p, value) = matchField p value + isRight (patternField, value) = matchField patternField value diff --git a/test/HelperSpec.hs b/test/HelperSpec.hs index 826229c..e2eb1af 100644 --- a/test/HelperSpec.hs +++ b/test/HelperSpec.hs @@ -10,7 +10,7 @@ main :: IO () main = hspec spec spec :: Spec -spec = +spec = do describe "Splitting" $ do it "can process empty string" $ wordsWhen (== '-') "" `shouldBe` [] it "can process only one word" $ wordsWhen (== '-') "10" `shouldBe` ["10"] @@ -18,3 +18,9 @@ spec = wordsWhen (== '-') "10-20" `shouldBe` ["10", "20"] it "can be separated by ','" $ wordsWhen (== ',') "10,20,30" `shouldBe` ["10", "20", "30"] + -- Test splitIntoTwoWords + describe "Splitting into two words" $ do + it "can process empty string" $ + splitIntoTwoWords (== '-') "" `shouldBe` ("", "") + it "can process normal string" $ + splitIntoTwoWords (== '-') "1-2" `shouldBe` ("1", "2")