{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phladiprelio.Partir
-- Copyright   :  (c) Oleksandr Zhabenko 2022-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- 

{-# LANGUAGE BangPatterns, FlexibleContexts, MultiParamTypeClasses, NoImplicitPrelude #-}

module Phladiprelio.Partir where

import GHC.Base
import GHC.Num
import GHC.Real
import GHC.Float
import qualified Data.Foldable as F
import Data.SubG
import Data.MinMax.Preconditions
import Phladiprelio.DataG
import Phladiprelio.Basis
import Data.Char (isDigit)
import Data.List (uncons, filter, null)
import Data.Maybe (fromJust, fromMaybe)
import Text.Read (readMaybe)

class F.Foldable t => ConstraintsG t a where
  decodeCDouble :: t a -> Double -> Bool

instance ConstraintsG [] Char where
  decodeCDouble :: [Char] -> Double -> Bool
decodeCDouble [Char]
xs !Double
y
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
xxs = Bool
True
    | Char
t forall a. Ord a => a -> a -> Bool
< Char
'2' = (if Char
t forall a. Eq a => a -> a -> Bool
== Char
'0' then forall a. Ord a => a -> a -> Bool
(>) else forall a. Ord a => a -> a -> Bool
(<)) Double
y (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Integer
1 forall a b. (a -> b) -> a -> b
$ (forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ts :: Maybe Integer))
    | Bool
otherwise = forall {a}.
(Ord a, Floating a) =>
Char -> [Char] -> Char -> a -> Bool
getScale Char
c [Char]
cs Char
t Double
y
       where xxs :: [Char]
xxs = forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit [Char]
xs
             (Char
t,[Char]
ts) = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (a, [a])
uncons forall a b. (a -> b) -> a -> b
$ [Char]
xxs
             (Char
c,[Char]
cs) = forall a. a -> Maybe a -> a
fromMaybe (Char
'0',[Char]
"1") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (a, [a])
uncons forall a b. (a -> b) -> a -> b
$ [Char]
ts
             getScale :: Char -> [Char] -> Char -> a -> Bool
getScale Char
c0 [Char]
ws Char
t0 a
y0  
               | Char
c0 forall a. Eq a => a -> a -> Bool
== Char
'1' = (forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (forall a. Floating a => a -> a -> a
logBase a
10 a
y0) a
base
               | Char
c0 forall a. Eq a => a -> a -> Bool
== Char
'2' = (forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (a
637.0 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
atan a
y0) a
base -- atan Infinity * 637.0 \approx 1000.0
               | Char
c0 forall a. Eq a => a -> a -> Bool
== Char
'3' = (forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (forall a. Floating a => a -> a
sin (a
k forall a. Num a => a -> a -> a
* a
y0)) (a
0.01 forall a. Num a => a -> a -> a
* a
base1)
               | Char
c0 forall a. Eq a => a -> a -> Bool
== Char
'4' = (forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (forall a. Floating a => a -> a
cos (a
k forall a. Num a => a -> a -> a
* a
y0)) (a
0.01 forall a. Num a => a -> a -> a
* a
base1)
               | Char
c0 forall a. Eq a => a -> a -> Bool
== Char
'5' = (forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (forall a. Floating a => a -> a
sin (a
k forall a. Num a => a -> a -> a
* a
y0)) (a
0.001 forall a. Num a => a -> a -> a
* a
base2)
               | Char
c0 forall a. Eq a => a -> a -> Bool
== Char
'6' = (forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (forall a. Floating a => a -> a
cos (a
k forall a. Num a => a -> a -> a
* a
y0)) (a
0.001 forall a. Num a => a -> a -> a
* a
base2)
               | Char
c0 forall a. Eq a => a -> a -> Bool
== Char
'7' = (forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (forall a. Floating a => a -> a
sin (a
k forall a. Num a => a -> a -> a
* a
y0)) (-a
0.01 forall a. Num a => a -> a -> a
* a
base1)
               | Char
c0 forall a. Eq a => a -> a -> Bool
== Char
'8' = (forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (forall a. Floating a => a -> a
cos (a
k forall a. Num a => a -> a -> a
* a
y0)) (-a
0.01 forall a. Num a => a -> a -> a
* a
base1)
               | Bool
otherwise = (forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (a
y0 forall a. Floating a => a -> a -> a
** a
k) a
base1
                  where base :: a
base = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Integer
1 forall a b. (a -> b) -> a -> b
$ (forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ws :: Maybe Integer)
                        ords :: Char -> a -> a -> Bool
ords Char
t0
                          | Char
t0 forall a. Eq a => a -> a -> Bool
== Char
'2' = forall a. Ord a => a -> a -> Bool
(>)
                          | Bool
otherwise = forall a. Ord a => a -> a -> Bool
(<)
                        (Char
w,[Char]
wws) = forall a. a -> Maybe a -> a
fromMaybe (Char
'2',[Char]
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (a, [a])
uncons forall a b. (a -> b) -> a -> b
$ [Char]
ws
                        base1 :: a
base1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Integer
50 forall a b. (a -> b) -> a -> b
$ (forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
wws :: Maybe Integer)
                        base2 :: a
base2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Integer
500 forall a b. (a -> b) -> a -> b
$ (forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
wws :: Maybe Integer)
                        k :: a
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Integer
2 forall a b. (a -> b) -> a -> b
$ (forall a. Read a => [Char] -> Maybe a
readMaybe [Char
w] :: Maybe Integer)
             
partitioningR
  :: (InsertLeft t2 (Result [] Char b Double), Monoid (t2 (Result [] Char b Double)), InsertLeft t2 Double, Monoid (t2 Double)) => String
  -> t2 (Result [] Char b Double)
  -> (t2 (Result [] Char b Double), t2 (Result [] Char b Double))
partitioningR :: forall (t2 :: * -> *) b.
(InsertLeft t2 (Result [] Char b Double),
 Monoid (t2 (Result [] Char b Double)), InsertLeft t2 Double,
 Monoid (t2 Double)) =>
[Char]
-> t2 (Result [] Char b Double)
-> (t2 (Result [] Char b Double), t2 (Result [] Char b Double))
partitioningR ![Char]
xs t2 (Result [] Char b Double)
dataR
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 (Result [] Char b Double)
dataR = (forall a. Monoid a => a
mempty,forall a. Monoid a => a
mempty)
 | Bool
otherwise = forall (t2 :: * -> *) (t :: * -> *) a b c.
(InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)),
 InsertLeft t2 c) =>
(c -> Bool)
-> t2 (Result t a b c)
-> (t2 (Result t a b c), t2 (Result t a b c))
partiR (forall (t :: * -> *) a. ConstraintsG t a => t a -> Double -> Bool
decodeCDouble [Char]
xs) t2 (Result [] Char b Double)
dataR
{-# INLINABLE partitioningR #-}

partitioningR2
  :: (InsertLeft t2 (Result2 a b Double), Monoid (t2 (Result2 a b Double)), InsertLeft t2 Double, Monoid (t2 Double)) => String
  -> t2 (Result2 a b Double)
  -> (t2 (Result2 a b Double), t2 (Result2 a b Double))
partitioningR2 :: forall (t2 :: * -> *) a b.
(InsertLeft t2 (Result2 a b Double),
 Monoid (t2 (Result2 a b Double)), InsertLeft t2 Double,
 Monoid (t2 Double)) =>
[Char]
-> t2 (Result2 a b Double)
-> (t2 (Result2 a b Double), t2 (Result2 a b Double))
partitioningR2 ![Char]
xs t2 (Result2 a b Double)
dataR
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 (Result2 a b Double)
dataR = (forall a. Monoid a => a
mempty,forall a. Monoid a => a
mempty)
 | Bool
otherwise = forall (t2 :: * -> *) a b c.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)),
 InsertLeft t2 c) =>
(c -> Bool)
-> t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
partiR2 (forall (t :: * -> *) a. ConstraintsG t a => t a -> Double -> Bool
decodeCDouble [Char]
xs) t2 (Result2 a b Double)
dataR
{-# INLINABLE partitioningR2 #-}