jammittools 0.4.1.1 → 0.5

raw patch · 6 files changed

+313/−121 lines, 6 filesdep +textdep +xmldep −property-listdep ~jammittoolsPVP ok

version bump matches the API change (PVP)

Dependencies added: text, xml

Dependencies removed: property-list

Dependency ranges changed: jammittools

API changes (from Hackage documentation)

Files

• Main.hs +1/−1
• README.md +2/−0
• jammittools.cabal +5/−3
• src/Sound/Jammit/Base.hs +154/−111
• src/Sound/Jammit/Internal/Image.hs +15/−6
• src/Sound/Jammit/Internal/PropertyList.hs +136/−0

@@ -127,7 +127,7 @@  getPageLines :: Integer -> Args -> Int getPageLines systemHeight args = let-  pageHeight   = 724 / 8.5 * 11 :: Double+  pageHeight   = sheetWidth / 8.5 * 11 :: Double   defaultLines = round $ pageHeight / fromIntegral systemHeight   in max 1 $ fromMaybe defaultLines $ pageLines args 

@@ -6,6 +6,8 @@ It should go without saying, but please do not distribute content from songs you have purchased -- it is for your use only! +Download the latest Windows/Mac binaries from the [releases page](https://github.com/mtolly/jammittools/releases).+ [Jammit]: https://www.jammit.com/  ## Usage

@@ -1,5 +1,5 @@ Name:               jammittools-Version:            0.4.1.1+Version:            0.5 Synopsis:           Export sheet music and audio from Windows/Mac app Jammit Description: @@ -30,10 +30,12 @@     Sound.Jammit.Internal.Audio     Sound.Jammit.Internal.Image     Sound.Jammit.Internal.TempIO+    Sound.Jammit.Internal.PropertyList   hs-source-dirs:   src   build-depends:     base            >= 4.6.0.1 && < 5-    , property-list >= 0.1.0.4 && < 0.2+    , xml           >= 1.3.14  && < 1.4+    , text          >= 1.2.1.1 && < 1.3     , directory     >= 1.2.0.1 && < 1.3     , filepath      >= 1.3.0.1 && < 1.5     , containers    >= 0.5.0.0 && < 0.6@@ -59,7 +61,7 @@     , directory     >= 1.2.0.1 && < 1.3     , filepath      >= 1.3.0.1 && < 1.5     , boxes         >= 0.1.3   && < 0.2-    , jammittools   == 0.4.1.1+    , jammittools   == 0.5   ghc-options:      -Wall -O2  source-repository head

@@ -2,6 +2,7 @@ Basic types and functions for dealing with Jammit song packages. -} {-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-} module Sound.Jammit.Base ( Instrument(..) , Part(..)@@ -11,44 +12,49 @@ , titleToAudioPart , partToInstrument , audioPartToInstrument-, Info(..)-, Track(..)-, loadInfo-, loadTracks+, Info(..), loadInfo+, Track(..), loadTracks+, SkillLevel(..) , findJammitDir , songSubdirs+, Beat(..), loadBeats, loadGhost+, Section(..), loadSections+, findNotation, findTab, findAudio+, sheetWidth, sheetHeight ) where  #if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>), (<*>))+import Control.Applicative ((<$>)) #endif-import Control.Applicative (liftA2)-import Control.Arrow ((***))-import Control.Exception (evaluate)-import Control.Monad (filterM, guard)-import Data.Char (toLower, toUpper)-import Data.Maybe (catMaybes)+import Control.Applicative ((<|>))+import Control.Monad (filterM, guard, forM)+import Data.Char (toLower) import System.Environment (lookupEnv)-import Text.Read (readMaybe)- import qualified Data.Map as Map-import qualified Data.PropertyList as PL import qualified System.Directory as Dir import System.FilePath ((</>)) import qualified System.Info as Info --- | The Enum instance corresponds to the number used in the "instrument"--- property, and the names (used by Show/Read) are capitalized versions of those--- used in the "skillLevel" property.+import Sound.Jammit.Internal.PropertyList++-- | The 'Enum' instance corresponds to the number used in the 'instrument'+-- property, and the names (used by 'Show' and 'Read') are capitalized versions+-- of those used in the 'skillLevel' property. data Instrument = Guitar | Bass | Drums | Keyboard | Vocal   deriving (Eq, Ord, Show, Read, Enum, Bounded) +-- | Used for both the "instrument" and "skillLevel" properties.+instance PropertyListItem Instrument where+  fromPropertyList pl = plistToEnum pl <|> do+    str <- fromPropertyList pl+    lookup str [ (map toLower $ show inst, inst) | inst <- [minBound .. maxBound] ]+ data Part   = PartGuitar1 -- ^ Used for both Guitar and Guitar 1   | PartGuitar2   | PartBass   | PartDrums1 -- ^ Used for both Drums and Drums 1-  | PartDrums2 -- ^ Rarely used. Seen in \"Space Truckin'\"+  | PartDrums2 -- ^ Rarely used. Seen in \"Space Truckin\'\"   | PartKeys1 -- ^ Used for both Keys and Keys 1   | PartKeys2   | PartPiano -- ^ Rarely used. Seen in \"The Answer Lies Within\" and \"Wait for Sleep\"@@ -59,13 +65,13 @@   deriving (Eq, Ord, Show, Read, Enum, Bounded)  data AudioPart-  = Only Part -- ^ An audio file for a single notated part.+  = Only    Part       -- ^ An audio file for a single notated part.   | Without Instrument -- ^ The backing track for an instrument package.   deriving (Eq, Ord, Show, Read)  data SheetPart   = Notation Part -- ^ For any instrument, the notation sheet music.-  | Tab Part -- ^ For guitar and bass, the tablature sheet music.+  | Tab      Part -- ^ For guitar and bass, the tablature sheet music.   deriving (Eq, Ord, Show, Read)  titleToPart :: String -> Maybe Part@@ -110,6 +116,22 @@ audioPartToInstrument (Only    p) = partToInstrument p audioPartToInstrument (Without i) = i +data SkillLevel+  = OneSkill   Integer+  | ManySkills [(Instrument, Integer)]+  deriving (Eq, Ord, Show, Read)++-- | Can be an integer, or a dict of instrument names to integers.+instance PropertyListItem SkillLevel where+  fromPropertyList pl+    =   do+      OneSkill <$> fromPropertyList pl+    <|> do+      dict <- fromPropertyList pl+      fmap ManySkills $ forM (Map.toList dict) $ \(k, v) -> do+        inst <- fromPropertyList $ String k+        return (inst, v)+ data Info = Info   { album        :: String   , artist       :: String@@ -122,7 +144,7 @@   , genre        :: String   , instrument   :: Instrument   , publishedBy  :: String-  , skillLevel   :: Either Integer [(Instrument, Integer)]+  , skillLevel   :: SkillLevel   , sku          :: String   , slow         :: Double   , title        :: String@@ -130,73 +152,30 @@   , writtenBy    :: String   } deriving (Eq, Ord, Show, Read) -instance PL.PropertyListItem Info where--  fromPropertyList pl = PL.fromPlDict pl >>= \dict -> Info-    <$> (Map.lookup "album"        dict >>= PL.fromPlString)-    <*> (Map.lookup "artist"       dict >>= PL.fromPlString)-    <*> (Map.lookup "bpm"          dict >>= PL.fromPlString)-    <*> (Map.lookup "copyright"    dict >>= PL.fromPlString)-    <*> (Map.lookup "countInBeats" dict >>= PL.fromPlInt   )-    <*> (Map.lookup "courtesyOf"   dict >>= PL.fromPlString)-    <*> (Map.lookup "demo"         dict >>=    fromPlEnum  )-    <*> (Map.lookup "explicit"     dict >>=    fromPlEnum  )-    <*> (Map.lookup "genre"        dict >>= PL.fromPlString)-    <*> (Map.lookup "instrument"   dict >>=    fromPlEnum  )-    <*> (Map.lookup "publishedBy"  dict >>= PL.fromPlString)-    <*> (Map.lookup "skillLevel"   dict >>=    fromPlSkills)-    <*> (Map.lookup "sku"          dict >>= PL.fromPlString)-    <*> (Map.lookup "slow"         dict >>= PL.fromPlReal  )-    <*> (Map.lookup "title"        dict >>= PL.fromPlString)-    <*> (Map.lookup "version"      dict >>= PL.fromPlInt   )-    <*> (Map.lookup "writtenBy"    dict >>= PL.fromPlString)--  toPropertyList info = PL.plDict $ Map.fromList-    [ ("album"       , PL.plString $ album        info)-    , ("artist"      , PL.plString $ artist       info)-    , ("bpm"         , PL.plString $ bpm          info)-    , ("copyright"   , PL.plString $ copyright    info)-    , ("countInBeats", PL.plInt    $ countInBeats info)-    , ("courtesyOf"  , PL.plString $ courtesyOf   info)-    , ("demo"        ,    plEnum   $ demo         info)-    , ("explicit"    ,    plEnum   $ explicit     info)-    , ("genre"       , PL.plString $ genre        info)-    , ("instrument"  ,    plEnum   $ instrument   info)-    , ("publishedBy" , PL.plString $ publishedBy  info)-    , ("skillLevel"  ,    plSkills $ skillLevel   info)-    , ("sku"         , PL.plString $ sku          info)-    , ("slow"        , PL.plReal   $ slow         info)-    , ("title"       , PL.plString $ title        info)-    , ("version"     , PL.plInt    $ version      info)-    , ("writtenBy"   , PL.plString $ writtenBy    info)-    ]--fromPlEnum :: (Enum a) => PL.PropertyList -> Maybe a-fromPlEnum pl = toEnum . fromIntegral <$> PL.fromPlInt pl--plEnum :: (Enum a) => a -> PL.PropertyList-plEnum = PL.plInt . fromIntegral . fromEnum--fromPlSkills-  :: PL.PropertyList -> Maybe (Either Integer [(Instrument, Integer)])-fromPlSkills pl = case (PL.fromPlInt pl, PL.fromPlDict pl) of-  (Nothing, Nothing) -> Nothing-  (Just i , _      ) -> Just $ Left i-  (_      , Just d ) -> let-    getSkill :: (String, PL.PropertyList) -> Maybe (Instrument, Integer)-    getSkill (x, y) = liftA2 (,) (readMaybe $ capitalize x) (PL.fromPlInt y)-    capitalize ""     = ""-    capitalize (c:cs) = toUpper c : map toLower cs-    in fmap Right $ mapM getSkill $ Map.toList d--plSkills :: Either Integer [(Instrument, Integer)] -> PL.PropertyList-plSkills (Left  i ) = PL.plInt i-plSkills (Right sl) = PL.plDict $-  Map.fromList $ map (map toLower . show *** PL.plInt) sl+instance PropertyListItem Info where+  fromPropertyList pl = do+    dict <- fromPropertyList pl+    album        <- fromLookup "album"        dict+    artist       <- fromLookup "artist"       dict+    bpm          <- fromLookup "bpm"          dict+    copyright    <- fromLookup "copyright"    dict+    countInBeats <- fromLookup "countInBeats" dict+    courtesyOf   <- fromLookup "courtesyOf"   dict+    demo         <- fromLookup "demo"         dict+    explicit     <- fromLookup "explicit"     dict+    genre        <- fromLookup "genre"        dict+    instrument   <- fromLookup "instrument"   dict+    publishedBy  <- fromLookup "publishedBy"  dict+    skillLevel   <- fromLookup "skillLevel"   dict+    sku          <- fromLookup "sku"          dict+    slow         <- fromLookup "slow"         dict+    title        <- fromLookup "title"        dict+    version      <- fromLookup "version"      dict+    writtenBy    <- fromLookup "writtenBy"    dict+    return Info{..}  loadInfo :: FilePath -> IO (Maybe Info)-loadInfo dir =-  PL.fromPropertyList <$> readXmlPropertyListFromFile' (dir </> "info.plist")+loadInfo dir = fromPropertyList <$> readPropertyList (dir </> "info.plist")  data Track = Track   { trackClass          :: String@@ -206,33 +185,18 @@   , trackTitle          :: Maybe String   } deriving (Eq, Ord, Show, Read) -instance PL.PropertyListItem Track where--  toPropertyList t = PL.plDict $ Map.fromList $ catMaybes-    [ Just ("class"              , PL.plString $ trackClass          t)-    , Just ("identifier"         , PL.plString $ identifier          t)-    , (\i -> ("scoreSystemHeight"  , PL.plInt    i)) <$> scoreSystemHeight   t-    , (\i -> ("scoreSystemInterval", PL.plInt    i)) <$> scoreSystemInterval t-    , (\s -> ("title"              , PL.plString s)) <$> trackTitle          t-    ]--  fromPropertyList pl = PL.fromPlDict pl >>= \d -> Track-    <$>      (Map.lookup "class"               d >>= PL.fromPlString)-    <*>      (Map.lookup "identifier"          d >>= PL.fromPlString)-    <*> Just (Map.lookup "scoreSystemHeight"   d >>= PL.fromPlInt   )-    <*> Just (Map.lookup "scoreSystemInterval" d >>= PL.fromPlInt   )-    <*> Just (Map.lookup "title"               d >>= PL.fromPlString)+instance PropertyListItem Track where+  fromPropertyList pl = do+    dict <- fromPropertyList pl+    trackClass             <- fromLookup "class"               dict+    identifier             <- fromLookup "identifier"          dict+    let scoreSystemHeight   = fromLookup "scoreSystemHeight"   dict+        scoreSystemInterval = fromLookup "scoreSystemInterval" dict+        trackTitle          = fromLookup "title"               dict+    return Track{..}  loadTracks :: FilePath -> IO (Maybe [Track])-loadTracks dir = PL.listFromPropertyList <$>-  readXmlPropertyListFromFile' (dir </> "tracks.plist")---- | Reads strictly so as not to exhaust our allowed open files.-readXmlPropertyListFromFile' :: FilePath -> IO PL.PropertyList-readXmlPropertyListFromFile' f = do-  str <- readFile f-  _ <- evaluate $ length str-  either fail return $ PL.readXmlPropertyList str+loadTracks dir = fromPropertyList <$> readPropertyList (dir </> "tracks.plist")  -- | Tries to find the top-level Jammit library directory on Windows or -- Mac OS X.@@ -266,3 +230,82 @@   let here = [dir | isSong]   subdirs <- lsAbsolute dir >>= filterM Dir.doesDirectoryExist   (here ++) . concat <$> mapM songSubdirs subdirs++data Beat = Beat+  { isDownbeat  :: Bool+  , isGhostBeat :: Bool+  , position    :: Double+  } deriving (Eq, Ord, Show, Read)++instance PropertyListItem Beat where+  fromPropertyList pl = do+    dict <- fromPropertyList pl+    isDownbeat  <- fromLookup "isDownbeat"  dict+    isGhostBeat <- fromLookup "isGhostBeat" dict+    position    <- fromLookup "position"    dict+    return Beat{..}++loadBeats :: FilePath -> IO (Maybe [Beat])+loadBeats dir = fromPropertyList <$> readPropertyList (dir </> "beats.plist")++loadGhost :: FilePath -> IO (Maybe [Beat])+loadGhost dir = fromPropertyList <$> readPropertyList (dir </> "ghost.plist")++data Section = Section+  { sectionBeat   :: Integer+  , sectionNumber :: Integer+  , sectionType   :: Integer+  } deriving (Eq, Ord, Show, Read)++instance PropertyListItem Section where+  fromPropertyList pl = do+    dict <- fromPropertyList pl+    sectionBeat   <- fromLookup "beat"   dict+    sectionNumber <- fromLookup "number" dict+    sectionType   <- fromLookup "type"   dict+    return Section{..}++loadSections :: FilePath -> IO (Maybe [Section])+loadSections dir = fromPropertyList <$> readPropertyList (dir </> "sections.plist")++{-+Known section types+=== in Erotomania ===+0 pre-song+1 intro+2 verse+4 chorus+7 outro+9 post-song+13 b-section+17 interlude+23 c-section+25 guitar solo+36 transition+-}++findImages :: String -> Track -> FilePath -> IO [FilePath]+findImages suffix trk dir = do+  files <- Dir.getDirectoryContents dir+  let image i = identifier trk ++ "_" ++ suffix ++ "_" ++ showTwo i+      showTwo i = if i < 10 then '0' : show i else show i+  return+    [ dir </> file+    | file <- map image ([0..99] :: [Int])+    , file `elem` files+    ]++findNotation, findTab :: Track -> FilePath -> IO [FilePath]+findNotation = findImages "jcfn"+findTab      = findImages "jcft"++findAudio :: Track -> FilePath -> IO (Maybe FilePath)+findAudio trk dir = let+  file = dir </> identifier trk ++ "_jcfx"+  in do+    b <- Dir.doesFileExist file+    return $ guard b >> Just file++sheetWidth, sheetHeight :: (Num a) => a+sheetWidth  = 724+sheetHeight = 1024

