Add Invariant and Idempotence to Haskell

haskell/package.yaml

@@ -24,6 +24,46 @@ ghc-options:
   # Don't optimize by default (faster build time)
   - -O0
 
+default-extensions:
+  - AutoDeriveTypeable
+  - BangPatterns
+  - BinaryLiterals
+  - ConstraintKinds
+  - DataKinds
+  - DefaultSignatures
+  - DeriveDataTypeable
+  - DeriveFoldable
+  - DeriveFunctor
+  - DeriveGeneric
+  - DeriveTraversable
+  - DoAndIfThenElse
+  - EmptyDataDecls
+  - ExistentialQuantification
+  - FlexibleContexts
+  - FlexibleInstances
+  - FunctionalDependencies
+  - GADTs
+  - GeneralizedNewtypeDeriving
+  - InstanceSigs
+  - KindSignatures
+  - LambdaCase
+  - MonadFailDesugaring
+  - MultiParamTypeClasses
+  - MultiWayIf
+  - NamedFieldPuns
+  - OverloadedStrings
+  - PartialTypeSignatures
+  - PatternGuards
+  - PolyKinds
+  - RankNTypes
+  - RecordWildCards
+  - ScopedTypeVariables
+  - StandaloneDeriving
+  - TupleSections
+  - TypeFamilies
+  - TypeSynonymInstances
+  - ViewPatterns
+
 dependencies:
   - base >= 4.7 && < 5
   - hlint

haskell/src/Idempotence.hs

@@ -0,0 +1,12 @@
+module Idempotence
+  ( sortByEvenThenValue
+  ) where
+
+import           Data.List
+
+sortByEvenThenValue :: [Int] -> [Int]
+sortByEvenThenValue input = evenSorted ++ oddSorted
+  where
+    evenSorted = sortGroupBy (\i -> i `mod` 2 == 0)
+    oddSorted = sortGroupBy (\i -> i `mod` 2 /= 0)
+    sortGroupBy grouper = sort . filter grouper $ input

haskell/src/Invariant.hs

@@ -1,6 +1,11 @@
-module Invariant (LocalDate, isNewYearEve) where
+module Invariant
+  ( Day
+  , isNewYearEve
+  ) where
 
-type LocalDate = (Integer, Int, Int)
+import           Data.Time (Day, toGregorian)
 
-isNewYearEve :: LocalDate -> Bool
-isNewYearEve (_, month, day) = month == 12 && day == 31
+isNewYearEve :: Day -> Bool
+isNewYearEve date = month == 12 && day == 31
+  where
+    (_, month, day) = toGregorian date

haskell/test/IdempotenceSpec.hs

@@ -0,0 +1,21 @@
+module IdempotenceSpec where
+
+import           Idempotence
+import           Test.QuickCheck
+import           Test.QuickCheck.Arbitrary.ADT
+import           Test.QuickCheck.Instances.Scientific
+import           Test.QuickCheck.Instances.Time
+import           Test.Tasty.HUnit
+import           Test.Tasty.QuickCheck
+
+test_empty = testCase "Empty is still empty" $ sortByEvenThenValue [] @?= []
+
+test_one = testCase "One sorted is still one" $ sortByEvenThenValue [1] @?= [1]
+
+test_many_ordered =
+  testCase "Many ordered, sorted, are ordered with even first" $
+  sortByEvenThenValue [1, 2, 3, 4, 5, 6] @?= [2, 4, 6, 1, 3, 5]
+
+test_many_unordered =
+  testCase "Many unordered, sorted, are ordered with even first" $
+  sortByEvenThenValue [43, 16, 22, 99, 68, 9865, 4567] @?= [16, 22, 68, 43, 99, 4567, 9865]

haskell/test/InvariantSpec.hs

@@ -1,17 +1,37 @@
 module InvariantSpec where
 
-import           Invariant
+import           Data.Time
+import qualified Invariant                            as SUT
 import           Test.QuickCheck
 import           Test.QuickCheck.Arbitrary.ADT
 import           Test.QuickCheck.Instances.Scientific
 import           Test.QuickCheck.Instances.Time
+import           Test.Tasty
 import           Test.Tasty.HUnit
 import           Test.Tasty.QuickCheck
 
-test_2018_12_31 = testCase "2018-12-31 is a new year's eve" $ isNewYearEve (2018, 12, 31) @?= True
+test_invariant_12_31 =
+  testProperty "Every 12-31 is a new year's eve" $ \anyYear -> SUT.isNewYearEve $ fromGregorian anyYear 12 31
 
-test_1989_12_31 = testCase "1989-12-31 is a new year's eve" $ isNewYearEve (1989, 12, 31) @?= True
+test_invariant_not_12_31 =
+  localOption (QuickCheckTests 1000) $
+  testProperty "Every other day is not a new year's eve" $ \anyDate ->
+    let anyDay = toDay anyDate
+        (_, month, day) = toGregorian anyDay
+     in month /= 12 || day /= 31 ==> not (SUT.isNewYearEve anyDay)
 
-test_2018_12_25 = testCase "2018-12-25 is not a new year's eve" $ isNewYearEve (2018, 12, 25) @?= False
+test_2018_12_31 = testCase "2018-12-31 is a new year's eve" $ SUT.isNewYearEve (fromGregorian 2018 12 31) @?= True
 
-test_2018_08_25 = testCase "2018-08-31 is not a new year's eve" $ isNewYearEve (2018, 8, 31) @?= False
+test_1989_12_31 = testCase "1989-12-31 is a new year's eve" $ SUT.isNewYearEve (fromGregorian 1989 12 31) @?= True
+
+test_2018_12_25 = testCase "2018-12-25 is not a new year's eve" $ SUT.isNewYearEve (fromGregorian 2018 12 25) @?= False
+
+test_2018_08_25 = testCase "2018-08-31 is not a new year's eve" $ SUT.isNewYearEve (fromGregorian 2018 8 31) @?= False
+
+newtype Date = Date
+  { toDay :: Day
+  } deriving (Show)
+
+instance Arbitrary Date where
+  arbitrary = Date . ModifiedJulianDay . (2000 +) <$> choose (-678170, 416465) -- Aprox. year between 0 and 3000, the default is 100 days around year 1864...
+  shrink = (Date <$>) . (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay . toDay