[project @ 2004-01-10 12:53:42 by panne]
[haskell-directory.git] / Data / Generics / Text.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module      :  Data.Generics.Text
4 -- Copyright   :  (c) The University of Glasgow, CWI 2001--2003
5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
6 -- 
7 -- Maintainer  :  libraries@haskell.org
8 -- Stability   :  experimental
9 -- Portability :  non-portable
10 --
11 -- \"Scrap your boilerplate\" --- Generic programming in Haskell 
12 -- See <http://www.cs.vu.nl/boilerplate/>. The present module provides
13 -- generic operations for text serialisation of terms.
14 --
15 -----------------------------------------------------------------------------
16
17 module Data.Generics.Text ( 
18
19         gshow,
20         gread
21
22  ) where
23
24 ------------------------------------------------------------------------------
25
26 #ifdef __HADDOCK__
27 import Prelude
28 #endif
29 import Control.Monad
30 import Data.Maybe
31 import Data.Typeable
32 import Data.Generics.Basics
33 import Data.Generics.Aliases
34 import Text.ParserCombinators.ReadP
35
36 ------------------------------------------------------------------------------
37
38
39 -- | Generic show: an alternative to \"deriving Show\"
40 gshow :: Data a => a -> String
41
42 -- This is a prefix-show using surrounding "(" and ")",
43 -- where we recurse into subterms with gmapQ.
44 -- 
45 gshow = ( \t ->
46                 "("
47              ++ conString (toConstr t)
48              ++ concat (gmapQ ((++) " " . gshow) t)
49              ++ ")"
50         ) `extQ` (show :: String -> String)
51
52
53
54 -- | Generic read: an alternative to \"deriving Read\"
55 gread :: Data a => ReadS a
56
57 {-
58
59 This is a read operation which insists on prefix notation.  (The
60 Haskell 98 read deals with infix operators subject to associativity
61 and precedence as well.) We use gunfoldR to "parse" the input. To be
62 precise, gunfoldR is used for all types except String. The
63 type-specific case for String uses basic String read.
64
65 -}
66
67 gread = readP_to_S gread'
68
69  where
70
71   gread' :: Data a => ReadP a
72   gread' = gdefault `extR` scase
73
74
75    where
76
77     -- A specific case for strings
78     scase :: ReadP String
79     scase = readS_to_P reads
80
81
82     -- The generic default for gread
83     -- gdefault :: Data a => ReadP a
84     gdefault =
85       do
86                 -- Drop "  (  "
87          skipSpaces                     -- Discard leading space
88          char '('                       -- Parse '('
89          skipSpaces                     -- Discard following space
90
91                 -- Do the real work
92          str   <- parseConstr           -- Get a lexeme for the constructor
93          con   <- str2con str           -- Convert it to a Constr (may fail)
94          x     <- gunfoldR con gread'   -- Read the children
95
96                 -- Drop "  )  "
97          skipSpaces                     -- Discard leading space
98          char ')'                       -- Parse ')'
99          skipSpaces                     -- Discard following space
100
101          return x
102
103      where
104
105         -- Get the datatype for the type at hand;
106         -- use gdefault to provide the type at hand.
107         myDataTypeOf :: Data a => ReadP a -> DataType
108         myDataTypeOf (_::ReadP a) = dataTypeOf (undefined::a)
109
110         -- Turn string into constructor driven by gdefault's type,
111         -- failing in the monad if it isn't a constructor of this data type
112         str2con :: String -> ReadP Constr       
113         str2con = maybe mzero return
114                 . stringCon (myDataTypeOf gdefault)
115
116         -- Get a Constr's string at the front of an input string
117         parseConstr :: ReadP String
118         parseConstr =  
119                string "[]"     -- Compound lexeme "[]"
120           <++  infixOp         -- Infix operator in parantheses
121           <++  readS_to_P lex  -- Ordinary constructors and literals
122
123         -- Handle infix operators such as (:)
124         infixOp :: ReadP String
125         infixOp = do c1  <- char '('
126                      str <- munch1 (not . (==) ')')
127                      c2  <- char ')'
128                      return $ [c1] ++ str ++ [c2]