{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}

module Highlight.Common.Options where

import Prelude ()
import Prelude.Compat

import Control.Applicative (many)
import Control.Lens (Lens', lens)
import Data.String (IsString)
import Options.Applicative
       (Parser, flag, help, long, metavar, short, strArgument)

-----------------
-- Ignore case --
-----------------

-- | Whether or not the case of a regular expression should be ignored.
-- Similar to @grep@'s @--ignore-case@ option.
data IgnoreCase = IgnoreCase | DoNotIgnoreCase
  deriving (IgnoreCase -> IgnoreCase -> Bool
(IgnoreCase -> IgnoreCase -> Bool)
-> (IgnoreCase -> IgnoreCase -> Bool) -> Eq IgnoreCase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IgnoreCase -> IgnoreCase -> Bool
$c/= :: IgnoreCase -> IgnoreCase -> Bool
== :: IgnoreCase -> IgnoreCase -> Bool
$c== :: IgnoreCase -> IgnoreCase -> Bool
Eq, ReadPrec [IgnoreCase]
ReadPrec IgnoreCase
Int -> ReadS IgnoreCase
ReadS [IgnoreCase]
(Int -> ReadS IgnoreCase)
-> ReadS [IgnoreCase]
-> ReadPrec IgnoreCase
-> ReadPrec [IgnoreCase]
-> Read IgnoreCase
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IgnoreCase]
$creadListPrec :: ReadPrec [IgnoreCase]
readPrec :: ReadPrec IgnoreCase
$creadPrec :: ReadPrec IgnoreCase
readList :: ReadS [IgnoreCase]
$creadList :: ReadS [IgnoreCase]
readsPrec :: Int -> ReadS IgnoreCase
$creadsPrec :: Int -> ReadS IgnoreCase
Read, Int -> IgnoreCase -> ShowS
[IgnoreCase] -> ShowS
IgnoreCase -> String
(Int -> IgnoreCase -> ShowS)
-> (IgnoreCase -> String)
-> ([IgnoreCase] -> ShowS)
-> Show IgnoreCase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IgnoreCase] -> ShowS
$cshowList :: [IgnoreCase] -> ShowS
show :: IgnoreCase -> String
$cshow :: IgnoreCase -> String
showsPrec :: Int -> IgnoreCase -> ShowS
$cshowsPrec :: Int -> IgnoreCase -> ShowS
Show)

class HasIgnoreCase r where
  ignoreCaseLens :: Lens' r IgnoreCase
  default ignoreCaseLens :: HasCommonOptions r => Lens' r IgnoreCase
  ignoreCaseLens = (CommonOptions -> f CommonOptions) -> r -> f r
forall r. HasCommonOptions r => Lens' r CommonOptions
commonOptionsLens ((CommonOptions -> f CommonOptions) -> r -> f r)
-> ((IgnoreCase -> f IgnoreCase)
    -> CommonOptions -> f CommonOptions)
-> (IgnoreCase -> f IgnoreCase)
-> r
-> f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IgnoreCase -> f IgnoreCase) -> CommonOptions -> f CommonOptions
forall r. HasIgnoreCase r => Lens' r IgnoreCase
ignoreCaseLens

ignoreCaseParser :: Parser IgnoreCase
ignoreCaseParser :: Parser IgnoreCase
ignoreCaseParser =
  IgnoreCase
-> IgnoreCase -> Mod FlagFields IgnoreCase -> Parser IgnoreCase
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
    IgnoreCase
DoNotIgnoreCase
    IgnoreCase
IgnoreCase
    (String -> Mod FlagFields IgnoreCase
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ignore-case" Mod FlagFields IgnoreCase
-> Mod FlagFields IgnoreCase -> Mod FlagFields IgnoreCase
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields IgnoreCase
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i' Mod FlagFields IgnoreCase
-> Mod FlagFields IgnoreCase -> Mod FlagFields IgnoreCase
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields IgnoreCase
forall (f :: * -> *) a. String -> Mod f a
help String
"ignore case distinctions")

---------------
-- Recursive --
---------------

