{-|

Use of these quasi-quoters in a pattern context requires the @ViewPatterns@
language extension.

-}
module ASCII.QuasiQuoters
  (
    {- * Character -} char,
    {- * String -} string,
    {- * Caseless string -} caseless,
    {- * Upper-case string -} upper,
    {- * Lower-case string -} lower,
  )
  where

import ASCII.Case (Case (..))
import ASCII.Caseless (CaselessChar)
import ASCII.Char (Char)
import Control.Monad (return, (>=>))
import Control.Monad.Fail (MonadFail, fail)
import Data.Functor ((<$>))
import Data.Maybe (Maybe (..))
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH.Syntax (Exp, Pat, Q)

import qualified ASCII.Case as Case
import qualified ASCII.Superset as S
import qualified ASCII.TemplateHaskell as TH
import qualified Data.Char as Unicode
import qualified Data.List as List
import qualified Data.String as Unicode

{-| An expression pattern corresponding to an ASCII character

=== In an expression context

The result will have a 'ASCII.Superset.FromChar' constraint.

The quasi-quoted string must consist of a single character that is within the
ASCII character set.

@
[char|e|] == SmallLetterE

[char|e|] == (101 :: Word8)
@

Since this is polymorphic, a type signature is recommended.

=== In a pattern context

The pattern matches a value of a type satisfying the 'ASCII.Superset.ToChar'
constraint.

@
let
    x = case Tilde of
          [char|@|] -> 1
          [char|~|] -> 2
          _ -> 3
in
    x == 2
@

-}

char :: QuasiQuoter
char :: QuasiQuoter
char = (String -> Q Char)
-> (Char -> Q Exp) -> (Char -> Q Pat) -> QuasiQuoter
forall a.
(String -> Q a) -> (a -> Q Exp) -> (a -> Q Pat) -> QuasiQuoter
expPatQQ String -> Q Char
requireOneAscii Char -> Q Exp
TH.isCharExp Char -> Q Pat
TH.isCharPat

{- | An expression or pattern corresponding to an ASCII string

=== In an expression context

The result will have a 'ASCII.Superset.FromString' constraint.

The quasi-quoted string must consist only of characters are within the ASCII
character set.

@
[string|Hello!|] ==
    [CapitalLetterH,SmallLetterE,SmallLetterL,SmallLetterL,SmallLetterO,ExclamationMark]

[string|Hello!|] == ("Hello!" :: 'Data.String.String')

[string|Hello!|] == ("Hello!" :: 'Data.Text.Text')

'Data.ByteString.Builder.toLazyByteString' [string|Hello!|] == "Hello!"
@

Since this is polymorphic, a type signature is recommended.

=== In a pattern context

The pattern matches a value of a type satisfying the 'ASCII.Superset.ToString'
constraint.

@
let
    x = case [CapitalLetterH, SmallLetterI] of
          [string|Bye|] -> 1
          [string|Hi|] -> 2
          _ -> 3
in
    x == 2
@

-}

string :: QuasiQuoter
string :: QuasiQuoter
string = (String -> Q [Char])
-> ([Char] -> Q Exp) -> ([Char] -> Q Pat) -> QuasiQuoter
forall a.
(String -> Q a) -> (a -> Q Exp) -> (a -> Q Pat) -> QuasiQuoter
expPatQQ String -> Q [Char]
requireAsciiList [Char] -> Q Exp
TH.isStringExp [Char] -> Q Pat
TH.isStringPat

