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