<commit_before>-- Copyright 2012 Google Inc. All Rights Reserved.
-- Copyright 2013 and onwards, <NAME>
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
--
-- Authors: <NAME> <<EMAIL>>, <NAME> <<EMAIL>>

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}

-- |
-- Module: HFlags
-- License: Apache 2.0
--
-- The @HFlags@ library supports easy definition of command line flags,
-- reimplementing the ideas from Google's @gflags@
-- (<http://code.google.com/p/gflags>).
--
-- Command line flags can be declared in any file at the toplevel,
-- using 'defineFlag'.  At runtime, the actual values are assigned to
-- the toplevel @flags_name@ constants.  Those can be used purely
-- throughout the program.
--
-- At the beginning of the @main@ function, @$(initHFlags "program
-- description")@ has to be called to initialize the flags.  All flags
-- will be initialized that are transitively reachable via imports
-- from @main@.  This means, that any Haskell package can easily
-- define command line flags with @HFlags@.  This feature is
-- demonstrated by
-- <http://github.com/errge/hflags/blob/master/examples/ImportExample.hs>.
--
-- A simple example (more in the
-- <http://github.com/errge/hflags/tree/master/examples> directory):
--
-- > #!/usr/bin/env runhaskell
-- >
-- > {-# LANGUAGE TemplateHaskell #-}
-- >
-- > import HFlags
-- >
-- > defineFlag "name" "<NAME>" "Who to greet."
-- > defineFlag "r:repeat" (3 + 4 :: Int) "Number of times to repeat the message."
-- >
-- > main = do s <- $(initHFlags "Simple program v0.1")
-- >           sequence_ $ replicate flags_repeat greet
-- >           putStrLn $ "Your additional arguments were: " ++ show s
-- >           putStrLn $ "Which is the same as: " ++ show HFlags.arguments
-- >   where
-- >     greet = putStrLn $ "Hello " ++ flags_name ++ ", very nice to meet you!"
--
-- At @initHFlags@ time, the library also tries to gather flags out of
-- environment variables.  @HFLAGS_verbose=True@ is equivalent to
-- specify --verbose=True.  This environment feature only works with
-- long options and the user has to specify a value even for Bools.

module HFlags (
  -- * Definition of flags
  defineCustomFlag,
  defineEQFlag,
  FlagType(..),
  -- * Initialization of flags at runtime
  initHFlags,
  -- * For easy access to arguments, after initHFlags has been called
  arguments,
  -- * For debugging, shouldn't be used in production code
  Flag(..)
  ) where

-- TODOs:
-- ?--no* for bools?
-- --help should show the current value if it's different than the default value, so user can test command line args

import Control.Exception
import Control.Monad
import Data.Char
import Data.Function
import Data.List
import Data.IORef
import Data.Maybe
import qualified Data.Map as Map
import Data.Map (Map, (!))
import qualified Data.Text
import Language.Haskell.TH
import System.Console.GetOpt
import System.Environment
import System.IO
import System.IO.Unsafe
import System.Exit

import Prelude

-- | Data type for storing every property of a flag.
data FlagData = FlagData
            { fName :: String
            , fShort :: Maybe Char
            , fDefValue :: String
            , fArgHelp :: String
            , fDescription :: String
            , fModuleName :: String
            , fCheck :: IO () -- ^ function to evaluate in 'initFlags'
                              -- to force syntax check of the argument.
            }

instance Show FlagData where
  show fd = show (fName fd, fShort fd, fDefValue fd, fArgHelp fd, fDescription fd, fModuleName fd)

-- | Every flag the program supports has to be defined through a new
-- phantom datatype and the Flag instance of that datatype.
--
-- But users of the library shouldn't worry about this class or the
-- implementation details behind these functions, just use the
-- @defineFlag@ Template Haskell function for defining new flags.
class Flag a where
  getFlagData :: a -> FlagData

-- | The most flexible way of defining a flag.  For an example see
-- <http://github.com/errge/hflags/blob/master/examples/ComplexExample.hs>.
-- For most things 'defineFlag' should be enough instead.
--
-- The parameters:
--
--   * name of the flag (@l:long@ syntax if you want to have the short option @l@ for this flag),
--
--   * expression quoted and type signed default value,
--
--   * help string for the argument,
--
--   * read function, expression quoted,
--
--   * show function, expression quoted,
--
--   * help string for the flag.
defineCustomFlag :: String -> ExpQ -> String -> ExpQ -> ExpQ -> String -> Q [Dec]
defineCustomFlag name' defQ argHelp readQ showQ description =
  do (name, short) <- case () of
       () | length name' == 0 -> fail "Flag's without names are not supported."
          | length name' == 1 -> return (name', Just $ head name')
          | length name' == 2 -> return (name', Nothing)
          | name' !! 1 == ':' -> return (drop 2 name', Just $ head name')
          | otherwise -> return (name', Nothing)
     defE <- defQ
     flagType <- case defE of
       SigE _ flagType -> return flagType
       _ -> fail "Default value for defineCustomFlag has to be an explicitly typed expression, like (12 :: Int)"
     moduleName <- fmap loc_module location
     let accessorName = mkName $ "flags_" ++ name
     let dataName = mkName $ "HFlag_" ++ name
     dataDec <- return $ DataD [] dataName [] [] []
     instanceDec <- instanceD
                    (return [])
                    (appT (conT ''Flag) (conT dataName))
                      [funD 'getFlagData [clause [wildP]
                                          (normalB
                                           [| FlagData
                                              name
                                              short
                                              $(appE showQ defQ)
                                              argHelp
                                              description
                                              moduleName
                                              (evaluate $(varE accessorName) >> return ())
                                           |]) []]]
     flagPragmaDec <- return $ PragmaD $ InlineP accessorName NoInline FunLike AllPhases
     flagSig <- return $ SigD accessorName flagType
     flagDec <- funD accessorName [clause [] (normalB [| case True of
                                                           True -> $(appE readQ [| lookupFlag name moduleName |])
                                                           False -> $(defQ) |]) []]<commit_msg>Haskell98: no phantom data types, always generate an empty constructor<commit_after>-- Copyright 2012 Google Inc. All Rights Reserved.
-- Copyright 2013 and onwards, <NAME>
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
--
-- Authors: <NAME> <<EMAIL>>, <NAME> <<EMAIL>>

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}

-- |
-- Module: HFlags
-- License: Apache 2.0
--
-- The @HFlags@ library supports easy definition of command line flags,
-- reimplementing the ideas from Google's @gflags@
-- (<http://code.google.com/p/gflags>).
--
-- Command line flags can be declared in any file at the toplevel,
-- using 'defineFlag'.  At runtime, the actual values are assigned to
-- the toplevel @flags_name@ constants.  Those can be used purely
-- throughout the program.
--
-- At the beginning of the @main@ function, @$(initHFlags "program
-- description")@ has to be called to initialize the flags.  All flags
-- will be initialized that are transitively reachable via imports
-- from @main@.  This means, that any Haskell package can easily
-- define command line flags with @HFlags@.  This feature is
-- demonstrated by
-- <http://github.com/errge/hflags/blob/master/examples/ImportExample.hs>.
--
-- A simple example (more in the
-- <http://github.com/errge/hflags/tree/master/examples> directory):
--
-- > #!/usr/bin/env runhaskell
-- >
-- > {-# LANGUAGE TemplateHaskell #-}
-- >
-- > import HFlags
-- >
-- > defineFlag "name" "<NAME>" "Who to greet."
-- > defineFlag "r:repeat" (3 + 4 :: Int) "Number of times to repeat the message."
-- >
-- > main = do s <- $(initHFlags "Simple program v0.1")
-- >           sequence_ $ replicate flags_repeat greet
-- >           putStrLn $ "Your additional arguments were: " ++ show s
-- >           putStrLn $ "Which is the same as: " ++ show HFlags.arguments
-- >   where
-- >     greet = putStrLn $ "Hello " ++ flags_name ++ ", very nice to meet you!"
--
-- At @initHFlags@ time, the library also tries to gather flags out of
-- environment variables.  @HFLAGS_verbose=True@ is equivalent to
-- specify --verbose=True.  This environment feature only works with
-- long options and the user has to specify a value even for Bools.

module HFlags (
  -- * Definition of flags
  defineCustomFlag,
  defineEQFlag,
  FlagType(..),
  -- * Initialization of flags at runtime
  initHFlags,
  -- * For easy access to arguments, after initHFlags has been called
  arguments,
  -- * For debugging, shouldn't be used in production code
  Flag(..)
  ) where

-- TODOs:
-- ?--no* for bools?
-- --help should show the current value if it's different than the default value, so user can test command line args

import Control.Exception
import Control.Monad
import Data.Char
import Data.Function
import Data.List
import Data.IORef
import Data.Maybe
import qualified Data.Map as Map
import Data.Map (Map, (!))
import qualified Data.Text
import Language.Haskell.TH
import System.Console.GetOpt
import System.Environment
import System.IO
import System.IO.Unsafe
import System.Exit

import Prelude

-- | Data type for storing every property of a flag.
data FlagData = FlagData
            { fName :: String
            , fShort :: Maybe Char
            , fDefValue :: String
            , fArgHelp :: String
            , fDescription :: String
            , fModuleName :: String
            , fCheck :: IO () -- ^ function to evaluate in 'initFlags'
                              -- to force syntax check of the argument.
            }

instance Show FlagData where
  show fd = show (fName fd, fShort fd, fDefValue fd, fArgHelp fd, fDescription fd, fModuleName fd)

-- | Every flag the program supports has to be defined through a new
-- phantom datatype and the Flag instance of that datatype.
--
-- But users of the library shouldn't worry about this class or the
-- implementation details behind these functions, just use the
-- @defineFlag@ Template Haskell function for defining new flags.
class Flag a where
  getFlagData :: a -> FlagData

-- | The most flexible way of defining a flag.  For an example see
-- <http://github.com/errge/hflags/blob/master/examples/ComplexExample.hs>.
-- For most things 'defineFlag' should be enough instead.
--
-- The parameters:
--
--   * name of the flag (@l:long@ syntax if you want to have the short option @l@ for this flag),
--
--   * expression quoted and type signed default value,
--
--   * help string for the argument,
--
--   * read function, expression quoted,
--
--   * show function, expression quoted,
--
--   * help string for the flag.
defineCustomFlag :: String -> ExpQ -> String -> ExpQ -> ExpQ -> String -> Q [Dec]
defineCustomFlag name' defQ argHelp readQ showQ description =
  do (name, short) <- case () of
       () | length name' == 0 -> fail "Flag's without names are not supported."
          | length name' == 1 -> return (name', Just $ head name')
          | length name' == 2 -> return (name', Nothing)
          | name' !! 1 == ':' -> return (drop 2 name', Just $ head name')
          | otherwise -> return (name', Nothing)
     defE <- defQ
     flagType <- case defE of
       SigE _ flagType -> return flagType
       _ -> fail "Default value for defineCustomFlag has to be an explicitly typed expression, like (12 :: Int)"
     moduleName <- fmap loc_module location
     let accessorName = mkName $ "flags_" ++ name
     let dataName = mkName $ "HFlag_" ++ name
     let dataConstrName = mkName $ "HFlagC_" ++ name
     dataDec <- return $ DataD [] dataName [] [(NormalC dataConstrName [])] []
     instanceDec <- instanceD
                    (return [])
                    (appT (conT ''Flag) (conT dataName))
                      [funD 'getFlagData [clause [wildP]
                                          (normalB
                                           [| FlagData
                                              name
                                              short
                                              $(appE showQ defQ)
                                              argHelp
                                              description
                                              moduleName
                                              (evaluate $(varE accessorName) >> return ())
                                           |]) []]]
     flagPragmaDec <- return $ PragmaD $ InlineP accessorName NoInline FunLike AllPhases
     flagSig <- return $ SigD accessorName flagType
     flagDec <- funD accessorName [clause [] (normalB [| case True of
                                                           True -> $(appE readQ [| lookupFlag name moduleName |])
                                                           False -> $(defQ) |]) []]
{'fraction_non_alphanumeric': 0.10824706454526506, 'fraction_numerical': 0.0036128673660807335, 'mean_word_length': 2.1325353645266594, 'pattern_counts': {'":': 0, '<': 47, '<?xml version=': 0, '>': 93, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 50, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '579714', 'n_tokens_mistral': 3848, 'n_tokens_neox': 3719, 'n_words': 1520}