{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Org.Types
  ( -- * Document
    OrgDocument (..)
  , Properties

    -- ** Helpers
  , lookupProperty

    -- * Sections
  , OrgSection (..)
  , TodoKeyword (..)
  , TodoState (..)
  , Tag
  , Priority (..)
  , PlanningInfo (..)

    -- ** Helpers
  , lookupSectionProperty

    -- * OrgContent
  , OrgContent
  , documentContent
  , mapContentM
  , mapContent
  , sectionContent
  , mapSectionContentM
  , mapSectionContent

    -- * Elements
  , OrgElement (..)
  , OrgElementData (..)

    -- ** Greater blocks
  , GreaterBlockType (..)

    -- ** Source blocks
  , SrcLine (..)
  , srcLineContent
  , srcLinesToText
  , srcLineMap

    -- ** Lists
  , ListType (..)
  , OrderedStyle (..)
  , orderedStyle
  , ListItem (..)
  , Bullet (..)
  , Checkbox (..)
  , listItemType

    -- ** Keywords
  , Keywords
  , KeywordValue (..)
  , lookupValueKeyword
  , lookupParsedKeyword
  , lookupBackendKeyword
  , keywordsFromList

    -- ** Tables
  , TableRow (..)
  , TableCell
  , ColumnAlignment (..)

    -- * Objects
  , OrgObject (..)

    -- ** Links
  , LinkTarget (..)
  , Protocol
  , Id
  , linkTargetToText

    -- ** LaTeX fragments
  , FragmentType (..)

    -- ** Citations
  , Citation (..)
  , CiteReference (..)

    -- ** Footnote references
  , FootnoteRefData (..)

    -- ** Timestamps
  , TimestampData (..)
  , DateTime
  , TimestampMark
  , Date
  , Time

    -- * Quotes
  , QuoteType (..)

    -- * Babel
  , BabelCall (..)
  ) where

import Data.Aeson
import Data.Aeson.Encoding (text)
import Data.Char (isDigit, toLower)
import Data.Data (Data)
import Data.Map qualified as M
import Data.Text qualified as T

-- * Document, Sections and Headings

data OrgDocument = OrgDocument
  { OrgDocument -> Properties
documentProperties :: Properties
  , OrgDocument -> [OrgElement]
documentChildren :: [OrgElement]
  , OrgDocument -> [OrgSection]
documentSections :: [OrgSection]
  }
  deriving (OrgDocument -> OrgDocument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgDocument -> OrgDocument -> Bool
$c/= :: OrgDocument -> OrgDocument -> Bool
== :: OrgDocument -> OrgDocument -> Bool
$c== :: OrgDocument -> OrgDocument -> Bool
Eq, Eq OrgDocument
OrgDocument -> OrgDocument -> Bool
OrgDocument -> OrgDocument -> Ordering
OrgDocument -> OrgDocument -> OrgDocument
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrgDocument -> OrgDocument -> OrgDocument
$cmin :: OrgDocument -> OrgDocument -> OrgDocument
max :: OrgDocument -> OrgDocument -> OrgDocument
$cmax :: OrgDocument -> OrgDocument -> OrgDocument
>= :: OrgDocument -> OrgDocument -> Bool
$c>= :: OrgDocument -> OrgDocument -> Bool
> :: OrgDocument -> OrgDocument -> Bool
$c> :: OrgDocument -> OrgDocument -> Bool
<= :: OrgDocument -> OrgDocument -> Bool
$c<= :: OrgDocument -> OrgDocument -> Bool
< :: OrgDocument -> OrgDocument -> Bool
$c< :: OrgDocument -> OrgDocument -> Bool
compare :: OrgDocument -> OrgDocument -> Ordering
$ccompare :: OrgDocument -> OrgDocument -> Ordering
Ord, ReadPrec [OrgDocument]
ReadPrec OrgDocument
Int -> ReadS OrgDocument
ReadS [OrgDocument]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OrgDocument]
$creadListPrec :: ReadPrec [OrgDocument]
readPrec :: ReadPrec OrgDocument
$creadPrec :: ReadPrec OrgDocument
readList :: ReadS [OrgDocument]
$creadList :: ReadS [OrgDocument]
readsPrec :: Int -> ReadS OrgDocument
$creadsPrec :: Int -> ReadS OrgDocument
Read, Int -> OrgDocument -> ShowS
[OrgDocument] -> ShowS
OrgDocument -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgDocument] -> ShowS
$cshowList :: [OrgDocument] -> ShowS
show :: OrgDocument -> String
$cshow :: OrgDocument -> String
showsPrec :: Int -> OrgDocument -> ShowS
$cshowsPrec :: Int -> OrgDocument -> ShowS
Show, forall x. Rep OrgDocument x -> OrgDocument
forall x. OrgDocument -> Rep OrgDocument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrgDocument x -> OrgDocument
$cfrom :: forall x. OrgDocument -> Rep OrgDocument x
Generic)
  deriving anyclass (OrgDocument -> ()
forall a. (a -> ()) -> NFData a
rnf :: OrgDocument -> ()
$crnf :: OrgDocument -> ()
NFData)

lookupProperty :: Text -> OrgDocument -> Maybe Text
lookupProperty :: Text -> OrgDocument -> Maybe Text
lookupProperty Text
k = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrgDocument -> Properties
documentProperties

data OrgSection = OrgSection
  { OrgSection -> Int
sectionLevel :: Int
  , OrgSection -> Properties
sectionProperties :: Properties
  , OrgSection -> Maybe TodoKeyword
sectionTodo :: Maybe TodoKeyword
  , OrgSection -> Bool
sectionIsComment :: Bool
  , OrgSection -> Maybe Priority
sectionPriority :: Maybe Priority
  , OrgSection -> [OrgObject]
sectionTitle :: [OrgObject]
  , OrgSection -> Text
sectionRawTitle :: Text
  , OrgSection -> Text
sectionAnchor :: Id
  -- ^ Section custom ID (Warning: this field is not populated by the parser! in
  -- the near future, fields like this one and the 'Id' type will be removed in
  -- favor of AST extensibility). See also the documentation for 'LinkTarget'
  , OrgSection -> [Text]
sectionTags :: [Tag]
  , OrgSection -> PlanningInfo
sectionPlanning :: PlanningInfo
  , OrgSection -> [OrgElement]
sectionChildren :: [OrgElement]
  , OrgSection -> [OrgSection]
sectionSubsections :: [OrgSection]
  }
  deriving (OrgSection -> OrgSection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgSection -> OrgSection -> Bool
$c/= :: OrgSection -> OrgSection -> Bool
== :: OrgSection -> OrgSection -> Bool
$c== :: OrgSection -> OrgSection -> Bool
Eq, Eq OrgSection
OrgSection -> OrgSection -> Bool
OrgSection -> OrgSection -> Ordering
OrgSection -> OrgSection -> OrgSection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrgSection -> OrgSection -> OrgSection
$cmin :: OrgSection -> OrgSection -> OrgSection
max :: OrgSection -> OrgSection -> OrgSection
$cmax :: OrgSection -> OrgSection -> OrgSection
>= :: OrgSection -> OrgSection -> Bool
$c>= :: OrgSection -> OrgSection -> Bool
> :: OrgSection -> OrgSection -> Bool
$c> :: OrgSection -> OrgSection -> Bool
<= :: OrgSection -> OrgSection -> Bool
$c<= :: OrgSection -> OrgSection -> Bool
< :: OrgSection -> OrgSection -> Bool
$c< :: OrgSection -> OrgSection -> Bool
compare :: OrgSection -> OrgSection -> Ordering
$ccompare :: OrgSection -> OrgSection -> Ordering
Ord, ReadPrec [OrgSection]
ReadPrec OrgSection
Int -> ReadS OrgSection
ReadS [OrgSection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OrgSection]
$creadListPrec :: ReadPrec [OrgSection]
readPrec :: ReadPrec OrgSection
$creadPrec :: ReadPrec OrgSection
readList :: ReadS [OrgSection]
$creadList :: ReadS [OrgSection]
readsPrec :: Int -> ReadS OrgSection
$creadsPrec :: Int -> ReadS OrgSection
Read, Int -> OrgSection -> ShowS
[OrgSection] -> ShowS
OrgSection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgSection] -> ShowS
$cshowList :: [OrgSection] -> ShowS
show :: OrgSection -> String
$cshow :: OrgSection -> String
showsPrec :: Int -> OrgSection -> ShowS
$cshowsPrec :: Int -> OrgSection -> ShowS
Show, Typeable, Typeable OrgSection
OrgSection -> DataType
OrgSection -> Constr
(forall b. Data b => b -> b) -> OrgSection -> OrgSection
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OrgSection -> u
forall u. (forall d. Data d => d -> u) -> OrgSection -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgSection -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgSection -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrgSection -> m OrgSection
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgSection -> m OrgSection
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgSection
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgSection -> c OrgSection
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgSection)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrgSection)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgSection -> m OrgSection
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgSection -> m OrgSection
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgSection -> m OrgSection
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgSection -> m OrgSection
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrgSection -> m OrgSection
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrgSection -> m OrgSection
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrgSection -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrgSection -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OrgSection -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OrgSection -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgSection -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgSection -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgSection -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgSection -> r
gmapT :: (forall b. Data b => b -> b) -> OrgSection -> OrgSection
$cgmapT :: (forall b. Data b => b -> b) -> OrgSection -> OrgSection
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrgSection)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrgSection)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgSection)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgSection)
dataTypeOf :: OrgSection -> DataType
$cdataTypeOf :: OrgSection -> DataType
toConstr :: OrgSection -> Constr
$ctoConstr :: OrgSection -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgSection
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgSection
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgSection -> c OrgSection
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgSection -> c OrgSection
Data, forall x. Rep OrgSection x -> OrgSection
forall x. OrgSection -> Rep OrgSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrgSection x -> OrgSection
$cfrom :: forall x. OrgSection -> Rep OrgSection x
Generic)
  deriving anyclass (OrgSection -> ()
forall a. (a -> ()) -> NFData a
rnf :: OrgSection -> ()
$crnf :: OrgSection -> ()
NFData)

lookupSectionProperty :: Text -> OrgSection -> Maybe Text
lookupSectionProperty :: Text -> OrgSection -> Maybe Text
lookupSectionProperty Text
k = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrgSection -> Properties
sectionProperties

type OrgContent = ([OrgElement], [OrgSection])

documentContent :: OrgDocument -> OrgContent
documentContent :: OrgDocument -> OrgContent
documentContent OrgDocument
doc = (OrgDocument -> [OrgElement]
documentChildren OrgDocument
doc, OrgDocument -> [OrgSection]
documentSections OrgDocument
doc)

mapContentM :: Monad m => (OrgContent -> m OrgContent) -> OrgDocument -> m OrgDocument
mapContentM :: forall (m :: * -> *).
Monad m =>
(OrgContent -> m OrgContent) -> OrgDocument -> m OrgDocument
mapContentM OrgContent -> m OrgContent
f OrgDocument
d = do
  ([OrgElement]
c', [OrgSection]
s') <- OrgContent -> m OrgContent
f (OrgDocument -> OrgContent
documentContent OrgDocument
d)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ OrgDocument
d {documentChildren :: [OrgElement]
documentChildren = [OrgElement]
c', documentSections :: [OrgSection]
documentSections = [OrgSection]
s'}

mapContent :: (OrgContent -> OrgContent) -> OrgDocument -> OrgDocument
mapContent :: (OrgContent -> OrgContent) -> OrgDocument -> OrgDocument
mapContent OrgContent -> OrgContent
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
Monad m =>
(OrgContent -> m OrgContent) -> OrgDocument -> m OrgDocument
mapContentM (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrgContent -> OrgContent
f)

sectionContent :: OrgSection -> OrgContent
sectionContent :: OrgSection -> OrgContent
sectionContent OrgSection
sec = (OrgSection -> [OrgElement]
sectionChildren OrgSection
sec, OrgSection -> [OrgSection]
sectionSubsections OrgSection
sec)

mapSectionContentM :: Monad m => (OrgContent -> m OrgContent) -> OrgSection -> m OrgSection
mapSectionContentM :: forall (m :: * -> *).
Monad m =>
(OrgContent -> m OrgContent) -> OrgSection -> m OrgSection
mapSectionContentM OrgContent -> m OrgContent
f OrgSection
d = do
  ([OrgElement]
c', [OrgSection]
s') <- OrgContent -> m OrgContent
f (OrgSection -> OrgContent
sectionContent OrgSection
d)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ OrgSection
d {sectionChildren :: [OrgElement]
sectionChildren = [OrgElement]
c', sectionSubsections :: [OrgSection]
sectionSubsections = [OrgSection]
s'}

mapSectionContent :: (OrgContent -> OrgContent) -> OrgSection -> OrgSection
mapSectionContent :: (OrgContent -> OrgContent) -> OrgSection -> OrgSection
mapSectionContent OrgContent -> OrgContent
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
Monad m =>
(OrgContent -> m OrgContent) -> OrgSection -> m OrgSection
mapSectionContentM (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrgContent -> OrgContent
f)

type Tag = Text

-- | The states in which a todo item can be
data TodoState = Todo | Done
  deriving (TodoState -> TodoState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TodoState -> TodoState -> Bool
$c/= :: TodoState -> TodoState -> Bool
== :: TodoState -> TodoState -> Bool
$c== :: TodoState -> TodoState -> Bool
Eq, Eq TodoState
TodoState -> TodoState -> Bool
TodoState -> TodoState -> Ordering
TodoState -> TodoState -> TodoState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TodoState -> TodoState -> TodoState
$cmin :: TodoState -> TodoState -> TodoState
max :: TodoState -> TodoState -> TodoState
$cmax :: TodoState -> TodoState -> TodoState
>= :: TodoState -> TodoState -> Bool
$c>= :: TodoState -> TodoState -> Bool
> :: TodoState -> TodoState -> Bool
$c> :: TodoState -> TodoState -> Bool
<= :: TodoState -> TodoState -> Bool
$c<= :: TodoState -> TodoState -> Bool
< :: TodoState -> TodoState -> Bool
$c< :: TodoState -> TodoState -> Bool
compare :: TodoState -> TodoState -> Ordering
$ccompare :: TodoState -> TodoState -> Ordering
Ord, Int -> TodoState -> ShowS
[TodoState] -> ShowS
TodoState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TodoState] -> ShowS
$cshowList :: [TodoState] -> ShowS
show :: TodoState -> String
$cshow :: TodoState -> String
showsPrec :: Int -> TodoState -> ShowS
$cshowsPrec :: Int -> TodoState -> ShowS
Show, ReadPrec [TodoState]
ReadPrec TodoState
Int -> ReadS TodoState
ReadS [TodoState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TodoState]
$creadListPrec :: ReadPrec [TodoState]
readPrec :: ReadPrec TodoState
$creadPrec :: ReadPrec TodoState
readList :: ReadS [TodoState]
$creadList :: ReadS [TodoState]
readsPrec :: Int -> ReadS TodoState
$creadsPrec :: Int -> ReadS TodoState
Read, Typeable, Typeable TodoState
TodoState -> DataType
TodoState -> Constr
(forall b. Data b => b -> b) -> TodoState -> TodoState
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TodoState -> u
forall u. (forall d. Data d => d -> u) -> TodoState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TodoState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TodoState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TodoState -> m TodoState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TodoState -> m TodoState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TodoState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TodoState -> c TodoState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TodoState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TodoState)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TodoState -> m TodoState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TodoState -> m TodoState
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TodoState -> m TodoState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TodoState -> m TodoState
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TodoState -> m TodoState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TodoState -> m TodoState
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TodoState -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TodoState -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TodoState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TodoState -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TodoState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TodoState -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TodoState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TodoState -> r
gmapT :: (forall b. Data b => b -> b) -> TodoState -> TodoState
$cgmapT :: (forall b. Data b => b -> b) -> TodoState -> TodoState
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TodoState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TodoState)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TodoState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TodoState)
dataTypeOf :: TodoState -> DataType
$cdataTypeOf :: TodoState -> DataType
toConstr :: TodoState -> Constr
$ctoConstr :: TodoState -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TodoState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TodoState
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TodoState -> c TodoState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TodoState -> c TodoState
Data, forall x. Rep TodoState x -> TodoState
forall x. TodoState -> Rep TodoState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TodoState x -> TodoState
$cfrom :: forall x. TodoState -> Rep TodoState x
Generic)
  deriving anyclass (TodoState -> ()
forall a. (a -> ()) -> NFData a
rnf :: TodoState -> ()
$crnf :: TodoState -> ()
NFData)

