{-# language FlexibleInstances #-}
{-# language OverlappingInstances #-}
{-# language IncoherentInstances #-}

module Autolib.ToDoc.Manual (
 -- instances, mostly
-- Clip (..)
) where

import Autolib.ToDoc.Class
import Autolib.ToDoc.Dutch
import Autolib.ToDoc.Frame
import Autolib.ToDoc.Beside

import Data.Bimap (Bimap, toAscList)
import Data.Int
import Data.Typeable ( Typeable )
import Data.Ratio
import Numeric.Natural
import qualified Data.Text as T

instance ToDoc Int   where toDocPrec :: Int -> Int -> Doc
toDocPrec = (Int -> Doc) -> Int -> Int -> Doc
forall {a} {a}.
(Ord a, Ord a, Num a, Num a) =>
(a -> Doc) -> a -> a -> Doc
signed Int -> Doc
int
instance ToDoc Int32 where toDocPrec :: Int -> Int32 -> Doc
toDocPrec = (Int32 -> Doc) -> Int -> Int32 -> Doc
forall {a} {a}.
(Ord a, Ord a, Num a, Num a) =>
(a -> Doc) -> a -> a -> Doc
signed ( Int -> Doc
int (Int -> Doc) -> (Int32 -> Int) -> Int32 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral )
instance ToDoc Int16 where toDocPrec :: Int -> Int16 -> Doc
toDocPrec = (Int16 -> Doc) -> Int -> Int16 -> Doc
forall {a} {a}.
(Ord a, Ord a, Num a, Num a) =>
(a -> Doc) -> a -> a -> Doc
signed ( Int -> Doc
int (Int -> Doc) -> (Int16 -> Int) -> Int16 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral )
instance ToDoc Integer where toDocPrec :: Int -> Integer -> Doc
toDocPrec = (Integer -> Doc) -> Int -> Integer -> Doc
forall {a} {a}.
(Ord a, Ord a, Num a, Num a) =>
(a -> Doc) -> a -> a -> Doc
signed Integer -> Doc
integer
instance ToDoc Natural where toDocPrec :: Int -> Natural -> Doc
toDocPrec Int
_ = Integer -> Doc
integer (Integer -> Doc) -> (Natural -> Integer) -> Natural -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToDoc Float where toDocPrec :: Int -> Float -> Doc
toDocPrec = (Float -> Doc) -> Int -> Float -> Doc
forall {a} {a}.
(Ord a, Ord a, Num a, Num a) =>
(a -> Doc) -> a -> a -> Doc
signed Float -> Doc
float
instance ToDoc Double where toDocPrec :: Int -> Double -> Doc
toDocPrec = (Double -> Doc) -> Int -> Double -> Doc
forall {a} {a}.
(Ord a, Ord a, Num a, Num a) =>
(a -> Doc) -> a -> a -> Doc
signed Double -> Doc
double

signed :: (a -> Doc) -> a -> a -> Doc
signed a -> Doc
f a
p a
x = Bool -> Doc -> Doc
docParen (a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ a -> Doc
f a
x

instance ToDoc Char where
  toDocPrec :: Int -> Char -> Doc
toDocPrec Int
_ = [Char] -> Doc
text ([Char] -> Doc) -> (Char -> [Char]) -> Char -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char]
forall a. Show a => a -> [Char]
show
  toDocList :: [Char] -> Doc
toDocList = [Char] -> Doc
text ([Char] -> Doc) -> ([Char] -> [Char]) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. Show a => a -> [Char]
show

-- with quotes, so that it can be parsed.
-- for nice output (no quotes), use @nice@
instance ToDoc T.Text where toDocPrec :: Int -> Text -> Doc
toDocPrec Int
_ = [Char] -> Doc
text ([Char] -> Doc) -> (Text -> [Char]) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a. Show a => a -> [Char]
show 
instance Nice T.Text where nice :: Text -> Doc
nice = Text -> Doc
text_

instance ( Integral a, ToDoc a ) => ToDoc ( Ratio a ) where
    toDocPrec :: Int -> Ratio a -> Doc
toDocPrec Int
p Ratio a
r = Bool -> Doc -> Doc
docParen ( Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ) 
        (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ case (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r, Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r) of
            (a
n,a
1) -> a -> Doc
forall a. ToDoc a => a -> Doc
toDoc a
n
            (a
n,a
d) -> [Doc] -> Doc
hsep [ a -> Doc
forall a. ToDoc a => a -> Doc
toDoc a
n , [Char] -> Doc
text [Char]
"/", a -> Doc
forall a. ToDoc a => a -> Doc
toDoc a
d ]

instance ToDoc () where
    toDocPrec :: Int -> () -> Doc
toDocPrec Int
_ () = [Doc] -> Doc
dutch_tuple ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ ]

instance (ToDoc a, ToDoc b) => ToDoc (a, b) where
    toDocPrec :: Int -> (a, b) -> Doc
toDocPrec Int
_ (a
x,b
y) = [Doc] -> Doc
dutch_tuple
              ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ Int -> a -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 a
x, Int -> b -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 b
y ]

instance (ToDoc a, ToDoc b, ToDoc c) => ToDoc (a, b, c) where
    toDocPrec :: Int -> (a, b, c) -> Doc
toDocPrec Int
_ (a
x,b
y,c
z) = [Doc] -> Doc
dutch_tuple
              ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ Int -> a -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 a
x, Int -> b -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 b
y, Int -> c -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 c
z]

instance (ToDoc a, ToDoc b, ToDoc c, ToDoc d) => ToDoc (a, b, c, d) where
    toDocPrec :: Int -> (a, b, c, d) -> Doc
toDocPrec Int
_ (a
x,b
y,c
z,d
q) = [Doc] -> Doc
dutch_tuple
              ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ Int -> a -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 a
x, Int -> b -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 b
y, Int -> c -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 c
z, Int -> d -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 d
q]


