-- | Routines to help with Symbols and Stages.
module Language.Drasil.Symbol.Helpers(eqSymb, codeSymb, hasStageSymbol,
  autoStage, hat, prime, staged, sub, subStr, sup, unicodeConv, upperLeft,
  vec, label, variable) where

import Data.Char (isLatin1, toLower)
import Data.Char.Properties.Names (getCharacterName)
import Data.List.Split (splitOn)

import Language.Drasil.Symbol (HasSymbol(symbol), Symbol(..), Decoration(..))
import Language.Drasil.Stages (Stage(Equational,Implementation))

-- | Helper for creating smart constructors for 'Symbol's.
neSymb :: (String -> Symbol) -> String -> String -> Symbol
neSymb :: (String -> Symbol) -> String -> String -> Symbol
neSymb String -> Symbol
_  String
s [] = String -> Symbol
forall a. HasCallStack => String -> a
error (String -> Symbol) -> String -> Symbol
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" names must be non-empty"
neSymb String -> Symbol
sy String
_ String
s  = String -> Symbol
sy String
s

-- | Label smart constructor, requires non-empty labels
label :: String -> Symbol
label :: String -> Symbol
label = (String -> Symbol) -> String -> String -> Symbol
neSymb String -> Symbol
Label String
"label"

-- | Variable smart constructor, requires non-empty variables
variable :: String -> Symbol
variable :: String -> Symbol
variable = (String -> Symbol) -> String -> String -> Symbol
neSymb String -> Symbol
Variable String
"variable"

-- | Helper function for getting a symbol in the Equational Stage.
eqSymb :: HasSymbol q => q -> Symbol
eqSymb :: forall q. HasSymbol q => q -> Symbol
eqSymb q
c = q -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol q
c Stage
Equational

-- | Helper function for getting a symbol in the Implementation Stage.
codeSymb :: HasSymbol q => q -> Symbol
codeSymb :: forall q. HasSymbol q => q -> Symbol
codeSymb q
c = q -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol q
c Stage
Implementation

-- | Finds if a 'Stage' symbol is real or Empty. True if real.
hasStageSymbol :: HasSymbol q => q -> Stage -> Bool
hasStageSymbol :: forall q. HasSymbol q => q -> Stage -> Bool
hasStageSymbol q
q Stage
st = q -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol q
q Stage
st Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
/= Symbol
Empty

-- | Helper for creating a symbol with a superscript on the left side of the symbol.
-- Arguments: Base symbol, then superscripted symbol.
upperLeft :: Symbol -> Symbol -> Symbol
upperLeft :: Symbol -> Symbol -> Symbol
upperLeft Symbol
b Symbol
ul = [Symbol] -> [Symbol] -> [Symbol] -> [Symbol] -> Symbol -> Symbol
Corners [Symbol
ul] [] [] [] Symbol
b

-- | Helper for creating a symbol with a subscript to the right.
-- Arguments: Base symbol, then subscripted symbol.
sub :: Symbol -> Symbol -> Symbol
sub :: Symbol -> Symbol -> Symbol
sub Symbol
b Symbol
lr = [Symbol] -> [Symbol] -> [Symbol] -> [Symbol] -> Symbol -> Symbol
Corners [] [] [] [Symbol
lr] Symbol
b

-- | Helper for a common case of subscript, with a string
-- Arguments: Base symbol, then subscript 'String'.
subStr :: Symbol -> String -> Symbol
subStr :: Symbol -> String -> Symbol
subStr Symbol
sym String
substr = Symbol -> Symbol -> Symbol
sub Symbol
sym (Symbol -> Symbol) -> Symbol -> Symbol
forall a b. (a -> b) -> a -> b
$ String -> Symbol
Label String
substr

-- | Helper for creating a symbol with a superscript to the right.
-- Arguments: Base symbol, then superscripted symbol.
sup :: Symbol -> Symbol -> Symbol
sup :: Symbol -> Symbol -> Symbol
sup Symbol
b Symbol
ur = [Symbol] -> [Symbol] -> [Symbol] -> [Symbol] -> Symbol -> Symbol
Corners [] [] [Symbol
ur] [] Symbol
b