instance ToJSON TodoState where
  toJSON :: TodoState -> Value
toJSON TodoState
Todo = Value
"todo"
  toJSON TodoState
Done = Value
"done"
  toEncoding :: TodoState -> Encoding
toEncoding TodoState
Todo = forall a. Text -> Encoding' a
text Text
"todo"
  toEncoding TodoState
Done = forall a. Text -> Encoding' a
text Text
"done"

instance FromJSON TodoState where
  parseJSON :: Value -> Parser TodoState
parseJSON =
    forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
        }

-- | A to-do keyword like @TODO@ or @DONE@.
data TodoKeyword = TodoKeyword
  { TodoKeyword -> TodoState
todoState :: TodoState
  , TodoKeyword -> Text
todoName :: Text
  }
  deriving (Int -> TodoKeyword -> ShowS
[TodoKeyword] -> ShowS
TodoKeyword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TodoKeyword] -> ShowS
$cshowList :: [TodoKeyword] -> ShowS
show :: TodoKeyword -> String
$cshow :: TodoKeyword -> String
showsPrec :: Int -> TodoKeyword -> ShowS
$cshowsPrec :: Int -> TodoKeyword -> ShowS
Show, TodoKeyword -> TodoKeyword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TodoKeyword -> TodoKeyword -> Bool
$c/= :: TodoKeyword -> TodoKeyword -> Bool
== :: TodoKeyword -> TodoKeyword -> Bool
$c== :: TodoKeyword -> TodoKeyword -> Bool
Eq, Eq TodoKeyword
TodoKeyword -> TodoKeyword -> Bool
TodoKeyword -> TodoKeyword -> Ordering
TodoKeyword -> TodoKeyword -> TodoKeyword
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TodoKeyword -> TodoKeyword -> TodoKeyword
$cmin :: TodoKeyword -> TodoKeyword -> TodoKeyword
max :: TodoKeyword -> TodoKeyword -> TodoKeyword
$cmax :: TodoKeyword -> TodoKeyword -> TodoKeyword
>= :: TodoKeyword -> TodoKeyword -> Bool
$c>= :: TodoKeyword -> TodoKeyword -> Bool
> :: TodoKeyword -> TodoKeyword -> Bool
$c> :: TodoKeyword -> TodoKeyword -> Bool
<= :: TodoKeyword -> TodoKeyword -> Bool
$c<= :: TodoKeyword -> TodoKeyword -> Bool
< :: TodoKeyword -> TodoKeyword -> Bool
$c< :: TodoKeyword -> TodoKeyword -> Bool
compare :: TodoKeyword -> TodoKeyword -> Ordering
$ccompare :: TodoKeyword -> TodoKeyword -> Ordering
Ord, ReadPrec [TodoKeyword]
ReadPrec TodoKeyword
Int -> ReadS TodoKeyword
ReadS [TodoKeyword]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TodoKeyword]
$creadListPrec :: ReadPrec [TodoKeyword]
readPrec :: ReadPrec TodoKeyword
$creadPrec :: ReadPrec TodoKeyword
readList :: ReadS [TodoKeyword]
$creadList :: ReadS [TodoKeyword]
readsPrec :: Int -> ReadS TodoKeyword
$creadsPrec :: Int -> ReadS TodoKeyword
Read, Typeable, Typeable TodoKeyword
TodoKeyword -> DataType
TodoKeyword -> Constr
(forall b. Data b => b -> b) -> TodoKeyword -> TodoKeyword
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TodoKeyword -> u
forall u. (forall d. Data d => d -> u) -> TodoKeyword -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TodoKeyword -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TodoKeyword -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TodoKeyword -> m TodoKeyword
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TodoKeyword -> m TodoKeyword
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TodoKeyword
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TodoKeyword -> c TodoKeyword
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TodoKeyword)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TodoKeyword)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TodoKeyword -> m TodoKeyword
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TodoKeyword -> m TodoKeyword
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TodoKeyword -> m TodoKeyword
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TodoKeyword -> m TodoKeyword
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TodoKeyword -> m TodoKeyword
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TodoKeyword -> m TodoKeyword
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TodoKeyword -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TodoKeyword -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TodoKeyword -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TodoKeyword -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TodoKeyword -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TodoKeyword -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TodoKeyword -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TodoKeyword -> r
gmapT :: (forall b. Data b => b -> b) -> TodoKeyword -> TodoKeyword
$cgmapT :: (forall b. Data b => b -> b) -> TodoKeyword -> TodoKeyword
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TodoKeyword)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TodoKeyword)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TodoKeyword)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TodoKeyword)
dataTypeOf :: TodoKeyword -> DataType
$cdataTypeOf :: TodoKeyword -> DataType
toConstr :: TodoKeyword -> Constr
$ctoConstr :: TodoKeyword -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TodoKeyword
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TodoKeyword
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TodoKeyword -> c TodoKeyword
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TodoKeyword -> c TodoKeyword
Data, forall x. Rep TodoKeyword x -> TodoKeyword
forall x. TodoKeyword -> Rep TodoKeyword x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TodoKeyword x -> TodoKeyword
$cfrom :: forall x. TodoKeyword -> Rep TodoKeyword x
Generic)
  deriving anyclass (TodoKeyword -> ()
forall a. (a -> ()) -> NFData a
rnf :: TodoKeyword -> ()
$crnf :: TodoKeyword -> ()
NFData)

instance ToJSON TodoKeyword where
  toJSON :: TodoKeyword -> Value
toJSON (TodoKeyword TodoState
s Text
n) = [Pair] -> Value
object [Key
"state" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TodoState
s, Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
n]
  toEncoding :: TodoKeyword -> Encoding
toEncoding (TodoKeyword TodoState
s Text
n) = Series -> Encoding
pairs (Key
"state" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TodoState
s forall a. Semigroup a => a -> a -> a
<> Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
n)

instance FromJSON TodoKeyword where
  parseJSON :: Value -> Parser TodoKeyword
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Todo Keyword" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    TodoState -> Text -> TodoKeyword
TodoKeyword forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

data Priority
  = LetterPriority Char
  | NumericPriority Int
  deriving (Int -> Priority -> ShowS
[Priority] -> ShowS
Priority -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Priority] -> ShowS
$cshowList :: [Priority] -> ShowS
show :: Priority -> String
$cshow :: Priority -> String
showsPrec :: Int -> Priority -> ShowS
$cshowsPrec :: Int -> Priority -> ShowS
Show, Priority -> Priority -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c== :: Priority -> Priority -> Bool
Eq, Eq Priority
Priority -> Priority -> Bool
Priority -> Priority -> Ordering
Priority -> Priority -> Priority
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Priority -> Priority -> Priority
$cmin :: Priority -> Priority -> Priority
max :: Priority -> Priority -> Priority
$cmax :: Priority -> Priority -> Priority
>= :: Priority -> Priority -> Bool
$c>= :: Priority -> Priority -> Bool
> :: Priority -> Priority -> Bool
$c> :: Priority -> Priority -> Bool
<= :: Priority -> Priority -> Bool
$c<= :: Priority -> Priority -> Bool
< :: Priority -> Priority -> Bool
$c< :: Priority -> Priority -> Bool
compare :: Priority -> Priority -> Ordering
$ccompare :: Priority -> Priority -> Ordering
Ord, ReadPrec [Priority]
ReadPrec Priority
Int -> ReadS Priority
ReadS [Priority]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Priority]
$creadListPrec :: ReadPrec [Priority]
readPrec :: ReadPrec Priority
$creadPrec :: ReadPrec Priority
readList :: ReadS [Priority]
$creadList :: ReadS [Priority]
readsPrec :: Int -> ReadS Priority
$creadsPrec :: Int -> ReadS Priority
Read, Typeable, Typeable Priority
Priority -> DataType
Priority -> Constr
(forall b. Data b => b -> b) -> Priority -> Priority
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Priority -> u
forall u. (forall d. Data d => d -> u) -> Priority -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Priority
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Priority -> c Priority
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Priority)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Priority)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Priority -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Priority -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Priority -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Priority -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
gmapT :: (forall b. Data b => b -> b) -> Priority -> Priority
$cgmapT :: (forall b. Data b => b -> b) -> Priority -> Priority
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Priority)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Priority)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Priority)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Priority)
dataTypeOf :: Priority -> DataType
$cdataTypeOf :: Priority -> DataType
toConstr :: Priority -> Constr
$ctoConstr :: Priority -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Priority
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Priority
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Priority -> c Priority
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Priority -> c Priority
Data, forall x. Rep Priority x -> Priority
forall x. Priority -> Rep Priority x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Priority x -> Priority
$cfrom :: forall x. Priority -> Rep Priority x
Generic)
  deriving anyclass (Priority -> ()
forall a. (a -> ()) -> NFData a
rnf :: Priority -> ()
$crnf :: Priority -> ()
NFData)

type Date = (Int, Int, Int, Maybe Text)

type Time = (Int, Int)

type TimestampMark = (Text, Int, Char)

type DateTime = (Date, Maybe Time, Maybe TimestampMark, Maybe TimestampMark)

-- | An Org timestamp, including repetition marks.
data TimestampData
  = TimestampData Bool DateTime
  | TimestampRange Bool DateTime DateTime
  deriving (Int -> TimestampData -> ShowS
[TimestampData] -> ShowS
TimestampData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimestampData] -> ShowS
$cshowList :: [TimestampData] -> ShowS
show :: TimestampData -> String
$cshow :: TimestampData -> String
showsPrec :: Int -> TimestampData -> ShowS
$cshowsPrec :: Int -> TimestampData -> ShowS
Show, TimestampData -> TimestampData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimestampData -> TimestampData -> Bool
$c/= :: TimestampData -> TimestampData -> Bool
== :: TimestampData -> TimestampData -> Bool
$c== :: TimestampData -> TimestampData -> Bool
Eq, Eq TimestampData
TimestampData -> TimestampData -> Bool
TimestampData -> TimestampData -> Ordering
TimestampData -> TimestampData -> TimestampData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimestampData -> TimestampData -> TimestampData
$cmin :: TimestampData -> TimestampData -> TimestampData
max :: TimestampData -> TimestampData -> TimestampData
$cmax :: TimestampData -> TimestampData -> TimestampData
>= :: TimestampData -> TimestampData -> Bool
$c>= :: TimestampData -> TimestampData -> Bool
> :: TimestampData -> TimestampData -> Bool
$c> :: TimestampData -> TimestampData -> Bool
<= :: TimestampData -> TimestampData -> Bool
$c<= :: TimestampData -> TimestampData -> Bool
< :: TimestampData -> TimestampData -> Bool
$c< :: TimestampData -> TimestampData -> Bool
compare :: TimestampData -> TimestampData -> Ordering
$ccompare :: TimestampData -> TimestampData -> Ordering
Ord, ReadPrec [TimestampData]
ReadPrec TimestampData
Int -> ReadS TimestampData
ReadS [TimestampData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TimestampData]
$creadListPrec :: ReadPrec [TimestampData]
readPrec :: ReadPrec TimestampData
$creadPrec :: ReadPrec TimestampData
readList :: ReadS [TimestampData]
$creadList :: ReadS [TimestampData]
readsPrec :: Int -> ReadS TimestampData
$creadsPrec :: Int -> ReadS TimestampData
Read, Typeable, Typeable TimestampData
TimestampData -> DataType
TimestampData -> Constr
(forall b. Data b => b -> b) -> TimestampData -> TimestampData
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TimestampData -> u
forall u. (forall d. Data d => d -> u) -> TimestampData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimestampData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimestampData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimestampData -> m TimestampData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimestampData -> m TimestampData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimestampData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimestampData -> c TimestampData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimestampData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimestampData)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimestampData -> m TimestampData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimestampData -> m TimestampData
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimestampData -> m TimestampData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimestampData -> m TimestampData
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimestampData -> m TimestampData
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimestampData -> m TimestampData
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TimestampData -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TimestampData -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TimestampData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TimestampData -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimestampData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimestampData -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimestampData -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimestampData -> r
gmapT :: (forall b. Data b => b -> b) -> TimestampData -> TimestampData
$cgmapT :: (forall b. Data b => b -> b) -> TimestampData -> TimestampData
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimestampData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimestampData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimestampData)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimestampData)
dataTypeOf :: TimestampData -> DataType
$cdataTypeOf :: TimestampData -> DataType
toConstr :: TimestampData -> Constr
$ctoConstr :: TimestampData -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimestampData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimestampData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimestampData -> c TimestampData
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimestampData -> c TimestampData
Data, forall x. Rep TimestampData x -> TimestampData
forall x. TimestampData -> Rep TimestampData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimestampData x -> TimestampData
$cfrom :: forall x. TimestampData -> Rep TimestampData x
Generic)
  deriving anyclass (TimestampData -> ()
forall a. (a -> ()) -> NFData a
rnf :: TimestampData -> ()
$crnf :: TimestampData -> ()
NFData)

