{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Dashi.Util where

import Clay (Refinement)
import Clay.Selector (Refinement (Refinement))
import Dashi.Prelude
import Data.Char (isUpper, toLower, toUpper)
import Data.Text (Text)
import Data.Text qualified as Text
import GHC.Float (FFFormat (..), formatRealFloat)
import Miso.String qualified as MisoString
import Numeric (fromRat)

fromText :: (IsString s) => Text -> s
fromText :: forall s. IsString s => MisoString -> s
fromText = String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> (MisoString -> String) -> MisoString -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> String
Text.unpack

formatFloat :: (RealFloat a, IsString s) => a -> s
formatFloat :: forall a s. (RealFloat a, IsString s) => a -> s
formatFloat a
v
    | a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = s
"0"
    | a -> a
forall a. Num a => a -> a
abs a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1e-5 Bool -> Bool -> Bool
|| a -> a
forall a. Num a => a -> a
abs a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1e10 =
        String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> String -> s
forall a b. (a -> b) -> a -> b
$ FFFormat -> Maybe Int -> a -> String
forall a. RealFloat a => FFFormat -> Maybe Int -> a -> String
formatRealFloat FFFormat
FFExponent Maybe Int
forall a. Maybe a
Nothing a
v
    | a
v a -> a -> a
forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int (a -> Int
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor a
v) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 =
        String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> String -> s
forall a b. (a -> b) -> a -> b
$ FFFormat -> Maybe Int -> a -> String
forall a. RealFloat a => FFFormat -> Maybe Int -> a -> String
formatRealFloat FFFormat
FFFixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) a
v
    | Bool
otherwise = String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> String -> s
forall a b. (a -> b) -> a -> b
$ FFFormat -> Maybe Int -> a -> String
forall a. RealFloat a => FFFormat -> Maybe Int -> a -> String
formatRealFloat FFFormat
FFGeneric Maybe Int
forall a. Maybe a
Nothing a
v

instance (HasResolution k) => ToMisoString (Fixed k) where
    toMisoString :: Fixed k -> MisoString
toMisoString = forall a s. (RealFloat a, IsString s) => a -> s
formatFloat @Double (Double -> MisoString)
-> (Fixed k -> Double) -> Fixed k -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Fixed k -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance ToMisoString Rational where
    toMisoString :: Rational -> MisoString
toMisoString = forall a s. (RealFloat a, IsString s) => a -> s
formatFloat @Double (Double -> MisoString)
-> (Rational -> Double) -> Rational -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> Double
forall a. RealFloat a => Rational -> a
fromRat

#ifndef VANILLA
instance Cons MisoString MisoString Char Char where
    _Cons = prism' (uncurry MisoString.cons) MisoString.uncons
#endif

capitalise :: (Cons s s Char Char) => s -> s
capitalise :: forall s. Cons s s Char Char => s -> s
capitalise = (Char -> Identity Char) -> s -> Identity s
forall s a. Cons s s a a => Traversal' s a
Traversal' s Char
_head ((Char -> Identity Char) -> s -> Identity s)
-> (Char -> Char) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Char -> Char
toUpper

uncapitalise :: (Cons s s Char Char) => s -> s
uncapitalise :: forall s. Cons s s Char Char => s -> s
uncapitalise = (Char -> Identity Char) -> s -> Identity s
forall s a. Cons s s a a => Traversal' s a
Traversal' s Char
_head ((Char -> Identity Char) -> s -> Identity s)
-> (Char -> Char) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Char -> Char
toLower

misoStringIso :: (FromMisoString a, ToMisoString a) => Iso' MisoString a
misoStringIso :: forall a. (FromMisoString a, ToMisoString a) => Iso' MisoString a
misoStringIso = (MisoString -> a)
-> (a -> MisoString) -> Iso MisoString MisoString a a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso MisoString -> a
forall a. FromMisoString a => MisoString -> a
fromMisoString a -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString

pascalWords :: Iso' MisoString [MisoString]
pascalWords :: Iso' MisoString [MisoString]
pascalWords = (MisoString -> [MisoString])
-> ([MisoString] -> MisoString) -> Iso' MisoString [MisoString]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((Char -> Bool) -> MisoString -> [MisoString]
breakAll Char -> Bool
isUpper) ([MisoString] -> MisoString
forall a. Monoid a => [a] -> a
mconcat ([MisoString] -> MisoString)
-> ([MisoString] -> [MisoString]) -> [MisoString] -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (MisoString -> MisoString) -> [MisoString] -> [MisoString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MisoString -> MisoString
forall s. Cons s s Char Char => s -> s
capitalise)

breakAll :: (Char -> Bool) -> MisoString -> [MisoString]
breakAll :: (Char -> Bool) -> MisoString -> [MisoString]
breakAll Char -> Bool
f MisoString
t
    | Just (Char
c, MisoString
cs) <- MisoString -> Maybe (Char, MisoString)
MisoString.uncons MisoString
r =
        [MisoString]
ls [MisoString] -> [MisoString] -> [MisoString]
forall a. Semigroup a => a -> a -> a
<> case (Char -> Bool) -> MisoString -> [MisoString]
breakAll Char -> Bool
f MisoString
cs of
            MisoString
x : [MisoString]
xs -> Char -> MisoString -> MisoString
MisoString.cons Char
c MisoString
x MisoString -> [MisoString] -> [MisoString]
forall a. a -> [a] -> [a]
: [MisoString]
xs
            [] -> [Char -> MisoString
MisoString.singleton Char
c]
    | Bool
otherwise = [MisoString]
ls
  where
    (MisoString
l, MisoString
r) = (Char -> Bool) -> MisoString -> (MisoString, MisoString)
MisoString.break Char -> Bool
f MisoString
t
    ls :: [MisoString]
ls = [MisoString
l | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ MisoString -> Bool
MisoString.null MisoString
l]

unpascal :: MisoString -> MisoString
unpascal :: MisoString -> MisoString
unpascal = [MisoString] -> MisoString
MisoString.unwords ([MisoString] -> MisoString)
-> (MisoString -> [MisoString]) -> MisoString -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (MisoString -> MisoString) -> [MisoString] -> [MisoString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MisoString -> MisoString
forall s. Cons s s Char Char => s -> s
uncapitalise ([MisoString] -> [MisoString])
-> (MisoString -> [MisoString]) -> MisoString -> [MisoString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Getting [MisoString] MisoString [MisoString]
-> MisoString -> [MisoString]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [MisoString] MisoString [MisoString]
Iso' MisoString [MisoString]
pascalWords

emptyView_ :: View model action
emptyView_ :: forall model action. View model action
emptyView_ = Maybe Key -> MisoString -> View model action
forall model action. Maybe Key -> MisoString -> View model action
VText Maybe Key
forall a. Maybe a
Nothing MisoString
forall a. Monoid a => a
mempty

emptyAttr_ :: Attribute action
emptyAttr_ :: forall action. Attribute action
emptyAttr_ = Map MisoString MisoString -> Attribute action
forall action. Map MisoString MisoString -> Attribute action
Styles Map MisoString MisoString
forall a. Monoid a => a
mempty

emptyRefinement :: Refinement
emptyRefinement :: Refinement
emptyRefinement = [Predicate] -> Refinement
Refinement [Predicate]
forall a. Monoid a => a
mempty

cyclePred :: (Eq a, Enum a, Bounded a) => a -> a
cyclePred :: forall a. (Eq a, Enum a, Bounded a) => a -> a
cyclePred a
x = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
minBound then a
forall a. Bounded a => a
maxBound else a -> a
forall a. Enum a => a -> a
pred a
x

cycleSucc :: (Eq a, Enum a, Bounded a) => a -> a
cycleSucc :: forall a. (Eq a, Enum a, Bounded a) => a -> a
cycleSucc a
x = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
maxBound then a
forall a. Bounded a => a
minBound else a -> a
forall a. Enum a => a -> a
succ a
x