-- Copyright 2018 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | General utilities for sampler patches.
module Synth.Sampler.Patch.Lib.Util where
import qualified Control.Monad.Except as Except
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Text as Text

import qualified GHC.Stack as Stack

import qualified Util.Maps as Maps
import qualified Util.Num as Num
import qualified Util.Lists as Lists

import qualified Cmd.Instrument.CUtil as CUtil
import qualified Cmd.Instrument.ImInst as ImInst
import qualified Derive.Attrs as Attrs
import qualified Instrument.Common as Common
import qualified Perform.Pitch as Pitch
import qualified Perform.RealTime as RealTime
import qualified Synth.Sampler.Patch as Patch
import qualified Synth.Sampler.Sample as Sample
import qualified Synth.Shared.Control as Control
import qualified Synth.Shared.Note as Note
import qualified Synth.Shared.Thru as Thru
import qualified Synth.Shared.Signal as Signal

import           Global


data SampleFormat = Wav | Flac deriving (SampleFormat -> SampleFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SampleFormat -> SampleFormat -> Bool
$c/= :: SampleFormat -> SampleFormat -> Bool
== :: SampleFormat -> SampleFormat -> Bool
$c== :: SampleFormat -> SampleFormat -> Bool
Eq, Int -> SampleFormat -> ShowS
[SampleFormat] -> ShowS
SampleFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SampleFormat] -> ShowS
$cshowList :: [SampleFormat] -> ShowS
show :: SampleFormat -> String
$cshow :: SampleFormat -> String
showsPrec :: Int -> SampleFormat -> ShowS
$cshowsPrec :: Int -> SampleFormat -> ShowS
Show)

extension :: SampleFormat -> String
extension :: SampleFormat -> String
extension = \case
    SampleFormat
Wav -> String
".wav"
    SampleFormat
Flac -> String
".flac"

-- * preprocess

nextsBy :: Eq key => (a -> key) -> [a] -> [(a, [a])]
nextsBy :: forall key a. Eq key => (a -> key) -> [a] -> [(a, [a])]
nextsBy a -> key
key [a]
xs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> [a] -> (a, [a])
extract [a]
xs (forall a. Int -> [a] -> [a]
drop Int
1 (forall a. [a] -> [[a]]
List.tails [a]
xs))
    where extract :: a -> [a] -> (a, [a])
extract a
x [a]
xs = (a
x, forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== a -> key
key a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> key
key) [a]
xs)

nexts :: [a] -> [(a, [a])]
nexts :: forall a. [a] -> [(a, [a])]
nexts [a]
xs = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs (forall a. Int -> [a] -> [a]
drop Int
1 (forall a. [a] -> [[a]]
List.tails [a]
xs))


-- * convert

-- ** pitch

symbolicPitch :: Except.MonadError Text m => Note.Note
    -> m (Either Pitch.Note Pitch.NoteNumber)
symbolicPitch :: forall (m :: * -> *).
MonadError Error m =>
Note -> m (Either Note NoteNumber)
symbolicPitch Note
note
    | Error -> Bool
Text.null (Note -> Error
Note.element Note
note) = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadError Error m => Note -> m NoteNumber
initialPitch Note
note
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Error -> Note
Pitch.Note forall a b. (a -> b) -> a -> b
$ Note -> Error
Note.element Note
note

initialPitch :: Except.MonadError Text m => Note.Note -> m Pitch.NoteNumber
initialPitch :: forall (m :: * -> *). MonadError Error m => Note -> m NoteNumber
initialPitch = forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
tryJust Error
"no pitch" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Maybe NoteNumber
Note.initialPitch

-- | Find a value (presumably a FileName) and pitch ratio for a simple patch
-- with a static NoteNumber mapping.
findPitchRatio :: Map Pitch.NoteNumber a -> Pitch.NoteNumber -> (a, Signal.Y)
findPitchRatio :: forall a. Map NoteNumber a -> NoteNumber -> (a, Y)
findPitchRatio Map NoteNumber a
nnToSample NoteNumber
nn = (a
fname, NoteNumber -> NoteNumber -> Y
Sample.pitchToRatio NoteNumber
sampleNn NoteNumber
nn)
    where
    (NoteNumber
sampleNn, a
fname) = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"findPitch: empty nnToSample") forall a b. (a -> b) -> a -> b
$
        forall k v. (Ord k, Num k) => k -> Map k v -> Maybe (k, v)
