{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}

{-|
Module      : Framework.Grammar.CCG
Description : CCG derivations.
Copyright   : (c) Julian Grove and Aaron Steven White, 2025
License     : MIT
Maintainer  : julian.grove@gmail.com

CCG types are defined and used to type strings, analogously to the way λ-terms
are typed.
-}

module Framework.Grammar.CCG where

import           Data.Bifunctor
import           Data.List
import           Data.Maybe                         (maybeToList)
import           Control.Monad
import           Control.Monad.State
import qualified Data.Map            as Map
import           Prelude             as Prel hiding (Word)
import           Framework.Lambda                   (Typed)

--------------------------------------------------------------------------------
-- * Expressions and grammatical categories

type Word = String
type Expr = [Word]

data Cat = Base String
         | Cat :/: Cat
         | Cat :\: Cat
  deriving (Cat -> Cat -> Bool
(Cat -> Cat -> Bool) -> (Cat -> Cat -> Bool) -> Eq Cat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cat -> Cat -> Bool
== :: Cat -> Cat -> Bool
$c/= :: Cat -> Cat -> Bool
/= :: Cat -> Cat -> Bool
Eq)

instance Show Cat where
  show :: Cat -> String
show = \case
    Base String
a  -> String
a
    Cat
a :/: Cat
b -> String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Cat -> String
forall a. Show a => a -> String
show Cat
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Cat -> String
forall a. Show a => a -> String
show Cat
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    Cat
a :\: Cat
b -> String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Cat -> String
forall a. Show a => a -> String
show Cat
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Cat -> String
forall a. Show a => a -> String
show Cat
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

infixl :/:
infixl :\:

(//), (\\) :: Cat -> Cat -> Cat
Cat
a // :: Cat -> Cat -> Cat
// Cat
b = Cat
a Cat -> Cat -> Cat
:/: Cat
b
Cat
a \\ :: Cat -> Cat -> Cat
\\ Cat
b = Cat
a Cat -> Cat -> Cat
:\: Cat
b

type Lexicon m = Word -> [m]

data Project = Adjectives | Factivity

class Interpretation (p :: Project) m where
  lexica   :: [Lexicon m]
  combineR :: m -> m -> [m]
  combineL :: m -> m -> [m]