module Ribosome.Data.ScratchOptions where

import Control.Lens (set)
import Prelude hiding (modify)

import Ribosome.Data.FloatOptions (FloatOptions)
import Ribosome.Data.Mapping (Mapping)
import Ribosome.Data.Syntax (Syntax)

data ScratchOptions =
  ScratchOptions {
    ScratchOptions -> Bool
_tab :: Bool,
    ScratchOptions -> Bool
_vertical :: Bool,
    ScratchOptions -> Bool
_wrap :: Bool,
    ScratchOptions -> Bool
_focus :: Bool,
    ScratchOptions -> Bool
_resize :: Bool,
    ScratchOptions -> Bool
_bottom :: Bool,
    ScratchOptions -> Bool
_modify :: Bool,
    ScratchOptions -> Maybe FloatOptions
_float :: Maybe FloatOptions,
    ScratchOptions -> Maybe Int
_size :: Maybe Int,
    ScratchOptions -> Maybe Int
_maxSize :: Maybe Int,
    ScratchOptions -> [Syntax]
_syntax :: [Syntax],
    ScratchOptions -> [Mapping]
_mappings :: [Mapping],
    ScratchOptions -> Text
_name :: Text
  }
  deriving (ScratchOptions -> ScratchOptions -> Bool
(ScratchOptions -> ScratchOptions -> Bool)
-> (ScratchOptions -> ScratchOptions -> Bool) -> Eq ScratchOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScratchOptions -> ScratchOptions -> Bool
$c/= :: ScratchOptions -> ScratchOptions -> Bool
== :: ScratchOptions -> ScratchOptions -> Bool
$c== :: ScratchOptions -> ScratchOptions -> Bool
Eq, Int -> ScratchOptions -> ShowS
[ScratchOptions] -> ShowS
ScratchOptions -> String
(Int -> ScratchOptions -> ShowS)
-> (ScratchOptions -> String)
-> ([ScratchOptions] -> ShowS)
-> Show ScratchOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScratchOptions] -> ShowS
$cshowList :: [ScratchOptions] -> ShowS
show :: ScratchOptions -> String
$cshow :: ScratchOptions -> String
showsPrec :: Int -> ScratchOptions -> ShowS
$cshowsPrec :: Int -> ScratchOptions -> ShowS
Show)

makeClassy ''ScratchOptions

defaultScratchOptions :: Text -> ScratchOptions
defaultScratchOptions :: Text -> ScratchOptions
defaultScratchOptions = Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe FloatOptions
-> Maybe Int
-> Maybe Int
-> [Syntax]
-> [Mapping]
-> Text
-> ScratchOptions
ScratchOptions Bool
False Bool
False Bool
False Bool
False Bool
True Bool
True Bool
False Maybe FloatOptions
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing [] []

instance Default ScratchOptions where
  def :: ScratchOptions
def = Text -> ScratchOptions
defaultScratchOptions Text
"scratch"

scratchFocus :: ScratchOptions -> ScratchOptions
scratchFocus :: ScratchOptions -> ScratchOptions
scratchFocus =
  ASetter ScratchOptions ScratchOptions Bool Bool
-> Bool -> ScratchOptions -> ScratchOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ScratchOptions ScratchOptions Bool Bool
forall c. HasScratchOptions c => Lens' c Bool
focus Bool
True

scratchSyntax :: [Syntax] -> ScratchOptions -> ScratchOptions
scratchSyntax :: [Syntax] -> ScratchOptions -> ScratchOptions
scratchSyntax =
  ASetter ScratchOptions ScratchOptions [Syntax] [Syntax]
-> [Syntax] -> ScratchOptions -> ScratchOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ScratchOptions ScratchOptions [Syntax] [Syntax]
forall c. HasScratchOptions c => Lens' c [Syntax]
syntax

scratchMappings :: [Mapping] -> ScratchOptions -> ScratchOptions
scratchMappings :: [Mapping] -> ScratchOptions -> ScratchOptions
scratchMappings =
  ASetter ScratchOptions ScratchOptions [Mapping] [Mapping]
-> [Mapping] -> ScratchOptions -> ScratchOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ScratchOptions ScratchOptions [Mapping] [Mapping]
forall c. HasScratchOptions c => Lens' c [Mapping]
mappings

scratchFloat :: FloatOptions -> ScratchOptions -> ScratchOptions
scratchFloat :: FloatOptions -> ScratchOptions -> ScratchOptions
scratchFloat =
  ASetter
  ScratchOptions
  ScratchOptions
  (Maybe FloatOptions)
  (Maybe FloatOptions)
-> Maybe FloatOptions -> ScratchOptions -> ScratchOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  ScratchOptions
  ScratchOptions
  (Maybe FloatOptions)
  (Maybe FloatOptions)
forall c. HasScratchOptions c => Lens' c (Maybe FloatOptions)
float (Maybe FloatOptions -> ScratchOptions -> ScratchOptions)
-> (FloatOptions -> Maybe FloatOptions)
-> FloatOptions
-> ScratchOptions
-> ScratchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatOptions -> Maybe FloatOptions
forall a. a -> Maybe a
Just

scratchSize :: Int -> ScratchOptions -> ScratchOptions
scratchSize :: Int -> ScratchOptions -> ScratchOptions
scratchSize =
  ASetter ScratchOptions ScratchOptions (Maybe Int) (Maybe Int)
-> Maybe Int -> ScratchOptions -> ScratchOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ScratchOptions ScratchOptions (Maybe Int) (Maybe Int)
forall c. HasScratchOptions c => Lens' c (Maybe Int)
size (Maybe Int -> ScratchOptions -> ScratchOptions)
-> (Int -> Maybe Int) -> Int -> ScratchOptions -> ScratchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just

scratchModify :: ScratchOptions -> ScratchOptions
scratchModify :: ScratchOptions -> ScratchOptions
scratchModify =
  ASetter ScratchOptions ScratchOptions Bool Bool
-> Bool -> ScratchOptions -> ScratchOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ScratchOptions ScratchOptions Bool Bool
forall c. HasScratchOptions c => Lens' c Bool
modify Bool
True