ngws/mad
1
0
Atdalīts 0
Kods Problēmas Izmaiņu pieprasījumi Pakotnes Projekti Laidieni Vikivietne Aktivitāte

Use inline functions everywhere except for IO

Pārlūkot izejas kodu
Šī revīzija ir iekļauta:
Niels G. W. Serup
2024-10-14 23:18:21 +02:00
vecāks 1da32745a2
revīzija 740cb67d66
9 mainīti faili ar 48 papildinājumiem un 106 dzēšanām
Lejupielādēt ielāpa failu Lejupielādēt izmaiņu failu Izvērst visus failus Savērst visus failus

12
byg/src/DependencyGenerator.hs
Parādīt failu

@@ -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
Parādīt failu

@@ -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
Parādīt failu

@@ -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

14
byg/src/Functions/Image.hs
Parādīt failu

@@ -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) =
convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM (Token Image)
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
convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM (Token Image)
convertImage a b = runFunction ConvertImage =<< toTupleToken a b

20
byg/src/Functions/Paths.hs
Parādīt failu

@@ -11,33 +11,23 @@ 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
joinPaths = onTupleToken $ \s0 s1 -> s0 ++ "/" ++ s1
data FileComponents = FileComponents deriving Show
instance IsFunction FileComponents FilePath (String, String) where
evalFunction FileComponents s =
fileComponents :: TokenableTo FilePath a => a -> DepGenM (Token (String, String))
fileComponents = onToken $ \s ->
let (lastRev, firstRev) = span (/= '.') $ reverse s
(base, ext) = case firstRev of
_ : firstRev' -> (reverse firstRev', reverse lastRev)
[] -> (reverse lastRev, "")
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 exts filename = do
ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename

21
byg/src/Functions/Template.hs
Parādīt failu

@@ -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) =
makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM (Token Template)
makeTemplate = onTupleToken $ \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]
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
Parādīt failu

@@ -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
Parādīt failu

@@ -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
Parādīt failu

@@ -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