{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances#-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeSynonymInstances #-}

module BNFC.Options
  ( Mode(..), Target(..), Backend
  , parseMode, usage, help
  , SharedOptions(..)
  , defaultOptions, isDefault, printOptions
  , AlexVersion(..), HappyMode(..), OCamlParser(..), JavaLexerParser(..)
  , RecordPositions(..), TokenText(..)
  , removedIn290
  , translateOldOptions
  )
  where

import qualified Control.Monad as Ctrl
import Control.Monad.Writer (WriterT, runWriterT, tell)
import Control.Monad.Except (MonadError(..))

import Data.Bifunctor
import Data.Either     (partitionEithers)
import qualified Data.Map  as Map
-- import qualified Data.List as List
import Data.Maybe      (fromMaybe, maybeToList)
import Data.Semigroup  (Semigroup(..))  -- for ghc 7.10
import Data.Version    (showVersion )

import System.Console.GetOpt
import System.FilePath (takeBaseName)

import Text.Printf     (printf)

import Paths_BNFC      (version)
import BNFC.CF         (CF)
import BNFC.Utils      (unless)

-- ~~~ Option data structures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- | To decouple the option parsing from the execution of the program,
-- we introduce a data structure that holds the result of the
-- parsing of the arguments.
data Mode
    -- An error has been made by the user
    -- e.g. invalid argument/combination of arguments
    = UsageError String
    -- Basic modes: print some info and exits
    | Help | License | Version
    -- Normal mode, specifying the back end to use,
    -- the option record to be passed to the backend
    -- and the path of the input grammar file
    | Target SharedOptions FilePath
  deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq,Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show,Eq Mode
Eq Mode
-> (Mode -> Mode -> Ordering)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Mode)
-> (Mode -> Mode -> Mode)
-> Ord Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
$cp1Ord :: Eq Mode
Ord)

-- | Target languages
data Target = TargetC | TargetCpp | TargetCppNoStl
            | TargetHaskell | TargetHaskellGadt | TargetLatex
            | TargetJava | TargetOCaml | TargetPygments
            | TargetCheck
  deriving (Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c== :: Target -> Target -> Bool
Eq, Target
Target -> Target -> Bounded Target
forall a. a -> a -> Bounded a
maxBound :: Target
$cmaxBound :: Target
minBound :: Target
$cminBound :: Target
Bounded, Int -> Target
Target -> Int
Target -> [Target]
Target -> Target
Target -> Target -> [Target]
Target -> Target -> Target -> [Target]
(Target -> Target)
-> (Target -> Target)
-> (Int -> Target)
-> (Target -> Int)
-> (Target -> [Target])
-> (Target -> Target -> [Target])
-> (Target -> Target -> [Target])
-> (Target -> Target -> Target -> [Target])
-> Enum Target
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Target -> Target -> Target -> [Target]
$cenumFromThenTo :: Target -> Target -> Target -> [Target]
enumFromTo :: Target -> Target -> [Target]
$cenumFromTo :: Target -> Target -> [Target]
enumFromThen :: Target -> Target -> [Target]
$cenumFromThen :: Target -> Target -> [Target]
enumFrom :: Target -> [Target]
$cenumFrom :: Target -> [Target]
fromEnum :: Target -> Int
$cfromEnum :: Target -> Int
toEnum :: Int -> Target
$ctoEnum :: Int -> Target
pred :: Target -> Target
$cpred :: Target -> Target
succ :: Target -> Target
$csucc :: Target -> Target
Enum, Eq Target
Eq Target
-> (Target -> Target -> Ordering)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Target)
-> (Target -> Target -> Target)
-> Ord Target
Target -> Target -> Bool
Target -> Target -> Ordering
Target -> Target -> Target
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Target -> Target -> Target
$cmin :: Target -> Target -> Target
max :: Target -> Target -> Target
$cmax :: Target -> Target -> Target
>= :: Target -> Target -> Bool
$c>= :: Target -> Target -> Bool
> :: Target -> Target -> Bool
$c> :: Target -> Target -> Bool
<= :: Target -> Target -> Bool
$c<= :: Target -> Target -> Bool
< :: Target -> Target -> Bool
$c< :: Target -> Target -> Bool
compare :: Target -> Target -> Ordering
$ccompare :: Target -> Target -> Ordering
$cp1Ord :: Eq Target
Ord)

-- | List of Haskell target.
haskellTargets :: [Target]
haskellTargets :: [Target]
haskellTargets = [ Target
TargetHaskell, Target
TargetHaskellGadt ]

instance Show Target where
  show :: Target -> String
show Target
TargetC            = String
"C"
  show Target
TargetCpp          = String
"C++"
  show Target
TargetCppNoStl     = String
"C++ (without STL)"
  show Target
TargetHaskell      = String
"Haskell"
  show Target
TargetHaskellGadt  = String
"Haskell (with GADT)"
  show Target
TargetLatex        = String
"Latex"
  show Target
TargetJava         = String
"Java"
  show Target
TargetOCaml        = String
"OCaml"
  show Target
TargetPygments     = String
"Pygments"
  show Target
TargetCheck        = String
"Check LBNF file"

-- | Which version of Alex is targeted?
data AlexVersion = Alex3
  deriving (Int -> AlexVersion -> ShowS
[AlexVersion] -> ShowS
AlexVersion -> String
(Int -> AlexVersion -> ShowS)
-> (AlexVersion -> String)
-> ([AlexVersion] -> ShowS)
-> Show AlexVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlexVersion] -> ShowS
$cshowList :: [AlexVersion] -> ShowS
show :: AlexVersion -> String
$cshow :: AlexVersion -> String
showsPrec :: Int -> AlexVersion -> ShowS
$cshowsPrec :: Int -> AlexVersion -> ShowS
Show,AlexVersion -> AlexVersion -> Bool
(AlexVersion -> AlexVersion -> Bool)
-> (AlexVersion -> AlexVersion -> Bool) -> Eq AlexVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlexVersion -> AlexVersion -> Bool
$c/= :: AlexVersion -> AlexVersion -> Bool
== :: AlexVersion -> AlexVersion -> Bool
$c== :: AlexVersion -> AlexVersion -> Bool
Eq,Eq AlexVersion
Eq AlexVersion
-> (AlexVersion -> AlexVersion -> Ordering)
-> (AlexVersion -> AlexVersion -> Bool)
-> (AlexVersion -> AlexVersion -> Bool)
-> (AlexVersion -> AlexVersion -> Bool)
-> (AlexVersion -> AlexVersion -> Bool)
-> (AlexVersion -> AlexVersion -> AlexVersion)
-> (AlexVersion -> AlexVersion -> AlexVersion)
-> Ord AlexVersion
AlexVersion -> AlexVersion -> Bool
AlexVersion -> AlexVersion -> Ordering
AlexVersion -> AlexVersion -> AlexVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AlexVersion -> AlexVersion -> AlexVersion
$cmin :: AlexVersion -> AlexVersion -> AlexVersion
max :: AlexVersion -> AlexVersion -> AlexVersion
$cmax :: AlexVersion -> AlexVersion -> AlexVersion
>= :: AlexVersion -> AlexVersion -> Bool
$c>= :: AlexVersion -> AlexVersion -> Bool
> :: AlexVersion -> AlexVersion -> Bool
$c> :: AlexVersion -> AlexVersion -> Bool
<= :: AlexVersion -> AlexVersion -> Bool
$c<= :: AlexVersion -> AlexVersion -> Bool
< :: AlexVersion -> AlexVersion -> Bool
$c< :: AlexVersion -> AlexVersion -> Bool
compare :: AlexVersion -> AlexVersion -> Ordering
$ccompare :: AlexVersion -> AlexVersion -> Ordering
$cp1Ord :: Eq AlexVersion
Ord,AlexVersion
AlexVersion -> AlexVersion -> Bounded AlexVersion
forall a. a -> a -> Bounded a
maxBound :: AlexVersion
$cmaxBound :: AlexVersion
minBound :: AlexVersion
$cminBound :: AlexVersion
Bounded,Int -> AlexVersion
AlexVersion -> Int
AlexVersion -> [AlexVersion]
AlexVersion -> AlexVersion
AlexVersion -> AlexVersion -> [AlexVersion]
AlexVersion -> AlexVersion -> AlexVersion -> [AlexVersion]
(AlexVersion -> AlexVersion)
-> (AlexVersion -> AlexVersion)
-> (Int -> AlexVersion)
-> (AlexVersion -> Int)
-> (AlexVersion -> [AlexVersion])
-> (AlexVersion -> AlexVersion -> [AlexVersion])
-> (AlexVersion -> AlexVersion -> [AlexVersion])
-> (AlexVersion -> AlexVersion -> AlexVersion -> [AlexVersion])
-> Enum AlexVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AlexVersion -> AlexVersion -> AlexVersion -> [AlexVersion]
$cenumFromThenTo :: AlexVersion -> AlexVersion -> AlexVersion -> [AlexVersion]
enumFromTo :: AlexVersion -> AlexVersion -> [AlexVersion]
$cenumFromTo :: AlexVersion -> AlexVersion -> [AlexVersion]
enumFromThen :: AlexVersion -> AlexVersion -> [AlexVersion]
$cenumFromThen :: AlexVersion -> AlexVersion -> [AlexVersion]
enumFrom :: AlexVersion -> [AlexVersion]
$cenumFrom :: AlexVersion -> [AlexVersion]
fromEnum :: AlexVersion -> Int
$cfromEnum :: AlexVersion -> Int
toEnum :: Int -> AlexVersion
$ctoEnum :: Int -> AlexVersion
pred :: AlexVersion -> AlexVersion
$cpred :: AlexVersion -> AlexVersion
succ :: AlexVersion -> AlexVersion
$csucc :: AlexVersion -> AlexVersion
Enum)

