forked from GitHub/gf-core
GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3
This commit is contained in:
51
src-3.0/GF/Infra/PrintClass.hs
Normal file
51
src-3.0/GF/Infra/PrintClass.hs
Normal file
@@ -0,0 +1,51 @@
|
||||
module GF.Infra.PrintClass where
|
||||
|
||||
import Data.List (intersperse)
|
||||
|
||||
class Print a where
|
||||
prt :: a -> String
|
||||
prtList :: [a] -> String
|
||||
prtList as = "[" ++ prtSep "," as ++ "]"
|
||||
|
||||
prtSep :: Print a => String -> [a] -> String
|
||||
prtSep sep = concat . intersperse sep . map prt
|
||||
|
||||
prtBefore :: Print a => String -> [a] -> String
|
||||
prtBefore before = prtBeforeAfter before ""
|
||||
|
||||
prtAfter :: Print a => String -> [a] -> String
|
||||
prtAfter after = prtBeforeAfter "" after
|
||||
|
||||
prtBeforeAfter :: Print a => String -> String -> [a] -> String
|
||||
prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ]
|
||||
|
||||
prtPairList :: (Print a, Print b) => String -> String -> [(a,b)] -> String
|
||||
prtPairList comma sep xys = prtSep sep [ prt x ++ comma ++ prt y | (x,y) <- xys ]
|
||||
prIO :: Print a => a -> IO ()
|
||||
prIO = putStr . prt
|
||||
|
||||
instance Print a => Print [a] where
|
||||
prt = prtList
|
||||
|
||||
instance (Print a, Print b) => Print (a, b) where
|
||||
prt (a, b) = "(" ++ prt a ++ "," ++ prt b ++ ")"
|
||||
|
||||
instance (Print a, Print b, Print c) => Print (a, b, c) where
|
||||
prt (a, b, c) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ ")"
|
||||
|
||||
instance (Print a, Print b, Print c, Print d) => Print (a, b, c, d) where
|
||||
prt (a, b, c, d) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ "," ++ prt d ++ ")"
|
||||
|
||||
instance Print Char where
|
||||
prt = return
|
||||
prtList = id
|
||||
|
||||
instance Print Int where
|
||||
prt = show
|
||||
|
||||
instance Print Integer where
|
||||
prt = show
|
||||
|
||||
instance Print a => Print (Maybe a) where
|
||||
prt (Just a) = prt a
|
||||
prt Nothing = "Nothing"
|
||||
Reference in New Issue
Block a user