{-# LANGUAGE OverloadedLists #-}

module Org.Parser.State where

import Data.Aeson qualified as Aeson
import Org.Types

-- | Collection of todo markers in the order in which items should progress
type TodoSequence = [TodoKeyword]

data OrgOptions = OrgOptions
  { OrgOptions -> Bool
orgSrcPreserveIndentation :: Bool
  , OrgOptions -> Int
orgSrcTabWidth :: Int
  , OrgOptions -> TodoSequence
orgTodoKeywords :: TodoSequence
  , OrgOptions -> Set Text
orgElementParsedKeywords :: Set Text
  , OrgOptions -> Set Text
orgElementDualKeywords :: Set Text
  , OrgOptions -> Set Text
orgElementAffiliatedKeywords :: Set Text
  }
  deriving (OrgOptions -> OrgOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgOptions -> OrgOptions -> Bool
$c/= :: OrgOptions -> OrgOptions -> Bool
== :: OrgOptions -> OrgOptions -> Bool
$c== :: OrgOptions -> OrgOptions -> Bool
Eq, Eq OrgOptions
OrgOptions -> OrgOptions -> Bool
OrgOptions -> OrgOptions -> Ordering
OrgOptions -> OrgOptions -> OrgOptions
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 :: OrgOptions -> OrgOptions -> OrgOptions
$cmin :: OrgOptions -> OrgOptions -> OrgOptions
max :: OrgOptions -> OrgOptions -> OrgOptions
$cmax :: OrgOptions -> OrgOptions -> OrgOptions
>= :: OrgOptions -> OrgOptions -> Bool
$c>= :: OrgOptions -> OrgOptions -> Bool
> :: OrgOptions -> OrgOptions -> Bool
$c> :: OrgOptions -> OrgOptions -> Bool
<= :: OrgOptions -> OrgOptions -> Bool
$c<= :: OrgOptions -> OrgOptions -> Bool
< :: OrgOptions -> OrgOptions -> Bool
$c< :: OrgOptions -> OrgOptions -> Bool
compare :: OrgOptions -> OrgOptions -> Ordering
$ccompare :: OrgOptions -> OrgOptions -> Ordering
Ord, Int -> OrgOptions -> ShowS
[OrgOptions] -> ShowS
OrgOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgOptions] -> ShowS
$cshowList :: [OrgOptions] -> ShowS
show :: OrgOptions -> String
$cshow :: OrgOptions -> String
showsPrec :: Int -> OrgOptions -> ShowS
$cshowsPrec :: Int -> OrgOptions -> ShowS
Show, Typeable, forall x. Rep OrgOptions x -> OrgOptions
forall x. OrgOptions -> Rep OrgOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrgOptions x -> OrgOptions
$cfrom :: forall x. OrgOptions -> Rep OrgOptions x
Generic)

instance Aeson.ToJSON OrgOptions where
  toJSON :: OrgOptions -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
aesonOptions
  toEncoding :: OrgOptions -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
aesonOptions

instance Aeson.FromJSON OrgOptions where
  parseJSON :: Value -> Parser OrgOptions
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
aesonOptions

instance NFData OrgOptions

defaultOrgOptions :: OrgOptions
defaultOrgOptions :: OrgOptions
defaultOrgOptions =
  OrgOptions
    { orgSrcPreserveIndentation :: Bool
orgSrcPreserveIndentation = Bool
False
    , orgSrcTabWidth :: Int
orgSrcTabWidth = Int
4
    , orgTodoKeywords :: TodoSequence
orgTodoKeywords = [TodoState -> Text -> TodoKeyword
TodoKeyword TodoState
Todo Text
"TODO", TodoState -> Text -> TodoKeyword
TodoKeyword TodoState
Done Text
"DONE"]
    , orgElementParsedKeywords :: Set Text
orgElementParsedKeywords = [Text
"caption", Text
"title", Text
"date", Text
"author"]
    , orgElementDualKeywords :: Set Text
orgElementDualKeywords = [Text
"caption", Text
"results"]
    , orgElementAffiliatedKeywords :: Set Text
orgElementAffiliatedKeywords = [Text
"caption", Text
"data", Text
"header", Text
"headers", Text
"label", Text
"name", Text
"plot", Text
"resname", Text
"result", Text
"source", Text
"srcname", Text
"tblname"]
    }

-- | Org-mode parser state
data OrgParserEnv = OrgParserEnv
  { OrgParserEnv -> OrgOptions
orgEnvOptions :: OrgOptions
  , OrgParserEnv -> Int
orgEnvIndentLevel :: Int
  }

-- | Org-mode parser state
newtype OrgParserState = OrgParserState
  { OrgParserState -> Maybe Char
orgStateLastChar :: Maybe Char
  }

defaultState :: OrgParserState
defaultState :: OrgParserState
defaultState =
  OrgParserState
    { orgStateLastChar :: Maybe Char
orgStateLastChar = forall a. Maybe a
Nothing
    }

defaultEnv :: OrgParserEnv
defaultEnv :: OrgParserEnv
defaultEnv =
  OrgParserEnv
    { orgEnvOptions :: OrgOptions
orgEnvOptions = OrgOptions
defaultOrgOptions
    , orgEnvIndentLevel :: Int
orgEnvIndentLevel = Int
0
    }

aesonOptions :: Aeson.Options
aesonOptions :: Options
aesonOptions =
  Options
Aeson.defaultOptions
    { fieldLabelModifier :: ShowS
Aeson.fieldLabelModifier = Char -> ShowS
Aeson.camelTo2 Char
'-'
    }