{- |
    Module      :  $Header$
    Description :  TODO
    Copyright   :  (c) 2017        Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

   TODO
-}
{-# LANGUAGE     CPP        #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Base.PrettyTypes where

#if __GLASGOW_HASKELL__ >= 804
import Prelude hiding ((<>))
#endif

import Data.Maybe (fromMaybe)
import qualified Data.Set as Set (Set, toAscList)

import Curry.Base.Ident (identSupply)
import Curry.Base.Pretty

import Base.CurryTypes
import Base.Types

instance Pretty Type where
  pPrint :: Type -> Doc
pPrint = Int -> TypeExpr -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0 (TypeExpr -> Doc) -> (Type -> TypeExpr) -> Type -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> Type -> TypeExpr
fromType [Ident]
identSupply

instance Pretty Pred where
  pPrint :: Pred -> Doc
pPrint = Constraint -> Doc
forall a. Pretty a => a -> Doc
pPrint (Constraint -> Doc) -> (Pred -> Constraint) -> Pred -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> Pred -> Constraint
fromPred [Ident]
identSupply

instance Pretty a => Pretty (Set.Set a) where
  pPrint :: Set a -> Doc
pPrint = Doc -> Doc
parens (Doc -> Doc) -> (Set a -> Doc) -> Set a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
list ([Doc] -> Doc) -> (Set a -> [Doc]) -> Set 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. Pretty a => a -> Doc
pPrint ([a] -> [Doc]) -> (Set a -> [a]) -> Set a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toAscList

instance Pretty PredType where
  pPrint :: PredType -> Doc
pPrint = QualTypeExpr -> Doc
forall a. Pretty a => a -> Doc
pPrint (QualTypeExpr -> Doc)
-> (PredType -> QualTypeExpr) -> PredType -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> PredType -> QualTypeExpr
fromPredType [Ident]
identSupply

instance Pretty DataConstr where
  pPrint :: DataConstr -> Doc
pPrint (DataConstr i :: Ident
i tys :: [Type]
tys)      = Ident -> Doc
forall a. Pretty a => a -> Doc
pPrint Ident
i Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Type -> Doc) -> [Type] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Doc
forall a. Pretty a => a -> Doc
pPrint [Type]
tys)
  pPrint (RecordConstr i :: Ident
i ls :: [Ident]
ls tys :: [Type]
tys) =     Ident -> Doc
forall a. Pretty a => a -> Doc
pPrint Ident
i
                                   Doc -> Doc -> Doc
<+> Doc -> Doc
braces ([Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma [Doc]
pLs))
    where
      pLs :: [Doc]
pLs = (Ident -> Type -> Doc) -> [Ident] -> [Type] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\l :: Ident
l ty :: Type
ty -> Ident -> Doc
forall a. Pretty a => a -> Doc
pPrint Ident
l Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Pretty a => a -> Doc
pPrint Type
ty) [Ident]
ls [Type]
tys

instance Pretty ClassMethod where
  pPrint :: ClassMethod -> Doc
pPrint (ClassMethod f :: Ident
f mar :: Maybe Int
mar pty :: PredType
pty) =     Ident -> Doc
forall a. Pretty a => a -> Doc
pPrint Ident
f
                                   Doc -> Doc -> Doc
<>  String -> Doc
text "/" Doc -> Doc -> Doc
<> Int -> Doc
int (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 Maybe Int
mar)
                                   Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> PredType -> Doc
forall a. Pretty a => a -> Doc
pPrint PredType
pty

instance Pretty TypeScheme where
  pPrint :: TypeScheme -> Doc
pPrint (ForAll _ ty :: PredType
ty) = PredType -> Doc
forall a. Pretty a => a -> Doc
pPrint PredType
ty