diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index ccbff84..f2d45e1 100644 --- a/byg/src/DependencyGenerator.hs +++ b/byg/src/DependencyGenerator.hs @@ -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)) diff --git a/byg/src/DependencyRunner.hs b/byg/src/DependencyRunner.hs index 4ac2b6d..005c86d 100644 --- a/byg/src/DependencyRunner.hs +++ b/byg/src/DependencyRunner.hs @@ -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) diff --git a/byg/src/Functions/General.hs b/byg/src/Functions/General.hs index 5b40ae3..e7e4053 100644 --- a/byg/src/Functions/General.hs +++ b/byg/src/Functions/General.hs @@ -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 diff --git a/byg/src/Functions/Image.hs b/byg/src/Functions/Image.hs index 57d058b..61c0404 100644 --- a/byg/src/Functions/Image.hs +++ b/byg/src/Functions/Image.hs @@ -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 diff --git a/byg/src/Functions/Paths.hs b/byg/src/Functions/Paths.hs index 708ee0e..39ea60c 100644 --- a/byg/src/Functions/Paths.hs +++ b/byg/src/Functions/Paths.hs @@ -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 diff --git a/byg/src/Functions/Template.hs b/byg/src/Functions/Template.hs index cb58cf4..322c5a7 100644 --- a/byg/src/Functions/Template.hs +++ b/byg/src/Functions/Template.hs @@ -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] diff --git a/byg/src/Functions/Text.hs b/byg/src/Functions/Text.hs index e848eb8..5f3dc75 100644 --- a/byg/src/Functions/Text.hs +++ b/byg/src/Functions/Text.hs @@ -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 diff --git a/byg/src/Types/Dependency.hs b/byg/src/Types/Dependency.hs index d8d5a1b..da7a96b 100644 --- a/byg/src/Types/Dependency.hs +++ b/byg/src/Types/Dependency.hs @@ -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 diff --git a/byg/src/Types/Functions.hs b/byg/src/Types/Functions.hs index b346421..1073c14 100644 --- a/byg/src/Types/Functions.hs +++ b/byg/src/Types/Functions.hs @@ -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