-- | Utilities for use in transformations

module Hydra.Printing where

import qualified Hydra.Basics as Basics
import qualified Hydra.Core as Core
import qualified Hydra.Lib.Literals as Literals
import qualified Hydra.Lib.Strings as Strings
import qualified Hydra.Mantle as Mantle
import Data.Int
import Data.List as L
import Data.Map as M
import Data.Set as S

-- | Display a floating-point type as a string
describeFloatType :: (Core.FloatType -> String)
describeFloatType :: FloatType -> String
describeFloatType FloatType
t = ([String] -> String
Strings.cat [
  (\FloatType
x -> Precision -> String
describePrecision (FloatType -> Precision
Basics.floatTypePrecision FloatType
x)) FloatType
t,
  String
" floating-point numbers"])

-- | Display an integer type as a string
describeIntegerType :: (Core.IntegerType -> String)
describeIntegerType :: IntegerType -> String
describeIntegerType IntegerType
t = ([String] -> String
Strings.cat [
  (\IntegerType
x -> Precision -> String
describePrecision (IntegerType -> Precision
Basics.integerTypePrecision IntegerType
x)) IntegerType
t,
  String
" integers"])

-- | Display a literal type as a string
describeLiteralType :: (Core.LiteralType -> String)
describeLiteralType :: LiteralType -> String
describeLiteralType LiteralType
x = case LiteralType
x of
  LiteralType
Core.LiteralTypeBinary -> String
"binary strings"
  LiteralType
Core.LiteralTypeBoolean -> String
"boolean values"
  Core.LiteralTypeFloat FloatType
v289 -> (FloatType -> String
describeFloatType FloatType
v289)
  Core.LiteralTypeInteger IntegerType
v290 -> (IntegerType -> String
describeIntegerType IntegerType
v290)
  LiteralType
Core.LiteralTypeString -> String
"character strings"

-- | Display numeric precision as a string
describePrecision :: (Mantle.Precision -> String)
describePrecision :: Precision -> String
describePrecision Precision
x = case Precision
x of
  Precision
Mantle.PrecisionArbitrary -> String
"arbitrary-precision"
  Mantle.PrecisionBits Int
v293 -> ([String] -> String
Strings.cat [
    Int -> String
Literals.showInt32 Int
v293,
    String
"-bit"])

-- | Display a type as a string
describeType :: (Core.Type -> String)
describeType :: Type -> String
describeType Type
x = case Type
x of
  Core.TypeAnnotated AnnotatedType
v294 -> ([String] -> String
Strings.cat [
    String
"annotated ",
    (Type -> String
describeType (AnnotatedType -> Type
Core.annotatedTypeSubject AnnotatedType
v294))])
  Core.TypeApplication ApplicationType
_ -> String
"instances of an application type"
  Core.TypeLiteral LiteralType
v296 -> (LiteralType -> String
describeLiteralType LiteralType
v296)
  Core.TypeFunction FunctionType
v297 -> ([String] -> String
Strings.cat [
    [String] -> String
Strings.cat [
      [String] -> String
Strings.cat [
        String
"functions from ",
        (Type -> String
describeType (FunctionType -> Type
Core.functionTypeDomain FunctionType
v297))],
      String
" to "],
    (Type -> String
describeType (FunctionType -> Type
Core.functionTypeCodomain FunctionType
v297))])
  Core.TypeLambda LambdaType
_ -> String
"polymorphic terms"
  Core.TypeList Type
v299 -> ([String] -> String
Strings.cat [
    String
"lists of ",
    (Type -> String
describeType Type
v299)])
  Core.TypeMap MapType
v300 -> ([String] -> String
Strings.cat [
    [String] -> String
Strings.cat [
      [String] -> String
Strings.cat [
        String
"maps from ",
        (Type -> String
describeType (MapType -> Type
Core.mapTypeKeys MapType
v300))],
      String
" to "],
    (Type -> String
describeType (MapType -> Type
Core.mapTypeValues MapType
v300))])
  Core.TypeOptional Type
v301 -> ([String] -> String
Strings.cat [
    String
"optional ",
    (Type -> String
describeType Type
v301)])
  Core.TypeProduct [Type]
_ -> String
"tuples"
  Core.TypeRecord RowType
_ -> String
"records"
  Core.TypeSet Type
v304 -> ([String] -> String
Strings.cat [
    String
"sets of ",
    (Type -> String
describeType Type
v304)])
  Core.TypeSum [Type]
_ -> String
"variant tuples"
  Core.TypeUnion RowType
_ -> String
"unions"
  Core.TypeVariable Name
_ -> String
"instances of a named type"
  Core.TypeWrap WrappedType
v308 -> ([String] -> String
Strings.cat [
    String
"wrapper for ",
    (Type -> String
describeType (WrappedType -> Type
Core.wrappedTypeObject WrappedType
v308))])