-- | Happy modes
data HappyMode = Standard | GLR
  deriving (HappyMode -> HappyMode -> Bool
(HappyMode -> HappyMode -> Bool)
-> (HappyMode -> HappyMode -> Bool) -> Eq HappyMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HappyMode -> HappyMode -> Bool
$c/= :: HappyMode -> HappyMode -> Bool
== :: HappyMode -> HappyMode -> Bool
$c== :: HappyMode -> HappyMode -> Bool
Eq,Int -> HappyMode -> ShowS
[HappyMode] -> ShowS
HappyMode -> String
(Int -> HappyMode -> ShowS)
-> (HappyMode -> String)
-> ([HappyMode] -> ShowS)
-> Show HappyMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HappyMode] -> ShowS
$cshowList :: [HappyMode] -> ShowS
show :: HappyMode -> String
$cshow :: HappyMode -> String
showsPrec :: Int -> HappyMode -> ShowS
$cshowsPrec :: Int -> HappyMode -> ShowS
Show,HappyMode
HappyMode -> HappyMode -> Bounded HappyMode
forall a. a -> a -> Bounded a
maxBound :: HappyMode
$cmaxBound :: HappyMode
minBound :: HappyMode
$cminBound :: HappyMode
Bounded,Int -> HappyMode
HappyMode -> Int
HappyMode -> [HappyMode]
HappyMode -> HappyMode
HappyMode -> HappyMode -> [HappyMode]
HappyMode -> HappyMode -> HappyMode -> [HappyMode]
(HappyMode -> HappyMode)
-> (HappyMode -> HappyMode)
-> (Int -> HappyMode)
-> (HappyMode -> Int)
-> (HappyMode -> [HappyMode])
-> (HappyMode -> HappyMode -> [HappyMode])
-> (HappyMode -> HappyMode -> [HappyMode])
-> (HappyMode -> HappyMode -> HappyMode -> [HappyMode])
-> Enum HappyMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HappyMode -> HappyMode -> HappyMode -> [HappyMode]
$cenumFromThenTo :: HappyMode -> HappyMode -> HappyMode -> [HappyMode]
enumFromTo :: HappyMode -> HappyMode -> [HappyMode]
$cenumFromTo :: HappyMode -> HappyMode -> [HappyMode]
enumFromThen :: HappyMode -> HappyMode -> [HappyMode]
$cenumFromThen :: HappyMode -> HappyMode -> [HappyMode]
enumFrom :: HappyMode -> [HappyMode]
$cenumFrom :: HappyMode -> [HappyMode]
fromEnum :: HappyMode -> Int
$cfromEnum :: HappyMode -> Int
toEnum :: Int -> HappyMode
$ctoEnum :: Int -> HappyMode
pred :: HappyMode -> HappyMode
$cpred :: HappyMode -> HappyMode
succ :: HappyMode -> HappyMode
$csucc :: HappyMode -> HappyMode
Enum,Eq HappyMode
Eq HappyMode
-> (HappyMode -> HappyMode -> Ordering)
-> (HappyMode -> HappyMode -> Bool)
-> (HappyMode -> HappyMode -> Bool)
-> (HappyMode -> HappyMode -> Bool)
-> (HappyMode -> HappyMode -> Bool)
-> (HappyMode -> HappyMode -> HappyMode)
-> (HappyMode -> HappyMode -> HappyMode)
-> Ord HappyMode
HappyMode -> HappyMode -> Bool
HappyMode -> HappyMode -> Ordering
HappyMode -> HappyMode -> HappyMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HappyMode -> HappyMode -> HappyMode
$cmin :: HappyMode -> HappyMode -> HappyMode
max :: HappyMode -> HappyMode -> HappyMode
$cmax :: HappyMode -> HappyMode -> HappyMode
>= :: HappyMode -> HappyMode -> Bool
$c>= :: HappyMode -> HappyMode -> Bool
> :: HappyMode -> HappyMode -> Bool
$c> :: HappyMode -> HappyMode -> Bool
<= :: HappyMode -> HappyMode -> Bool
$c<= :: HappyMode -> HappyMode -> Bool
< :: HappyMode -> HappyMode -> Bool
$c< :: HappyMode -> HappyMode -> Bool
compare :: HappyMode -> HappyMode -> Ordering
$ccompare :: HappyMode -> HappyMode -> Ordering
$cp1Ord :: Eq HappyMode
Ord)

-- | Which parser generator for ocaml?
data OCamlParser = OCamlYacc | Menhir
    deriving (OCamlParser -> OCamlParser -> Bool
(OCamlParser -> OCamlParser -> Bool)
-> (OCamlParser -> OCamlParser -> Bool) -> Eq OCamlParser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OCamlParser -> OCamlParser -> Bool
$c/= :: OCamlParser -> OCamlParser -> Bool
== :: OCamlParser -> OCamlParser -> Bool
$c== :: OCamlParser -> OCamlParser -> Bool
Eq,Int -> OCamlParser -> ShowS
[OCamlParser] -> ShowS
OCamlParser -> String
(Int -> OCamlParser -> ShowS)
-> (OCamlParser -> String)
-> ([OCamlParser] -> ShowS)
-> Show OCamlParser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OCamlParser] -> ShowS
$cshowList :: [OCamlParser] -> ShowS
show :: OCamlParser -> String
$cshow :: OCamlParser -> String
showsPrec :: Int -> OCamlParser -> ShowS
$cshowsPrec :: Int -> OCamlParser -> ShowS
Show,Eq OCamlParser
Eq OCamlParser
-> (OCamlParser -> OCamlParser -> Ordering)
-> (OCamlParser -> OCamlParser -> Bool)
-> (OCamlParser -> OCamlParser -> Bool)
-> (OCamlParser -> OCamlParser -> Bool)
-> (OCamlParser -> OCamlParser -> Bool)
-> (OCamlParser -> OCamlParser -> OCamlParser)
-> (OCamlParser -> OCamlParser -> OCamlParser)
-> Ord OCamlParser
OCamlParser -> OCamlParser -> Bool
OCamlParser -> OCamlParser -> Ordering
OCamlParser -> OCamlParser -> OCamlParser
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OCamlParser -> OCamlParser -> OCamlParser
$cmin :: OCamlParser -> OCamlParser -> OCamlParser
max :: OCamlParser -> OCamlParser -> OCamlParser
$cmax :: OCamlParser -> OCamlParser -> OCamlParser
>= :: OCamlParser -> OCamlParser -> Bool
$c>= :: OCamlParser -> OCamlParser -> Bool
> :: OCamlParser -> OCamlParser -> Bool
$c> :: OCamlParser -> OCamlParser -> Bool
<= :: OCamlParser -> OCamlParser -> Bool
$c<= :: OCamlParser -> OCamlParser -> Bool
< :: OCamlParser -> OCamlParser -> Bool
$c< :: OCamlParser -> OCamlParser -> Bool
compare :: OCamlParser -> OCamlParser -> Ordering
$ccompare :: OCamlParser -> OCamlParser -> Ordering
$cp1Ord :: Eq OCamlParser
Ord)

-- | Which Java backend?
data JavaLexerParser = JLexCup | JFlexCup | Antlr4
    deriving (JavaLexerParser -> JavaLexerParser -> Bool
(JavaLexerParser -> JavaLexerParser -> Bool)
-> (JavaLexerParser -> JavaLexerParser -> Bool)
-> Eq JavaLexerParser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JavaLexerParser -> JavaLexerParser -> Bool
$c/= :: JavaLexerParser -> JavaLexerParser -> Bool
== :: JavaLexerParser -> JavaLexerParser -> Bool
$c== :: JavaLexerParser -> JavaLexerParser -> Bool
Eq,Int -> JavaLexerParser -> ShowS
[JavaLexerParser] -> ShowS
JavaLexerParser -> String
(Int -> JavaLexerParser -> ShowS)
-> (JavaLexerParser -> String)
-> ([JavaLexerParser] -> ShowS)
-> Show JavaLexerParser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JavaLexerParser] -> ShowS
$cshowList :: [JavaLexerParser] -> ShowS
show :: JavaLexerParser -> String
$cshow :: JavaLexerParser -> String
showsPrec :: Int -> JavaLexerParser -> ShowS
$cshowsPrec :: Int -> JavaLexerParser -> ShowS
Show,Eq JavaLexerParser
Eq JavaLexerParser
-> (JavaLexerParser -> JavaLexerParser -> Ordering)
-> (JavaLexerParser -> JavaLexerParser -> Bool)
-> (JavaLexerParser -> JavaLexerParser -> Bool)
-> (JavaLexerParser -> JavaLexerParser -> Bool)
-> (JavaLexerParser -> JavaLexerParser -> Bool)
-> (JavaLexerParser -> JavaLexerParser -> JavaLexerParser)
-> (JavaLexerParser -> JavaLexerParser -> JavaLexerParser)
-> Ord JavaLexerParser
JavaLexerParser -> JavaLexerParser -> Bool
JavaLexerParser -> JavaLexerParser -> Ordering
JavaLexerParser -> JavaLexerParser -> JavaLexerParser
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JavaLexerParser -> JavaLexerParser -> JavaLexerParser
$cmin :: JavaLexerParser -> JavaLexerParser -> JavaLexerParser
max :: JavaLexerParser -> JavaLexerParser -> JavaLexerParser
$cmax :: JavaLexerParser -> JavaLexerParser -> JavaLexerParser
>= :: JavaLexerParser -> JavaLexerParser -> Bool
$c>= :: JavaLexerParser -> JavaLexerParser -> Bool
> :: JavaLexerParser -> JavaLexerParser -> Bool
$c> :: JavaLexerParser -> JavaLexerParser -> Bool
<= :: JavaLexerParser -> JavaLexerParser -> Bool
$c<= :: JavaLexerParser -> JavaLexerParser -> Bool
< :: JavaLexerParser -> JavaLexerParser -> Bool
$c< :: JavaLexerParser -> JavaLexerParser -> Bool
compare :: JavaLexerParser -> JavaLexerParser -> Ordering
$ccompare :: JavaLexerParser -> JavaLexerParser -> Ordering
$cp1Ord :: Eq JavaLexerParser
Ord)

