Language/DTC/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 Index for a DTC.
  11 module Language.DTC.Index where
  12
  13 import Control.Applicative (Applicative(..))
  14 import Control.Monad (Monad(..), mapM, forM)
  15 import Data.Bool
  16 import Data.Char (Char)
  17 import Data.Default.Class (Default(..))
  18 import Data.Foldable (Foldable(..), concat)
  19 import Data.Function (($), (.))
  20 import Data.Functor ((<$>))
  21 import Data.Int (Int)
  22 import Data.Map.Strict (Map)
  23 import Data.Maybe (Maybe(..))
  24 import Data.Ord (Ord(..))
  25 import Data.Semigroup (Semigroup(..))
  26 import Data.Sequence (Seq)
  27 import Data.Set (Set)
  28 import Data.Text (Text)
  29 import Data.TreeSeq.Strict (Tree(..))
  30 import Prelude (Num(..))
  31 import Text.Show (Show(..))
  32 import qualified Control.Monad.Trans.State as S
  33 import qualified Data.Char as Char
  34 import qualified Data.List as List
  35 import qualified Data.Map.Strict as Map
  36 import qualified Data.Set as Set
  37 import qualified Data.Text as Text
  38
  39 import qualified Language.DTC.Document as DTC
  40 import Language.XML (XmlPos(..))
  41
  42 -- * Type 'Term'
  43 type Term = Text
  44 terms :: [Term] -> Set Term
  45 terms = Set.fromList . foldMap ((Text.strip <$>) . Text.lines)
  46
  47 -- ** Type 'Term'
  48 type Aliases = [Term]
  49
  50 aliasesByChar :: [Aliases] -> Map Char [Aliases]
  51 aliasesByChar =
  52         -- TODO: case insensitivity?
  53         foldr (\ts acc ->
  54                 Map.insertWith (<>)
  55                  (Char.toUpper $ List.head ts `Text.index` 0)
  56                  [ts] acc
  57                 ) Map.empty
  58
  59 -- * Type 'Count'
  60 type Count = Int
  61
  62 -- * Type 'Ref'
  63 data Ref
  64  =   Ref
  65  {   term    :: Term
  66  ,   count   :: Count
  67  ,   section :: XmlPos
  68  } deriving (Show)
  69
  70 -- * Type 'State'
  71 data State
  72  =   State
  73  {   state_terms   :: Map Term [Ref]
  74  ,   state_text    :: Bool
  75  ,   state_section :: XmlPos
  76  }
  77 state :: State
  78 state = State
  79  { state_terms   = Map.empty
  80  , state_text    = True
  81  , state_section = def
  82  }
  83
  84 -- * Class 'Indexify'
  85 class Indexify a where
  86         indexify :: a -> S.State State a
  87 instance Indexify (Tree k a) => Indexify [Tree k a] where
  88         indexify = mapM indexify
  89 instance Indexify a => Indexify (Tree DTC.BodyKey a) where
  90         indexify = \case
  91          Tree0 v -> Tree0 <$> indexify v
  92          TreeN k v ->
  93                 case k of
  94                  DTC.Section{..} -> do
  95                         before@State{state_section} <- S.get
  96                         S.put before{state_section = pos}
  97                         t <- TreeN <$> indexify k <*> indexify v
  98                         after <- S.get
  99                         S.put after{state_section}
 100                         return t
 101 {-
 102 instance Indexify a => Indexify [a] where
 103         indexify = mapM indexify
 104 -}
 105 instance Indexify a => Indexify (Seq a) where
 106         indexify = mapM indexify
 107 instance Indexify DTC.BodyKey where
 108         indexify = \case
 109          DTC.Section{..} ->
 110                 DTC.Section pos attrs
 111                  <$> indexify title
 112                  <*> pure aliases
 113 instance Indexify DTC.BodyValue where
 114         indexify = \case
 115          d@DTC.ToC{} -> pure d
 116          d@DTC.ToF{} -> pure d
 117          d@DTC.Index{} -> pure d
 118          DTC.Figure{..} ->
 119                 DTC.Figure pos attrs type_
 120                  <$> indexify title
 121                  <*> indexify verts
 122          DTC.Vertical v ->
 123                 DTC.Vertical <$> indexify v
 124 instance Indexify [DTC.Reference] where
 125         indexify = mapM indexify
 126 instance Indexify [DTC.Vertical] where
 127         indexify = mapM indexify
 128 instance Indexify [[DTC.Vertical]] where
 129         indexify = mapM (mapM indexify)
 130 instance Indexify DTC.Title where
 131         indexify (DTC.Title t) = DTC.Title <$> indexify t
 132 instance Indexify DTC.Vertical where
 133         indexify = \case
 134          DTC.Para{..}    -> DTC.Para    pos attrs <$> indexify horis
 135          DTC.OL{..}      -> DTC.OL      pos attrs <$> indexify items
 136          DTC.UL{..}      -> DTC.UL      pos attrs <$> indexify items
 137          DTC.RL{..}      -> DTC.RL      pos attrs <$> indexify refs
 138          DTC.Artwork{..} -> DTC.Artwork pos attrs <$> indexify art
 139          d@DTC.Comment{} -> pure d
 140 instance Indexify [DTC.Horizontal] where
 141         indexify hs =
 142                 (concat <$>) $ forM hs $ \case
 143                  d@DTC.BR     -> return [d]
 144                  DTC.B    s   -> pure . DTC.B    <$> indexify s
 145                  DTC.Code s   -> pure . DTC.Code <$> indexify s
 146                  DTC.Del  s   -> pure . DTC.Del  <$> indexify s
 147                  DTC.I    s   -> pure . DTC.I    <$> indexify s
 148                  DTC.Note s   -> pure . DTC.Note <$> indexify s
 149                  DTC.Q    s   -> pure . DTC.Q    <$> indexify s
 150                  DTC.SC   s   -> pure . DTC.SC   <$> indexify s
 151                  DTC.Sub  s   -> pure . DTC.Sub  <$> indexify s
 152                  DTC.Sup  s   -> pure . DTC.Sup  <$> indexify s
 153                  DTC.U    s   -> pure . DTC.U    <$> indexify s
 154                  DTC.Eref{..} -> pure . DTC.Eref href <$> indexify text
 155                  DTC.Iref{..} -> pure . DTC.Iref count term <$> indexify text
 156                  DTC.Ref{..}  -> pure . DTC.Ref to <$> indexify text
 157                  DTC.Rref{..} -> pure . DTC.Rref to <$> indexify text
 158                  DTC.Plain p -> List.reverse <$> go 0 p p []
 159                 where
 160                 flt c = Char.isAlphaNum c || Char.isPunctuation c
 161                 go :: Int -> Text -> Text -> [DTC.Horizontal] -> S.State State [DTC.Horizontal]
 162                 go len plain curr acc =
 163                         -- NOTE: keep the number of DTC.Plain to the minimum
 164                         -- while sharing their Text with the original.
 165                         case Text.span flt curr of
 166                          ("","") | len > 0     -> return $ DTC.Plain plain:acc
 167                                  | otherwise -> return acc
 168                          ("",r) ->
 169                                 case Text.break flt r of
 170                                  (m,n) -> go (len + Text.length m) plain n acc
 171                          (term,r) -> do
 172                                 st@State{..} <- S.get
 173                                 case Map.updateLookupWithKey
 174                                          (\_w refs ->
 175                                                 let count = case refs of [] -> 1; Ref{count=c}:_ -> c + 1 in
 176                                                 Just $ Ref{term, count, section=state_section} : refs)
 177                                          term state_terms of
 178                                  (Nothing, _) ->
 179                                         go (len + Text.length term) plain r acc
 180                                  (Just refs, m) -> do
 181                                         S.put st{state_terms=m}
 182                                         go 0 r r $
 183                                                 DTC.Iref
 184                                                  { term
 185                                                  , count = count $ List.head refs
 186                                                  , text  = [DTC.Plain term]
 187                                                  } :
 188                                                 if len > 0
 189                                                 then DTC.Plain (Text.take len plain) : acc
 190                                                 else acc
 191 instance Indexify DTC.Reference where
 192         indexify = return
 193 instance Indexify DTC.Artwork where
 194         indexify = return
 195
 196 {-
 197 countIref :: Seq XmlPos -> Int
 198 countIref s =
 199         case Seq.viewr s of
 200          _ :> XmlPos{xmlPosAncestors=(_,c):_} -> c + 1
 201          _ -> 0
 202 data Iref
 203  =   Iref
 204  {   iref_pos :: Seq.XmlPos
 205  ,   iref_
 206  }
 207  -- Map Text DTC.Horizontal
 208 -}