monoid instances working

package.yaml

@@ -33,6 +33,9 @@ dependencies:
 
 ghc-options:
 - -Wall
+- -Wredundant-constraints
+- -Werror=incomplete-patterns
+- -Wcompat
 
 library:
   source-dirs: src

src/Interactive/Plot/Core.hs

@@ -28,6 +28,7 @@
 module Interactive.Plot.Core (
     Coord(..), cX, cY
   , Range(.., RAbout), rMin, rMax, rSize, rMid, _rSize
+  , Auto(..)
   , PointStyleF(.., PointStyle), PointStyle, AutoPointStyle, psMarker, psColor
   , SeriesF(..), Series, AutoSeries, sItems, sStyle, toCoordMap, fromCoordMap
   , Alignment(..)
@@ -112,6 +113,17 @@ instance Monad Range where
     return x = R x x
     R x y >>= f = R (_rMin (f x)) (_rMax (f y))
 
+data Auto a = Auto | Given a
+  deriving (Show, Eq, Ord, Generic)
+
+instance Semigroup (Auto a) where
+    (<>) = \case
+      Auto    -> id
+      Given x -> \case Auto -> Given x; Given y -> Given y
+
+instance Monoid (Auto a) where
+    mempty = Auto
+
 -- | Specification of a style for a point.
 data PointStyleF f = PointStyleF
       { _psMarkerF :: f Char  -- ^ Marker cahracter.  For getter/setter lens, see 'psMarker'.
@@ -125,16 +137,16 @@ type PointStyle     = PointStyleF Identity
 
 -- | A version of 'PointStyle' where you can leave the marker or color
 -- blank, to be automatically inferred.
-type AutoPointStyle = PointStyleF Maybe
+type AutoPointStyle = PointStyleF Auto
 
 pattern PointStyle :: Char -> Color -> PointStyle
 pattern PointStyle { _psMarker, _psColor } = PointStyleF (Identity _psMarker) (Identity _psColor)
 {-# COMPLETE PointStyle #-}
 
-instance Semigroup AutoPointStyle where
-    PointStyleF m1 c1 <> PointStyleF m2 c2 = PointStyleF (m1 <|> m2) (c1 <|> c2)
-instance Monoid    AutoPointStyle where
-    mempty = PointStyleF Nothing Nothing
+instance (Semigroup (f Char), Semigroup (f Color)) => Semigroup (PointStyleF f) where
+    PointStyleF m1 c1 <> PointStyleF m2 c2 = PointStyleF (m1 <> m2) (c1 <> c2)
+instance (Monoid (f Char), Monoid (f Color)) => Monoid (PointStyleF f) where
+    mempty = PointStyleF mempty mempty
 
 deriving instance (Eq (f Char), Eq (f Color)) => Eq (PointStyleF f)
 instance (Ord (f Char), Ord (f OrdColor), Functor f, Eq (f Color)) => Ord (PointStyleF f) where
@@ -160,7 +172,7 @@ type Series = SeriesF Identity
 
 -- | A version of 'Series' where you can leave the marker or color blank,
 -- to be automatically inferred.
-type AutoSeries = SeriesF Maybe
+type AutoSeries = SeriesF Auto
 
 
 makeLenses ''SeriesF

src/Interactive/Plot/Series.hs

@@ -46,8 +46,8 @@ tupleSeries xs = Series (toCoordMap . S.fromList . foldMap ((:[]) . uncurry C) $
 -- | Convert from a 'Series' back into an 'AutoSeries' with settings given.
 autoSeries :: Series -> AutoSeries
 autoSeries s = Series (s ^. sItems)
-             $ PointStyleF (Just (s ^. sStyle . psMarker))
-                           (Just (s ^. sStyle . psColor))
+             $ PointStyleF (Given (s ^. sStyle . psMarker))
+                           (Given (s ^. sStyle . psColor))
 
 -- | @'enumRange' n ('R' a b)@ generates a list of @n@ equally spaced values
 -- between @a@ and @b@.
@@ -108,27 +108,27 @@ fromAutoSeries_ seed = flip evalRand seed . flip evalStateT S.empty . mapM go
     go (Series is ps) = Series is <$> pickPs
       where
         pickPs = case ps of
-          PointStyleF Nothing Nothing -> do
+          PointStyleF Auto Auto -> do
             picked <- get
             samp <- sampleSet $ defaultStyles S.\\ picked
             case samp of
               Nothing -> fromJust <$> sampleSet defaultStyles
               Just s  -> s <$ put (s `S.insert` picked)
-          PointStyleF (Just m) Nothing  -> do
+          PointStyleF (Given m) Auto -> do
             picked <- get
             let allDefaults = combinePointStyles (S.singleton m) defaultColors
             samp <- sampleSet $ allDefaults S.\\ picked
             case samp of
               Nothing -> fromJust <$> sampleSet allDefaults
               Just s  -> s <$ put (s `S.insert` picked)
-          PointStyleF Nothing (Just c) -> do
+          PointStyleF Auto (Given c) -> do
             picked <- get
             let allDefaults = combinePointStyles defaultMarkers (S.singleton (OC c))
             samp <- sampleSet $ allDefaults S.\\ picked
             case samp of
               Nothing -> fromJust <$> sampleSet allDefaults
               Just s  -> s <$ put (s `S.insert` picked)
-          PointStyleF (Just m) (Just c) -> pure $ PointStyle m c
+          PointStyleF (Given m) (Given c) -> pure $ PointStyle m c
 
 sampleSet
     :: (MonadRandom m)