{-| An expression or pattern corresponding to a case-insensitive ASCII string

=== In an expression context

A monomorphic expression of type @['CaselessChar']@.

@
[caseless|Hello!|] ==
    [LetterH, LetterE, LetterL, LetterL, LetterO, ExclamationMark]
@

=== In a pattern context

A case-insensitive match of any type belonging to the
'ASCII.Superset.ToCaselessString' class.

@
let
    x = case "Hello!" :: 'Text' of
          [caseless|Bye!|] -> 1
          [caseless|hEllo!|] -> 2
          _ -> 3
in
    x == 2
@

-}
caseless :: QuasiQuoter
caseless :: QuasiQuoter
caseless = (String -> Q [CaselessChar])
-> ([CaselessChar] -> Q Exp)
-> ([CaselessChar] -> Q Pat)
-> QuasiQuoter
forall a.
(String -> Q a) -> (a -> Q Exp) -> (a -> Q Pat) -> QuasiQuoter
expPatQQ String -> Q [CaselessChar]
requireAsciiListCI [CaselessChar] -> Q Exp
TH.caselessListExp [CaselessChar] -> Q Pat
TH.caselessIsStringPat

{-| An expression or pattern corresponding to an ASCII string where all the
letters are of lower case

The letters in the body of the quasi-quotation may be written in any case
you like; they will be converted to lower case automatically.

=== In an expression context

The expression can become any type belonging to the 'ASCII.Superset.FromString'
class. Any letters in the quoted content will be converted to lower case.

@
[lower|Hello!|] == ("hello!" :: 'Text')
@

=== In a pattern context

The pattern matches a value of a type satisfying the 'ASCII.Superset.ToString'
constraint. A value matches this pattern if:

* All of the letters in the tested value are in lower case
* The tested value satisfies a case-insensitive comparison
  with the quasi-quoted content

@
let
    x = case "hi!" :: 'Text' of
          [lower|wow|] -> 1
          [lower|Hi!|] -> 2
          _ -> 3
in
    x == 2
@

-}
lower :: QuasiQuoter
lower :: QuasiQuoter
lower = Case -> QuasiQuoter
ofCase Case
LowerCase

{-| An expression or pattern corresponding to an ASCII string where all the
letters are of upper case

The letters in the body of the quasi-quotation may be written in any case
you like; they will be converted to upper case automatically.

=== In an expression context

The expression can become any type belonging to the 'ASCII.Superset.FromString'
class. Any letters in the quoted content will be converted to upper case.

@
[upper|Hello!|] == ("HELLO!" :: 'Text')
@

=== In a pattern context

The pattern matches a value of a type satisfying the 'ASCII.Superset.ToString'
constraint. A value matches this pattern if:

* All of the letters in the tested value are in upper case
* The tested value satisfies a case-insensitive comparison
  with the quasi-quoted content

@
let
    x = case "HI!" :: 'Text' of
          [QQ.upper|wow|] -> 1
          [QQ.upper|Hi!|] -> 2
          _ -> 3
in
    x == 2
@

-}
upper :: QuasiQuoter
upper :: QuasiQuoter
upper = Case -> QuasiQuoter
ofCase Case
UpperCase

ofCase :: Case -> QuasiQuoter
ofCase :: Case -> QuasiQuoter
ofCase Case
c = (String -> Q [Char])
-> ([Char] -> Q Exp) -> ([Char] -> Q Pat) -> QuasiQuoter
forall a.
(String -> Q a) -> (a -> Q Exp) -> (a -> Q Pat) -> QuasiQuoter
expPatQQ (Case -> String -> Q [Char]
requireAsciiToCase Case
c) [Char] -> Q Exp
TH.isStringExp [Char] -> Q Pat
TH.isStringPat

{-| Require the string to consist of exactly one ASCII character -}
requireOneAscii :: Unicode.String -> Q Char
requireOneAscii :: String -> Q Char
requireOneAscii = String -> Q Char
requireOne (String -> Q Char) -> (Char -> Q Char) -> String -> Q Char
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Char -> Q Char
requireAscii

{-| Require the list to consist of exactly one element -}
oneMaybe :: [a] -> Maybe a
oneMaybe :: [a] -> Maybe a
oneMaybe [a]
xs = case [a]
xs of [a
x] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x; [a]
_ -> Maybe a
forall a. Maybe a
Nothing

