-- | Common functions for working with terms, types, and names

module Hydra.Common where

import Hydra.Core
import Hydra.Compute
import Hydra.Mantle
import Hydra.Module
import qualified Hydra.Lib.Strings as Strings
import Hydra.Util.Formatting

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S


debug :: Bool
debug :: Bool
debug = Bool
True

convertFloatValue :: FloatType -> FloatValue -> FloatValue
convertFloatValue :: FloatType -> FloatValue -> FloatValue
convertFloatValue FloatType
target = Double -> FloatValue
encoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatValue -> Double
decoder
  where
    decoder :: FloatValue -> Double
decoder FloatValue
fv = case FloatValue
fv of
      FloatValueBigfloat Double
d -> Double
d
      FloatValueFloat32 Float
f -> forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
f
      FloatValueFloat64 Double
d -> Double
d
    encoder :: Double -> FloatValue
encoder Double
d = case FloatType
target of
      FloatType
FloatTypeBigfloat -> Double -> FloatValue
FloatValueBigfloat Double
d
      FloatType
FloatTypeFloat32 -> Float -> FloatValue
FloatValueFloat32 forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d
      FloatType
FloatTypeFloat64 -> Double -> FloatValue
FloatValueFloat64 Double
d

convertIntegerValue :: IntegerType -> IntegerValue -> IntegerValue
convertIntegerValue :: IntegerType -> IntegerValue -> IntegerValue
convertIntegerValue IntegerType
target = Integer -> IntegerValue
encoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntegerValue -> Integer
decoder
  where
    decoder :: IntegerValue -> Integer
decoder IntegerValue
iv = case IntegerValue
iv of
      IntegerValueBigint Integer
v -> Integer
v
      IntegerValueInt8 Int
v -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
      IntegerValueInt16 Int
v -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
      IntegerValueInt32 Int
v -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
      IntegerValueInt64 Integer
v -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v
      IntegerValueUint8 Int
v -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
      IntegerValueUint16 Int
v -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
      IntegerValueUint32 Integer
v -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v
      IntegerValueUint64 Integer
v -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v
    encoder :: Integer -> IntegerValue
encoder Integer
d = case IntegerType
target of
      IntegerType
IntegerTypeBigint -> Integer -> IntegerValue
IntegerValueBigint Integer
d
      IntegerType
IntegerTypeInt8 -> Int -> IntegerValue
IntegerValueInt8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeInt16 -> Int -> IntegerValue
IntegerValueInt16 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeInt32 -> Int -> IntegerValue
IntegerValueInt32 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeInt64 -> Integer -> IntegerValue
IntegerValueInt64 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeUint8 -> Int -> IntegerValue
IntegerValueUint8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeUint16 -> Int -> IntegerValue
IntegerValueUint16 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeUint32 -> Integer -> IntegerValue
IntegerValueUint32 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeUint64 -> Integer -> IntegerValue
IntegerValueUint64 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d

elementsToGraph :: Maybe (Graph m) -> [Element m] -> Graph m
elementsToGraph :: forall m. Maybe (Graph m) -> [Element m] -> Graph m
elementsToGraph Maybe (Graph m)
msg [Element m]
els = forall m. Map Name (Element m) -> Maybe (Graph m) -> Graph m
Graph Map Name (Element m)
elementMap Maybe (Graph m)
msg
  where
    elementMap :: Map Name (Element m)
elementMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall {m}. Element m -> (Name, Element m)
toPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Element m]
els)
      where
        toPair :: Element m -> (Name, Element m)
toPair Element m
el = (forall m. Element m -> Name
elementName Element m
el, Element m
el)

fromQname :: Namespace -> String -> Name
fromQname :: Namespace -> String -> Name
fromQname Namespace
ns String
local = String -> Name
Name forall a b. (a -> b) -> a -> b
$ Namespace -> String
unNamespace Namespace
ns forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
local

namespaceToFilePath :: Bool -> FileExtension -> Namespace -> FilePath
namespaceToFilePath :: Bool -> FileExtension -> Namespace -> String
namespaceToFilePath Bool
caps (FileExtension String
ext) (Namespace String
name) = forall a. [a] -> [[a]] -> [a]
L.intercalate String
"/" [String]
parts forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
ext
  where
    parts :: [String]
parts = (if Bool
caps then String -> String
capitalize else forall a. a -> a
id) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> [String]
Strings.splitOn String
"/" String
name

isEncodedType :: Eq m => Context m -> Term m -> Bool
isEncodedType :: forall m. Eq m => Context m -> Term m -> Bool
isEncodedType Context m
cx Term m
term = forall m. Term m -> Term m
stripTerm Term m
term forall a. Eq a => a -> a -> Bool
== forall m. Name -> Term m
TermElement Name
_Type

