]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Core/Utils/Prefix.hs
max cliques with apax to 2
[gargantext.git] / 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