{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.LaTeX.SIunitx
  ( dosi
  , doSI
  , doSIrange
  , doSInum
  , doSInumlist
  , doSIang
  )
where
import Text.Pandoc.Builder
import Text.Pandoc.Readers.LaTeX.Parsing
import Text.Pandoc.Readers.LaTeX.Types
import Text.Pandoc.Class
import Text.Pandoc.Parsing hiding (blankline, mathDisplay, mathInline,
                            optional, space, spaces, withRaw, (<|>))
import Control.Applicative ((<|>))
import qualified Data.Map as M
import Data.Char (isDigit)
import Data.Text (Text)
import qualified Data.Text as T
import Data.List (intersperse)

dosi :: PandocMonad m => LP m Inlines -> LP m Inlines
dosi :: LP m Inlines -> LP m Inlines
dosi LP m Inlines
tok = LP m Inlines -> LP m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped (LP m Inlines -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
siUnit LP m Inlines
tok) LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
siUnit LP m Inlines
tok

-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
doSI :: PandocMonad m => LP m Inlines -> LP m Inlines
doSI :: LP m Inlines -> LP m Inlines
doSI LP m Inlines
tok = do
  LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
  Inlines
value <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
doSInum
  Inlines
valueprefix <- Inlines -> LP m Inlines -> LP m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
"" (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ LP m Inlines -> LP m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
bracketed LP m Inlines
tok
  Inlines
unit <- LP m Inlines -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
dosi LP m Inlines
tok
  Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> LP m Inlines) -> [Inlines] -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines
valueprefix,
                      Inlines -> Inlines
emptyOr160 Inlines
valueprefix,
                      Inlines
value,
                      Inlines -> Inlines
emptyOr160 Inlines
unit,
                      Inlines
unit]

doSInum :: PandocMonad m => LP m Inlines
doSInum :: LP m Inlines
doSInum = LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts LP m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Inlines
tonum (Text -> Inlines) -> ([Tok] -> Text) -> [Tok] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Tok] -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced)

tonum :: Text -> Inlines
tonum :: Text -> Inlines
tonum Text
value =
  case Parsec Text () Inlines
-> () -> SourceName -> Text -> Either ParseError Inlines
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> SourceName -> s -> Either ParseError a
runParser Parsec Text () Inlines
parseNum () SourceName
"" Text
value of
    Left ParseError
_    -> Text -> Inlines
text Text
value
    Right Inlines
num -> Inlines
num

doSInumlist :: PandocMonad m => LP m Inlines
doSInumlist :: LP m Inlines
doSInumlist = do
  LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
  [Inlines]
xs <- (Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
tonum ([Text] -> [Inlines]) -> ([Tok] -> [Text]) -> [Tok] -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
";" (Text -> [Text]) -> ([Tok] -> Text) -> [Tok] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> [Inlines])
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Inlines]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  case [Inlines]
xs of
    []  -> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
    [Inlines
x] -> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
x
    [Inlines]
_   -> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$
             [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat (Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str Text
"," Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space) ([Inlines] -> [Inlines]
forall a. [a] -> [a]
init [Inlines]
xs)) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
             Text -> Inlines
text Text
", & " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Inlines
forall a. [a] -> a
last [Inlines]
xs

parseNum :: Parser Text () Inlines
parseNum :: Parsec Text () Inlines
parseNum = ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT Text () Identity [Inlines] -> Parsec Text () Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Text () Inlines -> ParsecT Text () Identity [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parsec Text () Inlines
parseNumPart) Parsec Text () Inlines
-> ParsecT Text () Identity () -> Parsec Text () Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

parseNumPart :: Parser Text () Inlines
parseNumPart :: Parsec Text () Inlines
parseNumPart =
  Parsec Text () Inlines
