{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
#endif

{-|

static-text combinators are defined for members of 'IsStaticText'
class. The package includes 'IsStaticText' instances for several
common types.

This module is meant to be imported qualifed, e.g.

> import qualified Data.StaticText as S

-}

module Data.StaticText
       (
         -- * Constructing static texts
         --
         -- | See also 'C.unsafeCreate'
         create
       , createLeft
       , createRight
       , st
       , replicate

         -- * Working with static texts
       , append
       , take
       , drop
       , map
       , padLeft
       , padRight

       , length

         -- * IsStaticText class
       , Static
       , IsStaticText(Elem, unsafeCreate, unwrap)
       )

where

import           Prelude as P hiding (drop, length, map, replicate, take)

import           GHC.TypeLits

import           Data.Proxy
import           Data.StaticText.Class (Elem, Static, IsStaticText)
import qualified Data.StaticText.Class as C
import           Data.StaticText.TH


-- $setup
-- >>> :set -XDataKinds
-- >>> :set -XTemplateHaskell
-- >>> :set -XOverloadedStrings
-- >>> import Data.Char (toUpper)
-- >>> import Data.StaticText
-- >>> import Prelude as P hiding (drop, length, map, replicate, take)


-- | Safely create a Static, possibly altering the source to match
-- target length. If target length is less than that of the source,
-- the source gets truncated. If target length is greater, the source
-- is padded using the provided basic element. Elements on the left
-- are preferred.
--
-- >>> createLeft ' ' "foobarbaz" :: Static String 6
-- "foobar"
-- >>> createLeft '#' "foobarbaz" :: Static String 12
-- "foobarbaz###"
createLeft :: forall a i.
              (IsStaticText a, KnownNat i) =>
              Elem a -> a -> Static a i
createLeft :: Elem a -> a -> Static a i
createLeft Elem a
e a
s =
  a -> Static a i
forall a (i :: Nat). IsStaticText a => a -> Static a i
C.unsafeCreate (a -> Static a i) -> a -> Static a i
forall a b. (a -> b) -> a -> b
$
  Int -> a -> a
forall a. IsStaticText a => Int -> a -> a
C.take Int
t (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$
  a -> a -> a
forall a. IsStaticText a => a -> a -> a
C.append a
s (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$
  Int -> Elem a -> a
forall a. IsStaticText a => Int -> Elem a -> a
C.replicate (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. IsStaticText a => a -> Int
C.length a
s) Elem a
e
  where
    t :: Int
t = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy i -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy i
forall k (t :: k). Proxy t
Proxy :: Proxy i)


-- | Just like 'createLeft', except that elements on the right are preferred.
--
-- >>> createRight '@' "foobarbaz" :: Static String 6
-- "barbaz"
-- >>> createRight '!' "foobarbaz" :: Static String 12
-- "!!!foobarbaz"
createRight :: forall a i.
               (IsStaticText a, KnownNat i) =>
               Elem a -> a -> Static a i
createRight :: Elem a -> a -> Static a i
createRight Elem a
e a
s =
  a -> Static a i
forall a (i :: Nat). IsStaticText a => a -> Static a i
C.unsafeCreate (a -> Static a i) -> a -> Static a i
forall a b. (a -> b) -> a -> b
$
  Int -> a -> a
forall a. IsStaticText a => Int -> a -> a
C.drop (a -> Int
forall a. IsStaticText a => a -> Int
C.length a
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
t) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$
  a -> a -> a
forall a. IsStaticText a => a -> a -> a
C.append (Int -> Elem a -> a
forall a. IsStaticText a => Int -> Elem a -> a
C.replicate (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. IsStaticText a => a -> Int
C.length a
s) Elem a
e) a
s
  where
    t :: Int
t = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy i -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy i
forall k (t :: k). Proxy t
Proxy :: Proxy i)


-- | Safely create a Static if it matches target length.
--
-- >>> create "foobar" :: Maybe (Static String 6)
-- Just "foobar"
-- >>> create "barbaz" :: Maybe (Static String 8)
-- Nothing
--
-- This is safer than 'C.unsafeCreate' and unlike with 'createLeft' /
-- 'createRight' the source value is left unchanged. However, this
-- implies a further run-time check for Nothing values.
create :: forall a i.
          (IsStaticText a, KnownNat i) =>
          a -> P.Maybe (Static a i)
create :: a -> Maybe (Static a i)
create a
s =
  if a -> Int
forall a. IsStaticText a => a -> Int
C.length a
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
t
  then Static a i -> Maybe (Static a i)
forall a. a -> Maybe a
Just (Static a i -> Maybe (Static a i))
-> Static a i -> Maybe (Static a i)
forall a b. (a -> b) -> a -> b
$ a -> Static a i
forall a (i :: Nat). IsStaticText a => a -> Static a i
C.unsafeCreate a
s
  else Maybe (Static a i)
forall a. Maybe a
Nothing
  where
    t :: Int
t = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy i -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy i
forall k (t :: k). Proxy t
Proxy :: Proxy i)


-- | Append two Statics together.
--
-- >>> append $(st "foo") $(st "bar") :: Static String 6
-- "foobar"
append :: forall a m n.
          (IsStaticText a) => Static a m -> Static a n -> Static a (m + n)
