Use inline functions everywhere except for IO

This commit is contained in:
Niels G. W. Serup 2024-10-14 23:18:21 +02:00
parent 1da32745a2
commit 740cb67d66
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
9 changed files with 48 additions and 106 deletions

View File

@ -8,7 +8,7 @@ module DependencyGenerator
, evalDepGenM , evalDepGenM
, inject , inject
, onToken , onToken
, runFunction , onTupleToken
, runFunctionIO , runFunctionIO
, runFunctionIO_ , runFunctionIO_
, mapDepGenM , mapDepGenM
@ -27,7 +27,7 @@ module DependencyGenerator
) where ) where
import Types.Token (Token(..)) import Types.Token (Token(..))
import Types.Functions (IsFunction(), IsFunctionIO(..)) import Types.Functions (IsFunctionIO(..))
import Types.Dependency (Action(..), F(..), Dependency, makeDependency) import Types.Dependency (Action(..), F(..), Dependency, makeDependency)
import Type.Reflection (Typeable, TypeRep, typeRep) import Type.Reflection (Typeable, TypeRep, typeRep)
@ -72,10 +72,12 @@ inject x = genDependency (makeDependency NoToken (Inject x))
onToken :: (TokenableTo a t, Show a, Typeable a, Show b, Typeable b) => (a -> b) -> t -> DepGenM (Token b) onToken :: (TokenableTo a t, Show a, Typeable a, Show b, Typeable b) => (a -> b) -> t -> DepGenM (Token b)
onToken f input = do onToken f input = do
input' <- toToken input input' <- toToken input
genDependency (makeDependency input' (InlineFunction (F f))) genDependency (makeDependency input' (Function (F f)))
runFunction :: IsFunction f a b => f -> Token a -> DepGenM (Token b) onTupleToken :: (TokenableTo a t1, Show a, Typeable a, TokenableTo b t2, Show b, Typeable b, Show r, Typeable r) => (a -> b -> r) -> t1 -> t2 -> DepGenM (Token r)
runFunction f input = genDependency (makeDependency input (Function f)) onTupleToken f input1 input2 = do
tup <- toTupleToken input1 input2
genDependency (makeDependency tup (Function (F (uncurry f))))
runFunctionIO :: IsFunctionIO f a b => f -> Token a -> DepGenM (Token b) runFunctionIO :: IsFunctionIO f a b => f -> Token a -> DepGenM (Token b)
runFunctionIO f input = genDependency (makeDependency input (FunctionIO f)) runFunctionIO f input = genDependency (makeDependency input (FunctionIO f))

View File

@ -5,7 +5,7 @@ module DependencyRunner
, runDepRunMIO , runDepRunMIO
) where ) where
import Types (evalFunction, evalFunctionIO) import Types (evalFunctionIO)
import Types.Value import Types.Value
import Types.Token import Types.Token
import Types.Dependency import Types.Dependency
@ -94,9 +94,7 @@ putTokenValue t e = case t of
runAction :: forall a b. Action a b -> Value -> DepRunM Value runAction :: forall a b. Action a b -> Value -> DepRunM Value
runAction action input = case action of runAction action input = case action of
Function f -> Function (F f) ->
calc (evalFunction f)
InlineFunction (F f) ->
calc f calc f
FunctionIO f -> FunctionIO f ->
calcM (liftIO . evalFunctionIO f) calcM (liftIO . evalFunctionIO f)

View File

@ -1,18 +1,9 @@
{-# LANGUAGE GADTs #-}
module Functions.General module Functions.General
( elemOf ( elemOf
) where ) where
import Types (IsFunction(..), Token) import Types (Token)
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction) import DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken)
import Type.Reflection (Typeable, TypeRep, typeRep) elemOf :: (Eq t, TokenableTo t a, TokenableTo [t] b) => a -> b -> DepGenM (Token Bool)
elemOf = onTupleToken elem
data ElemOf a where ElemOf :: TypeRep a -> ElemOf a
deriving instance Show (ElemOf a)
instance (Show a, Typeable a, Eq a) => IsFunction (ElemOf a) (a, [a]) Bool where
evalFunction (ElemOf _) (y, ys) = y `elem` ys
elemOf :: forall t a b. (Show t, Typeable t, Eq t, TokenableTo t a, TokenableTo [t] b, Typeable t) => a -> b -> DepGenM (Token Bool)
elemOf a b = runFunction (ElemOf (typeRep :: TypeRep t)) =<< toTupleToken a b

View File

