{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Vgrep.Environment.Config.Sources.File
( configFromFile
, Attr
, Color
, Style
) where
import Control.Monad ((<=<))
import Control.Monad.IO.Class
import Data.Aeson.Types
( FromJSON (..)
, Options (..)
, Parser
, camelTo
, defaultOptions
, genericParseJSON
, withObject
, (.!=)
, (.:?)
)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import Data.Yaml.Aeson
( decodeFileEither
, prettyPrintParseException
)
import GHC.Generics
import qualified Graphics.Vty.Attributes as Vty
import System.Directory
import System.IO
import Text.Read (readMaybe)
import Vgrep.Command
import Vgrep.Environment.Config.Monoid
import qualified Vgrep.Key as Key
import Vgrep.KeybindingMap
configFromFile :: MonadIO io => io ConfigMonoid
configFromFile :: io ConfigMonoid
configFromFile = IO ConfigMonoid -> io ConfigMonoid
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConfigMonoid -> io ConfigMonoid)
-> IO ConfigMonoid -> io ConfigMonoid
forall a b. (a -> b) -> a -> b
$ do
FilePath
configDir <- FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"vgrep"
let configFiles :: [FilePath]
configFiles = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
configDir FilePath -> FilePath -> FilePath
</>)
[ FilePath
"config.yaml"
, FilePath
"config.yml"
, FilePath
"config.json"
, FilePath
"config" ]
[FilePath] -> IO (Maybe FilePath)
findExistingFile [FilePath]
configFiles IO (Maybe FilePath)
-> (Maybe FilePath -> IO ConfigMonoid) -> IO ConfigMonoid
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing -> ConfigMonoid -> IO ConfigMonoid
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigMonoid
forall a. Monoid a => a
mempty
Just FilePath
configFile -> FilePath -> IO (Either ParseException ConfigMonoid)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
configFile IO (Either ParseException ConfigMonoid)
-> (Either ParseException ConfigMonoid -> IO ConfigMonoid)
-> IO ConfigMonoid
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right ConfigMonoid
config -> ConfigMonoid -> IO ConfigMonoid
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigMonoid
config
Left ParseException
err -> do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Could not parse config file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
configFile FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ParseException -> FilePath
prettyPrintParseException ParseException
err
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\nFalling back to default config."
ConfigMonoid -> IO ConfigMonoid
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigMonoid
forall a. Monoid a => a
mempty
where
findExistingFile :: [FilePath] -> IO (Maybe FilePath)
findExistingFile :: [FilePath] -> IO (Maybe FilePath)
findExistingFile = \case
[] -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
FilePath
f : [FilePath]
fs -> do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
f
if Bool
exists then Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f) else [FilePath] -> IO (Maybe FilePath)
findExistingFile [FilePath]
fs
(</>) :: FilePath -> FilePath -> FilePath
FilePath
dir </> :: FilePath -> FilePath -> FilePath
</> FilePath
file = FilePath
dir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
file
instance FromJSON ConfigMonoid where
parseJSON :: Value -> Parser ConfigMonoid
parseJSON = FilePath
-> (Object -> Parser ConfigMonoid) -> Value -> Parser ConfigMonoid
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"ConfigMonoid" ((Object -> Parser ConfigMonoid) -> Value -> Parser ConfigMonoid)
-> (Object -> Parser ConfigMonoid) -> Value -> Parser ConfigMonoid
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
ColorsMonoid
_mcolors <- Object
o Object -> Text -> Parser (Maybe ColorsMonoid)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"colors" Parser (Maybe ColorsMonoid) -> ColorsMonoid -> Parser ColorsMonoid
forall a. Parser (Maybe a) -> a -> Parser a
.!= ColorsMonoid
forall a. Monoid a => a
mempty
First Int
_mtabstop <- (Maybe Int -> First Int)
-> Parser (Maybe Int) -> Parser (First Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Int -> First Int
forall a. Maybe a -> First a
First (Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"tabstop")
First FilePath
_meditor <- (Maybe FilePath -> First FilePath)
-> Parser (Maybe FilePath) -> Parser (First FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe FilePath -> First FilePath
forall a. Maybe a -> First a
First (Object
o Object -> Text -> Parser (Maybe FilePath)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"editor")
KeybindingsMonoid
_mkeybindings <- Object
o Object -> Text -> Parser (Maybe KeybindingsMonoid)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"keybindings" Parser (Maybe KeybindingsMonoid)
-> KeybindingsMonoid -> Parser KeybindingsMonoid
forall a. Parser (Maybe a) -> a -> Parser a
.!= KeybindingsMonoid
forall a. Monoid a => a
mempty
ConfigMonoid -> Parser ConfigMonoid
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigMonoid :: ColorsMonoid
-> First Int -> First FilePath -> KeybindingsMonoid -> ConfigMonoid
ConfigMonoid{First Int
First FilePath
KeybindingsMonoid
ColorsMonoid
_mkeybindings :: KeybindingsMonoid
_meditor :: First FilePath
_mtabstop :: First Int
_mcolors :: ColorsMonoid
_mkeybindings :: KeybindingsMonoid
_meditor :: First FilePath
_mtabstop :: First Int
_mcolors :: ColorsMonoid
..}
instance FromJSON ColorsMonoid where
parseJSON :: Value -> Parser ColorsMonoid
parseJSON = Options -> Value -> Parser ColorsMonoid
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions
instance FromJSON Vty.Attr where
parseJSON :: Value -> Parser Attr
parseJSON = (Attr -> Attr) -> Parser Attr -> Parser Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attr -> Attr
attrToVty (Parser Attr -> Parser Attr)
-> (Value -> Parser Attr) -> Value -> Parser Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Attr
forall a. FromJSON a => Value -> Parser a
parseJSON
data Attr = Attr
{ Attr -> Maybe Color
foreColor :: Maybe Color
, Attr -> Maybe Color
backColor :: Maybe Color
, Attr -> Maybe Style
style :: Maybe Style
}
deriving (Attr -> Attr -> Bool
(Attr -> Attr -> Bool) -> (Attr -> Attr -> Bool) -> Eq Attr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attr -> Attr -> Bool
$c/= :: Attr -> Attr -> Bool
== :: Attr -> Attr -> Bool
$c== :: Attr -> Attr -> Bool
Eq, Int -> Attr -> FilePath -> FilePath
[Attr] -> FilePath -> FilePath
Attr -> FilePath
(Int -> Attr -> FilePath -> FilePath)
-> (Attr -> FilePath)
-> ([Attr] -> FilePath -> FilePath)
-> Show Attr
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Attr] -> FilePath -> FilePath
$cshowList :: [Attr] -> FilePath -> FilePath
show :: Attr -> FilePath
$cshow :: Attr -> FilePath
showsPrec :: Int -> Attr -> FilePath -> FilePath
$cshowsPrec :: Int -> Attr -> FilePath -> FilePath
Show, (forall x. Attr -> Rep Attr x)
-> (forall x. Rep Attr x -> Attr) -> Generic Attr
forall x. Rep Attr x -> Attr
forall x. Attr -> Rep Attr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attr x -> Attr
$cfrom :: forall x. Attr -> Rep Attr x
Generic)
instance FromJSON Attr where
parseJSON :: Value -> Parser Attr
parseJSON = Options -> Value -> Parser Attr
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions
attrToVty :: Attr -> Vty.Attr
attrToVty :: Attr -> Attr
attrToVty Attr{Maybe Style
Maybe Color
style :: Maybe Style
backColor :: Maybe Color
foreColor :: Maybe Color
style :: Attr -> Maybe Style
backColor :: Attr -> Maybe Color
foreColor :: Attr -> Maybe Color
..} = [Maybe (Attr -> Attr)] -> Attr
foldAttrs
[ (Color -> Attr -> Attr) -> Maybe Color -> Maybe (Attr -> Attr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Attr -> Color -> Attr) -> Color -> Attr -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Color -> Attr
Vty.withForeColor (Color -> Attr -> Attr)
-> (Color -> Color) -> Color -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Color
colorToVty) Maybe Color
foreColor
, (Color -> Attr -> Attr) -> Maybe Color -> Maybe (Attr -> Attr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Attr -> Color -> Attr) -> Color -> Attr -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Color -> Attr
Vty.withBackColor (Color -> Attr -> Attr)
-> (Color -> Color) -> Color -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Color
colorToVty) Maybe Color
backColor
, (Style -> Attr -> Attr) -> Maybe Style -> Maybe (Attr -> Attr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Attr -> Style -> Attr) -> Style -> Attr -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Style -> Attr
Vty.withStyle (Style -> Attr -> Attr)
-> (Style -> Style) -> Style -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Style
styleToVty) Maybe Style
style ]
where
foldAttrs :: [Maybe (Attr -> Attr)] -> Attr
foldAttrs = ((Attr -> Attr) -> Attr -> Attr) -> Attr -> [Attr -> Attr] -> Attr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Attr -> Attr) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
($) Attr
Vty.defAttr ([Attr -> Attr] -> Attr)
-> ([Maybe (Attr -> Attr)] -> [Attr -> Attr])
-> [Maybe (Attr -> Attr)]
-> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Attr -> Attr)] -> [Attr -> Attr]
forall a. [Maybe a] -> [a]
catMaybes
data Color
= Black
| Red
| Green
| Yellow
| Blue
| Magenta
| Cyan
| White
| BrightBlack
| BrightRed
| BrightGreen
| BrightYellow
| BrightBlue
| BrightMagenta
| BrightCyan
| BrightWhite
deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Int -> Color -> FilePath -> FilePath
[Color] -> FilePath -> FilePath
Color -> FilePath
(Int -> Color -> FilePath -> FilePath)
-> (Color -> FilePath)
-> ([Color] -> FilePath -> FilePath)
-> Show Color
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Color] -> FilePath -> FilePath
$cshowList :: [Color] -> FilePath -> FilePath
show :: Color -> FilePath
$cshow :: Color -> FilePath
showsPrec :: Int -> Color -> FilePath -> FilePath
$cshowsPrec :: Int -> Color -> FilePath -> FilePath
Show, (forall x. Color -> Rep Color x)
-> (forall x. Rep Color x -> Color) -> Generic Color
forall x. Rep Color x -> Color
forall x. Color -> Rep Color x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Color x -> Color
$cfrom :: forall x. Color -> Rep Color x
Generic)
instance FromJSON Color where
parseJSON :: Value -> Parser Color
parseJSON = Options -> Value -> Parser Color
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions
colorToVty :: Color -> Vty.Color
colorToVty :: Color -> Color
colorToVty = \case
Color
Black -> Color
Vty.black
Color
Red -> Color
Vty.red
Color
Green -> Color
Vty.green
Color
Yellow -> Color
Vty.yellow
Color
Blue -> Color
Vty.blue
Color
Magenta -> Color
Vty.magenta
Color
Cyan -> Color
Vty.cyan
Color
White -> Color
Vty.white
Color
BrightBlack -> Color
Vty.brightBlack
Color
BrightRed -> Color
Vty.brightRed
Color
BrightGreen -> Color
Vty.brightGreen
Color
BrightYellow -> Color
Vty.brightYellow
Color
BrightBlue -> Color
Vty.brightBlue
Color
BrightMagenta -> Color
Vty.brightMagenta
Color
BrightCyan -> Color
Vty.brightCyan
Color
BrightWhite -> Color
Vty.brightWhite
data Style
= Standout
| Underline
| ReverseVideo
| Blink
| Dim
| Bold
deriving (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq, Int -> Style -> FilePath -> FilePath
[Style] -> FilePath -> FilePath
Style -> FilePath
(Int -> Style -> FilePath -> FilePath)
-> (Style -> FilePath)
-> ([Style] -> FilePath -> FilePath)
-> Show Style
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Style] -> FilePath -> FilePath
$cshowList :: [Style] -> FilePath -> FilePath
show :: Style -> FilePath
$cshow :: Style -> FilePath
showsPrec :: Int -> Style -> FilePath -> FilePath
$cshowsPrec :: Int -> Style -> FilePath -> FilePath
Show, (forall x. Style -> Rep Style x)
-> (forall x. Rep Style x -> Style) -> Generic Style
forall x. Rep Style x -> Style
forall x. Style -> Rep Style x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Style x -> Style
$cfrom :: forall x. Style -> Rep Style x
Generic)
instance FromJSON Style where
parseJSON :: Value -> Parser Style
parseJSON = Options -> Value -> Parser Style
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions
styleToVty :: Style -> Vty.Style
styleToVty :: Style -> Style
styleToVty = \case
Style
Standout -> Style
Vty.standout
Style
Underline -> Style
Vty.underline
Style
ReverseVideo -> Style
Vty.reverseVideo
Style
Blink -> Style
Vty.blink
Style
Dim -> Style
Vty.dim
Style
Bold -> Style
Vty.bold
instance FromJSON KeybindingsMonoid where
parseJSON :: Value -> Parser KeybindingsMonoid
parseJSON = Options -> Value -> Parser KeybindingsMonoid
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions
instance FromJSON Command where
parseJSON :: Value -> Parser Command
parseJSON = Options -> Value -> Parser Command
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions
instance FromJSON KeybindingMap where
parseJSON :: Value -> Parser KeybindingMap
parseJSON = (Map Chord Command -> KeybindingMap)
-> Parser (Map Chord Command) -> Parser KeybindingMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Chord Command -> KeybindingMap
KeybindingMap (Parser (Map Chord Command) -> Parser KeybindingMap)
-> (Map FilePath Command -> Parser (Map Chord Command))
-> Map FilePath Command
-> Parser KeybindingMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Parser Chord)
-> Map FilePath Command -> Parser (Map Chord Command)
forall (m :: * -> *) k' k v.
(Monad m, Ord k') =>
(k -> m k') -> Map k v -> m (Map k' v)
mapMKeys FilePath -> Parser Chord
parseChord (Map FilePath Command -> Parser KeybindingMap)
-> (Value -> Parser (Map FilePath Command))
-> Value
-> Parser KeybindingMap
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser (Map FilePath Command)
forall a. FromJSON a => Value -> Parser a
parseJSON
mapMKeys :: (Monad m, Ord k') => (k -> m k') -> Map k v -> m (Map k' v)
mapMKeys :: (k -> m k') -> Map k v -> m (Map k' v)
mapMKeys k -> m k'
f = ([(k', v)] -> Map k' v) -> m [(k', v)] -> m (Map k' v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k', v)] -> Map k' v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (m [(k', v)] -> m (Map k' v))
-> (Map k v -> m [(k', v)]) -> Map k v -> m (Map k' v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> v -> m [(k', v)] -> m [(k', v)])
-> m [(k', v)] -> Map k v -> m [(k', v)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey k -> v -> m [(k', v)] -> m [(k', v)]
forall b. k -> b -> m [(k', b)] -> m [(k', b)]
go ([(k', v)] -> m [(k', v)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
where
go :: k -> b -> m [(k', b)] -> m [(k', b)]
go k
k b
x m [(k', b)]
mxs = do
k'
k' <- k -> m k'
f k
k
[(k', b)]
xs <- m [(k', b)]
mxs
[(k', b)] -> m [(k', b)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((k'
k', b
x) (k', b) -> [(k', b)] -> [(k', b)]
forall a. a -> [a] -> [a]
: [(k', b)]
xs)
parseChord :: String -> Parser Key.Chord
parseChord :: FilePath -> Parser Chord
parseChord = \case
Char
'C' : Char
'-' : FilePath
t -> (Chord -> Chord) -> Parser Chord -> Parser Chord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Chord -> Mod -> Chord
`Key.withModifier` Mod
Key.Ctrl) (FilePath -> Parser Chord
parseChord FilePath
t)
Char
'S' : Char
'-' : FilePath
t -> (Chord -> Chord) -> Parser Chord -> Parser Chord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Chord -> Mod -> Chord
`Key.withModifier` Mod
Key.Shift) (FilePath -> Parser Chord
parseChord FilePath
t)
Char
'M' : Char
'-' : FilePath
t -> (Chord -> Chord) -> Parser Chord -> Parser Chord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Chord -> Mod -> Chord
`Key.withModifier` Mod
Key.Meta) (FilePath -> Parser Chord
parseChord FilePath
t)
[Char
c] -> Chord -> Parser Chord
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> Chord
Key.key (Char -> Key
Key.Char Char
c))
FilePath
"PgUp" -> Chord -> Parser Chord
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> Chord
Key.key Key
Key.PageUp)
FilePath
"PgDown" -> Chord -> Parser Chord
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> Chord
Key.key Key
Key.PageDown)
FilePath
"PgDn" -> Chord -> Parser Chord
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> Chord
Key.key Key
Key.PageDown)
FilePath
s | Just Key
k <- FilePath -> Maybe Key
forall a. Read a => FilePath -> Maybe a
readMaybe FilePath
s
-> Chord -> Parser Chord
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> Chord
Key.key Key
k)
| Bool
otherwise -> FilePath -> Parser Chord
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Unknown key '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
s FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"'")
jsonOptions :: Options
jsonOptions :: Options
jsonOptions = Options
defaultOptions
{ constructorTagModifier :: FilePath -> FilePath
constructorTagModifier = Char -> FilePath -> FilePath
camelTo Char
'-'
, fieldLabelModifier :: FilePath -> FilePath
fieldLabelModifier = Char -> FilePath -> FilePath
camelTo Char
'-' (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
stripPrefix }
where
stripPrefix :: FilePath -> FilePath
stripPrefix = \case
Char
'_' : Char
'm' : FilePath
name -> FilePath
name
Char
'_' : FilePath
name -> FilePath
name
FilePath
name -> FilePath
name