@@ -90,12 +90,21 @@     else go is x $ y - P.imageHeight i  vertSplit :: Int -> P.Image P.PixelRGBA8 -> [P.Image P.PixelRGBA8]-vertSplit h img = map f $ takeWhile (< P.imageHeight img) [0, h ..] where-  f yoff = P.generateImage-    (g yoff)-    (P.imageWidth img)-    (min h $ P.imageHeight img - yoff)-  g yoff x y = P.pixelAt img x $ y + yoff+vertSplit h img = if P.imageHeight img <= h+  then [img]+  else let+    chunkSize = P.pixelBaseIndex img 0 h+    first = P.Image+      { P.imageWidth  = P.imageWidth img+      , P.imageHeight = h+      , P.imageData   = V.take chunkSize $ P.imageData img+      }+    rest = P.Image+      { P.imageWidth  = P.imageWidth img+      , P.imageHeight = P.imageHeight img - h+      , P.imageData   = V.drop chunkSize $ P.imageData img+      }+    in first : vertSplit h rest  imagePage :: PDF.JpegFile -> PDF.PDF () imagePage jpeg = do

@@ -0,0 +1,136 @@+-- | A very simple, non-robust property list parser.+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleInstances #-}+module Sound.Jammit.Internal.PropertyList+( readPropertyList+, PropertyList(..)+, PropertyListItem(..)+, plistToEnum+, fromLookup+) where++import qualified Data.Text.IO as TIO+import Text.XML.Light+import qualified Data.Map as Map+import Text.Read (readMaybe)+import Data.Maybe (mapMaybe, fromJust)+import Data.Char (isSpace)+import Control.Monad (guard)++#if !MIN_VERSION_base(4,8,0)+import Prelude hiding (mapM)+import Data.Traversable (mapM)+import Control.Applicative ((<$>))+#endif++data PropertyList+  = String String+  | Real Double+  | Integer Integer+  | Bool Bool+  | Array [PropertyList]+  | Dict (Map.Map String PropertyList)+  -- not supported: date or data+  deriving (Eq, Ord, Show, Read)++asParent :: Element -> (String, [Element])+asParent Element{ elName = QName{..}, .. } = (qName, getElements elContent)++getElements :: [Content] -> [Element]+getElements = mapMaybe $ \case+  Elem e -> Just e+  _      -> Nothing++asChild :: Element -> Maybe (String, String)+asChild Element{ elName = QName{..}, .. } = case elContent of+  [Text CData{..}] -> Just (qName, cdData)+  _                -> Nothing++plist :: Element -> Maybe PropertyList+plist e = case asParent e of+  ("plist", [x]) -> value x+  _              -> Nothing++value :: Element -> Maybe PropertyList+value e = case asParent e of+  ("array", elts) -> Array <$> mapM value elts+  ("dict" , elts) -> Dict . Map.fromList <$> go elts where+    go (x : y : xs) = do+      ("key", k) <- asChild x+      v <- value y+      ((k, v) :) <$> go xs+    go [] = Just []+    go _  = Nothing+  ("true" , []) -> Just $ Bool True+  ("false", []) -> Just $ Bool False+  _ -> asChild e >>= \case+    ("string" , s) -> Just $ String $ trim s+    ("real"   , s) -> Real    <$> readMaybe s+    ("integer", s) -> Integer <$> readMaybe s+    _              -> Nothing+    where trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace++-- | Reads strictly so as not to exhaust our allowed open files.+readPropertyList :: FilePath -> IO PropertyList+readPropertyList f = do+  txt <- TIO.readFile f+  case parseXMLDoc txt >>= plist of+    Nothing -> error $+      "readPropertyList: failed to read property list from " ++ f+    Just pl -> return pl++-- | Only covers parsing values from property lists.+class PropertyListItem a where+  fromPropertyList :: PropertyList -> Maybe a+  listFromPropertyList :: PropertyList -> Maybe [a]+  listFromPropertyList (Array xs) = mapM fromPropertyList xs+  listFromPropertyList _          = Nothing++instance PropertyListItem PropertyList where+  fromPropertyList = Just++instance PropertyListItem Char where+  fromPropertyList (String [c]) = Just c+  fromPropertyList _            = Nothing+  listFromPropertyList (String s) = Just s+  listFromPropertyList _          = Nothing++instance (PropertyListItem a) => PropertyListItem [a] where+  fromPropertyList = listFromPropertyList++instance PropertyListItem Int where+  fromPropertyList (Integer i) = Just $ fromIntegral i+  fromPropertyList _           = Nothing++instance PropertyListItem Integer where+  fromPropertyList (Integer i) = Just i+  fromPropertyList _           = Nothing++instance PropertyListItem Double where+  fromPropertyList (Real d) = Just d+  fromPropertyList _        = Nothing++instance (PropertyListItem a) => PropertyListItem (Map.Map String a) where+  fromPropertyList (Dict d) = mapM fromPropertyList d+  fromPropertyList _        = Nothing++instance PropertyListItem Bool where+  fromPropertyList (Bool    b) = Just b+  fromPropertyList (Integer 0) = Just False+  fromPropertyList (Integer 1) = Just True+  fromPropertyList _           = Nothing++plistToEnum :: (Enum a, Bounded a) => PropertyList -> Maybe a+plistToEnum pl = let+  minval = fromEnum $ minBound `asTypeOf` fromJust result+  maxval = fromEnum $ maxBound `asTypeOf` fromJust result+  result = do+    n <- fromPropertyList pl+    guard $ minval <= n && n <= maxval+    return $ toEnum n+  in result++fromLookup :: (PropertyListItem a) => String -> Map.Map String PropertyList -> Maybe a+fromLookup s dict = Map.lookup s dict >>= fromPropertyList