-- | Planning information for a subtree/headline.
data PlanningInfo = PlanningInfo
  { PlanningInfo -> Maybe TimestampData
planningClosed :: Maybe TimestampData
  , PlanningInfo -> Maybe TimestampData
planningDeadline :: Maybe TimestampData
  , PlanningInfo -> Maybe TimestampData
planningScheduled :: Maybe TimestampData
  }
  deriving (Int -> PlanningInfo -> ShowS
[PlanningInfo] -> ShowS
PlanningInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlanningInfo] -> ShowS
$cshowList :: [PlanningInfo] -> ShowS
show :: PlanningInfo -> String
$cshow :: PlanningInfo -> String
showsPrec :: Int -> PlanningInfo -> ShowS
$cshowsPrec :: Int -> PlanningInfo -> ShowS
Show, PlanningInfo -> PlanningInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlanningInfo -> PlanningInfo -> Bool
$c/= :: PlanningInfo -> PlanningInfo -> Bool
== :: PlanningInfo -> PlanningInfo -> Bool
$c== :: PlanningInfo -> PlanningInfo -> Bool
Eq, Eq PlanningInfo
PlanningInfo -> PlanningInfo -> Bool
PlanningInfo -> PlanningInfo -> Ordering
PlanningInfo -> PlanningInfo -> PlanningInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PlanningInfo -> PlanningInfo -> PlanningInfo
$cmin :: PlanningInfo -> PlanningInfo -> PlanningInfo
max :: PlanningInfo -> PlanningInfo -> PlanningInfo
$cmax :: PlanningInfo -> PlanningInfo -> PlanningInfo
>= :: PlanningInfo -> PlanningInfo -> Bool
$c>= :: PlanningInfo -> PlanningInfo -> Bool
> :: PlanningInfo -> PlanningInfo -> Bool
$c> :: PlanningInfo -> PlanningInfo -> Bool
<= :: PlanningInfo -> PlanningInfo -> Bool
$c<= :: PlanningInfo -> PlanningInfo -> Bool
< :: PlanningInfo -> PlanningInfo -> Bool
$c< :: PlanningInfo -> PlanningInfo -> Bool
compare :: PlanningInfo -> PlanningInfo -> Ordering
$ccompare :: PlanningInfo -> PlanningInfo -> Ordering
Ord, ReadPrec [PlanningInfo]
ReadPrec PlanningInfo
Int -> ReadS PlanningInfo
ReadS [PlanningInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PlanningInfo]
$creadListPrec :: ReadPrec [PlanningInfo]
readPrec :: ReadPrec PlanningInfo
$creadPrec :: ReadPrec PlanningInfo
readList :: ReadS [PlanningInfo]
$creadList :: ReadS [PlanningInfo]
readsPrec :: Int -> ReadS PlanningInfo
$creadsPrec :: Int -> ReadS PlanningInfo
Read, Typeable, Typeable PlanningInfo
PlanningInfo -> DataType
PlanningInfo -> Constr
(forall b. Data b => b -> b) -> PlanningInfo -> PlanningInfo
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PlanningInfo -> u
forall u. (forall d. Data d => d -> u) -> PlanningInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlanningInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlanningInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PlanningInfo -> m PlanningInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlanningInfo -> m PlanningInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanningInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanningInfo -> c PlanningInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlanningInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PlanningInfo)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlanningInfo -> m PlanningInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlanningInfo -> m PlanningInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlanningInfo -> m PlanningInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlanningInfo -> m PlanningInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PlanningInfo -> m PlanningInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PlanningInfo -> m PlanningInfo
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlanningInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlanningInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PlanningInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PlanningInfo -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlanningInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlanningInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlanningInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlanningInfo -> r
gmapT :: (forall b. Data b => b -> b) -> PlanningInfo -> PlanningInfo
$cgmapT :: (forall b. Data b => b -> b) -> PlanningInfo -> PlanningInfo
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PlanningInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PlanningInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlanningInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlanningInfo)
dataTypeOf :: PlanningInfo -> DataType
$cdataTypeOf :: PlanningInfo -> DataType
toConstr :: PlanningInfo -> Constr
$ctoConstr :: PlanningInfo -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanningInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanningInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanningInfo -> c PlanningInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanningInfo -> c PlanningInfo
Data, forall x. Rep PlanningInfo x -> PlanningInfo
forall x. PlanningInfo -> Rep PlanningInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlanningInfo x -> PlanningInfo
$cfrom :: forall x. PlanningInfo -> Rep PlanningInfo x
Generic)
  deriving anyclass (PlanningInfo -> ()
forall a. (a -> ()) -> NFData a
rnf :: PlanningInfo -> ()
$crnf :: PlanningInfo -> ()
NFData)

type Properties = Map Text Text

-- * Elements

-- | Org element. Like a Pandoc Block.
data OrgElement = OrgElement {OrgElement -> Keywords
affiliatedKeywords :: Keywords, OrgElement -> OrgElementData
elementData :: OrgElementData}
  deriving (OrgElement -> OrgElement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgElement -> OrgElement -> Bool
$c/= :: OrgElement -> OrgElement -> Bool
== :: OrgElement -> OrgElement -> Bool
$c== :: OrgElement -> OrgElement -> Bool
Eq, Eq OrgElement
OrgElement -> OrgElement -> Bool
OrgElement -> OrgElement -> Ordering
OrgElement -> OrgElement -> OrgElement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrgElement -> OrgElement -> OrgElement
$cmin :: OrgElement -> OrgElement -> OrgElement
max :: OrgElement -> OrgElement -> OrgElement
$cmax :: OrgElement -> OrgElement -> OrgElement
>= :: OrgElement -> OrgElement -> Bool
$c>= :: OrgElement -> OrgElement -> Bool
> :: OrgElement -> OrgElement -> Bool
$c> :: OrgElement -> OrgElement -> Bool
<= :: OrgElement -> OrgElement -> Bool
$c<= :: OrgElement -> OrgElement -> Bool
< :: OrgElement -> OrgElement -> Bool
$c< :: OrgElement -> OrgElement -> Bool
compare :: OrgElement -> OrgElement -> Ordering
$ccompare :: OrgElement -> OrgElement -> Ordering
Ord, ReadPrec [OrgElement]
ReadPrec OrgElement
Int -> ReadS OrgElement
ReadS [OrgElement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OrgElement]
$creadListPrec :: ReadPrec [OrgElement]
readPrec :: ReadPrec OrgElement
$creadPrec :: ReadPrec OrgElement
readList :: ReadS [OrgElement]
$creadList :: ReadS [OrgElement]
readsPrec :: Int -> ReadS OrgElement
$creadsPrec :: Int -> ReadS OrgElement
Read, Int -> OrgElement -> ShowS
[OrgElement] -> ShowS
OrgElement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgElement] -> ShowS
$cshowList :: [OrgElement] -> ShowS
show :: OrgElement -> String
$cshow :: OrgElement -> String
showsPrec :: Int -> OrgElement -> ShowS
$cshowsPrec :: Int -> OrgElement -> ShowS
Show, Typeable, Typeable OrgElement
OrgElement -> DataType
OrgElement -> Constr
(forall b. Data b => b -> b) -> OrgElement -> OrgElement
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OrgElement -> u
forall u. (forall d. Data d => d -> u) -> OrgElement -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElement -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElement -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrgElement -> m OrgElement
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgElement -> m OrgElement
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgElement
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgElement -> c OrgElement
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgElement)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrgElement)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgElement -> m OrgElement
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgElement -> m OrgElement
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgElement -> m OrgElement
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgElement -> m OrgElement
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrgElement -> m OrgElement
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrgElement -> m OrgElement
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrgElement -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrgElement -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OrgElement -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OrgElement -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElement -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElement -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElement -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElement -> r
gmapT :: (forall b. Data b => b -> b) -> OrgElement -> OrgElement
$cgmapT :: (forall b. Data b => b -> b) -> OrgElement -> OrgElement
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrgElement)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrgElement)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgElement)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgElement)
dataTypeOf :: OrgElement -> DataType
$cdataTypeOf :: OrgElement -> DataType
toConstr :: OrgElement -> Constr
$ctoConstr :: OrgElement -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgElement
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgElement
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgElement -> c OrgElement
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgElement -> c OrgElement
Data, forall x. Rep OrgElement x -> OrgElement
forall x. OrgElement -> Rep OrgElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrgElement x -> OrgElement
$cfrom :: forall x. OrgElement -> Rep OrgElement x
Generic)
  deriving anyclass (OrgElement -> ()
forall a. (a -> ()) -> NFData a
rnf :: OrgElement -> ()
$crnf :: OrgElement -> ()
NFData)

data OrgElementData
  = -- | Clock
    Clock
      TimestampData
      -- ^ Clock timestamp
      (Maybe Time)
      -- ^ Duration
  | -- | Greater block
    GreaterBlock
      { OrgElementData -> GreaterBlockType
blkType :: GreaterBlockType
      -- ^ Greater block type
      , OrgElementData -> [OrgElement]
blkElements :: [OrgElement]
      -- ^ Greater block elements
      }
  | -- | Drawer
    Drawer
      { OrgElementData -> Text
drawerName :: Text
      -- ^ Drawer name
      , OrgElementData -> [OrgElement]
drawerElements :: [OrgElement]
      -- ^ Drawer elements
      }
  | -- | Plain list
    PlainList
      { OrgElementData -> ListType
listType :: ListType
      -- ^ List types
      , OrgElementData -> [ListItem]
listItems :: [ListItem]
      -- ^ List items
      }
  | -- | Export block
    ExportBlock
      Text
      -- ^ Format
      Text
      -- ^ Contents
  | -- | Example block
    ExampleBlock
      (Map Text Text)
      -- ^ Switches
      [SrcLine]
      -- ^ Contents
  | -- | Source blocks
    SrcBlock
      { OrgElementData -> Text
srcBlkLang :: Text
      -- ^ Language
      , OrgElementData -> Properties
srcBlkSwitches :: Map Text Text
      -- ^ Switches
      , OrgElementData -> [(Text, Text)]
srcBlkArguments :: [(Text, Text)]
      -- ^ Header arguments
      , OrgElementData -> [SrcLine]
srcBlkLines :: [SrcLine]
      -- ^ Contents
      }
  | VerseBlock [[OrgObject]]
  | HorizontalRule
  | Keyword
      { OrgElementData -> Text
keywordKey :: Text
      , OrgElementData -> KeywordValue
keywordValue :: KeywordValue
      }
  | LaTeXEnvironment
      Text
      -- ^ Environment name
      Text
      -- ^ Environment contents
  | Paragraph [OrgObject]
  | Table [TableRow]
  | FootnoteDef
      Text
      -- ^ Footnote name
      [OrgElement]
      -- ^ Footnote content
  | Comment
  deriving (OrgElementData -> OrgElementData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgElementData -> OrgElementData -> Bool
$c/= :: OrgElementData -> OrgElementData -> Bool
== :: OrgElementData -> OrgElementData -> Bool
$c== :: OrgElementData -> OrgElementData -> Bool
Eq, Eq OrgElementData
OrgElementData -> OrgElementData -> Bool
OrgElementData -> OrgElementData -> Ordering
OrgElementData -> OrgElementData -> OrgElementData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrgElementData -> OrgElementData -> OrgElementData
$cmin :: OrgElementData -> OrgElementData -> OrgElementData
max :: OrgElementData -> OrgElementData -> OrgElementData
$cmax :: OrgElementData -> OrgElementData -> OrgElementData
>= :: OrgElementData -> OrgElementData -> Bool
$c>= :: OrgElementData -> OrgElementData -> Bool
> :: OrgElementData -> OrgElementData -> Bool
$c> :: OrgElementData -> OrgElementData -> Bool
<= :: OrgElementData -> OrgElementData -> Bool
$c<= :: OrgElementData -> OrgElementData -> Bool
< :: OrgElementData -> OrgElementData -> Bool
$c< :: OrgElementData -> OrgElementData -> Bool
compare :: OrgElementData -> OrgElementData -> Ordering
$ccompare :: OrgElementData -> OrgElementData -> Ordering
Ord, ReadPrec [OrgElementData]
ReadPrec OrgElementData
Int -> ReadS OrgElementData
ReadS [OrgElementData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OrgElementData]
$creadListPrec :: ReadPrec [OrgElementData]
readPrec :: ReadPrec OrgElementData
$creadPrec :: ReadPrec OrgElementData
readList :: ReadS [OrgElementData]
$creadList :: ReadS [OrgElementData]
readsPrec :: Int -> ReadS OrgElementData
$creadsPrec :: Int -> ReadS OrgElementData
Read, Int -> OrgElementData -> ShowS
[OrgElementData] -> ShowS
OrgElementData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgElementData] -> ShowS
$cshowList :: [OrgElementData] -> ShowS
show :: OrgElementData -> String
$cshow :: OrgElementData -> String
showsPrec :: Int -> OrgElementData -> ShowS
$cshowsPrec :: Int -> OrgElementData -> ShowS
Show, Typeable, Typeable OrgElementData
OrgElementData -> DataType
OrgElementData -> Constr
(forall b. Data b => b -> b) -> OrgElementData -> OrgElementData
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> OrgElementData -> u
forall u. (forall d. Data d => d -> u) -> OrgElementData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElementData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElementData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OrgElementData -> m OrgElementData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrgElementData -> m OrgElementData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgElementData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgElementData -> c OrgElementData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgElementData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrgElementData)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrgElementData -> m OrgElementData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrgElementData -> m OrgElementData
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrgElementData -> m OrgElementData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OrgElementData -> m OrgElementData
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OrgElementData -> m OrgElementData
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OrgElementData -> m OrgElementData
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OrgElementData -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OrgElementData -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OrgElementData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OrgElementData -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElementData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElementData -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElementData -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgElementData -> r
gmapT :: (forall b. Data b => b -> b) -> OrgElementData -> OrgElementData
$cgmapT :: (forall b. Data b => b -> b) -> OrgElementData -> OrgElementData
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrgElementData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrgElementData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgElementData)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgElementData)
dataTypeOf :: OrgElementData -> DataType
$cdataTypeOf :: OrgElementData -> DataType
toConstr :: OrgElementData -> Constr
$ctoConstr :: OrgElementData -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgElementData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgElementData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgElementData -> c OrgElementData
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgElementData -> c OrgElementData
Data, forall x. Rep OrgElementData x -> OrgElementData
forall x. OrgElementData -> Rep OrgElementData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrgElementData x -> OrgElementData
$cfrom :: forall x. OrgElementData -> Rep OrgElementData x
Generic)
  deriving anyclass (OrgElementData -> ()
forall a. (a -> ()) -> NFData a
rnf :: OrgElementData -> ()
$crnf :: OrgElementData -> ()
NFData)

