Testsuite: delete Windows line endings [skip ci] (#11631)

12 files changed, 1021 insertions, 1021 deletions

diff --git a/testsuite/tests/typecheck/should_run/T1735.hs b/testsuite/tests/typecheck/should_run/T1735.hs
index a8d453c39f..8a23c9effe 100644
--- a/testsuite/tests/typecheck/should_run/T1735.hs
+++ b/testsuite/tests/typecheck/should_run/T1735.hs
@@ -1,61 +1,61 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables,

-             ScopedTypeVariables, GADTs, RankNTypes, FlexibleContexts,

-             MultiParamTypeClasses, GeneralizedNewtypeDeriving,

-             DeriveDataTypeable,

-             OverlappingInstances, UndecidableInstances, CPP #-}

-

-module Main (main) where

-

-import T1735_Help.Basics

-import T1735_Help.Xml

-

-data YesNo = Yes | No

-    deriving (Eq, Show, Typeable)

-instance Sat (ctx YesNo) => Data ctx YesNo where

-    toConstr _ Yes = yesConstr

-    toConstr _ No  = noConstr

-    gunfold _ _ z c  = case constrIndex c of

-                           1 -> z Yes

-                           2 -> z No

-                           _ -> error "Foo"

-    dataTypeOf _ _ = yesNoDataType

-yesConstr :: Constr

-yesConstr = mkConstr yesNoDataType "Yes" [] Prefix

-noConstr :: Constr

-noConstr = mkConstr yesNoDataType "No" [] Prefix

-yesNoDataType :: DataType

-yesNoDataType = mkDataType "YesNo" [yesConstr, noConstr]

-

-newtype MyList a = MkMyList { unMyList :: [a] }

-    deriving (Show, Eq, Typeable)

-instance (Sat (ctx (MyList a)), Sat (ctx [a]), Data ctx a)

-      => Data ctx (MyList a) where

-    gfoldl _ f z x  = z MkMyList `f` unMyList x

-    toConstr _ (MkMyList _) = mkMyListConstr

-    gunfold _ k z c  = case constrIndex c of

-                           1 -> k (z MkMyList)

-                           _ -> error "Foo"

-    dataTypeOf _ _ = myListDataType

-mkMyListConstr :: Constr

-mkMyListConstr = mkConstr myListDataType "MkMyList" [] Prefix

-myListDataType :: DataType

-myListDataType = mkDataType "MyList" [mkMyListConstr]

-

-#ifdef FOO

-rigidTests :: Maybe (Maybe [YesNo])

-rigidTests =

- mkTest [Elem "No"  []] (Just [No])

-#endif

-

-rigidManualTests :: Maybe (Maybe (MyList YesNo))

-rigidManualTests =

- mkTest [Elem "MkMyList" [Elem "Yes" []]] (Just (MkMyList [Yes]))

-

-mkTest :: (Eq a, Xml a) => [Element] -> Maybe a -> Maybe (Maybe a)

-mkTest es v = case fromXml es of

-                  v' | v == v'   -> Nothing

-                     | otherwise -> Just v'

-

-main :: IO ()

-main = print rigidManualTests

-

+{-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables,
+             ScopedTypeVariables, GADTs, RankNTypes, FlexibleContexts,
+             MultiParamTypeClasses, GeneralizedNewtypeDeriving,
+             DeriveDataTypeable,
+             OverlappingInstances, UndecidableInstances, CPP #-}
+
+module Main (main) where
+
+import T1735_Help.Basics
+import T1735_Help.Xml
+
+data YesNo = Yes | No
+    deriving (Eq, Show, Typeable)
+instance Sat (ctx YesNo) => Data ctx YesNo where
+    toConstr _ Yes = yesConstr
+    toConstr _ No  = noConstr
+    gunfold _ _ z c  = case constrIndex c of
+                           1 -> z Yes
+                           2 -> z No
+                           _ -> error "Foo"
+    dataTypeOf _ _ = yesNoDataType
+yesConstr :: Constr
+yesConstr = mkConstr yesNoDataType "Yes" [] Prefix
+noConstr :: Constr
+noConstr = mkConstr yesNoDataType "No" [] Prefix
+yesNoDataType :: DataType
+yesNoDataType = mkDataType "YesNo" [yesConstr, noConstr]
+
+newtype MyList a = MkMyList { unMyList :: [a] }
+    deriving (Show, Eq, Typeable)
+instance (Sat (ctx (MyList a)), Sat (ctx [a]), Data ctx a)
+      => Data ctx (MyList a) where
+    gfoldl _ f z x  = z MkMyList `f` unMyList x
+    toConstr _ (MkMyList _) = mkMyListConstr
+    gunfold _ k z c  = case constrIndex c of
+                           1 -> k (z MkMyList)
+                           _ -> error "Foo"
+    dataTypeOf _ _ = myListDataType
+mkMyListConstr :: Constr
+mkMyListConstr = mkConstr myListDataType "MkMyList" [] Prefix
+myListDataType :: DataType
+myListDataType = mkDataType "MyList" [mkMyListConstr]
+
+#ifdef FOO
+rigidTests :: Maybe (Maybe [YesNo])
+rigidTests =
+ mkTest [Elem "No"  []] (Just [No])
+#endif
+
+rigidManualTests :: Maybe (Maybe (MyList YesNo))
+rigidManualTests =
+ mkTest [Elem "MkMyList" [Elem "Yes" []]] (Just (MkMyList [Yes]))
+
+mkTest :: (Eq a, Xml a) => [Element] -> Maybe a -> Maybe (Maybe a)
+mkTest es v = case fromXml es of
+                  v' | v == v'   -> Nothing
+                     | otherwise -> Just v'
+
+main :: IO ()
+main = print rigidManualTests
+
diff --git a/testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs b/testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs
index d444db7058..62dac4366b 100644
--- a/testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs
+++ b/testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs
@@ -1,487 +1,487 @@
-{-# LANGUAGE UndecidableInstances, OverlappingInstances, Rank2Types,

-    KindSignatures, EmptyDataDecls, MultiParamTypeClasses, CPP #-}

-

-{-

-

-(C) 2004--2005 Ralf Laemmel, Simon D. Foster

-

-This module approximates Data.Generics.Basics.

-

--}

-

-

-module T1735_Help.Basics (

-

- module Data.Typeable,

- module T1735_Help.Context,

- module T1735_Help.Basics

-

-) where

-

-import Data.Typeable

-import T1735_Help.Context

-

-

-------------------------------------------------------------------------------

--- The ingenious Data class

-

-class (Typeable a, Sat (ctx a)) => Data ctx a

-

-   where

-

-     gfoldl :: Proxy ctx

-            -> (forall b c. Data ctx b => w (b -> c) -> b -> w c)

-            -> (forall g. g -> w g)

-            -> a -> w a

-

-     -- Default definition for gfoldl

-     -- which copes immediately with basic datatypes

-     --

-     gfoldl _ _ z = z

-

-     gunfold :: Proxy ctx

-             -> (forall b r. Data ctx b => c (b -> r) -> c r)

-             -> (forall r. r -> c r)

-             -> Constr

-             -> c a

-

-     toConstr :: Proxy ctx -> a -> Constr

-

-     dataTypeOf :: Proxy ctx -> a -> DataType

-

-     -- incomplete implementation

-

-     gunfold _ _ _ _ = undefined

-

-     dataTypeOf _ _ = undefined

-

-     -- | Mediate types and unary type constructors

-     dataCast1 :: Typeable t

-               => Proxy ctx

-               -> (forall b. Data ctx b => w (t b))

-               -> Maybe (w a)

-     dataCast1 _ _ = Nothing

-

-     -- | Mediate types and binary type constructors

-     dataCast2 :: Typeable t

-               => Proxy ctx

-               -> (forall b c. (Data ctx b, Data ctx c) => w (t b c))

-               -> Maybe (w a)

-     dataCast2 _ _ = Nothing

-

-

-

-------------------------------------------------------------------------------

-

--- Generic transformations

-

-type GenericT ctx = forall a. Data ctx a => a -> a

-

-

--- Generic map for transformations

-

-gmapT :: Proxy ctx -> GenericT ctx -> GenericT ctx

-

-gmapT ctx f x = unID (gfoldl ctx k ID x)

-  where

-    k (ID g) y = ID (g (f y))

-

-

--- The identity type constructor

-

-newtype ID x = ID { unID :: x }

-

-

-------------------------------------------------------------------------------

-

--- Generic monadic transformations

-

-type GenericM m ctx = forall a. Data ctx a => a -> m a

-

--- Generic map for monadic transformations

-

-gmapM :: Monad m => Proxy ctx -> GenericM m ctx -> GenericM m ctx

-gmapM ctx f = gfoldl ctx k return

-    where k c x = do c' <- c

-                     x' <- f x

-                     return (c' x')

-

-

-------------------------------------------------------------------------------

-

--- Generic queries

-

-type GenericQ ctx r = forall a. Data ctx a => a -> r

-

-

--- Map for queries

-

-gmapQ :: Proxy ctx -> GenericQ ctx r -> GenericQ ctx [r]

-gmapQ ctx f = gmapQr ctx (:) [] f

-

-gmapQr :: Data ctx a

-       => Proxy ctx

-       -> (r' -> r -> r)

-       -> r

-       -> GenericQ ctx r'

-       -> a

-       -> r

-gmapQr ctx o r f x = unQr (gfoldl ctx k (const (Qr id)) x) r

-  where

-    k (Qr g) y = Qr (\s -> g (f y `o` s))

-

--- The type constructor used in definition of gmapQr

-newtype Qr r a = Qr { unQr  :: r -> r }

-

-

-

-------------------------------------------------------------------------------

---

--- Generic unfolding

---

-------------------------------------------------------------------------------

-

-

-

--- | Build a term skeleton

-fromConstr :: Data ctx a => Proxy ctx -> Constr -> a

-fromConstr ctx = fromConstrB ctx undefined

-

--- | Build a term and use a generic function for subterms

-fromConstrB :: Data ctx a

-            => Proxy ctx

-            -> (forall b. Data ctx b => b)

-            -> Constr

-            -> a

-fromConstrB ctx f = unID . gunfold ctx k z

- where

-  k c = ID (unID c f)

-  z = ID

-

-

-

--- | Monadic variation on \"fromConstrB\"

-fromConstrM :: (Monad m, Data ctx a)

-            => Proxy ctx

-            -> (forall b. Data ctx b => m b)

-            -> Constr

-            -> m a

-fromConstrM ctx f = gunfold ctx k z

- where

-  k c = do { c' <- c; b <- f; return (c' b) }

-  z = return

-

-

-

-------------------------------------------------------------------------------

---

--- Datatype and constructor representations

---

-------------------------------------------------------------------------------

-

-

---

--- | Representation of datatypes.

--- | A package of constructor representations with names of type and module.

--- | The list of constructors could be an array, a balanced tree, or others.

---

-data DataType = DataType

-                        { tycon   :: String

-                        , datarep :: DataRep

-                        }

-

-              deriving Show

-

-

--- | Representation of constructors

-data Constr = Constr

-                        { conrep    :: ConstrRep

-                        , constring :: String

-                        , confields :: [String] -- for AlgRep only

-                        , confixity :: Fixity   -- for AlgRep only

-                        , datatype  :: DataType

-                        }

-

-instance Show Constr where

- show = constring

-

-

--- | Equality of constructors

-instance Eq Constr where

-  c == c' = constrRep c == constrRep c'

-

-

--- | Public representation of datatypes

-data DataRep = AlgRep [Constr]

-             | IntRep

-             | FloatRep

-             | StringRep

-             | NoRep

-

-            deriving (Eq,Show)

-

-

--- | Public representation of constructors

-data ConstrRep = AlgConstr    ConIndex

-               | IntConstr    Integer

-               | FloatConstr  Double

-               | StringConstr String

-

-               deriving (Eq,Show)

-

-

---

--- | Unique index for datatype constructors.

--- | Textual order is respected. Starts at 1.

---

-type ConIndex = Int

-

-

--- | Fixity of constructors

-data Fixity = Prefix

-            | Infix  -- Later: add associativity and precedence

-

-            deriving (Eq,Show)

-

-

-------------------------------------------------------------------------------

---

--- Observers for datatype representations

---

-------------------------------------------------------------------------------

-

-

--- | Gets the type constructor including the module

-dataTypeName :: DataType -> String

-dataTypeName = tycon

-

-

-

--- | Gets the public presentation of datatypes

-dataTypeRep :: DataType -> DataRep

-dataTypeRep = datarep

-

-

--- | Gets the datatype of a constructor

-constrType :: Constr -> DataType

-constrType = datatype

-

-

--- | Gets the public presentation of constructors

-constrRep :: Constr -> ConstrRep

-constrRep = conrep

-

-

--- | Look up a constructor by its representation

-repConstr :: DataType -> ConstrRep -> Constr

-repConstr dt cr =

-      case (dataTypeRep dt, cr) of

-        (AlgRep cs, AlgConstr i)      -> cs !! (i-1)

-        (IntRep,    IntConstr i)      -> mkIntConstr dt i

-        (FloatRep,  FloatConstr f)    -> mkFloatConstr dt f

-        (StringRep, StringConstr str) -> mkStringConstr dt str

-        _ -> error "repConstr"

-

-

-

-------------------------------------------------------------------------------

---

--- Representations of algebraic data types

---

-------------------------------------------------------------------------------

-

-

--- | Constructs an algebraic datatype

-mkDataType :: String -> [Constr] -> DataType

-mkDataType str cs = DataType

-                        { tycon   = str

-                        , datarep = AlgRep cs

-                        }

-

-

--- | Constructs a constructor

-mkConstr :: DataType -> String -> [String] -> Fixity -> Constr

-mkConstr dt str fields fix =

-        Constr

-                { conrep    = AlgConstr idx

-                , constring = str

-                , confields = fields

-                , confixity = fix

-                , datatype  = dt

-                }

-  where

-    idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],

-                     showConstr c == str ]

-

-

--- | Gets the constructors

-dataTypeConstrs :: DataType -> [Constr]

-dataTypeConstrs dt = case datarep dt of

-                        (AlgRep cons) -> cons

-                        _ -> error "dataTypeConstrs"

-

-

--- | Gets the field labels of a constructor

-constrFields :: Constr -> [String]

-constrFields = confields

-

-

--- | Gets the fixity of a constructor

-constrFixity :: Constr -> Fixity

-constrFixity = confixity

-

-

-

-------------------------------------------------------------------------------

---

--- From strings to constr's and vice versa: all data types

---

-------------------------------------------------------------------------------

-

-

--- | Gets the string for a constructor

-showConstr :: Constr -> String

-showConstr = constring

-

-

--- | Lookup a constructor via a string

-readConstr :: DataType -> String -> Maybe Constr

-readConstr dt str =

-      case dataTypeRep dt of

-        AlgRep cons -> idx cons

-        IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))

