{- This file is part of language-kort.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Language.Kort.Types
    ( Resource (..)
    , Element (..)
    , Comment
    , Statement (..)
    , Line (..)
    , Document
    , ParseError (..)
    , ParseResult (..)
    , UidMap
    )
where

import Text.Razom.Types

-- | A resource, either an actual Uid or a placeholder.
data Resource
    -- | A resource Uid.
    = Uid String
    -- | A generator with a label. When generating Uids to fill the
    -- placeholders, generators with the same label get assigned the same Uid.
    | LGenerator String
    -- | A unique generator. When generating Uids, it will get assigned its own
    -- unique Uid.
    | UGenerator
    deriving (Eq, Show)

-- | A statement element, i.e. a relation tuple member. Either a resource or a
-- value with a literal and a type resource.
data Element = Resource Resource | Value String Resource deriving (Eq, Show)

-- | Kort comment line.
type Comment = String

-- | A tuple of arbitrary arity, which is a member of a given relation.
-- Parameters:
--
-- (1) Identifier
-- (2) Relation
-- (3) Elements: subject, object, etc.
data Statement = Statement Resource Resource [Element] deriving (Eq, Show)

-- | A Kort line. Either a comment or an arbitrary-arity statement.
type Line = Either Comment Statement

-- | A Kort document, represented as a list of lines. Note that in Kort the
-- order of lines is semantically insignificant.
type Document = [Line]

-- | Returned when the parser fails.
type ParseError = LexError Line

-- | Returned from the parser. Provides either the parsed line, or error
-- information.
type ParseResult = LexResult Line

-- | A structure storing generated Uids for insertion to placeholders.
type UidMap = ([(String, String)], [String])