data QuoteType = SingleQuote | DoubleQuote
  deriving (QuoteType -> QuoteType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuoteType -> QuoteType -> Bool
$c/= :: QuoteType -> QuoteType -> Bool
== :: QuoteType -> QuoteType -> Bool
$c== :: QuoteType -> QuoteType -> Bool
Eq, Eq QuoteType
QuoteType -> QuoteType -> Bool
QuoteType -> QuoteType -> Ordering
QuoteType -> QuoteType -> QuoteType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QuoteType -> QuoteType -> QuoteType
$cmin :: QuoteType -> QuoteType -> QuoteType
max :: QuoteType -> QuoteType -> QuoteType
$cmax :: QuoteType -> QuoteType -> QuoteType
>= :: QuoteType -> QuoteType -> Bool
$c>= :: QuoteType -> QuoteType -> Bool
> :: QuoteType -> QuoteType -> Bool
$c> :: QuoteType -> QuoteType -> Bool
<= :: QuoteType -> QuoteType -> Bool
$c<= :: QuoteType -> QuoteType -> Bool
< :: QuoteType -> QuoteType -> Bool
$c< :: QuoteType -> QuoteType -> Bool
compare :: QuoteType -> QuoteType -> Ordering
$ccompare :: QuoteType -> QuoteType -> Ordering
Ord, ReadPrec [QuoteType]
ReadPrec QuoteType
Int -> ReadS QuoteType
ReadS [QuoteType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QuoteType]
$creadListPrec :: ReadPrec [QuoteType]
readPrec :: ReadPrec QuoteType
$creadPrec :: ReadPrec QuoteType
readList :: ReadS [QuoteType]
$creadList :: ReadS [QuoteType]
readsPrec :: Int -> ReadS QuoteType
$creadsPrec :: Int -> ReadS QuoteType
Read, Int -> QuoteType -> ShowS
[QuoteType] -> ShowS
QuoteType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuoteType] -> ShowS
$cshowList :: [QuoteType] -> ShowS
show :: QuoteType -> String
$cshow :: QuoteType -> String
showsPrec :: Int -> QuoteType -> ShowS
$cshowsPrec :: Int -> QuoteType -> ShowS
Show, Typeable, Typeable QuoteType
QuoteType -> DataType
QuoteType -> Constr
(forall b. Data b => b -> b) -> QuoteType -> QuoteType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> QuoteType -> u
forall u. (forall d. Data d => d -> u) -> QuoteType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuoteType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuoteType -> c QuoteType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QuoteType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QuoteType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QuoteType -> m QuoteType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QuoteType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QuoteType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> QuoteType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> QuoteType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QuoteType -> r
gmapT :: (forall b. Data b => b -> b) -> QuoteType -> QuoteType
$cgmapT :: (forall b. Data b => b -> b) -> QuoteType -> QuoteType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QuoteType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QuoteType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QuoteType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QuoteType)
dataTypeOf :: QuoteType -> DataType
$cdataTypeOf :: QuoteType -> DataType
toConstr :: QuoteType -> Constr
$ctoConstr :: QuoteType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuoteType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QuoteType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuoteType -> c QuoteType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QuoteType -> c QuoteType
Data, forall x. Rep QuoteType x -> QuoteType
forall x. QuoteType -> Rep QuoteType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QuoteType x -> QuoteType
$cfrom :: forall x. QuoteType -> Rep QuoteType x
Generic)
  deriving anyclass (QuoteType -> ()
forall a. (a -> ()) -> NFData a
rnf :: QuoteType -> ()
$crnf :: QuoteType -> ()
NFData)

data SrcLine
  = SrcLine Text
  | RefLine
      Id
      -- ^ Reference id (its anchor)
      Text
      -- ^ Reference name (how it appears)
      Text
      -- ^ Line contents
  deriving (SrcLine -> SrcLine -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcLine -> SrcLine -> Bool
$c/= :: SrcLine -> SrcLine -> Bool
== :: SrcLine -> SrcLine -> Bool
$c== :: SrcLine -> SrcLine -> Bool
Eq, Eq SrcLine
SrcLine -> SrcLine -> Bool
SrcLine -> SrcLine -> Ordering
SrcLine -> SrcLine -> SrcLine
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SrcLine -> SrcLine -> SrcLine
$cmin :: SrcLine -> SrcLine -> SrcLine
max :: SrcLine -> SrcLine -> SrcLine
$cmax :: SrcLine -> SrcLine -> SrcLine
>= :: SrcLine -> SrcLine -> Bool
$c>= :: SrcLine -> SrcLine -> Bool
> :: SrcLine -> SrcLine -> Bool
$c> :: SrcLine -> SrcLine -> Bool
<= :: SrcLine -> SrcLine -> Bool
$c<= :: SrcLine -> SrcLine -> Bool
< :: SrcLine -> SrcLine -> Bool
$c< :: SrcLine -> SrcLine -> Bool
compare :: SrcLine -> SrcLine -> Ordering
$ccompare :: SrcLine -> SrcLine -> Ordering
Ord, ReadPrec [SrcLine]
ReadPrec SrcLine
Int -> ReadS SrcLine
ReadS [SrcLine]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SrcLine]
$creadListPrec :: ReadPrec [SrcLine]
readPrec :: ReadPrec SrcLine
$creadPrec :: ReadPrec SrcLine
readList :: ReadS [SrcLine]
$creadList :: ReadS [SrcLine]
readsPrec :: Int -> ReadS SrcLine
$creadsPrec :: Int -> ReadS SrcLine
Read, Int -> SrcLine -> ShowS
[SrcLine] -> ShowS
SrcLine -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SrcLine] -> ShowS
$cshowList :: [SrcLine] -> ShowS
show :: SrcLine -> String
$cshow :: SrcLine -> String
showsPrec :: Int -> SrcLine -> ShowS
$cshowsPrec :: Int -> SrcLine -> ShowS
Show, Typeable, Typeable SrcLine
SrcLine -> DataType
SrcLine -> Constr
(forall b. Data b => b -> b) -> SrcLine -> SrcLine
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SrcLine -> u
forall u. (forall d. Data d => d -> u) -> SrcLine -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLine -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLine -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcLine -> m SrcLine
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLine -> m SrcLine
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLine
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLine -> c SrcLine
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcLine)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcLine)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLine -> m SrcLine
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLine -> m SrcLine
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLine -> m SrcLine
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLine -> m SrcLine
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcLine -> m SrcLine
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcLine -> m SrcLine
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcLine -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcLine -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SrcLine -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcLine -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLine -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLine -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLine -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLine -> r
gmapT :: (forall b. Data b => b -> b) -> SrcLine -> SrcLine
$cgmapT :: (forall b. Data b => b -> b) -> SrcLine -> SrcLine
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcLine)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcLine)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcLine)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcLine)
dataTypeOf :: SrcLine -> DataType
$cdataTypeOf :: SrcLine -> DataType
toConstr :: SrcLine -> Constr
$ctoConstr :: SrcLine -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLine
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLine
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLine -> c SrcLine
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLine -> c SrcLine
Data, forall x. Rep SrcLine x -> SrcLine
forall x. SrcLine -> Rep SrcLine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SrcLine x -> SrcLine
$cfrom :: forall x. SrcLine -> Rep SrcLine x
Generic)
  deriving anyclass (SrcLine -> ()
forall a. (a -> ()) -> NFData a
rnf :: SrcLine -> ()
$crnf :: SrcLine -> ()
NFData)

srcLineContent :: SrcLine -> Text
srcLineContent :: SrcLine -> Text
srcLineContent (SrcLine Text
c) = Text
c
srcLineContent (RefLine Text
_ Text
_ Text
c) = Text
c

srcLinesToText :: [SrcLine] -> Text
srcLinesToText :: [SrcLine] -> Text
srcLinesToText = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map SrcLine -> Text
srcLineContent

srcLineMap :: (Text -> Text) -> SrcLine -> SrcLine
srcLineMap :: (Text -> Text) -> SrcLine -> SrcLine
srcLineMap Text -> Text
f (SrcLine Text
c) = Text -> SrcLine
SrcLine (Text -> Text
f Text
c)
srcLineMap Text -> Text
f (RefLine Text
i Text
t Text
c) = Text -> Text -> Text -> SrcLine
RefLine Text
i Text
t (Text -> Text
f Text
c)

-- Keywords

data KeywordValue
  = ValueKeyword Text
  | ParsedKeyword [OrgObject]
  | BackendKeyword [(Text, Text)]
  deriving (KeywordValue -> KeywordValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeywordValue -> KeywordValue -> Bool
$c/= :: KeywordValue -> KeywordValue -> Bool
== :: KeywordValue -> KeywordValue -> Bool
$c== :: KeywordValue -> KeywordValue -> Bool
Eq, Eq KeywordValue
KeywordValue -> KeywordValue -> Bool
KeywordValue -> KeywordValue -> Ordering
KeywordValue -> KeywordValue -> KeywordValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeywordValue -> KeywordValue -> KeywordValue
$cmin :: KeywordValue -> KeywordValue -> KeywordValue
max :: KeywordValue -> KeywordValue -> KeywordValue
$cmax :: KeywordValue -> KeywordValue -> KeywordValue
>= :: KeywordValue -> KeywordValue -> Bool
$c>= :: KeywordValue -> KeywordValue -> Bool
> :: KeywordValue -> KeywordValue -> Bool
$c> :: KeywordValue -> KeywordValue -> Bool
<= :: KeywordValue -> KeywordValue -> Bool
$c<= :: KeywordValue -> KeywordValue -> Bool
< :: KeywordValue -> KeywordValue -> Bool
$c< :: KeywordValue -> KeywordValue -> Bool
compare :: KeywordValue -> KeywordValue -> Ordering
$ccompare :: KeywordValue -> KeywordValue -> Ordering
Ord, ReadPrec [KeywordValue]
ReadPrec KeywordValue
Int -> ReadS KeywordValue
ReadS [KeywordValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KeywordValue]
$creadListPrec :: ReadPrec [KeywordValue]
readPrec :: ReadPrec KeywordValue
$creadPrec :: ReadPrec KeywordValue
readList :: ReadS [KeywordValue]
$creadList :: ReadS [KeywordValue]
readsPrec :: Int -> ReadS KeywordValue
$creadsPrec :: Int -> ReadS KeywordValue
Read, Int -> KeywordValue -> ShowS
[KeywordValue] -> ShowS
KeywordValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeywordValue] -> ShowS
$cshowList :: [KeywordValue] -> ShowS
show :: KeywordValue -> String
$cshow :: KeywordValue -> String
showsPrec :: Int -> KeywordValue -> ShowS
$cshowsPrec :: Int -> KeywordValue -> ShowS
Show, Typeable, Typeable KeywordValue
KeywordValue -> DataType
KeywordValue -> Constr
(forall b. Data b => b -> b) -> KeywordValue -> KeywordValue
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> KeywordValue -> u
forall u. (forall d. Data d => d -> u) -> KeywordValue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordValue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordValue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KeywordValue -> m KeywordValue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeywordValue -> m KeywordValue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeywordValue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeywordValue -> c KeywordValue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KeywordValue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c KeywordValue)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeywordValue -> m KeywordValue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeywordValue -> m KeywordValue
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeywordValue -> m KeywordValue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeywordValue -> m KeywordValue
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KeywordValue -> m KeywordValue
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KeywordValue -> m KeywordValue
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> KeywordValue -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> KeywordValue -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> KeywordValue -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> KeywordValue -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordValue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordValue -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordValue -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordValue -> r
gmapT :: (forall b. Data b => b -> b) -> KeywordValue -> KeywordValue
$cgmapT :: (forall b. Data b => b -> b) -> KeywordValue -> KeywordValue
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c KeywordValue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c KeywordValue)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KeywordValue)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KeywordValue)
dataTypeOf :: KeywordValue -> DataType
$cdataTypeOf :: KeywordValue -> DataType
toConstr :: KeywordValue -> Constr
$ctoConstr :: KeywordValue -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeywordValue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeywordValue
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeywordValue -> c KeywordValue
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeywordValue -> c KeywordValue
Data, forall x. Rep KeywordValue x -> KeywordValue
forall x. KeywordValue -> Rep KeywordValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeywordValue x -> KeywordValue
$cfrom :: forall x. KeywordValue -> Rep KeywordValue x
Generic)
  deriving anyclass (KeywordValue -> ()
forall a. (a -> ()) -> NFData a
rnf :: KeywordValue -> ()
$crnf :: KeywordValue -> ()
NFData)

instance Semigroup KeywordValue where
  (ValueKeyword Text
t1) <> :: KeywordValue -> KeywordValue -> KeywordValue
<> (ValueKeyword Text
t2) = Text -> KeywordValue
ValueKeyword (Text
t1 forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
t2)
  (ParsedKeyword [OrgObject]
t1) <> (ParsedKeyword [OrgObject]
t2) = [OrgObject] -> KeywordValue
ParsedKeyword ([OrgObject]
t1 forall a. Semigroup a => a -> a -> a
<> [OrgObject]
t2)
  (BackendKeyword [(Text, Text)]
b1) <> (BackendKeyword [(Text, Text)]
b2) = [(Text, Text)] -> KeywordValue
BackendKeyword ([(Text, Text)]
b1 forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
b2)
  KeywordValue
_ <> KeywordValue
x = KeywordValue
x

type Keywords = Map Text KeywordValue

lookupValueKeyword :: Text -> Keywords -> Text
lookupValueKeyword :: Text -> Keywords -> Text
lookupValueKeyword Text
key Keywords
kws = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty do
  ValueKeyword Text
x <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Keywords
kws
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
x

lookupParsedKeyword :: Text -> Keywords -> [OrgObject]
lookupParsedKeyword :: Text -> Keywords -> [OrgObject]
lookupParsedKeyword Text
key Keywords
kws = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty do
  ParsedKeyword [OrgObject]
x <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Keywords
kws
  forall (m :: * -> *) a. Monad m => a -> m a
return [OrgObject]
x

lookupBackendKeyword :: Text -> Keywords -> [(Text, Text)]
lookupBackendKeyword :: Text -> Keywords -> [(Text, Text)]
lookupBackendKeyword Text
key Keywords
kws = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty do
  BackendKeyword [(Text, Text)]
x <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Keywords
kws
  forall (m :: * -> *) a. Monad m => a -> m a
return [(Text, Text)]
x

keywordsFromList :: [(Text, KeywordValue)] -> Keywords
keywordsFromList :: [(Text, KeywordValue)] -> Keywords
keywordsFromList = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Semigroup a => a -> a -> a
(<>))

-- Greater Blocks