append :: Static a m -> Static a n -> Static a (m + n)
append Static a m
a Static a n
b = a -> Static a (m + n)
forall a (i :: Nat). IsStaticText a => a -> Static a i
C.unsafeCreate (a -> Static a (m + n)) -> a -> Static a (m + n)
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. IsStaticText a => a -> a -> a
C.append (Static a m -> a
forall a (i :: Nat). IsStaticText a => Static a i -> a
C.unwrap Static a m
a) (Static a n -> a
forall a (i :: Nat). IsStaticText a => Static a i -> a
C.unwrap Static a n
b)


-- | Construct a new Static from a basic element.
--
-- >>> replicate '=' :: Static String 10
-- "=========="
replicate :: forall a i.
             (IsStaticText a, KnownNat i) => Elem a -> Static a i
replicate :: Elem a -> Static a i
replicate Elem a
e =
  a -> Static a i
forall a (i :: Nat). IsStaticText a => a -> Static a i
C.unsafeCreate (a -> Static a i) -> a -> Static a i
forall a b. (a -> b) -> a -> b
$ Int -> Elem a -> a
forall a. IsStaticText a => Int -> Elem a -> a
C.replicate Int
t Elem a
e
  where
    t :: Int
t = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy i -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy i
forall k (t :: k). Proxy t
Proxy :: Proxy i)


-- | Map a Static to a Static of the same length.
--
-- >>> map toUpper $(st "Hello") :: Static String 5
-- "HELLO"
map :: IsStaticText a =>
       (Elem a -> Elem a) -> Static a m -> Static a m
map :: (Elem a -> Elem a) -> Static a m -> Static a m
map Elem a -> Elem a
f Static a m
s =
  a -> Static a m
forall a (i :: Nat). IsStaticText a => a -> Static a i
C.unsafeCreate (a -> Static a m) -> a -> Static a m
forall a b. (a -> b) -> a -> b
$ (Elem a -> Elem a) -> a -> a
forall a. IsStaticText a => (Elem a -> Elem a) -> a -> a
C.map Elem a -> Elem a
f (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Static a m -> a
forall a (i :: Nat). IsStaticText a => Static a i -> a
C.unwrap Static a m
s


-- | Reduce Static length, preferring elements on the left.
--
-- >>> take $(st "Foobar") :: Static String 3
-- "Foo"
take :: forall a m n.
        (IsStaticText a, KnownNat m, KnownNat n, n <= m) =>
        Static a m -> Static a n
take :: Static a m -> Static a n
take Static a m
s =
  a -> Static a n
forall a (i :: Nat). IsStaticText a => a -> Static a i
C.unsafeCreate (a -> Static a n) -> a -> Static a n
forall a b. (a -> b) -> a -> b
$ Int -> a -> a
forall a. IsStaticText a => Int -> a -> a
C.take Int
t (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Static a m -> a
forall a (i :: Nat). IsStaticText a => Static a i -> a
C.unwrap Static a m
s
  where
    t :: Int
t = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)


-- | Reduce Static length, preferring elements on the right.
--
-- >>> drop $(st "Foobar") :: Static String 2
-- "ar"
drop :: forall a m n.
        (IsStaticText a, KnownNat m, KnownNat n, n <= m) =>
        Static a m -> Static a n
drop :: Static a m -> Static a n
drop Static a m
s =
  a -> Static a n
forall a (i :: Nat). IsStaticText a => a -> Static a i
C.unsafeCreate (a -> Static a n) -> a -> Static a n
forall a b. (a -> b) -> a -> b
$ Int -> a -> a
forall a. IsStaticText a => Int -> a -> a
C.drop (a -> Int
forall a. IsStaticText a => a -> Int
C.length a
s' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
t) a
s'
  where
    s' :: a
s' = Static a m -> a
forall a (i :: Nat). IsStaticText a => Static a i -> a
C.unwrap Static a m
s
    t :: Int
t = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)


-- | Obtain value-level length.
length :: forall a m.
          KnownNat m => Static a m -> P.Int
length :: Static a m -> Int
length Static a m
_ = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
P.$ Proxy m -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy m
forall k (t :: k). Proxy t
Proxy :: Proxy m)


-- | Fill a Static with extra elements up to target length, padding
-- original elements to the left.
padLeft :: forall a m n.
           (IsStaticText a, KnownNat m, KnownNat (n - m),
            n ~ (n - m + m), m <= n) =>
           Elem a -> Static a m -> Static a n
padLeft :: Elem a -> Static a m -> Static a n
padLeft Elem a
pad = Static a (n - m) -> Static a m -> Static a ((n - m) + m)
forall a (m :: Nat) (n :: Nat).
IsStaticText a =>
Static a m -> Static a n -> Static a (m + n)
append (Elem a -> Static a (n - m)
forall a (i :: Nat).
(IsStaticText a, KnownNat i) =>
Elem a -> Static a i
replicate Elem a
pad)


-- | Like 'padLeft', but original elements are padded to the right.
padRight :: forall a m n.
           (IsStaticText a, KnownNat m, KnownNat (n - m),
            n ~ (m + (n - m)), m <= n) =>
           Elem a -> Static a m -> Static a n
padRight :: Elem a -> Static a m -> Static a n
padRight Elem a
pad = (Static a m -> Static a (n - m) -> Static a n)
-> Static a (n - m) -> Static a m -> Static a n
forall a b c. (a -> b -> c) -> b -> a -> c
P.flip Static a m -> Static a (n - m) -> Static a n
forall a (m :: Nat) (n :: Nat).
IsStaticText a =>
Static a m -> Static a n -> Static a (m + n)
append (Elem a -> Static a (n - m)
forall a (i :: Nat).
(IsStaticText a, KnownNat i) =>
Elem a -> Static a i
replicate Elem a
pad)