{-# LANGUAGE Safe #-}

{-|
Module      : Data.Char.Math.SansSerif.Greek
Description : Sans serif mathematical alphanumeric symbols
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

See "Data.Char.Math" for further documentation.
-}

module Data.Char.Math.SansSerif.Greek
  ( greekSansSerif,               greekSansSerif'
  , greekSansSerifNoBold,         greekSansSerifNoBold'
  , greekSansSerifBold,           greekSansSerifBold'
  , greekSansSerifNoItalic,       greekSansSerifNoItalic'
  , greekSansSerifItalic,         greekSansSerifItalic'
  , greekSansSerifNoBoldNoItalic, greekSansSerifNoBoldNoItalic'
  , greekSansSerifBoldNoItalic,   greekSansSerifBoldNoItalic'
  , greekSansSerifNoBoldItalic,   greekSansSerifNoBoldItalic'
  , greekSansSerifBoldItalic,     greekSansSerifBoldItalic'
  ) where


import Data.Char.Core (Emphasis, ItalicType, isGreek, splitEmphasis, splitItalicType)
import Data.Char.Math.Internal


-- | Convert the given character to a mathematical symbol without serifs, in the
-- given /emphasis/ and in the given /italics/ type wrapped in a 'Just'. If the character
-- is not in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@, 'Nothing' is returned.
greekSansSerif
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
greekSansSerif :: ItalicType -> Emphasis -> Char -> Maybe Char
greekSansSerif = (Emphasis -> Char -> Maybe Char)
-> (Emphasis -> Char -> Maybe Char)
-> ItalicType
-> Emphasis
-> Char
-> Maybe Char
forall a. a -> a -> ItalicType -> a
splitItalicType Emphasis -> Char -> Maybe Char
greekSansSerifNoItalic Emphasis -> Char -> Maybe Char
greekSansSerifItalic

-- | Convert the given character to a mathematical symbol without serifs, with a
-- given /emphasis/ and a given /italics/ style. This maps characters an equivalent sans-serif symbol
-- for the characters in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@.
-- For characters outside the range, the behavior is unspecified.
greekSansSerif'
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, depending on the given 'Emphasis' in bold or not, and depending on the given 'ItalicType' in italics or not.
greekSansSerif' :: ItalicType -> Emphasis -> Char -> Char
greekSansSerif' = (Emphasis -> Char -> Char)
-> (Emphasis -> Char -> Char)
-> ItalicType
-> Emphasis
-> Char
-> Char
forall a. a -> a -> ItalicType -> a
splitItalicType Emphasis -> Char -> Char
greekSansSerifNoItalic' Emphasis -> Char -> Char
greekSansSerifItalic'

-- | Convert the given character to a mathematical symbol without serifs, with no
-- /bold/ and no /italics/. This maps characters to itself.
greekSansSerifNoBoldNoItalic'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, not in bold and not in italics.
greekSansSerifNoBoldNoItalic' :: Char -> Char
greekSansSerifNoBoldNoItalic' = Char -> Char
forall a. a -> a
id

-- | Convert the given character to a mathematical symbol without serifs, with no
-- /bold/ and no /italics/. This maps characters to itself wrapped in a 'Just';
-- 'Nothing' if that character does not exists.
greekSansSerifNoBoldNoItalic
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
greekSansSerifNoBoldNoItalic :: Char -> Maybe Char
greekSansSerifNoBoldNoItalic = Maybe Char -> Char -> Maybe Char
forall a b. a -> b -> a
const Maybe Char
forall a. Maybe a
Nothing

-- | Convert the given character to a mathematical symbol without serifs, with no
-- /bold/ and no /italics/. This maps characters to itself.
greekSansSerifNoBoldItalic'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, not in bold and in italics.
greekSansSerifNoBoldItalic' :: Char -> Char
greekSansSerifNoBoldItalic' = Char -> Char
greekSansSerifNoBoldNoItalic'

-- | Convert the given character to a mathematical symbol without serifs, with no
-- /bold/, and in /italics/ wrapped in a 'Just'. If the character
-- is not in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@, 'Nothing' is returned.
greekSansSerifNoBoldItalic
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
greekSansSerifNoBoldItalic :: Char -> Maybe Char
greekSansSerifNoBoldItalic = Char -> Maybe Char
greekSansSerifNoBoldNoItalic

-- | Convert the given character to a mathematical symbol without serifs, in /bold/
-- not in /italics/. This maps characters an equivalent sans-serif symbol
-- for the characters in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@.
-- For characters outside the range, the behavior is unspecified.
greekSansSerifBoldNoItalic'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, in bold and not in italics.
greekSansSerifBoldNoItalic' :: Char -> Char
greekSansSerifBoldNoItalic' Char
'ϴ' = Char
'𝝧'
greekSansSerifBoldNoItalic' Char
'∇' = Char
'𝝯'
greekSansSerifBoldNoItalic' Char
'∂' = Char
'𝞉'
greekSansSerifBoldNoItalic' Char
'ϵ' = Char
'𝞊'
greekSansSerifBoldNoItalic' Char
'ϑ' = Char
'𝞋'
greekSansSerifBoldNoItalic' Char
'ϰ' = Char
'𝞌'
greekSansSerifBoldNoItalic' Char
'ϕ' = Char
'𝞍'
greekSansSerifBoldNoItalic' Char
'ϱ' = Char
'𝞎'
greekSansSerifBoldNoItalic' Char
'ϖ' = Char
'𝞏'
greekSansSerifBoldNoItalic' Char
c
  | Char
'Α' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Ω' = Int -> Char -> Char
_baseUpperLower Int
0x1d3c5 Char
c
  | Char
'α' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'ω' = Int -> Char -> Char
_baseUpperLower Int
0x1d3bf Char
c
  | Bool
otherwise            = Char
c

-- | Convert the given character to a mathematical symbol without serifs, in
-- /bold/, and no /italics/ wrapped in a 'Just'. If the character
-- is not in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@, 'Nothing' is returned.
greekSansSerifBoldNoItalic
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
greekSansSerifBoldNoItalic :: Char -> Maybe Char
greekSansSerifBoldNoItalic = (Char -> Bool) -> (Char -> Char) -> Char -> Maybe Char
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isGreek Char -> Char
greekSansSerifBoldNoItalic'

-- | Convert the given character to a mathematical symbol without serifs, with in
-- /bold/ and in /italics/. This maps characters an equivalent sans-serif symbol
-- for the characters in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@.
-- For characters outside the range, the behavior is unspecified.
greekSansSerifBoldItalic'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, in bold and in italics.
greekSansSerifBoldItalic' :: Char -> Char
greekSansSerifBoldItalic' Char
'ϴ' = Char
'𝞡'
greekSansSerifBoldItalic' Char
'∇' = Char
'𝞩'
greekSansSerifBoldItalic' Char
'∂' = Char
'𝟃'
greekSansSerifBoldItalic' Char
'ϵ' = Char
'𝟄'
greekSansSerifBoldItalic' Char
'ϑ' = Char
'𝟅'
greekSansSerifBoldItalic' Char
'ϰ' = Char
'𝟆'
greekSansSerifBoldItalic' Char
'ϕ' = Char
'𝟇'
greekSansSerifBoldItalic' Char
'ϱ' = Char
'𝟈'
greekSansSerifBoldItalic' Char
'ϖ' = Char
'𝟉'
greekSansSerifBoldItalic' Char
c
  | Char
'Α' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Ω' = Int -> Char -> Char
_baseUpperLower Int
0x1d3ff Char
c
  | Char
'α' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'ω' = Int -> Char -> Char
_baseUpperLower Int
0x1d3f9 Char
c
  | Bool
otherwise            = Char
c

-- | Convert the given character to a mathematical symbol without serifs, in
-- /bold/, and in /italics/ wrapped in a 'Just'. If the character
-- is not in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@, 'Nothing' is returned.
greekSansSerifBoldItalic
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
greekSansSerifBoldItalic :: Char -> Maybe Char
greekSansSerifBoldItalic = (Char -> Bool) -> (Char -> Char) -> Char -> Maybe Char
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isGreek Char -> Char
greekSansSerifBoldItalic'

-- | Convert the given character to a mathematical symbol without serifs, in /bold/
-- and in a /italics/ type. This maps characters an equivalent sans-serif symbol
-- for the characters in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@.
-- For characters outside the range, the behavior is unspecified.
greekSansSerifBold'
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, in bold and depending on the given 'ItalicType' in italics or not.
greekSansSerifBold' :: ItalicType -> Char -> Char
greekSansSerifBold' = (Char -> Char) -> (Char -> Char) -> ItalicType -> Char -> Char
forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Char
greekSansSerifBoldNoItalic' Char -> Char
greekSansSerifBoldItalic'

-- | Convert the given character to a mathematical symbol without serifs, in /bold/
-- with the given /italics/ type wrapped in a 'Just'. If the character
-- is not in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@, 'Nothing' is returned.
greekSansSerifBold
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
greekSansSerifBold :: ItalicType -> Char -> Maybe Char
greekSansSerifBold = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> ItalicType -> Char -> Maybe Char
forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Maybe Char
greekSansSerifBoldNoItalic Char -> Maybe Char
greekSansSerifBoldItalic

-- | Convert the given character to a mathematical symbol without serifs, not in /bold/
-- and in a /italics/ type. This maps characters an equivalent sans-serif symbol
-- for the characters in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@.
-- For characters outside the range, the behavior is unspecified.
greekSansSerifNoBold'
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, not in bold and depending on the given 'ItalicType' in italics or not.
greekSansSerifNoBold' :: ItalicType -> Char -> Char
greekSansSerifNoBold' = (Char -> Char) -> (Char -> Char) -> ItalicType -> Char -> Char
forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Char
greekSansSerifNoBoldNoItalic' Char -> Char
greekSansSerifNoBoldItalic'

-- | Convert the given character to a mathematical symbol without serifs, with no /bold/
-- and in the given /italics/ type wrapped in a 'Just'. If the character
-- is not in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@, 'Nothing' is returned.
greekSansSerifNoBold
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
greekSansSerifNoBold :: ItalicType -> Char -> Maybe Char
greekSansSerifNoBold = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> ItalicType -> Char -> Maybe Char
forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Maybe Char
greekSansSerifNoBoldNoItalic Char -> Maybe Char
greekSansSerifNoBoldItalic

-- | Convert the given character to a mathematical symbol without serifs, with a
-- given /emphasis/ and in italics. This maps characters an equivalent sans-serif symbol
-- for the characters in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@.
-- For characters outside the range, the behavior is unspecified.
greekSansSerifItalic'
  :: Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, depending on the given 'Emphasis' in bold or not, and in italics.
greekSansSerifItalic' :: Emphasis -> Char -> Char
greekSansSerifItalic' = (Char -> Char) -> (Char -> Char) -> Emphasis -> Char -> Char
forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Char
greekSansSerifNoBoldItalic' Char -> Char
greekSansSerifBoldItalic'

-- | Convert the given character to a mathematical symbol without serifs, in the
-- given /emphasis/ and in /italics/ wrapped in a 'Just'. If the character
-- is not in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@, 'Nothing' is returned.
greekSansSerifItalic
  :: Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
greekSansSerifItalic :: Emphasis -> Char -> Maybe Char
greekSansSerifItalic = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> Emphasis -> Char -> Maybe Char
forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Maybe Char
greekSansSerifNoBoldItalic Char -> Maybe Char
greekSansSerifBoldItalic

-- | Convert the given character to a mathematical symbol without serifs, with a
-- given /emphasis/ and not in italics. This maps characters an equivalent sans-serif symbol
-- for the characters in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@.
-- For characters outside the range, the behavior is unspecified.
greekSansSerifNoItalic'
  :: Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, depending on the given 'Emphasis' in bold or not, and not in italics.
greekSansSerifNoItalic' :: Emphasis -> Char -> Char
greekSansSerifNoItalic' = (Char -> Char) -> (Char -> Char) -> Emphasis -> Char -> Char
forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Char
greekSansSerifNoBoldNoItalic' Char -> Char
greekSansSerifBoldNoItalic'

-- | Convert the given character to a mathematical symbol without serifs, in the
-- given /emphasis/ and not in /italics/ wrapped in a 'Just'. If the character
-- is not in @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@, 'Nothing' is returned.
greekSansSerifNoItalic
  :: Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
greekSansSerifNoItalic :: Emphasis -> Char -> Maybe Char
greekSansSerifNoItalic = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> Emphasis -> Char -> Maybe Char
forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Maybe Char
greekSansSerifNoBoldNoItalic Char -> Maybe Char
greekSansSerifBoldNoItalic