data GreaterBlockType = Center | Quote | Special Text
  deriving (GreaterBlockType -> GreaterBlockType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GreaterBlockType -> GreaterBlockType -> Bool
$c/= :: GreaterBlockType -> GreaterBlockType -> Bool
== :: GreaterBlockType -> GreaterBlockType -> Bool
$c== :: GreaterBlockType -> GreaterBlockType -> Bool
Eq, Eq GreaterBlockType
GreaterBlockType -> GreaterBlockType -> Bool
GreaterBlockType -> GreaterBlockType -> Ordering
GreaterBlockType -> GreaterBlockType -> GreaterBlockType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GreaterBlockType -> GreaterBlockType -> GreaterBlockType
$cmin :: GreaterBlockType -> GreaterBlockType -> GreaterBlockType
max :: GreaterBlockType -> GreaterBlockType -> GreaterBlockType
$cmax :: GreaterBlockType -> GreaterBlockType -> GreaterBlockType
>= :: GreaterBlockType -> GreaterBlockType -> Bool
$c>= :: GreaterBlockType -> GreaterBlockType -> Bool
> :: GreaterBlockType -> GreaterBlockType -> Bool
$c> :: GreaterBlockType -> GreaterBlockType -> Bool
<= :: GreaterBlockType -> GreaterBlockType -> Bool
$c<= :: GreaterBlockType -> GreaterBlockType -> Bool
< :: GreaterBlockType -> GreaterBlockType -> Bool
$c< :: GreaterBlockType -> GreaterBlockType -> Bool
compare :: GreaterBlockType -> GreaterBlockType -> Ordering
$ccompare :: GreaterBlockType -> GreaterBlockType -> Ordering
Ord, ReadPrec [GreaterBlockType]
ReadPrec GreaterBlockType
Int -> ReadS GreaterBlockType
ReadS [GreaterBlockType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GreaterBlockType]
$creadListPrec :: ReadPrec [GreaterBlockType]
readPrec :: ReadPrec GreaterBlockType
$creadPrec :: ReadPrec GreaterBlockType
readList :: ReadS [GreaterBlockType]
$creadList :: ReadS [GreaterBlockType]
readsPrec :: Int -> ReadS GreaterBlockType
$creadsPrec :: Int -> ReadS GreaterBlockType
Read, Int -> GreaterBlockType -> ShowS
[GreaterBlockType] -> ShowS
GreaterBlockType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GreaterBlockType] -> ShowS
$cshowList :: [GreaterBlockType] -> ShowS
show :: GreaterBlockType -> String
$cshow :: GreaterBlockType -> String
showsPrec :: Int -> GreaterBlockType -> ShowS
$cshowsPrec :: Int -> GreaterBlockType -> ShowS
Show, Typeable, Typeable GreaterBlockType
GreaterBlockType -> DataType
GreaterBlockType -> Constr
(forall b. Data b => b -> b)
-> GreaterBlockType -> GreaterBlockType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> GreaterBlockType -> u
forall u. (forall d. Data d => d -> u) -> GreaterBlockType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GreaterBlockType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GreaterBlockType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GreaterBlockType -> m GreaterBlockType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GreaterBlockType -> m GreaterBlockType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GreaterBlockType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GreaterBlockType -> c GreaterBlockType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GreaterBlockType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GreaterBlockType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GreaterBlockType -> m GreaterBlockType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GreaterBlockType -> m GreaterBlockType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GreaterBlockType -> m GreaterBlockType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GreaterBlockType -> m GreaterBlockType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GreaterBlockType -> m GreaterBlockType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GreaterBlockType -> m GreaterBlockType
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> GreaterBlockType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> GreaterBlockType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> GreaterBlockType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GreaterBlockType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GreaterBlockType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GreaterBlockType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GreaterBlockType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GreaterBlockType -> r
gmapT :: (forall b. Data b => b -> b)
-> GreaterBlockType -> GreaterBlockType
$cgmapT :: (forall b. Data b => b -> b)
-> GreaterBlockType -> GreaterBlockType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GreaterBlockType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GreaterBlockType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GreaterBlockType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GreaterBlockType)
dataTypeOf :: GreaterBlockType -> DataType
$cdataTypeOf :: GreaterBlockType -> DataType
toConstr :: GreaterBlockType -> Constr
$ctoConstr :: GreaterBlockType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GreaterBlockType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GreaterBlockType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GreaterBlockType -> c GreaterBlockType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GreaterBlockType -> c GreaterBlockType
Data, forall x. Rep GreaterBlockType x -> GreaterBlockType
forall x. GreaterBlockType -> Rep GreaterBlockType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GreaterBlockType x -> GreaterBlockType
$cfrom :: forall x. GreaterBlockType -> Rep GreaterBlockType x
Generic)
  deriving anyclass (GreaterBlockType -> ()
forall a. (a -> ()) -> NFData a
rnf :: GreaterBlockType -> ()
$crnf :: GreaterBlockType -> ()
NFData)

-- Lists

data ListType = Ordered OrderedStyle | Descriptive | Unordered Char
  deriving (ListType -> ListType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c== :: ListType -> ListType -> Bool
Eq, Eq ListType
ListType -> ListType -> Bool
ListType -> ListType -> Ordering
ListType -> ListType -> ListType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ListType -> ListType -> ListType
$cmin :: ListType -> ListType -> ListType
max :: ListType -> ListType -> ListType
$cmax :: ListType -> ListType -> ListType
>= :: ListType -> ListType -> Bool
$c>= :: ListType -> ListType -> Bool
> :: ListType -> ListType -> Bool
$c> :: ListType -> ListType -> Bool
<= :: ListType -> ListType -> Bool
$c<= :: ListType -> ListType -> Bool
< :: ListType -> ListType -> Bool
$c< :: ListType -> ListType -> Bool
compare :: ListType -> ListType -> Ordering
$ccompare :: ListType -> ListType -> Ordering
Ord, ReadPrec [ListType]
ReadPrec ListType
Int -> ReadS ListType
ReadS [ListType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListType]
$creadListPrec :: ReadPrec [ListType]
readPrec :: ReadPrec ListType
$creadPrec :: ReadPrec ListType
readList :: ReadS [ListType]
$creadList :: ReadS [ListType]
readsPrec :: Int -> ReadS ListType
$creadsPrec :: Int -> ReadS ListType
Read, Int -> ListType -> ShowS
[ListType] -> ShowS
ListType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListType] -> ShowS
$cshowList :: [ListType] -> ShowS
show :: ListType -> String
$cshow :: ListType -> String
showsPrec :: Int -> ListType -> ShowS
$cshowsPrec :: Int -> ListType -> ShowS
Show, Typeable, Typeable ListType
ListType -> DataType
ListType -> Constr
(forall b. Data b => b -> b) -> ListType -> ListType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ListType -> u
forall u. (forall d. Data d => d -> u) -> ListType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListType -> c ListType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ListType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ListType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ListType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
gmapT :: (forall b. Data b => b -> b) -> ListType -> ListType
$cgmapT :: (forall b. Data b => b -> b) -> ListType -> ListType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListType)
dataTypeOf :: ListType -> DataType
$cdataTypeOf :: ListType -> DataType
toConstr :: ListType -> Constr
$ctoConstr :: ListType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListType -> c ListType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListType -> c ListType
Data, forall x. Rep ListType x -> ListType
forall x. ListType -> Rep ListType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListType x -> ListType
$cfrom :: forall x. ListType -> Rep ListType x
Generic)
  deriving anyclass (ListType -> ()
forall a. (a -> ()) -> NFData a
rnf :: ListType -> ()
$crnf :: ListType -> ()
NFData)

data OrderedStyle = OrderedNum | OrderedAlpha
  deriving (OrderedStyle -> OrderedStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderedStyle -> OrderedStyle -> Bool
$c/= :: OrderedStyle -> OrderedStyle -> Bool
== :: OrderedStyle -> OrderedStyle -> Bool
$c== :: OrderedStyle -> OrderedStyle -> Bool
Eq, Eq OrderedStyle
OrderedStyle -> OrderedStyle -> Bool
OrderedStyle -> OrderedStyle -> Ordering
OrderedStyle -> OrderedStyle -> OrderedStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrderedStyle -> OrderedStyle -> OrderedStyle
$cmin :: OrderedStyle -> OrderedStyle -> OrderedStyle
max :: OrderedStyle -> OrderedStyle -> OrderedStyle
$cmax :: OrderedStyle -> OrderedStyle -> OrderedStyle
>= :: OrderedStyle -> OrderedStyle -> Bool
$c>= :: OrderedStyle -> OrderedStyle -> Bool
> :: OrderedStyle -> OrderedStyle -> Bool
$c> :: OrderedStyle -> OrderedStyle -> Bool
<= :: OrderedStyle -> OrderedStyle -> Bool
$c<= :: OrderedStyle -> OrderedStyle -> Bool
< :: OrderedStyle -> OrderedStyle -> Bool
$c< :: OrderedStyle -> OrderedStyle -> Bool
compare :: OrderedStyle -> OrderedStyle -> Ordering
$ccompare :: OrderedStyle -> OrderedStyle -> Ordering
Ord, ReadPrec [OrderedStyle]
ReadPrec OrderedStyle
Int -> ReadS OrderedStyle
ReadS [OrderedStyle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OrderedStyle]
$creadListPrec :: ReadPrec [OrderedStyle]
readPrec :: ReadPrec OrderedStyle
$creadPrec :: ReadPrec OrderedStyle
readList :: ReadS [OrderedStyle]
$creadList :: ReadS [OrderedStyle]
readsPrec :: Int -> ReadS OrderedStyle
$creadsPrec :: Int -> ReadS OrderedStyle
Read, Int -> OrderedStyle -> ShowS
[OrderedStyle] -> ShowS
OrderedStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderedStyle] -> ShowS
$cshowList :: [OrderedStyle] -> ShowS
show :: OrderedStyle -> String
$cshow :: OrderedStyle -> String
showsPrec :: Int -> OrderedStyle -> ShowS
$cshowsPrec :: Int -> OrderedStyle -> ShowS
Show, Typeable, Typeable OrderedStyle
OrderedStyle -> DataType
OrderedStyle -> Constr
(forall b. Data b => b -> b) -> OrderedStyle -> OrderedStyle
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OrderedStyle -> u
forall u. (forall d. Data d => d -> u) -> OrderedStyle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderedStyle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderedStyle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrderedStyle -> m OrderedStyle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderedStyle -> m OrderedStyle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderedStyle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderedStyle -> c OrderedStyle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderedStyle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderedStyle)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderedStyle -> m OrderedStyle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderedStyle -> m OrderedStyle
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderedStyle -> m OrderedStyle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderedStyle -> m OrderedStyle
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrderedStyle -> m OrderedStyle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrderedStyle -> m OrderedStyle
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrderedStyle -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrderedStyle -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OrderedStyle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OrderedStyle -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderedStyle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderedStyle -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderedStyle -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderedStyle -> r
gmapT :: (forall b. Data b => b -> b) -> OrderedStyle -> OrderedStyle
$cgmapT :: (forall b. Data b => b -> b) -> OrderedStyle -> OrderedStyle
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderedStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OrderedStyle)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderedStyle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderedStyle)
dataTypeOf :: OrderedStyle -> DataType
$cdataTypeOf :: OrderedStyle -> DataType
toConstr :: OrderedStyle -> Constr
$ctoConstr :: OrderedStyle -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderedStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderedStyle
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderedStyle -> c OrderedStyle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderedStyle -> c OrderedStyle
Data, forall x. Rep OrderedStyle x -> OrderedStyle
forall x. OrderedStyle -> Rep OrderedStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrderedStyle x -> OrderedStyle
$cfrom :: forall x. OrderedStyle -> Rep OrderedStyle x
Generic)
  deriving anyclass (OrderedStyle -> ()
forall a. (a -> ()) -> NFData a
rnf :: OrderedStyle -> ()
$crnf :: OrderedStyle -> ()
NFData)

orderedStyle :: Text -> OrderedStyle
orderedStyle :: Text -> OrderedStyle
orderedStyle ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit -> Bool
True) = OrderedStyle
OrderedNum
orderedStyle Text
_ = OrderedStyle
OrderedAlpha

{- | One item of a list. Parameters are bullet, counter cookie, checkbox and
tag.
-}
data ListItem = ListItem Bullet (Maybe Int) (Maybe Checkbox) [OrgObject] [OrgElement]
  deriving (ListItem -> ListItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListItem -> ListItem -> Bool
$c/= :: ListItem -> ListItem -> Bool
== :: ListItem -> ListItem -> Bool
$c== :: ListItem -> ListItem -> Bool
Eq, Eq ListItem
ListItem -> ListItem -> Bool
ListItem -> ListItem -> Ordering
ListItem -> ListItem -> ListItem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ListItem -> ListItem -> ListItem
$cmin :: ListItem -> ListItem -> ListItem
max :: ListItem -> ListItem -> ListItem
$cmax :: ListItem -> ListItem -> ListItem
>= :: ListItem -> ListItem -> Bool
$c>= :: ListItem -> ListItem -> Bool
> :: ListItem -> ListItem -> Bool
$c> :: ListItem -> ListItem -> Bool
<= :: ListItem -> ListItem -> Bool
$c<= :: ListItem -> ListItem -> Bool
< :: ListItem -> ListItem -> Bool
$c< :: ListItem -> ListItem -> Bool
compare :: ListItem -> ListItem -> Ordering
$ccompare :: ListItem -> ListItem -> Ordering
Ord, ReadPrec [ListItem]
ReadPrec ListItem
Int -> ReadS ListItem
ReadS [ListItem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListItem]
$creadListPrec :: ReadPrec [ListItem]
readPrec :: ReadPrec ListItem
$creadPrec :: ReadPrec ListItem
readList :: ReadS [ListItem]
$creadList :: ReadS [ListItem]
readsPrec :: Int -> ReadS ListItem
$creadsPrec :: Int -> ReadS ListItem
Read, Int -> ListItem -> ShowS
[ListItem] -> ShowS
ListItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListItem] -> ShowS
$cshowList :: [ListItem] -> ShowS
show :: ListItem -> String
$cshow :: ListItem -> String
showsPrec :: Int -> ListItem -> ShowS
$cshowsPrec :: Int -> ListItem -> ShowS
Show, Typeable, Typeable ListItem
ListItem -> DataType
ListItem -> Constr
(forall b. Data b => b -> b) -> ListItem -> ListItem
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ListItem -> u
forall u. (forall d. Data d => d -> u) -> ListItem -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListItem -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListItem -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListItem -> m ListItem
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListItem -> m ListItem
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListItem
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListItem -> c ListItem
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListItem)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListItem)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListItem -> m ListItem
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListItem -> m ListItem
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListItem -> m ListItem
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListItem -> m ListItem
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListItem -> m ListItem
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListItem -> m ListItem
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ListItem -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ListItem -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ListItem -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListItem -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListItem -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListItem -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListItem -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListItem -> r
gmapT :: (forall b. Data b => b -> b) -> ListItem -> ListItem
$cgmapT :: (forall b. Data b => b -> b) -> ListItem -> ListItem
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListItem)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListItem)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListItem)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListItem)
dataTypeOf :: ListItem -> DataType
$cdataTypeOf :: ListItem -> DataType
toConstr :: ListItem -> Constr
$ctoConstr :: ListItem -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListItem
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListItem
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListItem -> c ListItem
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListItem -> c ListItem
Data, forall x. Rep ListItem x -> ListItem
forall x. ListItem -> Rep ListItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListItem x -> ListItem
$cfrom :: forall x. ListItem -> Rep ListItem x
Generic)
  deriving anyclass (ListItem -> ()
forall a. (a -> ()) -> NFData a
rnf :: ListItem -> ()
$crnf :: ListItem -> ()
NFData)

data Bullet = Bullet Char | Counter Text Char
  deriving (Bullet -> Bullet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bullet -> Bullet -> Bool
$c/= :: Bullet -> Bullet -> Bool
== :: Bullet -> Bullet -> Bool
$c== :: Bullet -> Bullet -> Bool
Eq, Eq Bullet
Bullet -> Bullet -> Bool
Bullet -> Bullet -> Ordering
Bullet -> Bullet -> Bullet
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Bullet -> Bullet -> Bullet
$cmin :: Bullet -> Bullet -> Bullet
max :: Bullet -> Bullet -> Bullet
$cmax :: Bullet -> Bullet -> Bullet
>= :: Bullet -> Bullet -> Bool
$c>= :: Bullet -> Bullet -> Bool
> :: Bullet -> Bullet -> Bool
$c> :: Bullet -> Bullet -> Bool
<= :: Bullet -> Bullet -> Bool
$c<= :: Bullet -> Bullet -> Bool
< :: Bullet -> Bullet -> Bool
$c< :: Bullet -> Bullet -> Bool
compare :: Bullet -> Bullet -> Ordering
$ccompare :: Bullet -> Bullet -> Ordering
Ord, ReadPrec [Bullet]
ReadPrec Bullet
Int -> ReadS Bullet
ReadS [Bullet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Bullet]
$creadListPrec :: ReadPrec [Bullet]
readPrec :: ReadPrec Bullet
$creadPrec :: ReadPrec Bullet
readList :: ReadS [Bullet]
$creadList :: ReadS [Bullet]
readsPrec :: Int -> ReadS Bullet
$creadsPrec :: Int -> ReadS Bullet
Read, Int -> Bullet -> ShowS
[Bullet] -> ShowS
Bullet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bullet] -> ShowS
$cshowList :: [Bullet] -> ShowS
show :: Bullet -> String
$cshow :: Bullet -> String
showsPrec :: Int -> Bullet -> ShowS
$cshowsPrec :: Int -> Bullet -> ShowS
Show, Typeable, Typeable Bullet
Bullet -> DataType
Bullet -> Constr
(forall b. Data b => b -> b) -> Bullet -> Bullet
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bullet -> u
forall u. (forall d. Data d => d -> u) -> Bullet -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bullet -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bullet -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bullet -> m Bullet
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bullet -> m Bullet
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bullet
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bullet -> c Bullet
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bullet)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bullet)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bullet -> m Bullet
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bullet -> m Bullet
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bullet -> m Bullet
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bullet -> m Bullet
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bullet -> m Bullet
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bullet -> m Bullet
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bullet -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bullet -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Bullet -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bullet -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bullet -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bullet -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bullet -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bullet -> r
gmapT :: (forall b. Data b => b -> b) -> Bullet -> Bullet
$cgmapT :: (forall b. Data b => b -> b) -> Bullet -> Bullet
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bullet)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bullet)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bullet)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bullet)
dataTypeOf :: Bullet -> DataType
$cdataTypeOf :: Bullet -> DataType
toConstr :: Bullet -> Constr
$ctoConstr :: Bullet -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bullet
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bullet
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bullet -> c Bullet
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bullet -> c Bullet
Data, forall x. Rep Bullet x -> Bullet
forall x. Bullet -> Rep Bullet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bullet x -> Bullet
$cfrom :: forall x. Bullet -> Rep Bullet x
Generic)
  deriving anyclass (Bullet -> ()
forall a. (a -> ()) -> NFData a
rnf :: Bullet -> ()
$crnf :: Bullet -> ()
NFData)