-- | Whether or not files should be searched recursively.  Similar to @grep@'s
-- @--recursive@ option.
data Recursive = Recursive | NotRecursive
  deriving (Recursive -> Recursive -> Bool
(Recursive -> Recursive -> Bool)
-> (Recursive -> Recursive -> Bool) -> Eq Recursive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Recursive -> Recursive -> Bool
$c/= :: Recursive -> Recursive -> Bool
== :: Recursive -> Recursive -> Bool
$c== :: Recursive -> Recursive -> Bool
Eq, ReadPrec [Recursive]
ReadPrec Recursive
Int -> ReadS Recursive
ReadS [Recursive]
(Int -> ReadS Recursive)
-> ReadS [Recursive]
-> ReadPrec Recursive
-> ReadPrec [Recursive]
-> Read Recursive
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Recursive]
$creadListPrec :: ReadPrec [Recursive]
readPrec :: ReadPrec Recursive
$creadPrec :: ReadPrec Recursive
readList :: ReadS [Recursive]
$creadList :: ReadS [Recursive]
readsPrec :: Int -> ReadS Recursive
$creadsPrec :: Int -> ReadS Recursive
Read, Int -> Recursive -> ShowS
[Recursive] -> ShowS
Recursive -> String
(Int -> Recursive -> ShowS)
-> (Recursive -> String)
-> ([Recursive] -> ShowS)
-> Show Recursive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Recursive] -> ShowS
$cshowList :: [Recursive] -> ShowS
show :: Recursive -> String
$cshow :: Recursive -> String
showsPrec :: Int -> Recursive -> ShowS
$cshowsPrec :: Int -> Recursive -> ShowS
Show)

class HasRecursive r where
  recursiveLens :: Lens' r Recursive
  default recursiveLens :: HasCommonOptions r => Lens' r Recursive
  recursiveLens = (CommonOptions -> f CommonOptions) -> r -> f r
forall r. HasCommonOptions r => Lens' r CommonOptions
commonOptionsLens ((CommonOptions -> f CommonOptions) -> r -> f r)
-> ((Recursive -> f Recursive) -> CommonOptions -> f CommonOptions)
-> (Recursive -> f Recursive)
-> r
-> f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Recursive -> f Recursive) -> CommonOptions -> f CommonOptions
forall r. HasRecursive r => Lens' r Recursive
recursiveLens

recursiveParser :: Parser Recursive
recursiveParser :: Parser Recursive
recursiveParser =
  let mods :: Mod FlagFields a
mods =
        String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"recursive" Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<>
        Char -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod FlagFields a
forall (f :: * -> *) a. String -> Mod f a
help String
"recursive operate on files under specified directory"
  in Recursive
-> Recursive -> Mod FlagFields Recursive -> Parser Recursive
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Recursive
NotRecursive Recursive
Recursive Mod FlagFields Recursive
forall a. Mod FlagFields a
mods

---------------
-- Raw regex --
---------------

-- | The raw, pre-compiled regular expression passed in on the command line by
-- the user.
newtype RawRegex = RawRegex
  { RawRegex -> String
unRawRegex :: String
  } deriving (RawRegex -> RawRegex -> Bool
(RawRegex -> RawRegex -> Bool)
-> (RawRegex -> RawRegex -> Bool) -> Eq RawRegex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawRegex -> RawRegex -> Bool
$c/= :: RawRegex -> RawRegex -> Bool
== :: RawRegex -> RawRegex -> Bool
$c== :: RawRegex -> RawRegex -> Bool
Eq, String -> RawRegex
(String -> RawRegex) -> IsString RawRegex
forall a. (String -> a) -> IsString a
fromString :: String -> RawRegex
$cfromString :: String -> RawRegex
IsString, ReadPrec [RawRegex]
ReadPrec RawRegex
Int -> ReadS RawRegex
ReadS [RawRegex]
(Int -> ReadS RawRegex)
-> ReadS [RawRegex]
-> ReadPrec RawRegex
-> ReadPrec [RawRegex]
-> Read RawRegex
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RawRegex]
$creadListPrec :: ReadPrec [RawRegex]
readPrec :: ReadPrec RawRegex
$creadPrec :: ReadPrec RawRegex
readList :: ReadS [RawRegex]
$creadList :: ReadS [RawRegex]
readsPrec :: Int -> ReadS RawRegex
$creadsPrec :: Int -> ReadS RawRegex
Read, Int -> RawRegex -> ShowS
[RawRegex] -> ShowS
RawRegex -> String
(Int -> RawRegex -> ShowS)
-> (RawRegex -> String) -> ([RawRegex] -> ShowS) -> Show RawRegex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawRegex] -> ShowS
$cshowList :: [RawRegex] -> ShowS
show :: RawRegex -> String
$cshow :: RawRegex -> String
showsPrec :: Int -> RawRegex -> ShowS
$cshowsPrec :: Int -> RawRegex -> ShowS
Show)