Maps.lookupClosest NoteNumber
nn Map NoteNumber a
nnToSample

-- ** articulation

articulation :: Except.MonadError Text m => Common.AttributeMap a
    -> Attrs.Attributes -> m a
articulation :: forall (m :: * -> *) a.
MonadError Error m =>
AttributeMap a -> Attributes -> m a
articulation AttributeMap a
attributeMap Attributes
attrs =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
Except.throwError forall a b. (a -> b) -> a -> b
$ Error
"attributes not found: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Error
pretty Attributes
attrs)
        (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
    forall a. Attributes -> AttributeMap a -> Maybe (Attributes, a)
Common.lookup_attributes Attributes
attrs AttributeMap a
attributeMap

articulationDefault :: a -> Common.AttributeMap a -> Attrs.Attributes -> a
articulationDefault :: forall a. a -> AttributeMap a -> Attributes -> a
articulationDefault a
deflt AttributeMap a
attributeMap  =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
deflt forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Attributes -> AttributeMap a -> Maybe (Attributes, a)
`Common.lookup_attributes` AttributeMap a
attributeMap)

-- ** dynamic

-- | Standard dynamic ranges.
data Dynamic = PP | MP | MF | FF
    deriving (Dynamic -> Dynamic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dynamic -> Dynamic -> Bool
$c/= :: Dynamic -> Dynamic -> Bool
== :: Dynamic -> Dynamic -> Bool
$c== :: Dynamic -> Dynamic -> Bool
Eq, Eq Dynamic
Dynamic -> Dynamic -> Bool
Dynamic -> Dynamic -> Ordering
Dynamic -> Dynamic -> Dynamic
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dynamic -> Dynamic -> Dynamic
$cmin :: Dynamic -> Dynamic -> Dynamic
max :: Dynamic -> Dynamic -> Dynamic
$cmax :: Dynamic -> Dynamic -> Dynamic
>= :: Dynamic -> Dynamic -> Bool
$c>= :: Dynamic -> Dynamic -> Bool
> :: Dynamic -> Dynamic -> Bool
$c> :: Dynamic -> Dynamic -> Bool
<= :: Dynamic -> Dynamic -> Bool
$c<= :: Dynamic -> Dynamic -> Bool
< :: Dynamic -> Dynamic -> Bool
$c< :: Dynamic -> Dynamic -> Bool
compare :: Dynamic -> Dynamic -> Ordering
$ccompare :: Dynamic -> Dynamic -> Ordering
Ord, Int -> Dynamic -> ShowS
[Dynamic] -> ShowS
Dynamic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dynamic] -> ShowS
$cshowList :: [Dynamic] -> ShowS
show :: Dynamic -> String
$cshow :: Dynamic -> String
showsPrec :: Int -> Dynamic -> ShowS
$cshowsPrec :: Int -> Dynamic -> ShowS
Show, ReadPrec [Dynamic]
ReadPrec Dynamic
Int -> ReadS Dynamic
ReadS [Dynamic]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Dynamic]
$creadListPrec :: ReadPrec [Dynamic]
readPrec :: ReadPrec Dynamic
$creadPrec :: ReadPrec Dynamic
readList :: ReadS [Dynamic]
$creadList :: ReadS [Dynamic]
readsPrec :: Int -> ReadS Dynamic
$creadsPrec :: Int -> ReadS Dynamic
Read, Dynamic
forall a. a -> a -> Bounded a
maxBound :: Dynamic
$cmaxBound :: Dynamic
minBound :: Dynamic
$cminBound :: Dynamic
Bounded, Int -> Dynamic
Dynamic -> Int
Dynamic -> [Dynamic]
Dynamic -> Dynamic
Dynamic -> Dynamic -> [Dynamic]
Dynamic -> Dynamic -> Dynamic -> [Dynamic]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Dynamic -> Dynamic -> Dynamic -> [Dynamic]
$cenumFromThenTo :: Dynamic -> Dynamic -> Dynamic -> [Dynamic]
enumFromTo :: Dynamic -> Dynamic -> [Dynamic]
$cenumFromTo :: Dynamic -> Dynamic -> [Dynamic]
enumFromThen :: Dynamic -> Dynamic -> [Dynamic]
$cenumFromThen :: Dynamic -> Dynamic -> [Dynamic]
enumFrom :: Dynamic -> [Dynamic]
$cenumFrom :: Dynamic -> [Dynamic]
fromEnum :: Dynamic -> Int
$cfromEnum :: Dynamic -> Int
toEnum :: Int -> Dynamic
$ctoEnum :: Int -> Dynamic
pred :: Dynamic -> Dynamic
$cpred :: Dynamic -> Dynamic
succ :: Dynamic -> Dynamic
$csucc :: Dynamic -> Dynamic
Enum)
instance Pretty Dynamic where pretty :: Dynamic -> Error
pretty = forall a. Show a => a -> Error
showt

