-- | 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, sortBySymbol, sortBySymbolTuple, compareBySymbol) where

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

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

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

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

-- | Variable smart constructor, requires non-empty variables
variable :: String -> Symbol
variable :: [Char] -> Symbol
variable = ([Char] -> Symbol) -> [Char] -> [Char] -> Symbol
neSymb [Char] -> Symbol
Variable [Char]
"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 -> [Char] -> Symbol
subStr Symbol
sym [Char]
substr = Symbol -> Symbol -> Symbol
sub Symbol
sym (Symbol -> Symbol) -> Symbol -> Symbol
forall a b. (a -> b) -> a -> b
$ [Char] -> Symbol
Label [Char]
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 [Char]
st) = [Char] -> Symbol
Variable ([Char] -> Symbol) -> [Char] -> Symbol
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unicodeString [Char]
st
unicodeConv (Label    [Char]
st) = [Char] -> Symbol
Label    ([Char] -> Symbol) -> [Char] -> Symbol
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unicodeString [Char]
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
unicodeConv (Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
a) (Symbol -> Symbol
unicodeConv (Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
b) (Symbol -> Symbol
unicodeConv (Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
c) (Symbol -> Symbol
unicodeConv (Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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
unicodeConv (Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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 :: [Char] -> [Char]
unicodeString = (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
x -> if Char -> Bool
isLatin1 Char
x then [Char
x] else [[Char]] -> [Char]
getName ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Char -> [[Char]]
nameList Char
x)
  where
    nameList :: Char -> [[Char]]
nameList = [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
" " ([Char] -> [[Char]]) -> (Char -> [Char]) -> Char -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower ([Char] -> [Char]) -> (Char -> [Char]) -> Char -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char]
getCharacterName
    getName :: [[Char]] -> [Char]
getName ([Char]
"greek":[Char]
_:[Char]
_:[[Char]]
name) = [[Char]] -> [Char]
unwords [[Char]]
name
    getName [[Char]]
_ = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"unicodeString not fully implemented"

-----------------------
-- Useful for sorting

-- | Compare the equational 'Symbol' of two things.
compareBySymbol :: HasSymbol a => a -> a -> Ordering
compareBySymbol :: forall a. HasSymbol a => a -> a -> Ordering
compareBySymbol a
a a
b = Symbol -> Symbol -> Ordering
compsy (a -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb a
a) (a -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb a
b)

-- | Sorts a list of 'HasSymbols' by 'Symbol'.
sortBySymbol :: HasSymbol a => [a] -> [a]
sortBySymbol :: forall a. HasSymbol a => [a] -> [a]
sortBySymbol = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
forall a. HasSymbol a => a -> a -> Ordering
compareBySymbol

-- | Sorts a tuple list of 'HasSymbols' by first Symbol in the tuple.
sortBySymbolTuple :: HasSymbol a => [(a, b)] -> [(a, b)]
sortBySymbolTuple :: forall a b. HasSymbol a => [(a, b)] -> [(a, b)]
sortBySymbolTuple = ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (a -> a -> Ordering
forall a. HasSymbol a => a -> a -> Ordering
compareBySymbol (a -> a -> Ordering)
-> ((a, b) -> a) -> (a, b) -> (a, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, b) -> a
forall a b. (a, b) -> a
fst)