Format source code

app/Main.hs

@@ -1,26 +1,27 @@
 module Main where
 
-import System.Environment (getArgs)
+import           System.Environment (getArgs)
-import Text.Parsec.Error (ParseError)
+import           System.Exit
-import System.Exit
+import           Text.Parsec.Error  (ParseError)
 
-import Pattern
+import           Data.Dates
-import Data.Dates
+import           Pattern
 
 main :: IO ()
 main = do
   args <- getArgs
   dt <- getCurrentDateTime
-  exitWith $ case processArgs args dt of
+  exitWith $
-    Just True -> ExitSuccess
+    case processArgs args dt of
-    Just False -> ExitFailure 1
+      Just True  -> ExitSuccess
-    Nothing -> ExitFailure 2
+      Just False -> ExitFailure 1
+      Nothing    -> ExitFailure 2
 
 processArgs :: [String] -> DateTime -> Maybe Bool
-processArgs [ptn] dt = safeMatch ptn dt
+processArgs [ptn] dt       = safeMatch ptn dt
 processArgs [ptn, time] dt = matchGivenTime ptn (parseDate dt time)
-processArgs _ _ = Nothing
+processArgs _ _            = Nothing
 
 matchGivenTime :: String -> Either ParseError DateTime -> Maybe Bool
-matchGivenTime _ (Left _) = Nothing
+matchGivenTime _ (Left _)     = Nothing
 matchGivenTime ptn (Right dt) = safeMatch ptn dt

src/Constraint.hs

@@ -1,9 +1,9 @@
 module Constraint where
 
-data Constraint = Constraint {
+data Constraint = Constraint
-  lower :: Int,
+  { lower :: Int
-  upper :: Int
+  , upper :: Int
-} deriving (Show, Eq)
+  } deriving (Show, Eq)
 
 makeRangeFromNumber :: Int -> Constraint
 makeRangeFromNumber x = Constraint x x

src/Field.hs

@@ -1,18 +1,25 @@
 module Field where
 
-import Data.Char (isDigit)
+import           Constraint
-import Data.Maybe
+import           Data.Char  (isDigit)
+import           Data.Maybe
+import           Helper
 
-import Constraint
+data Range
-import Helper
+  = All
-
+  | Range Int
-data Range = All | Range Int Int | Sequence [Int]
+          Int
+  | Sequence [Int]
   deriving (Eq, Show)
 
-data Step = Every | Step Int
+data Step
+  = Every
+  | Step Int
   deriving (Eq, Show)
 
-data Field = Field Range Step
+data Field =
+  Field Range
+        Step
   deriving (Eq, Show)
 
 parseField :: String -> Constraint -> Maybe Field
@@ -64,7 +71,9 @@ parseRange text constraint
     isAllNumbers = all isNumber pieces
     start = read (head pieces) :: Int
     end = read (pieces !! 1) :: Int
-    isValid = isTwo && isAllNumbers && start <= start && (start, end) `inside` constraint
+    isValid =
+      isTwo &&
+      isAllNumbers && start <= start && (start, end) `inside` constraint
 
 parseSequence :: String -> Constraint -> Maybe [Int]
 parseSequence text constraint
@@ -79,17 +88,19 @@ parseSequence text constraint
 
 parseFieldStep :: String -> Maybe Step
 parseFieldStep "" = Just Every
-parseFieldStep text | isNumber text = Just (Step (read text))
+parseFieldStep text
+  | isNumber text = Just (Step (read text))
 parseFieldStep _ = Nothing
 
 matchField :: Field -> Int -> Bool
-matchField (Field range step) n = matchFieldRange range n && matchFieldStep step n
+matchField (Field range step) n =
+  matchFieldRange range n && matchFieldStep step n
 
 matchFieldRange :: Range -> Int -> Bool
-matchFieldRange All _ = True
+matchFieldRange All _           = True
-matchFieldRange (Range x y) n = n >= x && n <= y
+matchFieldRange (Range x y) n   = n >= x && n <= y
 matchFieldRange (Sequence xs) n = n `elem` xs
 
 matchFieldStep :: Step -> Int -> Bool
-matchFieldStep Every _ = True
+matchFieldStep Every _    = True
 matchFieldStep (Step x) n = n `mod` x == 0

src/Pattern.hs

@@ -1,53 +1,55 @@
 module Pattern