-- | Get patch-specific dyn category, and note dynamic.
dynamic :: (Bounded dyn, Enum dyn) => (dyn -> (Int, Int))
    -- ^ Returns velocity instead of dyn, and the lower bound is unnecessary,
    -- for compatibility.
    -> Signal.Y
    -- ^ Min dyn.  This is for normalized samples, where 0 gets this dyn.
    -> Note.Note -> (dyn, Signal.Y)
dynamic :: forall dyn.
(Bounded dyn, Enum dyn) =>
(dyn -> (Int, Int)) -> Y -> Note -> (dyn, Y)
dynamic dyn -> (Int, Int)
dynToRange Y
minDyn Note
note =
    ( forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall dyn. (Bounded dyn, Enum dyn) => (dyn -> Y) -> Y -> (dyn, Y)
findDynamic (Int -> Y
velToDyn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. dyn -> (Int, Int)
dynToRange) Y
dyn
    , forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale Y
minDyn Y
1 Y
dyn
    )
    where dyn :: Y
dyn = Control -> Note -> Y
Note.initial0 Control
Control.dynamic Note
note

-- | Convert to (Dynamic, DistanceFromPrevDynamic)
findDynamic :: (Bounded dyn, Enum dyn) => (dyn -> Signal.Y)
    -> Signal.Y -> (dyn, Signal.Y)
findDynamic :: forall dyn. (Bounded dyn, Enum dyn) => (dyn -> Y) -> Y -> (dyn, Y)
findDynamic dyn -> Y
dynToRange Y
dyn = forall {t} {a}.
(Ord t, Fractional t) =>
t -> t -> [(t, a)] -> (a, t)
find Y
0 Y
dyn [(Y, dyn)]
rangeDynamics
    where
    find :: t -> t -> [(t, a)] -> (a, t)
find t
low t
val ((t
high, a
dyn) : [(t, a)]
rest)
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(t, a)]
rest Bool -> Bool -> Bool
|| t
val forall a. Ord a => a -> a -> Bool
< t
high = (a
dyn, forall a. (Eq a, Fractional a) => a -> a -> a -> a
Num.normalize t
low t
high t
val)
        | Bool
otherwise = t -> t -> [(t, a)] -> (a, t)
find t
high t
val [(t, a)]
rest
    find t
_ t
_ [] = forall a. HasCallStack => String -> a
error String
"empty rangeDynamics"
    rangeDynamics :: [(Y, dyn)]
rangeDynamics = forall a k. (a -> k) -> [a] -> [(k, a)]
Lists.keyOn dyn -> Y
dynToRange forall a. (Enum a, Bounded a) => [a]
enumAll

type Variation = Int

variation :: Variation -> Note.Note -> Variation
variation :: Int -> Note -> Int
variation Int
variations = forall {a} {b}. (RealFrac a, Integral b) => a -> b
pick forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Note -> Y
Note.initial0 Control
Control.variation
    where pick :: a -> b
pick a
var = forall a b. (RealFrac a, Integral b) => a -> b
round (a
var forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
variations forall a. Num a => a -> a -> a
- Int
1))

chooseVariation :: [a] -> Note.Note -> a
chooseVariation :: forall a. [a] -> Note -> a
chooseVariation [a]
as = forall a. [a] -> Y -> a
pickVariation [a]
as forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Note -> Y
Note.initial0 Control
Control.variation

pickVariation :: [a] -> Double -> a
pickVariation :: forall a. [a] -> Y -> a
pickVariation [a]
as Y
var =
    [a]
as forall a. [a] -> Int -> a
!! forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Ord a => a -> a -> a -> a
Num.clamp Y
0 Y
1 Y
var forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as forall a. Num a => a -> a -> a
- Int
1))

