{-# language DefaultSignatures #-}
{-# language FlexibleInstances #-}
{-# language FlexibleContexts #-}
{-# language UndecidableInstances #-}
{-# language TypeOperators #-}
{-# language DeriveGeneric #-}

module Autolib.ToDoc.Class 

( ToDoc (..), toDoc, Nice (..), docParen, fcp
-- , module Text.PrettyPrint.HughesPJ
, module Autolib.Multilingual.Doc
)

where

-- import Text.PrettyPrint.HughesPJ
import Autolib.Multilingual.Doc
import Autolib.ToDoc.Dutch

import GHC.Generics
import Data.List (isSuffixOf)

-- | should be re-readable with Reader
class ToDoc a where 
    toDocPrec :: Int -> a -> Doc
    default toDocPrec :: (Generic a, GToDoc (Rep a))
                      => Int -> a -> Doc
    toDocPrec Int
p = [Doc] -> Doc
cat ([Doc] -> Doc) -> (a -> [Doc]) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Int -> Rep a (ZonkAny 0) -> [Doc]
forall p. Type -> Int -> Rep a p -> [Doc]
forall (f :: * -> *) p. GToDoc f => Type -> Int -> f p -> [Doc]
gToDocPrec Type
Pref Int
p (Rep a (ZonkAny 0) -> [Doc])
-> (a -> Rep a (ZonkAny 0)) -> a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a (ZonkAny 0)
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from
    
    toDocList :: [a] -> Doc
    toDocList = [Doc] -> Doc
dutch_list ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. ToDoc a => a -> Doc
toDoc

toDoc :: ToDoc a => a -> Doc
toDoc :: forall a. ToDoc a => a -> Doc
toDoc = Int -> a -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0

-- | this is modelled after
-- https://github.com/dreixel/generic-deriving/blob/master/src/Generics/Deriving/Show.hs

data Type = Rec | Tup | Pref

class GToDoc f where
  gToDocPrec :: Type -> Int -> f p -> [Doc]

instance GToDoc U1 where
  gToDocPrec :: forall p. Type -> Int -> U1 p -> [Doc]
gToDocPrec Type
_ Int
p U1 p
_ = []
instance ToDoc c => GToDoc (K1 i c) where
  gToDocPrec :: forall p. Type -> Int -> K1 i c p -> [Doc]
gToDocPrec Type
_ Int
p K1 i c p
a = [ Int -> c -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
p ( K1 i c p -> c
forall k i c (p :: k). K1 i c p -> c
unK1 K1 i c p
a) ]
instance (GToDoc f, GToDoc g) => GToDoc (f :+: g) where
  gToDocPrec :: forall p. Type -> Int -> (:+:) f g p -> [Doc]
gToDocPrec Type
_ Int
p (L1 f p
x) = Type -> Int -> f p -> [Doc]
forall p. Type -> Int -> f p -> [Doc]
forall (f :: * -> *) p. GToDoc f => Type -> Int -> f p -> [Doc]
gToDocPrec Type
Pref Int
p f p
x
  gToDocPrec Type
_ Int
p (R1 g p
x) = Type -> Int -> g p -> [Doc]
forall p. Type -> Int -> g p -> [Doc]
forall (f :: * -> *) p. GToDoc f => Type -> Int -> f p -> [Doc]
gToDocPrec Type
Pref Int
p g p
x
instance (GToDoc f, GToDoc g) => GToDoc (f :*: g) where
  gToDocPrec :: forall p. Type -> Int -> (:*:) f g p -> [Doc]
gToDocPrec Type
t Int
p (f p
x :*: g p
y) = Type -> Int -> f p -> [Doc]
forall p. Type -> Int -> f p -> [Doc]
forall (f :: * -> *) p. GToDoc f => Type -> Int -> f p -> [Doc]
gToDocPrec Type
t Int
p f p
x [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Type -> Int -> g p -> [Doc]
forall p. Type -> Int -> g p -> [Doc]
forall (f :: * -> *) p. GToDoc f => Type -> Int -> f p -> [Doc]
gToDocPrec Type
t Int
p g p
y
instance (Constructor c, GToDoc f) => GToDoc (C1 c f) where
  gToDocPrec :: forall p. Type -> Int -> C1 c f p -> [Doc]
gToDocPrec Type
_ Int
p c :: C1 c f p
c@(M1 f p
x) =
    if C1 c f p -> Bool
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Bool
conIsRecord C1 c f p
c
    then [ ( if Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fcp then Doc -> Doc
parens else Doc -> Doc
forall a. a -> a
id )
          (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> Doc
named_dutch_record (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ C1 c f p -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName C1 c f p
c) (Type -> Int -> f p -> [Doc]
forall p. Type -> Int -> f p -> [Doc]
forall (f :: * -> *) p. GToDoc f => Type -> Int -> f p -> [Doc]
gToDocPrec Type
Rec Int
p f p
x)
         ]
    else case Type -> Int -> f p -> [Doc]
forall p. Type -> Int -> f p -> [Doc]
forall (f :: * -> *) p. GToDoc f => Type -> Int -> f p -> [Doc]
gToDocPrec Type
Pref Int
p f p
x of
      [] -> [ String -> Doc
text (C1 c f p -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName C1 c f p
c) ]
      [Doc]
ds -> [ ( if Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fcp then Doc -> Doc
parens else Doc -> Doc
forall a. a -> a
id )
              (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (C1 c f p -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName C1 c f p
c) Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Type -> Int -> f p -> [Doc]
forall p. Type -> Int -> f p -> [Doc]
forall (f :: * -> *) p. GToDoc f => Type -> Int -> f p -> [Doc]
gToDocPrec Type
Pref Int
fcp f p
x)
            ]

instance (Selector s, GToDoc f) => GToDoc (S1 s f) where
  gToDocPrec :: forall p. Type -> Int -> S1 s f p -> [Doc]
gToDocPrec Type
Rec Int
p s :: S1 s f p
s@(M1 f p
x) | String
"_info" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` (S1 s f p -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName S1 s f p
s) = []
  gToDocPrec Type
Rec Int
p s :: S1 s f p
s@(M1 f p
x) =
    [ Doc -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
forall {b}. Type b -> Type b
align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (S1 s f p -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName S1 s f p
s) Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> [Doc] -> Doc
cat ( Type -> Int -> f p -> [Doc]
forall p. Type -> Int -> f p -> [Doc]
forall (f :: * -> *) p. GToDoc f => Type -> Int -> f p -> [Doc]
gToDocPrec Type
Pref Int
p f p
x ) ]
  gToDocPrec Type
Pref Int
p s :: S1 s f p
s@(M1 f p
x) =
    Type -> Int -> f p -> [Doc]
forall p. Type -> Int -> f p -> [Doc]
forall (f :: * -> *) p. GToDoc f => Type -> Int -> f p -> [Doc]
gToDocPrec Type
Pref Int
fcp f p
x
instance ( GToDoc f) => GToDoc (M1 D c f) where
  gToDocPrec :: forall p. Type -> Int -> M1 D c f p -> [Doc]
gToDocPrec Type
_ Int
p c :: M1 D c f p
c@(M1 f p
x) = Type -> Int -> f p -> [Doc]
forall p. Type -> Int -> f p -> [Doc]
forall (f :: * -> *) p. GToDoc f => Type -> Int -> f p -> [Doc]
gToDocPrec Type
Pref Int
p f p
x

data B = F | T deriving (forall x. B -> Rep B x) -> (forall x. Rep B x -> B) -> Generic B
forall x. Rep B x -> B
forall x. B -> Rep B x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. B -> Rep B x
from :: forall x. B -> Rep B x
$cto :: forall x. Rep B x -> B
to :: forall x. Rep B x -> B
Generic
instance ToDoc B

data Foo = Foo | Bar B B | Baz { Foo -> B
baz :: B, Foo -> B
bum :: B }
         | Bam Foo deriving (forall x. Foo -> Rep Foo x)
-> (forall x. Rep Foo x -> Foo) -> Generic Foo
forall x. Rep Foo x -> Foo
forall x. Foo -> Rep Foo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Foo -> Rep Foo x
from :: forall x. Foo -> Rep Foo x
$cto :: forall x. Rep Foo x -> Foo
to :: forall x. Rep Foo x -> Foo
Generic
instance ToDoc Foo

-- | like ToDoc, but not intended to be re-readable
class ToDoc a => Nice a where 
    nicePrec :: Int -> a -> Doc
    nicePrec Int
p = Int -> a -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
p

    nice :: a -> Doc
    nice = Int -> a -> Doc
forall a. Nice a => Int -> a -> Doc
nicePrec Int
0

instance ToDoc a => Nice a


docParen :: Bool -> Doc -> Doc
docParen :: Bool -> Doc -> Doc
docParen Bool
f = if Bool
f then Doc -> Doc
parens else Doc -> Doc
forall a. a -> a
id

-- | zur ausgabe ohne zeilenschaltungen
-- TODO: sollte besser gehen (anderen renderer wählen?)
showDoc :: Doc -> String
showDoc :: Doc -> String
showDoc = [String] -> String
unwords ([String] -> String) -> (Doc -> [String]) -> Doc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String]) -> (Doc -> String) -> Doc -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render


-- | funcall precedence
fcp :: Int
fcp = Int
10 :: Int