diff --git a/Distribution/PackageDescription.hs b/Distribution/PackageDescription.hs
index a470c080eba97e65bf977cd6a2238d992c951c4e..0fbf646f42b7381c82d2c3e2c7e4e794511a4651 100644
--- a/Distribution/PackageDescription.hs
+++ b/Distribution/PackageDescription.hs
@@ -84,7 +84,7 @@ import Distribution.Package
 import Distribution.Version  (Version(Version), VersionRange(AnyVersion))
 import Distribution.License  (License(AllRightsReserved))
 import Distribution.Compiler (CompilerFlavor, showCompilerFlavor)
-import Distribution.System   (OS, showOS, Arch, showArch)
+import Distribution.System   (OS, Arch)
 import Distribution.Text
          ( display )
 import Distribution.Simple.Utils  (currentDir)
@@ -466,8 +466,8 @@ data ConfVar = OS OS
                deriving Eq
 
 instance Show ConfVar where
-    show (OS os) = "os(" ++ showOS os ++ ")"
-    show (Arch arch) = "arch(" ++ showArch arch ++ ")"
+    show (OS os) = "os(" ++ display os ++ ")"
+    show (Arch arch) = "arch(" ++ display arch ++ ")"
     show (Flag (ConfFlag f)) = "flag(" ++ f ++ ")"
     show (Impl c v) = "impl(" ++ showCompilerFlavor c
                        ++ " " ++ display v ++ ")"
diff --git a/Distribution/PackageDescription/Configuration.hs b/Distribution/PackageDescription/Configuration.hs
index b2b32a76c6728b48fa23d2616eeb046958bd818a..030ebf78d35a41c0131f7c045e7d50f43686d8d1 100644
--- a/Distribution/PackageDescription/Configuration.hs
+++ b/Distribution/PackageDescription/Configuration.hs
@@ -59,7 +59,7 @@ import Distribution.Version
          ( Version(..), VersionRange(..), withinRange )
 import Distribution.Compiler (CompilerFlavor, readCompilerFlavor)
 import Distribution.System
-         ( OS, readOS, Arch, readArch )
+         ( OS, Arch )
 import Distribution.Simple.Utils (currentDir)
 
 import Distribution.Text
@@ -149,15 +149,15 @@ parseCondition = condOr
                       +++ archCond +++ flagCond +++ implCond )
     inparens   = between (ReadP.char '(' >> sp) (sp >> ReadP.char ')' >> sp)
     notCond  = ReadP.char '!' >> sp >> cond >>= return . CNot
-    osCond   = string "os" >> sp >> inparens osIdent >>= return . Var . OS . readOS
-    archCond = string "arch" >> sp >> inparens archIdent >>= return . Var . Arch . readArch
+    osCond   = string "os" >> sp >> inparens osIdent >>= return . Var
+    archCond = string "arch" >> sp >> inparens archIdent >>= return . Var
     flagCond = string "flag" >> sp >> inparens flagIdent >>= return . Var . Flag . ConfFlag
     implCond = string "impl" >> sp >> inparens implIdent >>= return . Var
     ident    = munch1 isIdentChar >>= return . map toLower
     lit      = ((string "true" <++ string "True") >> return (Lit True)) <++ 
                ((string "false" <++ string "False") >> return (Lit False))
-    archIdent     = ident >>= return 
-    osIdent       = ident >>= return 
+    archIdent     = fmap Arch parse
+    osIdent       = fmap OS   parse
     flagIdent     = ident
     isIdentChar c = isAlphaNum c || (c `elem` "_-")
     oper s        = sp >> string s >> sp
diff --git a/Distribution/System.hs b/Distribution/System.hs
index f3bbd2a94d4ba2e5073936006986aa290d46ff58..6ffeeb145bb204df32899f20355b23e99ecc21fa 100644
--- a/Distribution/System.hs
+++ b/Distribution/System.hs
@@ -1,19 +1,19 @@
 module Distribution.System (
   -- * Operating System
   OS(..),
-  showOS,
-  readOS,
   buildOS,
 
   -- * Machine Architecture
   Arch(..),
-  showArch,
-  readArch,
   buildArch,
   ) where
 
 import qualified System.Info (os, arch)
-import qualified Data.Char as Char (toLower)
+import qualified Data.Char as Char (toLower, isAlphaNum)
+
+import Distribution.Text (Text(..), display)
+import qualified Distribution.Compat.ReadP as Parse
+import qualified Text.PrettyPrint as Disp
 
 -- ------------------------------------------------------------
 -- * Operating System
@@ -37,22 +37,25 @@ osAliases FreeBSD     = ["kfreebsdgnu"]
 osAliases Solaris     = ["solaris2"]
 osAliases _           = []
 
-showOS :: OS -> String
-showOS (OtherOS name) = name
-showOS other          = lowercase (show other)
+instance Text OS where
+  disp (OtherOS name) = Disp.text name
+  disp other          = Disp.text (lowercase (show other))
+
+  parse = fmap classifyOS (Parse.munch1 Char.isAlphaNum)
+  --TODO: probably should disallow starting with a number
 
-readOS :: String -> OS
-readOS s =
+classifyOS :: String -> OS
+classifyOS s =
   case lookup (lowercase s) osMap of
     Just os -> os
     Nothing -> OtherOS (lowercase s)
   where
     osMap = [ (name, os)
             | os <- knownOSs
-            , name <- showOS os : osAliases os ]
+            , name <- display os : osAliases os ]
 
 buildOS :: OS
-buildOS = readOS System.Info.os
+buildOS = classifyOS System.Info.os
 
 -- ------------------------------------------------------------
 -- * Machine Architecture
@@ -81,22 +84,25 @@ archAliases Mips  = ["mipsel", "mipseb"]
 archAliases Arm   = ["armeb", "armel"]
 archAliases _     = []
 
-showArch :: Arch -> String
-showArch (OtherArch name) = name
-showArch other            = lowercase (show other)
+instance Text Arch where
+  disp (OtherArch name) = Disp.text name
+  disp other            = Disp.text (lowercase (show other))
+
+  parse = fmap classifyArch (Parse.munch1 Char.isAlphaNum)
+  --TODO: probably should disallow starting with a number
 
-readArch :: String -> Arch
-readArch s =
+classifyArch :: String -> Arch
+classifyArch s =
   case lookup (lowercase s) archMap of
     Just arch -> arch
     Nothing   -> OtherArch (lowercase s)
   where
     archMap = [ (name, arch)
               | arch <- knownArches
-              , name <- showArch arch : archAliases arch ]
+              , name <- display arch : archAliases arch ]
 
 buildArch :: Arch
-buildArch = readArch System.Info.arch
+buildArch = classifyArch System.Info.arch
 
 lowercase :: String -> String
 lowercase = map Char.toLower