module CabalGild.Unstable.Type.Pragma where

import qualified Control.Monad as Monad
import qualified Data.List.NonEmpty as NonEmpty
import qualified Distribution.Compat.CharParsing as CharParsing
import qualified Distribution.FieldGrammar.Newtypes as Newtypes
import qualified Distribution.Parsec as Parsec

-- | A pragma, which is a special comment used to customize behavior.
newtype Pragma
  = -- | Discover modules within the given directory.
    Discover (NonEmpty.NonEmpty FilePath)
  deriving (Pragma -> Pragma -> Bool
(Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool) -> Eq Pragma
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pragma -> Pragma -> Bool
== :: Pragma -> Pragma -> Bool
$c/= :: Pragma -> Pragma -> Bool
/= :: Pragma -> Pragma -> Bool
Eq, Int -> Pragma -> ShowS
[Pragma] -> ShowS
Pragma -> FilePath
(Int -> Pragma -> ShowS)
-> (Pragma -> FilePath) -> ([Pragma] -> ShowS) -> Show Pragma
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pragma -> ShowS
showsPrec :: Int -> Pragma -> ShowS
$cshow :: Pragma -> FilePath
show :: Pragma -> FilePath
$cshowList :: [Pragma] -> ShowS
showList :: [Pragma] -> ShowS
Show)

instance Parsec.Parsec Pragma where
  parsec :: forall (m :: * -> *). CabalParsing m => m Pragma
parsec = do
    m ()
forall (m :: * -> *). CharParsing m => m ()
CharParsing.spaces
    m FilePath -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (m FilePath -> m ()) -> m FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m FilePath
forall (m :: * -> *). CharParsing m => FilePath -> m FilePath
CharParsing.string FilePath
"cabal-gild:"
    m ()
forall (m :: * -> *). CharParsing m => m ()
CharParsing.spaces
    m FilePath -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (m FilePath -> m ()) -> m FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m FilePath
forall (m :: * -> *). CharParsing m => FilePath -> m FilePath
CharParsing.string FilePath
"discover"
    m ()
forall (m :: * -> *). CharParsing m => m ()
CharParsing.skipSpaces1
    NonEmpty FilePath -> Pragma
Discover
      (NonEmpty FilePath -> Pragma)
-> (NonEmpty FilePathNT -> NonEmpty FilePath)
-> NonEmpty FilePathNT
-> Pragma
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePathNT -> FilePath)
-> NonEmpty FilePathNT -> NonEmpty FilePath
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePathNT -> FilePath
Newtypes.getFilePathNT
      (NonEmpty FilePathNT -> Pragma)
-> m (NonEmpty FilePathNT) -> m Pragma
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FilePathNT -> m () -> m (NonEmpty FilePathNT)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
CharParsing.sepByNonEmpty m FilePathNT
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m FilePathNT
Parsec.parsec m ()
forall (m :: * -> *). CharParsing m => m ()
CharParsing.skipSpaces1