judgmentphile-cli/src/Judgmentphile/CLI.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE NoMonomorphismRestriction #-}
   4 {-# LANGUAGE TypeApplications #-}
   5 {-# LANGUAGE NamedFieldPuns #-}
   6 {-# OPTIONS_GHC -Wno-missing-signatures #-}
   7 module Judgmentphile.CLI where
   8
   9 import Control.Monad (Monad(..))
  10 import Data.Bool
  11 import Data.Function (($))
  12 import Data.Semigroup (Semigroup(..))
  13 import Data.Text (Text)
  14 import Data.Void (Void)
  15 import Symantic.CLI as CLI
  16 import qualified Data.Text as Text
  17 import qualified Data.Version as Version
  18 import qualified Paths_judgmentphile_cli as Judgmentphile
  19 import qualified Symantic.Document as Doc
  20
  21 import Judgmentphile.CLI.Utils
  22 import Judgmentphile.CLI.Administrator
  23 import Judgmentphile.CLI.Registrar
  24 import Judgmentphile.CLI.Trustee
  25 import Judgmentphile.CLI.Voter
  26
  27 progname :: Text
  28 progname = "judgmentphile"
  29
  30 api =
  31         program "judgmentphile" $
  32                 (api_options <?> api_agent) <!>
  33                 api_help True <!>
  34                 api_version
  35 run =
  36         run_agent :!:
  37         run_help api :!:
  38         run_version
  39
  40 api_agent =
  41         rule "AGENT" $
  42                 api_administrator <!>
  43                 api_trustee <!>
  44                 api_registrar <!>
  45                 api_voter
  46 run_agent params =
  47         run_administrator params :!:
  48         run_trustee params :!:
  49         run_registrar params :!:
  50         run_voter params
  51
  52 api_version =
  53         "Print the version."
  54         `helps`
  55         tag (TagLong "version") nothing
  56         <.> response @Doc
  57 run_version =
  58         return (Doc.from version <> Doc.newline)
  59 version :: Text
  60 version =
  61         progname <> "-" <>
  62         Text.pack (Version.showVersion Judgmentphile.version)
  63
  64 parseAPI = parser @Void @Doc api run