-- |
-- Module      :  Text.Inflections.Types
-- Copyright   :  © 2016 Justin Leitgeb
-- License     :  MIT
--
-- Maintainer  :  Justin Leitgeb <justin@stackbuilders.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Types used in the library. Usually you don't need to import this module
-- and "Text.Inflections" should be enough.

{-# 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

-- | Create a word from given 'Text'. The input should consist of only
-- alpha-numeric characters (no white spaces or punctuation)
-- 'InflectionInvalidWord' will be thrown.
--
-- /since 0.3.0.0/

mkWord :: MonadThrow m => Text -> m (Word 'Normal)
mkWord :: forall (m :: * -> *). MonadThrow m => Text -> m (Word 'Normal)
mkWord Text
txt =
  if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlphaNum Text
txt
    then forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: WordType). Text -> Word t
Word Text
txt)
    else forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> InflectionException
InflectionInvalidWord Text
txt)

-- | Create an acronym from given 'Text'. The input should consist of only
-- alpha-numeric characters 'InflectionInvalidAcronym' will be thrown.
-- Acronym is different from normal word by that it may not be transformed
-- by inflections (also see 'unSomeWord').
--
-- /since 0.3.0.0/

mkAcronym :: MonadThrow m => Text -> m (Word 'Acronym)
mkAcronym :: forall (m :: * -> *). MonadThrow m => Text -> m (Word 'Acronym)
mkAcronym Text
txt =
  if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlphaNum Text
txt
    then forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: WordType). Text -> Word t
Word Text
txt)
    else forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> InflectionException
InflectionInvalidAcronym Text
txt)

-- | A 'Text' value that should be kept whole through applied inflections.

data Word (t :: WordType) = Word Text
  deriving (Word t -> Word t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: WordType). Word t -> Word t -> Bool
/= :: Word t -> Word t -> Bool
$c/= :: forall (t :: WordType). Word t -> Word t -> Bool
== :: Word t -> Word t -> Bool
$c== :: forall (t :: WordType). Word t -> Word t -> Bool
Eq, Word t -> Word t -> Bool
Word t -> Word t -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (t :: WordType). Eq (Word t)
forall (t :: WordType). Word t -> Word t -> Bool
forall (t :: WordType). Word t -> Word t -> Ordering
forall (t :: WordType). Word t -> Word t -> Word t
min :: Word t -> Word t -> Word t
$cmin :: forall (t :: WordType). Word t -> Word t -> Word t
max :: Word t -> Word t -> Word t
$cmax :: forall (t :: WordType). Word t -> Word t -> Word t
>= :: Word t -> Word t -> Bool
$c>= :: forall (t :: WordType). Word t -> Word t -> Bool
> :: Word t -> Word t -> Bool
$c> :: forall (t :: WordType). Word t -> Word t -> Bool
<= :: Word t -> Word t -> Bool
$c<= :: forall (t :: WordType). Word t -> Word t -> Bool
< :: Word t -> Word t -> Bool
$c< :: forall (t :: WordType). Word t -> Word t -> Bool
compare :: Word t -> Word t -> Ordering
$ccompare :: forall (t :: WordType). Word t -> Word t -> Ordering
Ord)

