{-# LANGUAGE OverloadedStrings #-}
module Symantic.Parser.Grammar.Write where

import Data.Bool
import Data.Function (($))
import qualified Data.Functor as Pre
import Control.Monad (Monad(..))
import Data.Maybe (Maybe(..), fromMaybe, catMaybes)
import Data.String (IsString(..))
import Data.Semigroup (Semigroup(..))
import Data.Monoid (Monoid(..))
import Symantic.Base.Univariant
import Symantic.Parser.Grammar.Combinators
import Symantic.Parser.Grammar.Observations
import Text.Show (Show(..))
import qualified Data.List as List
import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.Maybe as MT
import qualified Control.Monad.Trans.Reader as MT
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB

import Symantic.Base.Fixity

-- * Type 'GramWrite'
newtype GramWrite a = GramWrite { unGramWrite :: GramWriteInh -> Maybe TLB.Builder }

instance IsString (GramWrite a) where
  fromString s = GramWrite $ \_inh ->
    if List.null s then Nothing
    else Just (fromString s)

-- ** Type 'GramWriteInh'
data GramWriteInh
 =   GramWriteInh
 {   gramWriteInh_indent :: TLB.Builder
 ,   gramWriteInh_op :: (Infix, Side)
 ,   gramWriteInh_pair :: Pair
 }

emptyGramWriteInh :: GramWriteInh
emptyGramWriteInh = GramWriteInh
 { gramWriteInh_indent = "\n"
 , gramWriteInh_op = (infixN0, SideL)
 , gramWriteInh_pair = pairParen
 }

gramWrite :: GramWrite a -> TL.Text
gramWrite (GramWrite r) = TLB.toLazyText $ fromMaybe "" $ r emptyGramWriteInh

pairGramWriteInh ::
 Semigroup s => IsString s =>
 GramWriteInh -> Infix -> Maybe s -> Maybe s
pairGramWriteInh inh op s =
  if isPairNeeded (gramWriteInh_op inh) op
  then Just (fromString o<>" ")<>s<>Just (" "<>fromString c)
  else s
  where (o,c) = gramWriteInh_pair inh

instance Sharable GramWrite where
  def refName x = GramWrite $ \inh ->
    pairGramWriteInh inh op $
      Just "def "
      <> Just (fromString (show refName))
      <> unGramWrite x inh
    where
    op = infixN 9
  ref refRec refName = GramWrite $ \inh ->
    pairGramWriteInh inh op $
      Just "ref " <>
      (if refRec then Just "rec " else Nothing) <>
      Just (fromString (show refName))
    where
    op = infixN 9
instance Applicable GramWrite where
  pure _ = GramWrite $ return Nothing
  -- pure _ = "pure"
  GramWrite x <*> GramWrite y = GramWrite $ \inh ->
    let inh' side = inh
         { gramWriteInh_op = (op, side)
         , gramWriteInh_pair = pairParen
         } in
    case x (inh' SideL) of
     Nothing -> y (inh' SideR)
     Just xt ->
      case y (inh' SideR) of
       Nothing -> Just xt
       Just yt ->
        pairGramWriteInh inh op $
          Just $ xt <> ", " <> yt
    where
    op = infixN 1
instance Alternable GramWrite where
  empty = "empty"
  try x = GramWrite $ \inh ->
    pairGramWriteInh inh op $
      Just "try " <> unGramWrite x inh
    where
    op = infixN 9
  x <|> y = GramWrite $ \inh ->
    pairGramWriteInh inh op $
    unGramWrite x inh
     { gramWriteInh_op = (op, SideL)
     , gramWriteInh_pair = pairParen
     } <>
    Just " | " <>
    unGramWrite y inh
     { gramWriteInh_op = (op, SideR)
     , gramWriteInh_pair = pairParen
     }
    where op = infixB SideL 3
instance Charable GramWrite where
  satisfy _f = "sat"
instance Selectable GramWrite where
  branch lr l r = GramWrite $ \inh ->
    pairGramWriteInh inh op $
      Just "branch " <>
      unGramWrite lr inh <> Just " " <>
      unGramWrite l inh <> Just " " <>
      unGramWrite r inh
    where
    op = infixN 9
instance Matchable GramWrite where
  conditional _cs bs a b = GramWrite $ \inh ->
    pairGramWriteInh inh op $
      Just "conditional " <>
      Just "[" <>
      Just (mconcat (List.intersperse ", " $
      catMaybes $ (Pre.<$> bs) $ \x ->
        unGramWrite x inh{gramWriteInh_op=(infixN 0, SideL)})) <>
      Just "] " <>
      unGramWrite a inh <> Just " " <>
      unGramWrite b inh
    where
    op = infixN 9
instance Lookable GramWrite where
  look x = GramWrite $ \inh ->
    pairGramWriteInh inh op $
      Just "look " <> unGramWrite x inh
    where op = infixN 9
  negLook x = GramWrite $ \inh ->
    pairGramWriteInh inh op $
      Just "negLook " <> unGramWrite x inh
    where op = infixN 9
instance Foldable GramWrite where
  chainPre f x = GramWrite $ \inh ->
    pairGramWriteInh inh op $
      Just "chainPre " <>
      unGramWrite f inh <> Just " " <>
      unGramWrite x inh
    where op = infixN 9
  chainPost f x = GramWrite $ \inh ->
    pairGramWriteInh inh op $
      Just "chainPost " <>
      unGramWrite f inh <> Just " " <>
      unGramWrite x inh
    where op = infixN 9