aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs
blob: 6c10ed61da8d4405a43a2884fdcdce33f67fc9ba (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ViewPatterns  #-}

{-
Copyright (C) 2015 Martin Linnemann <theCodingMarlin@googlemail.com>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

{- |
   Module      : Text.Pandoc.Reader.Odt.Generic.Utils
   Copyright   : Copyright (C) 2015 Martin Linnemann
   License     : GNU GPL, version 2 or above

   Maintainer  : Martin Linnemann <theCodingMarlin@googlemail.com>
   Stability   : alpha
   Portability : portable

General utility functions for the odt reader.
-}

module Text.Pandoc.Readers.Odt.Generic.Utils
( uncurry3
, uncurry4
, uncurry5
, uncurry6
, uncurry7
, uncurry8
, swap
, reverseComposition
, bool
, tryToRead
, Lookupable(..)
, readLookupables
, readLookupable
, readPercent
, findBy
, swing
, composition
) where

import           Control.Category        ( Category, (>>>), (<<<) )
import qualified Control.Category as Cat ( id )
import           Control.Monad           ( msum )

import qualified Data.Foldable    as F   ( Foldable, foldr )
import           Data.Maybe


-- | Aequivalent to
-- > foldr (.) id
-- where '(.)' are 'id' are the ones from "Control.Category"
-- and 'foldr' is the one from "Data.Foldable".
-- The noun-form was chosen to be consistend with 'sum', 'product' etc
-- based on the discussion at
-- <https://groups.google.com/forum/#!topic/haskell-cafe/VkOZM1zaHOI>
-- (that I was not part of)
composition        :: (Category cat, F.Foldable f) => f (cat a a) -> cat a a
composition        = F.foldr (<<<) Cat.id

-- | Aequivalent to
-- > foldr (flip (.)) id
-- where '(.)' are 'id' are the ones from "Control.Category"
-- and 'foldr' is the one from "Data.Foldable".
-- A reversed version of 'composition'.
reverseComposition :: (Category cat, F.Foldable f) => f (cat a a) -> cat a a
reverseComposition = F.foldr (>>>) Cat.id

-- | 'Either' has 'either', 'Maybe' has 'maybe'. 'Bool' should have 'bool'.
-- Note that the first value is selected if the boolean value is 'False'.
-- That makes 'bool' consistent with the other two. Also, 'bool' now takes its
-- arguments in the exact opposite order compared to the normal if construct.
bool :: a -> a -> Bool -> a
bool x _ False = x
bool _ x True  = x

-- | This function often makes it possible to switch values with the functions
-- that are applied to them.
--
-- Examples:
-- > swing map :: [a -> b] -> a -> [b]
-- > swing any :: [a -> Bool] -> a -> Bool
-- > swing foldr :: b -> a -> [a -> b -> b] -> b
-- > swing scanr :: c -> a -> [a -> c -> c] -> c
-- > swing zipWith :: [a -> b -> c] -> a -> [b] -> [c]
-- > swing find :: [a -> Bool] -> a -> Maybe (a -> Bool)
--
-- Stolen from <https://wiki.haskell.org/Pointfree>
swing :: (((a -> b) -> b) -> c -> d) -> c -> a -> d
swing = flip.(.flip id)
-- swing f c a = f ($ a) c


-- | Alternative to 'read'/'reads'. The former of these throws errors
-- (nobody wants that) while the latter returns "to much" for simple purposes.
-- This function instead applies 'reads' and returns the first match (if any)
-- in a 'Maybe'.
tryToRead :: (Read r) => String -> Maybe r
tryToRead = reads >>> listToMaybe >>> fmap fst

-- | A version of 'reads' that requires a '%' sign after the number
readPercent :: ReadS Int
readPercent s = [ (i,s') | (i   , r ) <- reads s
                         , ("%" , s') <- lex   r
              ]

-- | Data that can be looked up.
-- This is mostly a utility to read data with kind *.
class Lookupable a where
  lookupTable :: [(String, a)]

-- | The idea is to use this function as if there was a declaration like
--
-- > instance (Lookupable a) => (Read a) where
-- >   readsPrec _ = readLookupables
-- .
-- But including this code in this form would need UndecideableInstances.
-- That is a bad idea. Luckily 'readLookupable' (without the s at the end)
-- can be used directly in almost any case.
readLookupables :: (Lookupable a) => String -> [(a,String)]
readLookupables s = [ (a,rest) | (word,rest) <- lex s,
                                 let result = lookup word lookupTable,
                                 isJust result,
                                 let Just a = result
                    ]

-- | Very similar to a simple 'lookup' in the 'lookupTable', but with a lexer.
readLookupable :: (Lookupable a) => String -> Maybe a
readLookupable s = msum
                 $ map ((`lookup` lookupTable).fst)
                 $ lex s

uncurry3 :: (a->b->c                -> z) -> (a,b,c          ) -> z
uncurry4 :: (a->b->c->d             -> z) -> (a,b,c,d        ) -> z
uncurry5 :: (a->b->c->d->e          -> z) -> (a,b,c,d,e      ) -> z
uncurry6 :: (a->b->c->d->e->f       -> z) -> (a,b,c,d,e,f    ) -> z
uncurry7 :: (a->b->c->d->e->f->g    -> z) -> (a,b,c,d,e,f,g  ) -> z
uncurry8 :: (a->b->c->d->e->f->g->h -> z) -> (a,b,c,d,e,f,g,h) -> z

uncurry3 fun (a,b,c          ) = fun a b c
uncurry4 fun (a,b,c,d        ) = fun a b c d
uncurry5 fun (a,b,c,d,e      ) = fun a b c d e
uncurry6 fun (a,b,c,d,e,f    ) = fun a b c d e f
uncurry7 fun (a,b,c,d,e,f,g  ) = fun a b c d e f g
uncurry8 fun (a,b,c,d,e,f,g,h) = fun a b c d e f g h

swap :: (a,b) -> (b,a)
swap (a,b) = (b,a)

-- | A version of "Data.List.find" that uses a converter to a Maybe instance.
-- The returned value is the first which the converter returns in a 'Just'
-- wrapper.
findBy :: (a -> Maybe b) -> [a] -> Maybe b
findBy _               []   = Nothing
findBy f ((f -> Just x):_ ) = Just x
findBy f (            _:xs) = findBy f xs