forall u. ParsecT Text u Identity Inlines
parseDecimalNum Parsec Text () Inlines
-> Parsec Text () Inlines -> Parsec Text () Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parsec Text () Inlines
forall u. ParsecT Text u Identity Inlines
parseComma Parsec Text () Inlines
-> Parsec Text () Inlines -> Parsec Text () Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parsec Text () Inlines
forall u. ParsecT Text u Identity Inlines
parsePlusMinus Parsec Text () Inlines
-> Parsec Text () Inlines -> Parsec Text () Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parsec Text () Inlines
forall u. ParsecT Text u Identity Inlines
parseI Parsec Text () Inlines
-> Parsec Text () Inlines -> Parsec Text () Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parsec Text () Inlines
forall u. ParsecT Text u Identity Inlines
parseExp Parsec Text () Inlines
-> Parsec Text () Inlines -> Parsec Text () Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parsec Text () Inlines
forall u. ParsecT Text u Identity Inlines
parseX Parsec Text () Inlines
-> Parsec Text () Inlines -> Parsec Text () Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parsec Text () Inlines
forall u. ParsecT Text u Identity Inlines
parseSpace
 where
  parseDecimalNum :: ParsecT Text u Identity Inlines
parseDecimalNum = do
    Text
pref <- Text
-> ParsecT Text u Identity Text -> ParsecT Text u Identity Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
forall a. Monoid a => a
mempty (ParsecT Text u Identity Text -> ParsecT Text u Identity Text)
-> ParsecT Text u Identity Text -> ParsecT Text u Identity Text
forall a b. (a -> b) -> a -> b
$ (Text
forall a. Monoid a => a
mempty Text
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+') ParsecT Text u Identity Text
-> ParsecT Text u Identity Text -> ParsecT Text u Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text
"\x2212" Text
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
    Text
basenum <- (Text
pref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (SourceName -> Text) -> SourceName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> Text
T.pack
                (SourceName -> Text)
-> ParsecT Text u Identity SourceName
-> ParsecT Text u Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text u Identity Char -> ParsecT Text u Identity SourceName
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'))
    Text
uncertainty <- Text
-> ParsecT Text u Identity Text -> ParsecT Text u Identity Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
forall a. Monoid a => a
mempty (ParsecT Text u Identity Text -> ParsecT Text u Identity Text)
-> ParsecT Text u Identity Text -> ParsecT Text u Identity Text
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
T.pack (SourceName -> Text)
-> ParsecT Text u Identity SourceName
-> ParsecT Text u Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text u Identity SourceName
forall u. ParsecT Text u Identity SourceName
parseParens
    if Text -> Bool
T.null Text
uncertainty
       then Inlines -> ParsecT Text u Identity Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Text u Identity Inlines)
-> Inlines -> ParsecT Text u Identity Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str Text
basenum
       else Inlines -> ParsecT Text u Identity Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT Text u Identity Inlines)
-> Inlines -> ParsecT Text u Identity Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text
basenum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\xa0\xb1\xa0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
             let (Text
_,Text
ys) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') Text
basenum
              in case (Text -> Int
T.length Text
ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Text -> Int
T.length Text
uncertainty) of
                   (Int
0,Int
_) -> Text
uncertainty
                   (Int
x,Int
y)
                     | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y  -> Text
"0." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y) Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                      (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'0') Text
uncertainty
                     | Bool
otherwise -> Int -> Text -> Text
T.take (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) Text
uncertainty Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                      case (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'0')
                                             (Int -> Text -> Text
T.drop (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) Text
uncertainty) of
                                             Text
t | Text -> Bool
T.null Text
t -> Text
forall a. Monoid a => a
mempty
                                               | Bool
otherwise -> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
  parseComma :: ParsecT Text u Identity Inlines
parseComma = Text -> Inlines
str Text
"." Inlines
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
  parsePlusMinus :: ParsecT Text u Identity Inlines
parsePlusMinus = Text -> Inlines
str Text
"\xa0\xb1\xa0" Inlines
-> ParsecT Text u Identity SourceName
-> ParsecT Text u Identity Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text u Identity SourceName
-> ParsecT Text u Identity SourceName
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (SourceName -> ParsecT Text u Identity SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
"+-")
  parseParens :: ParsecT Text u Identity SourceName
