-- | Utilities for use in transformations

module Hydra.Adapters.Utils 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.List
import Data.Map
import Data.Set

-- | Display a floating-point type as a string
describeFloatType :: (Core.FloatType -> String)
describeFloatType :: FloatType -> String
describeFloatType FloatType
t = ([String] -> String
Strings.cat [
  (\FloatType
x1 -> Precision -> String
describePrecision (FloatType -> Precision
Basics.floatTypePrecision FloatType
x1)) 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
x1 -> Precision -> String
describePrecision (IntegerType -> Precision
Basics.integerTypePrecision IntegerType
x1)) 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
v -> (FloatType -> String
describeFloatType FloatType
v)
  Core.LiteralTypeInteger IntegerType
v -> (IntegerType -> String
describeIntegerType IntegerType
v)
  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
v -> ([String] -> String
Strings.cat [
    Int -> String
Literals.showInt32 Int
v,
    String
"-bit"])

-- | Display a type as a string
describeType :: (Core.Type m -> String)
describeType :: forall m. Type m -> String
describeType Type m
typ = ((\Type m
x -> case Type m
x of
  Core.TypeAnnotated Annotated (Type m) m
v -> ([String] -> String
Strings.cat [
    String
"annotated ",
    (forall m. Type m -> String
describeType (forall a m. Annotated a m -> a
Core.annotatedSubject Annotated (Type m) m
v))])
  Core.TypeApplication ApplicationType m
_ -> String
"instances of an application type"
  Core.TypeLiteral LiteralType
v -> (LiteralType -> String
describeLiteralType LiteralType
v)
  Core.TypeElement Type m
v -> ([String] -> String
Strings.cat [
    String
"elements containing ",
    (forall m. Type m -> String
describeType Type m
v)])
  Core.TypeFunction FunctionType m
v -> ([String] -> String
Strings.cat [
    [String] -> String
Strings.cat [
      [String] -> String
Strings.cat [
        String
"functions from ",
        (forall m. Type m -> String
describeType (forall m. FunctionType m -> Type m
Core.functionTypeDomain FunctionType m
v))],
      String
" to "],
    (forall m. Type m -> String
describeType (forall m. FunctionType m -> Type m
Core.functionTypeCodomain FunctionType m
v))])
  Core.TypeLambda LambdaType m
_ -> String
"polymorphic terms"
  Core.TypeList Type m
v -> ([String] -> String
Strings.cat [
    String
"lists of ",
    (forall m. Type m -> String
describeType Type m
v)])
  Core.TypeMap MapType m
v -> ([String] -> String
Strings.cat [
    [String] -> String
Strings.cat [
      [String] -> String
Strings.cat [
        String
"maps from ",
        (forall m. Type m -> String
describeType (forall m. MapType m -> Type m
Core.mapTypeKeys MapType m
v))],
      String
" to "],
    (forall m. Type m -> String
describeType (forall m. MapType m -> Type m
Core.mapTypeValues MapType m
v))])
  Core.TypeNominal Name
v -> ([String] -> String
Strings.cat [
    String
"alias for ",
    (Name -> String
Core.unName Name
v)])
  Core.TypeOptional Type m
v -> ([String] -> String
Strings.cat [
    String
"optional ",
    (forall m. Type m -> String
describeType Type m
v)])
  Core.TypeProduct [Type m]
_ -> String
"tuples"
  Core.TypeRecord RowType m
_ -> String
"records"
  Core.TypeSet Type m
v -> ([String] -> String
Strings.cat [
    String
"sets of ",
    (forall m. Type m -> String
describeType Type m
v)])
  Core.TypeStream Type m
v -> ([String] -> String
Strings.cat [
    String
"streams of ",
    (forall m. Type m -> String
describeType Type m
v)])
  Core.TypeSum [Type m]
_ -> String
"variant tuples"
  Core.TypeUnion RowType m
_ -> String
"unions"
  Core.TypeVariable VariableType
_ -> String
"unspecified/parametric terms") Type m
typ)