-- | Pick from a list of dynamic variations.
pickDynamicVariation :: Double -> [a] -> Double -> Double -> a
pickDynamicVariation :: forall a. Y -> [a] -> Y -> Y -> a
pickDynamicVariation Y
variationRange [a]
samples Y
dyn Y
var =
    forall a. [a] -> Y -> a
pickVariation [a]
samples (forall a. Ord a => a -> a -> a -> a
Num.clamp Y
0 Y
1 (Y
dyn forall a. Num a => a -> a -> a
+ Y
var forall a. Num a => a -> a -> a
* Y
variationRange))

-- | Scale dynamic for non-normalized samples, recorded with few dynamic
-- levels.  Since each sample already has its own dynamic level, if I do no
-- scaling, then there will be noticeable bumps as the dynamic thresholds
-- are crossed.  So I scale the dynamics of each one by an adjustment to smooth
-- the bumps.  But the result will be more bumpy if each sample covers a
-- different width of dynamic range, so I also scale the adjustment by
-- that width.
--
-- TODO I think it doesn't actually work though, I need to adjust manually
-- per-sample.
dynamicAutoScale :: (Signal.Y, Signal.Y) -> (Signal.Y, Signal.Y) -> Signal.Y
    -> Signal.Y
dynamicAutoScale :: (Y, Y) -> (Y, Y) -> Y -> Y
dynamicAutoScale (Y
minDyn, Y
maxDyn) (Y
low, Y
high) Y
dyn =
    forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale Y
minDyn Y
maxDyn Y
biased
    where
    -- dyn should be in the (low, high) range already.
    pos :: Y
pos = forall a. (Eq a, Fractional a) => a -> a -> a -> a
Num.normalize Y
low Y
high Y
dyn
    -- bias the position toward the middle of the dyn range, depending on
    -- the dynamic width allocated to the sample.
    biased :: Y
biased = forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale Y
0.5 Y
pos (Y
high forall a. Num a => a -> a -> a
- Y
low)

dynToVel :: Signal.Y -> Int
dynToVel :: Y -> Int
dynToVel = forall a. Ord a => a -> a -> a -> a
Num.clamp Int
1 Int
127 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*Y
127)

velToDyn :: Int -> Signal.Y
velToDyn :: Int -> Y
velToDyn = (forall a. Fractional a => a -> a -> a
/Y
127) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- ** envelope

dynEnvelope :: Signal.Y -> RealTime.RealTime -> Note.Note -> Signal.Signal
dynEnvelope :: Y -> X -> Note -> Signal
dynEnvelope Y
minDyn X
releaseTime Note
note =
    Signal
env forall a. Semigroup a => a -> a -> a
<> forall {k} (kind :: k). [(X, Y)] -> Signal kind
Signal.from_pairs [(X
end, forall {k} (kind :: k). Signal kind -> X -> Y
Signal.at Signal
env X
end), (X
end forall a. Num a => a -> a -> a
+ X
releaseTime, Y
0)]
    where
    end :: X
end = Note -> X
Note.end Note
note
    env :: Signal
env = forall {k} (kind :: k). Y -> Signal kind -> Signal kind
Signal.scalar_scale Y
minDyn forall a b. (a -> b) -> a -> b
$
        forall {k} (kind :: k). X -> Signal kind -> Signal kind
Signal.drop_before (Note -> X
Note.start Note
note) forall a b. (a -> b) -> a -> b
$
        forall {k} (kind :: k). X -> Signal kind -> Signal kind
Signal.clip_after (Note -> X
Note.end Note
note) forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Monoid a => a
mempty Control
Control.dynamic forall a b. (a -> b) -> a -> b
$
        Note -> Map Control Signal
Note.controls Note
note

-- | Simple sustain-release envelope.
sustainRelease :: Signal.Y -> RealTime.RealTime -> Note.Note -> Signal.Signal
sustainRelease :: Y -> X -> Note -> Signal
sustainRelease Y
sustain X
releaseTime Note
note = forall {k} (kind :: k). [(X, Y)] -> Signal kind
Signal.from_pairs
    [ (Note -> X
Note.start Note
note, Y
sustain), (Note -> X
Note.end Note
note, Y
sustain)
    , (Note -> X
Note.end Note
note forall a. Num a => a -> a -> a
+ X
releaseTime, Y
0)
    ]

-- * thru