data RecordPositions = RecordPositions | NoRecordPositions
    deriving (RecordPositions -> RecordPositions -> Bool
(RecordPositions -> RecordPositions -> Bool)
-> (RecordPositions -> RecordPositions -> Bool)
-> Eq RecordPositions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecordPositions -> RecordPositions -> Bool
$c/= :: RecordPositions -> RecordPositions -> Bool
== :: RecordPositions -> RecordPositions -> Bool
$c== :: RecordPositions -> RecordPositions -> Bool
Eq,Int -> RecordPositions -> ShowS
[RecordPositions] -> ShowS
RecordPositions -> String
(Int -> RecordPositions -> ShowS)
-> (RecordPositions -> String)
-> ([RecordPositions] -> ShowS)
-> Show RecordPositions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecordPositions] -> ShowS
$cshowList :: [RecordPositions] -> ShowS
show :: RecordPositions -> String
$cshow :: RecordPositions -> String
showsPrec :: Int -> RecordPositions -> ShowS
$cshowsPrec :: Int -> RecordPositions -> ShowS
Show,Eq RecordPositions
Eq RecordPositions
-> (RecordPositions -> RecordPositions -> Ordering)
-> (RecordPositions -> RecordPositions -> Bool)
-> (RecordPositions -> RecordPositions -> Bool)
-> (RecordPositions -> RecordPositions -> Bool)
-> (RecordPositions -> RecordPositions -> Bool)
-> (RecordPositions -> RecordPositions -> RecordPositions)
-> (RecordPositions -> RecordPositions -> RecordPositions)
-> Ord RecordPositions
RecordPositions -> RecordPositions -> Bool
RecordPositions -> RecordPositions -> Ordering
RecordPositions -> RecordPositions -> RecordPositions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RecordPositions -> RecordPositions -> RecordPositions
$cmin :: RecordPositions -> RecordPositions -> RecordPositions
max :: RecordPositions -> RecordPositions -> RecordPositions
$cmax :: RecordPositions -> RecordPositions -> RecordPositions
>= :: RecordPositions -> RecordPositions -> Bool
$c>= :: RecordPositions -> RecordPositions -> Bool
> :: RecordPositions -> RecordPositions -> Bool
$c> :: RecordPositions -> RecordPositions -> Bool
<= :: RecordPositions -> RecordPositions -> Bool
$c<= :: RecordPositions -> RecordPositions -> Bool
< :: RecordPositions -> RecordPositions -> Bool
$c< :: RecordPositions -> RecordPositions -> Bool
compare :: RecordPositions -> RecordPositions -> Ordering
$ccompare :: RecordPositions -> RecordPositions -> Ordering
$cp1Ord :: Eq RecordPositions
Ord)

-- | How to represent token content in the Haskell backend?

data TokenText
  = StringToken      -- ^ Represent strings as @String@.
  | ByteStringToken  -- ^ Represent strings as @ByteString@.
  | TextToken        -- ^ Represent strings as @Data.Text@.
  deriving (TokenText -> TokenText -> Bool
(TokenText -> TokenText -> Bool)
-> (TokenText -> TokenText -> Bool) -> Eq TokenText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenText -> TokenText -> Bool
$c/= :: TokenText -> TokenText -> Bool
== :: TokenText -> TokenText -> Bool
$c== :: TokenText -> TokenText -> Bool
Eq, Eq TokenText
Eq TokenText
-> (TokenText -> TokenText -> Ordering)
-> (TokenText -> TokenText -> Bool)
-> (TokenText -> TokenText -> Bool)
-> (TokenText -> TokenText -> Bool)
-> (TokenText -> TokenText -> Bool)
-> (TokenText -> TokenText -> TokenText)
-> (TokenText -> TokenText -> TokenText)
-> Ord TokenText
TokenText -> TokenText -> Bool
TokenText -> TokenText -> Ordering
TokenText -> TokenText -> TokenText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TokenText -> TokenText -> TokenText
$cmin :: TokenText -> TokenText -> TokenText
max :: TokenText -> TokenText -> TokenText
$cmax :: TokenText -> TokenText -> TokenText
>= :: TokenText -> TokenText -> Bool
$c>= :: TokenText -> TokenText -> Bool
> :: TokenText -> TokenText -> Bool
$c> :: TokenText -> TokenText -> Bool
<= :: TokenText -> TokenText -> Bool
$c<= :: TokenText -> TokenText -> Bool
< :: TokenText -> TokenText -> Bool
$c< :: TokenText -> TokenText -> Bool
compare :: TokenText -> TokenText -> Ordering
$ccompare :: TokenText -> TokenText -> Ordering
$cp1Ord :: Eq TokenText
Ord, Int -> TokenText -> ShowS
[TokenText] -> ShowS
TokenText -> String
(Int -> TokenText -> ShowS)
-> (TokenText -> String)
-> ([TokenText] -> ShowS)
-> Show TokenText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenText] -> ShowS
$cshowList :: [TokenText] -> ShowS
show :: TokenText -> String
$cshow :: TokenText -> String
showsPrec :: Int -> TokenText -> ShowS
$cshowsPrec :: Int -> TokenText -> ShowS
Show)

-- | This is the option record that is passed to the different backends.
data SharedOptions = Options
  --- Option shared by at least 2 backends
  { SharedOptions -> String
lbnfFile    :: FilePath        -- ^ The input file BNFC processes.
  , SharedOptions -> String
lang        :: String          -- ^ The language we generate: the basename of 'lbnfFile'.
  , SharedOptions -> String
outDir      :: FilePath        -- ^ Target directory for generated files.
  , SharedOptions -> Bool
force       :: Bool            -- ^ Ignore errors as much as possible?
  , SharedOptions -> Target
target      :: Target          -- ^ E.g. @--haskell@.
  , SharedOptions -> Maybe String
make        :: Maybe String    -- ^ The name of the Makefile to generate or Nothing for no Makefile.
  , SharedOptions -> Maybe String
inPackage   :: Maybe String    -- ^ The hierarchical package to put the modules in, or Nothing.
  , SharedOptions -> RecordPositions
linenumbers :: RecordPositions -- ^ Add and set line_number field for syntax classes
  --- Haskell specific:
  , SharedOptions -> Bool
inDir         :: Bool        -- ^ Option @-d@.
  , SharedOptions -> Bool
functor       :: Bool        -- ^ Option @--functor@.  Make AST functorial?
  , SharedOptions -> Bool
generic       :: Bool        -- ^ Option @--generic@.  Derive Data, Generic, Typeable?
  , SharedOptions -> AlexVersion
alexMode      :: AlexVersion -- ^ Options @--alex@.
  , SharedOptions -> TokenText
tokenText     :: TokenText   -- ^ Options @--bytestrings@, @--string-token@, and @--text-token@.
  , SharedOptions -> HappyMode
glr           :: HappyMode   -- ^ Happy option @--glr@.
  , SharedOptions -> Int
xml           :: Int         -- ^ Options @--xml@, generate DTD and XML printers.
  , SharedOptions -> Bool
agda          :: Bool        -- ^ Option @--agda@. Create bindings for Agda?
  --- OCaml specific
  , SharedOptions -> OCamlParser
ocamlParser   :: OCamlParser -- ^ Option @--menhir@ to switch to @Menhir@.
  --- Java specific
  , SharedOptions -> JavaLexerParser
javaLexerParser :: JavaLexerParser
  --- C# specific
  , SharedOptions -> Bool
visualStudio  :: Bool        -- ^ Generate Visual Studio solution/project files.
  , SharedOptions -> Bool
wcf           :: Bool        -- ^ Windows Communication Foundation.
  } deriving (SharedOptions -> SharedOptions -> Bool
(SharedOptions -> SharedOptions -> Bool)
-> (SharedOptions -> SharedOptions -> Bool) -> Eq SharedOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SharedOptions -> SharedOptions -> Bool
$c/= :: SharedOptions -> SharedOptions -> Bool
== :: SharedOptions -> SharedOptions -> Bool
$c== :: SharedOptions -> SharedOptions -> Bool
Eq, Eq SharedOptions
Eq SharedOptions
-> (SharedOptions -> SharedOptions -> Ordering)
-> (SharedOptions -> SharedOptions -> Bool)
-> (SharedOptions -> SharedOptions -> Bool)
-> (SharedOptions -> SharedOptions -> Bool)
-> (SharedOptions -> SharedOptions -> Bool)
-> (SharedOptions -> SharedOptions -> SharedOptions)
-> (SharedOptions -> SharedOptions -> SharedOptions)
-> Ord SharedOptions
SharedOptions -> SharedOptions -> Bool
SharedOptions -> SharedOptions -> Ordering
SharedOptions -> SharedOptions -> SharedOptions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SharedOptions -> SharedOptions -> SharedOptions
$cmin :: SharedOptions -> SharedOptions -> SharedOptions
max :: SharedOptions -> SharedOptions -> SharedOptions
$cmax :: SharedOptions -> SharedOptions -> SharedOptions
>= :: SharedOptions -> SharedOptions -> Bool
$c>= :: SharedOptions -> SharedOptions -> Bool
> :: SharedOptions -> SharedOptions -> Bool
$c> :: SharedOptions -> SharedOptions -> Bool
<= :: SharedOptions -> SharedOptions -> Bool
$c<= :: SharedOptions -> SharedOptions -> Bool
< :: SharedOptions -> SharedOptions -> Bool
$c< :: SharedOptions -> SharedOptions -> Bool
compare :: SharedOptions -> SharedOptions -> Ordering
$ccompare :: SharedOptions -> SharedOptions -> Ordering
$cp1Ord :: Eq SharedOptions
Ord, Int -> SharedOptions -> ShowS
[SharedOptions] -> ShowS
SharedOptions -> String
(Int -> SharedOptions -> ShowS)
-> (SharedOptions -> String)
-> ([SharedOptions] -> ShowS)
-> Show SharedOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SharedOptions] -> ShowS
$cshowList :: [SharedOptions] -> ShowS
show :: SharedOptions -> String
$cshow :: SharedOptions -> String
showsPrec :: Int -> SharedOptions -> ShowS
$cshowsPrec :: Int -> SharedOptions -> ShowS
Show)

-- We take this opportunity to define the type of the backend functions.
type Backend = SharedOptions  -- ^ Options
            -> CF             -- ^ Grammar
            -> IO ()

