scaffolder/app/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 module Main where
   4
   5 import           Text.Edifact.BundleReader (BundleReaderEnv (..), readBundle)
   6 import           Text.Edifact.Fetcher      (FetchingEnv (..), fetch,
   7                                             readSelectMessages)
   8 import           Text.Edifact.Scaffolder   (ScaffoldingEnv (..), scaffold)
   9
  10 import           Data.String               (fromString)
  11 import           Options.Applicative
  12
  13 main :: IO ()
  14 main = execParser argumentsParser >>= run
  15
  16 data Command = ScaffoldCommand ScaffoldingEnv
  17              | FetchCommand FetchingEnv
  18              | BundleReaderCommand BundleReaderEnv
  19
  20 commandParser :: Parser Command
  21 commandParser =
  22   let mkCommand cmd = command (commandName cmd) (info (commandArgumentsParser cmd) (describe cmd))
  23   in subparser (foldMap mkCommand [ Scaffold, Fetch, ReadBundle ])
  24
  25 data CommandType = Scaffold | Fetch | ReadBundle
  26
  27 run :: Command -> IO ()
  28 run (ScaffoldCommand     env) = scaffold env
  29 run (FetchCommand        env) = fetch env
  30 run (BundleReaderCommand env) = readBundle env
  31
  32 commandName :: CommandType -> String
  33 commandName Scaffold   = "scaffold"
  34 commandName Fetch      = "fetch"
  35 commandName ReadBundle = "read-bundle"
  36
  37 commandArgumentsParser :: CommandType -> Parser Command
  38 commandArgumentsParser Scaffold =
  39   let revisionArg      = strOption (long "revision"      <> metavar "REVISION")
  40       moduleNameArg    = strOption (long "module-name"   <> metavar "MODULE_NAME"   <> value "Text.Edifact")
  41       specificationArg = strOption (long "specification" <> metavar "SPECIFICATION" <> value "./specification")
  42       srcArg           = strOption (long "src"           <> metavar "SOURCES"       <> value "./src")
  43       debugParsingArg  = flag False True (long "debug-parsing")
  44       arguments = ScaffoldingEnv <$> revisionArg
  45                                  <*> (fromString <$> moduleNameArg)
  46                                  <*> specificationArg
  47                                  <*> srcArg
  48                                  <*> debugParsingArg
  49   in ScaffoldCommand <$> arguments
  50 commandArgumentsParser Fetch =
  51   let revisionArg         = strOption (long "revision"      <> metavar "REVISION")
  52       specificationArg    = strOption (long "specification" <> metavar "SPECIFICATION" <> value "./specification")
  53       selectedMessagesArg = readSelectMessages <$>
  54                               optional (strOption (long "messages" <> metavar "MESSAGES"))
  55       arguments = FetchingEnv <$> revisionArg
  56                               <*> specificationArg
  57                               <*> selectedMessagesArg
  58   in FetchCommand <$> arguments
  59 commandArgumentsParser ReadBundle =
  60   let revisionArg         = strOption (long "revision"      <> metavar "REVISION")
  61       specificationArg    = strOption (long "specification" <> metavar "SPECIFICATION" <> value "./specification")
  62       bundle           = many (strOption (long "bundle" <> metavar "BUNDLE"))
  63       messagesFiles    = many (strOption (long "message-file" <> metavar "MESSAGE_FILE"))
  64       selectedMessages = many (strOption (long "message" <> metavar "MESSAGE"))
  65       segmentsFiles    = many (strOption (long "segment-file" <> metavar "SEGMENT_FILE"))
  66       compositeFiles   = many (strOption (long "composite-file" <> metavar "COMPOSITE_FILE"))
  67       simpleFiles      = many (strOption (long "simple-file" <> metavar "SIMPLE_FILE"))
  68       codedSimpleFiles = many (strOption (long "coded-simple-file" <> metavar "CODED_SIMPLE_FILE"))
  69       arguments = BundleReaderEnv <$> revisionArg
  70                            <*> specificationArg
  71                            <*> bundle
  72                            <*> selectedMessages
  73                            <*> messagesFiles
  74                            <*> segmentsFiles
  75                            <*> compositeFiles
  76                            <*> simpleFiles
  77                            <*> codedSimpleFiles
  78   in BundleReaderCommand <$> arguments
  79
  80 describe :: CommandType -> InfoMod a
  81 describe Scaffold   = progDesc "Scaffold parsers from specification previously fetched"
  82 describe Fetch      = progDesc "Fetch specification from UN website (Deprecated! Use read-bundle instead)"
  83 describe ReadBundle = progDesc "Read specification bundle downloaded from UN website"
  84
  85 argumentsParser :: ParserInfo Command
  86 argumentsParser = info (commandParser <**> helper) cliDesc
  87
  88 cliDesc :: InfoMod a
  89 cliDesc = fullDesc
  90        <> header "Let you scaffold parsers from an Edifact specification"