-- | Helper for creating a symbol with a hat ("^") atop it.
hat :: Symbol -> Symbol
hat :: Symbol -> Symbol
hat = Decoration -> Symbol -> Symbol
Atop Decoration
Hat

-- | Helper for creating a Vector symbol.
vec :: Symbol -> Symbol
vec :: Symbol -> Symbol
vec = Decoration -> Symbol -> Symbol
Atop Decoration
Vector

-- | Helper for creating a Vector symbol.
prime :: Symbol -> Symbol
prime :: Symbol -> Symbol
prime = Decoration -> Symbol -> Symbol
Atop Decoration
Prime

-- | Helper for creating a symbol that depends on the stage.
staged :: Symbol -> Symbol -> Stage -> Symbol
staged :: Symbol -> Symbol -> Stage -> Symbol
staged Symbol
eqS Symbol
_ Stage
Equational = Symbol
eqS
staged Symbol
_ Symbol
impS Stage
Implementation = Symbol
impS

-- | Helper for creating a symbol with Unicode in it.
autoStage :: Symbol -> (Stage -> Symbol)
autoStage :: Symbol -> Stage -> Symbol
autoStage Symbol
s = Symbol -> Symbol -> Stage -> Symbol
staged Symbol
s (Symbol -> Symbol
unicodeConv Symbol
s)

-- | Helper for autoStage that applies unicodeString to all 'Symbol's with 'String's.
unicodeConv :: Symbol -> Symbol
unicodeConv :: Symbol -> Symbol
unicodeConv (Variable String
st) = String -> Symbol
Variable (String -> Symbol) -> String -> Symbol
forall a b. (a -> b) -> a -> b
$ String -> String
unicodeString String
st
unicodeConv (Label    String
st) = String -> Symbol
Label    (String -> Symbol) -> String -> Symbol
forall a b. (a -> b) -> a -> b
$ String -> String
unicodeString String
st
unicodeConv (Atop    Decoration
d Symbol
s) = Decoration -> Symbol -> Symbol
Atop Decoration
d   (Symbol -> Symbol) -> Symbol -> Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol
unicodeConv Symbol
s
unicodeConv (Corners [Symbol]
a [Symbol]
b [Symbol]
c [Symbol]
d Symbol
s) =
  [Symbol] -> [Symbol] -> [Symbol] -> [Symbol] -> Symbol -> Symbol
Corners ((Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> Symbol
unicodeConv [Symbol]
a) ((Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> Symbol
unicodeConv [Symbol]
b) ((Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> Symbol
unicodeConv [Symbol]
c) ((Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> Symbol
unicodeConv [Symbol]
d) (Symbol -> Symbol
unicodeConv Symbol
s)
unicodeConv (Concat [Symbol]
ss) = [Symbol] -> Symbol
Concat ([Symbol] -> Symbol) -> [Symbol] -> Symbol
forall a b. (a -> b) -> a -> b
$ (Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> Symbol
unicodeConv [Symbol]
ss
unicodeConv Symbol
x = Symbol
x

-- | Helper for 'unicodeConv' that converts each Unicode character to text equivalent.
-- If a character is Latin, it it just returned.
-- If a character is Unicode and Greek, just the name of the symbol is returned (eg. theta).
-- Otherwise, an error is thrown.
unicodeString :: String -> String
unicodeString :: String -> String
unicodeString = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
x -> if Char -> Bool
isLatin1 Char
x then [Char
x] else [String] -> String
getName ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Char -> [String]
nameList Char
x)
  where
    nameList :: Char -> [String]
nameList = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
" " (String -> [String]) -> (Char -> String) -> Char -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (Char -> String) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
getCharacterName
    getName :: [String] -> String
getName (String
"greek":String
_:String
_:[String]
name) = [String] -> String
unwords [String]
name
    getName [String]
_ = String -> String
forall a. HasCallStack => String -> a
error String
"unicodeString not fully implemented"