{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}

import BasePrelude hiding (option, toList)
import Prelude.Unicode
import Data.Monoid.Unicode ((∅), (⊕))
import Util (show', replace, replaceWith, escape, filterOnIndex, versionStr, (>$>))

import Control.Monad.Reader (runReaderT)
import Control.Monad.Writer (WriterT, execWriterT, tell)
import Data.Aeson (eitherDecode)
import qualified Data.ByteString as B (ByteString, readFile, writeFile)
import qualified Data.ByteString.Char8 as B8 (lines, unlines)
import Data.FileEmbed (embedFile)
import Data.IOData (IOData)
import qualified Data.Text as T (pack)
import qualified Data.Text.Encoding as T (encodeUtf8)
import Data.Time (getCurrentTime, formatTime)
import Data.Time.Format (defaultTimeLocale)
import Lens.Micro.Platform (view, over)
import Options.Applicative hiding (Mod)
import qualified Options.Applicative (Mod)
import System.Directory (getPermissions, setPermissions, setOwnerExecutable, createDirectoryIfMissing)
import System.FilePath ((</>), (<.>), takeExtension)
#ifdef mingw32_HOST_OS
import System.Process (callCommand)
#endif

import Ahk (printAhk, toAhk)
import FileType (FileType(..))
import JsonComments (removeJsonComments)
import JsonPretty (Config(..), encodePretty')
import Keylayout (KeylayoutConfig(..), printKeylayout, toKeylayout)
import Klc (KlcConfig(..), printKlcData, toKlcData)
import KlcParse (parseKlcLayout)
import Layout.Layout (isEmptyLayout, isEmptyVariant, layoutOrd, layoutDelims, applyModLayout, applyVariantLayout, removeEmptyLetters, unifyShiftstates)
import Layout.Mod (isEmptyMod, applyInverseMod)
import Layout.Types
import Pkl (printPklData, toPklData, printLayoutData, toLayoutData)
import PklParse (parsePklLayout)
import Stream (Stream(..), toFname, readStream, writeStream, writeFileStream, writeFileStream')
import Tmk (toTmkKeymap, printTmkKeymap)
import Xkb (XkbConfig(..), printSymbols, printTypes, printKeycodes, printXCompose, getFileAndVariant, parseXkbLayoutVariant)

data Options = Options
    { __inputType ∷ Maybe FileType
    , __inputs ∷ [Stream]
    , __outputs ∷ [Output]
    , __extraOptions ∷ [ExtraOption]
    } deriving (Show, Read)

data Output
    = Output FileType Stream
    | OutputAll Stream
    deriving (Show, Read)

data ExtraOption
    = RemoveShiftstates [Int]
    | RemoveEmptyLetters
    | CombineMods
    | UnifyShiftstates

    | KlcChainedDeads

    | PklCompact

    | XkbCustomShortcuts
    | XkbRedirectAll
    | XkbRedirectClearsExtend

    | KeylayoutCustomShortcuts
    deriving (Eq, Show, Read)

execOptions ∷ Options → IO ()
execOptions (Options _ [] _ _) = fail "no input files."
execOptions o@(Options Nothing (Standard:_) _ _) = execOptions o { __inputType = Just Json}
execOptions o@(Options Nothing (File fname:_) _ _) =
  case takeExtension fname of
    ".json"      → execOptions o { __inputType = Just Json }
    ""           → execOptions o { __inputType = Just Xkb }
    ".ini"       → execOptions o { __inputType = Just Pkl }
    ".klc"       → execOptions o { __inputType = Just Klc }
    ".keylayout" → execOptions o { __inputType = Just Keylayout }
    ".c"         → execOptions o { __inputType = Just Tmk }
    ".ahk"       → execOptions o { __inputType = Just Ahk }
    xs → fail ("unknown layout type ‘" ⊕ xs ⊕ "’.")
execOptions o@(Options _ _ [] _) = execOptions o { __outputs = [Output Json Standard] }
execOptions (Options (Just inputType) inputs outputs extraOptions) = printLog $ do
    layout' ← mconcat <$> traverse (input inputType) inputs
    let layout = execExtraOptions extraOptions ∘ layout'
    forM_ outputs (\out → output out extraOptions layout)

input ∷ (Logger m, MonadIO m) ⇒ FileType → Stream → m (FileType → Layout)
input Json = parseWith (\fname → bimap ((fname ⊕ ": ") ⊕) pure ∘ eitherDecode ∘ removeJsonComments)
input Xkb =
    getFileAndVariant ∘ toFname >>> (\(fname, variant) →
    parseWith (parseXkbLayoutVariant variant) (File fname)) >$> const
input Pkl = parseWith parsePklLayout >$> const
input Klc = parseWith parseKlcLayout >$> const
input Keylayout = const ∘ liftIO $ fail "importing from a keylayout file is not supported"
input Tmk = const ∘ liftIO $ fail "importing from a TMK file is not supported"
input Ahk = const ∘ liftIO $ fail "importing from a AHK file is not supported"

parseWith ∷ (Logger m, MonadIO m) ⇒ IOData α ⇒ (String → α → Either String (m β)) →
    Stream → m β
parseWith parser stream = flip ($) stream $
    readStream >=>
    parser (toFname stream) >>>
    either (liftIO ∘ fail ∘ ("parse fail in " ⊕) ∘ dropWhileEnd (≡'\n')) id

output ∷ (Logger m, MonadIO m) ⇒ Output → [ExtraOption] → (FileType → Layout) → m ()
output (OutputAll Standard) _ = const ∘ liftIO $ fail "everything as output must be written to a directory"
output (OutputAll (File dir)) extraOptions = \layout → do
    let name = view (_info ∘ _name) ∘ layout
    let output' t fname
          | isEmptyLayout (layout t) = tell ["ignoring empty layout for " ⊕ show' t]
          | otherwise = output (Output t (File fname)) extraOptions layout
    let fnameJson
          | null (name Json) = fail "the layout has an empty name when exported to JSON"
          | otherwise = name Json
    output' Json (dir </> fnameJson <.> "json")
    output' Xkb (dir </> "xkb")
    output' Pkl (dir </> "pkl")
    output' Klc (dir </> "klc")
    output' Keylayout (dir </> "keylayout")
    output' Tmk (dir </> "tmk")
    output' Ahk (dir </> "ahk")
output (Output Json stream) _ = ($ Json) >>>
    writeStream stream ∘ encodePretty' (Config 2 layoutOrd layoutDelims)
output (Output Xkb Standard) _ = const ∘ liftIO $ fail "XKB as output must be written to a directory"
output (Output Xkb (File dir)) extraOptions = ($ Xkb) >>> \layout → do
    let isAllowedChar c = isAlphaNum c || c ∈ "-_"
    let name = replaceWith (not ∘ isAllowedChar) '_' $ view (_info ∘ _name) layout
    let description = replace '\n' ' ' $ fromMaybe (view (_info ∘ _fullName) layout) (view (_info ∘ _description) layout)
    let mods = (\(Mod modName _) → replaceWith (not ∘ isAllowedChar) '_' modName) <$> view _mods layout
    let descriptionMods = (\(Mod modName _) → replace '\n' ' ' modName) <$> view _mods layout
    let variants = replaceWith (not ∘ isAllowedChar) '_' ∘ view (_info ∘ _name) ∘ variantToLayout <$> view _variants layout
    let descriptionVariants = replace '\n' ' ' ∘ view (_info ∘ _name) ∘ variantToLayout <$> view _variants layout
    when (null name) (liftIO $ fail "the layout has an empty name when exported to XKB")
    let xkbConfig = liftA3 XkbConfig (XkbCustomShortcuts ∈) (XkbRedirectAll ∈) (XkbRedirectClearsExtend ∈) extraOptions

    writeFileStream (dir </> "symbols" </> name) =<< runReaderT (printSymbols layout) xkbConfig
    writeFileStream' (dir </> "types" </> name) =<< runReaderT (printTypes layout) xkbConfig
    writeFileStream' (dir </> "keycodes" </> name) =<< printKeycodes layout
    writeFileStream' (dir </> "XCompose") (printXCompose layout)

    let replaceLayout = replaceVar "layout" [name]
    let replaceDescription = replaceVar "description" [description]
    let replaceMods = replaceVar "mods" mods
    let replaceDescriptionMods = replaceVar "description_mods" descriptionMods
    let replaceVariants = replaceVar "variants" variants
    let replaceDescriptionVariants = replaceVar "description_variants" descriptionVariants
    let replaceAll = replaceDescriptionVariants ∘ replaceVariants ∘ replaceDescriptionMods ∘ replaceMods ∘ replaceDescription ∘ replaceLayout

    let copyXkbFile replaceFunc defFile path = liftIO $ do
        file ← B.readFile ("xkb" </> path) <|> pure defFile
        B.writeFile (dir </> path) (replaceFunc file)
        makeExecutable (dir </> path)
    copyXkbFile replaceLayout defXkbSession "run-session.sh"
    copyXkbFile replaceAll defXkbSystem "install-system.sh"
    copyXkbFile replaceAll defXkbUSystem "uninstall-system.sh"
    liftIO $ createDirectoryIfMissing True (dir </> "scripts")
    copyXkbFile replaceLayout defXkbXCompose "scripts/install-xcompose.sh"
    copyXkbFile replaceLayout defXkbUXCompose "scripts/uninstall-xcompose.sh"
    copyXkbFile id defXkbXml "scripts/add-layout-to-xml.py"
    copyXkbFile id defXkbRemoveXml "scripts/remove-layout-from-xml.py"
    copyXkbFile id defXkbFunctions "scripts/functions.sh"
    copyXkbFile id defXkbModelsXml "scripts/add-models-to-xml.py"
    copyXkbFile id defXkbRemoveModelsXml "scripts/remove-models-from-xml.py"
output (Output Pkl Standard) _ = const ∘ liftIO $ fail "PKL as output must be written to a directory"
output (Output Pkl (File dir)) extraOptions = ($ Pkl) >>> \layout → do
    let name = view (_info ∘ _name) layout
    when (null name) (liftIO $ fail "the layout has an empty name when exported to PKL")
    let isCompact = PklCompact ∈ extraOptions
    today ← liftIO $ formatTime defaultTimeLocale "%F %T" <$> getCurrentTime
    let printedPklData l = printPklData isCompact <$> toPklData l l
    let printedLayoutData l = printLayoutData today <$> toLayoutData l
    let layoutFile modName l
          | isCompact = dir </> ("layout" ⊕ modName) <.> "ini"
          | otherwise = dir </> "layouts" </> view (_info ∘ _name) l </> "layout" <.> "ini"
    forM_ ((∅) : view _variants layout) $ \variant → do
        let nameV = bool ('_':view (_info ∘ _name) (variantToLayout variant)) "" (isEmptyVariant variant)
        forM_ ((∅) : view _mods layout) $ \layoutMod@(Mod nameM _) → do
            let nameM' = bool ('_':nameM) "" (isEmptyMod layoutMod)
            let layout' = applyModLayout layoutMod ∘ applyVariantLayout variant $ layout
            let name' = nameV ⊕ nameM'
            writeFileStream (dir </> ("pkl" ⊕ name') <.> "ini") =<< printedPklData layout'
            writeFileStream (layoutFile name' layout') =<< printedLayoutData layout'
    pklFile ← liftIO $ B.readFile "pkl/pkl.exe" <|> pure defPklFile
    liftIO $ B.writeFile (dir </> "pkl.exe") pklFile
output (Output Klc Standard) extraOptions = ($ Klc) >>>
    let klcConfig = KlcConfig (KlcChainedDeads ∈ extraOptions)
    in  writeStream Standard ∘ printKlcData <=< flip runReaderT klcConfig ∘ toKlcData
output (Output Klc (File dir)) extraOptions = ($ Klc) >>> \layout → do
    let name = view (_info ∘ _name) layout
    when (null name) (liftIO $ fail "the layout has an empty name when exported to KLC")
    let klcConfig = KlcConfig (KlcChainedDeads ∈ extraOptions)
    let fname l = dir </> view (_info ∘ _name) l <.> "klc"
    forM_ ((∅) : view _variants layout) $ \variant → do
        forM_ ((∅) : view _mods layout) $ \layoutMod → do
            let layout' = applyModLayout layoutMod ∘ applyVariantLayout variant $ layout
            writeFileStream (fname layout') ∘ printKlcData =<< runReaderT (toKlcData layout') klcConfig
output (Output Keylayout Standard) extraOptions = ($ Keylayout) >>>
    toKeylayout (KeylayoutConfig (KeylayoutCustomShortcuts ∈ extraOptions)) >=>
    writeStream Standard ∘ printKeylayout
output (Output Keylayout (File dir)) extraOptions = ($ Keylayout) >>> \layout → do
    let name = view (_info ∘ _name) layout
    when (null name) (liftIO $ fail "the layout has an empty name when exported to keylayout")
    let keylayoutConfig = KeylayoutConfig (KeylayoutCustomShortcuts ∈ extraOptions)
    let fname l = dir </> view (_info ∘ _name) l <.> "keylayout"
    forM_ ((∅) : view _variants layout) $ \variant → do
        forM_ ((∅) : view _mods layout) $ \layoutMod → do
            let layout' = applyModLayout layoutMod ∘ applyVariantLayout variant $ layout
            writeFileStream (fname layout') ∘ printKeylayout =<< toKeylayout keylayoutConfig layout'
    let replaceLayout = replaceVar "layout" [name]
    userFile   ← liftIO $ B.readFile "keylayout/install-user.sh"   <|> pure defKeylayoutUser
    systemFile ← liftIO $ B.readFile "keylayout/install-system.sh" <|> pure defKeylayoutSystem
    liftIO $ B.writeFile (dir </> "install-user.sh")   (replaceLayout userFile)
    liftIO $ B.writeFile (dir </> "install-system.sh") (replaceLayout systemFile)
    liftIO $ makeExecutable (dir </> "install-user.sh")
    liftIO $ makeExecutable (dir </> "install-system.sh")
output (Output Tmk Standard) _ = const ∘ liftIO $ fail "TMK as output must be written to a directory"
output (Output Tmk (File dir)) _ = ($ Tmk) >>> \layout → do
    let name = view (_info ∘ _name) layout
    when (null name) (error "the layout has an empty name when exported to TMK")
    let fname l = dir </> ("unimap_" ⊕ view (_info ∘ _name) l) <.> "c"
    forM_ ((∅) : view _variants layout) $ \variant → do
        forM_ ((∅) : view _mods layout) $ \layoutMod → do
            let layout' = applyModLayout layoutMod ∘ applyVariantLayout variant $ layout
            writeFileStream (fname layout') ∘ printTmkKeymap =<< toTmkKeymap layout'
output (Output Ahk Standard) _ = ($ Ahk) >>>
    writeStream Standard ∘ printAhk <=< toAhk id
output (Output Ahk (File dir)) _ = ($ Ahk) >>> \layout → do
    let name = view (_info ∘ _name) layout
    when (null name) (liftIO $ fail "the layout has an empty name when exported to AHK")
    let fname l = dir </> view (_info ∘ _name) l <.> "ahk"
    forM_ ((∅) : view _variants layout) $ \variant → do
        forM_ ((∅) : view _mods layout) $ \layoutMod → do
            let layout' = applyModLayout layoutMod ∘ applyVariantLayout variant $ layout
            let getOrigPos = applyInverseMod layoutMod
            writeFileStream (fname layout') ∘ printAhk =<< toAhk getOrigPos layout'

replaceVar ∷ B.ByteString → [String] → B.ByteString → B.ByteString
replaceVar var vals = B8.unlines ∘ replace before after ∘ B8.lines
  where
    before = var ⊕ "=\"\""
    after  = var ⊕ "=\"" ⊕ T.encodeUtf8 (T.pack (intercalate "\n" (map escape vals))) ⊕ "\""

makeExecutable ∷ FilePath → IO ()
makeExecutable fname =
    getPermissions fname >>=
    setPermissions fname ∘ setOwnerExecutable True

defPklFile,
    defXkbSession, defXkbSystem, defXkbUSystem, defXkbXCompose, defXkbUXCompose,
    defXkbXml, defXkbRemoveXml, defXkbFunctions, defXkbModelsXml, defXkbRemoveModelsXml,
    defKeylayoutUser, defKeylayoutSystem ∷ B.ByteString
defPklFile = $(embedFile "files/pkl/pkl.exe")
defXkbSession   = $(embedFile "files/xkb/run-session.sh")
defXkbSystem    = $(embedFile "files/xkb/install-system.sh")
defXkbUSystem   = $(embedFile "files/xkb/uninstall-system.sh")
defXkbXCompose  = $(embedFile "files/xkb/scripts/install-xcompose.sh")
defXkbUXCompose = $(embedFile "files/xkb/scripts/uninstall-xcompose.sh")
defXkbXml       = $(embedFile "files/xkb/scripts/add-layout-to-xml.py")
defXkbRemoveXml = $(embedFile "files/xkb/scripts/remove-layout-from-xml.py")
defXkbFunctions = $(embedFile "files/xkb/scripts/functions.sh")
defXkbModelsXml = $(embedFile "files/xkb/scripts/add-models-to-xml.py")
defXkbRemoveModelsXml = $(embedFile "files/xkb/scripts/remove-models-from-xml.py")
defKeylayoutUser   = $(embedFile "files/keylayout/install-user.sh")
defKeylayoutSystem = $(embedFile "files/keylayout/install-system.sh")

execExtraOptions ∷ [ExtraOption] → Layout → Layout
execExtraOptions = flip (foldr execExtraOption)

execExtraOption ∷ ExtraOption → Layout → Layout
execExtraOption (RemoveShiftstates cols) =
    over (_keys ∘ traverse)
        (over _letters (filterOnIndex (∉ cols)) ∘
         over _shiftlevels (filterOnIndex (∉ cols)))
execExtraOption RemoveEmptyLetters = over (_keys ∘ traverse) removeEmptyLetters
execExtraOption CombineMods =
    over _mods (map mconcat ∘ tail ∘ subsequences)
execExtraOption UnifyShiftstates = over _keys (fst ∘ unifyShiftstates)
execExtraOption _ = id

printLog ∷ WriterT [String] IO () → IO ()
printLog =
    execWriterT >=>
    traverse_ (\xs → hPutStrLn stderr $ "klfc: warning: " ⊕ xs ⊕ ".") ∘ nub

main ∷ IO ()
main =
#ifdef mingw32_HOST_OS
    callCommand "chcp 65001" >>
#endif
    (execParser opts >>= execOptions) `catch` handler
  where
    opts = info (helper <*> versionOption <*> options)
      ( fullDesc
      ⊕ header "Keyboard Layout Files Creator - export a keyboard layout to different formats"
      )
    versionOption = infoOption versionStr (long "version" ⊕ hidden ⊕ help "Show version")
    handler e
      | isUserError e = putStrLn ("klfc: " ⊕ ioeGetErrorString e)
      | otherwise = ioError e

options ∷ Parser Options
options = Options
    <$> (usageText "IMPORT TYPE" *> headerStr "\n\b\bImport types:" *> optional parseInputType)
    <*> (headerStr "\n\b\bImport files:" *> some parseInput)
    <*> (usageText "OUTPUTS" *> headerStr "\n\b\bOutput files:" *> many parseOutput)
    <*> (usageText "OPTIONS" *> headerStr "\n\b\bExtra Options:" *> (many ∘ asum)
            [ parseExtraOption
            , headerStr "\b\bKLC:" *> parseKlcOption
            , headerStr "\b\bPKL:" *> parsePklOption
            , headerStr "\b\bXKB:" *> parseXkbOption
            , headerStr "\b\bKeylayout:" *> parseKeylayoutOption
            ]
        )

parseInputType ∷ Parser FileType
parseInputType = asum
    [ flag' Json (long "from-json" ⊕ hidden ⊕ help "Read from a JSON file")
    , flag' Xkb (long "from-xkb" ⊕ hidden ⊕ help "Import from a XKB symbols file. To read a variant, append it in parenthesis (e.g. to read the Colemak variant of the us symbols file, use \"us(colemak)\").")
    , flag' Pkl (long "from-pkl" ⊕ hidden ⊕ help "Import from a PKL layout file")
    , flag' Klc (long "from-klc" ⊕ hidden ⊕ help "Import from a KLC file")
    ]

parseInput ∷ Parser Stream
parseInput =
    argument (parseStream <$> str) (metavar "FILE..." ⊕ help "Files to read (‘-’ for stdin). If multiple files are read, the corresponding layouts will be put together. This is useful when a file only specifies a part of the layout (e.g. only the letters at a few shiftstates).")

parseOutput ∷ Parser Output
parseOutput = asum
    [ Output Json <$> streamOption (long "json" ⊕ metavar "FILE" ⊕ hidden ⊕ help "Save to a JSON file (‘-’ for stdout)")
    , Output Xkb <$> streamOption (long "xkb" ⊕ metavar "DIRECTORY" ⊕ hidden ⊕ help "Export to a XKB directory")
    , Output Pkl <$> streamOption (long "pkl" ⊕ metavar "DIRECTORY" ⊕ hidden ⊕ help "Export to a PKL directory")
    , Output Klc <$> streamOption (long "klc" ⊕ metavar "DIRECTORY" ⊕ hidden ⊕ help "Export to a KLC directory (‘-’ for printing the base layout to stdout)")
    , Output Keylayout <$> streamOption (long "keylayout" ⊕ metavar "DIRECTORY" ⊕ hidden ⊕ help "Export to a keylayout directory (‘-’ for printing the base layout to stdout)")
    , Output Tmk <$> streamOption (long "tmk" ⊕ metavar "DIRECTORY" ⊕ hidden ⊕ help "Export to a TMK directory (‘-’ for printing the base layout to stdout)")
    , Output Ahk <$> streamOption (long "ahk" ⊕ metavar "DIRECTORY" ⊕ hidden ⊕ help "Export to a AHK directory (‘-’ for printing the base layout to stdout)")
    , OutputAll <$> streamOption (long "output" ⊕ short 'o' ⊕ metavar "DIRECTORY" ⊕ hidden ⊕ help "Export to all file types")
    ]

parseExtraOption ∷ Parser ExtraOption
parseExtraOption = asum
    [ RemoveShiftstates <$> option (str >>= parseList) (long "remove-shiftstates" ⊕ metavar "INDEX" ⊕ hidden ⊕ help "Remove one or more shiftstates with their letters. The shiftstates are identified with their index (starting with 0). Multiple indices are seperated with a comma.")
    , flag' RemoveEmptyLetters (long "remove-empty-letters" ⊕ hidden ⊕ help "Remove empty letters at the end of each key")
    , flag' CombineMods (long "combine-mods" ⊕ hidden ⊕ help "Combine all the mods in the layout. For example, if the layout has the mods ‘Wide’ and ‘Angle’, a new mod ‘WideAngle’ will be created.")
    , flag' UnifyShiftstates (long "unify-shiftstates" ⊕ hidden ⊕ help "Change the shiftstates of all keys such that all keys have the same shiftstates")
    ]

parseKlcOption ∷ Parser ExtraOption
parseKlcOption =
    flag' KlcChainedDeads (long "klc-chained-deads" ⊕ hidden ⊕ help "Use chained dead keys in KLC. This requires alternative compilation, see <http://archives.miloush.net/michkap/archive/2011/04/16/10154700.html>.")

parsePklOption ∷ Parser ExtraOption
parsePklOption =
    flag' PklCompact (long "pkl-compact" ⊕ hidden ⊕ help "Set PKL to compact mode")

parseXkbOption ∷ Parser ExtraOption
parseXkbOption = asum
    [ flag' XkbCustomShortcuts (long "xkb-custom-shortcuts" ⊕ hidden ⊕ help "Use the shortcut positions from the ‘shortcutPos’ attributes for shortcuts in XKB")
    , flag' XkbCustomShortcuts (long "xkb-custom-shortcut-positions" ⊕ hidden)
    , flag' XkbRedirectAll (long "xkb-redirect-all" ⊕ hidden ⊕ help "Always use the ‘redirect’ action in XKB, if possible. This may help some programs detect special actions on different layers.")
    , flag' XkbRedirectClearsExtend (long "xkb-redirect-clears-extend" ⊕ hidden ⊕ help "Clear the extend modifier (LevelFive) in redirect actions. This may help some programs detect special actions on the extend layer.")
    , flag' XkbRedirectClearsExtend (long "xkb-redirect-if-extend" ⊕ hidden)
    ]

parseKeylayoutOption ∷ Parser ExtraOption
parseKeylayoutOption =
    flag' KeylayoutCustomShortcuts (long "keylayout-custom-shortcuts" ⊕ hidden ⊕ help "Use the shortcut positions from the ‘shortcutPos’ attributes for shortcuts in keylayout")

usageText ∷ String → Parser ()
usageText s = option disabled (value () ⊕ metavar s)

headerStr ∷ String → Parser ()
headerStr s = option disabled (value () ⊕ metavar s ⊕ hidden ⊕ helpDoc (pure (∅)))

streamOption ∷ Options.Applicative.Mod OptionFields Stream → Parser Stream
streamOption = option (parseStream <$> str)

parseList ∷ (MonadFail m, Read α) ⇒ String → m [α]
parseList s = either fail pure $ readEither ("[" ⊕ s ⊕ "]")

parseStream ∷ String → Stream
parseStream "-" = Standard
parseStream s   = File s