data Checkbox = BoolBox Bool | PartialBox
  deriving (Checkbox -> Checkbox -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Checkbox -> Checkbox -> Bool
$c/= :: Checkbox -> Checkbox -> Bool
== :: Checkbox -> Checkbox -> Bool
$c== :: Checkbox -> Checkbox -> Bool
Eq, Eq Checkbox
Checkbox -> Checkbox -> Bool
Checkbox -> Checkbox -> Ordering
Checkbox -> Checkbox -> Checkbox
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Checkbox -> Checkbox -> Checkbox
$cmin :: Checkbox -> Checkbox -> Checkbox
max :: Checkbox -> Checkbox -> Checkbox
$cmax :: Checkbox -> Checkbox -> Checkbox
>= :: Checkbox -> Checkbox -> Bool
$c>= :: Checkbox -> Checkbox -> Bool
> :: Checkbox -> Checkbox -> Bool
$c> :: Checkbox -> Checkbox -> Bool
<= :: Checkbox -> Checkbox -> Bool
$c<= :: Checkbox -> Checkbox -> Bool
< :: Checkbox -> Checkbox -> Bool
$c< :: Checkbox -> Checkbox -> Bool
compare :: Checkbox -> Checkbox -> Ordering
$ccompare :: Checkbox -> Checkbox -> Ordering
Ord, ReadPrec [Checkbox]
ReadPrec Checkbox
Int -> ReadS Checkbox
ReadS [Checkbox]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Checkbox]
$creadListPrec :: ReadPrec [Checkbox]
readPrec :: ReadPrec Checkbox
$creadPrec :: ReadPrec Checkbox
readList :: ReadS [Checkbox]
$creadList :: ReadS [Checkbox]
readsPrec :: Int -> ReadS Checkbox
$creadsPrec :: Int -> ReadS Checkbox
Read, Int -> Checkbox -> ShowS
[Checkbox] -> ShowS
Checkbox -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Checkbox] -> ShowS
$cshowList :: [Checkbox] -> ShowS
show :: Checkbox -> String
$cshow :: Checkbox -> String
showsPrec :: Int -> Checkbox -> ShowS
$cshowsPrec :: Int -> Checkbox -> ShowS
Show, Typeable, Typeable Checkbox
Checkbox -> DataType
Checkbox -> Constr
(forall b. Data b => b -> b) -> Checkbox -> Checkbox
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Checkbox -> u
forall u. (forall d. Data d => d -> u) -> Checkbox -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Checkbox -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Checkbox -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Checkbox -> m Checkbox
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Checkbox -> m Checkbox
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Checkbox
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Checkbox -> c Checkbox
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Checkbox)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Checkbox)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Checkbox -> m Checkbox
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Checkbox -> m Checkbox
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Checkbox -> m Checkbox
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Checkbox -> m Checkbox
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Checkbox -> m Checkbox
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Checkbox -> m Checkbox
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Checkbox -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Checkbox -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Checkbox -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Checkbox -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Checkbox -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Checkbox -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Checkbox -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Checkbox -> r
gmapT :: (forall b. Data b => b -> b) -> Checkbox -> Checkbox
$cgmapT :: (forall b. Data b => b -> b) -> Checkbox -> Checkbox
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Checkbox)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Checkbox)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Checkbox)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Checkbox)
dataTypeOf :: Checkbox -> DataType
$cdataTypeOf :: Checkbox -> DataType
toConstr :: Checkbox -> Constr
$ctoConstr :: Checkbox -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Checkbox
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Checkbox
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Checkbox -> c Checkbox
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Checkbox -> c Checkbox
Data, forall x. Rep Checkbox x -> Checkbox
forall x. Checkbox -> Rep Checkbox x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Checkbox x -> Checkbox
$cfrom :: forall x. Checkbox -> Rep Checkbox x
Generic)
  deriving anyclass (Checkbox -> ()
forall a. (a -> ()) -> NFData a
rnf :: Checkbox -> ()
$crnf :: Checkbox -> ()
NFData)

listItemType :: ListItem -> ListType
listItemType :: ListItem -> ListType
listItemType (ListItem (Counter Text
t Char
_) Maybe Int
_ Maybe Checkbox
_ [OrgObject]
_ [OrgElement]
_) = OrderedStyle -> ListType
Ordered (Text -> OrderedStyle
orderedStyle Text
t)
listItemType (ListItem (Bullet Char
_) Maybe Int
_ Maybe Checkbox
_ (OrgObject
_ : [OrgObject]
_) [OrgElement]
_) = ListType
Descriptive
listItemType (ListItem (Bullet Char
c) Maybe Int
_ Maybe Checkbox
_ [OrgObject]
_ [OrgElement]
_) = Char -> ListType
Unordered Char
c

-- Babel call

data BabelCall = BabelCall
  { BabelCall -> Text
babelCallName :: Text
  , BabelCall -> Text
babelCallHeader1 :: Text
  , BabelCall -> Text
babelCallHeader2 :: Text
  , BabelCall -> Text
babelCallArguments :: Text
  }
  deriving (BabelCall -> BabelCall -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BabelCall -> BabelCall -> Bool
$c/= :: BabelCall -> BabelCall -> Bool
== :: BabelCall -> BabelCall -> Bool
$c== :: BabelCall -> BabelCall -> Bool
Eq, Eq BabelCall
BabelCall -> BabelCall -> Bool
BabelCall -> BabelCall -> Ordering
BabelCall -> BabelCall -> BabelCall
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BabelCall -> BabelCall -> BabelCall
$cmin :: BabelCall -> BabelCall -> BabelCall
max :: BabelCall -> BabelCall -> BabelCall
$cmax :: BabelCall -> BabelCall -> BabelCall
>= :: BabelCall -> BabelCall -> Bool
$c>= :: BabelCall -> BabelCall -> Bool
> :: BabelCall -> BabelCall -> Bool
$c> :: BabelCall -> BabelCall -> Bool
<= :: BabelCall -> BabelCall -> Bool
$c<= :: BabelCall -> BabelCall -> Bool
< :: BabelCall -> BabelCall -> Bool
$c< :: BabelCall -> BabelCall -> Bool
compare :: BabelCall -> BabelCall -> Ordering
$ccompare :: BabelCall -> BabelCall -> Ordering
Ord, ReadPrec [BabelCall]
ReadPrec BabelCall
Int -> ReadS BabelCall
ReadS [BabelCall]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BabelCall]
$creadListPrec :: ReadPrec [BabelCall]
readPrec :: ReadPrec BabelCall
$creadPrec :: ReadPrec BabelCall
readList :: ReadS [BabelCall]
$creadList :: ReadS [BabelCall]
readsPrec :: Int -> ReadS BabelCall
$creadsPrec :: Int -> ReadS BabelCall
Read, Int -> BabelCall -> ShowS
[BabelCall] -> ShowS
BabelCall -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BabelCall] -> ShowS
$cshowList :: [BabelCall] -> ShowS
show :: BabelCall -> String
$cshow :: BabelCall -> String
showsPrec :: Int -> BabelCall -> ShowS
$cshowsPrec :: Int -> BabelCall -> ShowS
Show, Typeable, Typeable BabelCall
BabelCall -> DataType
BabelCall -> Constr
(forall b. Data b => b -> b) -> BabelCall -> BabelCall
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BabelCall -> u
forall u. (forall d. Data d => d -> u) -> BabelCall -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BabelCall -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BabelCall -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BabelCall -> m BabelCall
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BabelCall -> m BabelCall
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BabelCall
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BabelCall -> c BabelCall
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BabelCall)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BabelCall)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BabelCall -> m BabelCall
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BabelCall -> m BabelCall
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BabelCall -> m BabelCall
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BabelCall -> m BabelCall
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BabelCall -> m BabelCall
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BabelCall -> m BabelCall
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BabelCall -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BabelCall -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> BabelCall -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BabelCall -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BabelCall -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BabelCall -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BabelCall -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BabelCall -> r
gmapT :: (forall b. Data b => b -> b) -> BabelCall -> BabelCall
$cgmapT :: (forall b. Data b => b -> b) -> BabelCall -> BabelCall
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BabelCall)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BabelCall)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BabelCall)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BabelCall)
dataTypeOf :: BabelCall -> DataType
$cdataTypeOf :: BabelCall -> DataType
toConstr :: BabelCall -> Constr
$ctoConstr :: BabelCall -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BabelCall
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BabelCall
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BabelCall -> c BabelCall
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BabelCall -> c BabelCall
Data, forall x. Rep BabelCall x -> BabelCall
forall x. BabelCall -> Rep BabelCall x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BabelCall x -> BabelCall
$cfrom :: forall x. BabelCall -> Rep BabelCall x
Generic)
  deriving anyclass (BabelCall -> ()
forall a. (a -> ()) -> NFData a
rnf :: BabelCall -> ()
$crnf :: BabelCall -> ()
NFData)

-- Tables

data TableRow
  = StandardRow [TableCell]
  | ColumnPropsRow [Maybe ColumnAlignment]
  | RuleRow
  deriving (TableRow -> TableRow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableRow -> TableRow -> Bool
$c/= :: TableRow -> TableRow -> Bool
== :: TableRow -> TableRow -> Bool
$c== :: TableRow -> TableRow -> Bool
Eq, Eq TableRow
TableRow -> TableRow -> Bool
TableRow -> TableRow -> Ordering
TableRow -> TableRow -> TableRow
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TableRow -> TableRow -> TableRow
$cmin :: TableRow -> TableRow -> TableRow
max :: TableRow -> TableRow -> TableRow
$cmax :: TableRow -> TableRow -> TableRow
>= :: TableRow -> TableRow -> Bool
$c>= :: TableRow -> TableRow -> Bool
> :: TableRow -> TableRow -> Bool
$c> :: TableRow -> TableRow -> Bool
<= :: TableRow -> TableRow -> Bool
$c<= :: TableRow -> TableRow -> Bool
< :: TableRow -> TableRow -> Bool
$c< :: TableRow -> TableRow -> Bool
compare :: TableRow -> TableRow -> Ordering
$ccompare :: TableRow -> TableRow -> Ordering
Ord, ReadPrec [TableRow]
ReadPrec TableRow
Int -> ReadS TableRow
ReadS [TableRow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TableRow]
$creadListPrec :: ReadPrec [TableRow]
readPrec :: ReadPrec TableRow
$creadPrec :: ReadPrec TableRow
readList :: ReadS [TableRow]
$creadList :: ReadS [TableRow]
readsPrec :: Int -> ReadS TableRow
$creadsPrec :: Int -> ReadS TableRow
Read, Int -> TableRow -> ShowS
[TableRow] -> ShowS
TableRow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableRow] -> ShowS
$cshowList :: [TableRow] -> ShowS
show :: TableRow -> String
$cshow :: TableRow -> String
showsPrec :: Int -> TableRow -> ShowS
$cshowsPrec :: Int -> TableRow -> ShowS
Show, Typeable, Typeable TableRow
TableRow -> DataType
TableRow -> Constr
(forall b. Data b => b -> b) -> TableRow -> TableRow
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TableRow -> u
forall u. (forall d. Data d => d -> u) -> TableRow -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableRow -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableRow -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableRow -> m TableRow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableRow -> m TableRow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableRow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableRow -> c TableRow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableRow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableRow)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableRow -> m TableRow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableRow -> m TableRow
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableRow -> m TableRow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableRow -> m TableRow
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableRow -> m TableRow
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableRow -> m TableRow
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableRow -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableRow -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TableRow -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TableRow -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableRow -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableRow -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableRow -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableRow -> r
gmapT :: (forall b. Data b => b -> b) -> TableRow -> TableRow
$cgmapT :: (forall b. Data b => b -> b) -> TableRow -> TableRow
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableRow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableRow)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableRow)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableRow)
dataTypeOf :: TableRow -> DataType
$cdataTypeOf :: TableRow -> DataType
toConstr :: TableRow -> Constr
$ctoConstr :: TableRow -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableRow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableRow
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableRow -> c TableRow
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableRow -> c TableRow
Data, forall x. Rep TableRow x -> TableRow
forall x. TableRow -> Rep TableRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableRow x -> TableRow
$cfrom :: forall x. TableRow -> Rep TableRow x
Generic)
  deriving anyclass (TableRow -> ()
forall a. (a -> ()) -> NFData a
rnf :: TableRow -> ()
$crnf :: TableRow -> ()
NFData)

type TableCell = [OrgObject]

