Language/DTC/Write/Index.hs

   1 {-# LANGUAGE DuplicateRecordFields #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE FlexibleContexts #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# LANGUAGE ScopedTypeVariables #-}
   7 {-# LANGUAGE TypeApplications #-}
   8 {-# LANGUAGE ViewPatterns #-}
   9 {-# OPTIONS_GHC -fno-warn-orphans #-}
  10 -- | Compute an StateIndex for a DTC.
  11 module Language.DTC.Write.Index where
  12
  13 import Control.Applicative (Applicative(..))
  14 import Control.Monad (Monad(..), mapM)
  15 import Data.Bool
  16 import Data.Char (Char)
  17 import Data.Foldable (Foldable(..))
  18 import Data.Function (($), (.))
  19 import Data.Functor ((<$>))
  20 import Data.Int (Int)
  21 import Data.Map.Strict (Map)
  22 import Data.Maybe (Maybe(..))
  23 import Data.Semigroup (Semigroup(..))
  24 import Data.Sequence (Seq)
  25 import Data.Set (Set)
  26 import Data.Text (Text)
  27 import Data.Traversable (Traversable(..))
  28 import Data.TreeSeq.Strict (Tree(..))
  29 import Prelude (Num(..))
  30 import Text.Show (Show(..))
  31 import qualified Control.Monad.Trans.State as S
  32 import qualified Data.Char as Char
  33 import qualified Data.Map.Strict as Map
  34 import qualified Data.Set as Set
  35 import qualified Data.Text as Text
  36
  37 import qualified Language.DTC.Document as DTC
  38
  39 -- * Type 'Term'
  40 type Term = Text
  41 terms :: [Term] -> Set Term
  42 terms = Set.fromList . foldMap ((Text.strip <$>) . Text.lines)
  43
  44 termsByChar :: Map Term Count -> Map Char (Map Term Count)
  45 termsByChar = Map.foldlWithKey f Map.empty
  46         where
  47         f acc t n =
  48                 Map.insertWith (<>)
  49                  (Text.index t 0)
  50                  (Map.singleton t n) acc
  51
  52 -- * Type 'Count'
  53 type Count = Int
  54
  55 -- * Type 'Ref'
  56 data Ref
  57  =   Ref
  58  {   term  :: Term
  59  ,   count :: Count
  60  } deriving (Show)
  61
  62 -- * Type 'StateIndex'
  63 data StateIndex
  64  =   StateIndex
  65  {   stateIndex_terms :: Map Term Count
  66  ,   stateIndex_text  :: Bool
  67  }
  68 stateIndex :: StateIndex
  69 stateIndex = StateIndex
  70  { stateIndex_terms = Map.empty
  71  , stateIndex_text  = True
  72  }
  73
  74 -- * Class 'Indexify'
  75 class Indexify a where
  76         indexify :: a -> S.State StateIndex a
  77 instance (Indexify k, Indexify a) => Indexify [Tree k a] where
  78         indexify = mapM indexify
  79 instance (Indexify k, Indexify a) => Indexify (Tree k a) where
  80         indexify = \case
  81          TreeN k v -> TreeN <$> indexify k <*> indexify v
  82          Tree0   v -> Tree0 <$> indexify v
  83 {-
  84 instance Indexify a => Indexify [a] where
  85         indexify = mapM indexify
  86 -}
  87 instance Indexify a => Indexify (Seq a) where
  88         indexify = mapM indexify
  89 instance Indexify DTC.BodyKey where
  90         indexify = \case
  91          DTC.Section{..} ->
  92                 DTC.Section pos attrs
  93                  <$> indexify title
  94                  <*> pure aliases
  95 instance Indexify DTC.BodyValue where
  96         indexify = \case
  97          d@DTC.ToC{} -> pure d
  98          d@DTC.ToF{} -> pure d
  99          d@DTC.Index{} -> pure d
 100          DTC.Figure{..} ->
 101                 DTC.Figure pos attrs type_
 102                  <$> indexify title
 103                  <*> indexify verts
 104          DTC.Vertical v ->
 105                 DTC.Vertical <$> indexify v
 106 instance Indexify [DTC.Reference] where
 107         indexify = mapM indexify
 108 instance Indexify [DTC.Vertical] where
 109         indexify = mapM indexify
 110 instance Indexify [[DTC.Vertical]] where
 111         indexify = mapM (mapM indexify)
 112 instance Indexify DTC.Title where
 113         indexify (DTC.Title t) = DTC.Title <$> indexify t
 114 instance Indexify DTC.Vertical where
 115         indexify = \case
 116          DTC.Para{..}    -> DTC.Para    pos attrs <$> indexify horis
 117          DTC.OL{..}      -> DTC.OL      pos attrs <$> indexify items
 118          DTC.UL{..}      -> DTC.UL      pos attrs <$> indexify items
 119          DTC.RL{..}      -> DTC.RL      pos attrs <$> indexify refs
 120          DTC.Artwork{..} -> DTC.Artwork pos attrs <$> indexify art
 121          d@DTC.Comment{} -> pure d
 122 instance Indexify [DTC.Horizontal] where
 123         indexify hs = sequence $ hs >>= \case
 124          d@DTC.BR     -> return $ return d
 125          DTC.B    s   -> return $ DTC.B    <$> indexify s
 126          DTC.Code s   -> return $ DTC.Code <$> indexify s
 127          DTC.Del  s   -> return $ DTC.Del  <$> indexify s
 128          DTC.I    s   -> return $ DTC.I    <$> indexify s
 129          DTC.Note s   -> return $ DTC.Note <$> indexify s
 130          DTC.Q    s   -> return $ DTC.Q    <$> indexify s
 131          DTC.SC   s   -> return $ DTC.SC   <$> indexify s
 132          DTC.Sub  s   -> return $ DTC.Sub  <$> indexify s
 133          DTC.Sup  s   -> return $ DTC.Sup  <$> indexify s
 134          DTC.U    s   -> return $ DTC.U    <$> indexify s
 135          DTC.Eref{..} -> return $ DTC.Eref href <$> indexify text
 136          DTC.Iref{..} -> return $ DTC.Iref count term <$> indexify text
 137          DTC.Ref{..}  -> return $ DTC.Ref to <$> indexify text
 138          DTC.Rref{..} -> return $ DTC.Rref to <$> indexify text
 139          DTC.Plain p -> go p
 140                 where
 141                 go :: Text -> [S.State StateIndex DTC.Horizontal]
 142                 go t =
 143                         case Text.span Char.isAlphaNum t of
 144                          ("","") -> []
 145                          ("",r) ->
 146                                 case Text.break Char.isAlphaNum r of
 147                                  (m,n) -> return (DTC.Plain m) : go n
 148                          (w,r) ->
 149                                 (do
 150                                         idx <- S.get
 151                                         case Map.updateLookupWithKey
 152                                                  (\_w cnt -> Just $ cnt + 1)
 153                                                  w (stateIndex_terms idx) of
 154                                          (Nothing, _) -> return $ DTC.Plain w
 155                                          (Just count, m) -> do
 156                                                 S.put idx{stateIndex_terms=m}
 157                                                 return DTC.Iref{count, term=w, text=[DTC.Plain w]}
 158                                 ) : go r
 159 instance Indexify DTC.Reference where
 160         indexify = return
 161 instance Indexify DTC.Artwork where
 162         indexify = return
 163
 164 {-
 165 countIref :: Seq XmlPos -> Int
 166 countIref s =
 167         case Seq.viewr s of
 168          _ :> XmlPos{xmlPosAncestors=(_,c):_} -> c + 1
 169          _ -> 0
 170 data Iref
 171  =   Iref
 172  {   iref_pos :: Seq.XmlPos
 173  ,   iref_
 174  }
 175  -- Map Text DTC.Horizontal
 176 -}