src/Gargantext/Utils/Servant.hs

   1 module Gargantext.Utils.Servant where
   2
   3 import qualified Data.ByteString.Lazy.Char8 as BSC
   4 import Data.Csv (defaultEncodeOptions, encodeByNameWith, encodeDefaultOrderedByName, header, namedRecord, (.=), DefaultOrdered, EncodeOptions(..), NamedRecord, Quoting(QuoteNone), ToNamedRecord)
   5 import qualified Data.Map.Strict as Map
   6 import qualified Data.Text as T
   7 import qualified Data.Text.Encoding as TE
   8 import Gargantext.API.Ngrams.Types (mSetToList, NgramsRepoElement(..), NgramsTableMap, NgramsTerm(..), unNgramsTerm)
   9 import Gargantext.Core.Types.Main (ListType(..))
  10 import Network.HTTP.Media ((//), (/:))
  11 import qualified Prelude
  12 import Protolude
  13 import Protolude.Partial (read)
  14 import Servant
  15
  16 data CSV = CSV
  17
  18 instance Accept CSV where
  19   contentType _ = "text" // "csv" /: ("charset", "utf-8")
  20
  21 instance (DefaultOrdered a, ToNamedRecord a) => MimeRender CSV [a] where
  22   mimeRender _ = encodeDefaultOrderedByName
  23
  24 instance MimeRender CSV T.Text where
  25   mimeRender _ = BSC.fromStrict . TE.encodeUtf8
  26
  27 -- CSV:
  28 -- header: status\tlabel\tforms
  29 -- item: map\taccountability\taccounting|&|accoutns|&|account
  30 instance MimeRender CSV NgramsTableMap where
  31   -- mimeRender _ _val = encode ([] :: [(Text, Text)])
  32   mimeRender _ val = encodeByNameWith encOptions (header ["status", "label", "forms"]) $ fn <$> Map.toList val
  33     where
  34       encOptions = defaultEncodeOptions { encDelimiter = fromIntegral (ord '\t')
  35                                         , encQuoting = QuoteNone }
  36       fn :: (NgramsTerm, NgramsRepoElement) -> NamedRecord
  37       fn (NgramsTerm term, NgramsRepoElement { _nre_list, _nre_children }) =
  38         namedRecord [ "status" .= toText _nre_list
  39                     , "label" .= term
  40                     , "forms" .= (T.intercalate "|&|" $ unNgramsTerm <$> mSetToList _nre_children)]
  41       toText :: ListType -> Text
  42       toText CandidateTerm = "candidate"
  43       toText MapTerm = "map"
  44       toText StopTerm = "stop"
  45
  46 instance Read a => MimeUnrender CSV a where
  47    mimeUnrender _ bs = case BSC.take len bs of
  48      "text/csv" -> return . read . BSC.unpack $ BSC.drop len bs
  49      _ -> Left "didn't start with the magic incantation"
  50      where
  51        len :: Int64
  52        len = fromIntegral $ length ("text/csv" :: Prelude.String)
  53
  54 --instance ToNamedRecord a => MimeRender CSV [a] where
  55 --  mimeRender _ val = encode val
  56
  57 ----------------------------
  58
  59 data Markdown = Markdown
  60
  61 instance Accept Markdown where
  62   contentType _ = "text" // "markdown"
  63
  64 instance MimeRender Markdown T.Text where
  65   mimeRender _ = BSC.fromStrict . TE.encodeUtf8
  66
  67 instance MimeUnrender Markdown T.Text where
  68   mimeUnrender _ = Right . TE.decodeUtf8 . BSC.toStrict