{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Technique.Language where

import Core.Data.Structures (Key)
import Core.Text.Rope
import Data.Hashable (Hashable)
import GHC.Generics (Generic)
import Technique.Quantity

data Technique = Technique
  { Technique -> Int
techniqueVersion :: Int,
    Technique -> Rope
techniqueLicense :: Rope,
    Technique -> Maybe Rope
techniqueCopyright :: Maybe Rope,
    Technique -> [Procedure]
techniqueBody :: [Procedure]
  }
  deriving (Int -> Technique -> ShowS
[Technique] -> ShowS
Technique -> String
(Int -> Technique -> ShowS)
-> (Technique -> String)
-> ([Technique] -> ShowS)
-> Show Technique
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Technique] -> ShowS
$cshowList :: [Technique] -> ShowS
show :: Technique -> String
$cshow :: Technique -> String
showsPrec :: Int -> Technique -> ShowS
$cshowsPrec :: Int -> Technique -> ShowS
Show, Technique -> Technique -> Bool
(Technique -> Technique -> Bool)
-> (Technique -> Technique -> Bool) -> Eq Technique
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Technique -> Technique -> Bool
$c/= :: Technique -> Technique -> Bool
== :: Technique -> Technique -> Bool
$c== :: Technique -> Technique -> Bool
Eq)

emptyTechnique :: Technique
emptyTechnique :: Technique
emptyTechnique =
  Technique :: Int -> Rope -> Maybe Rope -> [Procedure] -> Technique
Technique
    { techniqueVersion :: Int
techniqueVersion = Int
0,
      techniqueLicense :: Rope
techniqueLicense = Rope
emptyRope,
      techniqueCopyright :: Maybe Rope
techniqueCopyright = Maybe Rope
forall a. Maybe a
Nothing,
      techniqueBody :: [Procedure]
techniqueBody = []
    }

-- TODO
data Identifier
  = Identifier Rope
  deriving (Int -> Identifier -> ShowS
[Identifier] -> ShowS
Identifier -> String
(Int -> Identifier -> ShowS)
-> (Identifier -> String)
-> ([Identifier] -> ShowS)
-> Show Identifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identifier] -> ShowS
$cshowList :: [Identifier] -> ShowS
show :: Identifier -> String
$cshow :: Identifier -> String
showsPrec :: Int -> Identifier -> ShowS
$cshowsPrec :: Int -> Identifier -> ShowS
Show, Identifier -> Identifier -> Bool
(Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool) -> Eq Identifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c== :: Identifier -> Identifier -> Bool
Eq, Eq Identifier
Eq Identifier
-> (Identifier -> Identifier -> Ordering)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Identifier)
-> (Identifier -> Identifier -> Identifier)
-> Ord Identifier
Identifier -> Identifier -> Bool
Identifier -> Identifier -> Ordering
Identifier -> Identifier -> Identifier
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Identifier -> Identifier -> Identifier
$cmin :: Identifier -> Identifier -> Identifier
max :: Identifier -> Identifier -> Identifier
$cmax :: Identifier -> Identifier -> Identifier
>= :: Identifier -> Identifier -> Bool
$c>= :: Identifier -> Identifier -> Bool
> :: Identifier -> Identifier -> Bool
$c> :: Identifier -> Identifier -> Bool
<= :: Identifier -> Identifier -> Bool
$c<= :: Identifier -> Identifier -> Bool
< :: Identifier -> Identifier -> Bool
$c< :: Identifier -> Identifier -> Bool
compare :: Identifier -> Identifier -> Ordering
$ccompare :: Identifier -> Identifier -> Ordering
$cp1Ord :: Eq Identifier
Ord, (forall x. Identifier -> Rep Identifier x)
-> (forall x. Rep Identifier x -> Identifier) -> Generic Identifier
forall x. Rep Identifier x -> Identifier
forall x. Identifier -> Rep Identifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Identifier x -> Identifier
$cfrom :: forall x. Identifier -> Rep Identifier x
Generic, Int -> Identifier -> Int
Identifier -> Int
(Int -> Identifier -> Int)
-> (Identifier -> Int) -> Hashable Identifier
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Identifier -> Int
$chash :: Identifier -> Int
hashWithSalt :: Int -> Identifier -> Int
$chashWithSalt :: Int -> Identifier -> Int
Hashable)