data ColumnAlignment = AlignLeft | AlignCenter | AlignRight
  deriving (ColumnAlignment -> ColumnAlignment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnAlignment -> ColumnAlignment -> Bool
$c/= :: ColumnAlignment -> ColumnAlignment -> Bool
== :: ColumnAlignment -> ColumnAlignment -> Bool
$c== :: ColumnAlignment -> ColumnAlignment -> Bool
Eq, Eq ColumnAlignment
ColumnAlignment -> ColumnAlignment -> Bool
ColumnAlignment -> ColumnAlignment -> Ordering
ColumnAlignment -> ColumnAlignment -> ColumnAlignment
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColumnAlignment -> ColumnAlignment -> ColumnAlignment
$cmin :: ColumnAlignment -> ColumnAlignment -> ColumnAlignment
max :: ColumnAlignment -> ColumnAlignment -> ColumnAlignment
$cmax :: ColumnAlignment -> ColumnAlignment -> ColumnAlignment
>= :: ColumnAlignment -> ColumnAlignment -> Bool
$c>= :: ColumnAlignment -> ColumnAlignment -> Bool
> :: ColumnAlignment -> ColumnAlignment -> Bool
$c> :: ColumnAlignment -> ColumnAlignment -> Bool
<= :: ColumnAlignment -> ColumnAlignment -> Bool
$c<= :: ColumnAlignment -> ColumnAlignment -> Bool
< :: ColumnAlignment -> ColumnAlignment -> Bool
$c< :: ColumnAlignment -> ColumnAlignment -> Bool
compare :: ColumnAlignment -> ColumnAlignment -> Ordering
$ccompare :: ColumnAlignment -> ColumnAlignment -> Ordering
Ord, ReadPrec [ColumnAlignment]
ReadPrec ColumnAlignment
Int -> ReadS ColumnAlignment
ReadS [ColumnAlignment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColumnAlignment]
$creadListPrec :: ReadPrec [ColumnAlignment]
readPrec :: ReadPrec ColumnAlignment
$creadPrec :: ReadPrec ColumnAlignment
readList :: ReadS [ColumnAlignment]
$creadList :: ReadS [ColumnAlignment]
readsPrec :: Int -> ReadS ColumnAlignment
$creadsPrec :: Int -> ReadS ColumnAlignment
Read, Int -> ColumnAlignment -> ShowS
[ColumnAlignment] -> ShowS
ColumnAlignment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnAlignment] -> ShowS
$cshowList :: [ColumnAlignment] -> ShowS
show :: ColumnAlignment -> String
$cshow :: ColumnAlignment -> String
showsPrec :: Int -> ColumnAlignment -> ShowS
$cshowsPrec :: Int -> ColumnAlignment -> ShowS
Show, Typeable, Typeable ColumnAlignment
ColumnAlignment -> DataType
ColumnAlignment -> Constr
(forall b. Data b => b -> b) -> ColumnAlignment -> ColumnAlignment
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ColumnAlignment -> u
forall u. (forall d. Data d => d -> u) -> ColumnAlignment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ColumnAlignment -> m ColumnAlignment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnAlignment -> m ColumnAlignment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnAlignment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnAlignment -> c ColumnAlignment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColumnAlignment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColumnAlignment)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnAlignment -> m ColumnAlignment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnAlignment -> m ColumnAlignment
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnAlignment -> m ColumnAlignment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnAlignment -> m ColumnAlignment
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ColumnAlignment -> m ColumnAlignment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ColumnAlignment -> m ColumnAlignment
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ColumnAlignment -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ColumnAlignment -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ColumnAlignment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColumnAlignment -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignment -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignment -> r
gmapT :: (forall b. Data b => b -> b) -> ColumnAlignment -> ColumnAlignment
$cgmapT :: (forall b. Data b => b -> b) -> ColumnAlignment -> ColumnAlignment
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColumnAlignment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColumnAlignment)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColumnAlignment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColumnAlignment)
dataTypeOf :: ColumnAlignment -> DataType
$cdataTypeOf :: ColumnAlignment -> DataType
toConstr :: ColumnAlignment -> Constr
$ctoConstr :: ColumnAlignment -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnAlignment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnAlignment
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnAlignment -> c ColumnAlignment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnAlignment -> c ColumnAlignment
Data, forall x. Rep ColumnAlignment x -> ColumnAlignment
forall x. ColumnAlignment -> Rep ColumnAlignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColumnAlignment x -> ColumnAlignment
$cfrom :: forall x. ColumnAlignment -> Rep ColumnAlignment x
Generic)
  deriving anyclass (ColumnAlignment -> ()
forall a. (a -> ()) -> NFData a
rnf :: ColumnAlignment -> ()
$crnf :: ColumnAlignment -> ()
NFData)

-- * Objects (inline elements)

-- | Objects (inline elements).
data OrgObject
  = Plain Text
  | LineBreak
  | Italic [OrgObject]
  | Underline [OrgObject]
  | Bold [OrgObject]
  | Strikethrough [OrgObject]
  | Superscript [OrgObject]
  | Subscript [OrgObject]
  | Quoted QuoteType [OrgObject]
  | Code Text
  | Verbatim Text
  | Timestamp TimestampData
  | -- | Entity (e.g. @\\alpha{}@)
    Entity
      Text
      -- ^ Name (e.g. @alpha@)
  | LaTeXFragment FragmentType Text
  | -- | Inline export snippet (e.g. @\@\@html:\<br/\>\@\@@)
    ExportSnippet
      Text
      -- ^ Back-end (e.g. @html@)
      Text
      -- ^ Value (e.g. @\<br/\>@)
  | -- | Footnote reference.
    FootnoteRef FootnoteRefData
  | Cite Citation
  | InlBabelCall BabelCall
  | -- | Inline source (e.g. @src_html[:foo bar]{\<br/\>}@)
    Src
      Text
      -- ^ Language (e.g. @html@)
      Text
      -- ^ Parameters (e.g. @:foo bar@)
      Text
      -- ^ Value (e.g. @\<br/\>@)
  | Link LinkTarget [OrgObject]
  | -- | Inline target (e.g. @\<\<\<foo\>\>\>@)
    Target
      Id
      -- ^ Anchor (Warning: this field is not populated by the parser! --- in
      -- the near future, fields like this one and the 'Id' type will be removed
      -- in favor of AST extensibility). See also the documentation for
      -- 'LinkTarget'
      Text
      -- ^ Name
  | -- | Org inline macro (e.g. @{{{poem(red,blue)}}}@)
    Macro
      Text
      -- ^ Macro name (e.g. @"poem"@)
      [Text]
      -- ^ Arguments (e.g. @["red", "blue"]@)
  | -- | Statistic cookies.
    StatisticCookie
      (Either (Int, Int) Int)
      -- ^ Either @[num1/num2]@ or @[percent%]@.
  deriving (Int -> OrgObject -> ShowS
[OrgObject] -> ShowS
OrgObject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgObject] -> ShowS
$cshowList :: [OrgObject] -> ShowS
show :: OrgObject -> String
$cshow :: OrgObject -> String
showsPrec :: Int -> OrgObject -> ShowS
$cshowsPrec :: Int -> OrgObject -> ShowS
Show, OrgObject -> OrgObject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgObject -> OrgObject -> Bool
$c/= :: OrgObject -> OrgObject -> Bool
== :: OrgObject -> OrgObject -> Bool
$c== :: OrgObject -> OrgObject -> Bool
Eq, Eq OrgObject
OrgObject -> OrgObject -> Bool
OrgObject -> OrgObject -> Ordering
OrgObject -> OrgObject -> OrgObject
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrgObject -> OrgObject -> OrgObject
$cmin :: OrgObject -> OrgObject -> OrgObject
max :: OrgObject -> OrgObject -> OrgObject
$cmax :: OrgObject -> OrgObject -> OrgObject
>= :: OrgObject -> OrgObject -> Bool
$c>= :: OrgObject -> OrgObject -> Bool
> :: OrgObject -> OrgObject -> Bool
$c> :: OrgObject -> OrgObject -> Bool
<= :: OrgObject -> OrgObject -> Bool
$c<= :: OrgObject -> OrgObject -> Bool
< :: OrgObject -> OrgObject -> Bool
$c< :: OrgObject -> OrgObject -> Bool
compare :: OrgObject -> OrgObject -> Ordering
$ccompare :: OrgObject -> OrgObject -> Ordering
Ord, ReadPrec [OrgObject]
ReadPrec OrgObject
Int -> ReadS OrgObject
ReadS [OrgObject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OrgObject]
$creadListPrec :: ReadPrec [OrgObject]
readPrec :: ReadPrec OrgObject
$creadPrec :: ReadPrec OrgObject
readList :: ReadS [OrgObject]
$creadList :: ReadS [OrgObject]
readsPrec :: Int -> ReadS OrgObject
$creadsPrec :: Int -> ReadS OrgObject
Read, Typeable, Typeable OrgObject
OrgObject -> DataType
OrgObject -> Constr
(forall b. Data b => b -> b) -> OrgObject -> OrgObject
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OrgObject -> u
forall u. (forall d. Data d => d -> u) -> OrgObject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgObject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgObject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrgObject -> m OrgObject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgObject -> m OrgObject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgObject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgObject -> c OrgObject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgObject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrgObject)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgObject -> m OrgObject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgObject -> m OrgObject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgObject -> m OrgObject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrgObject -> m OrgObject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrgObject -> m OrgObject
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrgObject -> m OrgObject
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrgObject -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrgObject -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OrgObject -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OrgObject -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgObject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrgObject -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgObject -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrgObject -> r
gmapT :: (forall b. Data b => b -> b) -> OrgObject -> OrgObject
$cgmapT :: (forall b. Data b => b -> b) -> OrgObject -> OrgObject
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrgObject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrgObject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgObject)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrgObject)
dataTypeOf :: OrgObject -> DataType
$cdataTypeOf :: OrgObject -> DataType
toConstr :: OrgObject -> Constr
$ctoConstr :: OrgObject -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgObject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrgObject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgObject -> c OrgObject
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrgObject -> c OrgObject
Data, forall x. Rep OrgObject x -> OrgObject
forall x. OrgObject -> Rep OrgObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrgObject x -> OrgObject
$cfrom :: forall x. OrgObject -> Rep OrgObject x
Generic)
  deriving anyclass (OrgObject -> ()
forall a. (a -> ()) -> NFData a
rnf :: OrgObject -> ()
$crnf :: OrgObject -> ()
NFData)

-- | Data for a footnote reference.
data FootnoteRefData
  = -- | Label-only footnote reference (e.g. @[fn:foo]@)
    FootnoteRefLabel
      Text
      -- ^ Label (e.g. @foo@)
  | -- | Inline footnote definition (e.g. @[fn:foo::bar]@)
    FootnoteRefDef
      (Maybe Text)
      -- ^ Label (if present, e.g. @foo@)
      [OrgObject]
      -- ^ Content (e.g. @bar@)
  deriving (Int -> FootnoteRefData -> ShowS
[FootnoteRefData] -> ShowS
FootnoteRefData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FootnoteRefData] -> ShowS
$cshowList :: [FootnoteRefData] -> ShowS
show :: FootnoteRefData -> String
$cshow :: FootnoteRefData -> String
showsPrec :: Int -> FootnoteRefData -> ShowS
$cshowsPrec :: Int -> FootnoteRefData -> ShowS
Show, FootnoteRefData -> FootnoteRefData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FootnoteRefData -> FootnoteRefData -> Bool
$c/= :: FootnoteRefData -> FootnoteRefData -> Bool
== :: FootnoteRefData -> FootnoteRefData -> Bool
$c== :: FootnoteRefData -> FootnoteRefData -> Bool
Eq, Eq FootnoteRefData
FootnoteRefData -> FootnoteRefData -> Bool
FootnoteRefData -> FootnoteRefData -> Ordering
FootnoteRefData -> FootnoteRefData -> FootnoteRefData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FootnoteRefData -> FootnoteRefData -> FootnoteRefData
$cmin :: FootnoteRefData -> FootnoteRefData -> FootnoteRefData
max :: FootnoteRefData -> FootnoteRefData -> FootnoteRefData
$cmax :: FootnoteRefData -> FootnoteRefData -> FootnoteRefData
>= :: FootnoteRefData -> FootnoteRefData -> Bool
$c>= :: FootnoteRefData -> FootnoteRefData -> Bool
> :: FootnoteRefData -> FootnoteRefData -> Bool
$c> :: FootnoteRefData -> FootnoteRefData -> Bool
<= :: FootnoteRefData -> FootnoteRefData -> Bool
$c<= :: FootnoteRefData -> FootnoteRefData -> Bool
< :: FootnoteRefData -> FootnoteRefData -> Bool
$c< :: FootnoteRefData -> FootnoteRefData -> Bool
compare :: FootnoteRefData -> FootnoteRefData -> Ordering
$ccompare :: FootnoteRefData -> FootnoteRefData -> Ordering
Ord, ReadPrec [FootnoteRefData]
ReadPrec FootnoteRefData
Int -> ReadS FootnoteRefData
ReadS [FootnoteRefData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FootnoteRefData]
$creadListPrec :: ReadPrec [FootnoteRefData]
readPrec :: ReadPrec FootnoteRefData
$creadPrec :: ReadPrec FootnoteRefData
readList :: ReadS [FootnoteRefData]
$creadList :: ReadS [FootnoteRefData]
readsPrec :: Int -> ReadS FootnoteRefData
$creadsPrec :: Int -> ReadS FootnoteRefData
Read, Typeable, Typeable FootnoteRefData
FootnoteRefData -> DataType
FootnoteRefData -> Constr
(forall b. Data b => b -> b) -> FootnoteRefData -> FootnoteRefData
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FootnoteRefData -> u
forall u. (forall d. Data d => d -> u) -> FootnoteRefData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FootnoteRefData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FootnoteRefData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FootnoteRefData -> m FootnoteRefData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FootnoteRefData -> m FootnoteRefData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FootnoteRefData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FootnoteRefData -> c FootnoteRefData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FootnoteRefData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FootnoteRefData)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FootnoteRefData -> m FootnoteRefData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FootnoteRefData -> m FootnoteRefData
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FootnoteRefData -> m FootnoteRefData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FootnoteRefData -> m FootnoteRefData
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FootnoteRefData -> m FootnoteRefData
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FootnoteRefData -> m FootnoteRefData
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FootnoteRefData -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FootnoteRefData -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FootnoteRefData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FootnoteRefData -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FootnoteRefData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FootnoteRefData -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FootnoteRefData -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FootnoteRefData -> r
gmapT :: (forall b. Data b => b -> b) -> FootnoteRefData -> FootnoteRefData
$cgmapT :: (forall b. Data b => b -> b) -> FootnoteRefData -> FootnoteRefData
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FootnoteRefData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FootnoteRefData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FootnoteRefData)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FootnoteRefData)
dataTypeOf :: FootnoteRefData -> DataType
$cdataTypeOf :: FootnoteRefData -> DataType
toConstr :: FootnoteRefData -> Constr
$ctoConstr :: FootnoteRefData -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FootnoteRefData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FootnoteRefData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FootnoteRefData -> c FootnoteRefData
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FootnoteRefData -> c FootnoteRefData
Data, forall x. Rep FootnoteRefData x -> FootnoteRefData
forall x. FootnoteRefData -> Rep FootnoteRefData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FootnoteRefData x -> FootnoteRefData
$cfrom :: forall x. FootnoteRefData -> Rep FootnoteRefData x
Generic)
  deriving anyclass (FootnoteRefData -> ()
forall a. (a -> ()) -> NFData a
rnf :: FootnoteRefData -> ()
$crnf :: FootnoteRefData -> ()
NFData)

type Protocol = Text

type Id = Text

