@@ -1,5 +1,6 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE GADTs #-}
3+{-# LANGUAGE OverloadedStrings #-}
34module CommandLine.Args.Internal
45 ( get
56 , Flags, noFlags, flags, (|--)
@@ -12,16 +13,15 @@ module CommandLine.Args.Internal
1213 )
1314 where
1415
16+
17+import Data.Monoid ((<>))
1518import qualified Data.Char as Char
1619import qualified Data.List as List
1720import GHC.IO.Handle (hIsTerminalDevice)
1821import System.Environment (getArgs)
1922import System.Exit (exitFailure)
2023import System.IO (hPutStrLn, stderr)
21−import Text.PrettyPrint.ANSI.Leijen
22− ( Doc, (<>), comma, displayIO, fillSep, green
23− , plain, red, renderPretty, text, vcat
24− )
24+import qualified Text.PrettyPrint.ANSI.Leijen as P
2525
2626import Elm.Utils (nearbyNames)
2727
@@ -667,23 +667,21 @@ failure :: Error -> IO a
667667failure err =
668668 do let doc = toDoc err
669669 isTerminal <- hIsTerminalDevice stderr
670− displayIO stderr $ renderPretty 1 80 $
671− if isTerminal then doc else plain doc
670+ P.displayIO stderr $ P.renderPretty 1 80 $
671+ if isTerminal then doc else P.plain doc
672672 hPutStrLn stderr ""
673673 exitFailure
674674
675675
676−toDoc :: Error -> Doc
676+toDoc :: Error -> P.Doc
677677toDoc err =
678678 case err of
679679 BadCommand badName suggestions lastSuggestion ->
680− fillSep $
681− [ text "There is no"
682− , code badName
683− , text "command."
684− , text "Did you mean"
680+ P.fillSep $
681+ ["There","is","no",toRed badName,"command.","Try"
685682 ]
686− ++ oxfordify (map code suggestions) "or" (code lastSuggestion <> text "?")
683+ ++ oxfordify (map toGreen suggestions) "or" (toGreen lastSuggestion)
684+ ++ ["instead?"]
687685
688686 NoCommand (BadArgs argError) ->
689687 argErrorToDoc Nothing argError
@@ -698,31 +696,41 @@ toDoc err =
698696 flagErrorToDoc (Just name) flagError
699697
700698
699+toRed :: String -> P.Doc
700+toRed str =
701+ P.red (P.text str)
702+
703+
704+toGreen :: String -> P.Doc
705+toGreen str =
706+ P.green (P.text str)
707+
708+
701709
702710-- ARG FAILURE
703711
704712
705−argErrorToDoc :: Maybe String -> ArgError -> Doc
713+argErrorToDoc :: Maybe String -> ArgError -> P.Doc
706714argErrorToDoc maybeCommand argError =
707715 case argError of
708716 NoneOf argErrors ->
709− text $ "TODO - " ++ show (map (argErrorToDoc maybeCommand) argErrors)
717+ P.text $ "TODO - " ++ show (map (argErrorToDoc maybeCommand) argErrors)
710718
711719 MissingArg (ParserInfo tipe) ->
712− text $ "TODO - " ++ tipe
720+ P.text $ "TODO - " ++ tipe
713721
714722 BadArg chunk _parserError ->
715− text $ "TODO - " ++ chunk
723+ P.text $ "TODO - " ++ chunk
716724
717725 ExtraArgs extraChunks ->
718− text $ "TODO - " ++ show extraChunks
726+ P.text $ "TODO - " ++ show extraChunks
719727
720728
721729
722730-- FLAG FAILURE
723731
724732
725−flagErrorToDoc :: Maybe String -> FlagError -> Doc
733+flagErrorToDoc :: Maybe String -> FlagError -> P.Doc
726734flagErrorToDoc maybeCommand flagError =
727735 case flagError of
728736 BadOnOff name value ->
@@ -731,121 +739,108 @@ flagErrorToDoc maybeCommand flagError =
731739 "--" ++ name ++ "=" ++ value
732740 in
733741 if null value then
734− flagErrorToDocHelp "This on/off flag has a trailing equals sign:" chunk
735− [ fillSep
736− [ text "Just get rid of the equals sign, like this:"
737− , green (text ("--" ++ name))
742+ flagErrorToDocHelp
743+ "This on/off flag has a trailing equals sign:"
744+ chunk
745+ [ P.fillSep
746+ ["Just","get","rid","of","the","equals","sign,","like","this:"
747+ , toGreen ("--" ++ name)
738748 ]
739749 ]
740750
741751 else
742− flagErrorToDocHelp "This on/off flag was given a value:" chunk
743− [ text "An on/off flag either exists or not, no need for an equals sign and value."
744− , text "Maybe you want this instead?"
745− , text ""
746− , text " " <> green (text ("--" ++ name))
747− , text ""
752+ flagErrorToDocHelp
753+ "This on/off flag was given a value:"
754+ chunk
755+ [ "An on/off flag either exists or not, no need for an equals sign and value.\n\
756+ \Maybe you want this instead?"
757+ , P.indent 4 (toGreen ("--" ++ name))
748758 ]
749759
750760 BadFlag name (ParserInfo tipe) Nothing ->
751761 flagErrorToDocHelp
752762 "This flag cannot appear without a value:"
753763 ("--" ++ name)
754− [ text $ "It needs a " ++ tipe ++ " value."
764+ [ P.fillSep ["It","needs","a",toGreen tipe,"value."]
755765 ]
756766
757767 BadFlag name (ParserInfo tipe) (Just (value, parserError)) ->
758768 flagErrorToDocHelp
759769 "This flag was given a bad value:"
760770 ("--" ++ name ++ "=" ++ value)
761− [ fillSep $ map text $ words $
762− "I need a " ++ tipe ++ " value, but "
771+ [ P.fillSep $
772+ ["I","need","a",toGreen tipe,"value,","but"
773+ ]
763774 ++
764775 case parserError of
765776 Expecting expectedType ->
766− value ++ " is not a valid " ++ expectedType ++ "."
777+ [P.text value,"is","not","a","valid",P.text expectedType <> "."]
767778 ]
768779
769780 Unrecognized chunk [] ->
770− let
771− explanation =
772− case maybeCommand of
773− Nothing ->
774− "I am not expecting any flags."
775−
776− Just command ->
777− "The `" ++ command ++ "` command does not expect any flags."
778− in
779− flagErrorToDocHelp "Get rid of this flag:" chunk $
780− [ fillSep (map text (words explanation))
781+ flagErrorToDocHelp
782+ "Get rid of this flag:"
783+ chunk
784+ [ P.fillSep $ map P.text $ words $
785+ case maybeCommand of
786+ Nothing ->
787+ "I am not expecting any flags."
788+
789+ Just command ->
790+ "The `" ++ command ++ "` command does not expect any flags."
781791 ]
782792
783793 Unrecognized chunk info ->
784794 case takeWhile ('=' /=) (dropWhile ('-' ==) chunk) of
785795 "" ->
786− flagErrorToDocHelp "This is not a valid flag:" chunk
787− [ text "Valid flags look like --output=FILE"
796+ flagErrorToDocHelp
797+ "This is not a valid flag:"
798+ chunk
799+ [ P.fillSep ["Valid","flags","look","like",P.green "--output=FILE"]
788800 ]
789801
790802 name ->
791803 let
792− suggestions =
793− nearbyNames id name (map fst info)
804+ closeNames = nearbyNames id name (map fst info)
805+ suggestions = if null closeNames then map fst info else closeNames
806+ toFlag str = toGreen ("--" ++ str)
794807 in
795− flagErrorToDocHelp "I do not recognize this flag:" chunk $
796− unrecognizedExplanation $
797− if null suggestions then map fst info else suggestions
808+ flagErrorToDocHelp
809+ "I do not recognize this flag:"
810+ chunk
811+ (
812+ case suggestions of
813+ [] ->
814+ []
815+
816+ [suggestion] ->
817+ [ P.fillSep ["Looks","like","a","typo.","Maybe","you","want",toFlag suggestion,"instead?"]
818+ ]
819+
820+ _ ->
821+ [ P.fillSep ["Maybe","you","want","one","of","these","instead?"]
822+ , P.indent 4 (P.vcat (map toFlag suggestions))
823+ ]
824+ )
798825
799826
800−flagErrorToDocHelp :: String -> String -> [Doc] -> Doc
827+flagErrorToDocHelp :: String -> String -> [P.Doc] -> P.Doc
801828flagErrorToDocHelp summary original explanation =
802− vcat $
803− [ text summary
804− , text ""
805− , text " " <> red (text original)
806− , text ""
829+ P.vcat $ concatMap (\d -> [d,""]) $
830+ [ P.fillSep (map P.text (words summary))
831+ , P.indent 4 (toRed original)
807832 ]
808833 ++ explanation
809834
810835
811−unrecognizedExplanation :: [String] -> [Doc]
812−unrecognizedExplanation suggestions =
813− let
814− toBullet name =
815− text " " <> green (text ("--" ++ name))
816− in
817− case suggestions of
818− [] ->
819− []
820−
821− [suggestion] ->
822− [ text "Looks like a typo. Maybe you want:"
823− , text ""
824− , toBullet suggestion
825− , text ""
826− ]
827−
828− _ ->
829− [ text "Maybe you want one of these?"
830− , text ""
831− ]
832− ++ map toBullet suggestions
833− ++ [ text "" ]
834−
835−
836−code :: String -> Doc
837−code str =
838− red (text str)
839−
840−
841−oxfordify :: [Doc] -> String -> Doc -> [Doc]
836+oxfordify :: [P.Doc] -> String -> P.Doc -> [P.Doc]
842837oxfordify chunks conjuction lastChunk =
843838 case chunks of
844839 [] ->
845840 [ lastChunk ]
846841
847842 [chunk] ->
848− [ chunk, text conjuction, lastChunk ]
843+ [ chunk, P.text conjuction, lastChunk ]
849844
850845 _ ->
851− map (<> comma) chunks ++ [ text conjuction, lastChunk ]
846+ map (<> P.comma) chunks ++ [ P.text conjuction, lastChunk ]