{-|
Module      : Gargantext.Core.Utils.Prefix
Description : 
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Here is a longer description of this module, containing some
commentary with @some markup@.
-}


module Gargantext.Core.Utils.Prefix
  ( module Gargantext.Core.Utils.Prefix
  , wellNamedSchema
  ) where

import Prelude

import Data.Aeson (Value, defaultOptions, parseJSON)
import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields, sumEncoding, SumEncoding(UntaggedValue))
import Data.Aeson.Types (Parser)
import Data.Char (toLower)
import Data.Swagger.SchemaOptions (SchemaOptions, fromAesonOptions)
import Servant.Job.Utils (wellNamedSchema)
import Text.Read (readMaybe)


-- | Aeson Options that remove the prefix from fields
unPrefix :: String -> Options
unPrefix :: String -> Options
unPrefix String
prefix = Options
defaultOptions
  { fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
unCapitalize (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
dropPrefix String
prefix
  , omitNothingFields :: Bool
omitNothingFields = Bool
True
  }

unPrefixUntagged :: String -> Options
unPrefixUntagged :: String -> Options
unPrefixUntagged String
prefix = (String -> Options
unPrefix String
prefix)
  { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue }

unPrefixSwagger :: String -> SchemaOptions
unPrefixSwagger :: String -> SchemaOptions
unPrefixSwagger = Options -> SchemaOptions
fromAesonOptions (Options -> SchemaOptions)
-> (String -> Options) -> String -> SchemaOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Options
unPrefix

-- | Lower case leading character
unCapitalize :: String -> String
unCapitalize :: String -> String
unCapitalize [] = []
unCapitalize (Char
c:String
cs) = Char -> Char
toLower Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
--unCapitalize cs = map toLower cs

-- | Remove given prefix
dropPrefix :: String -> String -> String
dropPrefix :: String -> String -> String
dropPrefix String
prefix String
input = String -> String -> String
go String
prefix String
input
  where
    go :: String -> String -> String
go String
pre [] = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
conStringual (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"prefix leftover: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pre
    go [] (Char
c:String
cs) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
    go (Char
p:String
preRest) (Char
c:String
cRest)
      | Char
p Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c = String -> String -> String
go String
preRest String
cRest
      | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
conStringual (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"not equal: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>  (Char
pChar -> String -> String
forall a. a -> [a] -> [a]
:String
preRest)  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cRest)

    conStringual :: String -> String
conStringual String
msg = String
"dropPrefix: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
input

parseJSONFromString :: (Read a) => Value -> Parser a
parseJSONFromString :: Value -> Parser a
parseJSONFromString Value
v = do
  String
numString <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String
numString :: String) of
    Maybe a
Nothing -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"Invalid number for TransactionID: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v -- TODO error message too specific
    Just a
n -> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
n