packages feed

gtvm-hs-1.0.0: app/Common/CLIOptions.hs

{-# LANGUAGE AllowAmbiguousTypes #-}

module Common.CLIOptions where

import Common.Config
import GHC.TypeLits hiding ( Mod )
import Options.Applicative hiding ( str )
import GHC.Exts
import Data.Char qualified as Char

streamStdin :: forall s. Stream 'StreamIn s
streamStdin = StreamStd
streamStdout :: forall s. Stream 'StreamOut s
streamStdout = StreamStd

pStreamIn :: forall s. KnownSymbol s => Parser (Stream 'StreamIn s)
pStreamIn = (StreamFile' <$> pStreamFileIn) <|> pStdinOpt
  where
    pStdinOpt = flag' StreamStd $  long "stdin"
                                <> help ("Get "<>sym @s<>" from stdin")

pStreamOut :: forall s. KnownSymbol s => Parser (Stream 'StreamOut s)
pStreamOut = (StreamFile' <$> pStreamFileOut) <|> pure StreamStd
  where
    pStreamFileOut = StreamFile <$> strOption (modFileOut (sym @s))

pStreamFileIn :: forall s. KnownSymbol s => Parser (StreamFile 'StreamIn s)
pStreamFileIn = StreamFile <$> strArgument (modFileIn (sym @s))

pPrintBin :: Parser PrintBin
pPrintBin = flag NoPrintBin PrintBin $  long "print-binary"
                                     <> help "Allow printing binary to stdout"


-- | More succint 'symbolVal' via type application.
sym :: forall s. KnownSymbol s => String
sym = symbolVal' (proxy# :: Proxy# s)

-- | Generate a base 'Mod' for a file type using the given descriptive
--   name (the "type" of input, e.g. file format) and the given direction.
modFile :: HasMetavar f => String -> String -> Mod f a
modFile dirStr descStr =  metavar "FILE"
                       <> help (dirStr<>" "<>descStr')
  where
    descStr' = descStr<>" file"

modFileIn :: HasMetavar f => String -> Mod f a
modFileIn = modFile "Input"

modFileOut :: (HasMetavar f, HasName f) => String -> Mod f a
modFileOut s = modFile "Output" s <> long "out-file" <> short 'o'

metavarify :: String -> String
metavarify = map $ Char.toUpper . spaceToUnderscore
  where spaceToUnderscore = \case ' ' -> '_'; ch -> ch