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