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.Generics.Basics
  32 import Data.Generics.Aliases
  33 import Text.ParserCombinators.ReadP
  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              ++ showConstr (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 fromConstrM to "parse" the input. To be
  61 precise, fromConstrM 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   -- Helper for recursive read
  71   gread' :: Data a' => ReadP a'
  72   gread' = allButString `extR` stringCase
  73
  74    where
  75
  76     -- A specific case for strings
  77     stringCase :: ReadP String
  78     stringCase = readS_to_P reads
  79
  80     -- Determine result type
  81     myDataType = dataTypeOf (getArg allButString)
  82      where
  83       getArg :: ReadP a'' -> a''
  84       getArg = undefined
  85
  86     -- The generic default for gread
  87     allButString =
  88       do
  89                 -- Drop "  (  "
  90          skipSpaces                     -- Discard leading space
  91          char '('                       -- Parse '('
  92          skipSpaces                     -- Discard following space
  93
  94                 -- Do the real work
  95          str  <- parseConstr            -- Get a lexeme for the constructor
  96          con  <- str2con str            -- Convert it to a Constr (may fail)
  97          x    <- fromConstrM gread' con -- Read the children
  98
  99                 -- Drop "  )  "
 100          skipSpaces                     -- Discard leading space
 101          char ')'                       -- Parse ')'
 102          skipSpaces                     -- Discard following space
 103
 104          return x
 105
 106     -- Turn string into constructor driven by the requested result type,
 107     -- failing in the monad if it isn't a constructor of this data type
 108     str2con :: String -> ReadP Constr
 109     str2con = maybe mzero return
 110             . readConstr myDataType
 111
 112     -- Get a Constr's string at the front of an input string
 113     parseConstr :: ReadP String
 114     parseConstr =
 115                string "[]"     -- Compound lexeme "[]"
 116           <++  infixOp         -- Infix operator in parantheses
 117           <++  readS_to_P lex  -- Ordinary constructors and literals
 118
 119     -- Handle infix operators such as (:)
 120     infixOp :: ReadP String
 121     infixOp = do c1  <- char '('
 122                  str <- munch1 (not . (==) ')')
 123                  c2  <- char ')'
 124                  return $ [c1] ++ str ++ [c2]