defaultOptions :: SharedOptions
defaultOptions :: SharedOptions
defaultOptions = Options :: String
-> String
-> String
-> Bool
-> Target
-> Maybe String
-> Maybe String
-> RecordPositions
-> Bool
-> Bool
-> Bool
-> AlexVersion
-> TokenText
-> HappyMode
-> Int
-> Bool
-> OCamlParser
-> JavaLexerParser
-> Bool
-> Bool
-> SharedOptions
Options
  { lbnfFile :: String
lbnfFile        = ShowS
forall a. HasCallStack => String -> a
error String
"lbnfFile not set"
  , lang :: String
lang            = ShowS
forall a. HasCallStack => String -> a
error String
"lang not set"
  , outDir :: String
outDir          = String
"."
  , force :: Bool
force           = Bool
False
  , target :: Target
target          = Target
TargetHaskell
  , make :: Maybe String
make            = Maybe String
forall a. Maybe a
Nothing
  , inPackage :: Maybe String
inPackage       = Maybe String
forall a. Maybe a
Nothing
  , linenumbers :: RecordPositions
linenumbers     = RecordPositions
NoRecordPositions
  -- Haskell specific
  , inDir :: Bool
inDir           = Bool
False
  , functor :: Bool
functor         = Bool
False
  , generic :: Bool
generic         = Bool
False
  , alexMode :: AlexVersion
alexMode        = AlexVersion
Alex3
  , tokenText :: TokenText
tokenText       = TokenText
StringToken
  , glr :: HappyMode
glr             = HappyMode
Standard
  , xml :: Int
xml             = Int
0
  , agda :: Bool
agda            = Bool
False
  -- OCaml specific
  , ocamlParser :: OCamlParser
ocamlParser     = OCamlParser
OCamlYacc
  -- Java specific
  , javaLexerParser :: JavaLexerParser
javaLexerParser = JavaLexerParser
JLexCup
  -- C# specific
  , visualStudio :: Bool
visualStudio    = Bool
False
  , wcf :: Bool
wcf             = Bool
False
  }

-- | Check whether an option is unchanged from the default.
isDefault :: (Eq a)
  => (SharedOptions -> a)  -- ^ Option field name.
  -> SharedOptions         -- ^ Options.
  -> Bool
isDefault :: (SharedOptions -> a) -> SharedOptions -> Bool
isDefault SharedOptions -> a
flag SharedOptions
opts = SharedOptions -> a
flag SharedOptions
opts a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== SharedOptions -> a
flag SharedOptions
defaultOptions

-- | Return something in case option differs from default.
unlessDefault :: (Monoid m, Eq a)
  => (SharedOptions -> a)  -- ^ Option field name.
  -> SharedOptions         -- ^ Options.
  -> (a -> m)              -- ^ Action in case option differs from standard.
  -> m
unlessDefault :: (SharedOptions -> a) -> SharedOptions -> (a -> m) -> m
unlessDefault SharedOptions -> a
flag SharedOptions
opts a -> m
f = Bool -> m -> m
forall m. Monoid m => Bool -> m -> m
unless (a
o a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== SharedOptions -> a
flag SharedOptions
defaultOptions) (m -> m) -> m -> m
forall a b. (a -> b) -> a -> b
$ a -> m
f a
o
  where o :: a
o = SharedOptions -> a
flag SharedOptions
opts

-- -- | Return something in case option is unchanged from default.
-- whenDefault :: (Monoid m, Eq a)
--   => (SharedOptions -> a)  -- ^ Option field name.
--   -> SharedOptions         -- ^ Options.
--   -> m                     -- ^ Action in case option is unchanged from standard.
--   -> m
-- whenDefault flag opts m = when (o == flag defaultOptions) m
--   where o = flag opts

-- | Print options as input to BNFC.
--
-- @unwords [ "bnfc", printOptions opts ]@ should call bnfc with the same options
-- as the current instance.
--
printOptions :: SharedOptions -> String
printOptions :: SharedOptions -> String
printOptions SharedOptions
opts = [String] -> String
unwords ([String] -> String)
-> ([[String]] -> [String]) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> String) -> [[String]] -> String
forall a b. (a -> b) -> a -> b
$
  [ [ Target -> String
printTargetOption Target
tgt ]
  -- General and shared options:
  , (SharedOptions -> String)
-> SharedOptions -> (String -> [String]) -> [String]
forall m a.
(Monoid m, Eq a) =>
(SharedOptions -> a) -> SharedOptions -> (a -> m) -> m
unlessDefault SharedOptions -> String
outDir SharedOptions
opts ((String -> [String]) -> [String])
-> (String -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \ String
o -> [ String
"--outputdir=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
o ]
  , [ String
"--makefile=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
m  | String
m <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ SharedOptions -> Maybe String
make SharedOptions
opts        ]
  , [ String
"-p " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p          | String
p <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ SharedOptions -> Maybe String
inPackage SharedOptions
opts   ]
  , (SharedOptions -> RecordPositions)
-> SharedOptions -> (RecordPositions -> [String]) -> [String]
forall m a.
(Monoid m, Eq a) =>
(SharedOptions -> a) -> SharedOptions -> (a -> m) -> m
unlessDefault SharedOptions -> RecordPositions
linenumbers SharedOptions
opts ((RecordPositions -> [String]) -> [String])
-> (RecordPositions -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> RecordPositions -> [String]
forall a b. a -> b -> a
const [ String
"-l" ]
  -- Haskell options:
  , [ String
"-d"                | SharedOptions -> Bool
inDir SharedOptions
opts                          ]
  , [ String
"--functor"         | SharedOptions -> Bool
functor SharedOptions
opts                        ]
  , [ String
"--generic"         | SharedOptions -> Bool
generic SharedOptions
opts                        ]
  , (SharedOptions -> AlexVersion)
-> SharedOptions -> (AlexVersion -> [String]) -> [String]
forall m a.
(Monoid m, Eq a) =>
(SharedOptions -> a) -> SharedOptions -> (a -> m) -> m
unlessDefault SharedOptions -> AlexVersion
alexMode SharedOptions
opts ((AlexVersion -> [String]) -> [String])
-> (AlexVersion -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \ AlexVersion
o -> [ AlexVersion -> String
printAlexOption AlexVersion
o ]
  , [ String
"--bytestrings"     | SharedOptions -> TokenText
tokenText SharedOptions
opts TokenText -> TokenText -> Bool
forall a. Eq a => a -> a -> Bool
== TokenText
ByteStringToken   ]
  , [ String
"--text-token"      | SharedOptions -> TokenText
tokenText SharedOptions
opts TokenText -> TokenText -> Bool
forall a. Eq a => a -> a -> Bool
== TokenText
TextToken, Bool -> Bool
not (SharedOptions -> Bool
agda SharedOptions
opts) ]  -- default for --agda
  , [ String
"--string-token"    | SharedOptions -> TokenText
tokenText SharedOptions
opts TokenText -> TokenText -> Bool
forall a. Eq a => a -> a -> Bool
== TokenText
StringToken, SharedOptions -> Bool
agda SharedOptions
opts ]      -- default unless --agda
  , [ String
"--glr"             | SharedOptions -> HappyMode
glr SharedOptions
opts HappyMode -> HappyMode -> Bool
forall a. Eq a => a -> a -> Bool
== HappyMode
GLR                     ]
  , [ String
"--xml"             | SharedOptions -> Int
xml SharedOptions
opts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1                       ]
  , [ String
"--xmlt"            | SharedOptions -> Int
xml SharedOptions
opts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2                       ]
  , [ String
"--agda"            | SharedOptions -> Bool
agda SharedOptions
opts                           ]
  -- C# options:
  , [ String
"--vs"              | SharedOptions -> Bool
visualStudio SharedOptions
opts                   ]
  , [ String
"--wfc"             | SharedOptions -> Bool
wcf SharedOptions
opts                            ]
  -- Java options:
  , (SharedOptions -> JavaLexerParser)
-> SharedOptions -> (JavaLexerParser -> [String]) -> [String]
forall m a.
(Monoid m, Eq a) =>
(SharedOptions -> a) -> SharedOptions -> (a -> m) -> m
unlessDefault SharedOptions -> JavaLexerParser
javaLexerParser SharedOptions
opts ((JavaLexerParser -> [String]) -> [String])
-> (JavaLexerParser -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \ JavaLexerParser
o -> [ JavaLexerParser -> String
printJavaLexerParserOption JavaLexerParser
o ]
  -- Java options:
  , (SharedOptions -> OCamlParser)
-> SharedOptions -> (OCamlParser -> [String]) -> [String]
forall m a.
(Monoid m, Eq a) =>
(SharedOptions -> a) -> SharedOptions -> (a -> m) -> m
unlessDefault SharedOptions -> OCamlParser
ocamlParser SharedOptions
opts ((OCamlParser -> [String]) -> [String])
-> (OCamlParser -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \ OCamlParser
o -> [ OCamlParser -> String
printOCamlParserOption OCamlParser
o ]
  -- Grammar file:
  , [ SharedOptions -> String
lbnfFile SharedOptions
opts ]
  ]
  where
  tgt :: Target
tgt = SharedOptions -> Target
target SharedOptions
opts
  -- haskell = tgt `elem` haskellTargets

-- | Print target as an option to BNFC.
printTargetOption :: Target -> String
printTargetOption :: Target -> String
printTargetOption = (String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Target -> String) -> Target -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  Target
TargetC           -> String
"c"
  Target
TargetCpp         -> String
"cpp"
  Target
TargetCppNoStl    -> String
"cpp-nostl"
  Target
TargetHaskell     -> String
"haskell"
  Target
TargetHaskellGadt -> String
"haskell-gadt"
  Target
TargetLatex       -> String
"latex"
  Target
TargetJava        -> String
"java"
  Target
TargetOCaml       -> String
"ocaml"
  Target
TargetPygments    -> String
"pygments"
  Target
TargetCheck       -> String
"check"

printAlexOption :: AlexVersion -> String
printAlexOption :: AlexVersion -> String
printAlexOption = (String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (AlexVersion -> String) -> AlexVersion -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  AlexVersion
Alex3 -> String
"alex3"

printJavaLexerParserOption :: JavaLexerParser -> String
printJavaLexerParserOption :: JavaLexerParser -> String
printJavaLexerParserOption = (String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (JavaLexerParser -> String) -> JavaLexerParser -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  JavaLexerParser
JLexCup  -> String
"jlex"
  JavaLexerParser
JFlexCup -> String
"jflex"
  JavaLexerParser
Antlr4   -> String
"antlr4"

printOCamlParserOption :: OCamlParser -> String
printOCamlParserOption :: OCamlParser -> String
printOCamlParserOption = (String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (OCamlParser -> String) -> OCamlParser -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  OCamlParser
OCamlYacc -> String
"yacc"
  OCamlParser
Menhir    -> String
"menhir"

-- ~~~ Option definition ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- This defines bnfc's "global" options, like --help
globalOptions :: [ OptDescr Mode ]
globalOptions :: [OptDescr Mode]
globalOptions = [
  String -> [String] -> ArgDescr Mode -> String -> OptDescr Mode
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"help"]                      (Mode -> ArgDescr Mode
forall a. a -> ArgDescr a
NoArg Mode
Help)         String
"show help",
  String -> [String] -> ArgDescr Mode -> String -> OptDescr Mode
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"license"]                   (Mode -> ArgDescr Mode
forall a. a -> ArgDescr a
NoArg Mode
License)      String
"show license",
  String -> [String] -> ArgDescr Mode -> String -> OptDescr Mode
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"version",String
"numeric-version"] (Mode -> ArgDescr Mode
forall a. a -> ArgDescr a
NoArg Mode
Version)      String
"show version number"]

-- | Options for the target languages
-- targetOptions :: [ OptDescr Target ]
targetOptions :: [ OptDescr (SharedOptions -> SharedOptions)]
targetOptions :: [OptDescr (SharedOptions -> SharedOptions)]
targetOptions =
  [ String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"java"]          ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {target :: Target
target = Target
TargetJava}))
    String
"Output Java code [default: for use with JLex and CUP]"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"java-antlr"]    ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\ SharedOptions
o -> SharedOptions
o{ target :: Target
target = Target
TargetJava, javaLexerParser :: JavaLexerParser
javaLexerParser = JavaLexerParser
Antlr4 }))
    String