instance Show (Word 'Normal) where
  show :: Word 'Normal -> String
show (Word Text
x) = String
"Word " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
x

instance Show (Word 'Acronym) where
  show :: Word 'Acronym -> String
show (Word Text
x) = String
"Acronym " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
x

-- | A type-level tag for words.
--
-- /since 0.3.0.0/

data WordType = Normal | Acronym

-- | Get a 'Text' value from 'Word'.
--
-- /since 0.3.0.0/

unWord :: Word t -> Text
unWord :: forall (t :: WordType). Word t -> Text
unWord (Word Text
s) = Text
s

-- | An existential wrapper that allows to keep words and acronyms in single
-- list for example. The only thing that receiver of 'SomeWord' can do is to
-- apply 'unWord' on it, of course. This is faciliated by 'unSomeWord'.
--
-- /since 0.3.0.0/

data SomeWord where
  SomeWord :: (Transformable (Word t), Show (Word t)) => Word t -> SomeWord
  -- NOTE The constraint is only needed because GHC is not smart enough
  -- (yet?) to figure out that t cannot be anything other than Normal and
  -- Acronym and thus all cases are already covered by the instances
  -- provided below.

instance Show SomeWord where
  show :: SomeWord -> String
show (SomeWord Word t
w) = forall a. Show a => a -> String
show Word t
w

instance Eq SomeWord where
  SomeWord
x == :: SomeWord -> SomeWord -> Bool
== SomeWord
y = (Text -> Text) -> SomeWord -> Text
unSomeWord forall a. a -> a
id SomeWord
x forall a. Eq a => a -> a -> Bool
== (Text -> Text) -> SomeWord -> Text
unSomeWord forall a. a -> a
id SomeWord
y

-- | Extract 'Text' from 'SomeWord' and apply given function only if the
-- word inside wasn't an acronym.
--
-- /since 0.3.0.0/

unSomeWord :: (Text -> Text) -> SomeWord -> Text
unSomeWord :: (Text -> Text) -> SomeWord -> Text
unSomeWord Text -> Text
f (SomeWord Word t
w) = forall a. Transformable a => (Text -> Text) -> a -> Text
transform Text -> Text
f Word t
w

-- | Non public stuff.

class Transformable a where
  transform :: (Text -> Text) -> a -> Text

instance Transformable (Word 'Normal) where
  transform :: (Text -> Text) -> Word 'Normal -> Text
transform Text -> Text
f = Text -> Text
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: WordType). Word t -> Text
unWord

instance Transformable (Word 'Acronym) where
  transform :: (Text -> Text) -> Word 'Acronym -> Text
transform Text -> Text
_ = forall (t :: WordType). Word t -> Text
unWord

-- | The exceptions that is thrown when parsing of input fails.
--
-- /since 0.3.0.0/

data InflectionException
  = InflectionParsingFailed (ParseErrorBundle Text Void)
  | InflectionInvalidWord Text
  | InflectionInvalidAcronym Text
  deriving (InflectionException -> InflectionException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InflectionException -> InflectionException -> Bool
$c/= :: InflectionException -> InflectionException -> Bool
== :: InflectionException -> InflectionException -> Bool
$c== :: InflectionException -> InflectionException -> Bool
Eq, Int -> InflectionException -> ShowS
[InflectionException] -> ShowS
InflectionException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InflectionException] -> ShowS
$cshowList :: [InflectionException] -> ShowS
show :: InflectionException -> String
$cshow :: InflectionException -> String
showsPrec :: Int -> InflectionException -> ShowS
$cshowsPrec :: Int -> InflectionException -> ShowS
Show, Typeable, Typeable InflectionException
InflectionException -> DataType
InflectionException -> Constr
(forall b. Data b => b -> b)
-> InflectionException -> InflectionException
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> InflectionException -> u
forall u.
(forall d. Data d => d -> u) -> InflectionException -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InflectionException -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InflectionException -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InflectionException -> m InflectionException
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InflectionException -> m InflectionException
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InflectionException
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InflectionException
-> c InflectionException
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InflectionException)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InflectionException)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InflectionException -> m InflectionException
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InflectionException -> m InflectionException
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InflectionException -> m InflectionException
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InflectionException -> m InflectionException
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InflectionException -> m InflectionException
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InflectionException -> m InflectionException
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InflectionException -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InflectionException -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> InflectionException -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> InflectionException -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InflectionException -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InflectionException -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InflectionException -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InflectionException -> r
gmapT :: (forall b. Data b => b -> b)
-> InflectionException -> InflectionException
$cgmapT :: (forall b. Data b => b -> b)
-> InflectionException -> InflectionException
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InflectionException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InflectionException)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InflectionException)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InflectionException)
dataTypeOf :: InflectionException -> DataType
$cdataTypeOf :: InflectionException -> DataType
toConstr :: InflectionException -> Constr
$ctoConstr :: InflectionException -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InflectionException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InflectionException
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InflectionException
-> c InflectionException
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InflectionException
-> c InflectionException
Data, forall x. Rep InflectionException x -> InflectionException
forall x. InflectionException -> Rep InflectionException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InflectionException x -> InflectionException
$cfrom :: forall x. InflectionException -> Rep InflectionException x
Generic)

instance Exception InflectionException