{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Compute an StateIndex for a DTC.
module Language.DTC.Write.Index where

import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..), mapM)
import Data.Bool
import Data.Char (Char)
import Data.Foldable (Foldable(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.Map.Strict (Map)
import Data.Maybe (Maybe(..))
import Data.Semigroup (Semigroup(..))
import Data.Sequence (Seq)
import Data.Set (Set)
import Data.Text (Text)
import Data.Traversable (Traversable(..))
import Data.TreeSeq.Strict (Tree(..))
import Prelude (Num(..))
import Text.Show (Show(..))
import qualified Control.Monad.Trans.State as S
import qualified Data.Char as Char
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as Text

import qualified Language.DTC.Document as DTC

-- * Type 'Term'
type Term = Text
terms :: [Term] -> Set Term
terms = Set.fromList . foldMap ((Text.strip <$>) . Text.lines)

termsByChar :: Map Term Count -> Map Char (Map Term Count)
termsByChar = Map.foldlWithKey f Map.empty
	where
	f acc t n =
		Map.insertWith (<>)
		 (Text.index t 0)
		 (Map.singleton t n) acc

-- * Type 'Count'
type Count = Int

-- * Type 'Ref'
data Ref
 =   Ref
 {   term  :: Term
 ,   count :: Count
 } deriving (Show)

-- * Type 'StateIndex'
data StateIndex
 =   StateIndex
 {   stateIndex_terms :: Map Term Count
 ,   stateIndex_text  :: Bool
 }
stateIndex :: StateIndex
stateIndex = StateIndex
 { stateIndex_terms = Map.empty
 , stateIndex_text  = True
 }

-- * Class 'Indexify'
class Indexify a where
	indexify :: a -> S.State StateIndex a
instance (Indexify k, Indexify a) => Indexify [Tree k a] where
	indexify = mapM indexify
instance (Indexify k, Indexify a) => Indexify (Tree k a) where
	indexify = \case
	 TreeN k v -> TreeN <$> indexify k <*> indexify v
	 Tree0   v -> Tree0 <$> indexify v
{-
instance Indexify a => Indexify [a] where
	indexify = mapM indexify
-}
instance Indexify a => Indexify (Seq a) where
	indexify = mapM indexify
instance Indexify DTC.BodyKey where
	indexify = \case
	 DTC.Section{..} ->
		DTC.Section pos attrs
		 <$> indexify title
		 <*> pure aliases
instance Indexify DTC.BodyValue where
	indexify = \case
	 d@DTC.ToC{} -> pure d
	 d@DTC.ToF{} -> pure d
	 d@DTC.Index{} -> pure d
	 DTC.Figure{..} ->
		DTC.Figure pos attrs type_
		 <$> indexify title
		 <*> indexify verts
	 DTC.Vertical v ->
		DTC.Vertical <$> indexify v
instance Indexify [DTC.Reference] where
	indexify = mapM indexify
instance Indexify [DTC.Vertical] where
	indexify = mapM indexify
instance Indexify [[DTC.Vertical]] where
	indexify = mapM (mapM indexify)
instance Indexify DTC.Title where
	indexify (DTC.Title t) = DTC.Title <$> indexify t
instance Indexify DTC.Vertical where
	indexify = \case
	 DTC.Para{..}    -> DTC.Para    pos attrs <$> indexify horis
	 DTC.OL{..}      -> DTC.OL      pos attrs <$> indexify items
	 DTC.UL{..}      -> DTC.UL      pos attrs <$> indexify items
	 DTC.RL{..}      -> DTC.RL      pos attrs <$> indexify refs
	 DTC.Artwork{..} -> DTC.Artwork pos attrs <$> indexify art
	 d@DTC.Comment{} -> pure d
instance Indexify [DTC.Horizontal] where
	indexify hs = sequence $ hs >>= \case
	 d@DTC.BR     -> return $ return d
	 DTC.B    s   -> return $ DTC.B    <$> indexify s
	 DTC.Code s   -> return $ DTC.Code <$> indexify s
	 DTC.Del  s   -> return $ DTC.Del  <$> indexify s
	 DTC.I    s   -> return $ DTC.I    <$> indexify s
	 DTC.Note s   -> return $ DTC.Note <$> indexify s
	 DTC.Q    s   -> return $ DTC.Q    <$> indexify s
	 DTC.SC   s   -> return $ DTC.SC   <$> indexify s
	 DTC.Sub  s   -> return $ DTC.Sub  <$> indexify s
	 DTC.Sup  s   -> return $ DTC.Sup  <$> indexify s
	 DTC.U    s   -> return $ DTC.U    <$> indexify s
	 DTC.Eref{..} -> return $ DTC.Eref href <$> indexify text
	 DTC.Iref{..} -> return $ DTC.Iref count term <$> indexify text
	 DTC.Ref{..}  -> return $ DTC.Ref to <$> indexify text
	 DTC.Rref{..} -> return $ DTC.Rref to <$> indexify text
	 DTC.Plain p -> go p
		where
		go :: Text -> [S.State StateIndex DTC.Horizontal]
		go t =
			case Text.span Char.isAlphaNum t of
			 ("","") -> []
			 ("",r) ->
				case Text.break Char.isAlphaNum r of
				 (m,n) -> return (DTC.Plain m) : go n
			 (w,r) ->
				(do
					idx <- S.get
					case Map.updateLookupWithKey
						 (\_w cnt -> Just $ cnt + 1)
						 w (stateIndex_terms idx) of
					 (Nothing, _) -> return $ DTC.Plain w
					 (Just count, m) -> do
						S.put idx{stateIndex_terms=m}
						return DTC.Iref{count, term=w, text=[DTC.Plain w]}
				) : go r
instance Indexify DTC.Reference where
	indexify = return
instance Indexify DTC.Artwork where
	indexify = return

{-
countIref :: Seq XmlPos -> Int
countIref s =
	case Seq.viewr s of
	 _ :> XmlPos{xmlPosAncestors=(_,c):_} -> c + 1
	 _ -> 0
data Iref
 =   Iref
 {   iref_pos :: Seq.XmlPos
 ,   iref_
 }
 -- Map Text DTC.Horizontal
-}