parseParens =
    Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT Text u Identity Char
-> ParsecT Text u Identity SourceName
-> ParsecT Text u Identity SourceName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text u Identity Char -> ParsecT Text u Identity SourceName
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')) ParsecT Text u Identity SourceName
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity SourceName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
  parseI :: ParsecT Text u Identity Inlines
parseI = Text -> Inlines
str Text
"i" Inlines
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'i'
  parseX :: ParsecT Text u Identity Inlines
parseX = Text -> Inlines
str Text
"\xa0\xd7\xa0" Inlines
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'x'
  parseExp :: ParsecT Text u Identity Inlines
parseExp = (\Inlines
n -> Text -> Inlines
str (Text
"\xa0\xd7\xa0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"10") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
superscript Inlines
n)
               (Inlines -> Inlines)
-> ParsecT Text u Identity Inlines
-> ParsecT Text u Identity Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' ParsecT Text u Identity Char
-> ParsecT Text u Identity Inlines
-> ParsecT Text u Identity Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text u Identity Inlines
forall u. ParsecT Text u Identity Inlines
parseDecimalNum)
  parseSpace :: ParsecT Text u Identity Inlines
parseSpace = Inlines
forall a. Monoid a => a
mempty Inlines
-> ParsecT Text u Identity () -> ParsecT Text u Identity Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text u Identity Char -> ParsecT Text u Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')

doSIang :: PandocMonad m => LP m Inlines
doSIang :: LP m Inlines
doSIang = do
  LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
  [Text]
ps <- Text -> Text -> [Text]
T.splitOn Text
";" (Text -> [Text]) -> ([Tok] -> Text) -> [Tok] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> [Text])
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  case [Text]
ps [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> [Text]
forall a. a -> [a]
repeat Text
"" of
    (Text
d:Text
m:Text
s:[Text]
_) -> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$
      (if Text -> Bool
T.null Text
d then Inlines
forall a. Monoid a => a
mempty else Text -> Inlines
str Text
d Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"\xb0") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
      (if Text -> Bool
T.null Text
m then Inlines
forall a. Monoid a => a
mempty else Text -> Inlines
str Text
m Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"\x2032") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
      (if Text -> Bool
T.null Text
s then Inlines
forall a. Monoid a => a
mempty else Text -> Inlines
str Text
s Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"\x2033")
    [Text]
_ -> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty

-- converts e.g. \SIrange{100}{200}{\ms} to "100 ms--200 ms"
doSIrange :: PandocMonad m => Bool -> LP m Inlines -> LP m Inlines
doSIrange :: Bool -> LP m Inlines -> LP m Inlines
doSIrange Bool
includeUnits LP m Inlines
tok = do
  LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
  Inlines
startvalue <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
doSInum
  Inlines
startvalueprefix <- Inlines -> LP m Inlines -> LP m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
"" (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ LP m Inlines -> LP m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
bracketed LP m Inlines
tok
  Inlines
stopvalue <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
doSInum
  Inlines
stopvalueprefix <- Inlines -> LP m Inlines -> LP m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
"" (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ LP m Inlines -> LP m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
bracketed LP m Inlines
tok
  Inlines
unit <- if Bool
includeUnits
             then LP m Inlines -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
dosi LP m Inlines
tok
             else Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
  Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> LP m Inlines) -> [Inlines] -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines
startvalueprefix,
                      Inlines -> Inlines
emptyOr160 Inlines
startvalueprefix,
                      Inlines
startvalue,
                      Inlines -> Inlines
emptyOr160 Inlines
unit,
                      Inlines
unit,
                      Inlines
"\8211", -- An en-dash
                      Inlines
stopvalueprefix,
                      Inlines -> Inlines
emptyOr160 Inlines
stopvalueprefix,
                      Inlines
stopvalue,
                      Inlines -> Inlines
emptyOr160 Inlines
unit,
                      Inlines
unit]

emptyOr160 :: Inlines -> Inlines
emptyOr160 :: Inlines -> Inlines
emptyOr160 Inlines
x = if Inlines
x Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty then Inlines
x else Text -> Inlines
str Text
"\160"

siUnit :: PandocMonad m => LP m Inlines -> LP m Inlines
siUnit :: LP m Inlines -> LP m Inlines
siUnit LP m Inlines
tok = LP m Inlines -> LP m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
  Tok SourcePos
_ (CtrlSeq Text
name) Text
_ <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyControlSeq
  case Text
name of
    Text
"square" -> do
       Inlines
unit <- LP m Inlines -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
siUnit LP m Inlines
tok
       Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
unit Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
superscript Inlines
"2"
    Text
"cubic" -> do
       Inlines
unit <- LP m Inlines -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
siUnit LP m Inlines
tok
       Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
unit Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
superscript Inlines
"3"
    Text
"raisetothe" -> do
       Inlines
n <- LP m Inlines
tok
       Inlines
unit <- LP m Inlines -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
siUnit LP m Inlines
tok
       Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
unit Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
superscript Inlines
n
    Text
_ ->
       case Text -> Map Text Inlines -> Maybe Inlines
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name Map Text Inlines
siUnitMap of
            Just Inlines
il ->
              Inlines -> LP m Inlines -> LP m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
il (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$
                [LP m Inlines] -> LP m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
                 [ (Inlines
il Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
superscript Inlines
"2") Inlines -> LP m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"squared"
                 , (Inlines
il Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
superscript Inlines
"3") Inlines -> LP m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"cubed"
                 , (\Inlines
n -> Inlines
il Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
superscript Inlines
n) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"tothe" LP m Tok -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
tok)
                 ]
            Maybe Inlines
Nothing -> SourceName -> LP m Inlines
forall (m :: * -> *) a. MonadFail m => SourceName -> m a
fail SourceName
"not an siunit unit command")
 LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (LP m Tok -> LP m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyControlSeq LP m Tok -> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m Inlines
tok)
 LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do Tok SourcePos
