diff --git a/Data/String/UTF8.hs b/Data/String/UTF8.hs
index 281076a3c3f552f74f3b35ddc0236fd59bdb10ce..fe1589fce9ee262c1656039bcf5ae53fae88ed7f 100644
--- a/Data/String/UTF8.hs
+++ b/Data/String/UTF8.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# OPTIONS_GHC -fallow-undecidable-instances #-}
+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}
 module Data.String.UTF8
   ( -- * Representation
     UTF8
diff --git a/System/Environment/UTF8.hs b/System/Environment/UTF8.hs
new file mode 100644
index 0000000000000000000000000000000000000000..fe838e81ed3fe5d67bf6372f4152c1f1023a5829
--- /dev/null
+++ b/System/Environment/UTF8.hs
@@ -0,0 +1,25 @@
+module System.Environment.UTF8
+  (getArgs, getProgName, getEnv, withArgs, withProgName, getEnvironment)
+  where
+
+import Codec.Binary.UTF8.String (decodeString)
+import qualified System.Environment as Sys
+
+getArgs :: IO [String]
+getArgs = map decodeString `fmap` Sys.getArgs
+
+getProgName :: IO String
+getProgName = decodeString `fmap` Sys.getProgName
+
+getEnv :: String -> IO String
+getEnv x = decodeString `fmap` Sys.getEnv x
+
+withArgs :: [String] -> IO a -> IO a
+withArgs = Sys.withArgs
+
+withProgName :: String -> IO a -> IO a
+withProgName = Sys.withProgName
+
+getEnvironment :: IO [(String,String)]
+getEnvironment = map f `fmap` Sys.getEnvironment
+  where f (a,b) = (decodeString a, decodeString b)
diff --git a/utf8-string.cabal b/utf8-string.cabal
index 0585cf35bb0503c18f91d0c3f6c7b275cb0d01ad..c050bb0a2d9fc04fc1c2c8eae3ae93aa7861231d 100644
--- a/utf8-string.cabal
+++ b/utf8-string.cabal
@@ -1,5 +1,5 @@
 Name:               utf8-string
-Version:            0.3.4
+Version:            0.3.5
 Author:             Eric Mertens
 Maintainer:         emertens@galois.com
 License:            BSD3
@@ -29,6 +29,7 @@ library
   Exposed-modules:    Codec.Binary.UTF8.String
                       Codec.Binary.UTF8.Generic
                       System.IO.UTF8
+                      System.Environment.UTF8
                       Data.String.UTF8
                       Data.ByteString.UTF8
                       Data.ByteString.Lazy.UTF8