{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}

module Yi.Config.Default (defaultConfig) where


import           Lens.Micro.Platform ((.~))
import qualified Data.HashMap.Strict as HM
import           Data.Monoid
import           Paths_yi_core
import           System.FilePath

import           Yi.Buffer
import           Yi.Command          (cabalBuildE, cabalConfigureE, grepFind,
                                      makeBuild, reloadProjectE, searchSources,
                                      shell)
import           Yi.Config
import           Yi.Core             (errorEditor, quitEditor)
import           Yi.Editor
import           Yi.Eval             (publishedActions)
import           Yi.File
import qualified Yi.Interact         as I
import           Yi.Keymap
import           Yi.Keymap.Keys
import           Yi.Layout
import           Yi.Mode.Common      (fundamentalMode)
import qualified Yi.Rope             as R
import           Yi.Search
import           Yi.Style.Library
import           Yi.Utils

import           Yi.Types            ()

-- | List of published Actions

-- THIS MUST BE OF THE FORM:
-- ("symbol", box symbol")
-- ... so we can hope getting rid of this someday.
-- Failing to conform to this rule exposes the code to instant deletion.
--
-- TODO: String → Text/YiString
defaultPublishedActions :: HM.HashMap String Action
defaultPublishedActions :: HashMap String Action
defaultPublishedActions = [(String, Action)] -> HashMap String Action
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
    [
      (String
"atBoundaryB"            , (TextUnit -> Direction -> BufferM Bool) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box TextUnit -> Direction -> BufferM Bool
atBoundaryB)
    , (String
"cabalBuildE"            , (CommandArguments -> YiM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box CommandArguments -> YiM ()
cabalBuildE)
    , (String
"cabalConfigureE"        , (CommandArguments -> YiM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box CommandArguments -> YiM ()
cabalConfigureE)
    , (String
"closeBufferE"           , (Text -> EditorM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box Text -> EditorM ()
closeBufferE)
    , (String
"deleteB"                , (TextUnit -> Direction -> BufferM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box TextUnit -> Direction -> BufferM ()
deleteB)
    , (String
"deleteBlankLinesB"      , BufferM () -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box BufferM ()
deleteBlankLinesB)
    , (String
"getSelectRegionB"       , BufferM Region -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box BufferM Region
getSelectRegionB)
    , (String
"grepFind"               , ((String ::: FilePatternTag) -> (String ::: RegexTag) -> YiM ())
-> Action
forall x a. (Show x, YiAction a x) => a -> Action
box (String ::: FilePatternTag) -> (String ::: RegexTag) -> YiM ()
grepFind)
    , (String
"insertB"                , (Char -> BufferM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box Char -> BufferM ()
insertB)
    , (String
"leftB"                  , BufferM () -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box BufferM ()
leftB)
    , (String
"linePrefixSelectionB"   , (YiString -> BufferM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box YiString -> BufferM ()
linePrefixSelectionB)
    , (String
"lineStreamB"            , (Direction -> BufferM [YiString]) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box Direction -> BufferM [YiString]
lineStreamB)
--    , ("mkRegion"               , box mkRegion) -- can't make 'instance Promptable Region'
    , (String
"makeBuild"              , (CommandArguments -> YiM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box CommandArguments -> YiM ()
makeBuild)
    , (String
"moveB"                  , (TextUnit -> Direction -> BufferM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box TextUnit -> Direction -> BufferM ()
moveB)
    , (String
"numberOfB"              , (TextUnit -> TextUnit -> BufferM Int) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box TextUnit -> TextUnit -> BufferM Int
numberOfB)
    , (String
"pointB"                 , BufferM Point -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box BufferM Point
pointB)
    , (String
"regionOfB"              , (TextUnit -> BufferM Region) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box TextUnit -> BufferM Region
regionOfB)
    , (String
"regionOfPartB"          , (TextUnit -> Direction -> BufferM Region) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box TextUnit -> Direction -> BufferM Region
regionOfPartB)
    , (String
"regionOfPartNonEmptyB"  , (TextUnit -> Direction -> BufferM Region) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box TextUnit -> Direction -> BufferM Region
regionOfPartNonEmptyB)
    , (String
"reloadProjectE"         , (String -> YiM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box String -> YiM ()
reloadProjectE)
    , (String
"replaceString"          , (YiString -> YiString -> BufferM Int) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box YiString -> YiString -> BufferM Int
replaceString)
    , (String
"revertE"                , YiM () -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box YiM ()
revertE)
    , (String
"shell"                  , YiM BufferRef -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box YiM BufferRef
shell)
    , (String
"searchSources"          , ((String ::: RegexTag) -> YiM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box (String ::: RegexTag) -> YiM ()
searchSources)
    , (String
"setAnyMode"             , (AnyMode -> BufferM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box AnyMode -> BufferM ()
setAnyMode)
    , (String
"sortLines"              , BufferM () -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box BufferM ()
sortLines)
    , (String
"unLineCommentSelectionB", (YiString -> YiString -> BufferM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box YiString -> YiString -> BufferM ()
unLineCommentSelectionB)
    , (String
"writeB"                 , (Char -> BufferM ()) -> Action
forall x a. (Show x, YiAction a x) => a -> Action
box Char -> BufferM ()
writeB)
    ]

  where
    box :: (Show x, YiAction a x) => a -> Action
    box :: a -> Action
box = a -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction


defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
  (HashMap String Action -> Identity (HashMap String Action))
-> Config -> Identity Config
Field (HashMap String Action)
publishedActions ((HashMap String Action -> Identity (HashMap String Action))
 -> Config -> Identity Config)
-> HashMap String Action -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HashMap String Action
defaultPublishedActions (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$
  Config :: UIBoot
-> UIConfig
-> [Action]
-> [Action]
-> KeymapSet
-> P Event Event
-> [AnyMode]
-> Bool
-> RegionStyle
-> Bool
-> Bool
-> Seq (Seq Update -> BufferM ())
-> [AnyLayoutManager]
-> DynamicState
-> Config
Config { startFrontEnd :: UIBoot
startFrontEnd    = String -> UIBoot
forall a. HasCallStack => String -> a
error String
"panic: no frontend compiled in! (configure with -fvty or another frontend.)"
         , configUI :: UIConfig
configUI         =  UIConfig :: Maybe String
-> Maybe Int
-> Maybe ScrollStyle
-> Int
-> Bool
-> Bool
-> Bool
-> Bool
-> CursorStyle
-> Char
-> Theme
-> Bool
-> UIConfig
UIConfig
           { configFontSize :: Maybe Int
configFontSize = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10
           , configFontName :: Maybe String
configFontName = Maybe String
forall a. Maybe a
Nothing
           , configScrollWheelAmount :: Int
configScrollWheelAmount = Int
4
           , configScrollStyle :: Maybe ScrollStyle
configScrollStyle = Maybe ScrollStyle
forall a. Maybe a
Nothing
           , configCursorStyle :: CursorStyle
configCursorStyle = CursorStyle
FatWhenFocusedAndInserting
           , configLineWrap :: Bool
configLineWrap = Bool
True
           , configLeftSideScrollBar :: Bool
configLeftSideScrollBar = Bool
True
           , configAutoHideScrollBar :: Bool
configAutoHideScrollBar = Bool
False
           , configAutoHideTabBar :: Bool
configAutoHideTabBar = Bool
True
           , configWindowFill :: Char
configWindowFill = Char
' '
           , configTheme :: Theme
configTheme = Theme
defaultTheme
           , configLineNumbers :: Bool
configLineNumbers = Bool
False
           }
         , defaultKm :: KeymapSet
defaultKm        = Keymap -> KeymapSet
modelessKeymapSet Keymap
nilKeymap
         , startActions :: [Action]
startActions     = [Action]
forall a. Monoid a => a
mempty
         , initialActions :: [Action]
initialActions   = [Action]
forall a. Monoid a => a
mempty
         , modeTable :: [AnyMode]
modeTable = [Mode Any -> AnyMode
forall syntax. Mode syntax -> AnyMode
AnyMode Mode Any
forall syntax. Mode syntax
fundamentalMode]
         , debugMode :: Bool
debugMode = Bool
False
         , configKillringAccumulate :: Bool
configKillringAccumulate = Bool
False
         , configCheckExternalChangesObsessively :: Bool
configCheckExternalChangesObsessively = Bool
True
         , configRegionStyle :: RegionStyle
configRegionStyle = RegionStyle
Exclusive
         , configInputPreprocess :: P Event Event
configInputPreprocess = P Event Event
forall a. (Ord a, Eq a) => P a a
I.idAutomaton
         , bufferUpdateHandler :: Seq (Seq Update -> BufferM ())
bufferUpdateHandler = Seq (Seq Update -> BufferM ())
forall a. Monoid a => a
mempty
         , layoutManagers :: [AnyLayoutManager]
layoutManagers = [Int -> AnyLayoutManager
hPairNStack Int
1, Int -> AnyLayoutManager
vPairNStack Int
1, AnyLayoutManager
tall, AnyLayoutManager
wide]
         , configVars :: DynamicState
configVars = DynamicState
forall a. Monoid a => a
mempty
         }

nilKeymap :: Keymap
nilKeymap :: Keymap
nilKeymap = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [
             Char -> Event
char Char
'q' Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
quitEditor,
             Char -> Event
char Char
'h' Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
configHelp
            ]
            Keymap -> Keymap -> Keymap
forall (f :: * -> *) w e a.
MonadInteract f w e =>
f a -> f a -> f a
<|| (I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
m event
anyEvent I Event Action Event -> YiM () -> Keymap
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! Text -> YiM ()
errorEditor Text
"Keymap not defined, 'q' to quit, 'h' for help.")
    where
      configHelp :: YiM ()
      configHelp :: YiM ()
configHelp = do
        String
dataDir <- IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO String
getDataDir
        let String
x <//> :: String -> String -> YiString
<//> String
y = String -> YiString
R.fromString (String
x String -> String -> String
</> String
y)
            welcomeText :: YiString
welcomeText = [YiString] -> YiString
R.unlines
              [ YiString
"This instance of Yi is not configured."
              , YiString
""
              , YiString
"To get a standard reasonable keymap, you can run yi with"
              , YiString
"either --as=cua, --as=vim or --as=emacs."
              , YiString
""
              , YiString
"You should however create your own ~/.config/yi/yi.hs file."
              , YiString
"As a starting point it's recommended to use one of the configs"
              , YiString
"from " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> (String
dataDir String -> String -> YiString
<//> String
"example-configs/")
              , YiString
""
              ]
        EditorM BufferRef -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m ()
withEditor_ (EditorM BufferRef -> YiM ()) -> EditorM BufferRef -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferId -> YiString -> EditorM BufferRef
newBufferE (Text -> BufferId
MemBuffer Text
"configuration help") YiString
welcomeText