content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  -- | Once you defined a `StateMachineT`, you can render its topology as a
  -- directed graph using a [Mermaid](https://mermaid.js.org/#/) state diagram
  module Crem.Render.Render where
  
  import Crem.BaseMachine
  import Crem.Graph
  import Crem.Render.RenderableVertices
  import Crem.StateMachine
  import Crem.Topology
  import "base" Data.List (intersperse)
  import "base" Data.String (IsString)
  import "singletons-base" Data.Singletons (Demote, SingI, SingKind, demote)
  import "text" Data.Text (Text, null, pack)
  import Prelude hiding (null)
  
  -- | `Mermaid` is just a @newtype@ around @Text@ to specialize it to Mermaid
  -- diagrams
  newtype Mermaid = Mermaid {getText :: Text}
    deriving newtype (Eq, Show)
  
  -- | Notice that we joining two non-empty mermaid diagrams, a newline will be
  -- added
  instance Semigroup Mermaid where
    (<>) :: Mermaid -> Mermaid -> Mermaid
    (Mermaid "") <> m = m
    m <> (Mermaid "") = m
    (Mermaid t1) <> (Mermaid t2) = Mermaid (t1 <> "\n" <> t2)
  
  -- | A `MachineLabel` is just a newtype around `Text` to represents label which
  -- will be attached to every leaf of the tree defined by the constructors of
  -- `StateMachineT`
  newtype MachineLabel = MachineLabel {getLabel :: Text}
    deriving newtype (Eq, Show, IsString)
  
  -- | We can render a `Graph` as a Mermaid state diagram
  renderStateDiagram :: (RenderableVertices a, Show a) => Graph a -> Mermaid
  renderStateDiagram graph =
    Mermaid "stateDiagram-v2\n" <> renderGraph graph
  
  -- | Prepends a `MachineLabel` to the `Show` output, as a `Text`
  labelVertex :: (Show a) => MachineLabel -> a -> Text
  labelVertex label =
    let
      prefix =
        if null (getLabel label)
          then ""
          else getLabel label <> "_"
     in
      (prefix <>) . pack . show
  
  -- | Render all the vertices of a graph after labelling all of them
  renderLabelledVertices
    :: forall a
     . (Show a, RenderableVertices a)
    => MachineLabel
    -> Graph a
    -> Mermaid
  renderLabelledVertices label _ =
    Mermaid . mconcat . intersperse "\n" $ labelVertex label <$> (vertices :: [a])
  
  -- | Render all vertices with no label
  renderVertices :: forall a. (Show a, RenderableVertices a) => Graph a -> Mermaid
  renderVertices = renderLabelledVertices ""
  
  -- | Render all the edges of a graph after labelling all of them
  renderLabelledEdges :: (Show a) => MachineLabel -> Graph a -> Mermaid
  renderLabelledEdges label (Graph l) =
    Mermaid . mconcat . intersperse "\n" $
      (\(a1, a2) -> labelVertex label a1 <> " --> " <> labelVertex label a2) <$> l
  
  -- | Render all edges with no label
  renderEdges :: (Show a) => Graph a -> Mermaid
  renderEdges = renderLabelledEdges ""
  
  -- | Join the outputs of `renderLabelledVertices` and `renderLabelledEdges` to
  -- render an entire `Graph`
  renderLabelledGraph
    :: (RenderableVertices a, Show a)
    => MachineLabel
    -> Graph a
    -> Mermaid
  renderLabelledGraph label graph =
    renderLabelledVertices label graph <> renderLabelledEdges label graph
  
  -- | Render a `Graph` with no labels
  renderGraph :: (RenderableVertices a, Show a) => Graph a -> Mermaid
  renderGraph = renderLabelledGraph ""
  
  -- | Turn a `Topology` into a `Graph`
  topologyAsGraph :: Topology v -> Graph v
  topologyAsGraph (Topology edges) = Graph $ edges >>= edgify
    where
      edgify :: (v, [v]) -> [(v, v)]
      edgify (v, vs) = (v,) <$> vs
  
  baseMachineTopology
    :: forall vertex topology input output m
     . ( Demote vertex ~ vertex
       , SingKind vertex
       , SingI topology
       )
    => BaseMachineT m (topology :: Topology vertex) input output
    -> Topology vertex
  baseMachineTopology _ = demote @topology
  
  -- | Interpret a `BaseMachine` as a `Graph` using the information contained in
  -- its topology.
  --
  -- This is the point where we make usage of the machinery provided by the
  -- [singletons](https://hackage.haskell.org/package/singletons) library, which
  -- require us to impose the constraints we have on @vertex@ and @topology@
  baseMachineAsGraph
    :: forall vertex topology input output m
     . ( Demote vertex ~ vertex
       , SingKind vertex
       , SingI topology
       )
    => BaseMachineT m (topology :: Topology vertex) input output
    -> Graph vertex
  baseMachineAsGraph _ = topologyAsGraph (demote @topology)
  
  -- | Render an `UntypedGraph` to the Mermaid format
  renderUntypedStateDiagram :: UntypedGraph -> Mermaid
  renderUntypedStateDiagram (UntypedGraph graph) = renderStateDiagram graph
  
  -- | Render an `UntypedGraph`
  renderUntypedGraph :: UntypedGraph -> Mermaid
  renderUntypedGraph (UntypedGraph graph) = renderGraph graph
  
  -- | Interpret a `StateMachine` as an `UntypedGraph` using the information
  -- contained in its structure and in the topology of its basic components
  machineAsGraph :: StateMachineT m input output -> UntypedGraph
  machineAsGraph (Basic baseMachine) =
    UntypedGraph (baseMachineAsGraph baseMachine)
  machineAsGraph (Sequential machine1 machine2) =
    untypedRemoveIdentityEdges $
      untypedProductGraph
        (untypedAddIdentityEdges $ machineAsGraph machine1)
        (untypedAddIdentityEdges $ machineAsGraph machine2)
  machineAsGraph (Parallel machine1 machine2) =
    untypedRemoveIdentityEdges $
      untypedProductGraph
        (untypedAddIdentityEdges $ machineAsGraph machine1)
        (untypedAddIdentityEdges $ machineAsGraph machine2)
  machineAsGraph (Alternative machine1 machine2) =
    untypedRemoveIdentityEdges $
      untypedProductGraph
        (untypedAddIdentityEdges $ machineAsGraph machine1)
        (untypedAddIdentityEdges $ machineAsGraph machine2)
  machineAsGraph (Feedback machine1 machine2) =
    untypedRemoveIdentityEdges $
      untypedTransitiveClosureGraph $
        untypedProductGraph
          (untypedAddIdentityEdges $ machineAsGraph machine1)
          (untypedAddIdentityEdges $ machineAsGraph machine2)
  machineAsGraph (Kleisli machine1 machine2) =
    untypedRemoveIdentityEdges $
      untypedProductGraph
        (untypedAddIdentityEdges $ machineAsGraph machine1)
        (untypedAddIdentityEdges $ untypedTransitiveClosureGraph $ machineAsGraph machine2)
  