module DrIFT.Perl5 where
import Data.Ratio
import Data.Word
import Data.List (intersperse)
import Codec.Binary.UTF8.String (encodeString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
type Perl5Class = String
type Perl5Key = String
type Perl5Val = String
class (Show a) => Perl5 a where
showPerl5 :: a -> String
showPerl5 x = show (show x)
showP5ArrayObj :: Perl5Class -> [Perl5Val] -> String
showP5ArrayObj = showP5Obj showP5Array
showP5HashObj :: Perl5Class -> [(Perl5Key, Perl5Val)] -> String
showP5HashObj = showP5Obj showP5Hash
showP5Array :: [Perl5Val] -> String
showP5Array xs = ('[' : (concat $ intersperse "," xs)) ++ "]"
showP5Hash :: [(Perl5Key, Perl5Val)] -> String
showP5Hash xs = ('{' : (concat $ intersperse "," (map showPair xs))) ++ "}"
where
showPair (k, v) = k ++ " => " ++ v
showP5Class :: Perl5Class -> String
showP5Class = show
showP5Obj :: (a -> String) -> Perl5Class -> a -> String
showP5Obj f cls dat = "bless(" ++ f dat ++ " , " ++ showP5Class cls ++ ")"
instance Perl5 () where
showPerl5 _ = "undef"
instance Perl5 Int where
showPerl5 = show
instance Perl5 Word where
showPerl5 = show
instance Perl5 S.ByteString where
showPerl5 = showPerl5 . S.unpack
instance Perl5 L.ByteString where
showPerl5 = showPerl5 . L.unpack
instance Perl5 String where
showPerl5 str = "\"" ++ concatMap escape (encodeString str) ++ "\""
where
escape '\\' = "\\\\"
escape '"' = "\\\""
escape '$' = "\\$"
escape '@' = "\\@"
escape '%' = "\\%"
escape x = x:""
instance Perl5 Bool where
showPerl5 True = "1"
showPerl5 False = "0"
instance Perl5 Integer where
showPerl5 = show
instance Perl5 Rational where
showPerl5 r = showPerl5 (x, y)
where
x = numerator r
y = denominator r
instance Perl5 Double where
showPerl5 num | show num == "Infinity" = "Math::BigInt->binf"
| show num == "-Infinity" = "Math::BigInt->binf('-')"
| show num == "NaN" = "Math::BigInt->bnan"
| otherwise = show num
instance (Perl5 a) => Perl5 (Maybe a) where
showPerl5 (Just x) = showPerl5 x
showPerl5 Nothing = "(undef)"
instance (Perl5 a) => Perl5 [a] where
showPerl5 = showP5Array . map showPerl5
instance (Perl5 a, Perl5 b) => Perl5 (a, b) where
showPerl5 (x, y) = showP5Array [showPerl5 x, showPerl5 y]
instance (Perl5 a, Perl5 b, Perl5 c) => Perl5 (a, b, c) where
showPerl5 (x, y, z) = showP5Array [showPerl5 x, showPerl5 y, showPerl5 z]