{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

-- |
-- This is the beginnings of the standard library.
module Technique.Builtins where

import Core.Data.Structures
import Core.Text.Rope ()
import Technique.Internal
import Technique.Language

-- Do these need descriptions? Not really, unless this becomes a form of
-- online help. Such text would not be used in overviews, so we'll see if
-- we ever need them.

builtinProcedures :: Map Identifier Function
builtinProcedures :: Map Identifier Function
builtinProcedures =
  [(Identifier, Function)]
-> Map (K [(Identifier, Function)]) (V [(Identifier, Function)])
forall α. Dictionary α => α -> Map (K α) (V α)
intoMap
    ( (Function -> (Identifier, Function))
-> [Function] -> [(Identifier, Function)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\Function
p -> (Function -> Identifier
functionName Function
p, Function
p))
        [ Function
builtinProcedureWaitEither,
          Function
builtinProcedureWaitBoth,
          Function
builtinProcedureCombineValues,
          Function
builtinProcedureTask,
          Function
builtinProcedureRecord
        ]
    )

builtinProcedureTask :: Function
builtinProcedureTask :: Function
builtinProcedureTask =
  Procedure -> (Step -> IO Value) -> Function
Primitive
    Procedure
emptyProcedure
      { procedureName :: Identifier
procedureName = Rope -> Identifier
Identifier Rope
"task",
        procedureInput :: [Type]
procedureInput = [Rope -> Type
Type Rope
"Text"],
        procedureOutput :: [Type]
procedureOutput = [Rope -> Type
Type Rope
"()"], -- ?
        procedureTitle :: Maybe Markdown
procedureTitle = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Rope -> Markdown
Markdown Rope
"Task"),
        procedureDescription :: Maybe Markdown
procedureDescription = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Rope -> Markdown
Markdown Rope
"A task to be executed by the person carrying out this role.")
      }
    Step -> IO Value
forall a. HasCallStack => a
undefined

builtinProcedureRecord :: Function
builtinProcedureRecord :: Function
builtinProcedureRecord =
  Procedure -> (Step -> IO Value) -> Function
Primitive
    Procedure
emptyProcedure
      { procedureName :: Identifier
procedureName = Rope -> Identifier
Identifier Rope
"record",
        procedureInput :: [Type]
procedureInput = [Rope -> Type
Type Rope
"Text"],
        procedureOutput :: [Type]
procedureOutput = [Rope -> Type
Type Rope
"Text"], -- ?
        procedureTitle :: Maybe Markdown
procedureTitle = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Rope -> Markdown
Markdown Rope
"Record"),
        procedureDescription :: Maybe Markdown
procedureDescription = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Rope -> Markdown
Markdown Rope
"Input from the user to be parsed as a quantity.")
      }
    Step -> IO Value
forall a. HasCallStack => a
undefined

-- the '|' operation
builtinProcedureWaitEither :: Function
builtinProcedureWaitEither :: Function
builtinProcedureWaitEither =
  Procedure -> (Step -> IO Value) -> Function
Primitive
    Procedure
emptyProcedure
      { procedureName :: Identifier
procedureName = Rope -> Identifier
Identifier Rope
"wait_either",
        procedureInput :: [Type]
procedureInput = [Rope -> Type
Type Rope
"*", Rope -> Type
Type Rope
"*"],
        procedureOutput :: [Type]
procedureOutput = [Rope -> Type
Type Rope
"()"],
        procedureTitle :: Maybe Markdown
procedureTitle = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Rope -> Markdown
Markdown Rope
"Wait Either"),
        procedureDescription :: Maybe Markdown
procedureDescription = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Rope -> Markdown
Markdown Rope
"Wait for either of two values to be ready.")
      }
    Step -> IO Value
forall a. HasCallStack => a
undefined

-- the '&' operation
builtinProcedureWaitBoth :: Function
builtinProcedureWaitBoth :: Function
builtinProcedureWaitBoth =
  Procedure -> (Step -> IO Value) -> Function
Primitive
    Procedure
emptyProcedure
      { procedureName :: Identifier
procedureName = Rope -> Identifier
Identifier Rope
"wait_both",
        procedureInput :: [Type]
procedureInput = [Rope -> Type
Type Rope
"*", Rope -> Type
Type Rope
"*"],
        procedureOutput :: [Type]
procedureOutput = [Rope -> Type
Type Rope
"()"],
        procedureTitle :: Maybe Markdown
procedureTitle = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Rope -> Markdown
Markdown Rope
"Wait Both"),
        procedureDescription :: Maybe Markdown
procedureDescription = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Rope -> Markdown
Markdown Rope
"Wait for two values to both be ready.")
      }
    Step -> IO Value
forall a. HasCallStack => a
undefined

-- the '+' operation
builtinProcedureCombineValues :: Function
builtinProcedureCombineValues :: Function
builtinProcedureCombineValues =
  Procedure -> (Step -> IO Value) -> Function
Primitive
    Procedure
emptyProcedure
      { procedureName :: Identifier
procedureName = Rope -> Identifier
Identifier Rope
"combine_values",
        procedureInput :: [Type]
procedureInput = [Rope -> Type
Type Rope
"*", Rope -> Type
Type Rope
"*"],
        procedureOutput :: [Type]
procedureOutput = [Rope -> Type
Type Rope
"*"],
        procedureTitle :: Maybe Markdown
procedureTitle = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Rope -> Markdown
Markdown Rope
"Combine Two Values"),
        procedureDescription :: Maybe Markdown
procedureDescription = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Rope -> Markdown
Markdown Rope
"Combine two values. This will involve coersion if the concrete types differ.")
      }
    Step -> IO Value
forall a. HasCallStack => a
undefined