-- | Drasil uses symbols in expressions and sentences.
module Language.Drasil.Symbol (
  -- * Types
  Decoration(..), Symbol(..),
  -- * Classes
  HasSymbol(..),
  -- * Ordering Function
  compsy
) where

import Language.Drasil.Stages (Stage)
import Language.Drasil.Unicode(Special)

import Data.Char (toLower)

-- | Decorations on symbols/characters such as hats or Vector representations
-- (determines bolding, italics, etc).
data Decoration = 
    Hat       -- ^ Places a @^@ on top of a symbol.
  | Vector    -- ^ Makes a symbol bold.
  | Prime     -- ^ Appends a @'@ to a symbol.
  | Delta     -- ^ Prepends a @Δ@ to a symbol.
  | Magnitude -- ^ Places @||@ before and after a symbol.
  deriving (Decoration -> Decoration -> Bool
(Decoration -> Decoration -> Bool)
-> (Decoration -> Decoration -> Bool) -> Eq Decoration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Decoration -> Decoration -> Bool
== :: Decoration -> Decoration -> Bool
$c/= :: Decoration -> Decoration -> Bool
/= :: Decoration -> Decoration -> Bool
Eq, Eq Decoration
Eq Decoration =>
(Decoration -> Decoration -> Ordering)
-> (Decoration -> Decoration -> Bool)
-> (Decoration -> Decoration -> Bool)
-> (Decoration -> Decoration -> Bool)
-> (Decoration -> Decoration -> Bool)
-> (Decoration -> Decoration -> Decoration)
-> (Decoration -> Decoration -> Decoration)
-> Ord Decoration
Decoration -> Decoration -> Bool
Decoration -> Decoration -> Ordering
Decoration -> Decoration -> Decoration
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Decoration -> Decoration -> Ordering
compare :: Decoration -> Decoration -> Ordering
$c< :: Decoration -> Decoration -> Bool
< :: Decoration -> Decoration -> Bool
$c<= :: Decoration -> Decoration -> Bool
<= :: Decoration -> Decoration -> Bool
$c> :: Decoration -> Decoration -> Bool
> :: Decoration -> Decoration -> Bool
$c>= :: Decoration -> Decoration -> Bool
>= :: Decoration -> Decoration -> Bool
$cmax :: Decoration -> Decoration -> Decoration
max :: Decoration -> Decoration -> Decoration
$cmin :: Decoration -> Decoration -> Decoration
min :: Decoration -> Decoration -> Decoration
Ord)

-- | A 'Symbol' is actually going to be a graphical description of what gets
-- rendered as a (unique) symbol.  This is actually NOT based on semantics at
-- all, but just a description of how things look.
-- 
-- Symbols can be:
-- 
--     * @'Variable'@ (string such as "x" that represent a value that can vary) 
--     * @'Label'@ (strings such as "max" or "target" that represent a single idea)
--     * @'Special'@ characters (ex. unicode)
--     * @Decorated@ symbols using 'Atop'
--     * @Concatenations@ of symbols, including subscripts and superscripts
--     * @'Empty'@! (this is to give this a monoid-like flavour)
data Symbol =
    Variable String -- ^ Basic variable name creation.
  | Label    String 
    -- ^ For when symbols need more context, but we don't want to add a new variable name.
    -- For example, @v_f@ may be encoded as @Concat [variable "v", label "f"]@.
  | Integ    Int -- ^ For using numbers in Symbols.
  | Special  Special 
    -- ^ For now, special characters are the degree and partial
    -- differentiation symbols. These should eventually move elsewhere
    -- and the 'Special' type removed.
  | Atop     Decoration Symbol
    -- ^ Used to decorate symbols. For things like vectors (which need to be bold),
    -- primes, magnitudes, etc. See 'Decoration' for more details.
  | Corners  [Symbol] [Symbol] [Symbol] [Symbol] Symbol
    -- ^ Order of Symbols: upleft   lowleft  upright  lowright base. Ex:
    --
    -- >Corners [1]   [2]   [3]   [4]   [5]
    -- @
    --  Visually:  [1]   [3]
    --
    --                [5]
    --
    --             [2]   [4]
    -- @
  | Concat   [Symbol] -- ^ Concatentation of two symbols: @[s1, s2] -> s1s2@
  | Empty -- ^ Placeholder for when a symbol is not needed.
  deriving Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
/= :: Symbol -> Symbol -> Bool
Eq

-- TODO: Instead of having "Stage" as a parameter of "symbol", we can make it a typeclass parameter instead.. extensibility for cheap!
-- | A HasSymbol is anything which has a 'Symbol'.
class HasSymbol c where
  -- | Provides the 'Symbol' for a particular stage of generation.
  symbol  :: c -> Stage -> Symbol

