{-# language ApplicativeDo #-}
{-# language BlockArguments #-}
{-# language OverloadedStrings #-}
{-# language RecordWildCards #-}

module Weeder.Config ( Config(..), config ) where

-- containers
import Data.Set ( Set )
import qualified Data.Set as Set

-- dhall
import qualified Dhall


-- | Configuration for Weeder analysis.
data Config = Config
  { Config -> Set String
rootPatterns :: Set String
    -- ^ Any declarations matching these regular expressions will be added to
    -- the root set.
  , Config -> Bool
typeClassRoots :: Bool
    -- ^ If True, consider all declarations in a type class as part of the root
    -- set. Weeder is currently unable to identify whether or not a type class
    -- instance is used - enabling this option can prevent false positives.
  }


-- | A Dhall expression decoder for 'Config'.
--
-- This parses Dhall expressions of the type @{ roots : List Text, type-class-roots : Bool }@.
config :: Dhall.Decoder Config
config :: Decoder Config
config =
  forall a. RecordDecoder a -> Decoder a
Dhall.record do
    Set String
rootPatterns <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Decoder a -> RecordDecoder a
Dhall.field Text
"roots" ( forall a. Decoder a -> Decoder [a]
Dhall.list Decoder String
Dhall.string )
    Bool
typeClassRoots <- forall a. Text -> Decoder a -> RecordDecoder a
Dhall.field Text
"type-class-roots" Decoder Bool
Dhall.bool

    return Config{Bool
Set String
typeClassRoots :: Bool
rootPatterns :: Set String
typeClassRoots :: Bool
rootPatterns :: Set String
..}