class HasRawRegex r where
  rawRegexLens :: Lens' r RawRegex
  default rawRegexLens :: HasCommonOptions r => Lens' r RawRegex
  rawRegexLens = (CommonOptions -> f CommonOptions) -> r -> f r
forall r. HasCommonOptions r => Lens' r CommonOptions
commonOptionsLens ((CommonOptions -> f CommonOptions) -> r -> f r)
-> ((RawRegex -> f RawRegex) -> CommonOptions -> f CommonOptions)
-> (RawRegex -> f RawRegex)
-> r
-> f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RawRegex -> f RawRegex) -> CommonOptions -> f CommonOptions
forall r. HasRawRegex r => Lens' r RawRegex
rawRegexLens

rawRegexParser :: Parser RawRegex
rawRegexParser :: Parser RawRegex
rawRegexParser =
  let mods :: Mod ArgumentFields a
mods = String -> Mod ArgumentFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PATTERN"
  in String -> RawRegex
RawRegex (String -> RawRegex) -> Parser String -> Parser RawRegex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument Mod ArgumentFields String
forall a. Mod ArgumentFields a
mods

--------------------
-- input filename --
--------------------

-- | An input file passed in on the command line by the user.
newtype InputFilename = InputFilename
  { InputFilename -> String
unInputFilename :: FilePath
  } deriving (InputFilename -> InputFilename -> Bool
(InputFilename -> InputFilename -> Bool)
-> (InputFilename -> InputFilename -> Bool) -> Eq InputFilename
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputFilename -> InputFilename -> Bool
$c/= :: InputFilename -> InputFilename -> Bool
== :: InputFilename -> InputFilename -> Bool
$c== :: InputFilename -> InputFilename -> Bool
Eq, String -> InputFilename
(String -> InputFilename) -> IsString InputFilename
forall a. (String -> a) -> IsString a
fromString :: String -> InputFilename
$cfromString :: String -> InputFilename
IsString, ReadPrec [InputFilename]
ReadPrec InputFilename
Int -> ReadS InputFilename
ReadS [InputFilename]
(Int -> ReadS InputFilename)
-> ReadS [InputFilename]
-> ReadPrec InputFilename
-> ReadPrec [InputFilename]
-> Read InputFilename
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InputFilename]
$creadListPrec :: ReadPrec [InputFilename]
readPrec :: ReadPrec InputFilename
$creadPrec :: ReadPrec InputFilename
readList :: ReadS [InputFilename]
$creadList :: ReadS [InputFilename]
readsPrec :: Int -> ReadS InputFilename
$creadsPrec :: Int -> ReadS InputFilename
Read, Int -> InputFilename -> ShowS
[InputFilename] -> ShowS
InputFilename -> String
(Int -> InputFilename -> ShowS)
-> (InputFilename -> String)
-> ([InputFilename] -> ShowS)
-> Show InputFilename
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputFilename] -> ShowS
$cshowList :: [InputFilename] -> ShowS
show :: InputFilename -> String
$cshow :: InputFilename -> String
showsPrec :: Int -> InputFilename -> ShowS
$cshowsPrec :: Int -> InputFilename -> ShowS
Show)

class HasInputFilenames r where
  inputFilenamesLens :: Lens' r [InputFilename]
  default inputFilenamesLens :: HasCommonOptions r => Lens' r [InputFilename]
  inputFilenamesLens = (CommonOptions -> f CommonOptions) -> r -> f r
