{-|
Module      : Instana.SDK.Internal.Util
Description : Utilities
-}
module Instana.SDK.Internal.Util
  ( (|>)
  , leftPad
  , leftPadAndLimit
  , limit
  ) where


import qualified Data.Text as T


-- |Elm-style function application.
(|>) :: a -> (a -> b) -> b
|> :: a -> (a -> b) -> b
(|>) =
  ((a -> b) -> a -> b) -> a -> (a -> b) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)


-- |Prepends the character "0" to this string until it has the given length.
-- Otherwise the input is returned unmodified.
leftPad :: Int -> String -> String
leftPad :: Int -> String -> String
leftPad digits :: Int
digits s :: String
s
  | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
digits = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
digits Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) '0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
  | Bool
otherwise         = String
s


-- |If the given string is shorten than the requested length, the character "0"
-- is prepended to this string. If the given string is longer than the requested
-- length, the leading characters will be discarded to limit it to the requested
-- length. Otherwise the input is returned unmodified.
leftPadAndLimit :: Int -> String -> String
leftPadAndLimit :: Int -> String -> String
leftPadAndLimit digits :: Int
digits s :: String
s =
  Int -> String -> String
leftPad Int
digits String
s
  String -> (String -> String) -> String
forall a b. a -> (a -> b) -> b
|> Int -> String -> String
limit Int
digits


-- |If the given string is longer than the requested length, the leading
-- characters will be discarded to limit it to the requested length. Otherwise
-- the input is returned unmodified.
limit :: Int -> String -> String
limit :: Int -> String -> String
limit digits :: Int
digits s :: String
s
  | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
digits = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.takeEnd Int
digits (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
  | Bool
otherwise         = String
s