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)
  24 import Data.Aeson.Types (Parser)
  25 import Data.Char (toLower)
  26 import Data.Monoid ((<>))
  27 import Data.Swagger.SchemaOptions (SchemaOptions, fromAesonOptions)
  28 import Servant.Job.Utils (wellNamedSchema)
  29 import Text.Read (Read(..),readMaybe)
  30
  31
  32 -- | Aeson Options that remove the prefix from fields
  33 unPrefix :: String -> Options
  34 unPrefix prefix = defaultOptions
  35   { fieldLabelModifier = unCapitalize . dropPrefix prefix
  36   , omitNothingFields = True
  37   }
  38
  39 unPrefixSwagger :: String -> SchemaOptions
  40 unPrefixSwagger = fromAesonOptions . unPrefix
  41
  42 -- | Lower case leading character
  43 unCapitalize :: String -> String
  44 unCapitalize [] = []
  45 unCapitalize (c:cs) = toLower c : cs
  46 --unCapitalize cs = map toLower cs
  47
  48 -- | Remove given prefix
  49 dropPrefix :: String -> String -> String
  50 dropPrefix prefix input = go prefix input
  51   where
  52     go pre [] = error $ conStringual $ "prefix leftover: " <> pre
  53     go [] (c:cs) = c : cs
  54     go (p:preRest) (c:cRest)
  55       | p == c = go preRest cRest
  56       | otherwise = error $ conStringual $ "not equal: " <>  (p:preRest)  <> " " <> (c:cRest)
  57
  58     conStringual msg = "dropPrefix: " <> msg <> ". " <> prefix <> " " <> input
  59
  60 parseJSONFromString :: (Read a) => Value -> Parser a
  61 parseJSONFromString v = do
  62   numString <- parseJSON v
  63   case readMaybe (numString :: String) of
  64     Nothing -> fail $ "Invalid number for TransactionID: " ++ show v -- TODO error message too specific
  65     Just n -> return n