git.iko.soy/typeable/pandoc
on master help sign in
Odt reader: remove dead code

The ODT reader contained a lot of general code useful for working with arrows. However, many of these utils weren't used and are hence removed.

commitf955af58e6a668179ec678c13d2c5a6c0c3d7b63 authorAlbert Krewinkel <albert@zeitkraut.de> dateWed 31 May 2017, 19:59 (9 years ago) parent774075c
7 files changed+4−902
compare with master
unifiedsplit
src/Text/Pandoc/Readers/Odt/Arrows/State.hs−90 src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs+4−268 src/Text/Pandoc/Readers/Odt/ContentReader.hs−5 src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs−129 src/Text/Pandoc/Readers/Odt/Generic/Utils.hs−7 src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs−320 src/Text/Pandoc/Readers/Odt/StyleReader.hs−83
src/Text/Pandoc/Readers/Odt/Arrows/State.hs−90
@@ -58,10 +58,6 @@ newtype ArrowState state a b = ArrowState
5858withState :: (state -> a -> (state, b)) -> ArrowState state a b
5959withState = ArrowState . uncurry
6060
61−-- | Constructor
62−withState' :: ((state, a) -> (state, b)) -> ArrowState state a b
63−withState' = ArrowState
64−
6561-- | Constructor
6662modifyState :: (state -> state ) -> ArrowState state a a
6763modifyState = ArrowState . first
@@ -78,10 +74,6 @@ fromState = ArrowState . (.fst)
7874extractFromState :: (state -> b ) -> ArrowState state x b
7975extractFromState f = ArrowState $ \(state,_) -> (state, f state)
8076
81−-- | Constructor
82−withUnchangedState :: (state -> a -> b ) -> ArrowState state a b
83−withUnchangedState f = ArrowState $ \(state,a) -> (state, f state a)
84−
8577-- | Constructor
8678tryModifyState :: (state -> Either f state)
8779 -> ArrowState state a (Either f a)
@@ -107,43 +99,9 @@ instance ArrowChoice (ArrowState state) where
10799 Left l -> (s, Left l)
108100 Right r -> second Right $ runArrowState a (s,r)
109101
110−instance ArrowLoop (ArrowState state) where
111− loop a = ArrowState $ \(s, x)
112− -> let (s', (x', _d)) = runArrowState a (s, (x, _d))
113− in (s', x')
114−
115102instance ArrowApply (ArrowState state) where
116103 app = ArrowState $ \(s, (f,b)) -> runArrowState f (s,b)
117104
118−
119−-- | Embedding of a state arrow in a state arrow with a different state type.
120−switchState :: (s -> s') -> (s' -> s) -> ArrowState s' x y -> ArrowState s x y
121−switchState there back a = ArrowState $ first there
122− >>> runArrowState a
123− >>> first back
124−
125−-- | Lift a state arrow to modify the state of an arrow
126−-- with a different state type.
127−liftToState :: (s -> s') -> ArrowState s' s s -> ArrowState s x x
128−liftToState unlift a = modifyState $ unlift &&& id
129− >>> runArrowState a
130− >>> snd
131−
132−-- | Switches the type of the state temporarily.
133−-- Drops the intermediate result state, behaving like the identity arrow,
134−-- save for side effects in the state.
135−withSubState :: ArrowState s x s2 -> ArrowState s2 s s -> ArrowState s x x
136−withSubState unlift a = keepingTheValue (withSubState unlift a) >>^ fst
137−
138−-- | Switches the type of the state temporarily.
139−-- Returns the resulting sub-state.
140−withSubState' :: ArrowState s x s' -> ArrowState s' s s -> ArrowState s x s'
141−withSubState' unlift a = ArrowState $ runArrowState unlift
142− >>> switch
143− >>> runArrowState a
144− >>> switch
145− where switch (x,y) = (y,x)
146−
147105-- | Switches the type of the state temporarily.
148106-- Drops the intermediate result state, behaving like a fallible
149107-- identity arrow, save for side effects in the state.
@@ -175,42 +133,6 @@ foldS :: (Foldable f, Monoid m) => ArrowState s x m -> ArrowState s (f x) m
175133foldS a = ArrowState $ \(s,f) -> foldr a' (s,mempty) f
176134 where a' x (s',m) = second (m <>) $ runArrowState a (s',x)
177135
178−-- | Fold a state arrow through something 'Foldable'. Collect the results
179−-- in a 'Monoid'.
180−-- Intermediate form of a fold between one with "only" a 'Monoid'
181−-- and one with any function.
182−foldSL :: (Foldable f, Monoid m) => ArrowState s x m -> ArrowState s (f x) m
183−foldSL a = ArrowState $ \(s,f) -> foldl a' (s,mempty) f
184− where a' (s',m) x = second (m <>) $ runArrowState a (s',x)
185−
186−-- | Fold a fallible state arrow through something 'Foldable'. Collect the
187−-- results in a 'Monoid'.
188−-- Intermediate form of a fold between one with "only" a 'Monoid'
189−-- and one with any function.
190−-- If the iteration fails, the state will be reset to the initial one.
191−foldS' :: (Foldable f, Monoid m)
192− => ArrowState s x (Either e m)
193− -> ArrowState s (f x) (Either e m)
194−foldS' a = ArrowState $ \(s,f) -> foldr (a' s) (s,Right mempty) f
195− where a' s x (s',Right m) = case runArrowState a (s',x) of
196− (s'',Right m') -> (s'', Right (m <> m'))
197− (_ ,Left e ) -> (s , Left e)
198− a' _ _ e = e
199−
200−-- | Fold a fallible state arrow through something 'Foldable'. Collect the
201−-- results in a 'Monoid'.
202−-- Intermediate form of a fold between one with "only" a 'Monoid'
203−-- and one with any function.
204−-- If the iteration fails, the state will be reset to the initial one.
205−foldSL' :: (Foldable f, Monoid m)
206− => ArrowState s x (Either e m)
207− -> ArrowState s (f x) (Either e m)
208−foldSL' a = ArrowState $ \(s,f) -> foldl (a' s) (s,Right mempty) f
209− where a' s (s',Right m) x = case runArrowState a (s',x) of
210− (s'',Right m') -> (s'', Right (m <> m'))
211− (_ ,Left e ) -> (s , Left e)
212− a' _ e _ = e
213−
214136-- | Fold a state arrow through something 'Foldable'. Collect the results in a
215137-- 'MonadPlus'.
216138iterateS :: (Foldable f, MonadPlus m)
@@ -239,15 +161,3 @@ iterateS' a = ArrowState $ \(s,f) -> foldr (a' s) (s,Right mzero) f
239161 (s'',Right m') -> (s'',Right $ mplus m $ return m')
240162 (_ ,Left e ) -> (s ,Left e )
241163 a' _ _ e = e
242−
243−-- | Fold a fallible state arrow through something 'Foldable'.
244−-- Collect the results in a 'MonadPlus'.
245−-- If the iteration fails, the state will be reset to the initial one.
246−iterateSL' :: (Foldable f, MonadPlus m)
247− => ArrowState s x (Either e y )
248− -> ArrowState s (f x) (Either e (m y))
249−iterateSL' a = ArrowState $ \(s,f) -> foldl (a' s) (s,Right mzero) f
250− where a' s (s',Right m) x = case runArrowState a (s',x) of
251− (s'',Right m') -> (s'',Right $ mplus m $ return m')
252− (_ ,Left e ) -> (s ,Left e )
253− a' _ e _ = e
src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs+4−268
@@ -40,10 +40,7 @@ with an equivalent return value.
4040module Text.Pandoc.Readers.Odt.Arrows.Utils where
4141
4242import Control.Arrow
43−import Control.Monad ( join, MonadPlus(..) )
44−
45−import qualified Data.Foldable as F
46−import Data.Monoid
43+import Control.Monad ( join )
4744
4845import Text.Pandoc.Readers.Odt.Generic.Fallible
4946import Text.Pandoc.Readers.Odt.Generic.Utils
@@ -63,12 +60,6 @@ and5 :: (Arrow a)
6360and6 :: (Arrow a)
6461 => a b c0->a b c1->a b c2->a b c3->a b c4->a b c5
6562 -> a b (c0,c1,c2,c3,c4,c5 )
66−and7 :: (Arrow a)
67− => a b c0->a b c1->a b c2->a b c3->a b c4->a b c5->a b c6
68− -> a b (c0,c1,c2,c3,c4,c5,c6 )
69−and8 :: (Arrow a)
70− => a b c0->a b c1->a b c2->a b c3->a b c4->a b c5->a b c6->a b c7
71− -> a b (c0,c1,c2,c3,c4,c5,c6,c7)
7263
7364and3 a b c = (and2 a b ) &&& c
7465 >>^ \((z,y ) , x) -> (z,y,x )
@@ -78,10 +69,6 @@ and5 a b c d e = (and4 a b c d ) &&& e
7869 >>^ \((z,y,x,w ) , v) -> (z,y,x,w,v )
7970and6 a b c d e f = (and5 a b c d e ) &&& f
8071 >>^ \((z,y,x,w,v ) , u) -> (z,y,x,w,v,u )
81−and7 a b c d e f g = (and6 a b c d e f ) &&& g
82− >>^ \((z,y,x,w,v,u ) , t) -> (z,y,x,w,v,u,t )
83−and8 a b c d e f g h = (and7 a b c d e f g) &&& h
84− >>^ \((z,y,x,w,v,u,t) , s) -> (z,y,x,w,v,u,t,s)
8572
8673liftA2 :: (Arrow a) => (x -> y -> z) -> a b x -> a b y -> a b z
8774liftA2 f a b = a &&& b >>^ uncurry f
@@ -98,19 +85,11 @@ liftA5 :: (Arrow a) => (z->y->x->w->v -> r)
9885liftA6 :: (Arrow a) => (z->y->x->w->v->u -> r)
9986 -> a b z->a b y->a b x->a b w->a b v->a b u
10087 -> a b r
101−liftA7 :: (Arrow a) => (z->y->x->w->v->u->t -> r)
102− -> a b z->a b y->a b x->a b w->a b v->a b u->a b t
103− -> a b r
104−liftA8 :: (Arrow a) => (z->y->x->w->v->u->t->s -> r)
105− -> a b z->a b y->a b x->a b w->a b v->a b u->a b t->a b s
106− -> a b r
10788
10889liftA3 fun a b c = and3 a b c >>^ uncurry3 fun
10990liftA4 fun a b c d = and4 a b c d >>^ uncurry4 fun
11091liftA5 fun a b c d e = and5 a b c d e >>^ uncurry5 fun
11192liftA6 fun a b c d e f = and6 a b c d e f >>^ uncurry6 fun
112−liftA7 fun a b c d e f g = and7 a b c d e f g >>^ uncurry7 fun
113−liftA8 fun a b c d e f g h = and8 a b c d e f g h >>^ uncurry8 fun
11493
11594liftA :: (Arrow a) => (y -> z) -> a b y -> a b z
11695liftA fun a = a >>^ fun
@@ -124,28 +103,12 @@ liftA fun a = a >>^ fun
124103duplicate :: (Arrow a) => a b (b,b)
125104duplicate = arr $ join (,)
126105
127−-- | Lifts the combination of two values into an arrow.
128−joinOn :: (Arrow a) => (x -> y -> z) -> a (x,y) z
129−joinOn = arr.uncurry
130−
131106-- | Applies a function to the uncurried result-pair of an arrow-application.
132107-- (The %-symbol was chosen to evoke an association with pairs.)
133108(>>%) :: (Arrow a) => a x (b,c) -> (b -> c -> d) -> a x d
134109a >>% f = a >>^ uncurry f
135110
136−-- | '(>>%)' with its arguments flipped
137−(%<<) :: (Arrow a) => (b -> c -> d) -> a x (b,c) -> a x d
138−(%<<) = flip (>>%)
139−
140−-- | Precomposition with an uncurried function
141−(%>>) :: (Arrow a) => (b -> c -> d) -> a d r -> a (b,c) r
142−f %>> a = uncurry f ^>> a
143−
144−-- | Precomposition with an uncurried function (right to left variant)
145−(<<%) :: (Arrow a) => a d r -> (b -> c -> d) -> a (b,c) r
146−(<<%) = flip (%>>)
147−
148−infixr 2 >>%, %<<, %>>, <<%
111+infixr 2 >>%
149112
150113
151114-- | Duplicate a value and apply an arrow to the second instance.
@@ -156,56 +119,6 @@ infixr 2 >>%, %<<, %>>, <<%
156119keepingTheValue :: (Arrow a) => a b c -> a b (b,c)
157120keepingTheValue a = returnA &&& a
158121
159−-- | Duplicate a value and apply an arrow to the first instance.
160−-- Aequivalent to
161−-- > \a -> duplicate >>> first a
162−-- or
163−-- > \a -> a &&& returnA
164−keepingTheValue' :: (Arrow a) => a b c -> a b (c,b)
165−keepingTheValue' a = a &&& returnA
166−
167−-- | 'bind' from the "Maybe"-Monad lifted into an 'ArrowChoice'.
168−-- Actually, it's the more complex '(>=>)', because 'bind' alone does not
169−-- combine as nicely in arrow form.
170−-- The current implementation is not the most efficient one, because it can
171−-- not return directly if a 'Nothing' is encountered. That in turn follows
172−-- from the type system, as 'Nothing' has an "invisible" type parameter that
173−-- can not be dropped early.
174−--
175−-- Also, there probably is a way to generalize this to other monads
176−-- or applicatives, but I'm leaving that as an exercise to the reader.
177−-- I have a feeling there is a new Arrow-typeclass to be found that is less
178−-- restrictive than 'ArrowApply'. If it is already out there,
179−-- I have not seen it yet. ('ArrowPlus' for example is not general enough.)
180−(>>>=) :: (ArrowChoice a) => a x (Maybe b) -> a b (Maybe c) -> a x (Maybe c)
181−a1 >>>= a2 = a1 >>> maybeToChoice >>> right a2 >>> choiceToMaybe >>^ join
182−
183−infixr 2 >>>=
184−
185−-- | 'mplus' Lifted into an arrow. No 'ArrowPlus' required.
186−-- (But still different from a true bind)
187−(>++<) :: (Arrow a, MonadPlus m) => a x (m b) -> a x (m b) -> a x (m b)
188−(>++<) = liftA2 mplus
189−
190−-- | Left-compose with a pure function
191−leftLift :: (ArrowChoice a) => (l -> l') -> a (Either l r) (Either l' r)
192−leftLift = left.arr
193−
194−-- | Right-compose with a pure function
195−rightLift :: (ArrowChoice a) => (r -> r') -> a (Either l r) (Either l r')
196−rightLift = right.arr
197−
198−
199−( ^+++ ) :: (ArrowChoice a) => (b -> c) -> a b' c' -> a (Either b b') (Either c c')
200−( +++^ ) :: (ArrowChoice a) => a b c -> (b' -> c') -> a (Either b b') (Either c c')
201−( ^+++^ ) :: (ArrowChoice a) => (b -> c) -> (b' -> c') -> a (Either b b') (Either c c')
202−
203−l ^+++ r = leftLift l >>> right r
204−l +++^ r = left l >>> rightLift r
205−l ^+++^ r = leftLift l >>> rightLift r
206−
207−infixr 2 ^+++, +++^, ^+++^
208−
209122( ^||| ) :: (ArrowChoice a) => (b -> d) -> a c d -> a (Either b c) d
210123( |||^ ) :: (ArrowChoice a) => a b d -> (c -> d) -> a (Either b c) d
211124( ^|||^ ) :: (ArrowChoice a) => (b -> d) -> (c -> d) -> a (Either b c) d
@@ -218,33 +131,12 @@ infixr 2 ^||| , |||^, ^|||^
218131
219132( ^&&& ) :: (Arrow a) => (b -> c) -> a b c' -> a b (c,c')
220133( &&&^ ) :: (Arrow a) => a b c -> (b -> c') -> a b (c,c')
221−( ^&&&^ ) :: (Arrow a) => (b -> c) -> (b -> c') -> a b (c,c')
222134
223135l ^&&& r = arr l &&& r
224136l &&&^ r = l &&& arr r
225−l ^&&&^ r = arr l &&& arr r
226−
227−infixr 3 ^&&&, &&&^, ^&&&^
228137
229−( ^*** ) :: (Arrow a) => (b -> c) -> a b' c' -> a (b,b') (c,c')
230−( ***^ ) :: (Arrow a) => a b c -> (b' -> c') -> a (b,b') (c,c')
231−( ^***^ ) :: (Arrow a) => (b -> c) -> (b' -> c') -> a (b,b') (c,c')
138+infixr 3 ^&&&, &&&^
232139
233−l ^*** r = arr l *** r
234−l ***^ r = l *** arr r
235−l ^***^ r = arr l *** arr r
236−
237−infixr 3 ^***, ***^, ^***^
238−
239−-- | A version of
240−--
241−-- >>> \p -> arr (\x -> if p x the Right x else Left x)
242−--
243−-- but with p being an arrow
244−choose :: (ArrowChoice a) => a b Bool -> a b (Either b b)
245−choose checkValue = keepingTheValue checkValue >>^ select
246− where select (x,True ) = Right x
247− select (x,False ) = Left x
248140
249141-- | Converts @Right a@ into @Just a@ and @Left _@ into @Nothing@.
250142choiceToMaybe :: (ArrowChoice a) => a (Either l r) (Maybe r)
@@ -258,130 +150,15 @@ maybeToChoice = arr maybeToEither
258150returnV :: (Arrow a) => c -> a x c
259151returnV = arr.const
260152
261−-- | 'returnA' dropping everything
262−returnA_ :: (Arrow a) => a _b ()
263−returnA_ = returnV ()
264−
265−-- | Wrapper for an arrow that can be evaluated im parallel. All
266−-- Arrows can be evaluated in parallel, as long as they return a
267−-- monoid.
268−newtype ParallelArrow a b c = CoEval { evalParallelArrow :: a b c }
269− deriving (Eq, Ord, Show)
270−
271−instance (Arrow a, Monoid m) => Monoid (ParallelArrow a b m) where
272− mempty = CoEval $ returnV mempty
273− (CoEval a) `mappend` (CoEval ~b) = CoEval $ a &&& b >>% mappend
274−
275−-- | Evaluates a collection of arrows in a parallel fashion.
276−--
277−-- This is in essence a fold of '(&&&)' over the collection,
278−-- so the actual execution order and parallelity depends on the
279−-- implementation of '(&&&)' in the arrow in question.
280−-- The default implementation of '(&&&)' for example keeps the
281−-- order as given in the collection.
282−--
283−-- This function can be seen as a generalization of
284−-- 'Control.Applicative.sequenceA' to arrows or as an alternative to
285−-- a fold with 'Control.Applicative.WrappedArrow', which
286−-- substitutes the monoid with function application.
287−--
288−coEval :: (Arrow a, F.Foldable f, Monoid m) => f (a b m) -> a b m
289−coEval = evalParallelArrow . (F.foldMap CoEval)
290−
291153-- | Defines Left as failure, Right as success
292154type FallibleArrow a input failure success = a input (Either failure success)
293155
294−type ReFallibleArrow a failure success success'
295− = FallibleArrow a (Either failure success) failure success'
296−
297−-- | Wrapper for fallible arrows. Fallible arrows are all arrows that return
298−-- an Either value where left is a faliure and right is a success value.
299−newtype AlternativeArrow a input failure success
300− = TryArrow { evalAlternativeArrow :: FallibleArrow a input failure success }
301−
302−
303−instance (ArrowChoice a, Monoid failure)
304− => Monoid (AlternativeArrow a input failure success) where
305− mempty = TryArrow $ returnV $ Left mempty
306− (TryArrow a) `mappend` (TryArrow b)
307− = TryArrow $ a &&& b
308− >>^ \(a',~b')
309− -> ( (\a'' -> left (mappend a'') b') ||| Right )
310− a'
311−
312−-- | Evaluates a collection of fallible arrows, trying each one in succession.
313−-- Left values are interpreted as failures, right values as successes.
314−--
315−-- The evaluation is stopped once an arrow succeeds.
316−-- Up to that point, all failures are collected in the failure-monoid.
317−-- Note that '()' is a monoid, and thus can serve as a failure-collector if
318−-- you are uninterested in the exact failures.
319−--
320−-- This is in essence a fold of '(&&&)' over the collection, enhanced with a
321−-- little bit of repackaging, so the actual execution order depends on the
322−-- implementation of '(&&&)' in the arrow in question.
323−-- The default implementation of '(&&&)' for example keeps the
324−-- order as given in the collection.
325−--
326−tryArrows :: (ArrowChoice a, F.Foldable f, Monoid failure)
327− => f (FallibleArrow a b failure success)
328− -> FallibleArrow a b failure success
329−tryArrows = evalAlternativeArrow . (F.foldMap TryArrow)
330−
331−--
332−liftSuccess :: (ArrowChoice a)
333− => (success -> success')
334− -> ReFallibleArrow a failure success success'
335−liftSuccess = rightLift
336−
337156--
338157liftAsSuccess :: (ArrowChoice a)
339158 => a x success
340159 -> FallibleArrow a x failure success
341160liftAsSuccess a = a >>^ Right
342161
343−--
344−asFallibleArrow :: (ArrowChoice a)
345− => a x success
346− -> FallibleArrow a x failure success
347−asFallibleArrow a = a >>^ Right
348−
349−-- | Raises an error into a 'ReFallibleArrow' if the arrow is already in
350−-- "error mode"
351−liftError :: (ArrowChoice a, Monoid failure)
352− => failure
353− -> ReFallibleArrow a failure success success
354−liftError e = leftLift (e <>)
355−
356−-- | Raises an error into a 'FallibleArrow', droping both the arrow input
357−-- and any previously stored error value.
358−_raiseA :: (ArrowChoice a)
359− => failure
360− -> FallibleArrow a x failure success
361−_raiseA e = returnV (Left e)
362−
363−-- | Raises an empty error into a 'FallibleArrow', droping both the arrow input
364−-- and any previously stored error value.
365−_raiseAEmpty :: (ArrowChoice a, Monoid failure)
366− => FallibleArrow a x failure success
367−_raiseAEmpty = _raiseA mempty
368−
369−-- | Raises an error into a 'ReFallibleArrow', possibly appending the new error
370−-- to an existing one
371−raiseA :: (ArrowChoice a, Monoid failure)
372− => failure
373− -> ReFallibleArrow a failure success success
374−raiseA e = arr $ Left.(either (<> e) (const e))
375−
376−-- | Raises an empty error into a 'ReFallibleArrow'. If there already is an
377−-- error, nothing changes.
378−-- (Note that this function is only aequivalent to @raiseA mempty@ iff the
379−-- failure monoid follows the monoid laws.)
380−raiseAEmpty :: (ArrowChoice a, Monoid failure)
381− => ReFallibleArrow a failure success success
382−raiseAEmpty = arr (fromRight (const mempty) >>> Left)
383−
384−
385162-- | Execute the second arrow if the first succeeds
386163(>>?) :: (ArrowChoice a)
387164 => FallibleArrow a x failure success
@@ -410,20 +187,6 @@ a >>?^? b = a >>> Left ^|||^ b
410187 -> FallibleArrow a x failure success'
411188a ^>>? b = a ^>> Left ^||| b
412189
413−-- | Execute the lifted second arrow if the lifted first arrow succeeds
414−(^>>?^) :: (ArrowChoice a)
415− => (x -> Either failure success)
416− -> (success -> success')
417− -> FallibleArrow a x failure success'
418−a ^>>?^ f = arr $ a >>> right f
419−
420−-- | Execute the lifted second arrow if the lifted first arrow succeeds
421−(^>>?^?) :: (ArrowChoice a)
422− => (x -> Either failure success)
423− -> (success -> Either failure success')
424− -> FallibleArrow a x failure success'
425−a ^>>?^? f = a ^>> Left ^|||^ f
426−
427190-- | Execute the second, non-fallible arrow if the first arrow succeeds
428191(>>?!) :: (ArrowChoice a)
429192 => FallibleArrow a x failure success
@@ -453,33 +216,9 @@ a ^>>?% f = arr a >>?^ (uncurry f)
453216a >>?%? f = a >>?^? (uncurry f)
454217
455218infixr 1 >>?, >>?^, >>?^?
456−infixr 1 ^>>?, ^>>?^, ^>>?^?, >>?!
219+infixr 1 ^>>?, >>?!
457220infixr 1 >>?%, ^>>?%, >>?%?
458221
459−-- | Keep values that are Right, replace Left values by a constant.
460−ifFailedUse :: (ArrowChoice a) => v -> a (Either f v) v
461−ifFailedUse v = arr $ either (const v) id
462−
463−-- | '(&&)' lifted into an arrow
464−(<&&>) :: (Arrow a) => a x Bool -> a x Bool -> a x Bool
465−(<&&>) = liftA2 (&&)
466−
467−-- | '(||)' lifted into an arrow
468−(<||>) :: (Arrow a) => a x Bool -> a x Bool -> a x Bool
469−(<||>) = liftA2 (||)
470−
471−-- | An equivalent of '(&&)' in a fallible arrow
472−(>&&<) :: (ArrowChoice a, Monoid f) => FallibleArrow a x f s
473− -> FallibleArrow a x f s'
474− -> FallibleArrow a x f (s,s')
475−(>&&<) = liftA2 chooseMin
476−
477−-- | An equivalent of '(||)' in some forms of fallible arrows
478−(>||<) :: (ArrowChoice a, Monoid f, Monoid s) => FallibleArrow a x f s
479− -> FallibleArrow a x f s
480− -> FallibleArrow a x f s
481−(>||<) = liftA2 chooseMax
482−
483222-- | An arrow version of a short-circuit (<|>)
484223ifFailedDo :: (ArrowChoice a)
485224 => FallibleArrow a x f y
@@ -489,7 +228,4 @@ ifFailedDo a b = keepingTheValue a >>> repackage ^>> (b |||^ Right)
489228 where repackage (x , Left _) = Left x
490229 repackage (_ , Right y) = Right y
491230
492−infixr 4 <&&>, <||>, >&&<, >||<
493231infixr 1 `ifFailedDo`
494−
495−
src/Text/Pandoc/Readers/Odt/ContentReader.hs−5
@@ -94,8 +94,6 @@ data ReaderState
9494 , envMedia :: Media
9595 -- | Hold binary resources used in the document
9696 , odtMediaBag :: MediaBag
97−-- , sequences
98−-- , trackedChangeIDs
9997 }
10098 deriving ( Show )
10199
@@ -899,9 +897,6 @@ read_reference_ref = matchingElement NsText "reference-ref"
899897-- Entry point
900898----------------------
901899
902−--read_plain_content :: OdtReaderSafe _x Inlines
903−--read_plain_content = strContent >>^ text
904−
905900read_text :: OdtReaderSafe _x Pandoc
906901read_text = matchChildContent' [ read_header
907902 , read_paragraph
src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs−129
@@ -39,10 +39,6 @@ compatible instances of "ArrowChoice".
3939-- We export everything
4040module Text.Pandoc.Readers.Odt.Generic.Fallible where
4141
42−import Control.Applicative
43−import Control.Monad
44−
45−import qualified Data.Foldable as F
4642import Data.Monoid ((<>))
4743
4844-- | Default for now. Will probably become a class at some point.
@@ -51,16 +47,6 @@ type Failure = ()
5147type Fallible a = Either Failure a
5248
5349
54−-- | False -> Left (), True -> Right ()
55−boolToEither :: Bool -> Fallible ()
56−boolToEither False = Left ()
57−boolToEither True = Right ()
58−
59−-- | False -> Left (), True -> Right ()
60−boolToChoice :: Bool -> Fallible ()
61−boolToChoice False = Left ()
62−boolToChoice True = Right ()
63−
6450--
6551maybeToEither :: Maybe a -> Fallible a
6652maybeToEither (Just a) = Right a
@@ -71,21 +57,11 @@ eitherToMaybe :: Either _l a -> Maybe a
7157eitherToMaybe (Left _) = Nothing
7258eitherToMaybe (Right a) = Just a
7359
74−-- | > untagEither === either id id
75−untagEither :: Either a a -> a
76−untagEither (Left a) = a
77−untagEither (Right a) = a
78−
7960-- | > fromLeft f === either f id
8061fromLeft :: (a -> b) -> Either a b -> b
8162fromLeft f (Left a) = f a
8263fromLeft _ (Right b) = b
8364
84−-- | > fromRight f === either id f
85−fromRight :: (a -> b) -> Either b a -> b
86−fromRight _ (Left b) = b
87−fromRight f (Right a) = f a
88−
8965-- | > recover a === fromLeft (const a) === either (const a) id
9066recover :: a -> Either _f a -> a
9167recover a (Left _) = a
@@ -110,24 +86,6 @@ collapseEither (Left f ) = Left f
11086collapseEither (Right (Left f)) = Left f
11187collapseEither (Right (Right x)) = Right x
11288
113−-- | If either of the values represents an error, the result is a
114−-- (possibly combined) error. If both values represent a success,
115−-- both are returned.
116−chooseMin :: (Monoid a) => Either a b -> Either a b' -> Either a (b,b')
117−chooseMin = chooseMinWith (,)
118−
119−-- | If either of the values represents an error, the result is a
120−-- (possibly combined) error. If both values represent a success,
121−-- a combination is returned.
122−chooseMinWith :: (Monoid a) => (b -> b' -> c)
123− -> Either a b
124− -> Either a b'
125− -> Either a c
126−chooseMinWith (><) (Right a) (Right b) = Right $ a >< b
127−chooseMinWith _ (Left a) (Left b) = Left $ a <> b
128−chooseMinWith _ (Left a) _ = Left a
129−chooseMinWith _ _ (Left b) = Left b
130−
13189-- | If either of the values represents a non-error, the result is a
13290-- (possibly combined) non-error. If both values represent an error, an error
13391-- is returned.
@@ -152,87 +110,11 @@ chooseMaxWith _ _ (Right b) = Right b
152110class ChoiceVector v where
153111 spreadChoice :: v (Either f a) -> Either f (v a)
154112
155−-- Let's do a few examples first
156−
157−instance ChoiceVector Maybe where
158− spreadChoice (Just (Left f)) = Left f
159− spreadChoice (Just (Right x)) = Right (Just x)
160− spreadChoice Nothing = Right Nothing
161−
162−instance ChoiceVector (Either l) where
163− spreadChoice (Right (Left f)) = Left f
164− spreadChoice (Right (Right x)) = Right (Right x)
165− spreadChoice (Left x ) = Right (Left x)
166−
167113instance ChoiceVector ((,) a) where
168114 spreadChoice (_, Left f) = Left f
169115 spreadChoice (x, Right y) = Right (x,y)
170116 -- Wasn't there a newtype somewhere with the elements flipped?
171117
172−--
173−-- More instances later, first some discussion.
174−--
175−-- I'll have to freshen up on type system details to see how (or if) to do
176−-- something like
177−--
178−-- > instance (ChoiceVector a, ChoiceVector b) => ChoiceVector (a b) where
179−-- > :
180−--
181−-- But maybe it would be even better to use something like
182−--
183−-- > class ChoiceVector v v' f | v -> v' f where
184−-- > spreadChoice :: v -> Either f v'
185−--
186−-- That way, more places in @v@ could spread the cheer, e.g.:
187−--
188−-- As before:
189−-- -- ( a , Either f b) (a , b) f
190−-- > instance ChoiceVector ((,) a (Either f b)) ((,) a b) f where
191−-- > spreadChoice (_, Left f) = Left f
192−-- > spreadChoice (a, Right b) = Right (a,b)
193−--
194−-- But also:
195−-- -- ( Either f a , b) (a , b) f
196−-- > instance ChoiceVector ((,) (Either f a) b) ((,) a b) f where
197−-- > spreadChoice (Right a,b) = Right (a,b)
198−-- > spreadChoice (Left f,_) = Left f
199−--
200−-- And maybe even:
201−-- -- ( Either f a , Either f b) (a , b) f
202−-- > instance ChoiceVector ((,) (Either f a) (Either f b)) ((,) a b) f where
203−-- > spreadChoice (Right a , Right b) = Right (a,b)
204−-- > spreadChoice (Left f , _ ) = Left f
205−-- > spreadChoice ( _ , Left f) = Left f
206−--
207−-- Of course that would lead to a lot of overlapping instances...
208−-- But I can't think of a different way. A selector function might help,
209−-- but not even a "Data.Traversable" is powerful enough for that.
210−-- But maybe someone has already solved all this with a lens library.
211−--
212−-- Well, it's an interesting academic question. But for practical purposes,
213−-- I have more than enough right now.
214−
215−instance ChoiceVector ((,,) a b) where
216− spreadChoice (_,_, Left f) = Left f
217− spreadChoice (a,b, Right x) = Right (a,b,x)
218−
219−instance ChoiceVector ((,,,) a b c) where
220− spreadChoice (_,_,_, Left f) = Left f
221− spreadChoice (a,b,c, Right x) = Right (a,b,c,x)
222−
223−instance ChoiceVector ((,,,,) a b c d) where
224− spreadChoice (_,_,_,_, Left f) = Left f
225− spreadChoice (a,b,c,d, Right x) = Right (a,b,c,d,x)
226−
227−instance ChoiceVector (Const a) where
228− spreadChoice (Const c) = Right (Const c) -- need to repackage because of implicit types
229−
230−-- | Fails on the first error
231−instance ChoiceVector [] where
232− spreadChoice = sequence -- using the monad instance of Either.
233− -- Could be generalized to "Data.Traversable" - but why play
234− -- with UndecidableInstances unless this is really needed.
235−
236118-- | Wrapper for a list. While the normal list instance of 'ChoiceVector'
237119-- fails whenever it can, this type will never fail.
238120newtype SuccessList a = SuccessList { collectNonFailing :: [a] }
@@ -247,14 +129,3 @@ instance ChoiceVector SuccessList where
247129collectRights :: [Either _l r] -> [r]
248130collectRights = collectNonFailing . untag . spreadChoice . SuccessList
249131 where untag = fromLeft (error "Unexpected Left")
250−
251−-- | A version of 'collectRights' generalized to other containers. The
252−-- container must be both "reducible" and "buildable". Most general containers
253−-- should fullfill these requirements, but there is no single typeclass
254−-- (that I know of) for that.
255−-- Therefore, they are split between 'Foldable' and 'MonadPlus'.
256−-- (Note that 'Data.Traversable.Traversable' alone would not be enough, either.)
257−collectRightsF :: (F.Foldable c, MonadPlus c) => c (Either _l r) -> c r
258−collectRightsF = F.foldr unTagRight mzero
259− where unTagRight (Right x) = mplus $ return x
260− unTagRight _ = id
src/Text/Pandoc/Readers/Odt/Generic/Utils.hs−7
@@ -38,8 +38,6 @@ module Text.Pandoc.Readers.Odt.Generic.Utils
3838, uncurry4
3939, uncurry5
4040, uncurry6
41−, uncurry7
42−, uncurry8
4341, swap
4442, reverseComposition
4543, bool
@@ -148,15 +146,11 @@ uncurry3 :: (a->b->c -> z) -> (a,b,c ) -> z
148146uncurry4 :: (a->b->c->d -> z) -> (a,b,c,d ) -> z
149147uncurry5 :: (a->b->c->d->e -> z) -> (a,b,c,d,e ) -> z
150148uncurry6 :: (a->b->c->d->e->f -> z) -> (a,b,c,d,e,f ) -> z
151−uncurry7 :: (a->b->c->d->e->f->g -> z) -> (a,b,c,d,e,f,g ) -> z
152−uncurry8 :: (a->b->c->d->e->f->g->h -> z) -> (a,b,c,d,e,f,g,h) -> z
153149
154150uncurry3 fun (a,b,c ) = fun a b c
155151uncurry4 fun (a,b,c,d ) = fun a b c d
156152uncurry5 fun (a,b,c,d,e ) = fun a b c d e
157153uncurry6 fun (a,b,c,d,e,f ) = fun a b c d e f
158−uncurry7 fun (a,b,c,d,e,f,g ) = fun a b c d e f g
159−uncurry8 fun (a,b,c,d,e,f,g,h) = fun a b c d e f g h
160154
161155swap :: (a,b) -> (b,a)
162156swap (a,b) = (b,a)
@@ -168,4 +162,3 @@ findBy :: (a -> Maybe b) -> [a] -> Maybe b
168162findBy _ [] = Nothing
169163findBy f ((f -> Just x):_ ) = Just x
170164findBy f ( _:xs) = findBy f xs
171−
src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs−320
@@ -41,50 +41,17 @@ module Text.Pandoc.Readers.Odt.Generic.XMLConverter
4141, XMLConverterState
4242, XMLConverter
4343, FallibleXMLConverter
44−, swapPosition
45−, runConverter
46−, runConverter''
4744, runConverter'
48−, runConverterF'
49−, runConverterF
50−, getCurrentElement
5145, getExtraState
5246, setExtraState
5347, modifyExtraState
54−, convertingExtraState
5548, producingExtraState
56−, lookupNSiri
57−, lookupNSprefix
58−, readNSattributes
59−, elemName
60−, elemNameIs
61−, strContent
62−, elContent
63−, currentElem
64−, currentElemIs
65−, expectElement
66−, elChildren
67−, findChildren
68−, filterChildren
69−, filterChildrenName
7049, findChild'
71−, findChild
72−, filterChild'
73−, filterChild
74−, filterChildName'
75−, filterChildName
76−, isSet
7750, isSet'
7851, isSetWithDefault
79−, hasAttrValueOf'
80−, failIfNotAttrValueOf
81−, isThatTheAttrValue
82−, searchAttrIn
83−, searchAttrWith
8452, searchAttr
8553, lookupAttr
8654, lookupAttr'
87−, lookupAttrWithDefault
8855, lookupDefaultingAttr
8956, findAttr'
9057, findAttr
@@ -93,25 +60,9 @@ module Text.Pandoc.Readers.Odt.Generic.XMLConverter
9360, readAttr'
9461, readAttrWithDefault
9562, getAttr
96−-- , (>/<)
97−-- , (?>/<)
9863, executeIn
99−, collectEvery
10064, withEveryL
101−, withEvery
10265, tryAll
103−, tryAll'
104−, IdXMLConverter
105−, MaybeEConverter
106−, ElementMatchConverter
107−, MaybeCConverter
108−, ContentMatchConverter
109−, makeMatcherE
110−, makeMatcherC
111−, prepareMatchersE
112−, prepareMatchersC
113−, matchChildren
114−, matchContent''
11566, matchContent'
11667, matchContent
11768) where
@@ -121,7 +72,6 @@ import Control.Monad ( MonadPlus )
12172import Control.Arrow
12273
12374import qualified Data.Map as M
124−import qualified Data.Foldable as F
12575import Data.Default
12676import Data.Maybe
12777
@@ -208,17 +158,6 @@ currentElement :: XMLConverterState nsID extraState
208158 -> XML.Element
209159currentElement state = head (parentElements state)
210160
211−-- | Replace the current position by another, modifying the extra state
212−-- in the process
213−swapPosition :: (extraState -> extraState')
214− -> [XML.Element]
215− -> XMLConverterState nsID extraState
216− -> XMLConverterState nsID extraState'
217−swapPosition f stack state
218− = state { parentElements = stack
219− , moreState = f (moreState state)
220− }
221−
222161-- | Replace the current position by another, modifying the extra state
223162-- in the process
224163swapStack' :: XMLConverterState nsID extraState
@@ -264,14 +203,6 @@ runConverter :: XMLConverter nsID extraState input output
264203 -> output
265204runConverter converter state input = snd $ runArrowState converter (state,input)
266205
267−--
268−runConverter'' :: (NameSpaceID nsID)
269− => XMLConverter nsID extraState (Fallible ()) output
270− -> extraState
271− -> XML.Element
272− -> output
273−runConverter'' converter extraState element = runConverter (readNSattributes >>> converter) (createStartState element extraState) ()
274−
275206runConverter' :: (NameSpaceID nsID)
276207 => FallibleXMLConverter nsID extraState () success
277208 -> extraState
@@ -279,20 +210,6 @@ runConverter' :: (NameSpaceID nsID)
279210 -> Fallible success
280211runConverter' converter extraState element = runConverter (readNSattributes >>? converter) (createStartState element extraState) ()
281212
282−--
283−runConverterF' :: FallibleXMLConverter nsID extraState x y
284− -> XMLConverterState nsID extraState
285− -> Fallible x -> Fallible y
286−runConverterF' a s e = runConverter (returnV e >>? a) s e
287−
288−--
289−runConverterF :: (NameSpaceID nsID)
290− => FallibleXMLConverter nsID extraState XML.Element x
291− -> extraState
292− -> Fallible XML.Element -> Fallible x
293−runConverterF a s = either failWith
294− (\e -> runConverter a (createStartState e s) e)
295−
296213--
297214getCurrentElement :: XMLConverter nsID extraState x XML.Element
298215getCurrentElement = extractFromState currentElement
@@ -429,58 +346,16 @@ elemNameIs nsID name = keepingTheValue (lookupNSiri nsID) >>% hasThatName
429346-- General content
430347--------------------------------------------------------------------------------
431348
432−--
433−strContent :: XMLConverter nsID extraState x String
434−strContent = getCurrentElement
435− >>^ XML.strContent
436−
437349--
438350elContent :: XMLConverter nsID extraState x [XML.Content]
439351elContent = getCurrentElement
440352 >>^ XML.elContent
441353
442−--------------------------------------------------------------------------------
443−-- Current element
444−--------------------------------------------------------------------------------
445−
446−--
447−currentElem :: XMLConverter nsID extraState x (XML.QName)
448−currentElem = getCurrentElement
449− >>^ XML.elName
450−
451−currentElemIs :: (NameSpaceID nsID)
452− => nsID -> ElementName
453− -> XMLConverter nsID extraState x Bool
454−currentElemIs nsID name = getCurrentElement
455− >>> elemNameIs nsID name
456−
457−
458−
459−{-
460−currentElemIs'' nsID name = ( (getCurrentElement >>^ XML.elName >>>
461− (XML.qName >>^ (&&).(== name) )
462− ^&&&^
463− (XML.qIRI >>^ (==) )
464− ) >>% (.)
465− ) &&& lookupNSiri nsID >>% ($)
466−-}
467−
468−--
469−expectElement :: (NameSpaceID nsID)
470− => nsID -> ElementName
471− -> FallibleXMLConverter nsID extraState x ()
472−expectElement nsID name = currentElemIs nsID name
473− >>^ boolToChoice
474−
475354--------------------------------------------------------------------------------
476355-- Chilren
477356--------------------------------------------------------------------------------
478357
479358--
480−elChildren :: XMLConverter nsID extraState x [XML.Element]
481−elChildren = getCurrentElement
482− >>^ XML.elChildren
483−
484359--
485360findChildren :: (NameSpaceID nsID)
486361 => nsID -> ElementName
@@ -489,18 +364,6 @@ findChildren nsID name = elemName nsID name
489364 &&& getCurrentElement
490365 >>% XML.findChildren
491366
492−--
493−filterChildren :: (XML.Element -> Bool)
494− -> XMLConverter nsID extraState x [XML.Element]
495−filterChildren p = getCurrentElement
496− >>^ XML.filterChildren p
497−
498−--
499−filterChildrenName :: (XML.QName -> Bool)
500− -> XMLConverter nsID extraState x [XML.Element]
501−filterChildrenName p = getCurrentElement
502− >>^ XML.filterChildrenName p
503−
504367--
505368findChild' :: (NameSpaceID nsID)
506369 => nsID
@@ -517,44 +380,11 @@ findChild :: (NameSpaceID nsID)
517380findChild nsID name = findChild' nsID name
518381 >>> maybeToChoice
519382
520−--
521−filterChild' :: (XML.Element -> Bool)
522− -> XMLConverter nsID extraState x (Maybe XML.Element)
523−filterChild' p = getCurrentElement
524− >>^ XML.filterChild p
525−
526−--
527−filterChild :: (XML.Element -> Bool)
528− -> FallibleXMLConverter nsID extraState x XML.Element
529−filterChild p = filterChild' p
530− >>> maybeToChoice
531−
532−--
533−filterChildName' :: (XML.QName -> Bool)
534− -> XMLConverter nsID extraState x (Maybe XML.Element)
535−filterChildName' p = getCurrentElement
536− >>^ XML.filterChildName p
537−
538−--
539−filterChildName :: (XML.QName -> Bool)
540− -> FallibleXMLConverter nsID extraState x XML.Element
541−filterChildName p = filterChildName' p
542− >>> maybeToChoice
543−
544383
545384--------------------------------------------------------------------------------
546385-- Attributes
547386--------------------------------------------------------------------------------
548387
549−--
550−isSet :: (NameSpaceID nsID)
551− => nsID -> AttributeName
552− -> (Either Failure Bool)
553− -> FallibleXMLConverter nsID extraState x Bool
554−isSet nsID attrName deflt
555− = findAttr' nsID attrName
556− >>^ maybe deflt stringToBool
557−
558388--
559389isSet' :: (NameSpaceID nsID)
560390 => nsID -> AttributeName
@@ -570,34 +400,6 @@ isSetWithDefault nsID attrName def'
570400 = isSet' nsID attrName
571401 >>^ fromMaybe def'
572402
573−--
574−hasAttrValueOf' :: (NameSpaceID nsID)
575− => nsID -> AttributeName
576− -> AttributeValue
577− -> XMLConverter nsID extraState x Bool
578−hasAttrValueOf' nsID attrName attrValue
579− = findAttr nsID attrName
580− >>> ( const False ^|||^ (==attrValue))
581−
582−--
583−failIfNotAttrValueOf :: (NameSpaceID nsID)
584− => nsID -> AttributeName
585− -> AttributeValue
586− -> FallibleXMLConverter nsID extraState x ()
587−failIfNotAttrValueOf nsID attrName attrValue
588− = hasAttrValueOf' nsID attrName attrValue
589− >>^ boolToChoice
590−
591−-- | Is the value that is currently transported in the arrow the value of
592−-- the specified attribute?
593−isThatTheAttrValue :: (NameSpaceID nsID)
594− => nsID -> AttributeName
595− -> FallibleXMLConverter nsID extraState AttributeValue Bool
596−isThatTheAttrValue nsID attrName
597− = keepingTheValue
598− (findAttr nsID attrName)
599− >>% right.(==)
600−
601403-- | Lookup value in a dictionary, fail if no attribute found or value
602404-- not in dictionary
603405searchAttrIn :: (NameSpaceID nsID)
@@ -608,18 +410,6 @@ searchAttrIn nsID attrName dict
608410 = findAttr nsID attrName
609411 >>?^? maybeToChoice.(`lookup` dict )
610412
611−
612−-- | Lookup value in a dictionary. Fail if no attribute found. If value not in
613−-- dictionary, return default value
614−searchAttrWith :: (NameSpaceID nsID)
615− => nsID -> AttributeName
616− -> a
617− -> [(AttributeValue,a)]
618− -> FallibleXMLConverter nsID extraState x a
619−searchAttrWith nsID attrName defV dict
620− = findAttr nsID attrName
621− >>?^ (fromMaybe defV).(`lookup` dict )
622−
623413-- | Lookup value in a dictionary. If attribute or value not found,
624414-- return default value
625415searchAttr :: (NameSpaceID nsID)
@@ -789,16 +579,6 @@ prepareIteration nsID name = keepingTheValue
789579 (findChildren nsID name)
790580 >>% distributeValue
791581
792−-- | Applies a converter to every child element of a specific type.
793−-- Collects results in a 'Monoid'.
794−-- Fails completely if any conversion fails.
795−collectEvery :: (NameSpaceID nsID, Monoid m)
796− => nsID -> ElementName
797− -> FallibleXMLConverter nsID extraState a m
798− -> FallibleXMLConverter nsID extraState a m
799−collectEvery nsID name a = prepareIteration nsID name
800− >>> foldS' (switchingTheStack a)
801−
802582--
803583withEveryL :: (NameSpaceID nsID)
804584 => nsID -> ElementName
@@ -826,16 +606,6 @@ tryAll nsID name a = prepareIteration nsID name
826606 >>> iterateS (switchingTheStack a)
827607 >>^ collectRights
828608
829−-- | Applies a converter to every child element of a specific type.
830−-- Collects all successful results.
831−tryAll' :: (NameSpaceID nsID, F.Foldable c, MonadPlus c)
832− => nsID -> ElementName
833− -> FallibleXMLConverter nsID extraState b a
834− -> XMLConverter nsID extraState b (c a)
835−tryAll' nsID name a = prepareIteration nsID name
836− >>> iterateS (switchingTheStack a)
837− >>^ collectRightsF
838−
839609--------------------------------------------------------------------------------
840610-- Matching children
841611--------------------------------------------------------------------------------
@@ -843,15 +613,6 @@ tryAll' nsID name a = prepareIteration nsID name
843613type IdXMLConverter nsID moreState x
844614 = XMLConverter nsID moreState x x
845615
846−type MaybeEConverter nsID moreState x
847− = Maybe (IdXMLConverter nsID moreState (x, XML.Element))
848−
849−-- Chainable converter that helps deciding which converter to actually use.
850−type ElementMatchConverter nsID extraState x
851− = IdXMLConverter nsID
852− extraState
853− (MaybeEConverter nsID extraState x, XML.Element)
854−
855616type MaybeCConverter nsID moreState x
856617 = Maybe (IdXMLConverter nsID moreState (x, XML.Content))
857618
@@ -861,26 +622,6 @@ type ContentMatchConverter nsID extraState x
861622 extraState
862623 (MaybeCConverter nsID extraState x, XML.Content)
863624
864−-- Helper function: The @c@ is actually a converter that is to be selected by
865−-- matching XML elements to the first two parameters.
866−-- The fold used to match elements however is very simple, so to use it,
867−-- this function wraps the converter in another converter that unifies
868−-- the accumulator. Think of a lot of converters with the resulting type
869−-- chained together. The accumulator not only transports the element
870−-- unchanged to the next matcher, it also does the actual selecting by
871−-- combining the intermediate results with '(<|>)'.
872−makeMatcherE :: (NameSpaceID nsID)
873− => nsID -> ElementName
874− -> FallibleXMLConverter nsID extraState a a
875− -> ElementMatchConverter nsID extraState a
876−makeMatcherE nsID name c = ( second (
877− elemNameIs nsID name
878− >>^ bool Nothing (Just tryC)
879− )
880− >>% (<|>)
881− ) &&&^ snd
882− where tryC = (fst ^&&& executeThere c >>% recover) &&&^ snd
883−
884625-- Helper function: The @c@ is actually a converter that is to be selected by
885626-- matching XML content to the first two parameters.
886627-- The fold used to match elements however is very simple, so to use it,
@@ -913,13 +654,6 @@ makeMatcherC nsID name c = ( second ( contentToElem
913654 XML.Elem e' -> succeedWith e'
914655 _ -> failEmpty
915656
916−-- Creates and chains a bunch of matchers
917−prepareMatchersE :: (NameSpaceID nsID)
918− => [(nsID, ElementName, FallibleXMLConverter nsID extraState x x)]
919− -> ElementMatchConverter nsID extraState x
920−--prepareMatchersE = foldSs . (map $ uncurry3 makeMatcherE)
921−prepareMatchersE = reverseComposition . (map $ uncurry3 makeMatcherE)
922−
923657-- Creates and chains a bunch of matchers
924658prepareMatchersC :: (NameSpaceID nsID)
925659 => [(nsID, ElementName, FallibleXMLConverter nsID extraState x x)]
@@ -927,52 +661,6 @@ prepareMatchersC :: (NameSpaceID nsID)
927661--prepareMatchersC = foldSs . (map $ uncurry3 makeMatcherC)
928662prepareMatchersC = reverseComposition . (map $ uncurry3 makeMatcherC)
929663
930−-- | Takes a list of element-data - converter groups and
931−-- * Finds all children of the current element
932−-- * Matches each group to each child in order (at most one group per child)
933−-- * Filters non-matched children
934−-- * Chains all found converters in child-order
935−-- * Applies the chain to the input element
936−matchChildren :: (NameSpaceID nsID)
937− => [(nsID, ElementName, FallibleXMLConverter nsID extraState a a)]
938− -> XMLConverter nsID extraState a a
939−matchChildren lookups = let matcher = prepareMatchersE lookups
940− in keepingTheValue (
941− elChildren
942− >>> map (Nothing,)
943− ^>> iterateSL matcher
944− >>^ catMaybes.map (\(m,e) -> fmap (swallowElem e) m)
945− -- >>> foldSs
946− >>> reverseComposition
947− )
948− >>> swap
949− ^>> app
950− where
951− -- let the converter swallow the element and drop the element
952− -- in the return value
953− swallowElem element converter = (,element) ^>> converter >>^ fst
954−
955−--
956−matchContent'' :: (NameSpaceID nsID)
957− => [(nsID, ElementName, FallibleXMLConverter nsID extraState a a)]
958− -> XMLConverter nsID extraState a a
959−matchContent'' lookups = let matcher = prepareMatchersC lookups
960− in keepingTheValue (
961− elContent
962− >>> map (Nothing,)
963− ^>> iterateSL matcher
964− >>^ catMaybes.map (\(m,c) -> fmap (swallowContent c) m)
965− -- >>> foldSs
966− >>> reverseComposition
967− )
968− >>> swap
969− ^>> app
970− where
971− -- let the converter swallow the content and drop the content
972− -- in the return value
973− swallowContent content converter = (,content) ^>> converter >>^ fst
974−
975−
976664-- | Takes a list of element-data - converter groups and
977665-- * Finds all content of the current element
978666-- * Matches each group to each piece of content in order
@@ -1018,14 +706,6 @@ matchContent lookups fallback
1018706-- Internals
1019707--------------------------------------------------------------------------------
1020708
1021−stringToBool :: (Monoid failure) => String -> Either failure Bool
1022−stringToBool val -- stringToBool' val >>> maybeToChoice
1023− | val `elem` trueValues = succeedWith True
1024− | val `elem` falseValues = succeedWith False
1025− | otherwise = failEmpty
1026− where trueValues = ["true" ,"on" ,"1"]
1027− falseValues = ["false","off","0"]
1028−
1029709stringToBool' :: String -> Maybe Bool
1030710stringToBool' val | val `elem` trueValues = Just True
1031711 | val `elem` falseValues = Just False
src/Text/Pandoc/Readers/Odt/StyleReader.hs−83
@@ -50,23 +50,11 @@ module Text.Pandoc.Readers.Odt.StyleReader
5050, ListLevelType (..)
5151, LengthOrPercent (..)
5252, lookupStyle
53−, getTextProperty
54−, getTextProperty'
55−, getParaProperty
56−, getListStyle
5753, getListLevelStyle
5854, getStyleFamily
59−, lookupDefaultStyle
6055, lookupDefaultStyle'
6156, lookupListStyleByName
62−, getPropertyChain
63−, textPropertyChain
64−, stylePropertyChain
65−, stylePropertyChain'
66−, getStylePropertyChain
6757, extendedStylePropertyChain
68−, extendedStylePropertyChain'
69−, liftStyles
7058, readStylesAt
7159) where
7260
@@ -83,7 +71,6 @@ import Data.Maybe
8371
8472import qualified Text.XML.Light as XML
8573
86−import Text.Pandoc.Readers.Odt.Arrows.State
8774import Text.Pandoc.Readers.Odt.Arrows.Utils
8875
8976import Text.Pandoc.Readers.Odt.Generic.Utils
@@ -623,20 +610,11 @@ chooseMostSpecificListLevelStyle ls | ls == mempty = Nothing
623610lookupStyle :: StyleName -> Styles -> Maybe Style
624611lookupStyle name Styles{..} = M.lookup name stylesByName
625612
626−--
627−lookupDefaultStyle :: StyleFamily -> Styles -> StyleProperties
628−lookupDefaultStyle family Styles{..} = fromMaybe def
629− (M.lookup family defaultStyleMap)
630−
631613--
632614lookupDefaultStyle' :: Styles -> StyleFamily -> StyleProperties
633615lookupDefaultStyle' Styles{..} family = fromMaybe def
634616 (M.lookup family defaultStyleMap)
635617
636−--
637−getListStyle :: Style -> Styles -> Maybe ListStyle
638−getListStyle Style{..} styles = listStyle >>= (`lookupListStyleByName` styles)
639−
640618--
641619lookupListStyleByName :: StyleName -> Styles -> Maybe ListStyle
642620lookupListStyleByName name Styles{..} = M.lookup name listStylesByName
@@ -681,64 +659,3 @@ extendedStylePropertyChain [style] styles = (stylePropertyChain style s
681659 ++ (maybeToList (fmap (lookupDefaultStyle' styles) (getStyleFamily style styles)))
682660extendedStylePropertyChain (style:trace) styles = (stylePropertyChain style styles)
683661 ++ (extendedStylePropertyChain trace styles)
684−-- Optimizable with Data.Sequence
685−
686−--
687−extendedStylePropertyChain' :: [Style] -> Styles -> Maybe [StyleProperties]
688−extendedStylePropertyChain' [] _ = Nothing
689−extendedStylePropertyChain' [style] styles = Just (
690− (stylePropertyChain style styles)
691− ++ (maybeToList (fmap (lookupDefaultStyle' styles) (getStyleFamily style styles)))
692− )
693−extendedStylePropertyChain' (style:trace) styles = fmap ((stylePropertyChain style styles) ++)
694− (extendedStylePropertyChain' trace styles)
695−
696−--
697−stylePropertyChain' :: Styles -> Style -> [StyleProperties]
698−stylePropertyChain' = flip stylePropertyChain
699−
700−--
701−getStylePropertyChain :: StyleName -> Styles -> [StyleProperties]
702−getStylePropertyChain name styles = maybe []
703− (`stylePropertyChain` styles)
704− (lookupStyle name styles)
705−
706−--
707−getPropertyChain :: (StyleProperties -> Maybe a) -> Style -> Styles -> [a]
708−getPropertyChain extract style styles = catMaybes
709− $ map extract
710− $ stylePropertyChain style styles
711−
712−--
713−textPropertyChain :: Style -> Styles -> [TextProperties]
714−textPropertyChain = getPropertyChain textProperties
715−
716−--
717−paraPropertyChain :: Style -> Styles -> [ParaProperties]
718−paraPropertyChain = getPropertyChain paraProperties
719−
720−--
721−getTextProperty :: (TextProperties -> a) -> Style -> Styles -> Maybe a
722−getTextProperty extract style styles = fmap extract
723− $ listToMaybe
724− $ textPropertyChain style styles
725−
726−--
727−getTextProperty' :: (TextProperties -> Maybe a) -> Style -> Styles -> Maybe a
728−getTextProperty' extract style styles = F.asum
729− $ map extract
730− $ textPropertyChain style styles
731−
732−--
733−getParaProperty :: (ParaProperties -> a) -> Style -> Styles -> Maybe a
734−getParaProperty extract style styles = fmap extract
735− $ listToMaybe
736− $ paraPropertyChain style styles
737−
738−-- | Lifts the reader into another readers' state.
739−liftStyles :: (OdtConverterState s -> OdtConverterState Styles)
740− -> (OdtConverterState Styles -> OdtConverterState s )
741− -> XMLReader s x x
742−liftStyles extract inject = switchState extract inject
743− $ convertingExtraState M.empty readAllStyles
744−