{-# LANGUAGE NamedFieldPuns #-}
module Transducer (
      Transducer
    , fromList
    , run
  ) where

import Data.Map ((!), insert)
import Graph (Graph(..), Vertex(..), editVertex, follow, rewind, singleton, weave)
import Stream (Stream(..), merge)
import qualified Stream (empty)

type Transducer input output = Graph input [output]

empty :: Transducer input output
empty = singleton []

entry :: Ord input => Transducer input output -> ([input], output) -> Transducer input output
entry transducer (path, output) =
  rewind $ editVertex (weave transducer path) pushLabel
  where
    pushLabel vertex = vertex {label = output:(label vertex)}

loop :: Ord input => Transducer input output -> ([input], [input]) -> Transducer input output
loop transducer ([], loopPath) =
  case splitAt (length loopPath - 1) loopPath of
    (_, []) -> transducer
    (loopBegining, lastInput:_) ->
      let end = weave transducer loopBegining in
      rewind $
        editVertex end $ tieKnot lastInput
  where
    tieKnot input vertex =
      vertex {edges = insert input (focus transducer) $ edges vertex}
loop transducer (prefix, loopPath) = loop (weave transducer prefix) ([], loopPath)

fromList :: Ord input => [([input], Either [input] output)] -> Transducer input output
fromList = foldl add empty
  where
    add transducer (path, Left loopPath) = loop transducer (path, loopPath)
    add transducer (path, Right output) = entry transducer (path, output)

run :: (Ord input, Eq output) => Transducer input output -> Stream input -> Stream output
run transducer (Stream inputs) = foldl (\outputsStream (input, stream) ->
    case follow transducer input of
      Nothing -> Stream.empty
      Just newState@(Graph {vertices, focus}) ->
        let emitted = Stream $ emit stream <$> label (vertices ! focus) in
        emitted `merge` outputsStream `merge` run newState stream
  ) Stream.empty inputs
  where
    emit stream output = (output, run (rewind transducer) stream)