module Restyler.Config.Include
    ( Include(..)
    , explicit
    , includePath
    )
where

import Restyler.Prelude

import Data.Aeson
import System.FilePath.Glob (Pattern, compile, decompile, match)

data Include
    = Include Pattern
    -- ^ @**\/*.hs@
    | Negated Pattern
    -- ^ @!**\/*.temp@
    deriving (Include -> Include -> Bool
(Include -> Include -> Bool)
-> (Include -> Include -> Bool) -> Eq Include
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Include -> Include -> Bool
$c/= :: Include -> Include -> Bool
== :: Include -> Include -> Bool
$c== :: Include -> Include -> Bool
Eq, Int -> Include -> ShowS
[Include] -> ShowS
Include -> String
(Int -> Include -> ShowS)
-> (Include -> String) -> ([Include] -> ShowS) -> Show Include
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Include] -> ShowS
$cshowList :: [Include] -> ShowS
show :: Include -> String
$cshow :: Include -> String
showsPrec :: Int -> Include -> ShowS
$cshowsPrec :: Int -> Include -> ShowS
Show)

instance FromJSON Include where
    parseJSON :: Value -> Parser Include
parseJSON = String -> (Text -> Parser Include) -> Value -> Parser Include
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Include pattern" ((Text -> Parser Include) -> Value -> Parser Include)
-> (Text -> Parser Include) -> Value -> Parser Include
forall a b. (a -> b) -> a -> b
$ Include -> Parser Include
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Include -> Parser Include)
-> (Text -> Include) -> Text -> Parser Include
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Include
forall a. IsString a => String -> a
fromString (String -> Include) -> (Text -> String) -> Text -> Include
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

instance ToJSON Include where
    toJSON :: Include -> Value
toJSON (Include p :: Pattern
p) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Pattern -> String
decompile Pattern
p
    toJSON (Negated p :: Pattern
p) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ "!" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Pattern -> String
decompile Pattern
p)

instance IsString Include where
    fromString :: String -> Include
fromString ('!' : rest :: String
rest) = Pattern -> Include
Negated (Pattern -> Include) -> Pattern -> Include
forall a b. (a -> b) -> a -> b
$ String -> Pattern
compile String
rest
    fromString x :: String
x = Pattern -> Include
Include (Pattern -> Include) -> Pattern -> Include
forall a b. (a -> b) -> a -> b
$ String -> Pattern
compile String
x

-- | Build an @'Include'@ matching a path exactly
explicit :: FilePath -> Include
explicit :: String -> Include
explicit = Pattern -> Include
Include (Pattern -> Include) -> (String -> Pattern) -> String -> Include
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pattern
compile

-- | Determine if a set of @'Include'@s match a file
--
-- Don't try to over-think this. It works how you would expect, and you can
-- confirm in its test cases.
--
includePath :: [Include] -> FilePath -> Bool
includePath :: [Include] -> String -> Bool
includePath is :: [Include]
is fp :: String
fp = (Bool -> Include -> Bool) -> Bool -> [Include] -> Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Bool -> Include -> Bool
go Bool
False [Include]
is
  where
    go :: Bool -> Include -> Bool
    go :: Bool -> Include -> Bool
go b :: Bool
b (Include p :: Pattern
p) = Bool
b Bool -> Bool -> Bool
|| Pattern
p Pattern -> String -> Bool
`match` String
fp
    go b :: Bool
b (Negated p :: Pattern
p) = Bool
b Bool -> Bool -> Bool
&& Bool -> Bool
not (Pattern
p Pattern -> String -> Bool
`match` String
fp)