unIdentifier :: Identifier -> Rope
unIdentifier :: Identifier -> Rope
unIdentifier (Identifier Rope
text) = Rope
text
{-# INLINE unIdentifier #-}

instance Key Identifier

-- TODO construction needs to validate internal rules for labels. No
-- newlines, perhaps.
newtype Label = Label Rope
  deriving (Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show, Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq, Eq Label
Eq Label
-> (Label -> Label -> Ordering)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Label)
-> (Label -> Label -> Label)
-> Ord Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmax :: Label -> Label -> Label
>= :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c< :: Label -> Label -> Bool
compare :: Label -> Label -> Ordering
$ccompare :: Label -> Label -> Ordering
$cp1Ord :: Eq Label
Ord)

data Attribute
  = Role Identifier
  | Place Identifier
  | Inherit
  deriving (Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show, Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq, Eq Attribute
Eq Attribute
-> (Attribute -> Attribute -> Ordering)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Attribute)
-> (Attribute -> Attribute -> Attribute)
-> Ord Attribute
Attribute -> Attribute -> Bool
Attribute -> Attribute -> Ordering
Attribute -> Attribute -> Attribute
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Attribute -> Attribute -> Attribute
$cmin :: Attribute -> Attribute -> Attribute
max :: Attribute -> Attribute -> Attribute
$cmax :: Attribute -> Attribute -> Attribute
>= :: Attribute -> Attribute -> Bool
$c>= :: Attribute -> Attribute -> Bool
> :: Attribute -> Attribute -> Bool
$c> :: Attribute -> Attribute -> Bool
<= :: Attribute -> Attribute -> Bool
$c<= :: Attribute -> Attribute -> Bool
< :: Attribute -> Attribute -> Bool
$c< :: Attribute -> Attribute -> Bool
compare :: Attribute -> Attribute -> Ordering
$ccompare :: Attribute -> Attribute -> Ordering
$cp1Ord :: Eq Attribute
Ord)

{-
    | Anyone
    | Anywhere
-}

data Markdown
  = Markdown Rope
  deriving (Markdown -> Markdown -> Bool
(Markdown -> Markdown -> Bool)
-> (Markdown -> Markdown -> Bool) -> Eq Markdown
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Markdown -> Markdown -> Bool
$c/= :: Markdown -> Markdown -> Bool
== :: Markdown -> Markdown -> Bool
$c== :: Markdown -> Markdown -> Bool
Eq, Eq Markdown
Eq Markdown
-> (Markdown -> Markdown -> Ordering)
-> (Markdown -> Markdown -> Bool)
-> (Markdown -> Markdown -> Bool)
-> (Markdown -> Markdown -> Bool)
-> (Markdown -> Markdown -> Bool)
-> (Markdown -> Markdown -> Markdown)
-> (Markdown -> Markdown -> Markdown)
-> Ord Markdown
Markdown -> Markdown -> Bool
Markdown -> Markdown -> Ordering
Markdown -> Markdown -> Markdown
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Markdown -> Markdown -> Markdown
$cmin :: Markdown -> Markdown -> Markdown
max :: Markdown -> Markdown -> Markdown
$cmax :: Markdown -> Markdown -> Markdown
>= :: Markdown -> Markdown -> Bool
$c>= :: Markdown -> Markdown -> Bool
> :: Markdown -> Markdown -> Bool
$c> :: Markdown -> Markdown -> Bool
<= :: Markdown -> Markdown -> Bool
$c<= :: Markdown -> Markdown -> Bool
< :: Markdown -> Markdown -> Bool
$c< :: Markdown -> Markdown -> Bool
compare :: Markdown -> Markdown -> Ordering
$ccompare :: Markdown -> Markdown -> Ordering
$cp1Ord :: Eq Markdown
Ord)