"Output Java code for use with ANTLR (short for --java --antlr)"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"haskell"]       ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {target :: Target
target = Target
TargetHaskell}))
    String
"Output Haskell code for use with Alex and Happy (default)"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"haskell-gadt"]  ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {target :: Target
target = Target
TargetHaskellGadt}))
    String
"Output Haskell code which uses GADTs"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"latex"]         ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {target :: Target
target = Target
TargetLatex}))
    String
"Output LaTeX code to generate a PDF description of the language"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"c"]             ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {target :: Target
target = Target
TargetC}))
    String
"Output C code for use with FLex and Bison"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"cpp"]           ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {target :: Target
target = Target
TargetCpp}))
    String
"Output C++ code for use with FLex and Bison"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"cpp-nostl"]     ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {target :: Target
target = Target
TargetCppNoStl}))
    String
"Output C++ code (without STL) for use with FLex and Bison"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"ocaml"]         ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {target :: Target
target = Target
TargetOCaml}))
    String
"Output OCaml code for use with ocamllex and ocamlyacc"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"ocaml-menhir"]  ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\ SharedOptions
o -> SharedOptions
o{ target :: Target
target = Target
TargetOCaml, ocamlParser :: OCamlParser
ocamlParser = OCamlParser
Menhir }))
    String
"Output OCaml code for use with ocamllex and menhir (short for --ocaml --menhir)"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"pygments"]      ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {target :: Target
target = Target
TargetPygments}))
    String
"Output a Python lexer for Pygments"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"check"]         ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\ SharedOptions
o -> SharedOptions
o{target :: Target
target = Target
TargetCheck }))
    String
"No output. Just check input LBNF file"
  ]

-- | A list of the options and for each of them, the target language
-- they apply to.
specificOptions :: [(OptDescr (SharedOptions -> SharedOptions), [Target])]
specificOptions :: [(OptDescr (SharedOptions -> SharedOptions), [Target])]
specificOptions =
  [ ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'l'] [String
"line-numbers"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {linenumbers :: RecordPositions
linenumbers = RecordPositions
RecordPositions})) (String -> OptDescr (SharedOptions -> SharedOptions))
-> String -> OptDescr (SharedOptions -> SharedOptions)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
        [ String
"Add and set line_number field for all syntax classes"
        , String
"(Note: Java requires cup version 0.11b-2014-06-11 or greater.)"
        ]
    , [Target
TargetC, Target
TargetCpp, Target
TargetJava] )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'p'] [String
"name-space"]
      ((String -> SharedOptions -> SharedOptions)
-> String -> ArgDescr (SharedOptions -> SharedOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
n SharedOptions
o -> SharedOptions
o {inPackage :: Maybe String
inPackage = String -> Maybe String
forall a. a -> Maybe a
Just String
n}) String
"NAMESPACE")
          String
"Prepend NAMESPACE to the package/module name"
    , [Target
TargetCpp, Target
TargetJava] [Target] -> [Target] -> [Target]
forall a. [a] -> [a] -> [a]
++ [Target]
haskellTargets)
  -- Java backend:
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"jlex"  ] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {javaLexerParser :: JavaLexerParser
javaLexerParser = JavaLexerParser
JLexCup}))
          String
"Lex with JLex, parse with CUP (default)"
    , [Target
TargetJava] )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"jflex" ] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {javaLexerParser :: JavaLexerParser
javaLexerParser = JavaLexerParser
JFlexCup}))
          String
"Lex with JFlex, parse with CUP"
    , [Target
TargetJava] )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"antlr4"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {javaLexerParser :: JavaLexerParser
javaLexerParser = JavaLexerParser
Antlr4}))
          String
"Lex and parse with antlr4"
    , [Target
TargetJava] )
  -- OCaml backend:
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"yacc"  ] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\ SharedOptions
o -> SharedOptions
o { ocamlParser :: OCamlParser
ocamlParser = OCamlParser
OCamlYacc }))
          String
"Generate parser with ocamlyacc (default)"
    , [Target
TargetOCaml] )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"menhir"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\ SharedOptions
o -> SharedOptions
o { ocamlParser :: OCamlParser
ocamlParser = OCamlParser
Menhir }))
          String
"Generate parser with menhir"
    , [Target
TargetOCaml] )
  -- Haskell backends:
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'd'] [] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {inDir :: Bool
inDir = Bool
True}))
          String
"Put Haskell code in modules LANG.* instead of LANG* (recommended)"
    , [Target]
haskellTargets )
  -- -- Option --alex3 is obsolete since Alex 3 is the only choice now.
  -- -- Keep this in case there will be a new lexer backend for Haskell.
  -- , ( Option []    ["alex3"] (NoArg (\o -> o {alexMode = Alex3}))
  --         "Use Alex 3 as Haskell lexer tool (default)"
  --   , haskellTargets )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []    [String
"bytestrings"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o { tokenText :: TokenText
tokenText = TokenText
ByteStringToken }))
          String
"Use ByteString in Alex lexer"
    , [Target]
haskellTargets )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []    [String
"text-token"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o { tokenText :: TokenText
tokenText = TokenText
TextToken }))
          String
"Use Text in Alex lexer"
          -- "Use Text in Alex lexer (default for --agda)"
    , [Target]
haskellTargets )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []    [String
"string-token"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o { tokenText :: TokenText
tokenText = TokenText
StringToken }))
          String
"Use String in Alex lexer (default)"
    , [Target]
haskellTargets )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []    [String
"glr"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {glr :: HappyMode
glr = HappyMode
GLR}))
          String
"Output Happy GLR parser [deprecated]"
    , [Target]
haskellTargets )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []    [String
"functor"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {functor :: Bool
functor = Bool
True}))
          String
"Make the AST a functor and use it to store the position of the nodes"
    , [Target]
haskellTargets )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []    [String
"generic"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {generic :: Bool
generic = Bool
True}))
          String
"Derive Data, Generic, and Typeable instances for AST types"
    , [Target]
haskellTargets )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []    [String
"xml"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {xml :: Int
xml = Int
1}))
          String
"Also generate a DTD and an XML printer"
    , [Target]
haskellTargets )
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []    [String
"xmlt"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o {xml :: Int
xml = Int
2}))
          String
"DTD and an XML printer, another encoding"
    , [Target]
haskellTargets )
  -- Agda does not support the GADT syntax
  , ( String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []    [String
"agda"] ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\SharedOptions
o -> SharedOptions
o { agda :: Bool
agda = Bool
True, tokenText :: TokenText
tokenText = TokenText
TextToken }))
          String
"Also generate Agda bindings for the abstract syntax"
    , [Target
TargetHaskell] )
  ]

-- | The list of specific options for a target.
specificOptions' :: Target -> [OptDescr (SharedOptions -> SharedOptions)]
specificOptions' :: Target -> [OptDescr (SharedOptions -> SharedOptions)]
specificOptions' Target
t = ((OptDescr (SharedOptions -> SharedOptions), [Target])
 -> OptDescr (SharedOptions -> SharedOptions))
-> [(OptDescr (SharedOptions -> SharedOptions), [Target])]
-> [OptDescr (SharedOptions -> SharedOptions)]
forall a b. (a -> b) -> [a] -> [b]
map (OptDescr (SharedOptions -> SharedOptions), [Target])
-> OptDescr (SharedOptions -> SharedOptions)
forall a b. (a, b) -> a
fst ([(OptDescr (SharedOptions -> SharedOptions), [Target])]
 -> [OptDescr (SharedOptions -> SharedOptions)])
-> [(OptDescr (SharedOptions -> SharedOptions), [Target])]
-> [OptDescr (SharedOptions -> SharedOptions)]
forall a b. (a -> b) -> a -> b
$ ((OptDescr (SharedOptions -> SharedOptions), [Target]) -> Bool)
-> [(OptDescr (SharedOptions -> SharedOptions), [Target])]
-> [(OptDescr (SharedOptions -> SharedOptions), [Target])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Target -> [Target] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Target
t ([Target] -> Bool)
-> ((OptDescr (SharedOptions -> SharedOptions), [Target])
    -> [Target])
-> (OptDescr (SharedOptions -> SharedOptions), [Target])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptDescr (SharedOptions -> SharedOptions), [Target]) -> [Target]
forall a b. (a, b) -> b
snd) [(OptDescr (SharedOptions -> SharedOptions), [Target])]
specificOptions

