Well, no useful properties hold. Should rewrite the type

func.cabal

@@ -1,5 +1,5 @@
 name:                func
-version:             0.12.0.0-SNAPSHOT
+version:             0.12.1.0-SNAPSHOT
 homepage:            https://github.com/jBugman/fun-lang#readme
 license:             MIT
 author:              Sergey Parshukov
@@ -61,7 +61,7 @@ test-suite fun-lang-test
                     , hspec-megaparsec
                     , mono-traversable
                     , QuickCheck
-                    , quickcheck-instances
+                --  , quickcheck-instances
                     , text
   ghc-options:        -Wall -threaded -rtsopts
   default-extensions: OverloadedStrings, NoImplicitPrelude

src/Fun/Sexp.hs

@@ -3,6 +3,7 @@
 module Fun.Sexp where
 
 import ClassyPrelude
+import Data.Semigroup         ((<>))
 import Data.Text.Buildable
 import Data.Text.Lazy.Builder (fromText)
 import GHC.Err                (errorWithoutStackTrace)
@@ -12,7 +13,7 @@ data Expression a
     | List [Expression a]
     | Op   a
     | Type a
-    | Atom a
+    | Atom a -- TODO: pack everything atomic-like into Atom
     | Unit
     deriving (Eq, Ord)
 
@@ -54,13 +55,38 @@ instance MonoFunctor (Expression Text) where
     omap f (List xs) = List $ omap (omap f) xs
     omap f (Exp xs)  = Exp  $ omap (omap f) xs
 
--- instance Functor Expression where
---     fmap _ Unit      = Unit
---     fmap f (Atom s)  = Atom $ f s
---     fmap f (Type s)  = Type $ f s
---     fmap f (Op s)    = Op   $ f s
---     fmap f (List xs) = List $ fmap (fmap f) xs
---     fmap f (Exp xs)  = Exp  $ fmap (fmap f) xs
+instance Semigroup (Expression Text) where
+    (<>) (Atom x) (Atom y)   = Exp [Atom x, Atom y]
+    (<>) (Atom x) (Op y)     = Exp [Atom x, Op y]
+    (<>) (Atom x) (Exp xs)   = Exp [Atom x, Exp xs]
+    (<>) (Atom x) (List xs)  = Exp [Atom x, List xs]
+    (<>) (Op x) (Atom y)     = Exp [Op x, Atom y]
+    (<>) (Op x) (Op y)       = Exp [Op x, Op y] -- not really a valid case
+    (<>) (Op x) (List xs)    = Exp [Op x, List xs]
+    (<>) (List xs) (List ys) = List $ xs <> ys
+    (<>) (List xs) x         = List $ xs `snoc` x
+    (<>) (Exp xs) (Exp ys)   = Exp $ xs <> ys
+    (<>) (Exp xs) x          = Exp $ xs `snoc` x
+    -- (<>) x y                = Exp [x, y]
+
+instance Monoid (Expression Text) where
+    mempty = Unit
+    mappend (Atom x) Unit = Exp [Atom x, Unit]
+    -- mappend (Atom x) (Atom y) = Exp [x, y]
+
+-- instance MonoFoldable (Expression Text) where
+-- --  -- ofoldMap :: Monoid m => (Text -> m) -> Expression Text -> m
+--     -- ofoldMap _ Unit = Unit
+--     ofoldMap f = oconcat . omap f
+--     ofoldr _ x Unit = x
+
+-- instance MonoTraversable (Expression Text) where
+--     otraverse _ Unit     = Unit
+--     otraverse f (Atom s) = Atom $ f s
+--     -- fmap f (Type s)  = Type $ f s
+--     -- fmap f (Op s)    = Op   $ f s
+--     -- fmap f (List xs) = List $ fmap (fmap f) xs
+--     -- fmap f (Exp xs)  = Exp  $ fmap (fmap f) xs
 
 opChars :: [Char]
 opChars = "=+-*/<>%"

test/Spec.hs

@@ -17,14 +17,22 @@ import qualified Fun.Sexp as S
 main :: IO ()
 main = hspec $ do
 
-  describe "S.Expression is a MonoFunctor" $ do
+  describe "MonoFunctor" $ do
     it "manual omap" $
       omap toUpper (S.Exp ["foo", S.Unit, "42", S.Exp ["barbar"]])
         `shouldBe` S.Exp [S.Atom "FOO", S.Unit, S.Atom "42", S.Exp[S.Atom "BARBAR" :: S.Expression Text]]
 
-    it "identity property" monofunctorIdentity
+    it "identity" monofunctorIdentity
 
-    it "compose property" monofunctorCompose
+    it "composability" monofunctorCompose
+
+  describe "Semigroup" $
+    it "associativity" semigroupAssociativity
+
+  describe "Monoid" $ do
+    it "associativity" monoidAssociativity
+
+    it "left identity" monoidLeftIdentity
 
 
   describe "Fun.Parser.sunit" $ do

test/Test/Properties.hs

@@ -1,26 +1,46 @@
 module Test.Properties
     ( monofunctorIdentity
     , monofunctorCompose
+    , monoidAssociativity
+    , monoidLeftIdentity
+    , semigroupAssociativity
 ) where
 
-import           Data.MonoTraversable
-import           Data.Text                (Text)
-import           Prelude                  (Bool, Eq, id, (.), (==))
+import           ClassyPrelude
+import           Data.Monoid              (mappend)
+import           Data.Semigroup           ((<>))
 import           Test.QuickCheck
 import qualified Test.QuickCheck.Function as QC
 
 import qualified Fun.Sexp       as S
 import           Test.Instances ()
 
 
+type SE = S.Expression Text
+
 monofunctorIdentity :: Property
-monofunctorIdentity = property (prop :: S.Expression Text -> Bool)
+monofunctorIdentity = property (prop :: SE -> Bool)
     where
         prop :: (MonoFunctor f, Eq f) => f -> Bool
         prop f = omap id f == f
 
 monofunctorCompose :: Property
-monofunctorCompose = property (prop :: QC.Fun Text Text -> QC.Fun Text Text -> S.Expression Text -> Bool)
+monofunctorCompose = property (prop :: QC.Fun Text Text -> QC.Fun Text Text -> SE -> Bool)
     where
         prop :: (MonoFunctor f, Eq f) => QC.Fun (Element f) (Element f) -> QC.Fun (Element f) (Element f) -> f -> Bool
         prop (QC.Fun _ f) (QC.Fun _ g) x = (omap g (omap f x)) == (omap (g . f) x)
+
+monoidAssociativity :: Property
+monoidAssociativity = property (prop :: SE -> SE -> SE -> Bool)
+    where
+        prop x y z = (x `mappend` y) `mappend` z == x `mappend` (y `mappend` z)
+
+monoidLeftIdentity :: Property
+monoidLeftIdentity = property (prop :: SE -> Bool)
+    where
+        prop x = mempty `mappend` x == x
+
+semigroupAssociativity :: Property
+semigroupAssociativity = property (prop :: SE -> SE -> SE -> Bool)
+    where
+        prop x y z = (x <> y) <> z == x <> (y <> z)