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 (gmapQ ((++) " " . 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)) deriving Typeable
  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 instance MonadPlus GRead where
  65  mzero = GRead (\_ -> Nothing)
  66  mplus = undefined
  67
  68
  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)
  72
  73
  74 -- | Generic read: an alternative to \"deriving Read\"
  75 gread :: Data a => String -> Maybe (a, String)
  76
  77 {-
  78
  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.
  84
  85 -}
  86
  87
  88 gread = unGRead gread'
  89
  90  where
  91
  92   gread' :: GenericB GRead
  93   gread' = gdefault `extB` scase
  94
  95    where
  96
  97     -- a specific case for strings
  98     scase = GRead ( \s -> case reads s of
  99                             [x::(String,String)] -> Just x
 100                             _ -> Nothing
 101                   )
 102
 103     -- the generic default for gread
 104     gdefault =
 105       do
 106         trafo $  dropWhile ((==) ' ')
 107         query $  not . (==) ""
 108         query $  (==) '(' . head
 109         trafo $  tail
 110         trafo $  dropWhile ((==) ' ')
 111         str   <- parseConstr
 112         con   <- str2con str
 113         x     <- gunfoldM con gread'
 114         trafo $  dropWhile ((==) ' ')
 115         query $  not . (==) ""
 116         query $  (==) ')' . head
 117         trafo $  tail
 118         return x
 119
 120      where
 121        -- Turn string into constructor driven by gdefault's type
 122        str2con = maybe mzero return
 123                .
 124                  (    stringCon         -- look up constructor at hand
 125                     $ dataTypeOf        -- get handle on all constructurs
 126                     $ undefinedType     -- turn type value into undefined
 127                     $ paraType          -- get a handle on a in m a
 128                     $ gdefault          -- use as type argument
 129                  )
 130 {-
 131   foo =
 132     do s' <- return $ dropWhile ((==) ' ') s
 133        guard (not (s' == ""))
 134        guard (head s' == '(')
 135        (c,s'')  <- parseConstr (dropWhile ((==) ' ') (tail s'))
 136        u  <- return undefined
 137        dt <- return $ dataTypeOf u
 138        case stringCon dt c of
 139         Nothing -> error "Data.Generics.String: gread failed"
 140         Just c' ->
 141           gunfoldm c' gread
 142
 143        guard ( or [ maxConIndex (dataTypeOf u) == 0
 144                   , c `elem` constrsOf u
 145                   ]
 146              )
 147        (a,s''') <- unGRead (gunfold f z c) s''
 148        _ <- return $ constrainTypes a u
 149        guard (not (s''' == ""))
 150        guard (head s''' == ')')
 151        return (a, tail s''')
 152 -}
 153
 154   -- Get a Constr's string at the front of an input string
 155   parseConstr :: GRead String
 156
 157   parseConstr = GRead ( \s -> case s of
 158
 159     -- Infix operators are prefixed in parantheses
 160     ('(':s) -> case break ((==) ')') s of
 161                  (s'@(_:_),(')':s'')) -> Just ("(" ++ s' ++ ")", s'')
 162                  _ -> Nothing
 163
 164     -- Special treatment of multiple token constructors
 165     ('[':']':s) -> Just ("[]",s)
 166
 167     -- Try lex for ordinary constructor and basic datatypes
 168     s -> case lex s of
 169            [(s'@(_:_),s'')] -> Just (s',s'')
 170            _ -> Nothing
 171
 172     )
 173