thru :: FilePath -> (Note.Note -> Patch.ConvertM Sample.Sample)
    -> ImInst.Code
thru :: String -> (Note -> ConvertM Sample) -> Code
thru String
sampleDir Note -> ConvertM Sample
convert = ThruFunction -> Code
ImInst.thru forall a b. (a -> b) -> a -> b
$ String -> (Note -> ConvertM Sample) -> ThruFunction
thruFunction String
sampleDir Note -> ConvertM Sample
convert

imThruFunction :: FilePath -> (Note.Note -> Patch.ConvertM Sample.Sample)
    -> CUtil.Thru
imThruFunction :: String -> (Note -> ConvertM Sample) -> Thru
imThruFunction String
dir = ThruFunction -> Thru
CUtil.ImThru forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Note -> ConvertM Sample) -> ThruFunction
thruFunction String
dir

thruFunction :: FilePath -> (Note.Note -> Patch.ConvertM Sample.Sample)
    -> Thru.ThruFunction
thruFunction :: String -> (Note -> ConvertM Sample) -> ThruFunction
thruFunction String
sampleDir Note -> ConvertM Sample
convert = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Play] -> Message
Thru.Plays forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Note -> Either Error Play
note
    where
    note :: Note -> Either Error Play
note (Thru.Note NoteNumber
pitch Y
velocity Attributes
attrs Int
offset) = do
        (Sample
sample, [Msg]
_logs) <- forall a. ConvertM a -> Either Error (a, [Msg])
Patch.runConvert forall a b. (a -> b) -> a -> b
$ Note -> ConvertM Sample
convert forall a b. (a -> b) -> a -> b
$ (Error -> Instrument -> X -> X -> Note
Note.note Error
"" Instrument
"" X
0 X
1)
            { attributes :: Attributes
Note.attributes = Attributes
attrs
            , controls :: Map Control Signal
Note.controls = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (Control
Control.pitch, forall {k} (kind :: k). Y -> Signal kind
Signal.constant (NoteNumber -> Y
Pitch.nn_to_double NoteNumber
pitch))
                , (Control
Control.dynamic, forall {k} (kind :: k). Y -> Signal kind
Signal.constant Y
velocity)
                , (Control
Control.sampleStartOffset,
                    forall {k} (kind :: k). Y -> Signal kind
Signal.constant (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset))
                ]
            }
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Sample -> Play
Sample.toThru String
sampleDir Sample
sample

-- * util

requireMap :: (Ord k, Show k) => Text -> Map k a -> k -> Patch.ConvertM a
requireMap :: forall k a. (Ord k, Show k) => Error -> Map k a -> k -> ConvertM a
requireMap Error
name Map k a
m k
k =
    forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
tryJust (Error
"no " forall a. Semigroup a => a -> a -> a
<> Error
name forall a. Semigroup a => a -> a -> a
<> Error
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Error
showt k
k) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k a
m

enumAll :: (Enum a, Bounded a) => [a]
enumAll :: forall a. (Enum a, Bounded a) => [a]
enumAll = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

findBelow :: Ord k => (a -> k) -> k -> [a] -> a
findBelow :: forall k a. Ord k => (a -> k) -> k -> [a] -> a
findBelow a -> k
_ k
_ [] = forall a. HasCallStack => String -> a
error String
"empty list"
findBelow a -> k
key k
val (a
x:[a]
xs) = a -> [a] -> a
go a
x [a]
xs
    where
    go :: a -> [a] -> a
go a
x0 (a
x:[a]
xs)
        | k
val forall a. Ord a => a -> a -> Bool
< a -> k
key a
x = a
x0
        | Bool
otherwise = a -> [a] -> a
go a
x [a]
xs
    go a
x0 [] = a
x0

showLower :: Show a => a -> String
showLower :: forall a. Show a => a -> String
showLower = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

showtLower :: Show a => a -> Text
showtLower :: forall a. Show a => a -> Error
showtLower = String -> Error
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
showLower

assertLength :: (Stack.HasCallStack, Foldable t) => Int -> t a -> t a
assertLength :: forall (t :: * -> *) a.
(HasCallStack, Foldable t) =>
Int -> t a -> t a
assertLength Int
len t a
xs
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
xs forall a. Eq a => a -> a -> Bool
== Int
len = t a
xs
    | Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"expected length " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
len forall a. Semigroup a => a -> a -> a
<> String
", but was "
        forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
xs)