1 -----------------------------------------------------------------------------
3 -- Module : Data.Generics.Strings
4 -- Copyright : (c) The University of Glasgow, CWI 2001--2003
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
11 -- "Scrap your boilerplate" --- Generic programming in Haskell
12 -- See <http://www.cs.vu.nl/boilerplate/>.
14 -----------------------------------------------------------------------------
16 module Data.Generics.Strings (
18 -- * Generic operations for string representations of terms
24 ------------------------------------------------------------------------------
29 import Data.Generics.Basics
30 import Data.Generics.Aliases
34 -- | Generic show: an alternative to \"deriving Show\"
35 gshow :: Data a => a -> String
37 -- This is a prefix-show using surrounding "(" and ")",
38 -- where we recurse into subterms with gmapQ.
42 ++ conString (toConstr t)
43 ++ concat (gmapQ ((++) " " . gshow) t)
45 ) `extQ` (show :: String -> String)
48 -- | The type constructor for gunfold a la ReadS from the Prelude;
49 -- we don't use lists here for simplicity but only maybes.
51 newtype GRead a = GRead (String -> Maybe (a, String)) deriving Typeable
55 -- | Turn GRead into a monad.
56 instance Monad GRead where
57 return x = GRead (\s -> Just (x, s))
58 (GRead f) >>= g = GRead (\s ->
60 (\(a,s') -> unGRead (g a) s')
64 instance MonadPlus GRead where
65 mzero = GRead (\_ -> Nothing)
69 -- | Special parsing operators
70 trafo f = GRead (\s -> Just ((), f s))
71 query f = GRead (\s -> if f s then Just ((), s) else Nothing)
74 -- | Generic read: an alternative to \"deriving Read\"
75 gread :: Data a => String -> Maybe (a, String)
79 This is a read operation which insists on prefix notation. (The
80 Haskell 98 read deals with infix operators subject to associativity
81 and precedence as well.) We use gunfoldM to "parse" the input. To be
82 precise, gunfoldM is used for all types except String. The
83 type-specific case for String uses basic String read.
88 gread = unGRead gread'
92 gread' :: Data a => GRead a
93 gread' = gdefault `extB` scase
97 -- a specific case for strings
99 scase = GRead ( \s -> case reads s of
100 [x::(String,String)] -> Just x
104 -- the generic default for gread
105 gdefault :: Data a => GRead a
109 trafo $ dropWhile ((==) ' ') -- Discard leading space
110 query $ not . (==) "" -- Check result is not empty
111 query $ (==) '(' . head -- ...and that it begins with (
112 trafo $ tail -- Discard the '('
113 trafo $ dropWhile ((==) ' ') -- ...and following white space
116 str <- parseConstr -- Get a lexeme for the constructor
117 con <- str2con str -- Convert it to a Constr (may fail)
118 x <- gunfoldM con gread' -- Read the children
121 trafo $ dropWhile ((==) ' ')
122 query $ not . (==) ""
123 query $ (==) ')' . head
128 get_data_type :: GRead a -> DataType
129 get_data_type (thing :: GRead a) = dataTypeOf (typeVal::a)
131 str2con :: String -> GRead Constr
132 -- Turn string into constructor driven by gdefault's type,
133 -- failing in the monad if it isn't a constructor of this data type
134 str2con = maybe mzero return . stringCon (get_data_type gdefault)
138 do s' <- return $ dropWhile ((==) ' ') s
139 guard (not (s' == ""))
140 guard (head s' == '(')
141 (c,s'') <- parseConstr (dropWhile ((==) ' ') (tail s'))
142 u <- return undefined
143 dt <- return $ dataTypeOf u
144 case stringCon dt c of
145 Nothing -> error "Data.Generics.String: gread failed"
149 guard ( or [ maxConIndex (dataTypeOf u) == 0
150 , c `elem` constrsOf u
153 (a,s''') <- unGRead (gunfold f z c) s''
154 _ <- return $ constrainTypes a u
155 guard (not (s''' == ""))
156 guard (head s''' == ')')
157 return (a, tail s''')
160 -- Get a Constr's string at the front of an input string
161 parseConstr :: GRead String
163 parseConstr = GRead ( \s -> case s of
165 -- Infix operators are prefixed in parantheses
166 ('(':s) -> case break ((==) ')') s of
167 (s'@(_:_),(')':s'')) -> Just ("(" ++ s' ++ ")", s'')
170 -- Special treatment of multiple token constructors
171 ('[':']':s) -> Just ("[]",s)
173 -- Try lex for ordinary constructor and basic datatypes
175 [(s'@(_:_),s'')] -> Just (s',s'')