instance (Nice a, Nice b) => Nice (a, b) where
    nicePrec :: Int -> (a, b) -> Doc
nicePrec Int
p (a
x,b
y) = [Doc] -> Doc
nice_tuple
              ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ Int -> a -> Doc
forall a. Nice a => Int -> a -> Doc
nicePrec Int
0 a
x, Int -> b -> Doc
forall a. Nice a => Int -> a -> Doc
nicePrec Int
0 b
y ]

instance (Nice a, Nice b, Nice c) => Nice (a, b, c) where
    nicePrec :: Int -> (a, b, c) -> Doc
nicePrec Int
p (a
x,b
y,c
z) = [Doc] -> Doc
nice_tuple
              ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ Int -> a -> Doc
forall a. Nice a => Int -> a -> Doc
nicePrec Int
0 a
x, Int -> b -> Doc
forall a. Nice a => Int -> a -> Doc
nicePrec Int
0 b
y, Int -> c -> Doc
forall a. Nice a => Int -> a -> Doc
nicePrec Int
0 c
z]

instance (Nice a, Nice b, Nice c, Nice d) => Nice (a, b, c, d) where
    nicePrec :: Int -> (a, b, c, d) -> Doc
nicePrec Int
p (a
x,b
y,c
z,d
q) = [Doc] -> Doc
nice_tuple
              ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ Int -> a -> Doc
forall a. Nice a => Int -> a -> Doc
nicePrec Int
0 a
x, Int -> b -> Doc
forall a. Nice a => Int -> a -> Doc
nicePrec Int
0 b
y, Int -> c -> Doc
forall a. Nice a => Int -> a -> Doc
nicePrec Int
0 c
z, Int -> d -> Doc
forall a. Nice a => Int -> a -> Doc
nicePrec Int
0 d
q]

