{-# 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
(Int -> Process -> ShowS)
-> (Process -> String) -> ([Process] -> ShowS) -> Show Process
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Process -> ShowS
showsPrec :: Int -> Process -> ShowS
$cshow :: Process -> String
show :: Process -> String
$cshowList :: [Process] -> ShowS
showList :: [Process] -> ShowS
Show, Process -> Process -> Bool
(Process -> Process -> Bool)
-> (Process -> Process -> Bool) -> Eq Process
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Process -> Process -> Bool
== :: Process -> Process -> Bool
$c/= :: Process -> Process -> Bool
/= :: 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
(Int -> Grammeme -> ShowS)
-> (Grammeme -> String) -> ([Grammeme] -> ShowS) -> Show Grammeme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Grammeme -> ShowS
showsPrec :: Int -> Grammeme -> ShowS
$cshow :: Grammeme -> String
show :: Grammeme -> String
$cshowList :: [Grammeme] -> ShowS
showList :: [Grammeme] -> ShowS
Show, Grammeme -> Grammeme -> Bool
(Grammeme -> Grammeme -> Bool)
-> (Grammeme -> Grammeme -> Bool) -> Eq Grammeme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Grammeme -> Grammeme -> Bool
== :: Grammeme -> Grammeme -> Bool
$c/= :: Grammeme -> Grammeme -> Bool
/= :: Grammeme -> Grammeme -> Bool
Eq)

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

-- | A condition which must be satisfied for a 'Feature' to be
-- included in a word.
data Condition
    = Always
    -- ^ Condition which is always satisfied
    | Is FeatureName Grammeme
    -- ^ Satisfied when the specified feature 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
(Int -> Condition -> ShowS)
-> (Condition -> String)
-> ([Condition] -> ShowS)
-> Show Condition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Condition -> ShowS
showsPrec :: Int -> Condition -> ShowS
$cshow :: Condition -> String
show :: Condition -> String
$cshowList :: [Condition] -> ShowS
showList :: [Condition] -> ShowS
Show, Condition -> Condition -> Bool
(Condition -> Condition -> Bool)
-> (Condition -> Condition -> Bool) -> Eq Condition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
/= :: 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
(Int -> Feature -> ShowS)
-> (Feature -> String) -> ([Feature] -> ShowS) -> Show Feature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Feature -> ShowS
showsPrec :: Int -> Feature -> ShowS
$cshow :: Feature -> String
show :: Feature -> String
$cshowList :: [Feature] -> ShowS
showList :: [Feature] -> ShowS
Show, Feature -> Feature -> Bool
(Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool) -> Eq Feature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Feature -> Feature -> Bool
== :: Feature -> Feature -> Bool
$c/= :: Feature -> Feature -> Bool
/= :: Feature -> Feature -> Bool
Eq)

-- | Name to identify a specific 'Feature'.
newtype FeatureName = FeatureName String
    deriving stock (Int -> FeatureName -> ShowS
[FeatureName] -> ShowS
FeatureName -> String
(Int -> FeatureName -> ShowS)
-> (FeatureName -> String)
-> ([FeatureName] -> ShowS)
-> Show FeatureName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FeatureName -> ShowS
showsPrec :: Int -> FeatureName -> ShowS
$cshow :: FeatureName -> String
show :: FeatureName -> String
$cshowList :: [FeatureName] -> ShowS
showList :: [FeatureName] -> ShowS
Show, FeatureName -> FeatureName -> Bool
(FeatureName -> FeatureName -> Bool)
-> (FeatureName -> FeatureName -> Bool) -> Eq FeatureName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FeatureName -> FeatureName -> Bool
== :: FeatureName -> FeatureName -> Bool
$c/= :: FeatureName -> FeatureName -> Bool
/= :: FeatureName -> FeatureName -> Bool
Eq)
    deriving newtype (String -> FeatureName
(String -> FeatureName) -> IsString FeatureName
forall a. (String -> a) -> IsString a
$cfromString :: String -> FeatureName
fromString :: 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
(Int -> Statement -> ShowS)
-> (Statement -> String)
-> ([Statement] -> ShowS)
-> Show Statement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Statement -> ShowS
showsPrec :: Int -> Statement -> ShowS
$cshow :: Statement -> String
show :: Statement -> String
$cshowList :: [Statement] -> ShowS
showList :: [Statement] -> ShowS
Show, Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
/= :: Statement -> Statement -> Bool
Eq)

-- | A paradigm is specified as a list of 'Statement's. The order is
-- reflected in the output 'Brassica.Paradigm.Apply.ResultsTree': the
-- root has one child for each grammeme in the first 'Feature', with
-- each child then having one child for each grammeme in the second
-- 'Feature', and so on.
type Paradigm = [Statement]