-- | Symbols may be concatenated.
instance Semigroup Symbol where
 Symbol
a <> :: Symbol -> Symbol -> Symbol
<> Symbol
b = [Symbol] -> Symbol
Concat [Symbol
a , Symbol
b]

-- | Symbols can be empty or concatenated.
instance Monoid Symbol where
  mempty :: Symbol
mempty = Symbol
Empty

-- | Gives an 'Ordering' of two lists of 'Symbol's.
complsy :: [Symbol] -> [Symbol] -> Ordering
complsy :: [Symbol] -> [Symbol] -> Ordering
complsy [] [] = Ordering
EQ
complsy [] [Symbol]
_  = Ordering
LT
complsy [Symbol]
_  [] = Ordering
GT
complsy (Symbol
x : [Symbol]
xs) (Symbol
y : [Symbol]
ys) = Symbol -> Symbol -> Ordering
compsy Symbol
x Symbol
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [Symbol] -> [Symbol] -> Ordering
complsy [Symbol]
xs [Symbol]
ys

-- | The default compare function that sorts all the lower case symbols after
-- the upper case ones.
--
-- Comparation is used twice for each `Atomic` case, once for making sure they
-- are the same letter, once for case sensitive. As far as this comparison is
-- considered, `Δ` is a "decoration" and ignored unless the compared symbols are
-- the exact same, in which case it is ordered after the undecorated symbol.
--
-- Superscripts and subscripts are ordered after the base symbols (because they
-- add additional context to a symbol). For example: `v_f^{AB}` (expressed in
-- LaTeX notation for clarity), where `v_f` is a final velocity, and the `^{AB}`
-- adds context that it is the final velocity between points `A` and `B`. In
-- these cases, the sorting of `v_f^{AB}` should be following `v_f` as it is
-- logical to place it with its parent concept.
compsy :: Symbol -> Symbol -> Ordering
compsy :: Symbol -> Symbol -> Ordering
compsy (Concat [Symbol]
x) (Concat [Symbol]
y) = [Symbol] -> [Symbol] -> Ordering
complsy [Symbol]
x [Symbol]
y
compsy (Concat [Symbol]
a) Symbol
b = [Symbol] -> [Symbol] -> Ordering
complsy [Symbol]
a [Symbol
b]
compsy Symbol
b (Concat [Symbol]
a) = [Symbol] -> [Symbol] -> Ordering
complsy [Symbol
b] [Symbol]
a
compsy (Atop Decoration
d1 Symbol
a) (Atop Decoration
d2 Symbol
a') = 
  case Symbol -> Symbol -> Ordering
compsy Symbol
a Symbol
a' of
    Ordering
EQ -> Decoration -> Decoration -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Decoration
d1 Decoration
d2
    Ordering
other -> Ordering
other
compsy Symbol
a (Atop Decoration
Magnitude Symbol
b) =
  case Symbol -> Symbol -> Ordering
compsy Symbol
a Symbol
b of
    Ordering
EQ -> Ordering
LT
    Ordering
other -> Ordering
other
compsy (Atop Decoration
Magnitude Symbol
b) Symbol
a =
 case Symbol -> Symbol -> Ordering
compsy Symbol
b Symbol
a of
    Ordering
EQ -> Ordering
GT
    Ordering
other -> Ordering
other
compsy Symbol
a (Atop Decoration
Delta Symbol
b) =
  case Symbol -> Symbol -> Ordering
compsy Symbol
a Symbol
b of
    Ordering
EQ -> Ordering
LT
    Ordering
other -> Ordering
other
compsy (Atop Decoration
Delta Symbol
b) Symbol
a =
 case Symbol -> Symbol -> Ordering
compsy Symbol
b Symbol
a of
    Ordering
EQ -> Ordering
GT
    Ordering
other -> Ordering
other
-- The next two cases are very specific (but common) patterns where a superscript is added
-- to some "conceptual" base symbol to add further context. For example: `v_f^{AB}` (expressed in LaTeX
-- notation for clarity), where `v_f` is a final velocity, and the `^{AB}` adds context that it is the
-- final velocity between points `A` and `B`. In these cases, the sorting of `v_f^{AB}` should be
-- following `v_f` as it is logical to place it with its parent concept.
compsy (Corners [] [] [Symbol]
ur [] (Corners [] [] [] [Symbol]
lr Symbol
b)) Symbol
a = Symbol -> Symbol -> Ordering
compsy ([Symbol] -> [Symbol] -> [Symbol] -> [Symbol] -> Symbol -> Symbol
Corners [] [] [Symbol]
ur [Symbol]
lr Symbol
b) Symbol
a
compsy Symbol
a (Corners [] [] [Symbol]
ur [] (Corners [] [] [] [Symbol]
lr Symbol
b)) = Symbol -> Symbol -> Ordering
compsy Symbol
a ([Symbol] -> [Symbol] -> [Symbol] -> [Symbol] -> Symbol -> Symbol
Corners [] [] [Symbol]
ur [Symbol]
lr Symbol
b)
compsy (Corners [Symbol]
_ [Symbol]
_ [Symbol]
u [Symbol]
l Symbol
b) (Corners [Symbol]
_ [Symbol]
_ [Symbol]
u' [Symbol]
l' Symbol
b')  =
  case Symbol -> Symbol -> Ordering
compsy Symbol
b Symbol
b' of
    Ordering
EQ -> case [Symbol] -> [Symbol] -> Ordering
complsy [Symbol]
l [Symbol]
l' of
      Ordering
EQ -> [Symbol] -> [Symbol] -> Ordering
complsy [Symbol]
u [Symbol]
u'
      Ordering
other -> Ordering
other
    Ordering
other -> Ordering
other
compsy Symbol
a (Corners [Symbol]
_ [Symbol]
_ [Symbol]
_ [Symbol]
_ Symbol
b) =
  case Symbol -> Symbol -> Ordering
compsy Symbol
a Symbol
b of
    Ordering
EQ -> Ordering
LT
    Ordering
other -> Ordering
other
compsy (Corners [Symbol]
_ [Symbol]
_ [Symbol]
_ [Symbol]
_ Symbol
b) Symbol
a =
  case Symbol -> Symbol -> Ordering
compsy Symbol
b Symbol
a of
    Ordering
EQ -> Ordering
GT
    Ordering
other -> Ordering
other
compsy Symbol
a (Atop Decoration
_ Symbol
b) =
  case Symbol -> Symbol -> Ordering
compsy Symbol
a Symbol
b of
    Ordering
EQ -> Ordering
LT
    Ordering
other -> Ordering
other
compsy (Atop Decoration
_ Symbol
b) Symbol
a =
 case Symbol -> Symbol -> Ordering
compsy Symbol
b Symbol
a of
    Ordering
EQ -> Ordering
GT
    Ordering
other -> Ordering
other
{-
compsy a (Atop d b) =
  case d of
    Magnitude -> case compsy a b of
                  EQ -> GT
                  other -> other
    Delta -> case compsy a b of
                  EQ -> GT
                  other -> other
    _ -> case compsy a b of
                  EQ -> LT
                  other -> other
compsy (Atop d a) b =
  case d of
    Magnitude -> case compsy a b of
                  EQ -> LT
                  other -> other
    Delta -> case compsy a b of
                  EQ -> LT
                  other -> other
    _ -> case compsy a b of
                  EQ -> GT
                  other -> other-}
compsy (Special Special
a)  (Special Special
b)  = Special -> Special -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Special
a Special
b
compsy (Integ    Int
x) (Integ    Int
y) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
y
compsy (Variable [Char]
x) (Variable [Char]
y) = [Char] -> [Char] -> Ordering
compsyLower [Char]
x [Char]
y
compsy (Variable [Char]
x) (Label [Char]
y)    = [Char] -> [Char] -> Ordering
compsyLower [Char]
x [Char]
y
compsy (Label [Char]
x)    (Variable [Char]
y) = [Char] -> [Char] -> Ordering
compsyLower [Char]
x [Char]
y
compsy (Label [Char]
x)    (Label [Char]
y)    = [Char] -> [Char] -> Ordering
compsyLower [Char]
x [Char]
y
compsy (Special Special
_)  Symbol
_ = Ordering
LT
compsy Symbol
_ (Special Special
_)  = Ordering
GT
compsy (Integ Int
_) Symbol
_    = Ordering
LT
compsy Symbol
_ (Integ Int
_)    = Ordering
GT
compsy (Variable [Char]
_) Symbol
_ = Ordering
LT
compsy Symbol
_ (Variable [Char]
_) = Ordering
GT
compsy (Label [Char]
_) Symbol
_    = Ordering
LT
compsy Symbol
_ (Label [Char]
_)    = Ordering
GT
compsy Symbol
Empty Symbol
Empty    = Ordering
EQ

-- | Helper for 'compsy' that compares lower case 'String's.
compsyLower :: String -> String -> Ordering
compsyLower :: [Char] -> [Char] -> Ordering
compsyLower [Char]
x [Char]
y = case [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
x) ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
y) of
  Ordering
EQ    -> [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Char]
x [Char]
y 
  Ordering
other -> Ordering
other