Enable (almost) all GHC warning, fix warnings

haga.cabal

@@ -34,6 +34,7 @@ library
                      , random-shuffle
                      , text
   default-language:    Haskell2010
+  ghc-options:         -Wall -Wno-name-shadowing -Wno-orphans
   hs-source-dirs:      src
   exposed-modules:     GA
                      , Seminar
@@ -55,6 +56,7 @@ executable haga
                      , random-shuffle
                      , text
   default-language:    Haskell2010
+  ghc-options:         -Wall -Wno-name-shadowing -Wno-orphans
   hs-source-dirs:      src
   main-is:             Main.hs
   other-modules:       GA
@@ -62,7 +64,7 @@ executable haga
                      , Pretty
                      , Szenario191
 
-executable haga-tests
+executable haga-test
   build-depends:       base ^>=4.13.0.0
                      , Cabal
                      , extra
@@ -78,6 +80,7 @@ executable haga-tests
                      , random-shuffle
                      , text
   default-language:    Haskell2010
+  ghc-options:         -Wall -Wno-name-shadowing -Wno-orphans
   hs-source-dirs:      src
   main-is:             Test.hs
   other-modules:       GA

src/GA.hs

@@ -24,18 +24,14 @@ function.
 module GA where
 
 import Control.Arrow hiding (first, second)
-import qualified Data.List as L
 import Data.List.NonEmpty ((<|))
 import qualified Data.List.NonEmpty as NE
 import qualified Data.List.NonEmpty.Extra as NE (appendl, sortOn)
 import Data.Random
-import Data.Random.Distribution.Categorical
-import Data.Random.Sample
 import Pipes
-import Pretty
 import Protolude
 import Test.QuickCheck hiding (sample, shuffle)
-import Test.QuickCheck.Instances
+import Test.QuickCheck.Instances ()
 import Test.QuickCheck.Monadic
 
 -- TODO there should be a few 'shuffle's here
