{-
Abstract syntax for the small subset of GF grammars supported
in gfse, the JavaScript-based simple grammar editor.
-}
module SimpleEditor.Syntax where

type Id    = String -- all sorts of identifiers
type ModId = Id -- module name
type Cat   = Id -- category name
type FunId = Id -- function name
type Type  = [Cat] -- [Cat_1,...,Cat_n] means Cat_1 -> ... -> Cat_n

data Grammar  = Grammar { Grammar -> ModId
basename :: ModId,
                          Grammar -> [ModId]
extends  :: [ModId],
                          Grammar -> Abstract
abstract :: Abstract,
                          Grammar -> [Concrete]
concretes:: [Concrete] }
                deriving Int -> Grammar -> ShowS
[Grammar] -> ShowS
Grammar -> ModId
(Int -> Grammar -> ShowS)
-> (Grammar -> ModId) -> ([Grammar] -> ShowS) -> Show Grammar
forall a.
(Int -> a -> ShowS) -> (a -> ModId) -> ([a] -> ShowS) -> Show a
showList :: [Grammar] -> ShowS
$cshowList :: [Grammar] -> ShowS
show :: Grammar -> ModId
$cshow :: Grammar -> ModId
showsPrec :: Int -> Grammar -> ShowS
$cshowsPrec :: Int -> Grammar -> ShowS
Show

data Abstract = Abstract { Abstract -> ModId
startcat:: Cat, Abstract -> [ModId]
cats:: [Cat], Abstract -> [Fun]
funs:: [Fun] }
                deriving Int -> Abstract -> ShowS
[Abstract] -> ShowS
Abstract -> ModId
(Int -> Abstract -> ShowS)
-> (Abstract -> ModId) -> ([Abstract] -> ShowS) -> Show Abstract
forall a.
(Int -> a -> ShowS) -> (a -> ModId) -> ([a] -> ShowS) -> Show a
showList :: [Abstract] -> ShowS
$cshowList :: [Abstract] -> ShowS
show :: Abstract -> ModId
$cshow :: Abstract -> ModId
showsPrec :: Int -> Abstract -> ShowS
$cshowsPrec :: Int -> Abstract -> ShowS
Show
data Fun      = Fun      { Fun -> ModId
fname:: FunId, Fun -> [ModId]
ftype:: Type }
                deriving Int -> Fun -> ShowS
[Fun] -> ShowS
Fun -> ModId
(Int -> Fun -> ShowS)
-> (Fun -> ModId) -> ([Fun] -> ShowS) -> Show Fun
forall a.
(Int -> a -> ShowS) -> (a -> ModId) -> ([a] -> ShowS) -> Show a
showList :: [Fun] -> ShowS
$cshowList :: [Fun] -> ShowS
show :: Fun -> ModId
$cshow :: Fun -> ModId
showsPrec :: Int -> Fun -> ShowS
$cshowsPrec :: Int -> Fun -> ShowS
Show

data Concrete = Concrete { Concrete -> ModId
langcode:: Id,
                           Concrete -> [ModId]
opens:: [ModId],
                           Concrete -> [Param]
params:: [Param],
                           Concrete -> [Lincat]
lincats:: [Lincat],
                           Concrete -> [Oper]
opers:: [Oper],
                           Concrete -> [Lin]
lins:: [Lin] }
                deriving Int -> Concrete -> ShowS
[Concrete] -> ShowS
Concrete -> ModId
(Int -> Concrete -> ShowS)
-> (Concrete -> ModId) -> ([Concrete] -> ShowS) -> Show Concrete
forall a.
(Int -> a -> ShowS) -> (a -> ModId) -> ([a] -> ShowS) -> Show a
showList :: [Concrete] -> ShowS
$cshowList :: [Concrete] -> ShowS
show :: Concrete -> ModId
$cshow :: Concrete -> ModId
showsPrec :: Int -> Concrete -> ShowS
$cshowsPrec :: Int -> Concrete -> ShowS
Show

data Param  = Param  {Param -> ModId
pname:: Id, Param -> ModId
prhs:: String}              deriving Int -> Param -> ShowS
[Param] -> ShowS
Param -> ModId
(Int -> Param -> ShowS)
-> (Param -> ModId) -> ([Param] -> ShowS) -> Show Param
forall a.
(Int -> a -> ShowS) -> (a -> ModId) -> ([a] -> ShowS) -> Show a
showList :: [Param] -> ShowS
$cshowList :: [Param] -> ShowS
show :: Param -> ModId
$cshow :: Param -> ModId
showsPrec :: Int -> Param -> ShowS
$cshowsPrec :: Int -> Param -> ShowS
Show
data Lincat = Lincat {Lincat -> ModId
cat  :: Cat, Lincat -> ModId
lintype:: Term}            deriving Int -> Lincat -> ShowS
[Lincat] -> ShowS
Lincat -> ModId
(Int -> Lincat -> ShowS)
-> (Lincat -> ModId) -> ([Lincat] -> ShowS) -> Show Lincat
forall a.
(Int -> a -> ShowS) -> (a -> ModId) -> ([a] -> ShowS) -> Show a
showList :: [Lincat] -> ShowS
$cshowList :: [Lincat] -> ShowS
show :: Lincat -> ModId
$cshow :: Lincat -> ModId
showsPrec :: Int -> Lincat -> ShowS
$cshowsPrec :: Int -> Lincat -> ShowS
Show
data Oper   = Oper   {Oper -> ModId
oname:: Lhs, Oper -> ModId
orhs:: Term}               deriving Int -> Oper -> ShowS
[Oper] -> ShowS
Oper -> ModId
(Int -> Oper -> ShowS)
-> (Oper -> ModId) -> ([Oper] -> ShowS) -> Show Oper
forall a.
(Int -> a -> ShowS) -> (a -> ModId) -> ([a] -> ShowS) -> Show a
showList :: [Oper] -> ShowS
$cshowList :: [Oper] -> ShowS
show :: Oper -> ModId
$cshow :: Oper -> ModId
showsPrec :: Int -> Oper -> ShowS
$cshowsPrec :: Int -> Oper -> ShowS
Show
data Lin    = Lin    {Lin -> ModId
fun  :: FunId, Lin -> [ModId]
args:: [Id], Lin -> ModId
lin:: Term} deriving Int -> Lin -> ShowS
[Lin] -> ShowS
Lin -> ModId
(Int -> Lin -> ShowS)
-> (Lin -> ModId) -> ([Lin] -> ShowS) -> Show Lin
forall a.
(Int -> a -> ShowS) -> (a -> ModId) -> ([a] -> ShowS) -> Show a
showList :: [Lin] -> ShowS
$cshowList :: [Lin] -> ShowS
show :: Lin -> ModId
$cshow :: Lin -> ModId
showsPrec :: Int -> Lin -> ShowS
$cshowsPrec :: Int -> Lin -> ShowS
Show

type Lhs = String -- name and type of oper,
                  -- e.g "regN : Str -> { s:Str,g:Gender} ="
type Term = String -- arbitrary GF term (not parsed by the editor)