-    ( Pattern(..),
+  ( Pattern(..)
-      match,
+  , match
-      safeMatch,
+  , safeMatch
-      parse,
+  , parse
-      check,
+  , check
-      createParts,
+  , createParts
-      parseField
+  , parseField
-    ) where
+  ) where
 
-import Data.Dates
+import           Constraint
-import Data.Maybe
+import           Data.Dates
+import           Data.Maybe
+import           Field
 
-import Field
+data Pattern = Pattern
-import Constraint
+  { cminute :: Field
-
+  , chour   :: Field
-data Pattern = Pattern {
+  , cday    :: Field
-    cminute :: Field,
+  , cmonth  :: Field
-    chour :: Field,
+  , cweek   :: Field
-    cday :: Field,
+  , cyear   :: Field
-    cmonth :: Field,
+  }
-    cweek :: Field,
-    cyear :: Field
-}
 
 match :: String -> DateTime -> Bool
-match s d =  case parse s of
+match s d =
-    Just p -> check p d
+  case parse s of
+    Just p  -> check p d
     Nothing -> error "Parse error"
 
 safeMatch :: String -> DateTime -> Maybe Bool
-safeMatch s d = case parse s of
+safeMatch s d =
-    Just p -> Just (check p d)
+  case parse s of
+    Just p  -> Just (check p d)
     Nothing -> Nothing
 
 parse :: String -> Maybe Pattern
 parse s
-    | isInvalid = Nothing
+  | isInvalid = Nothing
-    | otherwise = Just (createPattern $ catMaybes parts)
+  | otherwise = Just (createPattern $ catMaybes parts)
-    where
+  where
-        parts = createParts s
+    parts = createParts s
-        isInvalid = not (checkParts parts)
+    isInvalid = not (checkParts parts)
-        createPattern xs = Pattern {
+    createPattern xs =
-            cminute = head xs,
+      Pattern
-            chour = xs !! 1,
+      { cminute = head xs
-            cday = xs !! 2,
+      , chour = xs !! 1
-            cmonth = xs !! 3,
+      , cday = xs !! 2
-            cweek = xs !! 4,
+      , cmonth = xs !! 3
-            cyear = xs !! 5
+      , cweek = xs !! 4
-        }
+      , cyear = xs !! 5
+      }
 
 createParts s = zipWith (curry f) parsers (words s)
   where
@@ -55,18 +57,23 @@ createParts s = zipWith (curry f) parsers (words s)
 
 checkParts :: [Maybe Field] -> Bool
 checkParts xs
-    | length xs /= 6 = False
+  | length xs /= 6 = False
-    | any isNothing xs = False
+  | any isNothing xs = False
-    | otherwise = True
+  | otherwise = True
 
 parseFieldAdapter :: Constraint -> String -> Maybe Field
 parseFieldAdapter c t = parseField t c
 
 parseMinute = parseFieldAdapter (Constraint 0 59)
+
 parseHour = parseFieldAdapter (Constraint 0 59)
+
 parseDay = parseFieldAdapter (Constraint 1 31)
+
 parseMonth = parseFieldAdapter (Constraint 1 12)
+
 parseWeek = parseFieldAdapter (Constraint 1 7)
+
 parseYear = parseFieldAdapter (Constraint 0 9999)
 
 parsers = [parseMinute, parseHour, parseDay, parseMonth, parseWeek, parseYear]
@@ -74,11 +81,12 @@ parsers = [parseMinute, parseHour, parseDay, parseMonth, parseWeek, parseYear]
 check :: Pattern -> DateTime -> Bool
 check ptn date = all isRight pairs
   where
-    pairs = [ (cminute ptn, minute date),
+    pairs =
-              (chour ptn, hour date),
+      [ (cminute ptn, minute date)
-              (cday ptn, day date),
+      , (chour ptn, hour date)
-              (cmonth ptn, month date),
+      , (cday ptn, day date)
-              (cweek ptn, weekdayNumber $ dateWeekDay date),
+      , (cmonth ptn, month date)
-              (cyear ptn, year date)
+      , (cweek ptn, weekdayNumber $ dateWeekDay date)
-            ]
+      , (cyear ptn, year date)
+      ]
     isRight (p, value) = matchField p value

test/ConstraintSpec.hs

