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]