forall r. HasCommonOptions r => Lens' r CommonOptions
commonOptionsLens ((CommonOptions -> f CommonOptions) -> r -> f r)
-> (([InputFilename] -> f [InputFilename])
    -> CommonOptions -> f CommonOptions)
-> ([InputFilename] -> f [InputFilename])
-> r
-> f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([InputFilename] -> f [InputFilename])
-> CommonOptions -> f CommonOptions
forall r. HasInputFilenames r => Lens' r [InputFilename]
inputFilenamesLens

inputFilenamesParser :: Parser [InputFilename]
inputFilenamesParser :: Parser [InputFilename]
inputFilenamesParser =
  let mods :: Mod ArgumentFields a
mods = String -> Mod ArgumentFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
  in Parser InputFilename -> Parser [InputFilename]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser InputFilename -> Parser [InputFilename])
-> Parser InputFilename -> Parser [InputFilename]
forall a b. (a -> b) -> a -> b
$ String -> InputFilename
InputFilename (String -> InputFilename) -> Parser String -> Parser InputFilename
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument Mod ArgumentFields String
forall a. Mod ArgumentFields a
mods

--------------------
-- common options --
--------------------

-- | A set of options that are common to both the @highlight@ and @hrep@
-- applications.
data CommonOptions = CommonOptions
  { CommonOptions -> IgnoreCase
commonOptionsIgnoreCase :: IgnoreCase
  , CommonOptions -> Recursive
commonOptionsRecursive :: Recursive
  , CommonOptions -> RawRegex
commonOptionsRawRegex :: RawRegex
  , CommonOptions -> [InputFilename]
commonOptionsInputFilenames :: [InputFilename]
  } deriving (CommonOptions -> CommonOptions -> Bool
(CommonOptions -> CommonOptions -> Bool)
-> (CommonOptions -> CommonOptions -> Bool) -> Eq CommonOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommonOptions -> CommonOptions -> Bool
$c/= :: CommonOptions -> CommonOptions -> Bool
== :: CommonOptions -> CommonOptions -> Bool
$c== :: CommonOptions -> CommonOptions -> Bool
Eq, ReadPrec [CommonOptions]
ReadPrec CommonOptions
Int -> ReadS CommonOptions
ReadS [CommonOptions]
(Int -> ReadS CommonOptions)
-> ReadS [CommonOptions]
-> ReadPrec CommonOptions
-> ReadPrec [CommonOptions]
-> Read CommonOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommonOptions]
$creadListPrec :: ReadPrec [CommonOptions]
readPrec :: ReadPrec CommonOptions
$creadPrec :: ReadPrec CommonOptions
readList :: ReadS [CommonOptions]
$creadList :: ReadS [CommonOptions]
readsPrec :: Int -> ReadS CommonOptions
$creadsPrec :: Int -> ReadS CommonOptions
Read, Int -> CommonOptions -> ShowS
[CommonOptions] -> ShowS
CommonOptions -> String
(Int -> CommonOptions -> ShowS)
-> (CommonOptions -> String)
-> ([CommonOptions] -> ShowS)
-> Show CommonOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommonOptions] -> ShowS
$cshowList :: [CommonOptions] -> ShowS
show :: CommonOptions -> String
$cshow :: CommonOptions -> String
showsPrec :: Int -> CommonOptions -> ShowS
$cshowsPrec :: Int -> CommonOptions -> ShowS
Show)

class HasCommonOptions r where
  commonOptionsLens :: Lens' r CommonOptions

instance HasCommonOptions CommonOptions where
  commonOptionsLens :: Lens' CommonOptions CommonOptions
  commonOptionsLens :: (CommonOptions -> f CommonOptions)
-> CommonOptions -> f CommonOptions
commonOptionsLens = (CommonOptions -> f CommonOptions)
-> CommonOptions -> f CommonOptions
forall a. a -> a
id

instance HasIgnoreCase CommonOptions where
  ignoreCaseLens :: Lens' CommonOptions IgnoreCase
  ignoreCaseLens :: (IgnoreCase -> f IgnoreCase) -> CommonOptions -> f CommonOptions
ignoreCaseLens =
    (CommonOptions -> IgnoreCase)