@@ -122,6 +118,8 @@ children nX (i1 :| [i2]) = children2 nX i1 i2
 children nX (i1 :| i2 : is') =
   (<>) <$> children2 nX i1 i2 <*> children nX (NE.fromList is')
 
+prop_children_asManyAsParents
+  :: (Individual a, Show a) => N -> NonEmpty a -> Property
 prop_children_asManyAsParents nX is =
   again
     $ monadicIO
@@ -168,6 +166,7 @@ bestsBy' k f =
   fmap (NE.take k . fmap fst . NE.sortBy (comparing (Down . snd)))
     . traverse (\i -> (i,) <$> f i)
 
+prop_bestsBy_isBestsBy' :: Individual a => Int -> Population a -> Property
 prop_bestsBy_isBestsBy' k pop =
   k > 0
     ==> monadicIO
@@ -176,6 +175,7 @@ prop_bestsBy_isBestsBy' k pop =
       b <- bestsBy' k fitness pop
       assert $ NE.toList a == b
 
+prop_bestsBy_lengths :: Individual a => Int -> Population a -> Property
 prop_bestsBy_lengths k pop =
   k > 0 ==> monadicIO $ do
     (bests, rest) <- bestsBy k fitness pop
@@ -230,6 +230,8 @@ stepSteady select nParents nX pElite pop = do
   where
     nBest = floor . (pElite *) . fromIntegral $ NE.length pop
 
+prop_stepSteady_constantPopSize
+  :: (Individual a, Show a) => NonEmpty a -> Property
 prop_stepSteady_constantPopSize pop =
   forAll
     ( (,)
@@ -300,6 +302,7 @@ selected multiple times, see 'chain').
 tournament :: (Individual i, MonadRandom m) => N -> Selection m i
 tournament nTrnmnt = chain (tournament1 nTrnmnt)
 
+prop_tournament_selectsN :: Individual a => Int -> Int -> NonEmpty a -> Property
 prop_tournament_selectsN nTrnmnt n pop =
   0 < nTrnmnt && nTrnmnt < length pop
     && 0 < n ==> monadicIO
@@ -322,7 +325,6 @@ tournament1 nTrnmnt pop
   | otherwise = trnmnt >>= fmap (NE.head . fst) . bests 1
   where
     trnmnt = withoutReplacement nTrnmnt pop
-    size = length pop
 
 {-|
 Selects @n@ individuals uniformly at random from the population (without
@@ -340,6 +342,7 @@ withoutReplacement n pop
   | otherwise =
     fmap NE.fromList . sample . shuffleNofM n (length pop) $ NE.toList pop
 
+prop_withoutReplacement_selectsN :: Int -> NonEmpty a -> Property
 prop_withoutReplacement_selectsN n pop =
   0 < n && n <= length pop ==> monadicIO $ do
     pop' <- lift $ withoutReplacement n pop
@@ -365,7 +368,7 @@ steps tEnd _ t = t >= tEnd
 Shuffles a non-empty list.
 -}
 shuffle' :: (MonadRandom m) => NonEmpty a -> m (NonEmpty a)
-shuffle' xs@(x :| []) = return xs
+shuffle' xs@(_ :| []) = return xs
 shuffle' xs = do
   i <- sample . uniform 0 $ NE.length xs - 1
   -- slightly unsafe (!!) used here so deletion is faster
@@ -375,10 +378,12 @@ shuffle' xs = do
   where
     deleteI i xs = fst (NE.splitAt i xs) ++ snd (NE.splitAt (i + 1) xs)
 
+prop_shuffle_length :: NonEmpty a -> Property
 prop_shuffle_length xs = monadicIO $ do
   xs' <- lift $ shuffle' xs
   assert $ length xs' == length xs
 
 return []
 
+runTests :: IO Bool
 runTests = $quickCheckAll

src/Seminar.hs

@@ -8,13 +8,11 @@ module Seminar where
 import Data.List ((!!), (\\), lookup, zipWith3)
 import Data.List.Extra (nubOrd, nubOrdOn)
 import Data.Random
-import Data.Random.Distribution.Uniform
 import qualified Data.Text as T
 import GA
 import Pretty
 import Protolude
 import Test.QuickCheck hiding (sample, shuffle)
-import Test.QuickCheck.Instances
 import Test.QuickCheck.Monadic (assert, monadicIO)
 
 instance Pretty Text where
@@ -85,11 +83,14 @@ The priority value given by a student to a topic.
 prioOf :: Priorities -> Student -> Topic -> Int
 prioOf p s t = fromMaybe (lowestPriority p + 1) $ lookup s (unP p) >>= lookup t
 
+prop_prioOf_empty :: Bool
 prop_prioOf_empty = prioOf (P []) "S" "T" == 1
 
+prop_prioOf_singletonFound :: Bool
 prop_prioOf_singletonFound =
   prioOf (P [("S", [("Existing topic", 10)])]) "S" "Existing topic" == 10
 
+prop_prioOf_singletonNotFound :: Bool
 prop_prioOf_singletonNotFound =
   prioOf (P [("S", [("Existing topic", 10)])]) "S" "Non-existing topic" == 11
 
@@ -105,7 +106,7 @@ data I = I Priorities Assignment
   deriving (Eq, Show)
 
 instance Pretty I where
-  pretty i@(I p a) =
+  pretty (I p a) =
     T.unlines (gene <$> a)
     where
       gene :: (Student, Maybe Topic) -> Text
@@ -119,7 +120,7 @@ The priority value given by a student to a topic including the case of her not
 receiving a topic.
 -}
 prioOf' :: Priorities -> Student -> Maybe Topic -> Int
-prioOf' p s Nothing = lowestPriority p + 2
+prioOf' p _ Nothing = lowestPriority p + 2
 prioOf' p s (Just t) = prioOf p s t
 
 instance Individual I where
@@ -192,15 +193,18 @@ valid p a =
     studentsAssigned = fmap fst a
     topicsAssigned = fmap snd a
 
+prop_new_valid :: Priorities -> Property
 prop_new_valid p = monadicIO $ do
   I _ a <- lift $ new (I p [])
   assert $ valid p a
 
+prop_mutate_valid :: Priorities -> Property
 prop_mutate_valid p = monadicIO $ do
   a <- lift . new $ I p []
   I _ a <- lift $ mutate a
   assert $ valid p a
 
+prop_crossover1_valid :: Priorities -> Property
 prop_crossover1_valid p = monadicIO $ do
   a1 <- lift . new $ I p []
   a2 <- lift . new $ I p []
@@ -217,6 +221,7 @@ elements.
 noDupsList :: (Arbitrary a, Eq a, Ord a) => Gen [a]
 noDupsList = nubOrd <$> arbitrary
 
+prop_noDupsList :: Property
 prop_noDupsList = forAll (noDupsList :: Gen [Int]) unique
 
 {-|
@@ -227,4 +232,5 @@ unique xs = length xs == (length . nubOrd) xs
 
 return []
 
+runTests :: IO Bool
 runTests = $quickCheckAll

src/Szenario191.hs

@@ -9,7 +9,6 @@ module Szenario191
 where
 
 import GA hiding (runTests)
-import Protolude
 import Seminar hiding (runTests)
 
 prios :: Priorities