_ TokType
Word Text
t <- (Tok -> Bool) -> LP m Tok
forall (m :: * -> *). PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok Tok -> Bool
isWordTok
         Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str Text
t)
 LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'^' LP m Tok -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Inlines -> Inlines
superscript (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
tok))
 LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'_' LP m Tok -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Inlines -> Inlines
subscript (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
tok))
 LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines
"\xa0" Inlines -> LP m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'.')
 LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines
"\xa0" Inlines -> LP m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'~')
 LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
tok
 LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do Tok SourcePos
_ TokType
_ Text
t <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok
         Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
t))

siUnitMap :: M.Map Text Inlines
siUnitMap :: Map Text Inlines
siUnitMap = [(Text, Inlines)] -> Map Text Inlines
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"fg", Text -> Inlines
str Text
"fg")
  , (Text
"pg", Text -> Inlines
str Text
"pg")
  , (Text
"ng", Text -> Inlines
str Text
"ng")
  , (Text
"ug", Text -> Inlines
str Text
"μg")
  , (Text
"mg", Text -> Inlines
str Text
"mg")
  , (Text
"g", Text -> Inlines
str Text
"g")
  , (Text
"kg", Text -> Inlines
str Text
"kg")
  , (Text
"amu", Text -> Inlines
str Text
"u")
  , (Text
"pm", Text -> Inlines
str Text
"pm")
  , (Text
"nm", Text -> Inlines
str Text
"nm")
  , (Text
"um", Text -> Inlines
str Text
"μm")
  , (Text
"mm", Text -> Inlines
str Text
"mm")
  , (Text
"cm", Text -> Inlines
str Text
"cm")
  , (Text
"dm", Text -> Inlines
str Text
"dm")
  , (Text
"m", Text -> Inlines
str Text
"m")
  , (Text
"km", Text -> Inlines
str Text
"km")
  , (Text
"as", Text -> Inlines
str Text
"as")
  , (Text
"fs", Text -> Inlines
str Text
"fs")
  , (Text
"ps", Text -> Inlines
str Text
"ps")
  , (Text
"ns", Text -> Inlines
str Text
"ns")
  , (Text
"us", Text -> Inlines
str Text
"μs")
  , (Text
"ms", Text -> Inlines
str Text
"ms")
  , (Text
"s", Text -> Inlines
str Text
"s")
  , (Text
"fmol", Text -> Inlines
str Text
"fmol")
  , (Text
"pmol", Text -> Inlines
str Text
"pmol")
  , (Text
"nmol", Text -> Inlines
str Text
"nmol")
  , (Text
"umol", Text -> Inlines
str Text
"μmol")
  , (Text
"mmol", Text -> Inlines
str Text
"mmol")
  , (Text
"mol", Text -> Inlines
str Text
"mol")
  , (Text
"kmol", Text -> Inlines
str Text
"kmol")
  , (Text
"pA", Text -> Inlines
str Text
"pA")
  , (Text
"nA", Text -> Inlines
str Text
"nA")
  , (Text
"uA", Text -> Inlines
str Text
"μA")
  , (Text
"mA", Text -> Inlines
str Text
"mA")
  , (Text
"A", Text -> Inlines
str Text
"A")
  , (Text
"kA", Text -> Inlines
str Text
"kA")
  , (Text
"ul", Text -> Inlines
str Text
"μl")
  , (Text
"ml", Text -> Inlines
str Text
"ml")
  , (Text
"l", Text -> Inlines
str Text
"l")
  , (Text
"hl", Text -> Inlines
str Text
"hl")
  , (Text
"uL", Text -> Inlines
str Text
"μL")
  , (Text
"mL", Text -> Inlines
str Text
"mL")
  , (Text
"L", Text -> Inlines
str Text
"L")
  , (Text
"hL", Text -> Inlines
str Text
"hL")
  , (Text
"mHz", Text -> Inlines
str Text
"mHz")
  , (Text
"Hz", Text -> Inlines
str Text
"Hz")
  , (Text
"kHz", Text -> Inlines
str Text
"kHz")
  , (Text
"MHz", Text -> Inlines
str Text
"MHz")
  , (Text
"GHz", Text -> Inlines
str Text
"GHz")
  , (Text
"THz", Text -> Inlines
str Text
"THz")
  , (Text
"mN", Text -> Inlines
str Text
"mN")
  , (Text
"N", Text -> Inlines
str Text
"N")
  , (Text
"kN", Text -> Inlines
str Text
"kN")
  , (Text
"MN", Text -> Inlines
str Text
"MN")
  , (Text
"Pa", Text -> Inlines
str Text
"Pa")
  , (Text
"kPa", Text -> Inlines
str Text
"kPa")
  , (Text
"MPa", Text -> Inlines
str Text
"MPa")
  , (Text
"GPa", Text -> Inlines
str Text
"GPa")
  , (Text
"mohm", Text -> Inlines
str Text
"mΩ")
  , (Text
"kohm", Text -> Inlines
str Text
"kΩ")
  , (Text
"Mohm", Text -> Inlines
str Text
"MΩ")
  , (Text
"pV", Text -> Inlines
str Text
"pV")
  , (Text
"nV", Text -> Inlines
str Text
"nV")
  , (Text
"uV", Text -> Inlines
str Text
"μV")
  , (Text
"mV", Text -> Inlines
str Text
"mV")
  , (Text
"V", Text -> Inlines
str Text
"V")
  , (Text
"kV", Text -> Inlines
str Text
"kV")
  , (Text
"W", Text -> Inlines
str Text
"W")
  , (Text
"uW", Text -> Inlines
str Text
"μW")
  , (Text
"mW", Text -> Inlines
str Text
"mW")
  , (Text
"kW", Text -> Inlines
str Text
"kW")
  , (Text
"MW", Text -> Inlines
str Text
"MW")
  , (Text
"GW", Text -> Inlines
str Text
"GW")
  , (Text
"J", Text -> Inlines
str Text
"J")
  , (Text
"uJ", Text -> Inlines
str Text
"μJ")
  , (Text
"mJ", Text -> Inlines
str Text
"mJ")
  , (Text
"kJ", Text -> Inlines
str Text
"kJ")
  , (Text
"eV", Text -> Inlines
str Text
"eV")
  , (Text
"meV", Text -> Inlines
str Text
"meV")
  , (Text
"keV", Text -> Inlines
str Text
"keV")
  , (Text
"MeV", Text -> Inlines
str Text
"MeV")
  , (Text
"GeV", Text -> Inlines
str Text
"GeV")
  , (Text
"TeV", Text -> Inlines
str Text
"TeV")
  , (Text
"kWh", Text -> Inlines
str Text
"kWh")
  , (Text
"F", Text -> Inlines
str Text
"F")
  , (Text
"fF", Text -> Inlines
str Text
"fF")
  , (Text
"pF", Text -> Inlines
str Text
"pF")
  , (Text
"K", Text -> Inlines
str Text
"K")
  , (Text
"dB", Text -> Inlines
str Text
"dB")
  , (Text
"ampere", Text -> Inlines
str Text
"A")
  , (Text
"angstrom", Text -> Inlines
str Text
"Å")
  , (Text
"arcmin", Text -> Inlines
str Text
"′")
  , (Text
"arcminute", Text -> Inlines
str Text
"′")
  , (Text
"arcsecond", Text -> Inlines
str Text
"″")
  , (Text
"astronomicalunit", Text -> Inlines
str Text
"ua")
  , (Text
"atomicmassunit", Text -> Inlines
str Text
"u")
  , (Text
"atto", Text -> Inlines
str Text
"a")
  , (Text
"bar", Text -> Inlines
str Text
"bar")
  , (Text
"barn", Text -> Inlines
str Text
"b")
  , (Text
"becquerel", Text -> Inlines
str Text
"Bq")
  , (Text
"bel", Text -> Inlines
str Text
"B")
  , (Text
"bohr", Inlines -> Inlines
emph (Text -> Inlines
str Text
"a") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
subscript (Text -> Inlines
str Text
"0"))
  , (Text
"candela", Text -> Inlines
str Text
"cd")
  , (Text
"celsius", Text -> Inlines
str Text
"°C")
  , (Text
"centi", Text -> Inlines
str Text
"c")
  , (Text
"clight", Inlines -> Inlines
emph (Text -> Inlines
str Text
"c") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
subscript (Text -> Inlines
str Text
"0"))
  , (Text
"coulomb", Text -> Inlines
str Text
"C")
  , (Text
"dalton", Text -> Inlines
str Text
"Da")
  , (Text
"day", Text -> Inlines
str Text
"d")
  , (Text
"deca", Text -> Inlines
str Text
"d")
  , (Text
"deci", Text -> Inlines
str Text
"d")
  , (Text
"decibel", Text -> Inlines
str Text
"db")
  , (Text
"degreeCelsius",Text -> Inlines
str Text
"°C")
  , (Text
"degree", Text -> Inlines
str Text
"°")
  , (Text
"deka", Text -> Inlines
str Text
"d")
  , (Text
"electronmass", Inlines -> Inlines
emph (Text -> Inlines
str Text
"m") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
subscript (Text -> Inlines
str Text
"e"))
  , (Text
"electronvolt", Text -> Inlines
str Text
"eV")
  , (Text
"elementarycharge", Inlines -> Inlines
emph (Text -> Inlines
str Text
"e"))
  , (Text
"exa", Text -> Inlines
str Text
"E")
  , (Text
"farad", Text -> Inlines
str Text
"F")
  , (Text
"femto", Text -> Inlines
str Text
"f")
  , (Text
"giga", Text -> Inlines
str Text
"G")
  , (Text
"gram", Text -> Inlines
str Text
"g")
  , (Text
"gray", Text -> Inlines
str Text
"Gy")
  , (Text
"hartree", Inlines -> Inlines
emph (Text -> Inlines
str Text
"E") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
subscript (Text -> Inlines
str Text
"h"))
  , (Text
"hectare", Text -> Inlines
str Text
"ha")
  , (Text
"hecto", Text -> Inlines
str Text
"h")
  , (Text
"henry", Text -> Inlines
str Text
"H")
  , (Text
"hertz", Text -> Inlines
str Text
"Hz")
  , (Text
"hour", Text -> Inlines
str Text
"h")
  , (Text
"joule", Text -> Inlines
str Text
"J")
  , (Text
"katal", Text -> Inlines
str Text
"kat")
  , (Text
"kelvin", Text -> Inlines
str Text
"K")
  , (Text
"kilo", Text -> Inlines
str Text
"k")
  , (Text
"kilogram", Text -> Inlines
str Text
"kg")
  , (Text
"knot", Text -> Inlines
str Text
"kn")
  , (Text
"liter", Text -> Inlines
str Text
"L")
  , (Text
"litre", Text -> Inlines
str Text
"l")
  , (Text
"lumen", Text -> Inlines
str Text
"lm")
  , (Text
"lux", Text -> Inlines
str Text
"lx")
  , (Text
"mega", Text -> Inlines
str Text
"M")
  , (Text
"meter", Text -> Inlines
str Text
"m")
  , (Text
"metre", Text -> Inlines
str Text
"m")
  , (Text
"micro", Text -> Inlines
str Text
"μ")
  , (Text
"milli", Text -> Inlines
str Text
"m")
  , (Text
"minute", Text -> Inlines
str Text
"min")
  , (Text
"mmHg", Text -> Inlines
str Text
"mmHg")
  , (Text
"mole", Text -> Inlines
str Text
"mol")
  , (Text
"nano", Text -> Inlines
str Text
"n")
  , (Text
"nauticalmile", Text -> Inlines
str Text
"M")
  , (Text
"neper", Text -> Inlines
str Text
"Np")
  , (Text
"newton", Text -> Inlines
str Text
"N")
  , (Text
"ohm", Text -> Inlines
str Text
"Ω")
  , (Text
"Pa", Text -> Inlines
str Text
"Pa")
  , (Text
"pascal", Text -> Inlines
str Text
"Pa")
  , (Text
"percent", Text -> Inlines
str Text
"%")
  , (Text
"per", Text -> Inlines
str Text
"/")
  , (Text
"peta", Text -> Inlines
str Text
"P")
  , (Text
"pico", Text -> Inlines
str Text
"p")
  , (Text
"planckbar", Inlines -> Inlines
emph (Text -> Inlines
str Text
"\x210f"))
  , (Text
"radian", Text -> Inlines
str Text
"rad")
  , (Text
"second", Text -> Inlines
str Text
"s")
  , (Text
"siemens", Text -> Inlines
str Text
"S")
  , (Text
"sievert", Text -> Inlines
str Text
"Sv")
  , (Text
"steradian", Text -> Inlines
str Text
"sr")
  , (Text
"tera", Text -> Inlines
str Text
"T")
  , (Text
"tesla", Text -> Inlines
str Text
"T")
  , (Text
"tonne", Text -> Inlines
str Text
"t")
  , (Text
"volt", Text -> Inlines
str Text
"V")
  , (Text
"watt", Text -> Inlines
str Text
"W")
  , (Text
"weber", Text -> Inlines
str Text
"Wb")
  , (Text
"yocto", Text -> Inlines
str Text
"y")
  , (Text
"yotta", Text -> Inlines
str Text
"Y")
  , (Text
"zepto", Text -> Inlines
str Text
"z")
  , (Text
"zetta", Text -> Inlines
str Text
"Z")
  ]