-> (CommonOptions -> IgnoreCase -> CommonOptions)
-> Lens' CommonOptions IgnoreCase
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      CommonOptions -> IgnoreCase
commonOptionsIgnoreCase
      (\CommonOptions
s IgnoreCase
a -> CommonOptions
s {commonOptionsIgnoreCase :: IgnoreCase
commonOptionsIgnoreCase = IgnoreCase
a})

instance HasRecursive CommonOptions where
  recursiveLens :: Lens' CommonOptions Recursive
  recursiveLens :: (Recursive -> f Recursive) -> CommonOptions -> f CommonOptions
recursiveLens =
    (CommonOptions -> Recursive)
-> (CommonOptions -> Recursive -> CommonOptions)
-> Lens' CommonOptions Recursive
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      CommonOptions -> Recursive
commonOptionsRecursive
      (\CommonOptions
s Recursive
a -> CommonOptions
s {commonOptionsRecursive :: Recursive
commonOptionsRecursive = Recursive
a})

instance HasRawRegex CommonOptions where
  rawRegexLens :: Lens' CommonOptions RawRegex
  rawRegexLens :: (RawRegex -> f RawRegex) -> CommonOptions -> f CommonOptions
rawRegexLens =
    (CommonOptions -> RawRegex)
-> (CommonOptions -> RawRegex -> CommonOptions)
-> Lens' CommonOptions RawRegex
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      CommonOptions -> RawRegex
commonOptionsRawRegex
      (\CommonOptions
s RawRegex
a -> CommonOptions
s {commonOptionsRawRegex :: RawRegex
commonOptionsRawRegex = RawRegex
a})

instance HasInputFilenames CommonOptions where
  inputFilenamesLens :: Lens' CommonOptions [InputFilename]
  inputFilenamesLens :: ([InputFilename] -> f [InputFilename])
-> CommonOptions -> f CommonOptions
inputFilenamesLens =
    (CommonOptions -> [InputFilename])
-> (CommonOptions -> [InputFilename] -> CommonOptions)
-> Lens' CommonOptions [InputFilename]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      CommonOptions -> [InputFilename]
commonOptionsInputFilenames
      (\CommonOptions
s [InputFilename]
a -> CommonOptions
s {commonOptionsInputFilenames :: [InputFilename]
commonOptionsInputFilenames = [InputFilename]
a})

commonOptionsParser :: Parser CommonOptions
commonOptionsParser :: Parser CommonOptions
commonOptionsParser =
  IgnoreCase
-> Recursive -> RawRegex -> [InputFilename] -> CommonOptions
CommonOptions
    (IgnoreCase
 -> Recursive -> RawRegex -> [InputFilename] -> CommonOptions)
-> Parser IgnoreCase
-> Parser
     (Recursive -> RawRegex -> [InputFilename] -> CommonOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser IgnoreCase
ignoreCaseParser
    Parser (Recursive -> RawRegex -> [InputFilename] -> CommonOptions)
-> Parser Recursive
-> Parser (RawRegex -> [InputFilename] -> CommonOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Recursive
recursiveParser
    Parser (RawRegex -> [InputFilename] -> CommonOptions)
-> Parser RawRegex -> Parser ([InputFilename] -> CommonOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawRegex
rawRegexParser
    Parser ([InputFilename] -> CommonOptions)
-> Parser [InputFilename] -> Parser CommonOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [InputFilename]
inputFilenamesParser

-- | A default set of 'CommonOptions'.  Defined as the following:
--
-- >>> :{
-- let opts =
--       CommonOptions
--         { commonOptionsIgnoreCase = DoNotIgnoreCase
--         , commonOptionsRecursive = NotRecursive
--         , commonOptionsRawRegex = RawRegex { unRawRegex = "" }
--         , commonOptionsInputFilenames = []
--         }
-- :}
--
-- >>> opts == defaultCommonOptions
-- True
defaultCommonOptions :: CommonOptions
defaultCommonOptions :: CommonOptions
defaultCommonOptions =
  IgnoreCase
-> Recursive -> RawRegex -> [InputFilename] -> CommonOptions
CommonOptions IgnoreCase
DoNotIgnoreCase Recursive
NotRecursive (String -> RawRegex
RawRegex String
"") []