{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
module Text.Inflections.Types
( Word
, WordType (..)
, mkWord
, mkAcronym
, unWord
, SomeWord (..)
, unSomeWord
, InflectionException (..) )
where
import Control.Monad.Catch
import Data.Char (isAlphaNum)
import Data.Data (Data)
import Data.Void (Void)
import Data.Text (Text)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Text.Megaparsec
import qualified Data.Text as T
#if MIN_VERSION_base(4,8,0)
import Prelude hiding (Word)
#endif
mkWord :: MonadThrow m => Text -> m (Word 'Normal)
mkWord txt =
if T.all isAlphaNum txt
then return (Word txt)
else throwM (InflectionInvalidWord txt)
mkAcronym :: MonadThrow m => Text -> m (Word 'Acronym)
mkAcronym txt =
if T.all isAlphaNum txt
then return (Word txt)
else throwM (InflectionInvalidAcronym txt)
data Word (t :: WordType) = Word Text
deriving (Eq, Ord)
instance Show (Word 'Normal) where
show (Word x) = "Word " ++ show x
instance Show (Word 'Acronym) where
show (Word x) = "Acronym " ++ show x
data WordType = Normal | Acronym
unWord :: Word t -> Text
unWord (Word s) = s
data SomeWord where
SomeWord :: (Transformable (Word t), Show (Word t)) => Word t -> SomeWord
instance Show SomeWord where
show (SomeWord w) = show w
instance Eq SomeWord where
x == y = unSomeWord id x == unSomeWord id y
unSomeWord :: (Text -> Text) -> SomeWord -> Text
unSomeWord f (SomeWord w) = transform f w
class Transformable a where
transform :: (Text -> Text) -> a -> Text
instance Transformable (Word 'Normal) where
transform f = f . unWord
instance Transformable (Word 'Acronym) where
transform _ = unWord
data InflectionException
= InflectionParsingFailed (ParseErrorBundle Text Void)
| InflectionInvalidWord Text
| InflectionInvalidAcronym Text
deriving (Eq, Show, Typeable, Data, Generic)
instance Exception InflectionException