@ -6,9 +6,9 @@ module Functions.Image
, convertImage , convertImage
) where ) where
import Types (IsFunction(..), IsFunctionIO(..), Token) import Types (IsFunctionIO(..), Token)
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, import DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken, toTupleToken,
runFunction, runFunctionIO, runFunctionIO_) runFunctionIO, runFunctionIO_)
import qualified Codec.Picture as CP import qualified Codec.Picture as CP
import qualified Codec.Picture.STBIR as CPS import qualified Codec.Picture.STBIR as CPS
@ -46,13 +46,9 @@ saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM
saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b
data ConvertImage = ConvertImage deriving Show convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM (Token Image)
instance IsFunction ConvertImage (Image, ImageConversionSettings) Image where convertImage = onTupleToken $ \(ImageWrapper image) (ResizeToWidth widthResized) ->
evalFunction ConvertImage (ImageWrapper image, ResizeToWidth widthResized) =
let sizeFactor :: Double let sizeFactor :: Double
sizeFactor = fromIntegral (CP.imageWidth image) / fromIntegral widthResized sizeFactor = fromIntegral (CP.imageWidth image) / fromIntegral widthResized
heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor) heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor)
in ImageWrapper $ CPS.resize CPS.defaultOptions widthResized heightResized image in ImageWrapper $ CPS.resize CPS.defaultOptions widthResized heightResized image
convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM (Token Image)
convertImage a b = runFunction ConvertImage =<< toTupleToken a b

View File

@ -11,33 +11,23 @@ module Functions.Paths
import Functions.Text (lowerString) import Functions.Text (lowerString)
import Functions.General (elemOf) import Functions.General (elemOf)
import Types (IsFunction(..), IsFunctionIO(..), Token(..)) import Types (IsFunctionIO(..), Token(..))
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction, import DependencyGenerator (DepGenM, TokenableTo(..), onToken, onTupleToken, toTupleToken,
runFunctionIO, runFunctionIO_, untupleSndDepGenM) runFunctionIO, runFunctionIO_, untupleSndDepGenM)
import qualified System.Directory as SD import qualified System.Directory as SD
data JoinPaths = JoinPaths deriving Show
instance IsFunction JoinPaths (FilePath, FilePath) FilePath where
evalFunction JoinPaths (s0, s1) = s0 ++ "/" ++ s1
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM (Token FilePath) joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM (Token FilePath)
joinPaths a b = runFunction JoinPaths =<< TupleToken <$> toToken a <*> toToken b joinPaths = onTupleToken $ \s0 s1 -> s0 ++ "/" ++ s1
fileComponents :: TokenableTo FilePath a => a -> DepGenM (Token (String, String))
data FileComponents = FileComponents deriving Show fileComponents = onToken $ \s ->
instance IsFunction FileComponents FilePath (String, String) where
evalFunction FileComponents s =
let (lastRev, firstRev) = span (/= '.') $ reverse s let (lastRev, firstRev) = span (/= '.') $ reverse s
(base, ext) = case firstRev of (base, ext) = case firstRev of
_ : firstRev' -> (reverse firstRev', reverse lastRev) _ : firstRev' -> (reverse firstRev', reverse lastRev)
[] -> (reverse lastRev, "") [] -> (reverse lastRev, "")
in (base, ext) in (base, ext)
fileComponents :: TokenableTo FilePath a => a -> DepGenM (Token (String, String))
fileComponents a = runFunction FileComponents =<< toToken a
hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool) hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool)
hasExtension exts filename = do hasExtension exts filename = do
ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename

View File

@ -4,8 +4,8 @@ module Functions.Template
, applyTemplate , applyTemplate
) where ) where
import Types (IsFunction(..), Token) import Types (Token)
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction) import DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
@ -13,21 +13,12 @@ import qualified Data.Text as T
data Template = TemplateParts Text Text data Template = TemplateParts Text Text
deriving (Eq, Show) deriving (Eq, Show)
data MakeTemplate = MakeTemplate deriving Show makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM (Token Template)
instance IsFunction MakeTemplate (Text, Text) Template where makeTemplate = onTupleToken $ \t c ->
evalFunction MakeTemplate (t, c) =
let (beforeContent, after) = T.breakOn c t let (beforeContent, after) = T.breakOn c t
afterContent = T.drop (T.length c) after afterContent = T.drop (T.length c) after
in TemplateParts beforeContent afterContent in TemplateParts beforeContent afterContent
makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM (Token Template)
makeTemplate a b = runFunction MakeTemplate =<< toTupleToken a b
data ApplyTemplate = ApplyTemplate deriving Show
instance IsFunction ApplyTemplate (Template, Text) Text where
evalFunction ApplyTemplate (TemplateParts beforeContent afterContent, t) =
T.concat [beforeContent, t, afterContent]
applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM (Token Text) applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM (Token Text)
applyTemplate a b = runFunction ApplyTemplate =<< toTupleToken a b applyTemplate = onTupleToken $ \(TemplateParts beforeContent afterContent) t ->
T.concat [beforeContent, t, afterContent]

