diff options
Diffstat (limited to 'src/Text/Pandoc/Readers/Odt/Generic/Utils.hs')
| -rw-r--r-- | src/Text/Pandoc/Readers/Odt/Generic/Utils.hs | 171 |
1 files changed, 171 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs new file mode 100644 index 000000000..6c10ed61d --- /dev/null +++ b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs @@ -0,0 +1,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 + |