diff --git a/Data/String/UTF8.hs b/Data/String/UTF8.hs
index a7a24f0561f3356ef85765b62d3de9f8b5708eed..c67aae00a8f26e59d55f23304f86452d675468e5 100644
--- a/Data/String/UTF8.hs
+++ b/Data/String/UTF8.hs
@@ -48,6 +48,7 @@ import Prelude hiding (null,take,drop,span,break
                       ,foldl,foldr,length,lines,splitAt)
 import qualified Codec.Binary.UTF8.Generic as G
 import Codec.Binary.UTF8.Generic (UTF8Bytes)
+import qualified Data.String as S
 
 -- | The type of strings that are represented using the UTF8 encoding.
 -- The parameter is the type of the container for the representation.
@@ -56,6 +57,9 @@ newtype UTF8 string = Str string deriving (Eq,Ord)   -- XXX: Is this OK?
 instance UTF8Bytes string index => Show (UTF8 string) where
   show x = show (toString x)
 
+instance UTF8Bytes string index => S.IsString (UTF8 string) where
+  fromString = fromString
+
 fromRep :: string -> UTF8 string
 fromRep = Str