transf 0.12 → 0.13
raw patch · 3 files changed
+68/−30 lines, 3 files
Files
- src/Main.hs +19/−6
- src/Text/Transf.hs +48/−23
- transf.cabal +1/−1
src/Main.hs view
@@ -9,13 +9,22 @@ import Text.Transf.Process main = defaultMain' "transf" optDesc transf-transf opts = haskellT <> musicT' (getMusicOpts opts) <> musicHaskellT' (getMusicOpts opts) <> musicExtraT+transf opts = + haskellT+ <> printT+ <> evalT+ -- <> haskellT+ <> evalHaskellT+ <> musicT' (getMusicOpts opts) + <> musicHaskellT' (getMusicOpts opts) + <> musicExtraT data Opt = Format String | Resolution Int | Resize Int+ | Prelude String getFormat :: Opt -> Maybe String getFormat (Format a) = Just a getFormat _ = Nothing@@ -23,21 +32,25 @@ getResolution _ = Nothing getResize (Resize a) = Just a getResize _ = Nothing+getPrelude (Prelude a) = Just a+getPrelude _ = Nothing firstJust :: [Maybe a] -> Maybe a firstJust = listToMaybe . catMaybes getMusicOpts :: [Opt] -> MusicOpts getMusicOpts xs = MusicOpts {- format = fromMaybe (format def) $ firstJust $ fmap getFormat xs,+ format = fromMaybe (format def) $ firstJust $ fmap getFormat xs, resolution = fromMaybe (resolution def) $ firstJust $ fmap getResolution xs,- resize = fromMaybe (resize def) $ firstJust $ fmap getResize xs+ resize = fromMaybe (resize def) $ firstJust $ fmap getResize xs,+ prelude = fromMaybe (prelude def) $ firstJust $ fmap getPrelude xs } optDesc :: [OptDescr Opt] optDesc = [- Option [] ["format"] (ReqArg Format "pdf|png|ps") "Music output format",- Option [] ["resolution"] (ReqArg (Resolution . read) "N") "Music resolution",- Option [] ["resize"] (ReqArg (Resize . read) "N") "Music resize factor"+ Option [] ["format"] (ReqArg Format "pdf|png|ps") "Music output format",+ Option [] ["resolution"] (ReqArg (Resolution . read) "N") "Music resolution",+ Option [] ["resize"] (ReqArg (Resize . read) "N") "Music resize factor",+ Option [] ["prelude"] (ReqArg Prelude "<name>") "Music prelude name" ]
src/Text/Transf.hs view
@@ -42,6 +42,7 @@ MusicOpts(..), musicT', haskellT,+ evalHaskellT, musicHaskellT, musicHaskellT', musicExtraT,@@ -319,19 +320,25 @@ -- > The number is 6 -- evalT :: Transform-evalT = transform "eval" $ \input -> evalWith ["Prelude"] input+-- evalT = transform "eval" $ \input -> evalWith ["Prelude"] input+evalT = transform "eval" $ \input -> do+ (exit, out, err) <- liftIO $ readProcessWithExitCode "runhaskell2" [] input+ inform err+ return out -- TODO move to separate module and/or package data MusicOpts = MusicOpts { format :: String, resolution :: Int,- resize :: Int+ resize :: Int,+ prelude :: String } instance Default MusicOpts where def = MusicOpts { format = "png", resolution = 200,- resize = 45+ resize = 45,+ prelude = "basic" } -- |@@ -349,6 +356,7 @@ musicT' :: MusicOpts -> Transform musicT' opts = transform "music" $ \input -> do+ let prel = prelude opts let name = showHex (abs $ hash input) "" {-@@ -364,35 +372,37 @@ -- 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, - "-dresolution=" ++ show (resolution opts) ++ "", name++".ly"- ] mempty- hPutStr stderr out- hPutStr stderr err- return ()+ currentFile <- liftIO $ tryMaybe $ Prelude.readFile (name++".music")+ unless (currentFile == Just input) $ do+ writeFile (name++".music") input+ liftIO $ void $ readProcess "music2ly" ["--prelude", prel, "-o", name++".ly", name++".music"] ""+ liftIO $ void $ readProcess "music2midi" ["--prelude", prel, "-o", name++".mid", name++".music"] ""++ let makeLy = do+ (exit, out, err) <- readProcessWithExitCode "lilypond" [+ "-f", format opts, + "-dresolution=" ++ show (resolution opts) ++ "", name++".ly"+ ] mempty+ hPutStr stderr out+ hPutStr stderr err+ return () - let makePng = when (format opts == "png") $ void $ system $ - "convert -transparent white -resize " - ++ show (resize opts) ++"% "- ++ name ++".png "- ++ name ++ "x.png"+ let makePng = when (format opts == "png") $ void $ system $ + "convert -transparent white -resize " + ++ show (resize opts) ++"% "+ ++ name ++".png "+ ++ name ++ "x.png" - addPost (liftIO $ makeLy >> makePng)+ addPost (liftIO $ makeLy >> makePng) -- let playText = "" -- Play generated MIDI file- let playText = "<div class='haskell-music-listen'><a href='"++name++".mid'>listen</a></div>"+ 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>"+ -- let playText = "<div class='haskell-music-listen'><a href='"++name++".wav'>[listen]</a></div>" -- Use Web MIDI player -- let playText = "<div>" ++@@ -453,7 +463,13 @@ return $ begin ++ "\n\n" ++ musicRes ++ "\n\n" ++ haskellRes ++ "\n\n" ++ end +evalHaskellT :: Transform+evalHaskellT = transform "eval+haskell" $ \input -> do+ evalRes <- doTrans evalT input+ haskellRes <- doTrans haskellT input+ return $ "\n\n" ++ evalRes ++ "\n\n" ++ haskellRes ++ "\n\n" + ---------------------------------------------------------------------------------------------------- -- | Separate the sections delimited by the separators from their context. Returns@@ -504,3 +520,12 @@ in foldb f z as `f` foldb f z bs where split xs = (take n xs, drop n xs) where n = length xs `div` 2+++tryMaybe :: IO a -> IO (Maybe a)+tryMaybe action = do+ r <- try action+ return $ case r of+ Left e -> let e' = (e::SomeException) in Nothing+ Right x -> Just x+
transf.cabal view
@@ -1,6 +1,6 @@ name: transf-version: 0.12+version: 0.13 cabal-version: >= 1.6 author: Hans Hoglund maintainer: Hans Hoglund <hans@hanshoglund.se>