diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,22 @@
+The MIT License (MIT)
+
+Copyright (c) 2017 Daniel Mendler
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/colorful-monoids.cabal b/colorful-monoids.cabal
new file mode 100644
--- /dev/null
+++ b/colorful-monoids.cabal
@@ -0,0 +1,58 @@
+-- This file has been generated from package.yaml by hpack version 0.15.0.
+--
+-- see: https://github.com/sol/hpack
+
+name:           colorful-monoids
+version:        0.1.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
+stability:      experimental
+homepage:       https://github.com/minad/colorful-monoids#readme
+bug-reports:    https://github.com/minad/colorful-monoids/issues
+author:         Daniel Mendler <mail@daniel-mendler.de>
+maintainer:     Daniel Mendler <mail@daniel-mendler.de>
+copyright:      2017 Daniel Mendler
+license:        MIT
+license-file:   LICENSE
+tested-with:    GHC == 7.10.3, GHC == 8.0.1
+build-type:     Simple
+cabal-version:  >= 1.10
+
+source-repository head
+  type: git
+  location: https://github.com/minad/colorful-monoids
+
+library
+  hs-source-dirs:
+      src
+  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
+  other-modules:
+      Data.Monoid.Colorful.Color
+      Data.Monoid.Colorful.Nested
+      Data.Monoid.Colorful.Settings
+      Data.Monoid.Colorful.SGR
+      Data.Monoid.Colorful.Term
+      Data.Monoid.Colorful.Trustworthy
+      Paths_colorful_monoids
+  default-language: Haskell2010
+
+test-suite example
+  type: exitcode-stdio-1.0
+  main-is: example.hs
+  ghc-options: -Wall
+  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/example.hs b/example.hs
new file mode 100644
--- /dev/null
+++ b/example.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Data.Monoid.Colorful
+import Data.Foldable
+import Text.Printf
+import Data.Monoid ((<>))
+
+ansiColors :: [Color]
+ansiColors = [ DefaultColor
+             , Black
+             , Red
+             , Green
+             , Yellow
+             , Blue
+             , Magenta
+             , Cyan
+             , White
+             , DullBlack
+             , DullRed
+             , DullGreen
+             , DullYellow
+             , DullBlue
+             , DullMagenta
+             , DullCyan
+             , DullWhite
+             ]
+
+ansiColorsExample :: IO ()
+ansiColorsExample = do
+  term <- getTerm
+  printColoredS term $ Style Under $ Style Bold "ANSI Example\n"
+  for_ ansiColors $ \c -> do
+    printColoredIO term $ Bg c $ Value $ printf "%-15s" $ show c
+    printColoredIO term $ Fg c $ Value $ printf "%-15s" $ show c
+    printColoredIO term $ Bg c $ Style Invert $ Value $ printf " %-15s" $ show c
+    printColoredIO term $ Fg c $ Style Invert $ Value $ printf " %-15s" $ show c
+    printColoredS term $ Bg c $ Value $ printf "%-15s" $ show c
+    printColoredS term $ Fg c $ Value $ printf "%-15s" $ show c
+    printColoredS term $ Bg c $ Style Invert $ Value $ printf " %-15s" $ show c
+    printColoredS term $ Fg c $ Style Invert $ Value $ printf " %-15s" $ show c
+    putChar '\n'
+
+colors256Example :: IO ()
+colors256Example = do
+  term <- getTerm
+  printColoredS term $ Style Under $ Style Bold "Color256 Example\n"
+  for_ [0..255] $ \c -> do
+    printColoredS term $ Bg (Color256 c) $ Value $ printf "%02x" c
+    printColoredS term $ Fg (Color256 c) $ Value $ printf " %02x" c
+    printColoredS term $ Bg (Color256 c) $ Style Invert $ Value $ printf " %02x" c
+    printColoredS term $ Fg (Color256 c) $ Style Invert $ Value $ printf " %02x" c
+    putChar '\n'
+
+rgbExample :: IO ()
+rgbExample = do
+  term <- getTerm
+  printColoredS term $ Style Under $ Style Bold "RGB Example\n"
+  for_ [0,64..255] $ \r ->
+    for_ [0,64..255] $ \g ->
+      for_ [0,64..255] $ \b -> do
+        let c = RGB r g b
+        printColoredS term $ Bg c $ Value $ printf "%-20s" $ show c
+        printColoredS term $ Fg c $ Value $ printf " %-20s" $ show c
+        printColoredS term $ Bg c $ Style Invert $ Value $ printf " %-20s" $ show c
+        printColoredS term $ Fg c $ Style Invert $ Value $ printf " %-20s" $ show c
+        putChar '\n'
+
+specialExample :: IO ()
+specialExample = do
+  term <- getTerm
+  printColoredS term $ Style Under $ Style Bold "Special Example\n"
+  for_ [Bold,Italic,Under,Invert,Blink] $ \a -> do
+    printColoredS term $
+      Style a (Value (printf "%-20s" $ show a) <>
+               Unstyle a (Value $ printf " %-20s" $ "Not" ++ show a) <>
+               Value (printf "%-20s" $ show a))
+    putChar '\n'
+
+stackExample :: IO ()
+stackExample = do
+  term <- getTerm
+  printColoredS term $ Style Under $ Style Bold "Stack Example\n"
+  printColoredS term $ loop 0
+  putChar '\n'
+  where
+    loop 8 = mempty
+    loop n =
+      Bg (Color256 n) $
+        Value (replicate (fromIntegral n) ' ') <>
+        loop (n + 1) <>
+        Value (replicate (fromIntegral n) ' ')
+
+basicExample :: IO ()
+basicExample = do
+  term <- getTerm
+  printColoredS term $ Style Under $ Style Bold "Basic Example\n"
+  printColoredS term $ Style Bold "Bold"
+  printColoredS term $ Style Italic $ Bg Red "Italic Red"
+  printColoredS term $ Style Under "Under"
+  putChar '\n'
+
+reduceExample :: IO ()
+reduceExample = do
+  printColoredS Term8 $ Style Under $ Style Bold "Reduction Example\n"
+  for_ [0..255] $ \c -> do
+    printColoredS Term256 $ Bg (Color256 c) $ Value $ printf "%02x" c
+    printColoredS Term8   $ Bg (Color256 c) $ Value $ printf "%02x" c
+    putChar '\n'
+  for_ [0,64..255] $ \r ->
+    for_ [0,64..255] $ \g ->
+      for_ [0,64..255] $ \b -> do
+        let c = RGB r g b
+        printColoredS TermRGB $ Bg c $ Value $ printf "%20s" $ show c
+        printColoredS Term256 $ Bg c $ Value $ printf "%20s" $ show c
+        printColoredS Term8   $ Bg c $ Value $ printf "%20s" $ show c
+        putChar '\n'
+
+main :: IO ()
+main = do
+  putStrLn "\n"
+  ansiColorsExample
+  colors256Example
+  rgbExample
+  specialExample
+  stackExample
+  basicExample
+  reduceExample
+  putStrLn "\n"
diff --git a/src/Data/Monoid/Colorful.hs b/src/Data/Monoid/Colorful.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Colorful.hs
@@ -0,0 +1,53 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Monoid.Colorful
+-- Copyright   :  Daniel Mendler (c) 2017,
+-- License     :  MIT (see the file LICENSE)
+--
+-- Maintainer  :  mail@daniel-mendler.de
+-- Stability   :  experimental
+-- 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.
+--
+-- Warning: Windows support is currently not implemented, but
+-- is planned (by using ansi-terminal or the ffi).
+--
+-- Example:
+--
+-- > basicExample :: IO ()
+-- > basicExample = do
+-- >  term <- getTerm
+-- >  printColoredS term $ Style Under $ Style Bold "Basic Example\n"
+-- >  printColoredS term $ Style Bold "Bold"
+-- >  printColoredS term $ Style Italic $ Bg Red "Italic Red"
+-- >  printColoredS term $ Style Under "Under"
+-- >  putChar '\n'
+--
+-- For many more examples, see the
+-- <https://github.com/minad/colored-monoids/blob/master/example.hs example.hs> file.
+-----------------------------------------------------------
+
+module Data.Monoid.Colorful (
+  Style(..)
+  , Color(..)
+  , Term(..)
+  , Colored(..)
+  , hGetTerm
+  , getTerm
+  , hPrintColored
+  , printColored
+  , hPrintColoredIO
+  , printColoredIO
+  , hPrintColoredS
+  , printColoredS
+  , showColored
+  , showColoredA
+  , showColoredS
+) where
+
+import Data.Monoid.Colorful.Nested
diff --git a/src/Data/Monoid/Colorful/Color.hs b/src/Data/Monoid/Colorful/Color.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Colorful/Color.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Data.Monoid.Colorful.Color (
+  Color(..)
+  , Style(..)
+  , reduceColor
+) where
+
+import Data.Word (Word8)
+import Data.Bool (bool)
+import Data.Monoid.Colorful.Term
+import GHC.Generics (Generic)
+
+-- | Rendering style
+data Style
+  = Bold     -- ^ Bold font
+  | Italic   -- ^ Italic font
+  | Under    -- ^ Underlined text
+  | Invert   -- ^ Invert foreground and background color
+  | Blink    -- ^ Blinking
+  deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic)
+
+-- | Named colors, 256 and RGB colors for more capable terminals.
+data Color
+  = DefaultColor                  -- ^ Default terminal color (terminal specific)
+  | Black
+  | Red
+  | Green
+  | Yellow
+  | Blue
+  | Magenta
+  | Cyan
+  | White
+  | DullBlack
+  | DullRed
+  | DullGreen
+  | DullYellow
+  | DullBlue
+  | DullMagenta
+  | DullCyan
+  | DullWhite
+  | Color256 !Word8               -- ^ Color from 256 color scheme. Color is automatically reduced to 8 colors for less capable terminals.
+  | RGB      !Word8 !Word8 !Word8 -- ^ True color. Color is automatically reduced to 256 or 8 colors for less capable terminals.
+  deriving (Eq, Ord, Show, Read, Generic)
+
+reduceColor :: Term -> Color -> Color
+reduceColor Term8    = reduceColor8
+reduceColor Term256  = reduceColor256
+reduceColor _        = id
+
+rgbToWord8 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8
+rgbToWord8 base q r g b = base * (base * (r `div` q) + (g `div` q)) + (b `div` q)
+
+gray24ToANSI :: Word8 -> Color
+gray24ToANSI x
+  | x < 6             = DullBlack
+  | x >= 6 && x < 12  = Black
+  | x >= 12 && x < 18 = DullWhite
+  | otherwise         = White
+
+color216ToANSI :: Word8 -> Color
+color216ToANSI x = rgbToANSI 3 r g b
+  where (r,gb) = divMod x 36
+        (g,b)  = divMod gb 6
+
+color16ToANSI :: Word8 -> Color
+color16ToANSI 0  = DullBlack
+color16ToANSI 1  = DullRed
+color16ToANSI 2  = DullGreen
+color16ToANSI 3  = DullYellow
+color16ToANSI 4  = DullBlue
+color16ToANSI 5  = DullMagenta
+color16ToANSI 6  = DullCyan
+color16ToANSI 7  = DullWhite
+color16ToANSI 8  = Black
+color16ToANSI 9  = Red
+color16ToANSI 10 = Green
+color16ToANSI 11 = Yellow
+color16ToANSI 12 = Blue
+color16ToANSI 13 = Magenta
+color16ToANSI 14 = Cyan
+color16ToANSI _  = White
+
+squareNorm :: Integral a => a -> a -> a -> a
+squareNorm r g b = ri*ri + bi*bi * gi*gi
+  where ri = fromIntegral r
+        gi = fromIntegral g
+        bi = fromIntegral b
+
+rgbToANSI :: Word8 -> Word8 -> Word8 -> Word8 -> Color
+rgbToANSI q r g b = color16ToANSI $ bool 0 8 (squareNorm r g b >= squareNorm q q q) + rgbToWord8 2 q b g r
+
+reduceColor8 :: Color -> Color
+reduceColor8 (Color256 x)
+  | x < 16    = color16ToANSI x
+  | x < 232   = color216ToANSI $ x - 16
+  | otherwise = gray24ToANSI $ x - 232
+reduceColor8 (RGB r g b) = rgbToANSI 128 r g b
+reduceColor8 x = x
+
+reduceColor256 :: Color -> Color
+reduceColor256 (RGB r g b)
+  | r == g && r == b = Color256 $ 232 + r `div` 11
+  | otherwise = Color256 $ 16 + rgbToWord8 6 43 r g b
+reduceColor256 x = x
diff --git a/src/Data/Monoid/Colorful/Flat.hs b/src/Data/Monoid/Colorful/Flat.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Colorful/Flat.hs
@@ -0,0 +1,97 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Monoid.Colorful.Flat
+-- Copyright   :  Daniel Mendler (c) 2017,
+-- License     :  MIT (see the file LICENSE)
+--
+-- Maintainer  :  mail@daniel-mendler.de
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This module provides the flat 'Colored' type,
+-- which is used internally for rendering the
+-- nested 'Data.Monoid.Colorful.Colored' but is
+-- also useful on its own. The API resembles
+-- the API of 'Data.Monoid.Colorful'.
+--
+-----------------------------------------------------------
+
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Data.Monoid.Colorful.Flat (
+  Style(..)
+  , Color(..)
+  , Term(..)
+  , Colored(..)
+  , hGetTerm
+  , getTerm
+  , hPrintColored
+  , printColored
+  , hPrintColoredIO
+  , printColoredIO
+  , hPrintColoredS
+  , printColoredS
+  , showColored
+  , showColoredA
+  , showColoredS
+) where
+
+import System.IO (Handle, stdout, hPutStr)
+import Data.Monoid.Colorful.Term
+import Data.Monoid.Colorful.Settings
+import Data.Monoid.Colorful.Color
+import Data.Monoid.Colorful.SGR
+import Data.Functor.Identity
+import Data.Bifunctor (first, second)
+import GHC.Generics (Generic, Generic1)
+
+data Colored a
+  = Value a
+  | Style   !Style
+  | Unstyle !Style
+  | Fg      !Color
+  | Bg      !Color
+  | Push
+  | Pop
+  | Reset
+  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic, Generic1)
+
+hPrintColoredIO :: Handle -> Term -> [Colored (IO ())] -> IO ()
+hPrintColoredIO h = showColoredA 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)
+
+printColored :: (a -> IO ()) -> Term -> [Colored a] -> IO ()
+printColored f = hPrintColored (const f) stdout
+
+hPrintColoredS :: Handle -> Term -> [Colored String] -> IO ()
+hPrintColoredS h = showColoredA (hPutStr h) (hPutStr h)
+
+printColoredS :: Term -> [Colored String] -> IO ()
+printColoredS = hPrintColoredS stdout
+
+showColoredS :: Term -> [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
+
+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)
diff --git a/src/Data/Monoid/Colorful/Nested.hs b/src/Data/Monoid/Colorful/Nested.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Colorful/Nested.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Data.Monoid.Colorful.Nested (
+  Style(..)
+  , Color(..)
+  , Term(..)
+  , Colored(..)
+  , hGetTerm
+  , getTerm
+  , hPrintColored
+  , printColored
+  , hPrintColoredIO
+  , printColoredIO
+  , hPrintColoredS
+  , printColoredS
+  , showColored
+  , showColoredA
+  , showColoredS
+) where
+
+import System.IO (Handle)
+import Data.Monoid.Colorful.Term
+import Data.Monoid.Colorful.Color
+import Data.Monoid.Colorful.SGR
+import Data.Monoid.Colorful.Trustworthy
+import Data.String (IsString(..))
+import Data.Semigroup (Semigroup)
+import GHC.Generics (Generic, Generic1)
+import qualified Data.Monoid.Colorful.Flat as Flat
+import Control.Monad (ap)
+
+data Colored a
+  = Nil
+  | Value a
+  | Style   !Style (Colored a)
+  | Unstyle !Style (Colored a)
+  | Fg      !Color (Colored a)
+  | Bg      !Color (Colored a)
+  | Pair    (Colored a) (Colored a)
+  deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable, Generic, Generic1)
+
+instance Applicative Colored where
+  pure = Value
+  (<*>) = ap
+
+instance Monad Colored where
+  Nil         >>= _ = Nil
+  Value     x >>= f = f x
+  Style   a x >>= f = Style   a (x >>= f)
+  Unstyle a x >>= f = Unstyle a (x >>= f)
+  Fg      a x >>= f = Fg      a (x >>= f)
+  Bg      a x >>= f = Bg      a (x >>= f)
+  Pair    x y >>= f = Pair      (x >>= f) (y >>= f)
+
+instance Semigroup (Colored a)
+instance Monoid (Colored a) where
+  mempty = Nil
+  mappend = Pair
+
+instance IsString a => IsString (Colored a) where
+  fromString = Value . fromString
+
+instance IsList (Colored a) where
+  type Item (Colored a) = Colored a
+  fromList = foldr Pair Nil
+  toList   = (:[]) -- TODO, invalid
+
+flatten :: Colored a -> [Flat.Colored a]
+flatten s = go s []
+  where go (Value   a)      = (Flat.Value a:)
+        go (Style   a b)    = (Flat.Push:) . (Flat.Style   a:) . go b . (Flat.Pop:)
+        go (Unstyle a b)    = (Flat.Push:) . (Flat.Unstyle a:) . go b . (Flat.Pop:)
+        go (Fg      a b)    = (Flat.Push:) . (Flat.Fg      a:) . go b . (Flat.Pop:)
+        go (Bg      a b)    = (Flat.Push:) . (Flat.Bg      a:) . go b . (Flat.Pop:)
+        go Nil              = id
+        go (Pair    a b)    = go a . go b
+
+hPrintColoredIO :: Handle -> Term -> Colored (IO ()) -> IO ()
+hPrintColoredIO h t = Flat.hPrintColoredIO h t . flatten
+
+printColoredIO :: Term -> Colored (IO ()) -> IO ()
+printColoredIO t = Flat.printColoredIO t . flatten
+
+hPrintColored :: (Handle -> a -> IO ()) -> Handle -> Term -> Colored a -> IO ()
+hPrintColored f h t = Flat.hPrintColored f h t . flatten
+
+printColored :: (a -> IO ()) -> Term -> Colored a -> IO ()
+printColored f t = Flat.printColored f t . flatten
+
+hPrintColoredS :: Handle -> Term -> Colored String -> IO ()
+hPrintColoredS h t = Flat.hPrintColoredS h t . flatten
+
+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
+
+showColored :: Monoid o => (a -> o) -> (SGRCode -> o) -> Term -> Colored a -> o
+showColored f g t = Flat.showColored f g t . flatten
+
+showColoredS :: Term -> Colored String -> ShowS
+showColoredS t = Flat.showColoredS t . flatten
diff --git a/src/Data/Monoid/Colorful/SGR.hs b/src/Data/Monoid/Colorful/SGR.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Colorful/SGR.hs
@@ -0,0 +1,61 @@
+module Data.Monoid.Colorful.SGR (
+  SGRCode,
+  sgrCode
+) where
+
+import Data.Monoid.Colorful.Term
+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
+
+sgrCode :: Term -> Settings -> Settings -> SGRCode
+sgrCode TermDumb _ _ = ""
+sgrCode TermWin  _ _ = ""
+sgrCode t old new
+  | 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
+
+  where
+
+  update :: Eq a => (Settings -> a) -> (a -> [Word8]) -> [Word8]
+  update f g = let new' = f new in bool [] (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)
+
+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
diff --git a/src/Data/Monoid/Colorful/Settings.hs b/src/Data/Monoid/Colorful/Settings.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Colorful/Settings.hs
@@ -0,0 +1,48 @@
+module Data.Monoid.Colorful.Settings (
+  Settings(..)
+  , defaultSettings
+  , setStyle, setBg, setFg
+  , resetStack, pushStack, popStack
+) where
+
+import Data.Monoid.Colorful.Color
+
+data Settings = Settings
+  { styleBold   :: !Bool
+  , styleItalic :: !Bool
+  , styleUnder  :: !Bool
+  , styleInvert :: !Bool
+  , styleBlink  :: !Bool
+  , styleFg     :: !Color
+  , styleBg     :: !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
+  }
+
+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 }
+
+setBg, setFg :: Color -> Settings -> Settings
+setBg c s = s { styleBg = c }
+setFg c s = s { styleFg = c }
+
+resetStack, pushStack, popStack :: SettingsStack -> SettingsStack
+resetStack (_, ys)     = (defaultSettings, ys)
+pushStack  (y, ys)     = (y, y:ys)
+popStack   (_, [])     = (defaultSettings, [])
+popStack   (_, z : zs) = (z, zs)
diff --git a/src/Data/Monoid/Colorful/Term.hs b/src/Data/Monoid/Colorful/Term.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Colorful/Term.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Data.Monoid.Colorful.Term (
+  Term(..)
+  , getTerm
+  , hGetTerm
+) where
+
+import Data.List (isPrefixOf, isInfixOf)
+import System.Environment (getEnv)
+import System.IO (Handle, hIsTerminalDevice, stdout)
+import GHC.Generics (Generic)
+
+-- | Terminal type. For less capable terminals the color depth is automatically reduced.
+data Term
+  = TermDumb -- ^ Dumb terminal - no color output
+  | Term8    -- ^ 8 colors supported
+  | Term256  -- ^ 256 colors supported
+  | TermRGB  -- ^ True colors supported
+  | TermWin  -- ^ Windows terminal. Will use emulation (Not yet implemented).
+  deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic)
+
+getTerm :: IO Term
+getTerm = hGetTerm stdout
+
+-- | The action @(hGetTerm handle)@ determines the terminal type of the file @handle@.
+--
+-- The terminal type is determined by checking if the file handle points to a device
+-- and by looking at the @$TERM@ environment variable.
+hGetTerm :: Handle -> IO Term
+hGetTerm h = do
+  term <- hIsTerminalDevice h
+  if term
+    then envToTerm  <$> getEnv "TERM"
+    else pure TermDumb
+
+-- | Determine the terminal type from the value of the @$TERM@ environment variable.
+-- TODO improve this
+envToTerm :: String -> Term
+envToTerm "dumb" = TermDumb
+envToTerm term | any (`isPrefixOf` term) rgbTerminals = TermRGB
+               | "256" `isInfixOf` term = Term256
+               | otherwise = Term8
+  where rgbTerminals = ["xterm", "konsole", "gnome", "st", "linux"]
diff --git a/src/Data/Monoid/Colorful/Trustworthy.hs b/src/Data/Monoid/Colorful/Trustworthy.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Colorful/Trustworthy.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE Trustworthy #-}
+
+module Data.Monoid.Colorful.Trustworthy (
+  IsList(..)
+) where
+
+import GHC.Exts (IsList(..))