packages feed

alga 0.1.0 → 0.2.0

raw patch · 22 files changed

+202/−245 lines, 22 filesdep +aesondep +data-defaultdep +path-iodep −directorydep −temporarydep ~algadep ~megaparsecdep ~transformers

Dependencies added: aeson, data-default, path-io, yaml

Dependencies removed: directory, temporary

Dependency ranges changed: alga, megaparsec, transformers

Files

CHANGELOG.md view
@@ -1,6 +1,13 @@-# History of changes+## ALGA 0.2.0 +* Use the `path-io` library.++* Use YAML files for configuration.++* Fixed bug with “unsupported protocol in URI” on Windows.++* Cosmetic changes in the interface.+ ## ALGA 0.1.0 -Initial release. Support for Ardour is still not done. Maybe because I don't-use it.+* Initial release.
README.md view
@@ -5,7 +5,7 @@ [![Build Status](https://travis-ci.org/mrkkrp/alga.svg?branch=master)](https://travis-ci.org/mrkkrp/alga)  How to algorithmically control every aspect of music using familiar, robust-tools: plugins, DAWs, etc. that have not built with this in mind? I've+tools: plugins, DAWs, etc. that have not been built with this in mind? I've partially solved the problem in [MIDA](https://github.com/mrkkrp/mida) — program that generates MIDI files using simple, symmetric, declarative language. However, even though MIDA is a fine tool to create scores, it's@@ -26,32 +26,30 @@  ## Installation -1. Install [Haskell Platform](https://www.haskell.org/platform/);-2. Install [Cabal](https://www.haskell.org/cabal/);-3. Download and untar git repository of MIDA, or clone it:+1. Install the [Haskell Tool Stack](http://haskellstack.org). +2. Add `~/.local/bin` directory to your `PATH`, like this:+    ```-   $ git clone https://github.com/mrkkrp/alga.git+   # in .bashrc or similar+   export PATH=$HOME/.local/bin:$PATH    ``` -4. Go to the root directory of the repository and execute:+3. Clone the repo, `cd` into it, and let `stack` do its thing:     ```-   $ cabal update-   $ cabal configure-   $ cabal install --only-dependencies-   $ cabal build-   # sh install.sh+   $ git clone https://github.com/mrkkrp/alga.git+   $ cd mida+   $ stack build --copy-bins    ``` -   or (if you use Stack):+4. Check it out:     ```-   $ stack build+   $ alga --version+   ALGA 0.2.0    ``` -5. Done (you can use `uninstall.sh` to uninstall the program).- ## Example  ALGA is a simple declarative language. Just to get feeling of it:@@ -77,6 +75,6 @@  ## License -Copyright © 2015 Mark Karpov+Copyright © 2015–2016 Mark Karpov  Distributed under GNU GPL, version 3.
alga.cabal view
@@ -1,8 +1,7 @@--- -*- Mode: Haskell-Cabal; -*- -- -- Cabal config for ALGA. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software@@ -18,15 +17,15 @@ -- with this program. If not, see <http://www.gnu.org/licenses/>.  name:                 alga-version:              0.1.0+version:              0.2.0 synopsis:             Algorithmic automation for various DAWs description:    How to algorithmically control every aspect of music using familiar,-  robust tools: plugins, DAWs, etc. that have not built with this in mind?-  I've partially solved the problem in MIDA -- program that generates MIDI-  files using very simple and symmetric language. However, even though MIDA-  is a fine tool to create scores, it's not sufficient if you want to+  robust tools: plugins, DAWs, etc. that have not been built with this in+  mind?  I've partially solved the problem in MIDA — program that generates+  MIDI files using very simple and symmetric language. However, even though+  MIDA is a fine tool to create scores, it's not sufficient if you want to   control everything. Initially I thought I could find some plugins that can   algorithmically control other plugins, but there are no decent tools of   this sort. How automation is handled in a traditional DAW? Well, you draw@@ -40,15 +39,23 @@ license-file:         LICENSE.md author:               Mark Karpov maintainer:           Mark Karpov-copyright:            Copyright © 2015 Mark Karpov+copyright:            Copyright © 2015–2016 Mark Karpov category:             Language build-type:           Simple extra-source-files:   README.md, CHANGELOG.md cabal-version:        >= 1.10 +flag dev+  description:        Turn on development settings.+  manual:             True+  default:            False+ library   hs-source-dirs:     src-  ghc-options:        -O2 -Wall+  if flag(dev)+    ghc-options:      -O2 -Wall -Werror+  else+    ghc-options:      -O2 -Wall   ghc-prof-options:   -O2 -Wall -prof -fprof-cafs -rtsopts   build-depends:      base                   >= 4.8 && < 5                     , containers             >= 0.5.5.1@@ -61,13 +68,12 @@                     , random                     , text                   >= 1.2.0.4                     , tf-random              >= 0.5-                    , transformers           >= 0.2.0.0 && < 0.5+                    , transformers           >= 0.2.0.0   default-extensions: FlexibleContexts                     , FlexibleInstances                     , OverloadedStrings                     , TupleSections-  exposed-modules:    Alga.Configuration-                    , Alga.Language+  exposed-modules:    Alga.Language                     , Alga.Language.Element                     , Alga.Language.Environment                     , Alga.Language.Eval@@ -76,22 +82,26 @@                     , Alga.Representation.Parser                     , Alga.Representation.Show                     , Alga.Translation-  other-modules:      Alga.Representation.Base-                    , Alga.Translation.Base                     , Alga.Translation.Ardour+                    , Alga.Translation.Base                     , Alga.Translation.Cubase+  other-modules:      Alga.Representation.Base   default-language:   Haskell2010  executable alga   main-is:            Main.hs   hs-source-dirs:     src   other-modules:      Alga.Interaction-  ghc-options:        -O2 -Wall+  if flag(dev)+    ghc-options:      -O2 -Wall -Werror+  else+    ghc-options:      -O2 -Wall   ghc-prof-options:   -O2 -Wall -prof -fprof-cafs -rtsopts-  build-depends:      alga                   >= 0.1.0+  build-depends:      alga                   >= 0.2.0+                    , aeson                  >= 0.7                     , base                   >= 4.8 && < 5                     , containers             >= 0.5.5.1-                    , directory              >= 1.2.1.0+                    , data-default           >= 0.5.3                     , exceptions             >= 0.8                     , filepath               >= 1.3.0.2                     , formatting             >= 6.2@@ -101,14 +111,16 @@                     , mtl                    >= 2.1.3.1                     , optparse-applicative   >= 0.11.0.2                     , path                   >= 0.5.3+                    , path-io                >= 0.3.1                     , random-                    , temporary              >= 1.2                     , text                   >= 1.2.0.4                     , tf-random              >= 0.5-                    , transformers           >= 0.2.0.0 && < 0.5+                    , transformers           >= 0.2.0.0+                    , yaml                   >= 0.8.15.1   default-extensions: FlexibleContexts                     , FlexibleInstances                     , OverloadedStrings+                    , RecordWildCards                     , TupleSections   other-modules:      Alga.Configuration                     , Alga.Interaction@@ -134,10 +146,13 @@   main-is:            Main.hs   hs-source-dirs:     tests   type:               exitcode-stdio-1.0-  ghc-options:        -O2 -Wall -rtsopts+  if flag(dev)+    ghc-options:      -O2 -Wall -Werror+  else+    ghc-options:      -O2 -Wall   default-language:   Haskell2010   build-depends:      QuickCheck                 >= 2.4 && < 3-                    , alga                       >= 0.1.0+                    , alga                       >= 0.2.0                     , base                       >= 4.8 && < 5                     , containers                 >= 0.5.5.1                     , hxt                        >= 9.3.1.15@@ -148,8 +163,8 @@                     , test-framework-quickcheck2 >= 0.3 && < 0.4                     , text                       >= 1.2.0.4                     , tf-random                  >= 0.5-                    , transformers               >= 0.2.0.0 && < 0.5+                    , transformers               >= 0.2.0.0  source-repository head-  type:              git-  location:          git://github.com/mrkkrp/alga.git+  type:               git+  location:           git://github.com/mrkkrp/alga.git
src/Alga/Configuration.hs view
@@ -1,8 +1,7 @@--- -*- Mode: Haskell; -*- ----- This module describes how to parse Unix-style configuration files.+-- Parse YAML configuration. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software@@ -17,89 +16,67 @@ -- You should have received a copy of the GNU General Public License along -- with this program. If not, see <http://www.gnu.org/licenses/>. -{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE TemplateHaskell #-}  module Alga.Configuration-  ( Params-  , parseConfig-  , lookupCfg )+  ( AlgaConfig (..)+  , parseAlgaConfig+  , def ) where -import Control.Applicative-import Control.Monad-import Data.Char (isSpace)-import Data.Map (Map)-import Data.Maybe (fromMaybe, listToMaybe)-import Data.Text.Lazy (Text)+import Control.Monad.IO.Class+import Data.Aeson+import Data.Default+import Data.Yaml import Numeric.Natural-import Text.Megaparsec-import Text.Megaparsec.Text.Lazy-import qualified Data.Map as M-import qualified Text.Megaparsec.Lexer as L---- | Collection of configuration parameters. They are kept as 'String's and--- then converted on request.--type Params = Map String String--class Read a => Parsable a where-  parseValue :: String -> Maybe a--instance Parsable String where-  parseValue = Just--instance Parsable Natural where-  parseValue = parseNum--instance Parsable Double where-  parseValue = parseNum--instance Parsable Bool where-  parseValue "true"  = Just True-  parseValue "false" = Just False-  parseValue _       = Nothing---- | Lookup a value from configuration parameters. Type of result determines--- how value will be interpreted.--lookupCfg :: Parsable a-  => Params            -- ^ Collection of configuration parameters-  -> String            -- ^ Name of parameter to lookup-  -> a                 -- ^ Fallback value-  -> a                 -- ^ Result-lookupCfg cfg v d = fromMaybe d $ M.lookup v cfg >>= parseValue---- | Parse configuration file.--parseConfig :: String -> Text -> Either String Params-parseConfig file = either (Left . show) Right . parse pConfig file--pConfig :: Parser Params-pConfig = M.fromList <$> (sc *> many pItem <* eof)--pItem :: Parser (String, String)-pItem = (,) <$> pIdentifier <* pOperator "=" <*> (pString <|> pThing)--pIdentifier :: Parser String-pIdentifier = lexeme $ (:) <$> first <*> many other-  where first = letterChar   <|> char '_'-        other = alphaNumChar <|> char '_'+import Path -pOperator :: String -> Parser String-pOperator = lexeme . string+-- | ALGA configuration. -pString :: Parser String-pString = lexeme $ char '"' >> manyTill L.charLiteral (char '"')+data AlgaConfig = AlgaConfig+  { configBackend   :: String        -- ^ Selected backend (DAW dependent)+  , configPrevLen   :: Natural       -- ^ Length of preview principles+  , configSrcFile   :: Path Rel File -- ^ Name of current source file+  , configPrecision :: Double        -- ^ Precision for some REPL utilities+  , configPrompt    :: String        -- ^ REPL prompt+  , configVerbose   :: Bool          -- ^ Verbose mode?+  } deriving (Eq, Show) -pThing :: Parser String-pThing = lexeme $ many (satisfy $ not . isSpace)+instance Default AlgaConfig where+  def = AlgaConfig+    { configBackend   = "default"+    , configPrevLen   = 18+    , configSrcFile   = $(mkRelFile "foo.ga")+    , configPrecision = 0.01+    , configPrompt    = "> "+    , configVerbose   = True+    } -lexeme :: Parser a -> Parser a-lexeme = L.lexeme sc+instance FromJSON AlgaConfig where+  parseJSON = withObject "ALGA configuration" $ \o -> do+    let ω f g n = do+          mval <- o .:? n+          case mval of+            Nothing -> return (f def)+            Just val -> g val+        ξ x = case parseRelFile x of+          Nothing -> fail $ "cannot parse relative path: " ++ show x+          Just path -> return path+        τ :: Int -> Parser Natural+        τ x = if x >= 0+                then return (fromIntegral x)+                else fail $ "the value must be non-negative: " ++ show x+    configBackend   <- ω configBackend   return "backend"+    configPrevLen   <- ω configPrevLen   τ      "prvlen"+    configSrcFile   <- ω configSrcFile   ξ      "src"+    configPrecision <- ω configPrecision return "precision"+    configPrompt    <- ω configPrompt    return "prompt"+    configVerbose   <- ω configVerbose   return "verbose"+    return AlgaConfig {..} -sc :: Parser ()-sc = L.space (void spaceChar) (L.skipLineComment "#") empty+-- | Parse configuration from specified YAML file. -parseNum :: (Num a, Read a) => String -> Maybe a-parseNum = fmap fst . listToMaybe . reads+parseAlgaConfig :: MonadIO m => Path b File -> m (Either String AlgaConfig)+parseAlgaConfig path = liftIO $+  either (Left . prettyPrintParseException) Right+    <$> decodeFileEither (toFilePath path)
src/Alga/Interaction.hs view
@@ -1,9 +1,8 @@--- -*- Mode: Haskell; -*- -- -- This module describes how ALGA processes commands in interactive -- mode. These commands are also used in batch mode. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software
src/Alga/Interaction/Base.hs view
@@ -1,9 +1,8 @@--- -*- Mode: Haskell; -*- -- -- This module describes monad for interactive REPL and some basic -- functions. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software@@ -89,9 +88,9 @@   recursive <- checkRecur n t   if recursive   then liftIO $-    fprint ("Rejected recursive definition for «" % string % "».\n") n+    fprint ("Rejected recursive definition for ‘" % string % "’\n") n   else do addDef n t-          liftIO $ fprint ("• «" % string % "»\n") n+          liftIO $ fprint ("• ‘" % string % "’\n") n  -- | Render a ratio.
src/Alga/Interaction/Commands.hs view
@@ -1,9 +1,8 @@--- -*- Mode: Haskell; -*- -- -- This module describes all supported ALGA commands. It also provides all -- the functionality to load source files and patch XML files. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software@@ -33,8 +32,7 @@ import Alga.Language import Alga.Representation import Alga.Translation-import Control.Exception (SomeException)-import Control.Monad.Catch (try, MonadThrow, fromException, throwM)+import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Reader import Control.Monad.State.Class@@ -47,13 +45,7 @@ import Formatting import Numeric.Natural import Path-import System.Directory-  ( doesDirectoryExist-  , doesFileExist-  , getCurrentDirectory-  , getHomeDirectory-  , makeAbsolute-  , setCurrentDirectory )+import Path.IO import System.Exit (exitSuccess, ExitCode) import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.IO as T@@ -119,7 +111,7 @@             Nothing -> spitExc e         Right _ -> return ()     Nothing -> liftIO $-      fprint ("Unknown command, try " % string % "help.\n") cmdPrefix+      fprint ("Unknown command, try " % string % "help\n") cmdPrefix   where g Cmd { cmdName = c } = c == dropCmdPrefix (T.unpack cmd)         (cmd, args)           = T.break isSpace (T.strip txt) @@ -160,22 +152,21 @@  -- | Change working directory. -cmdCd :: MonadIO m => String -> m ()-cmdCd next' = liftIO $ do-  next    <- fixPath next' >>= parseAbsDir-  let npath = fromAbsDir next-  present <- doesDirectoryExist npath-  if present-  then do setCurrentDirectory npath-          fprint ("Changed to \"" % string % "\".\n") npath-  else fprint ("Cannot cd to \"" % string % "\".\n") npath+cmdCd :: (MonadIO m, MonadCatch m) => String -> m ()+cmdCd next' = do+  mnext <- forgivingAbsence (resolveDir' next')+  case mnext of+    Nothing -> liftIO $ fprint ("Cannot cd to \"" % string % "\"\n") next'+    Just next -> do+      setCurrentDir next+      liftIO $ fprint ("Changed to \"" % string % "\".\n") (fromAbsDir next)  -- | Restore default state of environment.  cmdClear :: (HasEnv m, MonadIO m) => String -> m () cmdClear _ = do   clearDefs-  liftIO (T.putStrLn "Environment cleared.")+  liftIO (T.putStrLn "Environment cleared")  -- | Print definition of given symbol. @@ -219,20 +210,21 @@ loadOne given = do   file <- output given ""   let fpath = fromAbsFile file-  b    <- liftIO $ doesFileExist fpath+  b    <- doesFileExist file   if b-  then do contents <- liftIO $ T.readFile fpath-          case parseAlga fpath contents of-            Right x -> do-              mapM_ f x-              setFileName file-              liftIO $ fprint-                ("\"" % string % "\" loaded successfully.\n")-                fpath-            Left  x -> liftIO $ fprint (string % "\n") x-  else liftIO $ fprint ("Could not find \"" % string % "\".\n") fpath-    where f (Definition n t) = processDef n t-          f (Exposition   _) = return ()+    then do+      contents <- liftIO $ T.readFile fpath+      case parseAlga fpath contents of+        Right x -> do+          mapM_ f x+          setFileName file+          liftIO $ fprint+            ("\"" % string % "\" loaded successfully\n")+            fpath+        Left  x -> liftIO $ fprint (string % "\n") x+    else liftIO $ fprint ("Could not find \"" % string % "\"\n") fpath+      where f (Definition n t) = processDef n t+            f (Exposition   _) = return ()  -- | Logarithmic scale conversion to ratio. @@ -263,8 +255,8 @@   backend <- gets stBackend   status  <- patchAuto s b file backend   let msg = if status == 0-       then "File patched successfully \"" % string % "\".\n"-       else "Failed to patch file \"" % string % "\".\n"+       then "File patched successfully \"" % string % "\"\n"+       else "Failed to patch file \"" % string % "\"\n"   liftIO $ fprint msg (fromAbsFile file)  -- | Set length of displayed results.@@ -279,12 +271,12 @@ cmdPurge :: (HasEnv m, MonadIO m) => String -> m () cmdPurge _ = do   topDefs >>= purgeEnv-  liftIO $ T.putStrLn "Environment purged."+  liftIO $ T.putStrLn "Environment purged"  -- | Print working directory.  cmdPwd :: MonadIO m => String -> m ()-cmdPwd _ = liftIO (getCurrentDirectory >>= putStrLn)+cmdPwd _ = liftIO (getCurrentDir >>= putStrLn . fromAbsDir)  -- | Quit the interactive environment. @@ -306,7 +298,7 @@   src    <- fullSrc   liftIO $ T.writeFile fpath src   setFileName file-  liftIO $ fprint ("Environment saved as \"" % string % "\".\n") fpath+  liftIO $ fprint ("Environment saved as \"" % string % "\"\n") fpath  -- | Undefine definitions. @@ -314,7 +306,7 @@ cmdUdef arg = mapM_ f (words arg)   where f name = do           remDef name-          liftIO $ fprint ("Definition for «" % string % "» removed.\n") name+          liftIO $ fprint ("Definition for ‘" % string % "’ removed\n") name  -- | Convert decibels to ratio. @@ -356,19 +348,11 @@   -> String            -- ^ Extension   -> m (Path Abs File) -- ^ Absolute path to output file output given' ext = do-  given  <- liftIO (fixPath given')+  given  <- resolveFile' given'   actual <- fromAbsFile <$> gets stSrcFile-  let a = if null ext then actual else FP.replaceExtension actual ext-  parseAbsFile (if null given' then a else given)---- | Make path absolute resolving tilde (that's actually shell-functionality,--- but we do it for convenience).--fixPath :: FilePath -> IO FilePath-fixPath path = do-  home <- getHomeDirectory-  let f x = if x == "~" then home else x-  makeAbsolute . FP.joinPath . fmap f . FP.splitDirectories $ path+  a      <- parseAbsFile $+    if null ext then actual else FP.replaceExtension actual ext+  return (if null given' then a else given)  -- | Change current file name. @@ -390,7 +374,7 @@ -- | Print out an exception.  spitExc :: MonadIO m => SomeException -> m ()-spitExc = liftIO . fprint ("× " % string % ".\n") . show+spitExc = liftIO . fprint ("× " % string % "\n") . show  -- | Stupid trimming for strings.
src/Alga/Language.hs view
@@ -1,8 +1,7 @@--- -*- Mode: Haskell; -*- -- -- This is entry point of Alga.Lang library. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software
src/Alga/Language/Element.hs view
@@ -1,9 +1,8 @@--- -*- Mode: Haskell; -*- -- -- This module describes internal representation of principle as list of -- elements. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software
src/Alga/Language/Environment.hs view
@@ -1,9 +1,8 @@--- -*- Mode: Haskell; -*- -- -- Environment is formed via evaluation of definitions. This module -- describes minimal ALGA environment in form of monad transformer. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software@@ -80,7 +79,7 @@            , MonadCatch            , MonadMask ) --- | Type class for things that can be considered MIDA environment.+-- | Type class for things that can be considered ALGA environment.  class Monad m => HasEnv m where   -- | Get collection of all definitions.
src/Alga/Language/Eval.hs view
@@ -1,10 +1,9 @@--- -*- Mode: Haskell; -*- -- -- This module describes process of evaluation of definitions and arbitrary -- principles. Result of evaluation is infinite list of integers or empty -- list. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software
src/Alga/Language/SyntaxTree.hs view
@@ -1,8 +1,7 @@--- -*- Mode: Haskell; -*- -- -- This module defines abstract syntax tree of ALGA language. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software
src/Alga/Representation.hs view
@@ -1,9 +1,8 @@--- -*- Mode: Haskell; -*- -- -- This module binds together syntax tree and textual representation of ALGA -- language. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software
src/Alga/Representation/Base.hs view
@@ -1,8 +1,7 @@--- -*- Mode: Haskell; -*- -- -- Textual representation of basic elements in ALGA language. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software
src/Alga/Representation/Parser.hs view
@@ -1,9 +1,8 @@--- -*- Mode: Haskell; -*- -- -- This module describes how to build syntax tree from textual -- representation of ALGA statements. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software
src/Alga/Representation/Show.hs view
@@ -1,9 +1,8 @@--- -*- Mode: Haskell; -*- -- -- Here we describe how to build textual representation of syntax trees and -- principles. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software
src/Alga/Translation.hs view
@@ -1,9 +1,8 @@--- -*- Mode: Haskell; -*- -- -- This module performs patching of data structure that represent tracks -- according of state of ALGA environment. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016! Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software@@ -28,6 +27,8 @@ import Alga.Translation.Base import Alga.Translation.Ardour import Alga.Translation.Cubase++-- | Transform name of DAW into ALGA backend.  toBackend :: String -> AlgaBackend toBackend "ardour" = ardourBackend
src/Alga/Translation/Ardour.hs view
@@ -1,8 +1,7 @@--- -*- Mode: Haskell; -*- -- -- Patching of XML files, Ardour backend. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software
src/Alga/Translation/Base.hs view
@@ -1,9 +1,8 @@--- -*- Mode: Haskell; -*- -- -- In this module we describe how to prepare information about automation -- tracks and then use specific (to DAW) arrow to patch XML file. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software@@ -105,7 +104,7 @@ patchAuto :: (MonadIO m, HasEnv m)   => Natural           -- ^ Seed for random number generator   -> Double            -- ^ Duration as number of whole notes-  -> Path Abs File     -- ^ Path to file to path+  -> Path Abs File     -- ^ Path to file to patch   -> AlgaBackend       -- ^ Backed (arrow that will patch XML)   -> m Int             -- ^ Exit code patchAuto s b fpath exec = do@@ -114,8 +113,11 @@   amap <- M.fromListWith M.union . concat <$>     mapM (fmap maybeToList . toMap b) refs   let file = fromAbsFile fpath+      uri = "file://" ++ n (g <$> file)+      g x = if x == '\\' then '/' else x+      n x = if head x /= '/' then '/' : x else x   head <$> (liftIO . runX $-    readDocument [withValidate no] file >>>+    readDocument [withValidate no] uri  >>>     exec amap                           >>>     writeDocument [withIndent yes] file >>>     errorMsgStderr                      >>>
src/Alga/Translation/Cubase.hs view
@@ -1,8 +1,7 @@--- -*- Mode: Haskell; -*- -- -- Patching of XML files, Cubase backend. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software
src/Main.hs view
@@ -1,8 +1,7 @@--- -*- Mode: Haskell; -*- -- -- Main module of ALGA describes logic of the program on top level. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software@@ -23,15 +22,14 @@ import Alga.Interaction import Alga.Translation (toBackend) import Control.Monad+import Control.Monad.IO.Class import Data.Text.Lazy (Text) import Data.Version (showVersion) import Formatting import Numeric.Natural import Options.Applicative-import Path+import Path.IO import Paths_alga (version)-import System.Directory (getHomeDirectory, doesFileExist, getCurrentDirectory)-import qualified Data.Map as M import qualified Data.Text.Lazy.IO as T  -- | ALGA application command line options.@@ -71,7 +69,7 @@  notice :: Text notice =-  "ALGA Copyright © 2015 Mark Karpov\n\n\+  "ALGA Copyright © 2015–2016 Mark Karpov\n\n\   \This program comes with ABSOLUTELY NO WARRANTY. This is free software,\n\   \and you are welcome to redistribute it under certain conditions; see\n\   \GNU General Public License for details.\n"@@ -81,7 +79,7 @@ license :: Text license =   "ALGA — algorithmic automation for various DAWs.\n\-  \Copyright © 2015 Mark Karpov\n\+  \Copyright © 2015–2016 Mark Karpov\n\   \\n\   \ALGA is free software: you can redistribute it and/or modify it under the\n\   \terms of the GNU General Public License as published by the Free Software\n\@@ -98,35 +96,24 @@  -- | Read configuration file if present and run ALGA monad. -runAlga' :: Alga () -> IO ()+runAlga' :: Alga a -> IO () runAlga' e = do-  params <- loadConfig-  wdir   <- getCurrentDirectory >>= parseAbsDir-  dfname <- parseRelFile "foo.da"-  let dfltSrcFile = fromAbsFile (wdir </> dfname)-  srcFile <- parseAbsFile (lookupCfg params "src" dfltSrcFile)+  mconfig <- forgivingAbsence (resolveFile' ".alga.yaml")+  c <- case mconfig of+    Nothing -> return def+    Just file -> do+      econfig <- parseAlgaConfig file+      case econfig of+        Left msg -> liftIO (putStrLn msg) >> return def+        Right val -> return val+  srcFile <- makeAbsolute (configSrcFile c)   void $ runAlga e-    AlgaSt { stBackend = toBackend $ lookupCfg params "backend" "default"-           , stPrevLen = lookupCfg params "prvlen" 18+    AlgaSt { stBackend = toBackend (configBackend c)+           , stPrevLen = configPrevLen c            , stSrcFile = srcFile }-    AlgaCfg { cfgPrecision = lookupCfg params "precision" 0.01-            , cfgPrompt    = lookupCfg params "prompt"    "> "-            , cfgVerbose   = lookupCfg params "verbose"   True }---- | Read configuration file.--loadConfig :: IO Params-loadConfig = do-  home <- getHomeDirectory >>= parseAbsDir-  cfn  <- parseRelFile ".alga"-  let file = fromAbsFile (home </> cfn)-  exist <- doesFileExist file-  if exist-  then do params <- parseConfig file <$> T.readFile file-          case params of-            Right x -> return x-            Left  _ -> return M.empty-  else return M.empty+    AlgaCfg { cfgPrecision = configPrecision c+            , cfgPrompt    = configPrompt c+            , cfgVerbose   = configVerbose c }  -- | Some information about the program.
tests/Main.hs view
@@ -1,8 +1,7 @@--- -*- Mode: Haskell; -*- -- -- QuickCheck tests for ALGA. ----- Copyright © 2015 Mark Karpov+-- Copyright © 2015–2016 Mark Karpov -- -- ALGA is free software: you can redistribute it and/or modify it under the -- terms of the GNU General Public License as published by the Free Software