Simplify code

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/

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]
+parseRange :: (String, String) -> Constraint -> Maybe Field
-splitRange text = take 2 $ wordsWhen (== '/') text ++ ["", ""]
+parseRange (intervalText, stepText) constraint = do
+  (from, to) <- parseRangeInterval intervalText constraint
+  step <- parseRangeStep stepText
+  return (Range from to step)
 
-isNumber :: String -> Bool
+parseRangeInterval :: String -> Constraint -> Maybe (Int, Int)
-isNumber ""   = False
+parseRangeInterval "*" (Constraint lo up) = Just (lo, up)
-isNumber text = all isDigit text
+parseRangeInterval text constraint = do
-
+  (from, to) <- tbind (parsedFrom, parsedTo)
-parseRange :: [String] -> Constraint -> Maybe Field
+  if validToConstraint (from, to)
-parseRange [interval, step] constraint = do
+    then return (from, to)
-  (from, to) <- parseInterval interval constraint
+    else Nothing
-  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
   where
-    pieces = take 2 $ wordsWhen (== '-') text ++ ["", ""]
+    (textFrom, textTo) = splitIntoTwoWords (== '-') text
-    isNumbers = all isNumber pieces
+    (parsedFrom, parsedTo) = (readMaybe textFrom, readMaybe textTo)
-    [start, end] = map read pieces
+    validToConstraint (start, end) =
-    isValid = isNumbers && start <= end && (start, end) `inside` constraint
+      start <= end && (start, end) `inside` constraint
 
-parseStep :: String -> Maybe Int
+parseRangeStep :: String -> Maybe Int
-parseStep "" = Just 1
+parseRangeStep ""   = Just 1
-parseStep text
+parseRangeStep text = readMaybe text
-  | isNumber text = Just (read text)
-parseStep _ = Nothing
 
 parseSequence :: String -> Constraint -> Maybe Field
-parseSequence text constraint
+parseSequence text constraint = do
-  | isValid = Just (Sequence numbers)
+  numbers <- sequence $ map readMaybe $ wordsWhen (== ',') text
-  | otherwise = Nothing
+  if validToConstraint numbers
+    then return $ Sequence numbers
+    else Nothing
   where
-    pieces = wordsWhen (== ',') text
+    validToConstraint = all (`inRange` constraint)
-    isNumbers = all isNumber pieces
-    numbers = map read pieces
-    allInRange = all (`inRange` constraint) numbers
-    isValid = not (null pieces) && isNumbers && allInRange
 
 matchField :: Field -> Int -> Bool
 matchField (Range f t s) n = n >= f && n <= t && n `mod` s == 0

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

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

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")