-- | TODO: parentheses, commas
nice_tuple :: [Doc] -> Doc
nice_tuple = Doc -> Doc
frame (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
besides 
-- | TODO: parentheses, commas
nice_list :: [Doc] -> Doc
nice_list [Doc]
xs = 
    if [Doc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Doc] -> Bool) -> [Doc] -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> [Doc] -> [Doc]
forall a. Int -> [a] -> [a]
drop Int
3 [Doc]
xs
    then Doc -> Doc
frame (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
besides [Doc]
xs
    else Doc -> Doc
frame (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
xs

-- brauchen wir tatsächlich, für SQLqueries
instance (ToDoc a, ToDoc b, ToDoc c, ToDoc d, ToDoc e) 
    => ToDoc (a, b, c, d, e) where
    toDocPrec :: Int -> (a, b, c, d, e) -> Doc
toDocPrec Int
_ (a
x,b
y,c
z,d
q,e
r) = [Doc] -> Doc
dutch_tuple
              ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ Int -> a -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 a
x, Int -> b -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 b
y, Int -> c -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 c
z
                , Int -> d -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 d
q, Int -> e -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 e
r
                ]

instance ToDoc a => ToDoc [a] where
    toDocPrec :: Int -> [a] -> Doc
toDocPrec Int
_ = [a] -> Doc
forall a. ToDoc a => [a] -> Doc
toDocList

instance Nice String where 
    nicePrec :: Int -> [Char] -> Doc
nicePrec Int
p = [Char] -> Doc
forall a. ToDoc a => a -> Doc
toDoc

instance Nice a => Nice [a] where
    nicePrec :: Int -> [a] -> Doc
nicePrec Int
p [a]
xs = [Doc] -> Doc
nice_list ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$  (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Nice a => a -> Doc
nice [a]
xs

instance ToDoc (a -> b) where
    toDocPrec :: Int -> (a -> b) -> Doc
toDocPrec Int
_ a -> b
f = [Char] -> Doc
text [Char]
"<<function>>"

instance {-# overlapping #-} ToDoc String where
    toDocPrec :: Int -> [Char] -> Doc
toDocPrec Int
_ = [Char] -> Doc
text ([Char] -> Doc) -> ([Char] -> [Char]) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. Show a => a -> [Char]
show


-- (un)clipped lists/strings

{-

data Clip a = Full [a] | Clip Int [a]
              deriving ( Eq , Ord , Show , Read , Typeable )

instance ToDoc a => ToDoc (Clip a) where 
    toDocPrec _ (Full   xs) = dutch_list $ map toDoc xs
    toDocPrec _ (Clip n xs) = dutch_list $ map toDoc xs

-- overlapping
instance ToDoc (Clip Char) where
    toDocPrec _ (Full   cs) = text $ show cs
    toDocPrec _ (Clip _ cs) = text $ show cs

-}

instance ToDoc Doc where
    toDocPrec :: Int -> Doc -> Doc
toDocPrec Int
_ = [Char] -> Doc
text ([Char] -> Doc) -> (Doc -> [Char]) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. Show a => a -> [Char]
show ([Char] -> [Char]) -> (Doc -> [Char]) -> Doc -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Char]
render

putz :: ToDoc a => [a] -> IO ()
-- benutzt implizit  take max_list_length
putz :: forall a. ToDoc a => [a] -> IO ()
putz = [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> ([a] -> [Char]) -> [a] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Char]
render (Doc -> [Char]) -> ([a] -> Doc) -> [a] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Doc
forall a. ToDoc a => [a] -> Doc
toDocList

instance (ToDoc a, ToDoc b) => ToDoc (Bimap a b) where
  toDocPrec :: Int -> Bimap a b -> Doc
toDocPrec Int
p Bimap a b
fm =
    Bool -> Doc -> Doc
docParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fcp) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"listToFM" Doc -> Doc -> Doc
</> Int -> [(a, b)] -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
fcp (Bimap a b -> [(a, b)]
forall a b. Bimap a b -> [(a, b)]
toAscList Bimap a b
fm)