Data/Generics/Strings.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   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)
   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/>.
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 module Data.Generics.Strings (
  17
  18         -- * Generic operations for string representations of terms
  19         gshow,
  20         gread
  21
  22  ) where
  23
  24 ------------------------------------------------------------------------------
  25
  26 import Control.Monad
  27 import Data.Maybe
  28 import Data.Typeable
  29 import Data.Generics.Basics
  30 import Data.Generics.Aliases
  31
  32
  33
  34 -- | Generic show: an alternative to \"deriving Show\"
  35 gshow :: Data a => a -> String
  36
  37 -- This is a prefix-show using surrounding "(" and ")",
  38 -- where we recurse into subterms with gmapQ.
  39 --
  40 gshow = ( \t ->
  41                 "("
  42              ++ conString (toConstr t)
  43              ++ concat (gmapL ((++) " " . gshow) t)
  44              ++ ")"
  45         ) `extQ` (show :: String -> String)
  46
  47
  48 -- | The type constructor for gunfold a la ReadS from the Prelude;
  49 --   we don't use lists here for simplicity but only maybes.
  50 --
  51 newtype GRead a = GRead (String -> Maybe (a, String))
  52 unGRead (GRead x) = x
  53
  54 {-
  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 ->
  59                              maybe Nothing
  60                                    (\(a,s') -> unGRead (g a) s')
  61                                    f s
  62                           )
  63 -}
  64
  65 -- | Generic read: an alternative to \"deriving Read\"
  66 gread :: GenericB Maybe
  67
  68 {-
  69
  70 This is a read operation which insists on prefix notation.  (The
  71 Haskell 98 read deals with infix operators as well. We will be able to
  72 deal with such special cases as well as sonn as we include fixity
  73 information into the definition of "Constr".)  We use gunfold to
  74 "parse" the input. To be precise, gunfold is used for all result types
  75 except String. The type-specific case for String uses basic String
  76 read. Another source of customisation would be to properly deal with
  77 infix operators subject to the capture of that information in the
  78 definition of Constr. The "gread" combinator properly checks the
  79 validity of constructors before invoking gunfold in order to rule
  80 out run-time errors.
  81
  82 -}
  83
  84 gread = undefined
  85
  86 {-
  87 gdefault `extB` scase
  88
  89  where
  90
  91   -- a specific case for strings
  92   scase s = case reads s of
  93               [x::(String,String)] -> Just x
  94               _ -> Nothing
  95
  96   -- the generic default of gread
  97   gdefault s = undefined
  98
  99 -}
 100
 101 {-
 102     do s' <- return $ dropWhile ((==) ' ') s
 103        guard (not (s' == ""))
 104        guard (head s' == '(')
 105        (c,s'')  <- prefixConstr (dropWhile ((==) ' ') (tail s'))
 106        u  <- return undefined
 107        dt <- return $ dataTypeOf u
 108        case stringCon dt c of
 109         Nothing -> error "Generics: gread failed"
 110         Just c' ->
 111           gunfoldm c' gread
 112
 113        guard ( or [ maxConIndex (dataTypeOf u) == 0
 114                   , c `elem` constrsOf u
 115                   ]
 116              )
 117        (a,s''') <- unGRead (gunfold f z c) s''
 118        _ <- return $ constrainTypes a u
 119        guard (not (s''' == ""))
 120        guard (head s''' == ')')
 121        return (a, tail s''')
 122
 123
 124   -- To force two types to be the same
 125   constrainTypes :: a -> a -> ()
 126   constrainTypes _ _ = ()
 127
 128   -- Argument f for unfolding
 129   f :: Data a => GRead (a -> b) -> GRead b
 130   f x = GRead (\s -> do (r,s') <- unGRead x s
 131                         (t,s'')  <- gread s'
 132                         return (r t,s''))
 133
 134   -- Argument z for unfolding
 135   z ::  forall g. g -> GRead g
 136   z g = GRead (\s -> return (g,s))
 137
 138
 139   -- Get Constr at front of string
 140   prefixConstr :: String -> Maybe (Constr, String)
 141
 142   -- Assume an infix operators in parantheses
 143   prefixConstr ('(':s)
 144     = case break ((==) ')') s of
 145         (s'@(_:_),(')':s'')) -> Just (Constr ("(" ++ s' ++ ")"), s'')
 146         _ -> Nothing
 147
 148   -- Special treatment of multiple token constructors
 149   prefixConstr ('[':']':s) = Just (Constr "[]",s)
 150
 151   -- Try lex for ordinary constructor and basic datatypes
 152   prefixConstr s
 153     = case lex s of
 154         [(s'@(_:_),s'')] -> Just (Constr s',s'')
 155         _ -> Nothing
 156
 157 -}