src/Gargantext/Core/Utils/Prefix.hs

   1 {-|
   2 Module      : Gargantext.Core.Utils.Prefix
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Here is a longer description of this module, containing some
  11 commentary with @some markup@.
  12 -}
  13
  14
  15 module Gargantext.Core.Utils.Prefix
  16   ( module Gargantext.Core.Utils.Prefix
  17   , wellNamedSchema
  18   ) where
  19
  20 import Prelude
  21
  22 import Data.Aeson (Value, defaultOptions, parseJSON)
  23 import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields, sumEncoding, SumEncoding(UntaggedValue))
  24 import Data.Aeson.Types (Parser)
  25 import Data.Char (toLower)
  26 import Data.Swagger.SchemaOptions (SchemaOptions, fromAesonOptions)
  27 import Servant.Job.Utils (wellNamedSchema)
  28 import Text.Read (readMaybe)
  29
  30
  31 -- | Aeson Options that remove the prefix from fields
  32 unPrefix :: String -> Options
  33 unPrefix prefix = defaultOptions
  34   { fieldLabelModifier = unCapitalize . dropPrefix prefix
  35   , omitNothingFields = True
  36   }
  37
  38 unPrefixUntagged :: String -> Options
  39 unPrefixUntagged prefix = (unPrefix prefix)
  40   { sumEncoding = UntaggedValue }
  41
  42 unPrefixSwagger :: String -> SchemaOptions
  43 unPrefixSwagger = fromAesonOptions . unPrefix
  44
  45 -- | Lower case leading character
  46 --
  47 -- Note that this is not necessarily the first letter,
  48 -- as determined by 'Data.Char.isLetter'.
  49 --
  50 -- And that it is incorrect in some languages, eg.
  51 -- @('unCapitalize' "İ" == "i")@ even though it should be @"i\775"@.
  52 -- See https://hackage.haskell.org/package/text-2.0.2/docs/Data-Text.html#g:9
  53 unCapitalize :: String -> String
  54 unCapitalize [] = []
  55 unCapitalize (c:cs) = toLower c : cs
  56 --unCapitalize cs = map toLower cs
  57
  58 -- | Remove given prefix
  59 dropPrefix :: String -> String -> String
  60 dropPrefix prefix input = go prefix input
  61   where
  62     go pre [] = error $ conStringual $ "prefix leftover: " <> pre
  63     go [] (c:cs) = c : cs
  64     go (p:preRest) (c:cRest)
  65       | p == c = go preRest cRest
  66       | otherwise = error $ conStringual $ "not equal: " <>  (p:preRest)  <> " " <> (c:cRest)
  67
  68     conStringual msg = "dropPrefix: " <> msg <> ". " <> prefix <> " " <> input
  69
  70 parseJSONFromString :: (Read a) => Value -> Parser a
  71 parseJSONFromString v = do
  72   numString <- parseJSON v
  73   case readMaybe (numString :: String) of
  74     Nothing -> fail $ "Invalid number for TransactionID: " ++ show v -- TODO error message too specific
  75     Just n -> return n