@@ -1,19 +1,18 @@
-module ConstraintSpec (main, spec) where
+module ConstraintSpec
+  ( main
+  , spec
+  ) where
 
-import Test.Hspec
+import           Constraint
-
+import           Test.Hspec
-import Constraint
 
 main :: IO ()
 main = hspec spec
 
 spec :: Spec
-spec = describe "Constraint" $ do
+spec =
-  it "can be created from number" $
+  describe "Constraint" $ do
-    makeRangeFromNumber 10 `shouldBe` Constraint 10 10
+    it "can be created from number" $
-
+      makeRangeFromNumber 10 `shouldBe` Constraint 10 10
-  it "validate number" $
+    it "validate number" $ 10 `inRange` Constraint 0 10 `shouldBe` True
-    10 `inRange` Constraint 0 10 `shouldBe` True
+    it "validate number" $ 10 `inRange` Constraint 15 20 `shouldBe` False
-
-  it "validate number" $
-    10 `inRange` Constraint 15 20 `shouldBe` False

test/FieldSpec.hs

@@ -1,9 +1,12 @@
-module FieldSpec (main, spec) where
+module FieldSpec
+  ( main
+  , spec
+  ) where
 
-import Foreign.Marshal.Utils (fromBool)
+import           Constraint
-import Test.Hspec
+import           Field
-import Constraint
+import           Foreign.Marshal.Utils (fromBool)
-import Field
+import           Test.Hspec
 
 main :: IO ()
 main = hspec spec
@@ -13,72 +16,48 @@ spec = do
   describe "Number" $ do
     it "can be parsed from string" $
       parseNumber "10" (Constraint 0 10) `shouldBe` Just 10
-
     it "can't be parsed from string" $
       parseNumber "10and10" (Constraint 0 10) `shouldBe` Nothing
-
     it "fails constraints" $
       parseNumber "10" (Constraint 0 5) `shouldBe` Nothing
-
   -- Field validation
-
   describe "Field Range can be created from" $ do
-    it "asterisk" $
+    it "asterisk" $ parseFieldRange "*" (Constraint 0 0) `shouldBe` Just All
-      parseFieldRange "*" (Constraint 0 0) `shouldBe` Just All
-
     it "number" $
       parseFieldRange "10" (Constraint 0 10) `shouldBe` Just (Range 10 10)
-
     it "range" $
       parseFieldRange "10-20" (Constraint 0 59) `shouldBe` Just (Range 10 20)
-
     it "sequence" $
-      parseFieldRange "1,2,3" (Constraint 0 59) `shouldBe` Just (Sequence [1, 2, 3])
+      parseFieldRange "1,2,3" (Constraint 0 59) `shouldBe`
-
+      Just (Sequence [1, 2, 3])
   -- Field Step validation
-
   describe "Step can be created from" $ do
-    it "empty string" $
+    it "empty string" $ parseFieldStep "" `shouldBe` Just Every
-      parseFieldStep "" `shouldBe` Just Every
+    it "number" $ parseFieldStep "5" `shouldBe` Just (Step 5)
-
-    it "number" $
-      parseFieldStep "5" `shouldBe` Just (Step 5)
-
   describe "Step cant'b created from" $ do
-    it "word" $
+    it "word" $ parseFieldStep "hello" `shouldBe` Nothing
-      parseFieldStep "hello" `shouldBe` Nothing
-
   -- Field validation
-
   describe "Field can be created from" $ do
     it "asterisk" $
       parseField "*" (Constraint 0 59) `shouldBe` Just (Field All Every)
-
     it "asterisk with step" $ do
       parseField "*/5" (Constraint 0 59) `shouldBe` Just (Field All (Step 5))
-
     it "number with step" $ do
-      parseField "10/5" (Constraint 0 59) `shouldBe` Just (Field (Range 10 10) (Step 5))
+      parseField "10/5" (Constraint 0 59) `shouldBe`
-
+        Just (Field (Range 10 10) (Step 5))
     it "range with step" $ do
-      parseField "0-59/5" (Constraint 0 59) `shouldBe` Just (Field (Range 0 59) (Step 5))
+      parseField "0-59/5" (Constraint 0 59) `shouldBe`
-
+        Just (Field (Range 0 59) (Step 5))
     it "sequence with step" $ do
