{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Brassica.Paradigm.Types where

import Data.String (IsString)

-- | Represents a single morphophonological process: currently, either
-- prefixation or suffixation of a 'String'. The 'Int' gives the
-- distance of the affix from the root.
data Process
    = Prefix Int String
    | Suffix Int String
    deriving (Int -> Process -> ShowS
[Process] -> ShowS
Process -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Process] -> ShowS
$cshowList :: [Process] -> ShowS
show :: Process -> String
$cshow :: Process -> String
showsPrec :: Int -> Process -> ShowS
$cshowsPrec :: Int -> Process -> ShowS
Show, Process -> Process -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Process -> Process -> Bool
$c/= :: Process -> Process -> Bool
== :: Process -> Process -> Bool
$c== :: Process -> Process -> Bool
Eq)

-- | A single affix (using the term in a wide sense) can be thought of
-- as a list of morphophonological processes. For instance, the Berber
-- feminine circumfix /t-/…/-t/ might be represented as
-- @['Prefix' 1 "t", 'Suffix' 1 "t"] :: 'Affix'@.
type Affix = [Process]

-- | A 'Grammeme' represents one value of a grammatical feature: for
-- instance past, or dual. This can be realised as a 'Concrete' affix,
-- or can be left 'Abstract' so that it can be encoded in a cumulative
-- morph or similar.
--
-- (The name is from Wikipedia; it doesn’t seem widely-used, but I can
-- find no better for this concept.)
data Grammeme = Concrete Affix | Abstract AbstractGrammeme
    deriving (Int -> Grammeme -> ShowS
[Grammeme] -> ShowS
Grammeme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Grammeme] -> ShowS
$cshowList :: [Grammeme] -> ShowS
show :: Grammeme -> String
$cshow :: Grammeme -> String
showsPrec :: Int -> Grammeme -> ShowS
$cshowsPrec :: Int -> Grammeme -> ShowS
Show, Grammeme -> Grammeme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Grammeme -> Grammeme -> Bool
$c/= :: Grammeme -> Grammeme -> Bool
== :: Grammeme -> Grammeme -> Bool
$c== :: Grammeme -> Grammeme -> Bool
Eq)

-- | An abstract identifier for a 'Grammeme'.
newtype AbstractGrammeme = AbstractGrammeme String
    deriving stock (Int -> AbstractGrammeme -> ShowS
[AbstractGrammeme] -> ShowS
AbstractGrammeme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbstractGrammeme] -> ShowS
$cshowList :: [AbstractGrammeme] -> ShowS
show :: AbstractGrammeme -> String
$cshow :: AbstractGrammeme -> String
showsPrec :: Int -> AbstractGrammeme -> ShowS
$cshowsPrec :: Int -> AbstractGrammeme -> ShowS
Show, AbstractGrammeme -> AbstractGrammeme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbstractGrammeme -> AbstractGrammeme -> Bool
$c/= :: AbstractGrammeme -> AbstractGrammeme -> Bool
== :: AbstractGrammeme -> AbstractGrammeme -> Bool
$c== :: AbstractGrammeme -> AbstractGrammeme -> Bool
Eq)
    deriving newtype (String -> AbstractGrammeme
forall a. (String -> a) -> IsString a
fromString :: String -> AbstractGrammeme
$cfromString :: String -> AbstractGrammeme
IsString)

-- | A condition which must be satisfied before including a 'Feature'
-- in a word. 
data Condition
    = Always
    -- ^ Condition which is always satisfied
    | Is FeatureName Grammeme
    -- ^ Satisfied when the specified feature (identified by its name)
    -- has been assigned to the specified 'Grammeme'
    | Not FeatureName Grammeme
    -- ^ Satisfied when the specified feature has /not/ been assigned
    -- to the specified 'Grammeme'
    deriving (Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> Condition -> ShowS
Show, Condition -> Condition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c== :: Condition -> Condition -> Bool
Eq)

-- | A grammatical feature, which may be realised by one of a
-- selection of 'Grammeme's. A feature may be given a descriptive
-- name, as well as a condition which must be satisfied for the
-- 'Feature' to be included in a word.
data Feature = Feature Condition (Maybe FeatureName) [Grammeme]
    deriving (Int -> Feature -> ShowS
[Feature] -> ShowS
Feature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feature] -> ShowS
$cshowList :: [Feature] -> ShowS
show :: Feature -> String
$cshow :: Feature -> String
showsPrec :: Int -> Feature -> ShowS
$cshowsPrec :: Int -> Feature -> ShowS
Show, Feature -> Feature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feature -> Feature -> Bool
$c/= :: Feature -> Feature -> Bool
== :: Feature -> Feature -> Bool
$c== :: Feature -> Feature -> Bool
Eq)

newtype FeatureName = FeatureName String
    deriving stock (Int -> FeatureName -> ShowS
[FeatureName] -> ShowS
FeatureName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FeatureName] -> ShowS
$cshowList :: [FeatureName] -> ShowS
show :: FeatureName -> String
$cshow :: FeatureName -> String
showsPrec :: Int -> FeatureName -> ShowS
$cshowsPrec :: Int -> FeatureName -> ShowS
Show, FeatureName -> FeatureName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FeatureName -> FeatureName -> Bool
$c/= :: FeatureName -> FeatureName -> Bool
== :: FeatureName -> FeatureName -> Bool
$c== :: FeatureName -> FeatureName -> Bool
Eq)
    deriving newtype (String -> FeatureName
forall a. (String -> a) -> IsString a
fromString :: String -> FeatureName
$cfromString :: String -> FeatureName
IsString)

-- | Each statement in a paradigm description specifies either a new
-- 'Feature', or a new mapping from a set of abstract grammemes to
-- their realisation.
data Statement = NewFeature Feature | NewMapping [AbstractGrammeme] Affix
    deriving (Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
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, Statement -> Statement -> Bool
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)

-- | A paradigm is specified as a list of 'Statement's. The list is
-- basically big-endian, in that the slowest-varying feature should be
-- listed first. (So if e.g. tense is listed first, then first all
-- words of tense 1 are listed, next all words of tense 2 are listed,
-- and so on.)
type Paradigm = [Statement]