-- | Functions for retrieving elements and primitive functions from a graph context

module Hydra.Lexical where

import Hydra.Basics
import Hydra.Strip
import Hydra.Core
import Hydra.Extras
import Hydra.Graph
import Hydra.Compute
import Hydra.Tier1
import Hydra.Tier2
import Hydra.Module

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Maybe as Y
import Control.Monad


dereferenceElement :: Name -> Flow Graph (Maybe Element)
dereferenceElement :: Name -> Flow Graph (Maybe Element)
dereferenceElement Name
name = do
  Graph
g <- Flow Graph Graph
forall s. Flow s s
getState
  Maybe Element -> Flow Graph (Maybe Element)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Element -> Flow Graph (Maybe Element))
-> Maybe Element -> Flow Graph (Maybe Element)
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Element -> Maybe Element
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name (Graph -> Map Name Element
graphElements Graph
g)

fieldsOf :: Type -> [FieldType]
fieldsOf :: Type -> [FieldType]
fieldsOf Type
t = case Type -> Type
stripType Type
t of
  TypeLambda (LambdaType Name
_ Type
body) -> Type -> [FieldType]
fieldsOf Type
body
  TypeRecord RowType
rt -> RowType -> [FieldType]
rowTypeFields RowType
rt
  TypeUnion RowType
rt -> RowType -> [FieldType]
rowTypeFields RowType
rt
  Type
_ -> []

requireElement :: Name -> Flow Graph Element
requireElement :: Name -> Flow Graph Element
requireElement Name
name = do
    Maybe Element
mel <- Name -> Flow Graph (Maybe Element)
dereferenceElement Name
name
    case Maybe Element
mel of
      Just Element
el -> Element -> Flow Graph Element
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Element
el
      Maybe Element
Nothing -> Flow Graph Graph
forall s. Flow s s
getState Flow Graph Graph
-> (Graph -> Flow Graph Element) -> Flow Graph Element
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Graph -> Flow Graph Element
forall {m :: * -> *} {a}. MonadFail m => Graph -> m a
err
  where
    err :: Graph -> m a
err Graph
g = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"no such element: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
name
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Available elements: {" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " ([String] -> [String]
forall {a}. a -> a
ellipsis (Name -> String
unName (Name -> String) -> (Element -> Name) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName (Element -> String) -> [Element] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Element -> [Element]
forall k a. Map k a -> [a]
M.elems (Graph -> Map Name Element
graphElements Graph
g))) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
      where
        showAll :: Bool
showAll = Bool
False
        ellipsis :: a -> a
ellipsis = a -> a
forall {a}. a -> a
id
--        ellipsis strings = if L.length strings > 3 && not showAll
--          then L.take 3 strings ++ ["..."]
--          else strings

requirePrimitive :: Name -> Flow Graph Primitive
requirePrimitive :: Name -> Flow Graph Primitive
requirePrimitive Name
fn = do
    Graph
cx <- Flow Graph Graph
forall s. Flow s s
getState
    Flow Graph Primitive
-> (Primitive -> Flow Graph Primitive)
-> Maybe Primitive
-> Flow Graph Primitive
forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe Flow Graph Primitive
forall {a}. Flow Graph a
err Primitive -> Flow Graph Primitive
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Primitive -> Flow Graph Primitive)
-> Maybe Primitive -> Flow Graph Primitive
forall a b. (a -> b) -> a -> b
$ Graph -> Name -> Maybe Primitive
lookupPrimitive Graph
cx Name
fn
  where
    err :: Flow Graph a
err = String -> Flow Graph a
forall a. String -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow Graph a) -> String -> Flow Graph a
forall a b. (a -> b) -> a -> b
$ String
"no such primitive function: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
fn

-- TODO: distinguish between lambda-bound and let-bound variables
resolveTerm :: Name -> Flow Graph (Maybe Term)
resolveTerm :: Name -> Flow Graph (Maybe Term)
resolveTerm Name
name = do
    Graph
g <- Flow Graph Graph
forall s. Flow s s
getState
    Flow Graph (Maybe Term)
-> (Element -> Flow Graph (Maybe Term))
-> Maybe Element
-> Flow Graph (Maybe Term)
forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe (Maybe Term -> Flow Graph (Maybe Term)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Term
forall a. Maybe a
Nothing) Element -> Flow Graph (Maybe Term)
recurse (Maybe Element -> Flow Graph (Maybe Term))
-> Maybe Element -> Flow Graph (Maybe Term)
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Element -> Maybe Element
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name (Map Name Element -> Maybe Element)
-> Map Name Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Graph -> Map Name Element
graphElements Graph
g
  where
    recurse :: Element -> Flow Graph (Maybe Term)
recurse Element
el = case Term -> Term
stripTerm (Element -> Term
elementData Element
el) of
      TermVariable Name
name' -> Name -> Flow Graph (Maybe Term)
resolveTerm Name
name'
      Term
_ -> Maybe Term -> Flow Graph (Maybe Term)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Term -> Flow Graph (Maybe Term))
-> Maybe Term -> Flow Graph (Maybe Term)
forall a b. (a -> b) -> a -> b
$ Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ Element -> Term
elementData Element
el

-- Note: assuming for now that primitive functions are the same in the schema graph
schemaContext :: Graph -> Graph
schemaContext :: Graph -> Graph
schemaContext Graph
g = Graph -> Maybe Graph -> Graph
forall a. a -> Maybe a -> a
Y.fromMaybe Graph
g (Graph -> Maybe Graph
graphSchema Graph
g)

toCompactName :: M.Map Namespace String -> Name -> String
toCompactName :: Map Namespace String -> Name -> String
toCompactName Map Namespace String
namespaces Name
name = case Maybe Namespace
mns of
    Maybe Namespace
Nothing -> Name -> String
unName Name
name
    Just Namespace
ns -> case Namespace -> Map Namespace String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Namespace
ns Map Namespace String
namespaces of
      Just String
pre -> String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
local
      Maybe String
Nothing -> String
local
  where
    (QualifiedName Maybe Namespace
mns String
local) = Name -> QualifiedName
qualifyNameLazy Name
name

withSchemaContext :: Flow Graph x -> Flow Graph x
withSchemaContext :: forall x. Flow Graph x -> Flow Graph x
withSchemaContext Flow Graph x
f = do
  Graph
cx <- Flow Graph Graph
forall s. Flow s s
getState
  Graph -> Flow Graph x -> Flow Graph x
forall s1 a s2. s1 -> Flow s1 a -> Flow s2 a
withState (Graph -> Graph
schemaContext Graph
cx) Flow Graph x
f