packages feed

uku (empty) → 0.0.1.0

raw patch · 4 files changed

+860/−0 lines, 4 filesdep +basedep +containersdep +ilist

Dependencies added: base, containers, ilist, protolude, text, uku

Files

+ app/Main.hs view
@@ -0,0 +1,109 @@+{-|+Description : Main entry point for the CLI app.++Display ukulele fingering charts in your terminal.+-}+module Main where++import Protolude as P (+  Applicative (pure),+  Char,+  Either (..),+  Functor (fmap),+  IO,+  Int,+  Print (putStr),+  Semigroup ((<>)),+  die,+  getArgs,+  length,+  mapM,+  maximum,+  replicate,+  toUpper,+  transpose,+  zipWith,+  ($),+  (&),+  (+),+  (-),+  (.),+  (<$>),+  (<&>),+ )++import Data.Text qualified as Text (+  Text,+  intercalate,+  lines,+  pack,+  replicate,+  unlines,+  unpack,+ )++import Uku.Render (getAnsiArts)+++toArt :: [Char] -> IO (Text.Text, Text.Text)+toArt raw = do+  let displayName = Text.pack (capitalizeChord raw)+  case getAnsiArts (Text.pack raw) of+    Left err -> die err+    Right art -> pure (displayName, art)+++-- | Capitalize the first letter only (A, B♭, G#m, …)+capitalizeChord :: [Char] -> [Char]+capitalizeChord [] = []+capitalizeChord (x : xs) = toUpper x : xs+++-- | Visible length (ignores "\ESC[ … m" sequences).+visibleLen :: Text.Text -> Int+visibleLen = do+  let+    skip [] = []+    skip ('m' : ys) = ys -- End of CSI+    skip (_ : ys) = skip ys++    go n [] = n+    go n ('\x1b' : xs) = go n $ skip xs -- Skip CSI+    go n (_ : xs) = go (n + 1) xs++  go 0 . Text.unpack+++combineArts :: [(Text.Text, Text.Text)] -> Text.Text+combineArts arts = do+  let+    -- Prepend the chord name to every column+    colsLines = fmap (\(name, art) -> name : Text.lines art) arts++    -- Pad every column to the same number of rows+    maxRows = P.maximum (P.length <$> colsLines)+    padRows x = x <> P.replicate (maxRows - P.length x) ""+    rowPadded = fmap padRows colsLines++    -- Width of every column+    widths = fmap (P.maximum . fmap visibleLen) rowPadded+    -- Right-pad every cell to the column width+    colPadded =+      P.zipWith+        (\col w -> col <&> (\l -> l <> Text.replicate (w - visibleLen l) " "))+        rowPadded+        widths+    -- Combine the rows horizontally+    joined = colPadded & P.transpose <&> Text.intercalate "  "++  Text.unlines joined+++main :: IO ()+main = do+  chords <- getArgs+  case chords of+    [] -> die "Usage: uku <chord> [<chord> ...]"+    cs -> do+      arts <- mapM toArt cs+      putStr $ combineArts arts
+ src/Uku/GeneralTypes.hs view
@@ -0,0 +1,272 @@+module Uku.GeneralTypes (+  MidiNote (..),+  Interval (..),+)+where++import Protolude (Eq, Ord, Show)+++-- | A type representing a MIDI note.+data MidiNote+  = M00+  | M01+  | M02+  | M03+  | M04+  | M05+  | M06+  | M07+  | M08+  | M09+  | M0X+  | M0E+  | M10+  | M11+  | M12+  | M13+  | M14+  | M15+  | M16+  | M17+  | M18+  | M19+  | M1X+  | M1E+  | M20+  | M21+  | M22+  | M23+  | M24+  | M25+  | M26+  | M27+  | M28+  | M29+  | M2X+  | M2E+  | M30+  | M31+  | M32+  | M33+  | M34+  | M35+  | M36+  | M37+  | M38+  | M39+  | M3X+  | M3E+  | M40+  | M41+  | M42+  | M43+  | M44+  | M45+  | M46+  | M47+  | M48+  | M49+  | M4X+  | M4E+  | M50+  | M51+  | M52+  | M53+  | M54+  | M55+  | M56+  | M57+  | M58+  | M59+  | M5X+  | M5E+  | M60+  | M61+  | M62+  | M63+  | M64+  | M65+  | M66+  | M67+  | M68+  | M69+  | M6X+  | M6E+  | M70+  | M71+  | M72+  | M73+  | M74+  | M75+  | M76+  | M77+  | M78+  | M79+  | M7X+  | M7E+  | M80+  | M81+  | M82+  | M83+  | M84+  | M85+  | M86+  | M87+  | M88+  | M89+  | M8X+  | M8E+  | M90+  | M91+  | M92+  | M93+  | M94+  | M95+  | M96+  | M97+  | M98+  | M99+  | M9X+  | M9E+  | MX0+  | MX1+  | MX2+  | MX3+  | MX4+  | MX5+  | MX6+  | MX7+  deriving (Eq, Ord, Show)+++data Interval+  = I00+  | I01+  | I02+  | I03+  | I04+  | I05+  | I06+  | I07+  | I08+  | I09+  | I0X+  | I0E+  | I10+  | I11+  | I12+  | I13+  | I14+  | I15+  | I16+  | I17+  | I18+  | I19+  | I1X+  | I1E+  | I20+  | I21+  | I22+  | I23+  | I24+  | I25+  | I26+  | I27+  | I28+  | I29+  | I2X+  | I2E+  | I30+  | I31+  | I32+  | I33+  | I34+  | I35+  | I36+  | I37+  | I38+  | I39+  | I3X+  | I3E+  | I40+  | I41+  | I42+  | I43+  | I44+  | I45+  | I46+  | I47+  | I48+  | I49+  | I4X+  | I4E+  | I50+  | I51+  | I52+  | I53+  | I54+  | I55+  | I56+  | I57+  | I58+  | I59+  | I5X+  | I5E+  | I60+  | I61+  | I62+  | I63+  | I64+  | I65+  | I66+  | I67+  | I68+  | I69+  | I6X+  | I6E+  | I70+  | I71+  | I72+  | I73+  | I74+  | I75+  | I76+  | I77+  | I78+  | I79+  | I7X+  | I7E+  | I80+  | I81+  | I82+  | I83+  | I84+  | I85+  | I86+  | I87+  | I88+  | I89+  | I8X+  | I8E+  | I90+  | I91+  | I92+  | I93+  | I94+  | I95+  | I96+  | I97+  | I98+  | I99+  | I9X+  | I9E+  | IX0+  | IX1+  | IX2+  | IX3+  | IX4+  | IX5+  | IX6+  | IX7+  deriving (Eq, Ord, Show)
+ src/Uku/Render.hs view
@@ -0,0 +1,426 @@+{-|+Description : Rendering module for Ukulele fingering charts.++This module provides functionality+to render Ukulele fingering charts as ANSI art.+-}+module Uku.Render where++import Protolude as P (+  Applicative (pure),+  Bounded,+  Either (..),+  Enum (fromEnum),+  Eq (..),+  Foldable (fold, foldr, length, maximum),+  Functor (fmap),+  Int,+  Map,+  Num ((+), (-)),+  Ord,+  Semigroup ((<>)),+  Show,+  Text,+  Traversable (mapM),+  intercalate,+  intersperse,+  maybeToEither,+  otherwise,+  replicate,+  transpose,+  ($),+  (&),+  (<$>),+ )++import Data.List.Index (imap, setAt)+import Data.Map.Strict as Map (fromList, lookup)+import Data.Text as Text (intercalate, toLower)++import Uku.GeneralTypes (+  Interval (..),+  MidiNote (..),+ )+++data Finger = Thumb | Index | Middle | Ring | Pinky | AnyFinger+  deriving (Eq, Ord, Show)+++fingerToText :: Finger -> Text+fingerToText finger =+  let colorize text = "\x1b[31m" <> text <> "\x1b[0m"+  in  colorize $ case finger of+        Thumb -> "T"+        Index -> "I"+        Middle -> "M"+        Ring -> "R"+        Pinky -> "P"+        AnyFinger -> "●"+++data FretPosition+  = F1+  | F2+  | F3+  | F4+  | F5+  | F6+  | F7+  | F8+  | F9+  | FA+  | FB+  | FC+  | FD+  | FE+  | FF+  | FG+  | FH+  | FI+  | FJ+  | FK+  | FL+  | FM+  | FN+  | FO+  | FP+  | FQ+  | FR+  | FS+  | FT+  | FU+  | FV+  | FW+  | FX+  | FY+  | FZ+  deriving (Bounded, Enum, Eq, Ord, Show)+++data Pick+  = Mute+  | Open+  | Pick FretPosition Finger+  deriving (Eq, Ord, Show)+++pickToInt :: Pick -> Int+pickToInt fretPosition =+  case fretPosition of+    Pick fret _ -> fromEnum fret + 1+    _ -> 0+++type Fretting = [[Pick]]+++type InstStrings = [Interval]+data PlayedInstrument = PlayedInst InstStrings MidiNote Fretting+type Instrument = Fretting -> PlayedInstrument+++ukulele :: Instrument+ukulele =+  PlayedInst [I07, I00, I04, I09] M34+++-- TODO: Remove duplication+mapChordToHarmonicEquivalent :: Text -> Text+mapChordToHarmonicEquivalent chord = case chord of+  "ab" -> "g#"+  "bb" -> "a#"+  "db" -> "c#"+  "eb" -> "d#"+  "gb" -> "f#"+  "abm" -> "g#m"+  "bbm" -> "a#m"+  "dbm" -> "c#m"+  "ebm" -> "d#m"+  "gbm" -> "f#m"+  "ab7" -> "g#7"+  "bb7" -> "a#7"+  "db7" -> "c#7"+  "eb7" -> "d#7"+  "gb7" -> "f#7"+  _ -> chord+++chordToPlayedInsts :: Text -> Instrument -> Either Text [PlayedInstrument]+chordToPlayedInsts chord instrument =+  let+    maybeInst = do+      frettings <-+        archaicToFretting+          & Map.lookup (chord & toLower & mapChordToHarmonicEquivalent)+      pure $ fmap instrument frettings+    errorMessage =+      "There is no fretting available for the specified chord"+  in+    maybeToEither errorMessage maybeInst+++putPickOnString :: Pick -> [Text] -> [Text]+putPickOnString pick stringParts =+  case pick of+    Mute -> stringParts+    Open -> stringParts+    (Pick _ finger) ->+      setAt+        (pickToInt pick)+        (fingerToText finger)+        stringParts+++getString :: Int -> Int -> Int -> [Pick] -> [Text]+getString numberOfFrets numOfStrings stringIndex strPick =+  let+    openString =+      [ if+          | stringIndex == 0 -> "╒"+          | stringIndex == (numOfStrings - 1) -> "╕"+          | otherwise -> "╤"+      ]+        <> P.replicate (numberOfFrets + 1) "│"+  in+    P.foldr putPickOnString openString strPick+++showFretting :: Fretting -> Text+showFretting fretting =+  let+    maxPos = P.maximum (pickToInt <$> fold fretting)+  in+    fretting+      & imap (getString maxPos $ P.length fretting)+      & P.intersperse (["═"] <> P.replicate (maxPos + 1) "_")+      & P.transpose+      & P.intercalate ["\n"]+      & fold+      & (<> "\n")+++showPlayedInst :: PlayedInstrument -> Either Text Text+showPlayedInst (PlayedInst strings _ fretting)+  | P.length strings /= P.length fretting =+      Left "Number of strings and picks in fretting do not match"+  | otherwise =+      Right $+        showFretting fretting+++getAnsiArts :: Text -> Either Text Text+getAnsiArts chord = do+  playedInsts <- chordToPlayedInsts chord ukulele+  fmap+    (Text.intercalate "\n")+    (mapM showPlayedInst playedInsts)+++archaicToFretting :: Map Text [Fretting]+archaicToFretting =+  Map.fromList+    [+      ( "a"+      ,+        [ [[Pick F2 Middle], [Pick F1 Index], [Open], [Open]]+        ,+          [ [Pick F4 Index, Pick F6 Ring]+          , [Pick F4 Index]+          , [Pick F4 Index, Pick F5 Middle]+          , [Pick F4 Index]+          ]+        ]+      )+    , ("am", [[[Pick F2 Middle], [Open], [Open], [Open]]])+    , ("a7", [[[Open], [Pick F1 Index], [Open], [Open]]])+    ,+      ( "a#"+      ,+        [+          [ [Pick F1 Index, Pick F3 Ring]+          , [Pick F1 Index, Pick F2 Middle]+          , [Pick F1 Index]+          , [Pick F1 Index]+          ]+        ]+      )+    ,+      ( "a#m"+      ,+        [+          [ [Pick F1 Index, Pick F3 Ring]+          , [Pick F1 Index]+          , [Pick F1 Index]+          , [Pick F1 Index]+          ]+        ]+      )+    ,+      ( "a#7"+      ,+        [+          [ [Pick F1 Index]+          , [Pick F1 Index, Pick F2 Middle]+          , [Pick F1 Index]+          , [Pick F1 Index]+          ]+        ]+      )+    ,+      ( "b"+      ,+        [+          [ [Pick F2 Index, Pick F4 Ring]+          , [Pick F2 Index, Pick F3 Middle]+          , [Pick F2 Index]+          , [Pick F2 Index]+          ]+        ]+      )+    ,+      ( "bm"+      ,+        [+          [ [Pick F2 Index, Pick F4 Ring]+          , [Pick F2 Index]+          , [Pick F2 Index]+          , [Pick F2 Index]+          ]+        ]+      )+    , ("b7", [[[Pick F2 Index], [Pick F2 Index], [Pick F2 Index], [Open]]])+    , ("c", [[[Open], [Open], [Open], [Pick F3 Ring]]])+    , ("cm", [[[Open], [Pick F3 Index], [Pick F3 Index], [Pick F3 Index]]])+    , ("c7", [[[Open], [Open], [Open], [Pick F1 Index]]])+    ,+      ( "c#"+      ,+        [+          [ [Pick F1 Index]+          , [Pick F1 Index]+          , [Pick F1 Index]+          , [Pick F1 Index, Pick F4 Pinky]+          ]+        ]+      )+    , ("c#m", [[[Pick F1 Index], [Pick F1 Index], [Open], [Open]]])+    ,+      ( "c#7"+      ,+        [+          [ [Pick F1 Index]+          , [Pick F1 Index]+          , [Pick F1 Index]+          , [Pick F1 Index, Pick F2 Middle]+          ]+        ]+      )+    , ("d", [[[Pick F2 Index], [Pick F2 Middle], [Pick F2 Middle], [Open]]])+    , ("dm", [[[Pick F2 Middle], [Pick F2 Ring], [Pick F1 Index], [Open]]])+    ,+      ( "d7"+      ,+        [+          [ [Pick F2 Index]+          , [Pick F2 Index]+          , [Pick F2 Index]+          , [Pick F2 Index, Pick F3 Middle]+          ]+        ]+      )+    , ("d#", [[[Open], [Pick F3 Ring], [Pick F3 Pinky], [Pick F1 Index]]])+    ,+      ( "d#m"+      ,+        [ [[Pick F3 Ring], [Pick F3 Pinky], [Pick F2 Middle], [Pick F1 Index]]+        ]+      )+    ,+      ( "d#7"+      ,+        [+          [ [Pick F3 Index]+          , [Pick F3 Index]+          , [Pick F3 Index]+          , [Pick F3 Index, Pick F4 Middle]+          ]+        ]+      )+    , ("e", [[[Pick F1 Index], [Pick F4 Pinky], [Open], [Pick F2 Middle]]])+    , ("em", [[[Open], [Pick F4 Ring], [Pick F3 Middle], [Pick F2 Index]]])+    , ("e7", [[[Pick F1 Index], [Pick F2 Middle], [Open], [Pick F2 Pinky]]])+    , ("f", [[[Pick F2 Middle], [Open], [Pick F1 Index], [Open]]])+    , ("fm", [[[Pick F1 Index], [Open], [Pick F1 Middle], [Pick F3 Ring]]])+    ,+      ( "f7"+      ,+        [+          [ [Pick F2 Middle]+          , [Pick F3 Ring]+          , [Pick F1 Index]+          , [Pick F4 Pinky]+          ]+        ,+          [ [Pick F5 Index]+          , [Pick F5 Index]+          , [Pick F5 Index]+          , [Pick F5 Index, Pick F6 Middle]+          ]+        ]+      )+    ,+      ( "f#"+      ,+        [+          [ [Pick F1 Index, Pick F3 Ring]+          , [Pick F1 Index]+          , [Pick F1 Index, Pick F2 Middle]+          , [Pick F1 Index]+          ]+        ]+      )+    , ("f#m", [[[Pick F2 Middle], [Pick F1 Index], [Pick F2 Ring], [Open]]])+    ,+      ( "f#7"+      ,+        [+          [ [Pick F3 Middle]+          , [Pick F4 Ring]+          , [Pick F2 Index]+          , [Pick F4 Pinky]+          ]+        ]+      )+    , ("g", [[[Open], [Pick F2 Index], [Pick F3 Ring], [Pick F2 Middle]]])+    , ("gm", [[[Open], [Pick F2 Middle], [Pick F3 Ring], [Pick F1 Index]]])+    , ("g7", [[[Open], [Pick F2 Middle], [Pick F1 Index], [Pick F2 Ring]]])+    ,+      ( "g#"+      ,+        [+          [ [Pick F3 Index, Pick F5 Ring]+          , [Pick F3 Index]+          , [Pick F3 Index, Pick F4 Middle]+          , [Pick F3 Index]+          ]+        ]+      )+    ,+      ( "g#m"+      ,+        [ [[Pick F4 Ring], [Pick F3 Middle], [Pick F4 Pinky], [Pick F2 Index]]+        ]+      )+    ,+      ( "g#7"+      ,+        [+          [ [Pick F1 Index]+          , [Pick F3 Ring]+          , [Pick F2 Middle]+          , [Pick F3 Pinky]+          ]+        ]+      )+    ]
+ uku.cabal view
@@ -0,0 +1,53 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.38.0.+--+-- see: https://github.com/sol/hpack++name:          uku+version:       0.0.1.0+synopsis:      Display Ukulele fingering charts in the terminal+description:   Please see readme.md+author:        Adrian Sieber+maintainer:    Adrian Sieber+license:       ISC+build-type:    Simple++library+  exposed-modules:+      Uku.GeneralTypes+      Uku.Render+  other-modules:+      Paths_uku+  hs-source-dirs:+      src+  default-extensions:+      NoImplicitPrelude+      OverloadedStrings+      MultiWayIf+  ghc-options: -threaded -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wno-orphans -Wredundant-constraints -Wunused-packages+  build-depends:+      base >=4.18.2 && <4.20+    , containers >=0.6.7 && <0.7+    , ilist >=0.4.0 && <0.5+    , protolude >=0.3.4 && <0.4+    , text >=2.0.2 && <2.2+  default-language: GHC2021++executable uku+  main-is: Main.hs+  other-modules:+      Paths_uku+  hs-source-dirs:+      app+  default-extensions:+      NoImplicitPrelude+      OverloadedStrings+      MultiWayIf+  ghc-options: -threaded -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wno-orphans -Wredundant-constraints -Wunused-packages+  build-depends:+      base >=4.18.2 && <4.20+    , protolude >=0.3.4 && <0.4+    , text >=2.0.2 && <2.2+    , uku+  default-language: GHC2021