{- |
Taken from Haskore.
-}

module Sound.MIDI.String where

import Control.Monad.Trans.State (State, runState)

unlinesS :: [ShowS] -> ShowS
unlinesS :: [ShowS] -> ShowS
unlinesS = [ShowS] -> ShowS
concatS ([ShowS] -> ShowS) -> ([ShowS] -> [ShowS]) -> [ShowS] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS -> ShowS) -> [ShowS] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\n")

concatS :: [ShowS] -> ShowS
concatS :: [ShowS] -> ShowS
concatS = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id

rightS, leftS, centreS :: Int -> ShowS -> ShowS
rightS :: Int -> ShowS -> ShowS
rightS  Int
n ShowS
s = String -> ShowS
showString (Int -> ShowS
right  Int
n (ShowS
s String
""))
leftS :: Int -> ShowS -> ShowS
leftS   Int
n ShowS
s = String -> ShowS
showString (Int -> ShowS
left   Int
n (ShowS
s String
""))
centreS :: Int -> ShowS -> ShowS
centreS Int
n ShowS
s = String -> ShowS
showString (Int -> ShowS
centre Int
n (ShowS
s String
""))

right,left, centre :: Int -> String -> String
right :: Int -> ShowS
right  Int
n String
s = Int -> String
spaces (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
left :: Int -> ShowS
left   Int
n String
s = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
spaces (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s)
centre :: Int -> ShowS
centre Int
n String
s = Int -> String
spaces Int
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
spaces (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l)
  where
    n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
    l :: Int
l  = Int
n' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

spaces :: Int -> String
spaces :: Int -> String
spaces Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n) Char
' '

stateToReadS :: State String a -> ReadS a
stateToReadS :: State String a -> ReadS a
stateToReadS State String a
state String
string =
   [State String a -> String -> (a, String)
forall s a. State s a -> s -> (a, s)
runState State String a
state String
string]