diff --git a/colorful-monoids.cabal b/colorful-monoids.cabal
--- a/colorful-monoids.cabal
+++ b/colorful-monoids.cabal
@@ -3,7 +3,7 @@
 -- see: https://github.com/sol/hpack
 
 name:           colorful-monoids
-version:        0.1.0.1
+version:        0.2.0.0
 synopsis:       Styled console text output using ANSI escape sequences.
 description:    Styled console text output using ANSI escape sequences.
 category:       Text, User Interfaces, Monad
@@ -29,9 +29,6 @@
   ghc-options: -Wall
   build-depends:
       base >= 4.8 && < 5
-  if impl(ghc < 8.0)
-    build-depends:
-        semigroups >= 0.9 && < 1
   exposed-modules:
       Data.Monoid.Colorful
       Data.Monoid.Colorful.Flat
@@ -52,7 +49,4 @@
   build-depends:
       base >= 4.8 && < 5
     , colorful-monoids
-  if impl(ghc < 8.0)
-    build-depends:
-        semigroups >= 0.9 && < 1
   default-language: Haskell2010
diff --git a/src/Data/Monoid/Colorful.hs b/src/Data/Monoid/Colorful.hs
--- a/src/Data/Monoid/Colorful.hs
+++ b/src/Data/Monoid/Colorful.hs
@@ -9,11 +9,18 @@
 -- Portability :  portable
 --
 -- This library provides styled text output using ANSI
--- escape sequences. The main feature is that the library
--- keeps track of a stack of the active styles using a state monad.
--- This makes it easy to use this library for a pretty printer with
--- nested annotations, e.g., wl-pprint-console.
+-- escape sequences. The colored text is modeled
+-- as nested Colored values, which form a Monoid.
+-- As a result the colored code has a relatively concise form.
 --
+-- For rendering, the Colored Monoid is flattended and
+-- then printed out. The library keeps track of a stack of the active
+-- styles internally, such that correct and minimal escape sequences are generated.
+--
+-- This library is used by
+-- <https://hackage.haskell.org/package/wl-pprint-console wl-pprint-console>,
+-- which is a pretty printer with support for annotations.
+--
 -- Warning: Windows support is currently not implemented, but
 -- is planned (by using ansi-terminal or the ffi).
 --
@@ -53,7 +60,7 @@
 
   -- ** Show with ANSI escape sequences
   , showColored
-  , showColoredA
+  , showColoredM
   , showColoredS
 
   -- * Reexport from Data.Semigroup
diff --git a/src/Data/Monoid/Colorful/Flat.hs b/src/Data/Monoid/Colorful/Flat.hs
--- a/src/Data/Monoid/Colorful/Flat.hs
+++ b/src/Data/Monoid/Colorful/Flat.hs
@@ -20,6 +20,7 @@
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE BangPatterns #-}
 
 module Data.Monoid.Colorful.Flat (
   -- * Colored datatypes
@@ -42,7 +43,7 @@
 
   -- ** Show with ANSI escape sequences
   , showColored
-  , showColoredA
+  , showColoredM
   , showColoredS
 
   -- * Reexport from Data.Semigroup
@@ -55,9 +56,9 @@
 import Data.Monoid.Colorful.Color
 import Data.Monoid.Colorful.SGR
 import Data.Functor.Identity
-import Data.Bifunctor (first, second)
 import GHC.Generics (Generic, Generic1)
 import Data.Semigroup ((<>))
+import Data.Foldable (foldlM)
 
 data Colored a
   = Value a
@@ -71,38 +72,57 @@
   deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic, Generic1)
 
 hPrintColoredIO :: Handle -> Term -> [Colored (IO ())] -> IO ()
-hPrintColoredIO h = showColoredA id (hPutStr h)
+hPrintColoredIO h = showColoredM id (hPutStr h)
 
 printColoredIO :: Term -> [Colored (IO ())] -> IO ()
 printColoredIO = hPrintColoredIO stdout
 
-hPrintColored :: (Handle -> a -> IO ()) -> Handle -> Term -> [Colored a] -> IO ()
-hPrintColored f h = showColoredA (f h) (hPutStr h)
+hPrintColored :: Foldable f => (Handle -> a -> IO ()) -> Handle -> Term -> f (Colored a) -> IO ()
+hPrintColored f h = showColoredM (f h) (hPutStr h)
 
-printColored :: (a -> IO ()) -> Term -> [Colored a] -> IO ()
+printColored :: Foldable f => (a -> IO ()) -> Term -> f (Colored a) -> IO ()
 printColored f = hPrintColored (const f) stdout
 
