]> Git — Sourcephile - doclang.git/blob - Language/DTC/Write/Index.hs
Add HTML5 rendition of DTC.Index.
[doclang.git] / 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 -}