content: --------------------------------------------------------------------------------
  {-# LANGUAGE OverloadedStrings #-}
  module LoremMarkdownum.Token
      ( Stream
      , streamElements
      , mapStream
      , printStream
      , previewStream
  
      , Token (..)
      , tokenIsElement
      , tokenIsDelimiter
      , tokenEndsSentence
      , castToken
      ) where
  
  
  --------------------------------------------------------------------------------
  import           Text.Blaze.Html       (Html)
  
  
  --------------------------------------------------------------------------------
  import           LoremMarkdownum.Print
  
  
  --------------------------------------------------------------------------------
  type Stream a = [Token a]
  
  
  --------------------------------------------------------------------------------
  streamElements :: [Token a] -> [a]
  streamElements tokens = [x | Element x <- tokens]
  
  
  --------------------------------------------------------------------------------
  mapStream :: (a -> b) -> Stream a -> Stream b
  mapStream = map . fmap
  
  
  --------------------------------------------------------------------------------
  printStream :: (a -> Print ()) -> Stream a -> Print ()
  printStream printElement = go
    where
      go []                       = return ()
      go [t]                      = printToken t
      go (t : xs@(Element _ : _)) =
          printToken t >> printBrkSp >> go xs
      go (t : xs@(_ : _))         =
          printToken t >> go xs
  
      printToken (Element x) = printElement x
      printToken Comma       = printText ","
      printToken Colon       = printText ":"
      printToken Semicolon   = printText ";"
      printToken FullStop    = printText "."
      printToken Question    = printText "?"
      printToken Exclamation = printText "!"
  
  
  --------------------------------------------------------------------------------
  previewStream :: (a -> Html) -> Stream a -> Html
  previewStream previewElement = go
    where
      go []                       = mempty
      go [t]                      = printToken t
      go (t : xs@(Element _ : _)) =
          printToken t `mappend` " " `mappend` go xs
      go (t : xs@(_ : _))         =
          printToken t `mappend` go xs
  
      printToken (Element x) = previewElement x
      printToken Comma       = ","
      printToken Colon       = ":"
      printToken Semicolon   = ";"
      printToken FullStop    = "."
      printToken Question    = "?"
      printToken Exclamation = "!"
  
  
  --------------------------------------------------------------------------------
  data Token a
      = Element !a
      | Comma
      | Colon
      | Semicolon
      | FullStop
      | Question
      | Exclamation
      deriving (Eq, Ord, Show)
  
  
  --------------------------------------------------------------------------------
  instance Functor Token where
      fmap f (Element x)  = Element (f x)
      fmap _ Comma        = Comma
      fmap _ Colon        = Colon
      fmap _ Semicolon    = Semicolon
      fmap _ FullStop     = FullStop
      fmap _ Question     = Question
      fmap _ Exclamation  = Exclamation
  
  
  --------------------------------------------------------------------------------
  instance Foldable Token where
      foldr f z (Element x) = f x z
      foldr _ z _           = z
  
  
  --------------------------------------------------------------------------------
  instance Traversable Token where
      traverse f (Element x) = Element <$> f x
      traverse _ Comma       = pure Comma
      traverse _ Colon       = pure Colon
      traverse _ Semicolon   = pure Semicolon
      traverse _ FullStop    = pure FullStop
      traverse _ Question    = pure Question
      traverse _ Exclamation = pure Exclamation
  
  
  --------------------------------------------------------------------------------
  tokenIsElement :: Token a -> Bool
  tokenIsElement = not . tokenIsDelimiter
  
  
  --------------------------------------------------------------------------------
  tokenIsDelimiter :: Token a -> Bool
  tokenIsDelimiter (Element _) = False
  tokenIsDelimiter _           = True
  
  
  --------------------------------------------------------------------------------
  tokenEndsSentence :: Token a -> Bool
  tokenEndsSentence FullStop    = True
  tokenEndsSentence Question    = True
  tokenEndsSentence Exclamation = True
  tokenEndsSentence _           = False
  
  
  --------------------------------------------------------------------------------
  castToken :: Token a -> Maybe (Token b)
  castToken (Element _) = Nothing
  castToken Comma       = Just Comma
  castToken Colon       = Just Colon
  castToken Semicolon   = Just Semicolon
  castToken FullStop    = Just FullStop
  castToken Question    = Just Question
  castToken Exclamation = Just Exclamation
  