instance Show Markdown where
  show :: Markdown -> String
show (Markdown Rope
text) = String
"[quote|\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rope -> String
forall α. Textual α => Rope -> α
fromRope Rope
text String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|]"

data Type
  = Type Rope
  deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Eq Type
-> (Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq Type
Ord)

unitType :: Type
unitType :: Type
unitType = Rope -> Type
Type Rope
"()"

data Procedure = Procedure
  { Procedure -> Int
procedureOffset :: Offset,
    Procedure -> Identifier
procedureName :: Identifier,
    Procedure -> [Identifier]
procedureParams :: [Identifier],
    Procedure -> [Type]
procedureInput :: [Type],
    Procedure -> [Type]
procedureOutput :: [Type],
    Procedure -> Maybe Markdown
procedureTitle :: Maybe Markdown,
    Procedure -> Maybe Markdown
procedureDescription :: Maybe Markdown,
    Procedure -> Block
procedureBlock :: Block
  }
  deriving (Int -> Procedure -> ShowS
[Procedure] -> ShowS
Procedure -> String
(Int -> Procedure -> ShowS)
-> (Procedure -> String)
-> ([Procedure] -> ShowS)
-> Show Procedure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Procedure] -> ShowS
$cshowList :: [Procedure] -> ShowS
show :: Procedure -> String
$cshow :: Procedure -> String
showsPrec :: Int -> Procedure -> ShowS
$cshowsPrec :: Int -> Procedure -> ShowS
Show, Procedure -> Procedure -> Bool
(Procedure -> Procedure -> Bool)
-> (Procedure -> Procedure -> Bool) -> Eq Procedure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Procedure -> Procedure -> Bool
$c/= :: Procedure -> Procedure -> Bool
== :: Procedure -> Procedure -> Bool
$c== :: Procedure -> Procedure -> Bool
Eq, Eq Procedure
Eq Procedure
-> (Procedure -> Procedure -> Ordering)
-> (Procedure -> Procedure -> Bool)
-> (Procedure -> Procedure -> Bool)
-> (Procedure -> Procedure -> Bool)
-> (Procedure -> Procedure -> Bool)
-> (Procedure -> Procedure -> Procedure)
-> (Procedure -> Procedure -> Procedure)
-> Ord Procedure
Procedure -> Procedure -> Bool
Procedure -> Procedure -> Ordering
Procedure -> Procedure -> Procedure
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Procedure -> Procedure -> Procedure
$cmin :: Procedure -> Procedure -> Procedure
max :: Procedure -> Procedure -> Procedure
$cmax :: Procedure -> Procedure -> Procedure
>= :: Procedure -> Procedure -> Bool
$c>= :: Procedure -> Procedure -> Bool
> :: Procedure -> Procedure -> Bool
$c> :: Procedure -> Procedure -> Bool
<= :: Procedure -> Procedure -> Bool
$c<= :: Procedure -> Procedure -> Bool
< :: Procedure -> Procedure -> Bool
$c< :: Procedure -> Procedure -> Bool
compare :: Procedure -> Procedure -> Ordering
$ccompare :: Procedure -> Procedure -> Ordering
$cp1Ord :: Eq Procedure
Ord)

emptyProcedure :: Procedure
emptyProcedure :: Procedure
emptyProcedure =
  Procedure :: Int
