transf 0.10 → 0.12

raw patch · 3 files changed

+39/−13 lines, 3 filesdep −music-preludes

Dependencies removed: music-preludes

Files

• src/Text/Transf.hs +36/−9
• src/Text/Transf/Process.hs +1/−1
• transf.cabal +2/−3

@@ -63,7 +63,7 @@ import Data.Traversable import Data.Typeable import Data.Hashable-import System.IO (hPutStr, stderr)+import System.IO (hPutStr, hPutStrLn, stderr) import System.Process import Language.Haskell.Interpreter hiding (eval) @@ -71,7 +71,7 @@ import qualified Data.List          as List import qualified Data.Char          as Char import qualified Data.Traversable   as Traversable-import qualified Music.Prelude.Basic as Music+-- import qualified Music.Prelude.Basic as Music  -- | -- A single line of text.@@ -100,7 +100,7 @@ type PrimContextT m = ErrorT String (WriterT (Post m) m)  newtype ContextT m a = ContextT { runContextT_ :: PrimContextT m a }-    deriving ( Monad, MonadIO, MonadPlus,+    deriving ( Functor, Monad, MonadIO, MonadPlus,         MonadError String, MonadWriter (Post m) )  -- | @@ -249,7 +249,9 @@ -- Evaluate a Haskell expression. -- eval :: Typeable a => String -> Context a-eval = evalWith ["Prelude", "Music.Prelude.Basic", "Control.Monad.Plus"] -- FIXME+eval = evalWith ["Prelude", "Music.Prelude.Basic"] +    -- FIXME hardcoded+    -- For some reason, Pitch needs to be in scope (type synonym exported from Music.Prelude.Basic)  -- | Evaluate a Haskell expression with the given modules in scope. --   Note that "Prelude" is /not/ implicitly imported.@@ -264,11 +266,17 @@ evalWith :: Typeable a => [String] -> String -> Context a evalWith imps str = do     res <- liftIO $ runInterpreter $ do+        set [languageExtensions := [OverloadedStrings, NoMonomorphismRestriction]]         setImports imps         interpret str infer     case res of-        Left e -> throwError $ "eval: " ++ show e+        Left e -> throwError $ "Could not evaluate: " ++ str ++ "\n" ++ showIE e         Right a -> return a+    where+        showIE (WontCompile xs)  = "    " ++ List.intercalate "\n    " (fmap errMsg xs)+        showIE (UnknownError x)  = x+        showIE (NotAllowed x)    = x+        showIE (GhcException x)  = x  -- | -- Write to the standard error stream.@@ -342,12 +350,25 @@ musicT' :: MusicOpts -> Transform musicT' opts = transform "music" $ \input -> do     let name = showHex (abs $ hash input) ""-    music <- eval input :: Context (Music.Score Music.Note) -    liftIO $ Music.writeLy (name++".ly") music+    {-+    music <- eval input :: Context (Music.Score Music.BasicNote)++    liftIO $ let handler ex = hPutStrLn stderr $ "transf (music+ly): " ++ show (ex::SomeException) ++ "\n" ++ show input+        in handler `handle` (Music.writeLilypond (name++".ly") music)+     liftIO $ Music.writeMidi (name++".mid") music-    -- liftIO $ void $ readProcess "timidity" ["-Ow", name++".mid"] ""+    -- liftIO $ void $ readProcess "timidity" ["-Ow", name++".mid"] ""+-} +    -- Use music2... wrappers rather than hint+    -- Note that the use of readProcess will propagate error messages from stderr+    -- (including both parse and type errors).+    +    writeFile (name++".music") input+    liftIO $ void $ readProcess "music2ly"   ["-o", name++".ly",  name++".music"] ""+    liftIO $ void $ readProcess "music2midi" ["-o", name++".mid", name++".music"] ""+     let makeLy = do         (exit, out, err) <- readProcessWithExitCode "lilypond" [             "-f", format opts, @@ -365,9 +386,15 @@      addPost (liftIO $ makeLy >> makePng) -    let playText = ""+    -- let playText = ""++    -- Play generated MIDI file+    let playText = "<div class='haskell-music-listen'><a href='"++name++".mid'>listen</a></div>"+    +    -- Play generated WAV file     -- let playText = "<div class='haskell-music-listen'><a href='"++name++".wav'>listen</a></div>" +    -- Use Web MIDI player     -- let playText = "<div>" ++     --                "  <a href=\"javascript:playFile('"++name++".mid')\">[play]</a>\n" ++     --                "  <a href=\"javascript:stopPlaying()\">[stop]</a>\n" ++

@@ -64,7 +64,7 @@     return ()      where-        version name = name ++ "-0.9"+        version name = name ++ "-0.12"         header  name = "Usage: "++name++" [options]\n" ++                        "Usage: "++name++" [options] files...\n" ++                        "\n" ++

@@ -1,6 +1,6 @@  name:               transf-version:            0.10+version:            0.12 cabal-version:      >= 1.6 author:             Hans Hoglund maintainer:         Hans Hoglund <hans@hanshoglund.se>@@ -51,8 +51,7 @@         async,         process,               hashable,-        hint,-        music-preludes+        hint     hs-source-dirs: src     exposed-modules:         Text.Transf