commonOptions :: [OptDescr (SharedOptions -> SharedOptions)]
commonOptions :: [OptDescr (SharedOptions -> SharedOptions)]
commonOptions =
  [ String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"m" [String
"makefile"] ((Maybe String -> SharedOptions -> SharedOptions)
-> String -> ArgDescr (SharedOptions -> SharedOptions)
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (String -> SharedOptions -> SharedOptions
setMakefile (String -> SharedOptions -> SharedOptions)
-> (Maybe String -> String)
-> Maybe String
-> SharedOptions
-> SharedOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"Makefile") String
"MAKEFILE")
      String
"generate Makefile"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"o" [String
"outputdir"] ((String -> SharedOptions -> SharedOptions)
-> String -> ArgDescr (SharedOptions -> SharedOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
n SharedOptions
o -> SharedOptions
o {outDir :: String
outDir = String
n}) String
"DIR")
      String
"Redirects all generated files into DIR"
  , String
-> [String]
-> ArgDescr (SharedOptions -> SharedOptions)
-> String
-> OptDescr (SharedOptions -> SharedOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
""  [String
"force"]     ((SharedOptions -> SharedOptions)
-> ArgDescr (SharedOptions -> SharedOptions)
forall a. a -> ArgDescr a
NoArg (\ SharedOptions
o -> SharedOptions
o { force :: Bool
force = Bool
True }))
      String
"Ignore errors in the grammar (may produce ill-formed output or crash)"
  ]
  where setMakefile :: String -> SharedOptions -> SharedOptions
setMakefile String
mf SharedOptions
o = SharedOptions
o { make :: Maybe String
make = String -> Maybe String
forall a. a -> Maybe a
Just String
mf }

allOptions :: [OptDescr (SharedOptions -> SharedOptions)]
allOptions :: [OptDescr (SharedOptions -> SharedOptions)]
allOptions = [OptDescr (SharedOptions -> SharedOptions)]
targetOptions [OptDescr (SharedOptions -> SharedOptions)]
-> [OptDescr (SharedOptions -> SharedOptions)]
-> [OptDescr (SharedOptions -> SharedOptions)]
forall a. [a] -> [a] -> [a]
++ [OptDescr (SharedOptions -> SharedOptions)]
commonOptions [OptDescr (SharedOptions -> SharedOptions)]
-> [OptDescr (SharedOptions -> SharedOptions)]
-> [OptDescr (SharedOptions -> SharedOptions)]
forall a. [a] -> [a] -> [a]
++ ((OptDescr (SharedOptions -> SharedOptions), [Target])
 -> OptDescr (SharedOptions -> SharedOptions))
-> [(OptDescr (SharedOptions -> SharedOptions), [Target])]
-> [OptDescr (SharedOptions -> SharedOptions)]
forall a b. (a -> b) -> [a] -> [b]
map (OptDescr (SharedOptions -> SharedOptions), [Target])
-> OptDescr (SharedOptions -> SharedOptions)
forall a b. (a, b) -> a
fst [(OptDescr (SharedOptions -> SharedOptions), [Target])]
specificOptions

-- | All target options and all specific options for a given target.
allOptions' :: Target -> [OptDescr (SharedOptions -> SharedOptions)]
allOptions' :: Target -> [OptDescr (SharedOptions -> SharedOptions)]
allOptions' Target
t = [OptDescr (SharedOptions -> SharedOptions)]
targetOptions [OptDescr (SharedOptions -> SharedOptions)]
-> [OptDescr (SharedOptions -> SharedOptions)]
-> [OptDescr (SharedOptions -> SharedOptions)]
forall a. [a] -> [a] -> [a]
++ [OptDescr (SharedOptions -> SharedOptions)]
commonOptions [OptDescr (SharedOptions -> SharedOptions)]
-> [OptDescr (SharedOptions -> SharedOptions)]
-> [OptDescr (SharedOptions -> SharedOptions)]
forall a. [a] -> [a] -> [a]
++ Target -> [OptDescr (SharedOptions -> SharedOptions)]
specificOptions' Target
t

-- ~~~ Help strings ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

title :: [String]
title :: [String]
title =
  [ String
"The BNF Converter, " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (c) 2002-today BNFC development team."
  , String
"Free software under the BSD 3-clause license."
  , String
"List of recent contributors at https://github.com/BNFC/bnfc/graphs/contributors."
  , String
"Report bugs at https://github.com/BNFC/bnfc/issues."
  , String
""
  ]

-- oldContributors :: [String]
-- oldContributors =
--   [ "(c) Jonas Almström Duregård, Krasimir Angelov, Jean-Philippe Bernardy, Björn Bringert, Johan Broberg, Paul Callaghan, "
--   , "    Grégoire Détrez, Markus Forsberg, Ola Frid, Peter Gammie, Thomas Hallgren, Patrik Jansson, "
--   , "    Kristofer Johannisson, Antti-Juhani Kaijanaho, Ulf Norell, "
--   , "    Michael Pellauer and Aarne Ranta 2002 - 2013."
--   ]

usage :: String
usage :: String
usage = [String] -> String
unlines
  [ String
"usage: bnfc [--TARGET] [OPTIONS] LANG.cf"
  , String
"   or: bnfc --[numeric-]version"
  , String
"   or: bnfc [--license]"
  , String
"   or: bnfc [--help]"
  ]

help :: String
help :: String
help = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
title [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [ String
usage
    , String -> [OptDescr Mode] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
"Global options"   [OptDescr Mode]
globalOptions
    , String -> [OptDescr (SharedOptions -> SharedOptions)] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
"Common options"   [OptDescr (SharedOptions -> SharedOptions)]
commonOptions
    , String -> [OptDescr (SharedOptions -> SharedOptions)] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
"TARGET languages" [OptDescr (SharedOptions -> SharedOptions)]
targetOptions
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Target -> String) -> [Target] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Target -> String
targetUsage [Target]
helpTargets
  where
  helpTargets :: [Target]
helpTargets = [ Target
TargetHaskell, Target
TargetJava, Target
TargetC, Target
TargetCpp ]
  targetUsage :: Target -> String
targetUsage Target
t = String -> [OptDescr (SharedOptions -> SharedOptions)] -> String
forall a. String -> [OptDescr a] -> String
usageInfo
    (String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Special options for the %s backend" (Target -> String
forall a. Show a => a -> String
show Target
t))
    (Target -> [OptDescr (SharedOptions -> SharedOptions)]
specificOptions' Target
t)

-- ~~~ Parsing machinery ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

-- | Main parsing function
parseMode :: [String] -> (Mode, UsageWarnings)
parseMode :: [String] -> (Mode, [String])
parseMode [String]
args =
  case WriterT [String] (Either String) Mode
-> Either String (Mode, [String])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [String] (Either String) Mode
 -> Either String (Mode, [String]))
-> WriterT [String] (Either String) Mode
-> Either String (Mode, [String])
forall a b. (a -> b) -> a -> b
$ [String] -> WriterT [String] (Either String) Mode
parseMode' ([String] -> WriterT [String] (Either String) Mode)
-> WriterT [String] (Either String) [String]
-> WriterT [String] (Either String) Mode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [String] -> WriterT [String] (Either String) [String]
translateOldOptions [String]
args of
    Left String
err  -> (String -> Mode
UsageError String
err, [])
    Right (Mode, [String])
res -> (Mode, [String])
res

type ParseOpt = WriterT UsageWarnings (Either String)
type UsageWarnings = [String]