-> Identifier
-> [Identifier]
-> [Type]
-> [Type]
-> Maybe Markdown
-> Maybe Markdown
-> Block
-> Procedure
Procedure
    { procedureOffset :: Int
procedureOffset = -Int
1,
      procedureName :: Identifier
procedureName = Rope -> Identifier
Identifier Rope
"none",
      procedureParams :: [Identifier]
procedureParams = [],
      procedureInput :: [Type]
procedureInput = [Type
unitType],
      procedureOutput :: [Type]
procedureOutput = [Type
unitType],
      procedureTitle :: Maybe Markdown
procedureTitle = Maybe Markdown
forall a. Maybe a
Nothing,
      procedureDescription :: Maybe Markdown
procedureDescription = Maybe Markdown
forall a. Maybe a
Nothing,
      procedureBlock :: Block
procedureBlock = [Statement] -> Block
Block []
    }

data Block = Block [Statement]
  deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: Block -> Block -> Bool
Eq, Eq Block
Eq Block
-> (Block -> Block -> Ordering)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Block)
-> (Block -> Block -> Block)
-> Ord Block
Block -> Block -> Bool
Block -> Block -> Ordering
Block -> Block -> Block
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Block -> Block -> Block
$cmin :: Block -> Block -> Block
max :: Block -> Block -> Block
$cmax :: Block -> Block -> Block
>= :: Block -> Block -> Bool
$c>= :: Block -> Block -> Bool
> :: Block -> Block -> Bool
$c> :: Block -> Block -> Bool
<= :: Block -> Block -> Bool
$c<= :: Block -> Block -> Bool
< :: Block -> Block -> Bool
$c< :: Block -> Block -> Bool
compare :: Block -> Block -> Ordering
$ccompare :: Block -> Block -> Ordering
$cp1Ord :: Eq Block
Ord)

type Offset = Int

class Located a where
  locationOf :: a -> Offset

instance Located Procedure where
  locationOf :: Procedure -> Int
locationOf = Procedure -> Int
procedureOffset

data Statement
  = Assignment Offset [Identifier] Expression
  | Execute Offset Expression
  | Comment Offset Rope
  | Declaration Offset Procedure
  | Blank Offset
  | Series Offset
  deriving (Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
(Int -> Statement -> ShowS)
-> (Statement -> String)
-> ([Statement] -> ShowS)
-> Show Statement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> String
$cshow :: Statement -> String
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show, Eq Statement
Eq Statement
-> (Statement -> Statement -> Ordering)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Statement)
-> (Statement -> Statement -> Statement)
-> Ord Statement
Statement -> Statement -> Bool
Statement -> Statement -> Ordering
Statement -> Statement -> Statement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Statement -> Statement -> Statement
$cmin :: Statement -> Statement -> Statement
max :: Statement -> Statement -> Statement
$cmax :: Statement -> Statement -> Statement
>= :: Statement -> Statement -> Bool
$c>= :: Statement -> Statement -> Bool
> :: Statement -> Statement -> Bool
$c> :: Statement -> Statement -> Bool
<= :: Statement -> Statement -> Bool
$c<= :: Statement -> Statement -> Bool
< :: Statement -> Statement -> Bool
$c< :: Statement -> Statement -> Bool
compare :: Statement -> Statement -> Ordering
$ccompare :: Statement -> Statement -> Ordering
$cp1Ord :: Eq Statement
Ord, Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c== :: Statement -> Statement -> Bool
Eq)

instance Located Statement where
  locationOf :: Statement -> Int
locationOf Statement
statement = case Statement
statement of
    Assignment Int
o [Identifier]
_ Expression
_ -> Int
o
    Execute Int
o Expression
_ -> Int
o
    Comment Int
o Rope
_ -> Int
o
    Declaration Int
o Procedure
_ -> Int
o
    Blank Int
o -> Int
o
    Series Int
o -> Int
o

data Expression
  = Application Offset Identifier Expression -- this had better turn out to be a procedure
  | None Offset
  | Text Offset Rope
  | Amount Offset Quantity
  | Undefined Offset
  | Object Offset Tablet
  | Variable Offset [Identifier]
  | Operation Offset Operator Expression Expression
  | Grouping Offset Expression
  | Restriction Offset Attribute Block
  deriving (Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression] -> ShowS
