{-# OPTIONS_GHC -Wall #-}

module Text.Pandoc.Z.TabStop where

import Control.Lens ( Lens', Prism' )
import Text.Pandoc.Options(ReaderOptions(..), WriterOptions(..))

class HasTabStop a where
  tabStop ::
    Lens' a Int

instance HasTabStop Int where
  tabStop :: Lens' Int Int
tabStop =
    (Int -> f Int) -> Int -> f Int
forall a. a -> a
id

class AsTabStop a where
  _TabStop ::
    Prism' a Int

instance AsTabStop Int where
  _TabStop :: Prism' Int Int
_TabStop =
    p Int (f Int) -> p Int (f Int)
forall a. a -> a
id

instance HasTabStop ReaderOptions where
  tabStop :: Lens' ReaderOptions Int
tabStop Int -> f Int
f (ReaderOptions Extensions
e Bool
s Int
c Int
t [Text]
i Set Text
a Text
g TrackChanges
h Bool
m) =
    (Int -> ReaderOptions) -> f Int -> f ReaderOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
t' -> Extensions
-> Bool
-> Int
-> Int
-> [Text]
-> Set Text
-> Text
-> TrackChanges
-> Bool
-> ReaderOptions
ReaderOptions Extensions
e Bool
s Int
c Int
t' [Text]
i Set Text
a Text
g TrackChanges
h Bool
m) (Int -> f Int
f Int
t)

instance HasTabStop WriterOptions where
  tabStop :: Lens' WriterOptions Int
tabStop Int -> f Int
f (WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02 Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) =
    (Int -> WriterOptions) -> f Int -> f WriterOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
a02' -> Maybe (Template Text)
-> Context Text
-> Int
-> Bool
-> Bool
-> HTMLMathMethod
-> Bool
-> [Int]
-> Bool
-> Extensions
-> Bool
-> Int
-> WrapOption
-> Int
-> ObfuscationMethod
-> Text
-> CiteMethod
-> Bool
-> Maybe Int
-> TopLevelDivision
-> Bool
-> Maybe Style
-> Bool
-> Bool
-> Text
-> Maybe Text
-> [FilePath]
-> Bool
-> Int
-> PathTemplate
-> Int
-> Maybe FilePath
-> ReferenceLocation
-> SyntaxMap
-> Bool
-> WriterOptions
WriterOptions Maybe (Template Text)
a00 Context Text
a01 Int
a02' Bool
a03 Bool
a04 HTMLMathMethod
a05 Bool
a06 [Int]
a07 Bool
a08 Extensions
a09 Bool
a10 Int
a11 WrapOption
a12 Int
a13 ObfuscationMethod
a14 Text
a15 CiteMethod
a16 Bool
a17 Maybe Int
a18 TopLevelDivision
a19 Bool
a20 Maybe Style
a21 Bool
a22 Bool
a23 Text
a24 Maybe Text
a25 [FilePath]
a26 Bool
a27 Int
a28 PathTemplate
a29 Int
a30 Maybe FilePath
a31 ReferenceLocation
a32 SyntaxMap
a33 Bool
a34) (Int -> f Int
f Int
a02)