instance {-# OVERLAPPING #-} Semigroup (ParseOpt ()) where <> :: ParseOpt () -> ParseOpt () -> ParseOpt ()
(<>)   = ParseOpt () -> ParseOpt () -> ParseOpt ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)
instance {-# OVERLAPPING #-} Monoid    (ParseOpt ()) where mempty :: ParseOpt ()
mempty = () -> ParseOpt ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (); mappend :: ParseOpt () -> ParseOpt () -> ParseOpt ()
mappend = ParseOpt () -> ParseOpt () -> ParseOpt ()
forall a. Semigroup a => a -> a -> a
(<>)

parseMode' :: [String] -> ParseOpt Mode
parseMode' :: [String] -> WriterT [String] (Either String) Mode
parseMode' []   = Mode -> WriterT [String] (Either String) Mode
forall (m :: * -> *) a. Monad m => a -> m a
return Mode
Help
parseMode' [String]
args =
  -- First, check for global options like --help or --version
  case ArgOrder Mode
-> [OptDescr Mode]
-> [String]
-> ([Mode], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder Mode
forall a. ArgOrder a
Permute [OptDescr Mode]
globalOptions [String]
args of
   (Mode
mode:[Mode]
_,[String]
_,[String]
_,[String]
_) -> Mode -> WriterT [String] (Either String) Mode
forall (m :: * -> *) a. Monad m => a -> m a
return Mode
mode

   -- Then, check for unrecognized options.
   ([Mode], [String], [String], [String])
_ -> do
    let ([SharedOptions -> SharedOptions]
_, [String]
_, [String]
unknown, [String]
_) = ArgOrder (SharedOptions -> SharedOptions)
-> [OptDescr (SharedOptions -> SharedOptions)]
-> [String]
-> ([SharedOptions -> SharedOptions], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder (SharedOptions -> SharedOptions)
forall a. ArgOrder a
Permute [OptDescr (SharedOptions -> SharedOptions)]
allOptions [String]
args
    [String] -> ParseOpt ()
processUnknownOptions [String]
unknown

    -- Then, determine target language.
    case ArgOrder (SharedOptions -> SharedOptions)
-> [OptDescr (SharedOptions -> SharedOptions)]
-> [String]
-> ([SharedOptions -> SharedOptions], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder (SharedOptions -> SharedOptions)
forall a. ArgOrder a
Permute [OptDescr (SharedOptions -> SharedOptions)]
targetOptions [String]
args of
      -- ([]     ,_,_,_) -> usageError "No target selected"  -- --haskell is default target
      (SharedOptions -> SharedOptions
_:SharedOptions -> SharedOptions
_:[SharedOptions -> SharedOptions]
_,[String]
_,[String]
_,[String]
_) -> String -> WriterT [String] (Either String) Mode
usageError String
"At most one target is allowed"

      -- Finally, parse options with known target.
      ([SharedOptions -> SharedOptions]
optionUpdates,[String]
_,[String]
_,[String]
_) -> do
        let tgt :: Target
tgt = SharedOptions -> Target
target ([SharedOptions -> SharedOptions] -> SharedOptions
forall (t :: * -> *).
Foldable t =>
t (SharedOptions -> SharedOptions) -> SharedOptions
options [SharedOptions -> SharedOptions]
optionUpdates)
        case ArgOrder (SharedOptions -> SharedOptions)
-> [OptDescr (SharedOptions -> SharedOptions)]
-> [String]
-> ([SharedOptions -> SharedOptions], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder (SharedOptions -> SharedOptions)
forall a. ArgOrder a
Permute (Target -> [OptDescr (SharedOptions -> SharedOptions)]
allOptions' Target
tgt) [String]
args of
          ([SharedOptions -> SharedOptions]
_,  [String]
_, [String]
_,      String
e:[String]
_) -> String -> WriterT [String] (Either String) Mode
usageError String
e
          ([SharedOptions -> SharedOptions]
_,  [String]
_, [String
u],      [String]
_) -> String -> WriterT [String] (Either String) Mode
usageError (String -> WriterT [String] (Either String) Mode)
-> String -> WriterT [String] (Either String) Mode
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ String
"Backend", Target -> String
forall a. Show a => a -> String
show Target
tgt, String
"does not support option", String
u ]
          ([SharedOptions -> SharedOptions]
_,  [String]
_, us :: [String]
us@(String
_:[String]
_), [String]
_) -> String -> WriterT [String] (Either String) Mode
usageError (String -> WriterT [String] (Either String) Mode)
-> String -> WriterT [String] (Either String) Mode
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ String
"Backend", Target -> String
forall a. Show a => a -> String
show Target
tgt, String
"does not support options" ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
us
          ([SharedOptions -> SharedOptions]
_, [], [String]
_,        [String]
_) -> String -> WriterT [String] (Either String) Mode
usageError String
"Missing grammar file"
          ([SharedOptions -> SharedOptions]
optionsUpdates, [String
grammarFile], [], []) -> do
            let opts :: SharedOptions
opts = ([SharedOptions -> SharedOptions] -> SharedOptions
forall (t :: * -> *).
Foldable t =>
t (SharedOptions -> SharedOptions) -> SharedOptions
options [SharedOptions -> SharedOptions]
optionsUpdates)
                       { lbnfFile :: String
lbnfFile = String
grammarFile
                       , lang :: String
lang = ShowS
takeBaseName String
grammarFile
                       }
            Target -> ParseOpt ()
forall a. Maintained a => a -> ParseOpt ()
warnDeprecatedBackend Target
tgt
            SharedOptions -> ParseOpt ()
warnDeprecatedOptions SharedOptions
opts
            Mode -> WriterT [String] (Either String) Mode
forall (m :: * -> *) a. Monad m => a -> m a
return (Mode -> WriterT [String] (Either String) Mode)
-> Mode -> WriterT [String] (Either String) Mode
forall a b. (a -> b) -> a -> b
$ SharedOptions -> String -> Mode
Target SharedOptions
opts String
grammarFile
          ([SharedOptions -> SharedOptions]
_,  [String]
_, [String]
_,        [String]
_) -> String -> WriterT [String] (Either String) Mode
usageError String
"Too many arguments"
  where
  options :: t (SharedOptions -> SharedOptions) -> SharedOptions
options t (SharedOptions -> SharedOptions)
optionsUpdates = ((SharedOptions -> SharedOptions)
 -> (SharedOptions -> SharedOptions)
 -> SharedOptions
 -> SharedOptions)
-> (SharedOptions -> SharedOptions)
-> t (SharedOptions -> SharedOptions)
-> SharedOptions
-> SharedOptions
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (SharedOptions -> SharedOptions)
-> (SharedOptions -> SharedOptions)
-> SharedOptions
-> SharedOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) SharedOptions -> SharedOptions
forall a. a -> a
id t (SharedOptions -> SharedOptions)
optionsUpdates SharedOptions
defaultOptions
  usageError :: String -> WriterT [String] (Either String) Mode
usageError = Mode -> WriterT [String] (Either String) Mode
forall (m :: * -> *) a. Monad m => a -> m a
return (Mode -> WriterT [String] (Either String) Mode)
-> (String -> Mode)
-> String
-> WriterT [String] (Either String) Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Mode
UsageError


-- * Deprecation

class Maintained a where
  maintained   :: a -> Bool
  printFeature :: a -> String

instance Maintained Target where
  printFeature :: Target -> String
printFeature = Target -> String
printTargetOption
  maintained :: Target -> Bool
maintained = \case
    Target
TargetC           -> Bool
True
    Target
TargetCpp         -> Bool
True
    Target
TargetCppNoStl    -> Bool
True
    Target
TargetHaskell     -> Bool
True
    Target
TargetHaskellGadt -> Bool
True
    Target
TargetLatex       -> Bool
True
    Target
TargetJava        -> Bool
True
    Target
TargetOCaml       -> Bool
True
    Target
TargetPygments    -> Bool
True
    Target
TargetCheck       -> Bool
True

instance Maintained AlexVersion where
  printFeature :: AlexVersion -> String
printFeature = AlexVersion -> String
printAlexOption
  maintained :: AlexVersion -> Bool
maintained = \case
    AlexVersion
Alex3 -> Bool
True

instance Maintained HappyMode where
  printFeature :: HappyMode -> String
printFeature = \case
    HappyMode
Standard -> String
forall a. HasCallStack => a
undefined
    HappyMode
GLR      -> String
"--glr"
  maintained :: HappyMode -> Bool
maintained = \case
    HappyMode
Standard -> Bool
True
    HappyMode
GLR      -> Bool
False

warnDeprecatedBackend :: Maintained a => a -> ParseOpt ()
warnDeprecatedBackend :: a -> ParseOpt ()
warnDeprecatedBackend a
backend =
  Bool -> ParseOpt () -> ParseOpt ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Ctrl.unless (a -> Bool
forall a. Maintained a => a -> Bool
maintained a
backend) (ParseOpt () -> ParseOpt ()) -> ParseOpt () -> ParseOpt ()
forall a b. (a -> b) -> a -> b
$ String -> ParseOpt ()
warnDeprecated (String -> ParseOpt ()) -> String -> ParseOpt ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [ String
"backend", a -> String
forall a. Maintained a => a -> String
printFeature a
backend ]

warnDeprecated :: String -> ParseOpt ()
warnDeprecated :: String -> ParseOpt ()
warnDeprecated String
feature =
  [String] -> ParseOpt ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    [ [String] -> String
unwords [ String
"Warning:", String
feature, String
"is deprecated and no longer maintained." ]
    -- , "Should it be broken, try an older version of BNFC."
    ]

warnDeprecatedOptions :: SharedOptions -> ParseOpt ()
warnDeprecatedOptions :: SharedOptions -> ParseOpt ()
warnDeprecatedOptions Options{Bool
Int
String
Maybe String
TokenText
RecordPositions
JavaLexerParser
OCamlParser
HappyMode
AlexVersion
Target
wcf :: Bool
visualStudio :: Bool
javaLexerParser :: JavaLexerParser
ocamlParser :: OCamlParser
agda :: Bool
xml :: Int
glr :: HappyMode
tokenText :: TokenText
alexMode :: AlexVersion
generic :: Bool
functor :: Bool
inDir :: Bool
linenumbers :: RecordPositions
inPackage :: Maybe String
make :: Maybe String
target :: Target
force :: Bool
outDir :: String
lang :: String
lbnfFile :: String
wcf :: SharedOptions -> Bool
visualStudio :: SharedOptions -> Bool
javaLexerParser :: SharedOptions -> JavaLexerParser
ocamlParser :: SharedOptions -> OCamlParser
agda :: SharedOptions -> Bool
xml :: SharedOptions -> Int
glr :: SharedOptions -> HappyMode
tokenText :: SharedOptions -> TokenText
alexMode :: SharedOptions -> AlexVersion
generic :: SharedOptions -> Bool
functor :: SharedOptions -> Bool
inDir :: SharedOptions -> Bool
linenumbers :: SharedOptions -> RecordPositions
inPackage :: SharedOptions -> Maybe String
make :: SharedOptions -> Maybe String
target :: SharedOptions -> Target
force :: SharedOptions -> Bool
outDir :: SharedOptions -> String
lang :: SharedOptions -> String
lbnfFile :: SharedOptions -> String
..} = do
  AlexVersion -> ParseOpt ()
forall a. Maintained a => a -> ParseOpt ()
warnDeprecatedBackend AlexVersion
alexMode
  HappyMode -> ParseOpt ()
forall a. Maintained a => a -> ParseOpt ()
warnDeprecatedBackend HappyMode
glr

-- * Backward compatibility

-- | Produce a warning for former options that are now obsolete.
--   Throw an error for properly unknown options.
--
--   Note: this only works properly for former options that had no arguments.
processUnknownOptions :: [String] -> ParseOpt ()
processUnknownOptions :: [String] -> ParseOpt ()
processUnknownOptions [String]
os = do

  -- Classify unknown options.
  let cl :: [Either
   (Either (String, UnknownOption) (String, RemovedOption))
   (String, ObsoleteOption)]
cl = (String
 -> Either
      (Either (String, UnknownOption) (String, RemovedOption))
      (String, ObsoleteOption))
-> [String]
-> [Either
      (Either (String, UnknownOption) (String, RemovedOption))
      (String, ObsoleteOption)]
forall a b. (a -> b) -> [a] -> [b]
map (\ String
o -> (Either UnknownOption RemovedOption
 -> Either (String, UnknownOption) (String, RemovedOption))
-> (ObsoleteOption -> (String, ObsoleteOption))
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
-> Either
     (Either (String, UnknownOption) (String, RemovedOption))
     (String, ObsoleteOption)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((UnknownOption -> (String, UnknownOption))
-> (RemovedOption -> (String, RemovedOption))
-> Either UnknownOption RemovedOption
-> Either (String, UnknownOption) (String, RemovedOption)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String
o,) (String
o,)) (String
o,) (Either (Either UnknownOption RemovedOption) ObsoleteOption
 -> Either
      (Either (String, UnknownOption) (String, RemovedOption))
      (String, ObsoleteOption))
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
-> Either
     (Either (String, UnknownOption) (String, RemovedOption))
     (String, ObsoleteOption)
forall a b. (a -> b) -> a -> b
$ String
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
classifyUnknownOption String
o) [String]
os
  let ([Either (String, UnknownOption) (String, RemovedOption)]
errs, [(String, ObsoleteOption)]
obsolete) = [Either
   (Either (String, UnknownOption) (String, RemovedOption))
   (String, ObsoleteOption)]
-> ([Either (String, UnknownOption) (String, RemovedOption)],
    [(String, ObsoleteOption)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
   (Either (String, UnknownOption) (String, RemovedOption))
   (String, ObsoleteOption)]
cl

  -- Print warnings about obsolete options.
  case ((String, ObsoleteOption) -> String)
-> [(String, ObsoleteOption)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (String
o, ObsoleteOption
ObsoleteOption) -> String
o) [(String, ObsoleteOption)]
obsolete of
    []       -> () -> ParseOpt ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    os :: [String]
os@[String
_]   -> [String] -> ParseOpt ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"Warning: ignoring obsolete option:"  String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
os ]
    os :: [String]
os@(String
_:[String]
_) -> [String] -> ParseOpt ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"Warning: ignoring obsolete options:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
os ]

  -- Throw errors.
  Bool -> ParseOpt () -> ParseOpt ()
forall m. Monoid m => Bool -> m -> m
unless ([Either (String, UnknownOption) (String, RemovedOption)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Either (String, UnknownOption) (String, RemovedOption)]
errs) (ParseOpt () -> ParseOpt ()) -> ParseOpt () -> ParseOpt ()
forall a b. (a -> b) -> a -> b
$ do
    let ([(String, UnknownOption)]
unknown, [(String, RemovedOption)]
removed) = [Either (String, UnknownOption) (String, RemovedOption)]
-> ([(String, UnknownOption)], [(String, RemovedOption)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (String, UnknownOption) (String, RemovedOption)]
errs
    String -> ParseOpt ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ParseOpt ()) -> String -> ParseOpt ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ String
"Option error(s):" ]
      , case ((String, UnknownOption) -> String)
