content: {-|
  Module      : MasterPlan.Backend.Identity
  Description : a backend that renders to a text that can be parsed
  Copyright   : (c) Rodrigo Setti, 2017
  License     : MIT
  Maintainer  : rodrigosetti@gmail.com
  Stability   : experimental
  Portability : POSIX
  -}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE UnicodeSyntax     #-}
  module MasterPlan.Backend.Identity (render) where
  
  import           Control.Monad      (when)
  import           Control.Monad.RWS  hiding (Product, Sum)
  import           Data.List          (intersperse)
  import qualified Data.List.NonEmpty as NE
  import           Data.Monoid        ((<>))
  import qualified Data.Text          as T
  import           MasterPlan.Data
  
  type RenderMonad a = RWS [ProjAttribute] T.Text [(ProjectKey, Project a)]
  
  -- |Plain text renderer
  render ∷ Project a → [ProjAttribute] -> T.Text
  render proj whitelist =
     snd $ evalRWS (renderDefinition "root" proj) whitelist []
   where
     renderDefinition key p =
       do tell $ T.pack key
          when (hasAttribute p) $ do
             tell " {\n"
             renderAttr p
             tell "}"
          case p of
            Atomic {}    -> pure ()
            Annotated {} -> pure ()
            p'           -> tell " " >> expression False p'
          tell "\n;"
          modify $ filter ((/= key) . fst)
          remainingBindings <- get
          case remainingBindings of
            []        -> pure ()
            (k, p'):_ -> renderDefinition k p'
  
     expression :: Bool -> Project a -> RenderMonad a ()
     expression parens p@(Product _ ps)  = maybeBinding p $ combinedE parens "*" ps
     expression parens p@(Sequence _ ps) = maybeBinding p $ combinedE parens "->" ps
     expression parens p@(Sum _ ps)      = maybeBinding p $ combinedE parens "+" ps
     expression _      p@Atomic {}       = maybeBinding p $ tell $ T.pack $ mkKey p
     expression _ _                      = pure ()
  
     maybeBinding :: Project a -> RenderMonad a () -> RenderMonad a ()
     maybeBinding p action
      | hasAttribute p = let key = mkKey p
                          in modify ((key, p):) >> tell (T.pack key)
      | otherwise = action
  
     mkKey :: Project a -> String
     mkKey (Annotated _)        = "?"
     mkKey (Product props _)    = maybe "?" toId $ title props
     mkKey (Sequence props _)   = maybe "?" toId $ title props
     mkKey (Sum props _)        = maybe "?" toId $ title props
     mkKey (Atomic props _ _ _) =  maybe "?" toId $ title props
  
     toId :: String -> String
     toId = mconcat . words
  
     combinedE :: Bool -> T.Text -> NE.NonEmpty (Project a) -> RenderMonad a ()
     combinedE parens op ps = let sube = expression True <$> NE.toList ps
                                  s = sequence_ $ intersperse (tell $ " " <> op <> " ") sube
                              in  if parens && length ps > 1
                                      then tell "(" >> s >> tell ")"
                                      else s
  
     hasAttribute (Annotated _) = False
     hasAttribute (Product props _) = hasProperty props
     hasAttribute (Sequence props _) = hasProperty props
     hasAttribute (Sum props _) = hasProperty props
     hasAttribute (Atomic props c t p) =  hasProperty props
                                              || c /= defaultCost
                                              || t /= defaultTrust
                                              || p  /= defaultProgress
  
     hasProperty props =  isNonEmpty (title props)
                       || isNonEmpty (description props)
                       || isNonEmpty (owner props)
                       || isNonEmpty (url props)
  
     isNonEmpty Nothing   = False
     isNonEmpty (Just "") = False
     isNonEmpty (Just _)  = True
  
     percentage n = T.pack $ show (n * 100) <> "%"
  
     renderAttr (Annotated _) = pure ()
     renderAttr (Product props _) = renderProps props
     renderAttr (Sequence props _) = renderProps props
     renderAttr (Sum props _) = renderProps props
     renderAttr (Atomic props c t p) =
       do renderProps props
          when (c /= defaultCost) $ tell $ "cost " <> T.pack (show $ getCost c) <> "\n"
          when (t /= defaultTrust) $ tell $ "trust " <> percentage (getTrust t) <> "\n"
          when (p /= defaultProgress) $ tell $ "progress " <> percentage (getProgress p) <> "\n"
  
     renderProps :: ProjectProperties -> RenderMonad a ()
     renderProps p = do let maybeRender :: T.Text -> Maybe String -> RenderMonad a ()
                            maybeRender _ Nothing   = pure ()
                            maybeRender _ (Just "") = pure ()
                            maybeRender n (Just x)  = tell $ n <> " " <> T.pack (show x) <> "\n"
                        maybeRender "title" (title p)
                        maybeRender "description" (description p)
                        maybeRender "url" (url p)
                        maybeRender "owner" (owner p)
  