-        FloatRep    -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))

-        StringRep   -> Just (mkStringConstr dt str)

-        NoRep       -> Nothing

-  where

-

-    -- Read a value and build a constructor

-    mkReadCon :: Read t => (t -> Constr) -> Maybe Constr

-    mkReadCon f = case (reads str) of

-                    [(t,"")] -> Just (f t)

-                    _ -> Nothing

-

-    -- Traverse list of algebraic datatype constructors

-    idx :: [Constr] -> Maybe Constr

-    idx cons = let fit = filter ((==) str . showConstr) cons

-                in if fit == []

-                     then Nothing

-                     else Just (head fit)

-

-

-------------------------------------------------------------------------------

---

--- Convenience funtions: algebraic data types

---

-------------------------------------------------------------------------------

-

-

--- | Test for an algebraic type

-isAlgType :: DataType -> Bool

-isAlgType dt = case datarep dt of

-                 (AlgRep _) -> True

-                 _ -> False

-

-

--- | Gets the constructor for an index

-indexConstr :: DataType -> ConIndex -> Constr

-indexConstr dt idx = case datarep dt of

-                        (AlgRep cs) -> cs !! (idx-1)

-                        _           -> error "indexConstr"

-

-

--- | Gets the index of a constructor

-constrIndex :: Constr -> ConIndex

-constrIndex con = case constrRep con of

-                    (AlgConstr idx) -> idx

-                    _ -> error "constrIndex"

-

-

--- | Gets the maximum constructor index

-maxConstrIndex :: DataType -> ConIndex

-maxConstrIndex dt = case dataTypeRep dt of

-                        AlgRep cs -> length cs

-                        _         -> error "maxConstrIndex"

-

-

-

-------------------------------------------------------------------------------

---

--- Representation of primitive types

---

-------------------------------------------------------------------------------

-

-

--- | Constructs the Int type

-mkIntType :: String -> DataType

-mkIntType = mkPrimType IntRep

-

-

--- | Constructs the Float type

-mkFloatType :: String -> DataType

-mkFloatType = mkPrimType FloatRep

-

-

--- | Constructs the String type

-mkStringType :: String -> DataType