isType :: Eq m => Context m -> Type m -> Bool
isType :: forall m. Eq m => Context m -> Type m -> Bool
isType Context m
cx Type m
typ = case forall m. Type m -> Type m
stripType Type m
typ of
  TypeNominal Name
_Type -> Bool
True
  TypeUnion (RowType Name
_Type Maybe Name
_ [FieldType m]
_) -> Bool
True
  TypeApplication (ApplicationType Type m
lhs Type m
_) -> forall m. Eq m => Context m -> Type m -> Bool
isType Context m
cx Type m
lhs
  Type m
_ -> Bool
False

localNameOfLazy :: Name -> String
localNameOfLazy :: Name -> String
localNameOfLazy = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> (Namespace, String)
toQnameLazy

localNameOfEager :: Name -> String
localNameOfEager :: Name -> String
localNameOfEager = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> (Namespace, String)
toQnameEager

namespaceOfLazy :: Name -> Namespace
namespaceOfLazy :: Name -> Namespace
namespaceOfLazy = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> (Namespace, String)
toQnameLazy

namespaceOfEager :: Name -> Namespace
namespaceOfEager :: Name -> Namespace
namespaceOfEager = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> (Namespace, String)
toQnameEager

placeholderName :: Name
placeholderName :: Name
placeholderName = String -> Name
Name String
"Placeholder"

skipAnnotations :: (a -> Maybe (Annotated a m)) -> a -> a
skipAnnotations :: forall a m. (a -> Maybe (Annotated a m)) -> a -> a
skipAnnotations a -> Maybe (Annotated a m)
getAnn a
t = a -> a
skip a
t
  where
    skip :: a -> a
skip a
t = case a -> Maybe (Annotated a m)
getAnn a
t of
      Maybe (Annotated a m)
Nothing -> a
t
      Just (Annotated a
t' m
_) -> a -> a
skip a
t'

stripTerm :: Term m -> Term m
stripTerm :: forall m. Term m -> Term m
stripTerm = forall a m. (a -> Maybe (Annotated a m)) -> a -> a
skipAnnotations forall a b. (a -> b) -> a -> b
$ \Term m
t -> case Term m
t of
  TermAnnotated Annotated (Term m) m
a -> forall a. a -> Maybe a
Just Annotated (Term m) m
a
  Term m
_ -> forall a. Maybe a
Nothing

stripType :: Type m -> Type m
stripType :: forall m. Type m -> Type m
stripType = forall a m. (a -> Maybe (Annotated a m)) -> a -> a
skipAnnotations forall a b. (a -> b) -> a -> b
$ \Type m
t -> case Type m
t of
  TypeAnnotated Annotated (Type m) m
a -> forall a. a -> Maybe a
Just Annotated (Type m) m
a
  Type m
_ -> forall a. Maybe a
Nothing

termMeta :: Context m -> Term m -> m
termMeta :: forall m. Context m -> Term m -> m
termMeta Context m
cx = forall m. AnnotationClass m -> Term m -> m
annotationClassTermMeta forall a b. (a -> b) -> a -> b
$ forall m. Context m -> AnnotationClass m
contextAnnotations Context m
cx

toQnameLazy :: Name -> (Namespace, String)
toQnameLazy :: Name -> (Namespace, String)
toQnameLazy (Name String
name) = case forall a. [a] -> [a]
L.reverse forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
Strings.splitOn String
"." String
name of
  (String
local:[String]
rest) -> (String -> Namespace
Namespace forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
L.intercalate String
"." forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
L.reverse [String]
rest, String
local)
  [String]
_ -> (String -> Namespace
Namespace String
"UNKNOWN", String
name)

toQnameEager :: Name -> (Namespace, String)
toQnameEager :: Name -> (Namespace, String)
toQnameEager (Name String
name) = case String -> String -> [String]
Strings.splitOn String
"." String
name of
  (String
ns:[String]
rest) -> (String -> Namespace
Namespace String
ns, forall a. [a] -> [[a]] -> [a]
L.intercalate String
"." [String]
rest)
  [String]
_ -> (String -> Namespace
Namespace String
"UNKNOWN", String
name)

typeMeta :: Context m -> Type m -> m
typeMeta :: forall m. Context m -> Type m -> m
typeMeta Context m
cx = forall m. AnnotationClass m -> Type m -> m
annotationClassTypeMeta forall a b. (a -> b) -> a -> b
$ forall m. Context m -> AnnotationClass m
contextAnnotations Context m
cx

unitTypeName :: Name
unitTypeName :: Name
unitTypeName = String -> Name
Name String
"hydra/core.UnitType"