Begin generalizing elemOf

This commit is contained in:
Niels G. W. Serup 2024-10-06 16:04:22 +02:00
parent 3e0e9a128e
commit 347cc07c93
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
2 changed files with 11 additions and 6 deletions

View File

@ -5,6 +5,7 @@ module Function
, fileComponents
, lowerString
, elemOf
, elemOfString
, makeTemplate
, applyTemplate
, toText
@ -15,6 +16,7 @@ module Function
import Prelude hiding (String, FilePath)
import Types.Values
import Types.Value (Valuable)
import Types.Function
import Types.Token (Token(..))
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
@ -75,12 +77,15 @@ lowerString :: TokenableTo String a => a -> DepGenM (Token String)
lowerString a = runFunction LowerString =<< toToken a
data ElemOf = ElemOf deriving (Show, Lift)
instance IsFunction ElemOf (String, [String]) Bool where
evalFunction ElemOf (y, ys) = y `elem` ys
data ElemOf a = ElemOf a deriving (Show, Lift)
instance (Show a, Lift a, Valuable a, Eq a) => IsFunction (ElemOf a) (a, [a]) Bool where
evalFunction (ElemOf _) (y, ys) = y `elem` ys
elemOf :: (TokenableTo String a, TokenableTo [String] b) => a -> b -> DepGenM (Token Bool)
elemOf a b = runFunction ElemOf =<< toTupleToken a b
elemOf :: (Show t, Lift t, Valuable t, Eq t, TokenableTo t a, TokenableTo [t] b) => t -> a -> b -> DepGenM (Token Bool)
elemOf witness a b = runFunction (ElemOf witness) =<< toTupleToken a b
elemOfString :: (TokenableTo String a, TokenableTo [String] b) => a -> b -> DepGenM (Token Bool)
elemOfString a b = elemOf "" a b
data MakeTemplate = MakeTemplate deriving (Show, Lift)

View File

@ -17,7 +17,7 @@ copyTo path targetDir = do
hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool)
hasExtension exts filename = do
ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename
ext `elemOf` exts
ext `elemOfString` exts
handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM ()
handleRecipeDir outputDir htmlTemplate indexName dir = do