-mkStringType = mkPrimType StringRep

-

-

--- | Helper for mkIntType, mkFloatType, mkStringType

-mkPrimType :: DataRep -> String -> DataType

-mkPrimType dr str = DataType

-                        { tycon   = str

-                        , datarep = dr

-                        }

-

-

--- Makes a constructor for primitive types

-mkPrimCon :: DataType -> String -> ConstrRep -> Constr

-mkPrimCon dt str cr = Constr

-                        { datatype  = dt

-                        , conrep    = cr

-                        , constring = str

-                        , confields = error $ concat ["constrFields : ", (tycon dt), " is primative"]

-                        , confixity = error "constrFixity"

-                        }

-

-

-mkIntConstr :: DataType -> Integer -> Constr

-mkIntConstr dt i = case datarep dt of

-                  IntRep -> mkPrimCon dt (show i) (IntConstr i)

-                  _ -> error "mkIntConstr"

-

-

-mkFloatConstr :: DataType -> Double -> Constr

-mkFloatConstr dt f = case datarep dt of

-                    FloatRep -> mkPrimCon dt (show f) (FloatConstr f)

-                    _ -> error "mkFloatConstr"

-

-

-mkStringConstr :: DataType -> String -> Constr

-mkStringConstr dt str = case datarep dt of

-                       StringRep -> mkPrimCon dt str (StringConstr str)

-                       _ -> error "mkStringConstr"

-

-

-------------------------------------------------------------------------------

---

--- Non-representations for non-presentable types

---

-------------------------------------------------------------------------------

-

-

--- | Constructs a non-representation

-mkNorepType :: String -> DataType

-mkNorepType str = DataType

-                        { tycon   = str

-                        , datarep = NoRep

-                        }

-

-

--- | Test for a non-representable type

-isNorepType :: DataType -> Bool

-isNorepType dt = case datarep dt of

-                   NoRep -> True

-                   _ -> False

-

