module Printer (canonical, canonicalString,
                basic, basicString,
                advanced, advancedString
               ) where

import Sexpr

import Data.Char
import Data.Maybe
import Text.PrettyPrint
import qualified Codec.Binary.Base64.String as B64

instance Show Sexpr where
    show s = advancedString s

raw s = shows (length s) . showString ":" . showString s

canonicalString s = canonical s ""

canonical :: Sexpr -> ShowS
canonical s | isAtom s && hint s == Just defaultHint = raw $ unAtom s
canonical s | isAtom s = showString "[" 
                             . raw (fromJust $ hint s)
                             . showString "]"
                             . raw (unAtom s)
canonical s | isList s = showString "("
                 . showString (foldr (.) id (map canonical $ unList s) $ "")
                 . showString ")"

basicString s = render $ basic s

basic :: Sexpr -> Doc
basic s = braces . hcat $ map char . B64.encode $ canonical s ""
-- FIXME should basic add and encode a NUL terminator?
-- FIXMIE We parse it out in canonical---should canonical encodings end with a NUL? 

advancedString s = render $ advanced s


format s | canToken s = text s
         | canQuote s = quote s
         | canHex s = hex s
         | otherwise = base64 s

canToken (x:xs) = isInitialTokenChar x && all isTokenChar xs

canQuote s = all isQuoteableChar s
             || fromIntegral (length (show s)) <= 1.1 * fromIntegral (length s)

canHex s = length s `elem` [1,2,3,4,8,16,20]

hex s = text (show $ length s) <> (char '#') <> hcat (map (text . hexEncode) s) <> (char '#')

hexEncode x = (intToDigit h) : (intToDigit o) : []
    where 
      (h,o) = quotRem (ord x) 16

quote s = text $ show s

base64 s = (char '|') <> hcat (map char $ B64.encode s) <> (char '|')

advanced s | isAtom s && hint s == Just defaultHint = format $ unAtom s
advanced s | isAtom s = brackets (format $ fromJust $ hint s) 
                        <> (format $ unAtom s) 
advanced s | isList s = parens $ sep (map advanced $ unList s)