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))
neSymb :: (String -> Symbol) -> String -> String -> Symbol
neSymb :: (String -> Symbol) -> String -> String -> Symbol
neSymb _ s :: 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]
++ " names must be non-empty"
neSymb sy :: String -> Symbol
sy _ s :: String
s = String -> Symbol
sy String
s
label :: String -> Symbol
label :: String -> Symbol
label = (String -> Symbol) -> String -> String -> Symbol
neSymb String -> Symbol
Label "label"
variable :: String -> Symbol
variable :: String -> Symbol
variable = (String -> Symbol) -> String -> String -> Symbol
neSymb String -> Symbol
Variable "variable"
eqSymb :: HasSymbol q => q -> Symbol
eqSymb :: q -> Symbol
eqSymb c :: q
c = q -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol q
c Stage
Equational
codeSymb :: HasSymbol q => q -> Symbol
codeSymb :: q -> Symbol
codeSymb c :: q
c = q -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol q
c Stage
Implementation
hasStageSymbol :: HasSymbol q => q -> Stage -> Bool
hasStageSymbol :: q -> Stage -> Bool
hasStageSymbol q :: q
q st :: 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
upperLeft :: Symbol -> Symbol -> Symbol
upperLeft :: Symbol -> Symbol -> Symbol
upperLeft b :: Symbol
b ul :: Symbol
ul = [Symbol] -> [Symbol] -> [Symbol] -> [Symbol] -> Symbol -> Symbol
Corners [Symbol
ul] [] [] [] Symbol
b
sub :: Symbol -> Symbol -> Symbol
sub :: Symbol -> Symbol -> Symbol
sub b :: Symbol
b lr :: Symbol
lr = [Symbol] -> [Symbol] -> [Symbol] -> [Symbol] -> Symbol -> Symbol
Corners [] [] [] [Symbol
lr] Symbol
b
subStr :: Symbol -> String -> Symbol
subStr :: Symbol -> String -> Symbol
subStr sym :: Symbol
sym substr :: String
substr = Symbol -> Symbol -> Symbol
sub Symbol
sym (Symbol -> Symbol) -> Symbol -> Symbol
forall a b. (a -> b) -> a -> b
$ String -> Symbol
Label String
substr
sup :: Symbol -> Symbol -> Symbol
sup :: Symbol -> Symbol -> Symbol
sup b :: Symbol
b ur :: Symbol
ur = [Symbol] -> [Symbol] -> [Symbol] -> [Symbol] -> Symbol -> Symbol
Corners [] [] [Symbol
ur] [] Symbol
b
hat :: Symbol -> Symbol
hat :: Symbol -> Symbol
hat = Decoration -> Symbol -> Symbol
Atop Decoration
Hat
vec :: Symbol -> Symbol
vec :: Symbol -> Symbol
vec = Decoration -> Symbol -> Symbol
Atop Decoration
Vector
prime :: Symbol -> Symbol
prime :: Symbol -> Symbol
prime = Decoration -> Symbol -> Symbol
Atop Decoration
Prime
staged :: Symbol -> Symbol -> Stage -> Symbol
staged :: Symbol -> Symbol -> Stage -> Symbol
staged eqS :: Symbol
eqS _ Equational = Symbol
eqS
staged _ impS :: Symbol
impS Implementation = Symbol
impS
autoStage :: Symbol -> (Stage -> Symbol)
autoStage :: Symbol -> Stage -> Symbol
autoStage s :: Symbol
s = Symbol -> Symbol -> Stage -> Symbol
staged Symbol
s (Symbol -> Symbol
unicodeConv Symbol
s)
unicodeConv :: Symbol -> Symbol
unicodeConv :: Symbol -> Symbol
unicodeConv (Variable st :: String
st) = String -> Symbol
Variable (String -> Symbol) -> String -> Symbol
forall a b. (a -> b) -> a -> b
$ String -> String
unicodeString String
st
unicodeConv (Label st :: String
st) = String -> Symbol
Label (String -> Symbol) -> String -> Symbol
forall a b. (a -> b) -> a -> b
$ String -> String
unicodeString String
st
unicodeConv (Atop d :: Decoration
d s :: 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 a :: [Symbol]
a b :: [Symbol]
b c :: [Symbol]
c d :: [Symbol]
d s :: 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 ss :: [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 x :: Symbol
x = Symbol
x
unicodeString :: String -> String
unicodeString :: String -> String
unicodeString = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: 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]) -> (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 ("greek":_:_:name :: [String]
name) = [String] -> String
unwords [String]
name
getName _ = String -> String
forall a. HasCallStack => String -> a
error "unicodeString not fully implemented"