{-# LANGUAGE TypeOperators #-}{-# LANGUAGE TypeSynonymInstances #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE OverlappingInstances #-}------------------------------------------------------------------------------- |-- Module : Generics.EMGM.Functions.Show-- Copyright : (c) 2008, 2009 Universiteit Utrecht-- License : BSD3---- Maintainer : generics@haskell.org-- Stability : experimental-- Portability : non-portable---- Summary: Generic functions that convert values to readable strings.---- The functions in this module involve generically producing a string from a-- value of a supported datatype. The functions 'showsPrec' and 'show' are-- modeled after those in the class @Show@, and 'shows' after the related-- function of the same name.---- The underlying unparser is designed to be as similar to @deriving Show@ as-- possible. Refer to documentation in "Text.Show" for details.---- Since this library does not have access to the syntax of a @data@-- declaration, it relies on 'ConDescr' for information. It is important that-- 'ConDescr' accurately describe, for each constructor, the name, arity, record-- labels (in same order as declared) if present, and fixity.---- See also "Generics.EMGM.Functions.Read".-----------------------------------------------------------------------------moduleGenerics.EMGM.Functions.Show(Show(..),showsPrec,shows,show,)whereimportPreludehiding(Show,showsPrec,show,shows)importqualifiedPreludeasP(Show,showsPrec,show)importqualifiedGHC.ShowasGHC(showList__)importGenerics.EMGM.Common------------------------------------------------------------------------------- Types-----------------------------------------------------------------------------typeShowsPreca=Int->a->ShowS-- | The type of a generic function that takes a constructor-type argument, a-- number (precedence), and a value and returns a 'ShowS' function.newtypeShowa=Show{selShow::ConType->Int->a->ShowS}-- NOTE: Use full type here instead of 'ShowsPrec' for Haddock.------------------------------------------------------------------------------- Utility functions-----------------------------------------------------------------------------showSpace::ShowSshowSpace=showChar' 'showBraces::ShowsPreca->ShowsPrecashowBracesshowsPrec'px=showChar'{'.showsPrec'px.showChar'}'showTuple::[ShowS]->ShowSshowTupless=showParenTrue$foldr1(\sr->s.showChar','.r)ssrecEntry::Bool->String->ShowsPreca->ShowsPrecarecEntrycommalabelshowsPrec'_x=showStringlabel.showString" = ".showsPrec'minPrecx.-- Reset precedence for record fieldsshowString(ifcommathen", "else"")------------------------------------------------------------------------------- Generic instance declaration-----------------------------------------------------------------------------rconstantShow::(P.Showa)=>ConType->ShowsPrecarconstantShowct=casectof-- Standard constructorConStd->P.showsPrec-- Record-style constructor with 1 labelConRec(label:[])->recEntryFalselabelP.showsPrec-- No other patterns expectedother->error$"rconstantShow: Unexpected constructor: '"++P.showother++"'"rsumShow::Showa->Showb->ConType->ShowsPrec(a:+:b)rsumShowra__p(La)=selShowraConStdparsumShow_rb_p(Rb)=selShowrbConStdpbrprodShow::Showa->Showb->ConType->ShowsPrec(a:*:b)rprodShowrarbctp(a:*:b)=casectof-- Standard nonfix constructorConStd->selShowStepraConStdpa.showSpace.selShowSteprbConStdpb-- Standard infix constructorConIfxsymbol->selShowStepraConStdpa.showSpace.showStringsymbol.showSpace.selShowSteprbConStdpb-- Record-style constructorConRec(label:labels)->letp'=p+1inrecEntryTruelabel(selShowStepraConStd)p'a.selShowSteprb(ConRec(labels))p'b-- No other patterns expectedother->error$"rprodShow: Unexpected constructor: '"++P.showother++"'"whereselShowSteprct'=selShowrct'.(+1)rconShow::ConDescr->Showa->ConType->ShowsPrecarconShowcdra_pa=casecdof-- Standard nonfix constructorConDescrnamearity[]Nonfix->lethasArgs=arity>0in-- Don't show parens if constructor has no argumentsshowParen(p>appPrec&&hasArgs)$showStringname.showString(ifhasArgsthen" "else"").showConStepConStdappPreca-- Standard infix constructorConDescrname_[]fixity->letconPrec=precfixityinshowParen(p>conPrec)$showConStep(ConIfxname)conPreca-- Record-style nonfix constructorConDescrname_labelsNonfix->-- NOTE: Technically, we can use 'recPrec' below, because the precedence-- for record construction is higher than function application. However,-- since GHC puts parens for 'appRec', we'll put them. That way, we can-- compare string output to deriving Show for testing.showParen(p>appPrec)$showStringname.showSpace.showBraces(selShowra(ConReclabels))minPreca-- Record-style infix constructorConDescrname_labels_->showParenTrue(showStringname).showSpace.showBraces(showConStep(ConReclabels))pawhereshowConStepct=selShowract.(+1)rtypeShow::EPba->Showa->ConType->ShowsPrecbrtypeShowepract=casectof-- Standard constructorConStd->selShowFromConStd-- Record-style constructorConRec(label:[])->recEntryFalselabel(selShowFromConStd)-- No other patterns expectedother->error$"rtypeShow: Unexpected constructor: '"++P.showother++"'"whereselShowFromct'p=selShowract'p.fromepinstanceGenericShowwhererconstant=ShowrconstantShowrsumrarb=Show(rsumShowrarb)rprodrarb=Show(rprodShowrarb)rconcdra=Show(rconShowcdra)rtypeepra=Show(rtypeShowepra)------------------------------------------------------------------------------- Rep instance declarations------------------------------------------------------------------------------- | Ad-hoc instance for listsinstance(RepShowa)=>RepShow[a]whererep=Show$const$const$GHC.showList__$selShowrepConStdminPrec-- | Ad-hoc instance for stringsinstanceRepShowStringwhererep=Show$constP.showsPrec-- | Ad-hoc instance for @()@instanceRepShow()whererep=Show$constP.showsPrec-- | Ad-hoc instance for @(a,b)@instance(RepShowa,RepShowb)=>RepShow(a,b)whererep=Showswheres__(a,b)=showTuple[showsa,showsb]-- | Ad-hoc instance for @(a,b,c)@instance(RepShowa,RepShowb,RepShowc)=>RepShow(a,b,c)whererep=Showswheres__(a,b,c)=showTuple[showsa,showsb,showsc]-- | Ad-hoc instance for @(a,b,c,d)@instance(RepShowa,RepShowb,RepShowc,RepShowd)=>RepShow(a,b,c,d)whererep=Showswheres__(a,b,c,d)=showTuple[showsa,showsb,showsc,showsd]-- | Ad-hoc instance for @(a,b,c,d,e)@instance(RepShowa,RepShowb,RepShowc,RepShowd,RepShowe)=>RepShow(a,b,c,d,e)whererep=Showswheres__(a,b,c,d,e)=showTuple[showsa,showsb,showsc,showsd,showse]-- | Ad-hoc instance for @(a,b,c,d,e,f)@instance(RepShowa,RepShowb,RepShowc,RepShowd,RepShowe,RepShowf)=>RepShow(a,b,c,d,e,f)whererep=Showswheres__(a,b,c,d,e,f)=showTuple[showsa,showsb,showsc,showsd,showse,showsf]-- | Ad-hoc instance for @(a,b,c,d,e,f,h)@instance(RepShowa,RepShowb,RepShowc,RepShowd,RepShowe,RepShowf,RepShowh)=>RepShow(a,b,c,d,e,f,h)whererep=Showswheres__(a,b,c,d,e,f,h)=showTuple[showsa,showsb,showsc,showsd,showse,showsf,showsh]------------------------------------------------------------------------------- Exported functions------------------------------------------------------------------------------- | Convert a value to a readable string starting with the operator precedence-- of the enclosing context.showsPrec::(RepShowa)=>Int-- ^ Operator precedence of the enclosing context (a number from 0 to 11).->a-- ^ The value to be converted to a 'String'.->ShowSshowsPrec=selShowrepConStd-- | A variant of 'showsPrec' with the minimum precedence (0).shows::(RepShowa)=>a->ShowSshows=showsPrec0-- | A variant of 'shows' that returns a 'String' instead of 'ShowS'.show::(RepShowa)=>a->Stringshow=flipshows""