---------------------------------------------------------------------------------------------------
-- |
-- Module      : Dynkin
-- Description : A way to represent Dynkin Diagrams
-- Copyright   : (c) Felix Springer, 2019
-- License     : BSD3
-- Maintainer  : felixspringer149@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- This module defines data structures that implement Dynkin Diagrams as a way to represent Lie
-- Algebras.
--
---------------------------------------------------------------------------------------------------

module Lie.Dynkin ( Dynkin (..)
                  , DynkinNode (..)
                  , DynkinVertex (..)
                  , reverse
                  , variations
                  ) where

import Prelude hiding (reverse)
import Data.List (permutations , nub)

-- | A type that represents a Dynkin Diagram
data Dynkin = Dynkin DynkinNode

instance Eq Dynkin where
  (==) x y = foldl (||) False nodesEq
    where nodesEq = [ a == b | a <- variations x , b <- variations y ]

instance Show Dynkin where
  show (Dynkin x) = show x


data DynkinNode = DynkinNode [DynkinVertex]

instance Eq DynkinNode where
  (==) (DynkinNode vs) (DynkinNode ws) = vs == ws

instance Show DynkinNode where
  show (DynkinNode []         ) = "O"
  show (DynkinNode (vertex:[])) = "O" ++ show vertex
  show (DynkinNode (next:another:[])) = "O"  ++ "(" ++ show another ++ ")" ++ show next


data DynkinVertex = DynkinVertex        Int DynkinNode
                  | DynkinVertexToShort Int DynkinNode
                  | DynkinVertexToLong  Int DynkinNode

instance Eq DynkinVertex where
  (==) (DynkinVertex i n) (DynkinVertex j m) = (i == j) && (n == m)

instance Show DynkinVertex where
  show (DynkinVertex        1 node) = "---" ++ show node
  show (DynkinVertex        2 node) = "===" ++ show node
  show (DynkinVertex        3 node) = "≡≡≡" ++ show node
  show (DynkinVertexToShort 1 node) = "->-" ++ show node
  show (DynkinVertexToShort 2 node) = "=>=" ++ show node
  show (DynkinVertexToShort 3 node) = "≡>≡" ++ show node
  show (DynkinVertexToLong  1 node) = "-<-" ++ show node
  show (DynkinVertexToLong  2 node) = "=<=" ++ show node
  show (DynkinVertexToLong  3 node) = "≡<≡" ++ show node


reverse :: Dynkin -> Dynkin
reverse (Dynkin node) = Dynkin (reverseDynkinHelper node Nothing)

-- | Only reverses the first vertex in any (DynkinNode [vertex,...]).
-- Has effect of stretching Dynkin diagrams like D3 (, which is sane).
-- Has no purpose since variationsDynkin is more powerful?
reverseDynkinHelper :: DynkinNode -> Maybe DynkinVertex -> DynkinNode
reverseDynkinHelper (DynkinNode []               ) Nothing     = DynkinNode []
reverseDynkinHelper (DynkinNode []               ) (Just prev) = DynkinNode [ prev ]
reverseDynkinHelper (DynkinNode (vertex:vertices)) Nothing     =
  reverseDynkinHelper (connectedNode vertex)
                      (Just (reverseDynkinVertexSingle vertex (DynkinNode vertices)))
reverseDynkinHelper (DynkinNode (vertex:vertices)) (Just prev) =
  reverseDynkinHelper (connectedNode vertex)
                      (Just (reverseDynkinVertexSingle vertex (DynkinNode (prev : vertices))))

-- | Return a list of all (simpler, ) equivalent Dynkin Diagrams.
variations :: Dynkin -> [Dynkin]
variations (Dynkin node) = map Dynkin $ nub $ node : (variationsDynkinHelper node Nothing)

-- | Doesn't return the DynkinNode it started with (, but 'variations' does!).
-- Doesn't find ALL variations (, but seems to work for now).
variationsDynkinHelper :: DynkinNode -> Maybe DynkinVertex -> [DynkinNode]
variationsDynkinHelper (DynkinNode []      ) Nothing     = [ DynkinNode []       ]
variationsDynkinHelper (DynkinNode []      ) (Just prev) = [ DynkinNode [ prev ] ]
variationsDynkinHelper (DynkinNode vertices) mPrev       = mapOverPermutations rec vertices
  where rec :: [DynkinVertex] -> [DynkinNode]
        rec (v:vs) = variationsDynkinHelper (connectedNode v)
                                            (Just (reverseDynkinVertexSingle v (newPrev mPrev)))
          where newPrev :: Maybe DynkinVertex -> DynkinNode
                newPrev Nothing     = DynkinNode vs
                newPrev (Just prev) = DynkinNode (prev : vs)


reverseDynkinVertexSingle :: DynkinVertex -> DynkinNode -> DynkinVertex
reverseDynkinVertexSingle (DynkinVertex        n _) node = DynkinVertex        n node
reverseDynkinVertexSingle (DynkinVertexToShort n _) node = DynkinVertexToLong  n node
reverseDynkinVertexSingle (DynkinVertexToLong  n _) node = DynkinVertexToShort n node

connectedNode :: DynkinVertex -> DynkinNode
connectedNode (DynkinVertex        _ node) = node
connectedNode (DynkinVertexToShort _ node) = node
connectedNode (DynkinVertexToLong  _ node) = node

mapOverPermutations :: ([a] -> [b]) -> [a] -> [b]
mapOverPermutations f xs = foldl (++) [] $ map f (permutations xs)