Add newtype Salign

Author: chris-martin

Data/Align.hs

@@ -8,7 +8,7 @@
 module Data.Align (
       Align(..)
     -- * Specialized aligns
-    , malign, salign, padZip, padZipWith
+    , malign, salign, Salign (..), padZip, padZipWith
     , lpadZip, lpadZipWith
     , rpadZip, rpadZipWith
     , alignVectorWith
@@ -285,6 +285,16 @@ malign = alignWith (mergeThese mappend)
 salign :: (Align f, Semigroup a) => f a -> f a -> f a
 salign = alignWith (mergeThese (<>))
 
+-- | Monoid under 'salign' and 'nil'.
+newtype Salign f a = Salign (f a)
+
+instance (Align f, Semigroup a) => Semigroup (Salign f a) where
+    Salign x <> Salign y = Salign (salign x y)
+
+instance (Align f, Semigroup a) => Monoid (Salign f a) where
+    mappend = (<>)
+    mempty = Salign nil
+
 -- | Align two structures as in 'zip', but filling in blanks with 'Nothing'.
 padZip :: (Align f) => f a -> f b -> f (Maybe a, Maybe b)
 padZip = alignWith (fromThese Nothing Nothing . bimap Just Just)

test/Tests.hs

@@ -2,9 +2,11 @@
 {-# LANGUAGE DeriveFoldable      #-}
 {-# LANGUAGE DeriveFunctor       #-}
 {-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures      #-}
 {-# LANGUAGE MonoLocalBinds      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving  #-}
 {-# LANGUAGE TupleSections       #-}
 module Main (main) where
 
@@ -63,6 +65,7 @@ tests = testGroup "Tests"
         [ semigroupLaws "These" (These "x" "y")
         , semigroupLaws "SearchResult" (ScannedAndFound "x" "y")
         , monoidLaws "List" "x" -- to disallow
+        , monoidLaws "Salign" (Salign ["x"])
         ]
     ]
 
@@ -444,3 +447,7 @@ instance Monoid a => Monoid (SearchResult a b) where
     mappend = (<>)
     mempty = Scanned mempty
 -}
+
+deriving instance Eq (f a) => Eq (Salign f a)
+deriving instance Show (f a) => Show (Salign f a)
+deriving instance Arbitrary (f a) => Arbitrary (Salign f a)