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
  27 import Control.Monad
  28 import Data.Maybe
  29 import Data.Typeable
  30 import Data.Generics.Basics
  31 import Data.Generics.Aliases
  32 import Text.ParserCombinators.ReadP
  33
  34
  35 ------------------------------------------------------------------------------
  36
  37
  38 -- | Generic show: an alternative to \"deriving Show\"
  39 gshow :: Data a => a -> String
  40
  41 -- This is a prefix-show using surrounding "(" and ")",
  42 -- where we recurse into subterms with gmapQ.
  43 --
  44 gshow = ( \t ->
  45                 "("
  46              ++ conString (toConstr t)
  47              ++ concat (gmapQ ((++) " " . gshow) t)
  48              ++ ")"
  49         ) `extQ` (show :: String -> String)
  50
  51
  52
  53 -- | Generic read: an alternative to \"deriving Read\"
  54 gread :: Data a => ReadS a
  55
  56 {-
  57
  58 This is a read operation which insists on prefix notation.  (The
  59 Haskell 98 read deals with infix operators subject to associativity
  60 and precedence as well.) We use gunfoldR to "parse" the input. To be
  61 precise, gunfoldR is used for all types except String. The
  62 type-specific case for String uses basic String read.
  63
  64 -}
  65
  66 gread = readP_to_S gread'
  67
  68  where
  69
  70   gread' :: Data a => ReadP a
  71   gread' = gdefault `extR` scase
  72
  73
  74    where
  75
  76     -- A specific case for strings
  77     scase :: ReadP String
  78     scase = readS_to_P reads
  79
  80
  81     -- The generic default for gread
  82     -- gdefault :: Data a => ReadP a
  83     gdefault =
  84       do
  85                 -- Drop "  (  "
  86          skipSpaces                     -- Discard leading space
  87          char '('                       -- Parse '('
  88          skipSpaces                     -- Discard following space
  89
  90                 -- Do the real work
  91          str   <- parseConstr           -- Get a lexeme for the constructor
  92          con   <- str2con str           -- Convert it to a Constr (may fail)
  93          x     <- gunfoldR con gread'   -- Read the children
  94
  95                 -- Drop "  )  "
  96          skipSpaces                     -- Discard leading space
  97          char ')'                       -- Parse ')'
  98          skipSpaces                     -- Discard following space
  99
 100          return x
 101
 102      where
 103
 104         -- Get the datatype for the type at hand;
 105         -- use gdefault to provide the type at hand.
 106         myDataTypeOf :: Data a => ReadP a -> DataType
 107         myDataTypeOf (_::ReadP a) = dataTypeOf (undefined::a)
 108
 109         -- Turn string into constructor driven by gdefault's type,
 110         -- failing in the monad if it isn't a constructor of this data type
 111         str2con :: String -> ReadP Constr
 112         str2con = maybe mzero return
 113                 . stringCon (myDataTypeOf gdefault)
 114
 115         -- Get a Constr's string at the front of an input string
 116         parseConstr :: ReadP String
 117         parseConstr =
 118                string "[]"     -- Compound lexeme "[]"
 119           <++  infixOp         -- Infix operator in parantheses
 120           <++  readS_to_P lex  -- Ordinary constructors and literals
 121
 122         -- Handle infix operators such as (:)
 123         infixOp :: ReadP String
 124         infixOp = do c1  <- char '('
 125                      str <- munch1 (not . (==) ')')
 126                      c2  <- char ')'
 127                      return $ [c1] ++ str ++ [c2]