{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Brassica.SoundChange.Types
(
Grapheme
, PWord
, Lexeme(..)
, CategoryElement(..)
, LexemeType(..)
, Rule(..)
, Environment
, Direction(..)
, Flags(..)
, defFlags
, CategoriesDecl(..)
, Statement(..)
, plaintext'
, SoundChanges
, OneOf
) where
import Control.DeepSeq (NFData(..))
import Data.Kind (Constraint)
import GHC.Generics (Generic)
import GHC.TypeLits
type family OneOf a x y :: Constraint where
OneOf a a y = ()
OneOf a x a = ()
OneOf a b c =
( () ~ Bool
, TypeError ('Text "Couldn't match type "
':<>: 'ShowType a
':<>: 'Text " with "
':<>: 'ShowType b
':<>: 'Text " or "
':<>: 'ShowType c))
type Grapheme = [Char]
type PWord = [Grapheme]
data LexemeType = Target | Replacement | Env
data Lexeme (a :: LexemeType) where
Grapheme :: Grapheme -> Lexeme a
Category :: [CategoryElement a] -> Lexeme a
Boundary :: Lexeme 'Env
Optional :: [Lexeme a] -> Lexeme a
Metathesis :: Lexeme 'Replacement
Geminate :: Lexeme a
Wildcard :: OneOf a 'Target 'Env => Lexeme a -> Lexeme a
Kleene :: OneOf a 'Target 'Env => Lexeme a -> Lexeme a
Discard :: Lexeme 'Replacement
deriving instance Show (Lexeme a)
instance NFData (Lexeme a) where
rnf :: Lexeme a -> ()
rnf (Grapheme Grapheme
g) = forall a. NFData a => a -> ()
rnf Grapheme
g
rnf (Category [CategoryElement a]
cs) = forall a. NFData a => a -> ()
rnf [CategoryElement a]
cs
rnf Lexeme a
Boundary = ()
rnf (Optional [Lexeme a]
ls) = forall a. NFData a => a -> ()
rnf [Lexeme a]
ls
rnf Lexeme a
Metathesis = ()
rnf Lexeme a
Geminate = ()
rnf (Wildcard Lexeme a
l) = forall a. NFData a => a -> ()
rnf Lexeme a
l
rnf (Kleene Lexeme a
l) = forall a. NFData a => a -> ()
rnf Lexeme a
l
rnf Lexeme a
Discard = ()
data CategoryElement (a :: LexemeType) where
GraphemeEl :: Grapheme -> CategoryElement a
BoundaryEl :: CategoryElement 'Env
deriving instance Show (CategoryElement a)
deriving instance Eq (CategoryElement a)
deriving instance Ord (CategoryElement a)
instance NFData (CategoryElement a) where
rnf :: CategoryElement a -> ()
rnf (GraphemeEl Grapheme
a) = forall a. NFData a => a -> ()
rnf Grapheme
a
rnf CategoryElement a
BoundaryEl = ()
type Environment = ([Lexeme 'Env], [Lexeme 'Env])
data Direction = LTR | RTL
deriving (Direction -> Direction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> Grapheme
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> Grapheme
$cshow :: Direction -> Grapheme
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Direction x -> Direction
$cfrom :: forall x. Direction -> Rep Direction x
Generic, Direction -> ()
forall a. (a -> ()) -> NFData a
rnf :: Direction -> ()
$crnf :: Direction -> ()
NFData)
data Flags = Flags
{ Flags -> Bool
highlightChanges :: Bool
, Flags -> Direction
applyDirection :: Direction
, Flags -> Bool
applyOnceOnly :: Bool
, Flags -> Bool
sporadic :: Bool
} deriving (Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> Grapheme
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
showList :: [Flags] -> ShowS
$cshowList :: [Flags] -> ShowS
show :: Flags -> Grapheme
$cshow :: Flags -> Grapheme
showsPrec :: Int -> Flags -> ShowS
$cshowsPrec :: Int -> Flags -> ShowS
Show, forall x. Rep Flags x -> Flags
forall x. Flags -> Rep Flags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Flags x -> Flags
$cfrom :: forall x. Flags -> Rep Flags x
Generic, Flags -> ()
forall a. (a -> ()) -> NFData a
rnf :: Flags -> ()
$crnf :: Flags -> ()
NFData)
defFlags :: Flags
defFlags :: Flags
defFlags = Flags
{ highlightChanges :: Bool
highlightChanges = Bool
True
, applyDirection :: Direction
applyDirection = Direction
LTR
, applyOnceOnly :: Bool
applyOnceOnly = Bool
False
, sporadic :: Bool
sporadic = Bool
False
}
data Rule = Rule
{ Rule -> [Lexeme 'Target]
target :: [Lexeme 'Target]
, Rule -> [Lexeme 'Replacement]
replacement :: [Lexeme 'Replacement]
, Rule -> Environment
environment :: Environment
, Rule -> Maybe Environment
exception :: Maybe Environment
, Rule -> Flags
flags :: Flags
, Rule -> Grapheme
plaintext :: String
} deriving (Int -> Rule -> ShowS
[Rule] -> ShowS
Rule -> Grapheme
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
showList :: [Rule] -> ShowS
$cshowList :: [Rule] -> ShowS
show :: Rule -> Grapheme
$cshow :: Rule -> Grapheme
showsPrec :: Int -> Rule -> ShowS
$cshowsPrec :: Int -> Rule -> ShowS
Show, forall x. Rep Rule x -> Rule
forall x. Rule -> Rep Rule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rule x -> Rule
$cfrom :: forall x. Rule -> Rep Rule x
Generic, Rule -> ()
forall a. (a -> ()) -> NFData a
rnf :: Rule -> ()
$crnf :: Rule -> ()
NFData)
newtype CategoriesDecl = CategoriesDecl { CategoriesDecl -> [Grapheme]
graphemes :: [Grapheme] }
deriving (Int -> CategoriesDecl -> ShowS
[CategoriesDecl] -> ShowS
CategoriesDecl -> Grapheme
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
showList :: [CategoriesDecl] -> ShowS
$cshowList :: [CategoriesDecl] -> ShowS
show :: CategoriesDecl -> Grapheme
$cshow :: CategoriesDecl -> Grapheme
showsPrec :: Int -> CategoriesDecl -> ShowS
$cshowsPrec :: Int -> CategoriesDecl -> ShowS
Show, forall x. Rep CategoriesDecl x -> CategoriesDecl
forall x. CategoriesDecl -> Rep CategoriesDecl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CategoriesDecl x -> CategoriesDecl
$cfrom :: forall x. CategoriesDecl -> Rep CategoriesDecl x
Generic, CategoriesDecl -> ()
forall a. (a -> ()) -> NFData a
rnf :: CategoriesDecl -> ()
$crnf :: CategoriesDecl -> ()
NFData)
data Statement = RuleS Rule | CategoriesDeclS CategoriesDecl
deriving (Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> Grapheme
forall a.
(Int -> a -> ShowS) -> (a -> Grapheme) -> ([a] -> ShowS) -> Show a
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> Grapheme
$cshow :: Statement -> Grapheme
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show, forall x. Rep Statement x -> Statement
forall x. Statement -> Rep Statement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Statement x -> Statement
$cfrom :: forall x. Statement -> Rep Statement x
Generic, Statement -> ()
forall a. (a -> ()) -> NFData a
rnf :: Statement -> ()
$crnf :: Statement -> ()
NFData)
plaintext' :: Statement -> String
plaintext' :: Statement -> Grapheme
plaintext' (RuleS Rule
r) = Rule -> Grapheme
plaintext Rule
r
plaintext' (CategoriesDeclS CategoriesDecl
_) = Grapheme
"categories … end"
type SoundChanges = [Statement]