+{-# LANGUAGE UndecidableInstances, OverlappingInstances, Rank2Types,
+    KindSignatures, EmptyDataDecls, MultiParamTypeClasses, CPP #-}
+
+{-
+
+(C) 2004--2005 Ralf Laemmel, Simon D. Foster
+
+This module approximates Data.Generics.Basics.
+
+-}
+
+
+module T1735_Help.Basics (
+
+ module Data.Typeable,
+ module T1735_Help.Context,
+ module T1735_Help.Basics
+
+) where
+
+import Data.Typeable
+import T1735_Help.Context
+
+
+------------------------------------------------------------------------------
+-- The ingenious Data class
+
+class (Typeable a, Sat (ctx a)) => Data ctx a
+
+   where
+
+     gfoldl :: Proxy ctx
+            -> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
+            -> (forall g. g -> w g)
+            -> a -> w a
+
+     -- Default definition for gfoldl
+     -- which copes immediately with basic datatypes
+     --
+     gfoldl _ _ z = z
+
+     gunfold :: Proxy ctx
+             -> (forall b r. Data ctx b => c (b -> r) -> c r)
+             -> (forall r. r -> c r)
+             -> Constr
+             -> c a
+
+     toConstr :: Proxy ctx -> a -> Constr
+
+     dataTypeOf :: Proxy ctx -> a -> DataType
+
+     -- incomplete implementation
+
+     gunfold _ _ _ _ = undefined
+
+     dataTypeOf _ _ = undefined
+
+     -- | Mediate types and unary type constructors
+     dataCast1 :: Typeable t
+               => Proxy ctx
+               -> (forall b. Data ctx b => w (t b))
+               -> Maybe (w a)
+     dataCast1 _ _ = Nothing
+
+     -- | Mediate types and binary type constructors
+     dataCast2 :: Typeable t
+               => Proxy ctx
+               -> (forall b c. (Data ctx b, Data ctx c) => w (t b c))
+               -> Maybe (w a)
+     dataCast2 _ _ = Nothing
+
+
+
+------------------------------------------------------------------------------
+
+-- Generic transformations
+
+type GenericT ctx = forall a. Data ctx a => a -> a
+
+
+-- Generic map for transformations
+
+gmapT :: Proxy ctx -> GenericT ctx -> GenericT ctx
+
+gmapT ctx f x = unID (gfoldl ctx k ID x)
+  where
+    k (ID g) y = ID (g (f y))
+
+
+-- The identity type constructor
+
+newtype ID x = ID { unID :: x }
+
+
+------------------------------------------------------------------------------
+
+-- Generic monadic transformations
+
+type GenericM m ctx = forall a. Data ctx a => a -> m a
+
+-- Generic map for monadic transformations
+
+gmapM :: Monad m => Proxy ctx -> GenericM m ctx -> GenericM m ctx
+gmapM ctx f = gfoldl ctx k return
+    where k c x = do c' <- c
+                     x' <- f x
+                     return (c' x')
+
+
+------------------------------------------------------------------------------
+
+-- Generic queries
+
+type GenericQ ctx r = forall a. Data ctx a => a -> r
+
+
+-- Map for queries
+
+gmapQ :: Proxy ctx -> GenericQ ctx r -> GenericQ ctx [r]
+gmapQ ctx f = gmapQr ctx (:) [] f
+
+gmapQr :: Data ctx a
+       => Proxy ctx
+       -> (r' -> r -> r)
+       -> r
+       -> GenericQ ctx r'
+       -> a
+       -> r
+gmapQr ctx o r f x = unQr (gfoldl ctx k (const (Qr id)) x) r
+  where
+    k (Qr g) y = Qr (\s -> g (f y `o` s))
+
+-- The type constructor used in definition of gmapQr
+newtype Qr r a = Qr { unQr  :: r -> r }
+
+
+
+------------------------------------------------------------------------------
+--
+-- Generic unfolding
+--
+------------------------------------------------------------------------------
+
+
+
+-- | Build a term skeleton
+fromConstr :: Data ctx a => Proxy ctx -> Constr -> a
+fromConstr ctx = fromConstrB ctx undefined
+
+-- | Build a term and use a generic function for subterms
+fromConstrB :: Data ctx a
+            => Proxy ctx
+            -> (forall b. Data ctx b => b)
+            -> Constr
+            -> a
+fromConstrB ctx f = unID . gunfold ctx k z
+ where
+  k c = ID (unID c f)
+  z = ID
+
+
+
+-- | Monadic variation on \"fromConstrB\"
+fromConstrM :: (Monad m, Data ctx a)
+            => Proxy ctx
+            -> (forall b. Data ctx b => m b)
+            -> Constr
+            -> m a
+fromConstrM ctx f = gunfold ctx k z
+ where
+  k c = do { c' <- c; b <- f; return (c' b) }
+  z = return
+
+
+
+------------------------------------------------------------------------------
+--
+-- Datatype and constructor representations
+--
+------------------------------------------------------------------------------
+
+
+--
+-- | Representation of datatypes.
+-- | A package of constructor representations with names of type and module.
+-- | The list of constructors could be an array, a balanced tree, or others.
+--
+data DataType = DataType
+                        { tycon   :: String
+                        , datarep :: DataRep
+                        }
+
+              deriving Show
+
+
+-- | Representation of constructors
+data Constr = Constr
+                        { conrep    :: ConstrRep
+                        , constring :: String
+                        , confields :: [String] -- for AlgRep only
+                        , confixity :: Fixity   -- for AlgRep only
+                        , datatype  :: DataType
+                        }
+
+instance Show Constr where
+ show = constring
+
+
+-- | Equality of constructors
+instance Eq Constr where
+  c == c' = constrRep c == constrRep c'
+
+
+-- | Public representation of datatypes
+data DataRep = AlgRep [Constr]
+             | IntRep
+             | FloatRep
+             | StringRep
+             | NoRep
+
+            deriving (Eq,Show)
+
+
+-- | Public representation of constructors
+data ConstrRep = AlgConstr    ConIndex
+               | IntConstr    Integer
+               | FloatConstr  Double
+               | StringConstr String
+
+               deriving (Eq,Show)
+
+
+--
+-- | Unique index for datatype constructors.
+-- | Textual order is respected. Starts at 1.
+--
+type ConIndex = Int
+
+
+-- | Fixity of constructors
+data Fixity = Prefix
+            | Infix  -- Later: add associativity and precedence
+
+            deriving (Eq,Show)
+
+
+------------------------------------------------------------------------------
+--
+-- Observers for datatype representations
+--
+------------------------------------------------------------------------------
+
+
+-- | Gets the type constructor including the module
+dataTypeName :: DataType -> String
+dataTypeName = tycon
+
+
+
+-- | Gets the public presentation of datatypes
+dataTypeRep :: DataType -> DataRep
+dataTypeRep = datarep
+
+
+-- | Gets the datatype of a constructor
+constrType :: Constr -> DataType
+constrType = datatype
+
+
+-- | Gets the public presentation of constructors
+constrRep :: Constr -> ConstrRep
+constrRep = conrep
+
+
+-- | Look up a constructor by its representation
+repConstr :: DataType -> ConstrRep -> Constr
+repConstr dt cr =
+      case (dataTypeRep dt, cr) of
+        (AlgRep cs, AlgConstr i)      -> cs !! (i-1)
+        (IntRep,    IntConstr i)      -> mkIntConstr dt i
+        (FloatRep,  FloatConstr f)    -> mkFloatConstr dt f
+        (StringRep, StringConstr str) -> mkStringConstr dt str
+        _ -> error "repConstr"
+
+
+
+------------------------------------------------------------------------------
+--
+-- Representations of algebraic data types
+--
+------------------------------------------------------------------------------
+
+
+-- | Constructs an algebraic datatype
+mkDataType :: String -> [Constr] -> DataType
+mkDataType str cs = DataType
+                        { tycon   = str
+                        , datarep = AlgRep cs
+                        }
+
+
+-- | Constructs a constructor
+mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
+mkConstr dt str fields fix =
+        Constr
+                { conrep    = AlgConstr idx
+                , constring = str
+                , confields = fields
+                , confixity = fix
+                , datatype  = dt
+                }
+  where
+    idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
+                     showConstr c == str ]
+
+
+-- | Gets the constructors
+dataTypeConstrs :: DataType -> [Constr]
+dataTypeConstrs dt = case datarep dt of
+                        (AlgRep cons) -> cons
+                        _ -> error "dataTypeConstrs"
+
+
+-- | Gets the field labels of a constructor
+constrFields :: Constr -> [String]
+constrFields = confields
+
+
+-- | Gets the fixity of a constructor
+constrFixity :: Constr -> Fixity
+constrFixity = confixity
+
+
+
+------------------------------------------------------------------------------
+--
+-- From strings to constr's and vice versa: all data types
+--
+------------------------------------------------------------------------------
+
+
+-- | Gets the string for a constructor
+showConstr :: Constr -> String
+showConstr = constring
+
+
+-- | Lookup a constructor via a string
+readConstr :: DataType -> String -> Maybe Constr
+readConstr dt str =
+      case dataTypeRep dt of
+        AlgRep cons -> idx cons
+        IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
+        FloatRep    -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))
+        StringRep   -> Just (mkStringConstr dt str)
+        NoRep       -> Nothing
+  where
+
+    -- Read a value and build a constructor
+    mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
+    mkReadCon f = case (reads str) of
+                    [(t,"")] -> Just (f t)
+                    _ -> Nothing
+
+    -- Traverse list of algebraic datatype constructors
+    idx :: [Constr] -> Maybe Constr
+    idx cons = let fit = filter ((==) str . showConstr) cons
+                in if fit == []
+                     then Nothing
+                     else Just (head fit)
+
+
+------------------------------------------------------------------------------
+--
+-- Convenience funtions: algebraic data types
+--
+------------------------------------------------------------------------------
+
+
+-- | Test for an algebraic type
+isAlgType :: DataType -> Bool
+isAlgType dt = case datarep dt of
+                 (AlgRep _) -> True
+                 _ -> False
+
+
+-- | Gets the constructor for an index
+indexConstr :: DataType -> ConIndex -> Constr
+indexConstr dt idx = case datarep dt of
+                        (AlgRep cs) -> cs !! (idx-1)
+                        _           -> error "indexConstr"
+
+
+-- | Gets the index of a constructor
+constrIndex :: Constr -> ConIndex
+constrIndex con = case constrRep con of
+                    (AlgConstr idx) -> idx
+                    _ -> error "constrIndex"
+
+
+-- | Gets the maximum constructor index
+maxConstrIndex :: DataType -> ConIndex
+maxConstrIndex dt = case dataTypeRep dt of
+                        AlgRep cs -> length cs
+                        _         -> error "maxConstrIndex"
+
+
+
+------------------------------------------------------------------------------
+--
+-- Representation of primitive types
+--
+------------------------------------------------------------------------------
+
+
+-- | Constructs the Int type
+mkIntType :: String -> DataType
+mkIntType = mkPrimType IntRep
+
+
+-- | Constructs the Float type
+mkFloatType :: String -> DataType
+mkFloatType = mkPrimType FloatRep
+
+
+-- | Constructs the String type
+mkStringType :: String -> DataType
+mkStringType = mkPrimType StringRep
+
+
+-- | Helper for mkIntType, mkFloatType, mkStringType
+mkPrimType :: DataRep -> String -> DataType
+mkPrimType dr str = DataType
+                        { tycon   = str
+                        , datarep = dr
+                        }
+
+
+-- Makes a constructor for primitive types
+mkPrimCon :: DataType -> String -> ConstrRep -> Constr
+mkPrimCon dt str cr = Constr
+                        { datatype  = dt
+                        , conrep    = cr
+                        , constring = str
+                        , confields = error $ concat ["constrFields : ", (tycon dt), " is primative"]
+                        , confixity = error "constrFixity"
+                        }
+
+
+mkIntConstr :: DataType -> Integer -> Constr
+mkIntConstr dt i = case datarep dt of
+                  IntRep -> mkPrimCon dt (show i) (IntConstr i)
+                  _ -> error "mkIntConstr"
+
+
+mkFloatConstr :: DataType -> Double -> Constr
+mkFloatConstr dt f = case datarep dt of
+                    FloatRep -> mkPrimCon dt (show f) (FloatConstr f)
+                    _ -> error "mkFloatConstr"
+
+
+mkStringConstr :: DataType -> String -> Constr
+mkStringConstr dt str = case datarep dt of
+                       StringRep -> mkPrimCon dt str (StringConstr str)
+                       _ -> error "mkStringConstr"
+
+
+------------------------------------------------------------------------------
+--
+-- Non-representations for non-presentable types
+--
+------------------------------------------------------------------------------
+
+
+-- | Constructs a non-representation
+mkNorepType :: String -> DataType
+mkNorepType str = DataType
+                        { tycon   = str
+                        , datarep = NoRep
+                        }
+
+
+-- | Test for a non-representable type
+isNorepType :: DataType -> Bool
+isNorepType dt = case datarep dt of
+                   NoRep -> True
+                   _ -> False
+
diff --git a/testsuite/tests/typecheck/should_run/T1735_Help/Context.hs b/testsuite/tests/typecheck/should_run/T1735_Help/Context.hs
index 25b9df94a8..df743126c6 100644
--- a/testsuite/tests/typecheck/should_run/T1735_Help/Context.hs
+++ b/testsuite/tests/typecheck/should_run/T1735_Help/Context.hs
@@ -1,57 +1,57 @@
-{-# LANGUAGE UndecidableInstances, OverlappingInstances, EmptyDataDecls #-}

-

-{-

-

-(C) 2004 Ralf Laemmel

-

-Context parameterisation and context passing.

-

--}

-

-

-module T1735_Help.Context

-

-where

-

-------------------------------------------------------------------------------

-

---

--- The Sat class from John Hughes' "Restricted Data Types in Haskell"

---

-

-class Sat a

-  where

-    dict :: a

-

-

-------------------------------------------------------------------------------

-

--- No context

-

-data NoCtx a

-

-noCtx :: NoCtx ()

-noCtx = undefined

-

-instance Sat (NoCtx a) where dict = undefined

-

-

-------------------------------------------------------------------------------

-

--- Pair context

-

-data PairCtx l r a

-   = PairCtx { leftCtx  :: l a

-             , rightCtx :: r a }

-

-pairCtx :: l () -> r () -> PairCtx l r ()

-pairCtx _ _ = undefined

-

-instance (Sat (l a), Sat (r a))

-      => Sat (PairCtx l r a)

-  where

-    dict = PairCtx { leftCtx  = dict

-                   , rightCtx = dict }

-

-

-------------------------------------------------------------------------------

+{-# LANGUAGE UndecidableInstances, OverlappingInstances, EmptyDataDecls #-}
+
+{-
+
+(C) 2004 Ralf Laemmel
+
+Context parameterisation and context passing.
+
+-}
+
+
+module T1735_Help.Context
+
+where
+
+------------------------------------------------------------------------------
+
+--
+-- The Sat class from John Hughes' "Restricted Data Types in Haskell"
+--
+
+class Sat a
+  where
+    dict :: a
+
+
+------------------------------------------------------------------------------
+
+-- No context
+
+data NoCtx a
+
+noCtx :: NoCtx ()
+noCtx = undefined
+
+instance Sat (NoCtx a) where dict = undefined
+
+
+------------------------------------------------------------------------------
+
+-- Pair context
+
+data PairCtx l r a
+   = PairCtx { leftCtx  :: l a
+             , rightCtx :: r a }
+
+pairCtx :: l () -> r () -> PairCtx l r ()
+pairCtx _ _ = undefined
+
+instance (Sat (l a), Sat (r a))
+      => Sat (PairCtx l r a)
+  where
+    dict = PairCtx { leftCtx  = dict
+                   , rightCtx = dict }
+
+
+------------------------------------------------------------------------------
diff --git a/testsuite/tests/typecheck/should_run/T1735_Help/Instances.hs b/testsuite/tests/typecheck/should_run/T1735_Help/Instances.hs
index 6a626138ea..8d9a20ef4c 100644
--- a/testsuite/tests/typecheck/should_run/T1735_Help/Instances.hs
+++ b/testsuite/tests/typecheck/should_run/T1735_Help/Instances.hs
@@ -1,41 +1,41 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, MultiParamTypeClasses,

-             UndecidableInstances, OverlappingInstances, CPP #-}

-{-# OPTIONS_GHC -fno-warn-orphans #-}

--- This is a module full of orphans, so don't warn about them

-

-module T1735_Help.Instances () where

-

-import T1735_Help.Basics

-import Data.Typeable

-

-charType :: DataType

-charType = mkStringType "Prelude.Char"

-

-instance Sat (ctx Char) =>

-         Data ctx Char where

-  toConstr _ x = mkStringConstr charType [x]

-  gunfold _ _ z c = case constrRep c of

-                      (StringConstr [x]) -> z x

-                      _ -> error "gunfold Char"

-  dataTypeOf _ _ = charType

-

-nilConstr :: Constr

-nilConstr    = mkConstr listDataType "[]" [] Prefix

-consConstr :: Constr

-consConstr   = mkConstr listDataType "(:)" [] Infix

-listDataType :: DataType

-listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]

-

-instance (Sat (ctx [a]), Data ctx a) =>

-         Data ctx [a] where

-  gfoldl _ _ z []     = z []

-  gfoldl _ f z (x:xs) = z (:) `f` x `f` xs

-  toConstr _ []    = nilConstr

-  toConstr _ (_:_) = consConstr

-  gunfold _ k z c = case constrIndex c of

-                      1 -> z []

-                      2 -> k (k (z (:)))

-                      _ -> error "gunfold List"

-  dataTypeOf _ _ = listDataType

-  dataCast1 _ f = gcast1 f

-

+{-# LANGUAGE TemplateHaskell, FlexibleInstances, MultiParamTypeClasses,
+             UndecidableInstances, OverlappingInstances, CPP #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- This is a module full of orphans, so don't warn about them
+
+module T1735_Help.Instances () where
+
+import T1735_Help.Basics
+import Data.Typeable
+
+charType :: DataType
+charType = mkStringType "Prelude.Char"
+
+instance Sat (ctx Char) =>
+         Data ctx Char where
+  toConstr _ x = mkStringConstr charType [x]
+  gunfold _ _ z c = case constrRep c of
+                      (StringConstr [x]) -> z x
+                      _ -> error "gunfold Char"
+  dataTypeOf _ _ = charType
+
+nilConstr :: Constr
+nilConstr    = mkConstr listDataType "[]" [] Prefix
+consConstr :: Constr
+consConstr   = mkConstr listDataType "(:)" [] Infix
+listDataType :: DataType
+listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
+
+instance (Sat (ctx [a]), Data ctx a) =>
+         Data ctx [a] where
+  gfoldl _ _ z []     = z []
+  gfoldl _ f z (x:xs) = z (:) `f` x `f` xs
+  toConstr _ []    = nilConstr
+  toConstr _ (_:_) = consConstr
+  gunfold _ k z c = case constrIndex c of
+                      1 -> z []
+                      2 -> k (k (z (:)))
+                      _ -> error "gunfold List"
+  dataTypeOf _ _ = listDataType
+  dataCast1 _ f = gcast1 f
+
diff --git a/testsuite/tests/typecheck/should_run/T1735_Help/Main.hs b/testsuite/tests/typecheck/should_run/T1735_Help/Main.hs
index 0a6e1c59f4..0c59d449fa 100644
--- a/testsuite/tests/typecheck/should_run/T1735_Help/Main.hs
+++ b/testsuite/tests/typecheck/should_run/T1735_Help/Main.hs
@@ -1,62 +1,62 @@
-

-{-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables,

-             PatternSignatures, GADTs, RankNTypes, FlexibleContexts,

-             MultiParamTypeClasses, GeneralizedNewtypeDeriving,

-             DeriveDataTypeable,

-             OverlappingInstances, UndecidableInstances, CPP #-}

-

-module Main (main) where

-

-import SYBWC.Basics

-import Xml

-

-data YesNo = Yes | No

-    deriving (Eq, Show, Typeable)

-instance Sat (ctx YesNo) => Data ctx YesNo where

-    toConstr _ Yes = yesConstr

-    toConstr _ No  = noConstr

-    gunfold _ _ z c  = case constrIndex c of

-                           1 -> z Yes

-                           2 -> z No

-                           _ -> error "Foo"

-    dataTypeOf _ _ = yesNoDataType

-yesConstr :: Constr

-yesConstr = mkConstr yesNoDataType "Yes" [] Prefix

-noConstr :: Constr

-noConstr = mkConstr yesNoDataType "No" [] Prefix

-yesNoDataType :: DataType

-yesNoDataType = mkDataType "YesNo" [yesConstr, noConstr]

-

-newtype MyList a = MkMyList { unMyList :: [a] }

-    deriving (Show, Eq, Typeable)

-instance (Sat (ctx (MyList a)), Sat (ctx [a]), Data ctx a)

-      => Data ctx (MyList a) where

-    gfoldl _ f z x  = z MkMyList `f` unMyList x

-    toConstr _ (MkMyList _) = mkMyListConstr

-    gunfold _ k z c  = case constrIndex c of

-                           1 -> k (z MkMyList)

-                           _ -> error "Foo"

-    dataTypeOf _ _ = myListDataType

-mkMyListConstr :: Constr

-mkMyListConstr = mkConstr myListDataType "MkMyList" [] Prefix

-myListDataType :: DataType

-myListDataType = mkDataType "MyList" [mkMyListConstr]

-

-#ifdef FOO

-rigidTests :: Maybe (Maybe [YesNo])

-rigidTests =

- mkTest [Elem "No"  []] (Just [No])

-#endif

-

-rigidManualTests :: Maybe (Maybe (MyList YesNo))

-rigidManualTests =

- mkTest [Elem "MkMyList" [Elem "Yes" []]] (Just (MkMyList [Yes]))

-

-mkTest :: (Eq a, Xml a) => [Element] -> Maybe a -> Maybe (Maybe a)

-mkTest es v = case fromXml es of

-                  v' | v == v'   -> Nothing

-                     | otherwise -> Just v'

-

-main :: IO ()

-main = print rigidManualTests

-

+
+{-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables,
+             PatternSignatures, GADTs, RankNTypes, FlexibleContexts,
+             MultiParamTypeClasses, GeneralizedNewtypeDeriving,
+             DeriveDataTypeable,
+             OverlappingInstances, UndecidableInstances, CPP #-}
+
+module Main (main) where
+
+import SYBWC.Basics
+import Xml
+
+data YesNo = Yes | No
+    deriving (Eq, Show, Typeable)
+instance Sat (ctx YesNo) => Data ctx YesNo where
+    toConstr _ Yes = yesConstr
+    toConstr _ No  = noConstr
+    gunfold _ _ z c  = case constrIndex c of
+                           1 -> z Yes
+                           2 -> z No
+                           _ -> error "Foo"
+    dataTypeOf _ _ = yesNoDataType
+yesConstr :: Constr
+yesConstr = mkConstr yesNoDataType "Yes" [] Prefix
+noConstr :: Constr
+noConstr = mkConstr yesNoDataType "No" [] Prefix
+yesNoDataType :: DataType
+yesNoDataType = mkDataType "YesNo" [yesConstr, noConstr]
+
+newtype MyList a = MkMyList { unMyList :: [a] }
+    deriving (Show, Eq, Typeable)
+instance (Sat (ctx (MyList a)), Sat (ctx [a]), Data ctx a)
+      => Data ctx (MyList a) where
+    gfoldl _ f z x  = z MkMyList `f` unMyList x
+    toConstr _ (MkMyList _) = mkMyListConstr
+    gunfold _ k z c  = case constrIndex c of
+                           1 -> k (z MkMyList)
+                           _ -> error "Foo"
+    dataTypeOf _ _ = myListDataType
+mkMyListConstr :: Constr
+mkMyListConstr = mkConstr myListDataType "MkMyList" [] Prefix
+myListDataType :: DataType
+myListDataType = mkDataType "MyList" [mkMyListConstr]
+
+#ifdef FOO
+rigidTests :: Maybe (Maybe [YesNo])
+rigidTests =
+ mkTest [Elem "No"  []] (Just [No])
+#endif
+
+rigidManualTests :: Maybe (Maybe (MyList YesNo))
+rigidManualTests =
+ mkTest [Elem "MkMyList" [Elem "Yes" []]] (Just (MkMyList [Yes]))
+
+mkTest :: (Eq a, Xml a) => [Element] -> Maybe a -> Maybe (Maybe a)
+mkTest es v = case fromXml es of
+                  v' | v == v'   -> Nothing
+                     | otherwise -> Just v'
+
+main :: IO ()
+main = print rigidManualTests
+
diff --git a/testsuite/tests/typecheck/should_run/T1735_Help/State.hs b/testsuite/tests/typecheck/should_run/T1735_Help/State.hs
index d696af738f..44078ae944 100644
--- a/testsuite/tests/typecheck/should_run/T1735_Help/State.hs
+++ b/testsuite/tests/typecheck/should_run/T1735_Help/State.hs
@@ -1,28 +1,28 @@
-

-module T1735_Help.State where

-

-import Control.Monad (ap, liftM)

-

-

-newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }

-

-instance Monad m => Monad (StateT s m) where

-    return a = StateT $ \s -> return (a, s)

-    m >>= k  = StateT $ \s -> do

-        ~(a, s') <- runStateT m s

-        runStateT (k a) s'

-    fail str = StateT $ \_ -> fail str

-

-instance Monad m => Functor (StateT s m) where

-    fmap = liftM

-

-instance Monad m => Applicative (StateT s m) where

-    pure  = return

-    (<*>) = ap

-

-get :: Monad m => StateT s m s

-get = StateT $ \s -> return (s, s)

-

-put :: Monad m => s -> StateT s m ()

-put s = StateT $ \_ -> return ((), s)

-

+
+module T1735_Help.State where
+
+import Control.Monad (ap, liftM)
+
+
+newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }
+
+instance Monad m => Monad (StateT s m) where
+    return a = StateT $ \s -> return (a, s)
+    m >>= k  = StateT $ \s -> do
+        ~(a, s') <- runStateT m s
+        runStateT (k a) s'
+    fail str = StateT $ \_ -> fail str
+
+instance Monad m => Functor (StateT s m) where
+    fmap = liftM
+
+instance Monad m => Applicative (StateT s m) where
+    pure  = return
+    (<*>) = ap
+
+get :: Monad m => StateT s m s
+get = StateT $ \s -> return (s, s)
+
+put :: Monad m => s -> StateT s m ()
+put s = StateT $ \_ -> return ((), s)
+
diff --git a/testsuite/tests/typecheck/should_run/T1735_Help/Xml.hs b/testsuite/tests/typecheck/should_run/T1735_Help/Xml.hs
index b641c6a82c..01cc39365e 100644
--- a/testsuite/tests/typecheck/should_run/T1735_Help/Xml.hs
+++ b/testsuite/tests/typecheck/should_run/T1735_Help/Xml.hs
@@ -1,143 +1,143 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables,

-             GADTs, RankNTypes, FlexibleContexts, TypeSynonymInstances,

-             MultiParamTypeClasses, DeriveDataTypeable, PatternGuards,

-             OverlappingInstances, UndecidableInstances, CPP #-}

-

-module T1735_Help.Xml (Element(..), Xml, fromXml) where

-

-import T1735_Help.Basics

-import T1735_Help.Instances ()

-import T1735_Help.State

-

-data Element = Elem String [Element]

-             | CData String

-             | Attr String String

-

-fromXml :: Xml a => [Element] -> Maybe a

-fromXml xs = case readXml xs of

-             Just (_, v) -> return v

-             Nothing -> error "XXX"

-

-class (Data XmlD a) => Xml a where

-    toXml :: a -> [Element]

-    toXml = defaultToXml

-

-    readXml :: [Element] -> Maybe ([Element], a)

-    readXml = defaultReadXml

-

-    readXml' :: [Element] -> Maybe ([Element], a)

-    readXml' = defaultReadXml'

-

-instance (Data XmlD t, Show t) => Xml t

-

-data XmlD a = XmlD { toXmlD :: a -> [Element], readMXmlD :: ReadM Maybe a }

-

-xmlProxy :: Proxy XmlD

-xmlProxy = error "xmlProxy"

-

-instance Xml t => Sat (XmlD t) where

-    dict = XmlD { toXmlD = toXml, readMXmlD = readMXml }

-

-defaultToXml :: Xml t => t -> [Element]

-defaultToXml x = [Elem (constring $ toConstr xmlProxy x) (transparentToXml x)]

-

-transparentToXml :: Xml t => t -> [Element]

-transparentToXml x = concat $ gmapQ xmlProxy (toXmlD dict) x

-

--- Don't do any defaulting here, as these functions can be implemented

--- differently by the user. We do the defaulting elsewhere instead.

--- The t' type is thus not used.

-

-defaultReadXml :: Xml t => [Element] -> Maybe ([Element], t)

-defaultReadXml es = readXml' es

-

-defaultReadXml' :: Xml t => [Element] -> Maybe ([Element], t)

-defaultReadXml' = readXmlWith readVersionedElement

-

-readXmlWith :: Xml t

-            => (Element -> Maybe t)

-            -> [Element]

-            -> Maybe ([Element], t)

-readXmlWith f es = case es of

-                       e : es' ->

-                           case f e of

-                               Just v -> Just (es', v)

-                               Nothing -> Nothing

-                       [] ->

-                           Nothing

-

-readVersionedElement :: forall t . Xml t => Element -> Maybe t

-readVersionedElement e = readElement e

-

-readElement :: forall t . Xml t => Element -> Maybe t

-readElement (Elem n es) = res

-    where resType :: t

-          resType = typeNotValue resType

-          resDataType = dataTypeOf xmlProxy resType

-          con = readConstr resDataType n

-          res = case con of

-                Just c -> f c

-                Nothing -> Nothing

-          f c =     let m :: Maybe ([Element], t)

-                        m = constrFromElements c es

-                    in case m of

-                           Just ([], x) -> Just x

-                           _ -> Nothing

-readElement _ = Nothing

-

-constrFromElements :: forall t . Xml t

-                   => Constr -> [Element] -> Maybe ([Element], t)

-constrFromElements c es

- = do let st = ReadState { xmls = es }

-          m :: ReadM Maybe t

-          m = fromConstrM xmlProxy (readMXmlD dict) c

-      -- XXX Should we flip the result order?

-      (x, st') <- runStateT m st

-      return (xmls st', x)

-

-type ReadM m = StateT ReadState m

-

-data ReadState = ReadState {

-                     xmls :: [Element]

-                 }

-

-getXmls :: Monad m => ReadM m [Element]

-getXmls = do st <- get

-             return $ xmls st

-

-putXmls :: Monad m => [Element] -> ReadM m ()

-putXmls xs = do st <- get

-                put $ st { xmls = xs }

-

-readMXml :: Xml a => ReadM Maybe a

-readMXml

- = do xs <- getXmls

-      case readXml xs of

-          Nothing -> fail "Cannot read value"

-          Just (xs', v) ->

-              do putXmls xs'

-                 return v

-

-typeNotValue :: Xml a => a -> a

-typeNotValue t = error ("Type used as value: " ++ typeName)

-    where typeName = dataTypeName (dataTypeOf xmlProxy t)

-

--- The Xml [a] context is a bit scary, but if we don't have it then

--- GHC complains about overlapping instances

-

-instance (Xml a {-, Xml [a] -}) => Xml [a] where

-    toXml = concatMap toXml

-    readXml = f [] []

-        where f acc_xs acc_vs [] = Just (reverse acc_xs, reverse acc_vs)

-              f acc_xs acc_vs (x:xs) = case readXml [x] of

-                                           Just ([], v) ->

-                                               f acc_xs (v:acc_vs) xs

-                                           _ ->

-                                               f (x:acc_xs) acc_vs xs

-

-instance Xml String where

-    toXml x = [CData x]

-    readXml = readXmlWith f

-        where f (CData x) = Just x

-              f _ = Nothing

-

+{-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables,
+             GADTs, RankNTypes, FlexibleContexts, TypeSynonymInstances,
+             MultiParamTypeClasses, DeriveDataTypeable, PatternGuards,
+             OverlappingInstances, UndecidableInstances, CPP #-}
+
+module T1735_Help.Xml (Element(..), Xml, fromXml) where
+
+import T1735_Help.Basics
+import T1735_Help.Instances ()
+import T1735_Help.State
+
+data Element = Elem String [Element]
+             | CData String
+             | Attr String String
+
+fromXml :: Xml a => [Element] -> Maybe a
+fromXml xs = case readXml xs of
+             Just (_, v) -> return v
+             Nothing -> error "XXX"
+
+class (Data XmlD a) => Xml a where
+    toXml :: a -> [Element]
+    toXml = defaultToXml
+
+    readXml :: [Element] -> Maybe ([Element], a)
+    readXml = defaultReadXml
+
+    readXml' :: [Element] -> Maybe ([Element], a)
+    readXml' = defaultReadXml'
+
+instance (Data XmlD t, Show t) => Xml t
+
+data XmlD a = XmlD { toXmlD :: a -> [Element], readMXmlD :: ReadM Maybe a }
+
+xmlProxy :: Proxy XmlD
+xmlProxy = error "xmlProxy"
+
+instance Xml t => Sat (XmlD t) where
+    dict = XmlD { toXmlD = toXml, readMXmlD = readMXml }
+
+defaultToXml :: Xml t => t -> [Element]
+defaultToXml x = [Elem (constring $ toConstr xmlProxy x) (transparentToXml x)]
+
+transparentToXml :: Xml t => t -> [Element]
+transparentToXml x = concat $ gmapQ xmlProxy (toXmlD dict) x
+
+-- Don't do any defaulting here, as these functions can be implemented
+-- differently by the user. We do the defaulting elsewhere instead.
+-- The t' type is thus not used.
+
+defaultReadXml :: Xml t => [Element] -> Maybe ([Element], t)
+defaultReadXml es = readXml' es
+
+defaultReadXml' :: Xml t => [Element] -> Maybe ([Element], t)
+defaultReadXml' = readXmlWith readVersionedElement
+
+readXmlWith :: Xml t
+            => (Element -> Maybe t)
+            -> [Element]
+            -> Maybe ([Element], t)
+readXmlWith f es = case es of
+                       e : es' ->
+                           case f e of
+                               Just v -> Just (es', v)
+                               Nothing -> Nothing
+                       [] ->
+                           Nothing
+
+readVersionedElement :: forall t . Xml t => Element -> Maybe t
+readVersionedElement e = readElement e
+
+readElement :: forall t . Xml t => Element -> Maybe t
+readElement (Elem n es) = res
+    where resType :: t
+          resType = typeNotValue resType
+          resDataType = dataTypeOf xmlProxy resType
+          con = readConstr resDataType n
+          res = case con of
+                Just c -> f c
+                Nothing -> Nothing
+          f c =     let m :: Maybe ([Element], t)
+                        m = constrFromElements c es
+                    in case m of
+                           Just ([], x) -> Just x
+                           _ -> Nothing
+readElement _ = Nothing
+
+constrFromElements :: forall t . Xml t
+                   => Constr -> [Element] -> Maybe ([Element], t)
+constrFromElements c es
+ = do let st = ReadState { xmls = es }
+          m :: ReadM Maybe t
+          m = fromConstrM xmlProxy (readMXmlD dict) c
+      -- XXX Should we flip the result order?
+      (x, st') <- runStateT m st
+      return (xmls st', x)
+
+type ReadM m = StateT ReadState m
+
+data ReadState = ReadState {
+                     xmls :: [Element]
+                 }
+
+getXmls :: Monad m => ReadM m [Element]
+getXmls = do st <- get
+             return $ xmls st
+
+putXmls :: Monad m => [Element] -> ReadM m ()
+putXmls xs = do st <- get
+                put $ st { xmls = xs }
+
+readMXml :: Xml a => ReadM Maybe a
+readMXml
+ = do xs <- getXmls
+      case readXml xs of
+          Nothing -> fail "Cannot read value"
+          Just (xs', v) ->
+              do putXmls xs'
+                 return v
+
+typeNotValue :: Xml a => a -> a
+typeNotValue t = error ("Type used as value: " ++ typeName)
+    where typeName = dataTypeName (dataTypeOf xmlProxy t)
+
+-- The Xml [a] context is a bit scary, but if we don't have it then
+-- GHC complains about overlapping instances
+
+instance (Xml a {-, Xml [a] -}) => Xml [a] where
+    toXml = concatMap toXml
+    readXml = f [] []
+        where f acc_xs acc_vs [] = Just (reverse acc_xs, reverse acc_vs)
+              f acc_xs acc_vs (x:xs) = case readXml [x] of
+                                           Just ([], v) ->
+                                               f acc_xs (v:acc_vs) xs
+                                           _ ->
+                                               f (x:acc_xs) acc_vs xs
+
+instance Xml String where
+    toXml x = [CData x]
+    readXml = readXmlWith f
+        where f (CData x) = Just x
+              f _ = Nothing
+
diff --git a/testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs b/testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs
index 1b5cbfe738..ff56059950 100644
--- a/testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs
+++ b/testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs
@@ -1,82 +1,82 @@
-{-# LANGUAGE CPP, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies, 

-      FlexibleContexts, FlexibleInstances, UndecidableInstances, OverlappingInstances,

-      TypeSynonymInstances, GeneralizedNewtypeDeriving #-}

------------------------------------------------------------------------------

--- |

--- Module      :  HSX.XMLGenerator

--- Copyright   :  (c) Niklas Broberg 2008

--- License     :  BSD-style (see the file LICENSE.txt)

--- 

--- Maintainer  :  Niklas Broberg, niklas.broberg@chalmers.se

--- Stability   :  experimental

--- Portability :  requires newtype deriving and MPTCs with fundeps

---

--- The class and monad transformer that forms the basis of the literal XML

--- syntax translation. Literal tags will be translated into functions of

--- the GenerateXML class, and any instantiating monads with associated XML

--- types can benefit from that syntax.

------------------------------------------------------------------------------

-module T4809_XMLGenerator where

-

-import Control.Applicative

-import Control.Monad

-import Control.Monad.Trans

-import Control.Monad.Cont  (MonadCont)

-import Control.Monad.Error (MonadError)

-import Control.Monad.Reader(MonadReader)

-import Control.Monad.Writer(MonadWriter)

-import Control.Monad.State (MonadState)

-import Control.Monad.RWS   (MonadRWS)

-import Control.Monad (MonadPlus(..),liftM)

-

-----------------------------------------------

--- General XML Generation

-

--- | The monad transformer that allows a monad to generate XML values.

-newtype XMLGenT m a = XMLGenT (m a)

-  deriving (Monad, Functor, MonadIO, MonadPlus, MonadWriter w, MonadReader r,

-            MonadState s, MonadRWS r w s, MonadCont, MonadError e)

-

-instance Monad m => Applicative (XMLGenT m) where

-  pure  = return

-  (<*>) = ap

-

-instance Monad m => Alternative (XMLGenT m) where

-

--- | un-lift.

-unXMLGenT :: XMLGenT m a -> m a

-unXMLGenT   (XMLGenT ma) =  ma

-

-instance MonadTrans XMLGenT where

- lift = XMLGenT

-

-type Name = (Maybe String, String)

-

--- | Generate XML values in some XMLGenerator monad.

-class Monad m => XMLGen m where

- type XML m

- data Child m

- genElement  :: Name -> [XMLGenT m [Int]] -> [XMLGenT m [Child m]] -> XMLGenT m (XML m)

- genEElement :: Name -> [XMLGenT m [Int]]                          -> XMLGenT m (XML m)

- genEElement n ats = genElement n ats []

-

--- | Embed values as child nodes of an XML element. The parent type will be clear

--- from the context so it is not mentioned.

-class XMLGen m => EmbedAsChild m c where

- asChild :: c -> XMLGenT m [Child m]

-

-instance (MonadIO m, EmbedAsChild m c, m ~ n) => EmbedAsChild m (XMLGenT n c) where

- asChild m = do

-      liftIO $ putStrLn "EmbedAsChild m (XMLGenT n c)"

-      a <- m

-      asChild a

-

-instance (MonadIO m, EmbedAsChild m c) => EmbedAsChild m [c] where

-  asChild cs = 

-      do liftIO $ putStrLn "EmbedAsChild m [c]"

-         liftM concat . mapM asChild $ cs

-

-instance (MonadIO m, XMLGen m) => EmbedAsChild m (Child m) where

- asChild c = 

-     do liftIO $ putStrLn "EmbedAsChild m (Child m)"

-        return . return $ c 

+{-# LANGUAGE CPP, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies,
+      FlexibleContexts, FlexibleInstances, UndecidableInstances, OverlappingInstances,
+      TypeSynonymInstances, GeneralizedNewtypeDeriving #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  HSX.XMLGenerator
+-- Copyright   :  (c) Niklas Broberg 2008
+-- License     :  BSD-style (see the file LICENSE.txt)
+--
+-- Maintainer  :  Niklas Broberg, niklas.broberg@chalmers.se
+-- Stability   :  experimental
+-- Portability :  requires newtype deriving and MPTCs with fundeps
+--
+-- The class and monad transformer that forms the basis of the literal XML
+-- syntax translation. Literal tags will be translated into functions of
+-- the GenerateXML class, and any instantiating monads with associated XML
+-- types can benefit from that syntax.
+-----------------------------------------------------------------------------
+module T4809_XMLGenerator where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Cont  (MonadCont)
+import Control.Monad.Error (MonadError)
+import Control.Monad.Reader(MonadReader)
+import Control.Monad.Writer(MonadWriter)
+import Control.Monad.State (MonadState)
+import Control.Monad.RWS   (MonadRWS)
+import Control.Monad (MonadPlus(..),liftM)
+
+----------------------------------------------
+-- General XML Generation
+
+-- | The monad transformer that allows a monad to generate XML values.
+newtype XMLGenT m a = XMLGenT (m a)
+  deriving (Monad, Functor, MonadIO, MonadPlus, MonadWriter w, MonadReader r,
+            MonadState s, MonadRWS r w s, MonadCont, MonadError e)
+
+instance Monad m => Applicative (XMLGenT m) where
+  pure  = return
+  (<*>) = ap
+
+instance Monad m => Alternative (XMLGenT m) where
+
+-- | un-lift.
+unXMLGenT :: XMLGenT m a -> m a
+unXMLGenT   (XMLGenT ma) =  ma
+
+instance MonadTrans XMLGenT where
+ lift = XMLGenT
+
+type Name = (Maybe String, String)
+
+-- | Generate XML values in some XMLGenerator monad.
+class Monad m => XMLGen m where
+ type XML m
+ data Child m
+ genElement  :: Name -> [XMLGenT m [Int]] -> [XMLGenT m [Child m]] -> XMLGenT m (XML m)
+ genEElement :: Name -> [XMLGenT m [Int]]                          -> XMLGenT m (XML m)
+ genEElement n ats = genElement n ats []
+
+-- | Embed values as child nodes of an XML element. The parent type will be clear
+-- from the context so it is not mentioned.
+class XMLGen m => EmbedAsChild m c where
+ asChild :: c -> XMLGenT m [Child m]
+
+instance (MonadIO m, EmbedAsChild m c, m ~ n) => EmbedAsChild m (XMLGenT n c) where
+ asChild m = do
+      liftIO $ putStrLn "EmbedAsChild m (XMLGenT n c)"
+      a <- m
+      asChild a
+
+instance (MonadIO m, EmbedAsChild m c) => EmbedAsChild m [c] where
+  asChild cs =
+      do liftIO $ putStrLn "EmbedAsChild m [c]"
+         liftM concat . mapM asChild $ cs
+
+instance (MonadIO m, XMLGen m) => EmbedAsChild m (Child m) where
+ asChild c =
+     do liftIO $ putStrLn "EmbedAsChild m (Child m)"
+        return . return $ c
diff --git a/testsuite/tests/typecheck/should_run/TcRun038_B.hs b/testsuite/tests/typecheck/should_run/TcRun038_B.hs
index 994348ba42..131b693066 100644
--- a/testsuite/tests/typecheck/should_run/TcRun038_B.hs
+++ b/testsuite/tests/typecheck/should_run/TcRun038_B.hs
@@ -1,13 +1,13 @@
 {-# LANGUAGE FlexibleContexts #-}
-

-module TcRun038_B where

-

-class Foo a where

-  op :: a -> Int

-

--- Note the (Foo Int) constraint here; and the fact

--- that there is no (Foo Int) instance in this module

--- It's in the importing module!

-

-bar :: Foo Int => Int -> Int

-bar x = op x + 7

+
+module TcRun038_B where
+
+class Foo a where
+  op :: a -> Int
+
+-- Note the (Foo Int) constraint here; and the fact
+-- that there is no (Foo Int) instance in this module
+-- It's in the importing module!
+
+bar :: Foo Int => Int -> Int
+bar x = op x + 7
diff --git a/testsuite/tests/typecheck/should_run/tcrun032.hs b/testsuite/tests/typecheck/should_run/tcrun032.hs
index 8aa43637ba..5609a9f066 100644
--- a/testsuite/tests/typecheck/should_run/tcrun032.hs
+++ b/testsuite/tests/typecheck/should_run/tcrun032.hs
@@ -1,20 +1,20 @@
 
-{-# LANGUAGE UndecidableInstances #-}

-

--- This tests the recursive-dictionary stuff.

-

-module Main where

-

-data Fix f = In (f (Fix f)) 

-

-instance Show (f (Fix f)) => Show (Fix f) where

-  show (In x) = "In " ++ show x	-- No parens, but never mind

-

-instance Eq (f (Fix f)) => Eq (Fix f) where

-  (In x) == (In y) = x==y

-

-data L x = Nil | Cons Int x  deriving( Show, Eq )

-

-main = do { print (In Nil); 

-	    print (In Nil == In Nil) }

-

+{-# LANGUAGE UndecidableInstances #-}
+
+-- This tests the recursive-dictionary stuff.
+
+module Main where
+
+data Fix f = In (f (Fix f))
+
+instance Show (f (Fix f)) => Show (Fix f) where
+  show (In x) = "In " ++ show x -- No parens, but never mind
+
+instance Eq (f (Fix f)) => Eq (Fix f) where
+  (In x) == (In y) = x==y
+
+data L x = Nil | Cons Int x  deriving( Show, Eq )
+
+main = do { print (In Nil);
+            print (In Nil == In Nil) }
+
diff --git a/testsuite/tests/typecheck/should_run/tcrun038.hs b/testsuite/tests/typecheck/should_run/tcrun038.hs
index 26337cdb95..04c7d831c5 100644
--- a/testsuite/tests/typecheck/should_run/tcrun038.hs
+++ b/testsuite/tests/typecheck/should_run/tcrun038.hs
@@ -1,8 +1,8 @@
-module Main where

-

-import TcRun038_B( Foo(..), bar )

-

-instance Foo Int where

-  op x = x+1

-

-main = print (bar (3::Int))

+module Main where
+
+import TcRun038_B( Foo(..), bar )
+
+instance Foo Int where
+  op x = x+1
+
+main = print (bar (3::Int))
diff --git a/testsuite/tests/typecheck/should_run/tcrun039.hs b/testsuite/tests/typecheck/should_run/tcrun039.hs
index 916d5330e4..eabe01589e 100644
--- a/testsuite/tests/typecheck/should_run/tcrun039.hs
+++ b/testsuite/tests/typecheck/should_run/tcrun039.hs
@@ -1,22 +1,22 @@
 {-# LANGUAGE GADTs, ExplicitForAll #-}
-

--- Test for GADTs and implication constraints

-

-module Main where

-

-data T a where

-  MkT :: Num a => a -> T a

-

-f :: Read a => T a -> String -> a

-f (MkT n) s = n + read s

-

-----------------

-data GADT a where

-  MkG :: Num a => a -> GADT [a]

-

-g :: forall b. Read b => GADT b -> String -> b

-g (MkG n) s = -- Here we know Read [b]

-	      n : (read s)

-

-main = do print (f (MkT (3::Int)) "4")

-          print (g (MkG (3::Int)) "[4,5]")

+
+-- Test for GADTs and implication constraints
+
+module Main where
+
+data T a where
+  MkT :: Num a => a -> T a
+
+f :: Read a => T a -> String -> a
+f (MkT n) s = n + read s
+
+----------------
+data GADT a where
+  MkG :: Num a => a -> GADT [a]
+
+g :: forall b. Read b => GADT b -> String -> b
+g (MkG n) s = -- Here we know Read [b]
+              n : (read s)
+
+main = do print (f (MkT (3::Int)) "4")
+          print (g (MkG (3::Int)) "[4,5]")