{- | Link target. Note that the parser does not resolve internal links. Instead,
they should be resolved using the functions in [@org-exporters@
package](https://github.com/lucasvreis/org-mode-hs). In the near future, the
'InternalLink' constructor and 'Id' type will be removed in favor of AST
extensibility. See also the documentation for 'Target'.
-}
data LinkTarget
  = URILink Protocol Text
  | InternalLink Id
  | UnresolvedLink Text
  deriving (Int -> LinkTarget -> ShowS
[LinkTarget] -> ShowS
LinkTarget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkTarget] -> ShowS
$cshowList :: [LinkTarget] -> ShowS
show :: LinkTarget -> String
$cshow :: LinkTarget -> String
showsPrec :: Int -> LinkTarget -> ShowS
$cshowsPrec :: Int -> LinkTarget -> ShowS
Show, LinkTarget -> LinkTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkTarget -> LinkTarget -> Bool
$c/= :: LinkTarget -> LinkTarget -> Bool
== :: LinkTarget -> LinkTarget -> Bool
$c== :: LinkTarget -> LinkTarget -> Bool
Eq, Eq LinkTarget
LinkTarget -> LinkTarget -> Bool
LinkTarget -> LinkTarget -> Ordering
LinkTarget -> LinkTarget -> LinkTarget
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LinkTarget -> LinkTarget -> LinkTarget
$cmin :: LinkTarget -> LinkTarget -> LinkTarget
max :: LinkTarget -> LinkTarget -> LinkTarget
$cmax :: LinkTarget -> LinkTarget -> LinkTarget
>= :: LinkTarget -> LinkTarget -> Bool
$c>= :: LinkTarget -> LinkTarget -> Bool
> :: LinkTarget -> LinkTarget -> Bool
$c> :: LinkTarget -> LinkTarget -> Bool
<= :: LinkTarget -> LinkTarget -> Bool
$c<= :: LinkTarget -> LinkTarget -> Bool
< :: LinkTarget -> LinkTarget -> Bool
$c< :: LinkTarget -> LinkTarget -> Bool
compare :: LinkTarget -> LinkTarget -> Ordering
$ccompare :: LinkTarget -> LinkTarget -> Ordering
Ord, ReadPrec [LinkTarget]
ReadPrec LinkTarget
Int -> ReadS LinkTarget
ReadS [LinkTarget]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LinkTarget]
$creadListPrec :: ReadPrec [LinkTarget]
readPrec :: ReadPrec LinkTarget
$creadPrec :: ReadPrec LinkTarget
readList :: ReadS [LinkTarget]
$creadList :: ReadS [LinkTarget]
readsPrec :: Int -> ReadS LinkTarget
$creadsPrec :: Int -> ReadS LinkTarget
Read, Typeable, Typeable LinkTarget
LinkTarget -> DataType
LinkTarget -> Constr
(forall b. Data b => b -> b) -> LinkTarget -> LinkTarget
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LinkTarget -> u
forall u. (forall d. Data d => d -> u) -> LinkTarget -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LinkTarget -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LinkTarget -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LinkTarget -> m LinkTarget
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LinkTarget -> m LinkTarget
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LinkTarget
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LinkTarget -> c LinkTarget
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LinkTarget)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LinkTarget)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LinkTarget -> m LinkTarget
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LinkTarget -> m LinkTarget
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LinkTarget -> m LinkTarget
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LinkTarget -> m LinkTarget
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LinkTarget -> m LinkTarget
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LinkTarget -> m LinkTarget
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LinkTarget -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LinkTarget -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> LinkTarget -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LinkTarget -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LinkTarget -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LinkTarget -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LinkTarget -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LinkTarget -> r
gmapT :: (forall b. Data b => b -> b) -> LinkTarget -> LinkTarget
$cgmapT :: (forall b. Data b => b -> b) -> LinkTarget -> LinkTarget
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LinkTarget)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LinkTarget)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LinkTarget)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LinkTarget)
dataTypeOf :: LinkTarget -> DataType
$cdataTypeOf :: LinkTarget -> DataType
toConstr :: LinkTarget -> Constr
$ctoConstr :: LinkTarget -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LinkTarget
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LinkTarget
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LinkTarget -> c LinkTarget
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LinkTarget -> c LinkTarget
Data, forall x. Rep LinkTarget x -> LinkTarget
forall x. LinkTarget -> Rep LinkTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LinkTarget x -> LinkTarget
$cfrom :: forall x. LinkTarget -> Rep LinkTarget x
Generic)
  deriving anyclass (LinkTarget -> ()
forall a. (a -> ()) -> NFData a
rnf :: LinkTarget -> ()
$crnf :: LinkTarget -> ()
NFData)

linkTargetToText :: LinkTarget -> Text
linkTargetToText :: LinkTarget -> Text
linkTargetToText = \case
  URILink Text
prot Text
l -> Text
prot forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
l
  InternalLink Text
l -> Text
l
  UnresolvedLink Text
l -> Text
l

data FragmentType
  = RawFragment
  | InlMathFragment
  | DispMathFragment
  deriving (Int -> FragmentType -> ShowS
[FragmentType] -> ShowS
FragmentType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FragmentType] -> ShowS
$cshowList :: [FragmentType] -> ShowS
show :: FragmentType -> String
$cshow :: FragmentType -> String
showsPrec :: Int -> FragmentType -> ShowS
$cshowsPrec :: Int -> FragmentType -> ShowS
Show, FragmentType -> FragmentType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FragmentType -> FragmentType -> Bool
$c/= :: FragmentType -> FragmentType -> Bool
== :: FragmentType -> FragmentType -> Bool
$c== :: FragmentType -> FragmentType -> Bool
Eq, Eq FragmentType
FragmentType -> FragmentType -> Bool
FragmentType -> FragmentType -> Ordering
FragmentType -> FragmentType -> FragmentType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FragmentType -> FragmentType -> FragmentType
$cmin :: FragmentType -> FragmentType -> FragmentType
max :: FragmentType -> FragmentType -> FragmentType
$cmax :: FragmentType -> FragmentType -> FragmentType
>= :: FragmentType -> FragmentType -> Bool
$c>= :: FragmentType -> FragmentType -> Bool
> :: FragmentType -> FragmentType -> Bool
$c> :: FragmentType -> FragmentType -> Bool
<= :: FragmentType -> FragmentType -> Bool
$c<= :: FragmentType -> FragmentType -> Bool
< :: FragmentType -> FragmentType -> Bool
$c< :: FragmentType -> FragmentType -> Bool
compare :: FragmentType -> FragmentType -> Ordering
$ccompare :: FragmentType -> FragmentType -> Ordering
Ord, ReadPrec [FragmentType]
ReadPrec FragmentType
Int -> ReadS FragmentType
ReadS [FragmentType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FragmentType]
$creadListPrec :: ReadPrec [FragmentType]
readPrec :: ReadPrec FragmentType
$creadPrec :: ReadPrec FragmentType
readList :: ReadS [FragmentType]
$creadList :: ReadS [FragmentType]
readsPrec :: Int -> ReadS FragmentType
$creadsPrec :: Int -> ReadS FragmentType
Read, Typeable, Typeable FragmentType
FragmentType -> DataType
FragmentType -> Constr
(forall b. Data b => b -> b) -> FragmentType -> FragmentType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FragmentType -> u
forall u. (forall d. Data d => d -> u) -> FragmentType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FragmentType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FragmentType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FragmentType -> m FragmentType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FragmentType -> m FragmentType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FragmentType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FragmentType -> c FragmentType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FragmentType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FragmentType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FragmentType -> m FragmentType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FragmentType -> m FragmentType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FragmentType -> m FragmentType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FragmentType -> m FragmentType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FragmentType -> m FragmentType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FragmentType -> m FragmentType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FragmentType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FragmentType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FragmentType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FragmentType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FragmentType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FragmentType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FragmentType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FragmentType -> r
gmapT :: (forall b. Data b => b -> b) -> FragmentType -> FragmentType
$cgmapT :: (forall b. Data b => b -> b) -> FragmentType -> FragmentType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FragmentType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FragmentType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FragmentType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FragmentType)
dataTypeOf :: FragmentType -> DataType
$cdataTypeOf :: FragmentType -> DataType
toConstr :: FragmentType -> Constr
$ctoConstr :: FragmentType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FragmentType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FragmentType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FragmentType -> c FragmentType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FragmentType -> c FragmentType
Data, forall x. Rep FragmentType x -> FragmentType
forall x. FragmentType -> Rep FragmentType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FragmentType x -> FragmentType
$cfrom :: forall x. FragmentType -> Rep FragmentType x
Generic)
  deriving anyclass (FragmentType -> ()
forall a. (a -> ()) -> NFData a
rnf :: FragmentType -> ()
$crnf :: FragmentType -> ()
NFData)

data Citation = Citation
  { Citation -> Text
citationStyle :: Text
  , Citation -> Text
citationVariant :: Text
  , Citation -> [OrgObject]
citationPrefix :: [OrgObject]
  , Citation -> [OrgObject]
citationSuffix :: [OrgObject]
  , Citation -> [CiteReference]
citationReferences :: [CiteReference]
  }
  deriving (Int -> Citation -> ShowS
[Citation] -> ShowS
Citation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Citation] -> ShowS
$cshowList :: [Citation] -> ShowS
show :: Citation -> String
$cshow :: Citation -> String
showsPrec :: Int -> Citation -> ShowS
$cshowsPrec :: Int -> Citation -> ShowS
Show, Citation -> Citation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Citation -> Citation -> Bool
$c/= :: Citation -> Citation -> Bool
== :: Citation -> Citation -> Bool
$c== :: Citation -> Citation -> Bool
Eq, Eq Citation
Citation -> Citation -> Bool
Citation -> Citation -> Ordering
Citation -> Citation -> Citation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Citation -> Citation -> Citation
$cmin :: Citation -> Citation -> Citation
max :: Citation -> Citation -> Citation
$cmax :: Citation -> Citation -> Citation
>= :: Citation -> Citation -> Bool
$c>= :: Citation -> Citation -> Bool
> :: Citation -> Citation -> Bool
$c> :: Citation -> Citation -> Bool
<= :: Citation -> Citation -> Bool
$c<= :: Citation -> Citation -> Bool
< :: Citation -> Citation -> Bool
$c< :: Citation -> Citation -> Bool
compare :: Citation -> Citation -> Ordering
$ccompare :: Citation -> Citation -> Ordering
Ord, ReadPrec [Citation]
ReadPrec Citation
Int -> ReadS Citation
ReadS [Citation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Citation]
$creadListPrec :: ReadPrec [Citation]
readPrec :: ReadPrec Citation
$creadPrec :: ReadPrec Citation
readList :: ReadS [Citation]
$creadList :: ReadS [Citation]
readsPrec :: Int -> ReadS Citation
$creadsPrec :: Int -> ReadS Citation
Read, Typeable, Typeable Citation
Citation -> DataType
Citation -> Constr
(forall b. Data b => b -> b) -> Citation -> Citation
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Citation -> u
forall u. (forall d. Data d => d -> u) -> Citation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Citation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Citation -> c Citation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Citation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Citation)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Citation -> m Citation
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Citation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Citation -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Citation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Citation -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Citation -> r
gmapT :: (forall b. Data b => b -> b) -> Citation -> Citation
$cgmapT :: (forall b. Data b => b -> b) -> Citation -> Citation
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Citation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Citation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Citation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Citation)
dataTypeOf :: Citation -> DataType
$cdataTypeOf :: Citation -> DataType
toConstr :: Citation -> Constr
$ctoConstr :: Citation -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Citation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Citation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Citation -> c Citation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Citation -> c Citation
Data, forall x. Rep Citation x -> Citation
forall x. Citation -> Rep Citation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Citation x -> Citation
$cfrom :: forall x. Citation -> Rep Citation x
Generic)
  deriving anyclass (Citation -> ()
forall a. (a -> ()) -> NFData a
rnf :: Citation -> ()
$crnf :: Citation -> ()
NFData)

data CiteReference = CiteReference
  { CiteReference -> Text
refId :: Text
  , CiteReference -> [OrgObject]
refPrefix :: [OrgObject]
  , CiteReference -> [OrgObject]
refSuffix :: [OrgObject]
  }
  deriving (Int -> CiteReference -> ShowS
[CiteReference] -> ShowS
CiteReference -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CiteReference] -> ShowS
$cshowList :: [CiteReference] -> ShowS
show :: CiteReference -> String
$cshow :: CiteReference -> String
showsPrec :: Int -> CiteReference -> ShowS
$cshowsPrec :: Int -> CiteReference -> ShowS
Show, CiteReference -> CiteReference -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CiteReference -> CiteReference -> Bool
$c/= :: CiteReference -> CiteReference -> Bool
== :: CiteReference -> CiteReference -> Bool
$c== :: CiteReference -> CiteReference -> Bool
Eq, Eq CiteReference
CiteReference -> CiteReference -> Bool
CiteReference -> CiteReference -> Ordering
CiteReference -> CiteReference -> CiteReference
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CiteReference -> CiteReference -> CiteReference
$cmin :: CiteReference -> CiteReference -> CiteReference
max :: CiteReference -> CiteReference -> CiteReference
$cmax :: CiteReference -> CiteReference -> CiteReference
>= :: CiteReference -> CiteReference -> Bool
$c>= :: CiteReference -> CiteReference -> Bool
> :: CiteReference -> CiteReference -> Bool
$c> :: CiteReference -> CiteReference -> Bool
<= :: CiteReference -> CiteReference -> Bool
$c<= :: CiteReference -> CiteReference -> Bool
< :: CiteReference -> CiteReference -> Bool
$c< :: CiteReference -> CiteReference -> Bool
compare :: CiteReference -> CiteReference -> Ordering
$ccompare :: CiteReference -> CiteReference -> Ordering
Ord, ReadPrec [CiteReference]
ReadPrec CiteReference
Int -> ReadS CiteReference
ReadS [CiteReference]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CiteReference]
$creadListPrec :: ReadPrec [CiteReference]
readPrec :: ReadPrec CiteReference
$creadPrec :: ReadPrec CiteReference
readList :: ReadS [CiteReference]
$creadList :: ReadS [CiteReference]
readsPrec :: Int -> ReadS CiteReference
$creadsPrec :: Int -> ReadS CiteReference
Read, Typeable, Typeable CiteReference
CiteReference -> DataType
CiteReference -> Constr
(forall b. Data b => b -> b) -> CiteReference -> CiteReference
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CiteReference -> u
forall u. (forall d. Data d => d -> u) -> CiteReference -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CiteReference -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CiteReference -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CiteReference -> m CiteReference
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CiteReference -> m CiteReference
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CiteReference
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CiteReference -> c CiteReference
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CiteReference)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CiteReference)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CiteReference -> m CiteReference
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CiteReference -> m CiteReference
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CiteReference -> m CiteReference
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CiteReference -> m CiteReference
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CiteReference -> m CiteReference
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CiteReference -> m CiteReference
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CiteReference -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CiteReference -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CiteReference -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CiteReference -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CiteReference -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CiteReference -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CiteReference -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CiteReference -> r
gmapT :: (forall b. Data b => b -> b) -> CiteReference -> CiteReference
$cgmapT :: (forall b. Data b => b -> b) -> CiteReference -> CiteReference
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CiteReference)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CiteReference)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CiteReference)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CiteReference)
dataTypeOf :: CiteReference -> DataType
$cdataTypeOf :: CiteReference -> DataType
toConstr :: CiteReference -> Constr
$ctoConstr :: CiteReference -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CiteReference
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CiteReference
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CiteReference -> c CiteReference
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CiteReference -> c CiteReference
Data, forall x. Rep CiteReference x -> CiteReference
forall x. CiteReference -> Rep CiteReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CiteReference x -> CiteReference
$cfrom :: forall x. CiteReference -> Rep CiteReference x
Generic)
  deriving anyclass (CiteReference -> ()
forall a. (a -> ()) -> NFData a
rnf :: CiteReference -> ()
$crnf :: CiteReference -> ()
NFData)