ngws
/
mad
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
byg/src/DependencyGenerator.hs
View File

@ -8,7 +8,7 @@ module DependencyGenerator
, evalDepGenM
, inject
, onToken
, runFunction
, onTupleToken
, runFunctionIO
, runFunctionIO_
, mapDepGenM
@ -27,7 +27,7 @@ module DependencyGenerator
) where
import Types.Token (Token(..))
import Types.Functions (IsFunction(), IsFunctionIO(..))
import Types.Functions (IsFunctionIO(..))
import Types.Dependency (Action(..), F(..), Dependency, makeDependency)
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 f input = do
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)
runFunction f input = genDependency (makeDependency input (Function f))
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)
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 f input = genDependency (makeDependency input (FunctionIO f))

6
byg/src/DependencyRunner.hs
View File

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

17
byg/src/Functions/General.hs
View File

@ -1,18 +1,9 @@
{-# LANGUAGE GADTs #-}
module Functions.General
( elemOf
) where
import Types (IsFunction(..), Token)
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
import Types (Token)
import DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken)
import Type.Reflection (Typeable, TypeRep, typeRep)
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
elemOf :: (Eq t, TokenableTo t a, TokenableTo [t] b) => a -> b -> DepGenM (Token Bool)
elemOf = onTupleToken elem

20
byg/src/Functions/Image.hs
View File

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

28
byg/src/Functions/Paths.hs
View File

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

25
byg/src/Functions/Template.hs
View File

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

34
byg/src/Functions/Text.hs
View File

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

6
byg/src/Types/Dependency.hs
View File

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

6
byg/src/Types/Functions.hs
View File

@ -1,14 +1,10 @@
{-# LANGUAGE FunctionalDependencies #-}
module Types.Functions
( IsFunction(..)
, IsFunctionIO(..)
( IsFunctionIO(..)
) where
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
evalFunctionIO :: f -> a -> IO b
functionIOTouchesFilesystem :: f -> Bool