-> [(String, UnknownOption)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (String
o, UnknownOption
UnknownOption) -> String
o) [(String, UnknownOption)]
unknown of
          []       -> []
          us :: [String]
us@[String
_]   -> [ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized option:"  String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
us ]
          us :: [String]
us@(String
_:[String]
_) -> [ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized options:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
us ]
      , ((String, RemovedOption) -> String)
-> [(String, RemovedOption)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (String
o, RemovedOption String
msg) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
o, String
": ", String
msg ]) [(String, RemovedOption)]
removed
      ]

-- | Option has never been known.
data UnknownOption  = UnknownOption

-- | Option is obsolete, print warning and continue.
data ObsoleteOption = ObsoleteOption

-- | Error: Option has been removed, throw error with given message.
newtype RemovedOption = RemovedOption String

classifyUnknownOption :: String -> Either (Either UnknownOption RemovedOption) ObsoleteOption
classifyUnknownOption :: String
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
classifyUnknownOption = \case
  String
"--alex1" -> String
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
forall a b. String -> Either (Either a RemovedOption) b
supportRemovedIn290 (String
 -> Either (Either UnknownOption RemovedOption) ObsoleteOption)
-> String
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
forall a b. (a -> b) -> a -> b
$ String
"Alex version 1"
  String
"--alex2" -> String
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
forall a b. String -> Either (Either a RemovedOption) b
supportRemovedIn290 (String
 -> Either (Either UnknownOption RemovedOption) ObsoleteOption)
-> String
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
forall a b. (a -> b) -> a -> b
$ String
"Alex version 2"
  String
"--alex3" -> Either (Either UnknownOption RemovedOption) ObsoleteOption
forall a. Either a ObsoleteOption
obsolete
  s :: String
s@String
"--sharestrings" -> String
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
forall a b. String -> Either (Either a RemovedOption) b
optionRemovedIn290 String
s
  s :: String
s@String
"--cnf" -> String
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
forall a b. String -> Either (Either a RemovedOption) b
optionRemovedIn290 String
s
  String
"--csharp" -> String
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
forall a b. String -> Either (Either a RemovedOption) b
supportRemovedIn290 String
"C#"
  String
"--profile" -> String
-> Either (Either UnknownOption RemovedOption) ObsoleteOption
forall a b. String -> Either (Either a RemovedOption) b
supportRemovedIn290 String
"permutation profiles"
  String
_ -> Either (Either UnknownOption RemovedOption) ObsoleteOption
forall b b. Either (Either UnknownOption b) b
unknown
  where
  unknown :: Either (Either UnknownOption b) b
unknown  = Either UnknownOption b -> Either (Either UnknownOption b) b
forall a b. a -> Either a b
Left (Either UnknownOption b -> Either (Either UnknownOption b) b)
-> Either UnknownOption b -> Either (Either UnknownOption b) b
forall a b. (a -> b) -> a -> b
$ UnknownOption -> Either UnknownOption b
forall a b. a -> Either a b
Left UnknownOption
UnknownOption
  obsolete :: Either a ObsoleteOption
obsolete = ObsoleteOption -> Either a ObsoleteOption
forall a b. b -> Either a b
Right ObsoleteOption
ObsoleteOption
  removed :: String -> Either (Either a RemovedOption) b
removed  = Either a RemovedOption -> Either (Either a RemovedOption) b
forall a b. a -> Either a b
Left (Either a RemovedOption -> Either (Either a RemovedOption) b)
-> (String -> Either a RemovedOption)
-> String
-> Either (Either a RemovedOption) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemovedOption -> Either a RemovedOption
forall a b. b -> Either a b
Right (RemovedOption -> Either a RemovedOption)
-> (String -> RemovedOption) -> String -> Either a RemovedOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RemovedOption
RemovedOption
  supportRemovedIn290 :: String -> Either (Either a RemovedOption) b
supportRemovedIn290 String
feature = String -> Either (Either a RemovedOption) b
forall a b. String -> Either (Either a RemovedOption) b
removed (String -> Either (Either a RemovedOption) b)
-> String -> Either (Either a RemovedOption) b
forall a b. (a -> b) -> a -> b
$
    [String] -> String
unwords [ String
"Support for", String
feature, String
removedIn290 ]
  optionRemovedIn290 :: String -> Either (Either a RemovedOption) b
optionRemovedIn290 String
o = String -> Either (Either a RemovedOption) b
forall a b. String -> Either (Either a RemovedOption) b
removed (String -> Either (Either a RemovedOption) b)
-> String -> Either (Either a RemovedOption) b
forall a b. (a -> b) -> a -> b
$
    [String] -> String
unwords [ String
"Option", String
o, String
removedIn290 ]

removedIn290 :: String
removedIn290 :: String
removedIn290 = String
"has been removed in version 2.9.0."

-- | A translation function to maintain backward compatibility
--   with the old option syntax.

translateOldOptions :: [String] -> ParseOpt [String]
translateOldOptions :: [String] -> WriterT [String] (Either String) [String]
translateOldOptions = (String -> WriterT [String] (Either String) String)
-> [String] -> WriterT [String] (Either String) [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> WriterT [String] (Either String) String)
 -> [String] -> WriterT [String] (Either String) [String])
-> (String -> WriterT [String] (Either String) String)
-> [String]
-> WriterT [String] (Either String) [String]
forall a b. (a -> b) -> a -> b
$ \ String
o -> do
   case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
o Map String String
translation of
     Maybe String
Nothing -> String -> WriterT [String] (Either String) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
o
     Just String
o' -> do
       [String] -> ParseOpt ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ [String] -> String
unwords [ String
"Warning: unrecognized option", String
o, String
"treated as if", String
o', String
"was provided." ] ]
       String -> WriterT [String] (Either String) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
o'
  where
  translation :: Map String String
translation = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, String)] -> Map String String)
-> [(String, String)] -> Map String String
forall a b. (a -> b) -> a -> b
$
    [ (String
"-agda"         , String
"--agda")
    , (String
"-java"         , String
"--java")
    , (String
"-java1.5"      , String
"--java")
    , (String
"-c"            , String
"--c")
    , (String
"-cpp"          , String
"--cpp")
    , (String
"-cpp_stl"      , String
"--cpp")
    , (String
"-cpp_no_stl"   , String
"--cpp-nostl")
    , (String
"-csharp"       , String
"--csharp")
    , (String
"-ocaml"        , String
"--ocaml")
    , (String
"-haskell"      , String
"--haskell")
    , (String
"-prof"         , String
"--profile")
    , (String
"-gadt"         , String
"--haskell-gadt")
    , (String
"-alex1"        , String
"--alex1")
    , (String
"-alex2"        , String
"--alex2")
    , (String
"-alex3"        , String
"--alex3")
    , (String
"-sharestrings" , String
"--sharestring")
    , (String
"-bytestrings"  , String
"--bytestring")
    , (String
"-glr"          , String
"--glr")
    , (String
"-xml"          , String
"--xml")
    , (String
"-xmlt"         , String
"--xmlt")
    , (String
"-vs"           , String
"--vs")
    , (String
"-wcf"          , String
"--wcf")
    , (String
"-generic"             , String
"--generic")
    , (String
"--ghc"                , String
"--generic")
    , (String
"--deriveGeneric"      , String
"--generic")
    , (String
"--deriveDataTypeable" , String
"--generic")
    ]