{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Haskell.Tools.Rewrite.Create.Kinds where
import Data.String (IsString(..), String)
import Language.Haskell.Tools.AST (UPromoted(..), UKind(..), UKindConstraint(..))
import Language.Haskell.Tools.PrettyPrint.Prepare
import Language.Haskell.Tools.Rewrite.Create.Utils (mkAnn, mkAnnList)
import Language.Haskell.Tools.Rewrite.ElementTypes (Name, Kind, KindConstraint)
mkKindConstraint :: Kind -> KindConstraint
mkKindConstraint = mkAnn (" :: " <> child) . UKindConstraint
mkKindStar :: Kind
mkKindStar = mkAnn "*" UStarKind
mkKindUnbox :: Kind
mkKindUnbox = mkAnn "#" UUnboxKind
mkKindFun :: Kind -> Kind -> Kind
mkKindFun lhs rhs = mkAnn (child <> " -> " <> child) $ UFunKind lhs rhs
mkKindParen :: Kind -> Kind
mkKindParen = mkAnn ("(" <> child <> ")") . UParenKind
mkKindVar :: Name -> Kind
mkKindVar = mkAnn child . UVarKind
mkKindApp :: Kind -> Kind -> Kind
mkKindApp lhs rhs = mkAnn (child <> " " <> child) $ UAppKind lhs rhs
mkKindList :: Kind -> Kind
mkKindList = mkAnn ("[" <> child <> "]") . UListKind
mkIntKind :: Integer -> Kind
mkIntKind i = mkAnn child $ UPromotedKind $ mkAnn (fromString $ show i) (UPromotedInt i)
mkStringKind :: String -> Kind
mkStringKind i = mkAnn child $ UPromotedKind $ mkAnn (fromString $ show i) (UPromotedString i)
mkConKind :: Name -> Kind
mkConKind = mkAnn child . UPromotedKind . mkAnn child . UPromotedCon
mkListKind :: [Kind] -> Kind
mkListKind = mkAnn child . UPromotedKind . mkAnn ("[" <> child <> "]") . UPromotedList . mkAnnList (separatedBy ", " list)
mkTupleKind :: [Kind] -> Kind
mkTupleKind = mkAnn child . UPromotedKind . mkAnn ("(" <> child <> ")") . UPromotedTuple . mkAnnList (separatedBy ", " list)
mkUnitKind :: Kind
mkUnitKind = mkAnn child $ UPromotedKind $ mkAnn "()" UPromotedUnit