transf (empty) → 0.5
raw patch · 5 files changed
+291/−0 lines, 5 filesdep +basedep +containersdep +filepathsetup-changed
Dependencies added: base, containers, filepath, hashable, hint, monadplus, mtl, music-preludes, process, semigroups
Files
- COPYING +26/−0
- Setup.lhs +4/−0
- src/Main.hs +55/−0
- src/Text/Transf.hs +146/−0
- transf.cabal +60/−0
+ COPYING view
@@ -0,0 +1,26 @@++Copyright (c) 2013, Hans Höglund+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ src/Main.hs view
@@ -0,0 +1,55 @@++module Main where++import Control.Exception+import Control.Monad (when)+import Control.Monad.Error hiding (mapM)+import Control.Monad.Plus hiding (mapM)+import Data.Semigroup hiding (Option)+import Data.List (find)+import Data.Maybe (fromMaybe, maybeToList)+import Data.Traversable (mapM) +import Data.Typeable+import System.IO+import System.Exit+import System.Environment+import System.Console.GetOpt+import Text.Transf++import Prelude hiding (readFile, writeFile)++++version = "transf-0.5"+header = "Usage: transf [options]\n" +++ "Usage: transf [options] files...\n" +++ "\n" +++ "Options:"++options = [ + (Option ['h'] ["help"] (NoArg 1) "Print help and exit"),+ (Option ['v'] ["version"] (NoArg 2) "Print version and exit")+ ] + +main = do+ (opts, args, optErrs) <- getOpt Permute options `fmap` getArgs++ let usage = usageInfo header options+ let printUsage = putStr (usage ++ "\n") >> exitWith ExitSuccess+ let printVersion = putStr (version ++ "\n") >> exitWith ExitSuccess++ when (1 `elem` opts) printUsage+ when (2 `elem` opts) printVersion + runFilter opts+++runFilter _ = transform stdin stdout++transform fin fout = do+ res <- runTransf $ do+ input <- liftIO $ hGetContents fin + output <- runTransformation (censorT <> printT <> evalT <> musicT) input+ liftIO $ hPutStr fout output+ case res of+ Left e -> putStrLn $ "Error: " ++ e+ Right _ -> return ()
+ src/Text/Transf.hs view
@@ -0,0 +1,146 @@++{-# LANGUAGE+ GeneralizedNewtypeDeriving #-}++module Text.Transf -- (+ -- ) +where++import Prelude hiding (mapM, readFile, writeFile) ++import Control.Exception+import Control.Monad.Error hiding (mapM)+import Control.Monad.Plus hiding (mapM)+import Data.Semigroup+import Data.Traversable (mapM) +import Data.Typeable+import Data.Hashable+import Data.Maybe+import Language.Haskell.Interpreter+import System.IO (hPutStr, stderr)+import System.Process+import Numeric+import Music.Prelude.StringQuartet++import qualified Prelude+import qualified Data.List as List+++-- | A line of text.+type Line = String++-- | A relative file path.+type RelativePath = FilePath++-- | +newtype Transf a = Transf { getTransf :: + ErrorT String IO a + }+ deriving (Monad, MonadPlus, MonadError String, MonadIO)++runTransf :: Transf a -> IO (Either String a)+runTransf = runErrorT . getTransf++-- | Read a file.+readFile :: RelativePath -> Transf String+readFile path = do+ input <- liftIO $ try $ Prelude.readFile path+ case input of+ Left e -> throwError $ "readFile: " ++ show (e::SomeException)+ Right a -> return a++-- appendFile :: RelativePath -> String -> Transf ()++writeFile :: RelativePath -> String -> Transf ()+writeFile path str = liftIO $ Prelude.writeFile path str++interp :: Typeable a => String -> Transf a+interp str = do + res <- liftIO $ runInterpreter $ do+ setImports ["Prelude", "Music.Prelude.StringQuartet"]+ interpret str infer+ case res of+ Left e -> throwError $ "interp: " ++ show e+ Right a -> return a++data Transformation + = CompTrans {+ decomp :: [Transformation]+ }+ | SingTrans {+ guard :: (Line -> Bool, Line -> Bool),+ function :: Line -> Transf Line+ }++instance Semigroup Transformation where+ a <> b = CompTrans [a,b]++censorT :: Transformation+censorT = SingTrans ((== "```censor"), (== "```")) $ \input -> do+ liftIO $ hPutStr stderr "Censoring!\n"+ return "(censored)"++printT :: Transformation+printT = SingTrans ((== "```print"), (== "```")) $ \input -> do+ liftIO $ hPutStr stderr "Passing through!\n"+ return input++evalT :: Transformation+evalT = SingTrans ((== "```eval"), (== "```")) $ \input -> do+ liftIO $ hPutStr stderr "Evaluating!\n"+ interp input++musicT :: Transformation+musicT = SingTrans ((== "```music"), (== "```")) $ \input -> do+ let name = showHex (abs $ hash input) ""+ liftIO $ hPutStr stderr "Interpreting music!\n"+ music <- interp input :: Transf (Score Note)+ liftIO $ writeLy (name++".ly") music+ liftIO $ runCommand $ "lilypond -f png "++name++".ly"+ return $ "![Output]("++name++".png)"++++runTransformation :: Transformation -> String -> Transf String+runTransformation (CompTrans []) as = return as++runTransformation (CompTrans (t:ts)) as = do+ bs <- runTransformation t as+ runTransformation (CompTrans ts) bs+ +runTransformation (SingTrans (start,stop) f) as = do+ let bs = (sections start stop . lines) as :: [([Line], Maybe [Line])]+ let cs = fmap (first unlines . second (fmap unlines)) bs :: [(String, Maybe String)]+ ds <- mapM (secondM (mapM f)) cs :: Transf [(String, Maybe String)] + return $ concatMap (\(a, b) -> a ++ fromMaybe b ++ "\n") ds+++++-- | Separate the sections delimited by the separators from their context. Returns+-- [(outside1, inside1), (outside2, inside2)...] +--+sections :: (a -> Bool) -> (a -> Bool) -> [a] -> [([a], Maybe [a])]+sections start stop as = case (bs,cs) of+ ([], []) -> [] + (bs, []) -> [(bs, Nothing)]+ (bs, [c]) -> [(bs, Nothing)]+ (bs, cs) -> (bs, Just $ tail cs) : sections start stop (drop skip as)+ where+ (bs,cs) = sections1 start stop as + skip = length bs + length cs + 1++sections1 :: (a -> Bool) -> (a -> Bool) -> [a] -> ([a],[a])+sections1 start stop as = + (takeWhile (not . start) as, takeWhile (not . stop) $ dropWhile (not . start) as)+++first f (a, b) = (f a, b)+second f (a, b) = (a, f b)++secondM :: Monad m => (a -> m b) -> (c, a) -> m (c, b)+secondM f (a, b) = do+ b' <- f b+ return (a, b')+ +
+ transf.cabal view
@@ -0,0 +1,60 @@++name: transf+version: 0.5+cabal-version: >= 1.6+author: Hans Hoglund+maintainer: Hans Hoglund <hans@hanshoglund.se>+license: BSD3+license-file: COPYING+synopsis: Text transformer and interpreter.+category: Music+tested-with: GHC+build-type: Simple++description: + Transf is functional text transformer and interpreter. ++ It scans its input for guard tokens and passes everything between to transformation functions. Transformation functions are composed from a small set of combinators and may perform arbirary Haskell computation. Transf contains a full Haskell interpeter and can even interpret its input as Haskell. ++ The main purpose of Transf is to allow the embedding of Domain-Specific Languages in plain text or Markdown files. For example one could use it with Diagrams as follows:++ > This is my file. Here is an image:+ > + > ~~~diagram "A circle!"+ > circle <> stretchX 2 square+ > ~~~++ Transf can then generate the image, and replace the source in the text file with the name of the actual image. It can also include the source.++ > This is my file. Here is an image:+ > + > + >+ + You can supply your own file names. In the above example, the file name is a 32-bit hash of the source code.+ ++source-repository head+ type: git+ location: git://github.com/hanshoglund/transf.git+ +library + build-depends: + base >= 4 && < 5,+ semigroups,+ containers,+ mtl,+ monadplus,+ filepath,+ process, + hashable,+ hint,+ music-preludes+ hs-source-dirs: src+ exposed-modules:+ Text.Transf++executable "transf"+ ghc-options: -O3 -threaded+ hs-source-dirs: src+ main-is: Main.hs