-hPrintColoredS :: Handle -> Term -> [Colored String] -> IO ()
-hPrintColoredS h = showColoredA (hPutStr h) (hPutStr h)
+hPrintColoredS :: Foldable f => Handle -> Term -> f (Colored String) -> IO ()
+hPrintColoredS h = showColoredM (hPutStr h) (hPutStr h)
 
-printColoredS :: Term -> [Colored String] -> IO ()
+printColoredS :: Foldable f => Term -> f (Colored String) -> IO ()
 printColoredS = hPrintColoredS stdout
 
-showColoredS :: Term -> [Colored String] -> ShowS
+showColoredS :: Foldable f => Term -> f (Colored String) -> ShowS
 showColoredS = showColored (++) (++)
 
-showColored :: Monoid o => (a -> o) -> (SGRCode -> o) -> Term -> [Colored a] -> o
-showColored str code term flat = runIdentity $ showColoredA (pure . str) (pure . code) term flat
+showColored :: (Foldable f, Monoid o) => (a -> o) -> (SGRCode -> o) -> Term -> f (Colored a) -> o
+showColored str code term flat = runIdentity $ showColoredM (pure . str) (pure . code) term flat
+{-# SPECIALIZE showColored :: Monoid o => (a -> o) -> (SGRCode -> o) -> Term -> [Colored a] -> o #-}
 
-showColoredA :: (Applicative f, Monoid o) => (a -> f o) -> (SGRCode -> f o) -> Term -> [Colored a] -> f o
-showColoredA str code term = go (defaultSettings, (defaultSettings, []))
-  where go s (Style   a:b) = go ((second.first) (setStyle a True) s) b
-        go s (Unstyle a:b) = go ((second.first) (setStyle a False) s) b
-        go s (Fg      a:b) = go ((second.first) (setFg a) s) b
-        go s (Bg      a:b) = go ((second.first) (setBg a) s) b
-        go s (Push     :b) = go (second pushStack s) b
-        go s (Pop      :b) = go (second popStack s) b
-        go s (Reset    :b) = go (second resetStack s) b
-        go s (Value   a:b) = let (old, stack@(new, _)) = s in
-          mappend <$> (mappend <$> code (sgrCode term old new) <*> str a) <*> go (new, stack) b
-        go s [] = let (old, (new, _)) = s in code (sgrCode term old new)
+showColoredM :: (Foldable f, Monad m, Monoid o) => (a -> m o) -> (SGRCode -> m o) -> Term -> f (Colored a) -> m o
+showColoredM str code term list = do
+  s <- foldlM go (State mempty defaultSettings (defaultSettings, [])) list
+  mappend (stateStr s) <$> code (sgrCode term (stateActive s) (fst $ stateStack s))
+  where go s Push        = pure $ s { stateStack = pushStack $ stateStack s }
+        go s Pop         = pure $ s { stateStack = popStack $ stateStack s }
+        go s Reset       = pure $ s { stateStack = resetStack $ stateStack s }
+        go s (Style   a) = pure $ mapTop (setStyle a True) s
+        go s (Unstyle a) = pure $ mapTop (setStyle a False) s
+        go s (Fg      a) = pure $ mapTop (setFg a) s
+        go s (Bg      a) = pure $ mapTop (setBg a) s
+        go s (Value   a) = do
+          !x <- code (sgrCode term (stateActive s) (fst $ stateStack s))
+          !y <- str a
+          let !z = x `mappend` y
+          pure $ s { stateStr = stateStr s `mappend` z, stateActive = fst $ stateStack s }
+{-# SPECIALIZE showColoredM :: (Foldable f, Monoid o) => (a -> Identity o) -> (SGRCode -> Identity o) -> Term -> f (Colored a) -> Identity o #-}
+{-# SPECIALIZE showColoredM :: (Foldable f, Monoid o) => (a -> (o -> o)) -> (SGRCode -> (o -> o)) -> Term -> f (Colored a) -> (o -> o) #-}
+{-# SPECIALIZE showColoredM :: Monoid o => (a -> Identity o) -> (SGRCode -> Identity o) -> Term -> [Colored a] -> Identity o #-}
+{-# SPECIALIZE showColoredM :: Monoid o => (a -> (o -> o)) -> (SGRCode -> (o -> o)) -> Term -> [Colored a] -> (o -> o) #-}
+
+data State a = State
+  { stateStr  :: !a
+  , stateActive :: !Settings
+  , stateStack  :: !(Settings, [Settings])
+  }
+
+mapTop :: (Settings -> Settings) -> State a -> State a
+mapTop f s = let !t = f $ fst $ stateStack s in s { stateStack = (t, snd $ stateStack s) }
+{-# INLINE mapTop #-}
diff --git a/src/Data/Monoid/Colorful/Nested.hs b/src/Data/Monoid/Colorful/Nested.hs
--- a/src/Data/Monoid/Colorful/Nested.hs
+++ b/src/Data/Monoid/Colorful/Nested.hs
@@ -18,7 +18,7 @@
   , hPrintColoredS
   , printColoredS
   , showColored
-  , showColoredA
+  , showColoredM
   , showColoredS
 ) where
 
@@ -103,8 +103,8 @@
 printColoredS :: Term -> Colored String -> IO ()
 printColoredS t = Flat.printColoredS t . flatten
 
-showColoredA :: (Applicative f, Monoid o) => (a -> f o) -> (SGRCode -> f o) -> Term -> Colored a -> f o
-showColoredA f g t = Flat.showColoredA f g t . flatten
+showColoredM :: (Monad f, Monoid o) => (a -> f o) -> (SGRCode -> f o) -> Term -> Colored a -> f o
+showColoredM f g t = Flat.showColoredM f g t . flatten
 
 showColored :: Monoid o => (a -> o) -> (SGRCode -> o) -> Term -> Colored a -> o
 showColored f g t = Flat.showColored f g t . flatten
diff --git a/src/Data/Monoid/Colorful/SGR.hs b/src/Data/Monoid/Colorful/SGR.hs
--- a/src/Data/Monoid/Colorful/SGR.hs
+++ b/src/Data/Monoid/Colorful/SGR.hs
@@ -7,14 +7,16 @@
 import Data.Monoid.Colorful.Settings
 import Data.Monoid.Colorful.Color
 import Data.Word (Word8)
-import Data.List.NonEmpty (NonEmpty(..))
 import Data.Bool (bool)
-import Data.List (intercalate)
 
 type SGRCode = String
 
 csi :: Char -> [Word8] -> SGRCode
-csi cmd args = "\ESC[" ++ intercalate ";" (map show args) ++ pure cmd
+csi cmd args = (("\ESC["++) . go args) [cmd]
+  where go [] = id
+        go [x] = (show x++)
+        go (x:xs@(_:_)) = (show x++) . (';':) . go xs
+{-# INLINE csi #-}
 
 sgrCode :: Term -> Settings -> Settings -> SGRCode
 sgrCode TermDumb _ _ = ""
@@ -23,39 +25,42 @@
   | old == new = ""
   | new == defaultSettings = csi 'm' []
   | otherwise = csi 'm' $
-    flag  styleBlink  5  ++
-    flag  styleBold   1  ++
-    flag  styleItalic 3  ++
-    flag  styleUnder  4  ++
-    flag  styleInvert 7  ++
-    color styleFg     0  ++
-    color styleBg     10
+                (flag  settingBlink  5 .
+                 flag  settingBold   1 .
+                 flag  settingItalic 3 .
+                 flag  settingUnder  4 .
+                 flag  settingInvert 7 .
+                 color settingFg     0 .
+                 color settingBg     10) []
 
   where
 
-  update :: Eq a => (Settings -> a) -> (a -> [Word8]) -> [Word8]
-  update f g = let new' = f new in bool [] (g new') (new' /= f old)
+  update :: Eq a => (Settings -> a) -> (a -> ([Word8] -> [Word8])) -> ([Word8] -> [Word8])
+  update f g = let new' = f new in bool id (g new') (new' /= f old)
 
-  flag  f n = update f $ bool [20 + n] [n]
-  color f n = update (reduceColor t . f) (\x -> let (c:|cs) = sgrColorArgs x in c + n : cs)
+  flag  f n = update f $ bool (20 + n:) (n:)
+  color f n = update (reduceColor t . f) $ sgrColorArgs n
+{-# INLINE sgrCode #-}
 
-sgrColorArgs :: Color -> NonEmpty Word8
-sgrColorArgs (Color256 n) = 38 :| [5, n]
-sgrColorArgs (RGB r g b)  = 38 :| [2, r, g, b]
-sgrColorArgs Black        = pure 90
-sgrColorArgs Red          = pure 91
-sgrColorArgs Green        = pure 92
-sgrColorArgs Yellow       = pure 93
-sgrColorArgs Blue         = pure 94
-sgrColorArgs Magenta      = pure 95
-sgrColorArgs Cyan         = pure 96
-sgrColorArgs White        = pure 97
-sgrColorArgs DullBlack    = pure 30
-sgrColorArgs DullRed      = pure 31
-sgrColorArgs DullGreen    = pure 32
-sgrColorArgs DullYellow   = pure 33
-sgrColorArgs DullBlue     = pure 34
-sgrColorArgs DullMagenta  = pure 35
-sgrColorArgs DullCyan     = pure 36
-sgrColorArgs DullWhite    = pure 37
-sgrColorArgs DefaultColor = pure 39
+sgrColorArgs :: Word8 -> Color -> ([Word8] -> [Word8])
+sgrColorArgs n c = case c of
+  (Color256 o) -> ([38 + n, 5, o]++)
+  (RGB r g b)  -> ([38 + n, 2, r, g, b]++)
+  Black        -> (90 + n:)
+  Red          -> (91 + n:)
+  Green        -> (92 + n:)
+  Yellow       -> (93 + n:)
+  Blue         -> (94 + n:)
+  Magenta      -> (95 + n:)
+  Cyan         -> (96 + n:)
+  White        -> (97 + n:)
+  DullBlack    -> (30 + n:)
+  DullRed      -> (31 + n:)
+  DullGreen    -> (32 + n:)
+  DullYellow   -> (33 + n:)
+  DullBlue     -> (34 + n:)
+  DullMagenta  -> (35 + n:)
+  DullCyan     -> (36 + n:)
+  DullWhite    -> (37 + n:)
+  DefaultColor -> (39 + n:)
+{-# INLINE sgrColorArgs #-}
diff --git a/src/Data/Monoid/Colorful/Settings.hs b/src/Data/Monoid/Colorful/Settings.hs
--- a/src/Data/Monoid/Colorful/Settings.hs
+++ b/src/Data/Monoid/Colorful/Settings.hs
@@ -8,41 +8,47 @@
 import Data.Monoid.Colorful.Color
 
 data Settings = Settings
-  { styleBold   :: !Bool
-  , styleItalic :: !Bool
-  , styleUnder  :: !Bool
-  , styleInvert :: !Bool
-  , styleBlink  :: !Bool
-  , styleFg     :: !Color
-  , styleBg     :: !Color
+  { settingBold   :: !Bool
+  , settingItalic :: !Bool
+  , settingUnder  :: !Bool
+  , settingInvert :: !Bool
+  , settingBlink  :: !Bool
+  , settingFg     :: !Color
+  , settingBg     :: !Color
   } deriving (Eq)
 
 type SettingsStack = (Settings, [Settings])
 
 defaultSettings :: Settings
 defaultSettings = Settings
-  { styleBold   = False
-  , styleItalic = False
-  , styleInvert = False
-  , styleUnder  = False
-  , styleBlink  = False
-  , styleFg     = DefaultColor
-  , styleBg     = DefaultColor
+  { settingBold   = False
+  , settingItalic = False
+  , settingInvert = False
+  , settingUnder  = False
+  , settingBlink  = False
+  , settingFg     = DefaultColor
+  , settingBg     = DefaultColor
   }
 
 setStyle :: Style -> Bool -> Settings -> Settings
-setStyle Bold   b s = s { styleBold   = b }
-setStyle Italic b s = s { styleItalic = b }
-setStyle Under  b s = s { styleUnder  = b }
-setStyle Invert b s = s { styleInvert = b }
-setStyle Blink  b s = s { styleBlink  = b }
+setStyle Bold   b s = s { settingBold   = b }
+setStyle Italic b s = s { settingItalic = b }
+setStyle Under  b s = s { settingUnder  = b }
+setStyle Invert b s = s { settingInvert = b }
+setStyle Blink  b s = s { settingBlink  = b }
+{-# INLINE setStyle #-}
 
 setBg, setFg :: Color -> Settings -> Settings
-setBg c s = s { styleBg = c }
-setFg c s = s { styleFg = c }
+setBg c s = s { settingBg = c }
+setFg c s = s { settingFg = c }
+{-# INLINE setBg #-}
+{-# INLINE setFg #-}
 
 resetStack, pushStack, popStack :: SettingsStack -> SettingsStack
 resetStack (_, ys)     = (defaultSettings, ys)
 pushStack  (y, ys)     = (y, y:ys)
 popStack   (_, [])     = (defaultSettings, [])
 popStack   (_, z : zs) = (z, zs)
+{-# INLINE resetStack #-}
+{-# INLINE pushStack #-}
+{-# INLINE popStack #-}