{-| Require the string to consist of exactly one character -}
requireOne :: Unicode.String -> Q Unicode.Char
requireOne :: String -> Q Char
requireOne = String -> Maybe Char
forall a. [a] -> Maybe a
oneMaybe (String -> Maybe Char) -> String -> String -> Q Char
forall a b. (a -> Maybe b) -> String -> a -> Q b
|| String
"Must be exactly one character."

{-| Require the character to be ASCII -}
requireAscii :: Unicode.Char -> Q Char
requireAscii :: Char -> Q Char
requireAscii = Char -> Maybe Char
forall char. ToChar char => char -> Maybe Char
S.toCharMaybe (Char -> Maybe Char) -> String -> Char -> Q Char
forall a b. (a -> Maybe b) -> String -> a -> Q b
|| String
"Must be an ASCII character."

{-| Require the string to consist of all ASCII characters -}
requireAsciiList :: Unicode.String -> Q [Char]
requireAsciiList :: String -> Q [Char]
requireAsciiList = String -> Maybe [Char]
forall string. ToString string => string -> Maybe [Char]
S.toCharListMaybe (String -> Maybe [Char]) -> String -> String -> Q [Char]
forall a b. (a -> Maybe b) -> String -> a -> Q b
|| String
"Must be only ASCII characters."

{-| Require the string to consist of all ASCII characters,
and return them with letter case discarded -}
requireAsciiListCI :: Unicode.String -> Q [CaselessChar]
requireAsciiListCI :: String -> Q [CaselessChar]
requireAsciiListCI = String -> Maybe [CaselessChar]
forall string.
ToCaselessString string =>
string -> Maybe [CaselessChar]
S.toCaselessCharListMaybe (String -> Maybe [CaselessChar])
-> String -> String -> Q [CaselessChar]
forall a b. (a -> Maybe b) -> String -> a -> Q b
|| String
"Must be only ASCII characters."

{-| Require the string to consist of all ASCII characters,
and return them converted to the given case -}
requireAsciiToCase :: Case -> Unicode.String -> Q [Char]
requireAsciiToCase :: Case -> String -> Q [Char]
requireAsciiToCase Case
c String
s = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
List.map (Case -> Char -> Char
Case.toCase Case
c) ([Char] -> [Char]) -> Q [Char] -> Q [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q [Char]
requireAsciiList String
s

(||) :: (a -> Maybe b) -> Unicode.String -> a -> Q b
a -> Maybe b
f || :: (a -> Maybe b) -> String -> a -> Q b
|| String
msg = \a
a -> case a -> Maybe b
f a
a of Just b
b -> b -> Q b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b; Maybe b
Nothing -> String -> Q b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg

expPatQQ :: (Unicode.String -> Q a) -> (a -> Q Exp) -> (a -> Q Pat) -> QuasiQuoter
expPatQQ :: (String -> Q a) -> (a -> Q Exp) -> (a -> Q Pat) -> QuasiQuoter
expPatQQ String -> Q a
f a -> Q Exp
a a -> Q Pat
b = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp  = String -> Q a
f (String -> Q a) -> (a -> Q Exp) -> String -> Q Exp
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Q Exp
a
    , quotePat :: String -> Q Pat
quotePat  = String -> Q a
f (String -> Q a) -> (a -> Q Pat) -> String -> Q Pat
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Q Pat
b
    , quoteType :: String -> Q Type
quoteType = String -> Q Type
forall (m :: * -> *) a b. MonadFail m => a -> m b
notType
    , quoteDec :: String -> Q [Dec]
quoteDec  = String -> Q [Dec]
forall (m :: * -> *) a b. MonadFail m => a -> m b
notDec
    }

notType :: MonadFail m => a -> m b
notType :: a -> m b
notType a
_ = String -> m b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot be used in a type context."

notDec :: MonadFail m => a -> m b
notDec :: a -> m b
notDec a
_ = String -> m b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot be used in a declaration context."