-      parseField "1,3,4/5" (Constraint 0 59) `shouldBe` Just (Field (Sequence [1, 3, 4]) (Step 5))
+      parseField "1,3,4/5" (Constraint 0 59) `shouldBe`
-
+        Just (Field (Sequence [1, 3, 4]) (Step 5))
   -- Field match
-
   describe "Field can match" $ do
-    it "number" $
+    it "number" $ count (Field All Every) [0 .. 59] `shouldBe` 60
-      count (Field All Every) [0..59] `shouldBe` 60
+    it "range" $ count (Field (Range 10 20) Every) [0 .. 59] `shouldBe` 11
-
+    it "range" $ count (Field All (Step 10)) [0 .. 59] `shouldBe` 6
-    it "range" $
-      count (Field (Range 10 20) Every) [0..59] `shouldBe` 11
-
-    it "range" $
-      count (Field All (Step 10)) [0..59] `shouldBe` 6
-
 
 count :: Field -> [Int] -> Int
 count field values = sum $ map m values
-  where m = fromBool . matchField field
+  where
+    m = fromBool . matchField field

test/HelperSpec.hs

@@ -1,21 +1,20 @@
-module HelperSpec (main, spec) where
+module HelperSpec
+  ( main
+  , spec
+  ) where
 
-import Test.Hspec
+import           Helper
-import Helper
+import           Test.Hspec
 
 main :: IO ()
 main = hspec spec
 
 spec :: Spec
-spec = describe "Splitting" $ do
+spec =
-  it "can process empty string" $
+  describe "Splitting" $ do
-    wordsWhen (== '-') "" `shouldBe` []
+    it "can process empty string" $ wordsWhen (== '-') "" `shouldBe` []
-
+    it "can process only one word" $ wordsWhen (== '-') "10" `shouldBe` ["10"]
-  it "can process only one word" $
+    it "can separated by '-'" $
-    wordsWhen (== '-') "10" `shouldBe` ["10"]
+      wordsWhen (== '-') "10-20" `shouldBe` ["10", "20"]
-
+    it "can be separated by ','" $
-  it "can separated by '-'" $
+      wordsWhen (== ',') "10,20,30" `shouldBe` ["10", "20", "30"]
-    wordsWhen (== '-') "10-20" `shouldBe` ["10", "20"]
-
-  it "can be separated by ','" $
-    wordsWhen (== ',') "10,20,30" `shouldBe` ["10", "20", "30"]

test/PatternSpec.hs

@@ -1,9 +1,11 @@
-module PatternSpec (main, spec) where
+module PatternSpec
+  ( main
+  , spec
+  ) where
 
-import Test.Hspec
+import           Data.Dates
-import Data.Dates
+import           Pattern
-
+import           Test.Hspec
-import Pattern
 
 main :: IO ()
 main = hspec spec
@@ -11,33 +13,24 @@ main = hspec spec
 spec :: Spec
 spec = do
   describe "Cron pattern" $ do
-
+    it "createParts" $ length (createParts "* * * * * *") `shouldBe` 6
-    it "createParts" $
-      length (createParts "* * * * * *") `shouldBe` 6
-
     it "matches fixed time" $
-      let
+      let ptn = "* * * * * *"
-        ptn = "* * * * * *"
+          date = DateTime 2017 10 11 0 0 0
-        date = DateTime 2017 10 11 0 0 0
+      in match ptn date `shouldBe` True
-      in
-        match ptn date `shouldBe` True
-
     it "matches all minutes" $
-      let
+      let ptn = "* * * * * *"
-        ptn = "* * * * * *"
+          dates = [DateTime 2017 10 11 0 i 0 | i <- [0 .. 59]]
-        dates = [DateTime 2017 10 11 0 i 0 | i <- [0..59]]
+      in countMatches ptn dates `shouldBe` 60
-      in
-        countMatches ptn dates `shouldBe` 60
-
     it "matches exactly moment" $
-      let
+      let date = DateTime 2017 10 11 0 0 0
-        date = DateTime 2017 10 11 0 0 0
+          ptn = "0 0 11 10 * 2017"
-        ptn = "0 0 11 10 * 2017"
+      in match ptn date `shouldBe` True
-      in
-        match ptn date `shouldBe` True
-
 
 countMatches :: String -> [DateTime] -> Int
 countMatches p xs = sum $ map (f p) xs
   where
-    f x d = if  match x d then 1 else 0
+    f x d =
+      if match x d
+        then 1
+        else 0