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"