$cshowList :: [Expression] -> ShowS
show :: Expression -> String
$cshow :: Expression -> String
showsPrec :: Int -> Expression -> ShowS
$cshowsPrec :: Int -> Expression -> ShowS
Show, Eq Expression
Eq Expression
-> (Expression -> Expression -> Ordering)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Expression)
-> (Expression -> Expression -> Expression)
-> Ord Expression
Expression -> Expression -> Bool
Expression -> Expression -> Ordering
Expression -> Expression -> Expression
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Expression -> Expression -> Expression
$cmin :: Expression -> Expression -> Expression
max :: Expression -> Expression -> Expression
$cmax :: Expression -> Expression -> Expression
>= :: Expression -> Expression -> Bool
$c>= :: Expression -> Expression -> Bool
> :: Expression -> Expression -> Bool
$c> :: Expression -> Expression -> Bool
<= :: Expression -> Expression -> Bool
$c<= :: Expression -> Expression -> Bool
< :: Expression -> Expression -> Bool
$c< :: Expression -> Expression -> Bool
compare :: Expression -> Expression -> Ordering
$ccompare :: Expression -> Expression -> Ordering
$cp1Ord :: Eq Expression
Ord, Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c== :: Expression -> Expression -> Bool
Eq)

instance Located Expression where
  locationOf :: Expression -> Int
locationOf Expression
expr = case Expression
expr of
    Application Int
o Identifier
_ Expression
_ -> Int
o
    None Int
o -> Int
o
    Text Int
o Rope
_ -> Int
o
    Amount Int
o Quantity
_ -> Int
o
    Undefined Int
o -> Int
o
    Object Int
o Tablet
_ -> Int
o
    Variable Int
o [Identifier]
_ -> Int
o
    Operation Int
o Operator
_ Expression
_ Expression
_ -> Int
o
    Grouping Int
o Expression
_ -> Int
o
    Restriction Int
o Attribute
_ Block
_ -> Int
o

data Tablet
  = Tablet [Binding]
  deriving (Int -> Tablet -> ShowS
[Tablet] -> ShowS
Tablet -> String
(Int -> Tablet -> ShowS)
-> (Tablet -> String) -> ([Tablet] -> ShowS) -> Show Tablet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tablet] -> ShowS
$cshowList :: [Tablet] -> ShowS
show :: Tablet -> String
$cshow :: Tablet -> String
showsPrec :: Int -> Tablet -> ShowS
$cshowsPrec :: Int -> Tablet -> ShowS
Show, Eq Tablet
Eq Tablet
-> (Tablet -> Tablet -> Ordering)
-> (Tablet -> Tablet -> Bool)
-> (Tablet -> Tablet -> Bool)
-> (Tablet -> Tablet -> Bool)
-> (Tablet -> Tablet -> Bool)
-> (Tablet -> Tablet -> Tablet)
-> (Tablet -> Tablet -> Tablet)
-> Ord Tablet
Tablet -> Tablet -> Bool
Tablet -> Tablet -> Ordering
Tablet -> Tablet -> Tablet
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tablet -> Tablet -> Tablet
$cmin :: Tablet -> Tablet -> Tablet
max :: Tablet -> Tablet -> Tablet
$cmax :: Tablet -> Tablet -> Tablet
>= :: Tablet -> Tablet -> Bool
$c>= :: Tablet -> Tablet -> Bool
> :: Tablet -> Tablet -> Bool
$c> :: Tablet -> Tablet -> Bool
<= :: Tablet -> Tablet -> Bool
$c<= :: Tablet -> Tablet -> Bool
< :: Tablet -> Tablet -> Bool
$c< :: Tablet -> Tablet -> Bool
compare :: Tablet -> Tablet -> Ordering
$ccompare :: Tablet -> Tablet -> Ordering
$cp1Ord :: Eq Tablet
Ord, Tablet -> Tablet -> Bool
(Tablet -> Tablet -> Bool)
-> (Tablet -> Tablet -> Bool) -> Eq Tablet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tablet -> Tablet -> Bool
$c/= :: Tablet -> Tablet -> Bool
== :: Tablet -> Tablet -> Bool
$c== :: Tablet -> Tablet -> Bool
Eq)

