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"