View File

@ -7,46 +7,26 @@ module Functions.Text
, saveTextFile , saveTextFile
) where ) where
import Types (IsFunction(..), IsFunctionIO(..), Token) import Types (IsFunctionIO(..), Token)
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, import DependencyGenerator (DepGenM, TokenableTo(..), onToken, toTupleToken,
runFunction, runFunctionIO, runFunctionIO_) runFunctionIO, runFunctionIO_)
import Data.Char (toLower) import Data.Char (toLower)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
data ConcatStrings = ConcatStrings deriving Show
instance IsFunction ConcatStrings [String] String where
evalFunction ConcatStrings = concat
concatStrings :: TokenableTo [String] a => a -> DepGenM (Token String) concatStrings :: TokenableTo [String] a => a -> DepGenM (Token String)
concatStrings a = runFunction ConcatStrings =<< toToken a concatStrings = onToken concat
data ConcatTexts = ConcatTexts deriving Show
instance IsFunction ConcatTexts [Text] Text where
evalFunction ConcatTexts = T.concat
concatTexts :: TokenableTo [Text] a => a -> DepGenM (Token Text) concatTexts :: TokenableTo [Text] a => a -> DepGenM (Token Text)
concatTexts a = runFunction ConcatTexts =<< toToken a concatTexts = onToken T.concat
data LowerString = LowerString deriving Show
instance IsFunction LowerString String String where
evalFunction LowerString s = map toLower s
lowerString :: TokenableTo String a => a -> DepGenM (Token String) lowerString :: TokenableTo String a => a -> DepGenM (Token String)
lowerString a = runFunction LowerString =<< toToken a lowerString = onToken (map toLower)
data ToText = ToText deriving Show
instance IsFunction ToText String Text where
evalFunction ToText s = T.pack s
toText :: TokenableTo String a => a -> DepGenM (Token Text) toText :: TokenableTo String a => a -> DepGenM (Token Text)
toText a = runFunction ToText =<< toToken a toText = onToken T.pack
data ReadTextFile = ReadTextFile deriving Show data ReadTextFile = ReadTextFile deriving Show

View File

@ -11,7 +11,7 @@ module Types.Dependency
) where ) where
import Types.Token (Token(..)) import Types.Token (Token(..))
import Types.Functions (IsFunction(), IsFunctionIO(..)) import Types.Functions (IsFunctionIO(..))
import Type.Reflection (Typeable, TypeRep, typeRep) import Type.Reflection (Typeable, TypeRep, typeRep)
import Text.Printf (printf) import Text.Printf (printf)
@ -19,8 +19,7 @@ import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
data Action a b where data Action a b where
Function :: IsFunction f a b => f -> Action a b Function :: (Typeable a, Typeable b, Show b) => F a b -> Action a b
InlineFunction :: (Typeable a, Typeable b, Show b) => F a b -> Action a b
FunctionIO :: IsFunctionIO f a b => f -> Action a b FunctionIO :: IsFunctionIO f a b => f -> Action a b
Inject :: (Typeable a, Show a) => a -> Action () a Inject :: (Typeable a, Show a) => a -> Action () a
FilterComp :: (Typeable a, Show a) => Action ([a], [Bool]) [a] FilterComp :: (Typeable a, Show a) => Action ([a], [Bool]) [a]
@ -53,7 +52,6 @@ actionTargetType _ = typeRep
actionTouchesFilesystem :: Action a b -> Bool actionTouchesFilesystem :: Action a b -> Bool
actionTouchesFilesystem = \case actionTouchesFilesystem = \case
Function _ -> False Function _ -> False
InlineFunction _ -> False
FunctionIO f -> functionIOTouchesFilesystem f FunctionIO f -> functionIOTouchesFilesystem f
Inject _ -> False Inject _ -> False
FilterComp -> False FilterComp -> False

View File

@ -1,14 +1,10 @@
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
module Types.Functions module Types.Functions
( IsFunction(..) ( IsFunctionIO(..)
, IsFunctionIO(..)
) where ) where
import Type.Reflection (Typeable) import Type.Reflection (Typeable)
class (Show f, Show a, Typeable a, Show b, Typeable b) => IsFunction f a b | f -> a b where
evalFunction :: f -> a -> b
class (Show f, Show a, Typeable a, Show b, Typeable b) => IsFunctionIO f a b | f -> a b where class (Show f, Show a, Typeable a, Show b, Typeable b) => IsFunctionIO f a b | f -> a b where
evalFunctionIO :: f -> a -> IO b evalFunctionIO :: f -> a -> IO b
functionIOTouchesFilesystem :: f -> Bool functionIOTouchesFilesystem :: f -> Bool