-- only valid Expressions are Literal and Variable. Should we enforce that
-- somewhere?
data Binding
  = Binding Label Expression
  deriving (Int -> Binding -> ShowS
[Binding] -> ShowS
Binding -> String
(Int -> Binding -> ShowS)
-> (Binding -> String) -> ([Binding] -> ShowS) -> Show Binding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binding] -> ShowS
$cshowList :: [Binding] -> ShowS
show :: Binding -> String
$cshow :: Binding -> String
showsPrec :: Int -> Binding -> ShowS
$cshowsPrec :: Int -> Binding -> ShowS
Show, Binding -> Binding -> Bool
(Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool) -> Eq Binding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Binding -> Binding -> Bool
$c/= :: Binding -> Binding -> Bool
== :: Binding -> Binding -> Bool
$c== :: Binding -> Binding -> Bool
Eq, Eq Binding
Eq Binding
-> (Binding -> Binding -> Ordering)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Binding)
-> (Binding -> Binding -> Binding)
-> Ord Binding
Binding -> Binding -> Bool
Binding -> Binding -> Ordering
Binding -> Binding -> Binding
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Binding -> Binding -> Binding
$cmin :: Binding -> Binding -> Binding
max :: Binding -> Binding -> Binding
$cmax :: Binding -> Binding -> Binding
>= :: Binding -> Binding -> Bool
$c>= :: Binding -> Binding -> Bool
> :: Binding -> Binding -> Bool
$c> :: Binding -> Binding -> Bool
<= :: Binding -> Binding -> Bool
$c<= :: Binding -> Binding -> Bool
< :: Binding -> Binding -> Bool
$c< :: Binding -> Binding -> Bool
compare :: Binding -> Binding -> Ordering
$ccompare :: Binding -> Binding -> Ordering
$cp1Ord :: Eq Binding
Ord)

data Operator
  = WaitEither
  | WaitBoth
  | Combine
  deriving (Int -> Operator -> ShowS
[Operator] -> ShowS
Operator -> String
(Int -> Operator -> ShowS)
-> (Operator -> String) -> ([Operator] -> ShowS) -> Show Operator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operator] -> ShowS
$cshowList :: [Operator] -> ShowS
show :: Operator -> String
$cshow :: Operator -> String
showsPrec :: Int -> Operator -> ShowS
$cshowsPrec :: Int -> Operator -> ShowS
Show, Operator -> Operator -> Bool
(Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool) -> Eq Operator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operator -> Operator -> Bool
$c/= :: Operator -> Operator -> Bool
== :: Operator -> Operator -> Bool
$c== :: Operator -> Operator -> Bool
Eq, Eq Operator
Eq Operator
-> (Operator -> Operator -> Ordering)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Operator)
-> (Operator -> Operator -> Operator)
-> Ord Operator
Operator -> Operator -> Bool
Operator -> Operator -> Ordering
Operator -> Operator -> Operator
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Operator -> Operator -> Operator
$cmin :: Operator -> Operator -> Operator
max :: Operator -> Operator -> Operator
$cmax :: Operator -> Operator -> Operator
>= :: Operator -> Operator -> Bool
$c>= :: Operator -> Operator -> Bool
> :: Operator -> Operator -> Bool
$c> :: Operator -> Operator -> Bool
<= :: Operator -> Operator -> Bool
$c<= :: Operator -> Operator -> Bool
< :: Operator -> Operator -> Bool
$c< :: Operator -> Operator -> Bool
compare :: Operator -> Operator -> Ordering
$ccompare :: Operator -> Operator -> Ordering
$cp1Ord :: Eq Operator
Ord)