{-# LANGUAGE TypeSynonymInstances #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Data.String.ToString
-- Copyright   :  (c) 2009 Bas van Dijk
-- License     :  BSD3 (see the file LICENSE)
-- Maintainer  :  v.dijk.bas@gmail.com
-- Stability   :  Stable
--
--------------------------------------------------------------------------------

module Data.String.ToString
    ( ToString
    , toString
    , fromToString
    , prop_fromToString
    )
    where

import Data.String (IsString, fromString)

-- | Class of string-like types that can be converted to 'String's.
--
-- Ensure that types that have an instance for this class and also have an
-- instance for 'IsString' obey the 'prop_fromToString' law.
class ToString s where
    -- | Convert a string-like type to a 'String'.
    toString :: s -> String

instance ToString String where
    toString = id

instance ToString Char where
    toString = (: [])

instance ToString ShowS where
    toString = ($ [])

-- | General coercion between string-like types.
--
-- Note that: @fromToString = 'fromString' . 'toString'@
fromToString :: (IsString s2, ToString s1) => s1 -> s2
fromToString = fromString . toString

-- | @prop_fromToString x = 'fromToString' x == x@
prop_fromToString :: (IsString s, ToString s, Eq s) => s -> Bool
prop_fromToString x = fromToString x == x