{- | Main Configuration of Gargantext Front-End

The main function to use for internal link in the Front-End
developpement is : toUrl.

* Example usage (depending on your Config):
toUrl Back  Corpus 1 == "http://localhost:8008/api/v1.0/corpus/1"
toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1"
-}
module Gargantext.Config where

import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject)
import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), maybe)
import Gargantext.Router as R

import Gargantext.Types (TermList, TermSize(..))

urlPlease :: End -> String -> String
urlPlease end path = theEnd.baseUrl <> theEnd.prePath <> path
  where theEnd = endOf end endConfig

endConfig :: EndConfig
endConfig = endConfig' V10

endConfig' :: ApiVersion -> EndConfig
endConfig' v = { front : frontRelative
               , back  : backLocal v
               --, back: backDev v
               , static : staticRelative
             }
--               , back  : backDemo v  }

------------------------------------------------------------------------
frontRelative :: Config
frontRelative = { baseUrl: ""
                , prePath: "/#/"
                }

staticRelative :: Config
staticRelative = { baseUrl: ""
                 , prePath : "/"
               }

frontCaddy :: Config
frontCaddy = { baseUrl: "http://localhost:2015"
             , prePath: "/#/"
             }

frontHaskell :: Config
frontHaskell = { baseUrl: "http://localhost:8008"
               , prePath: "/#/"
               }

frontDev :: Config
frontDev = { baseUrl: "https://dev.gargantext.org"
           , prePath: "/#/"
           }

frontDemo :: Config
frontDemo = { baseUrl: "https://demo.gargantext.org"
           , prePath: "/#/"
           }

frontProd :: Config
frontProd = { baseUrl: "https://gargantext.org"
            , prePath: "/#/"
            }

------------------------------------------------------------------------

backLocal :: ApiVersion -> Config
backLocal v = { baseUrl: "http://localhost:8008"
              , prePath: "/api/" <> show v <> "/"
              }

backDev :: ApiVersion -> Config
backDev v = { baseUrl: "https://dev.gargantext.org"
            , prePath: "/api/" <> show v <> "/"
            }

backDemo :: ApiVersion -> Config
backDemo v = { baseUrl: "https://demo.gargantext.org"
             , prePath: "/api/" <> show v <> "/"
             }

backProd :: ApiVersion -> Config
backProd v = { baseUrl: "https://gargantext.org"
             , prePath: "/api/" <> show v <> "/"
             }
------------------------------------------------------------------------

type EndConfig = { front :: Config
                 , back  :: Config
                 , static :: Config
                 }

type Config = { baseUrl :: String
              , prePath :: String
              }

------------------------------------------------------------
type UrlBase  = String
type UrlPath  = String
type UrlParam = String
type Url      = String

doUrl :: UrlBase -> UrlPath -> UrlParam -> Url
doUrl b p ps = b <> p <> ps

endOf :: forall cfg. End -> { front :: cfg, back :: cfg, static :: cfg } -> cfg
endOf Back  = _.back
endOf Front = _.front
endOf Static = _.static

endBaseUrl :: End -> EndConfig -> UrlBase
endBaseUrl end c = (endOf end c).baseUrl

endPathUrl :: End -> EndConfig -> Path -> Maybe Id -> UrlPath
endPathUrl end = pathUrl <<< endOf end

limitUrl :: Limit -> UrlPath
limitUrl l = "&limit=" <> show l

offsetUrl :: Offset -> UrlPath
offsetUrl o = "&offset=" <> show o

orderUrl :: forall a. Show a => Maybe a -> UrlPath
orderUrl = maybe "" (\x -> "&order=" <> show x)

orderByUrl :: forall a. Show a => Maybe a -> UrlPath
orderByUrl = maybe "" (\x -> "&orderBy=" <> show x)

showTabType' :: TabType -> String
showTabType' (TabCorpus   t) = show t
showTabType' (TabDocument t) = show t
showTabType' (TabPairing t) = show t

data TabPostQuery = TabPostQuery {
    offset :: Int
  , limit :: Int
  , orderBy :: OrderBy
  , tabType :: TabType
  , query :: String
  }

instance encodeJsonTabPostQuery :: EncodeJson TabPostQuery where
  encodeJson (TabPostQuery post) =
        "view"       := showTabType' post.tabType
     ~> "offset"     := post.offset
     ~> "limit"      := post.limit
     ~> "orderBy"    := show post.orderBy
     ~> "query"      := post.query
     ~> jsonEmptyObject

pathUrl :: Config -> Path -> Maybe Id -> UrlPath
pathUrl c (Tab t) i =
    pathUrl c (NodeAPI Node) i <> "/" <> showTabType' t
pathUrl c (Children n o l s) i =
    pathUrl c (NodeAPI Node) i <>
      "/" <> "children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s
pathUrl c (NodeAPI Phylo) pId = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId)
pathUrl c (GetNgrams
            { tabType: t
            , offset: o
            , orderBy
            , limit: l
            , listIds
            , termListFilter: tlf
            , termSizeFilter: tsf
            , searchQuery: q
            }) i =
      base
      <> "/ngrams?ngramsType=" <> showTabType' t
      <> offsetUrl o <> limitUrl l
      <> orderByUrl orderBy
      <> foldMap (\x -> "&list=" <> show x) listIds
      <> foldMap (\x -> "&listType=" <> show x) tlf
      <> foldMap (\x -> case x of
                          MonoTerm  -> "&minTermSize=0&maxTermSize=1"
                          MultiTerm -> "&minTermSize=2"
                 ) tsf
      <> if q == "" then "" else ("&search=" <> q)
        where
          base =  case t of
                    TabCorpus _ -> pathUrl c (NodeAPI Node) i
                    _           -> pathUrl c (NodeAPI Url_Document) i
pathUrl c (ListDocument lId) dId =
  pathUrl c (NodeAPI NodeList) lId <> "/document/" <> (show $ maybe 0 identity dId)

pathUrl c (PutNgrams t listid termList) i =
    pathUrl c (NodeAPI Node) i <> "/ngrams?ngramsType="
      <> showTabType' t
      <> maybe "" (\x -> "&list=" <> show x) listid
      <> foldMap (\x -> "&listType=" <> show x) termList
pathUrl c Auth Nothing = c.prePath <> "auth"
pathUrl c Auth (Just _) = "impossible" -- TODO better types
pathUrl c (NodeAPI nt) i = c.prePath <> nodeTypeUrl nt <> (maybe "" (\i' -> "/" <> show i') i)
pathUrl c (Search {listId,limit,offset,orderBy}) i =
    pathUrl c (NodeAPI Corpus) i
      <> "/search?list_id=" <> show listId
      <> offsetUrl offset <> limitUrl limit <> orderUrl orderBy
pathUrl c (CorpusMetrics {tabType, listId, limit}) i =
    pathUrl c (NodeAPI Corpus) i <> "/metrics"
      <> "?ngrams=" <> show listId
      <> "&ngramsType=" <> showTabType' tabType
      <> maybe "" (\x -> "&limit=" <> show x) limit
-- TODO fix this url path
pathUrl c (Chart {chartType, tabType}) i =
    pathUrl c (NodeAPI Corpus) i <> "/" <> show chartType
      <> "?ngramsType=" <> showTabType' tabType
      <> "&listType=GraphTerm" -- <> show listId
      -- <> maybe "" (\x -> "&limit=" <> show x) limit


------------------------------------------------------------

routesPath :: R.Routes -> String
routesPath R.Home = ""
routesPath R.Login = "login"
routesPath R.SearchView = "search"
routesPath (R.Folder i) = "folder/" <> show i
routesPath (R.Corpus i) = "corpus/" <> show i
routesPath R.AddCorpus = "addCorpus"
routesPath (R.CorpusDocument c l i) = "corpus/" <> show c <> "/list/" <> show l <> "/document/" <> show i
routesPath (R.Document l i) = "list/" <> show l <> "/document/" <> show i
routesPath (R.PGraphExplorer i) = "#/"
routesPath (R.Texts i) = "texts/" <> show i
routesPath (R.Lists i) = "lists/" <> show i
routesPath R.Dashboard = "dashboard"
routesPath (R.Annuaire i) = "annuaire/" <> show i
routesPath (R.UserPage i) = "user/" <> show i
routesPath (R.ContactPage i) = "contact/" <> show i

class Linkable a where
  toLink :: a -> String

instance linkableRoutes :: Linkable R.Routes where
  toLink l = endConfig.front.baseUrl <> endConfig.front.prePath <> routesPath l

class ToUrl a where
  toUrl :: End -> a -> Maybe Id -> Url

instance toUrlNodeType :: ToUrl NodeType where
  toUrl e nt i = toUrl e (NodeAPI nt) i

instance toUrlPath :: ToUrl Path where
  toUrl e p i = doUrl base path params
    where
      base   = endBaseUrl e endConfig
      path   = endPathUrl e endConfig p i
      params = ""
------------------------------------------------------------

data NodeType = NodeUser
              | Annuaire
              | NodeContact
              | Corpus
              | Url_Document
              | CorpusV3
              | Dashboard
              | Error
              | Folder
              | Graph
              | Phylo
              | Individu
              | Node
              | Nodes
              | Tree
              | NodeList
              | Texts

derive instance eqNodeType :: Eq NodeType

instance showNodeType :: Show NodeType where
  show NodeUser      = "NodeUser"
  show Annuaire      = "Annuaire"
  show NodeContact   = "NodeContact"
  show Corpus        = "NodeCorpus"
  show CorpusV3      = "NodeCorpusV3"
  show Dashboard     = "NodeDashboard"
  show Url_Document  = "NodeDocument"
  show Error         = "NodeError"
  show Folder        = "NodeFolder"
  show Graph         = "NodeGraph"
  show Phylo         = "NodePhylo"
  show Individu      = "NodeIndividu"
  show Node          = "Node"
  show Nodes         = "Nodes"
  show Tree          = "NodeTree"
  show NodeList      = "NodeList"
  show Texts         = "NodeTexts"

readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire"  = Annuaire
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document"      = Url_Document
readNodeType "NodeFolder"    = Folder
readNodeType "NodeGraph"     = Graph
readNodeType "NodePhylo"     = Phylo
readNodeType "Individu"      = Individu
readNodeType "Node"          = Node
readNodeType "Nodes"         = Nodes
readNodeType "NodeCorpus"    = Corpus
readNodeType "NodeCorpusV3"  = CorpusV3
readNodeType "NodeUser"      = NodeUser
readNodeType "NodeContact"   = NodeContact
readNodeType "Tree"          = Tree
readNodeType "NodeList"      = NodeList
readNodeType "NodeTexts"     = Texts
readNodeType _               = Error
{-
------------------------------------------------------------
instance ordNodeType :: Ord NodeType where
  compare n1 n2 = compare (show n1) (show n2)

instance eqNodeType :: Eq NodeType where
  eq n1 n2  = eq (show n1) (show n2)
-}
------------------------------------------------------------
instance decodeJsonNodeType :: DecodeJson NodeType where
  decodeJson json = do
    obj <- decodeJson json
    pure $ readNodeType obj

instance encodeJsonNodeType :: EncodeJson NodeType where
  encodeJson nodeType = encodeJson $ show nodeType

nodeTypeUrl :: NodeType -> Url
nodeTypeUrl Annuaire  = "annuaire"
nodeTypeUrl Corpus    = "corpus"
nodeTypeUrl CorpusV3  = "corpus"
nodeTypeUrl Dashboard = "dashboard"
nodeTypeUrl Url_Document  = "document"
nodeTypeUrl Error     = "ErrorNodeType"
nodeTypeUrl Folder    = "folder"
nodeTypeUrl Graph     = "graph"
nodeTypeUrl Phylo     = "phylo"
nodeTypeUrl Individu  = "individu"
nodeTypeUrl Node      = "node"
nodeTypeUrl Nodes     = "nodes"
nodeTypeUrl NodeUser  = "user"
nodeTypeUrl NodeContact = "contact"
nodeTypeUrl Tree      = "tree"
nodeTypeUrl NodeList  = "lists"
nodeTypeUrl Texts     = "texts"
------------------------------------------------------------

type ListId = Int

data Path
  = Auth
  | Tab      TabType
  | Children NodeType Offset Limit (Maybe OrderBy)
  | GetNgrams
      { tabType        :: TabType
      , offset         :: Offset
      , limit          :: Limit
      , orderBy        :: Maybe OrderBy
      , listIds        :: Array ListId
      , termListFilter :: Maybe TermList
      , termSizeFilter :: Maybe TermSize
      , searchQuery    :: String
      }
  | PutNgrams TabType (Maybe ListId) (Maybe TermList)
  -- ^ The name is not good. In particular this URL is used both in PUT and POST.
  | NodeAPI NodeType
  | ListDocument (Maybe ListId)
  | Search  { {-id :: Int
            , query    :: Array String
            ,-}
              listId   :: Int
            , limit    :: Limit
            , offset   :: Offset
            , orderBy  :: Maybe OrderBy
            }
  | CorpusMetrics { tabType :: TabType
                  , listId  :: ListId
                  , limit   :: Maybe Limit
                  }
  | Chart { chartType :: ChartType
          , tabType   :: TabType
     --            , listId  :: ListId
      --           , limit   :: Maybe Limit
                 }

data ChartType = Histo | Scatter | ChartPie | ChartTree

instance showChartType :: Show ChartType
  where
    show Histo    = "chart"
    show Scatter  = "scatter"
    show ChartPie = "pie"
    show ChartTree = "tree"

data End = Back | Front | Static
type Id  = Int

type Limit  = Int
type Offset = Int
data OrderBy = DateAsc  | DateDesc
             | TitleAsc | TitleDesc
             | ScoreAsc | ScoreDesc
             | TermAsc  | TermDesc
             | SourceAsc | SourceDesc

derive instance genericOrderBy :: Generic OrderBy _

instance showOrderBy :: Show OrderBy where
  show = genericShow

------------------------------------------------------------
data ApiVersion = V10 | V11
instance showApiVersion :: Show ApiVersion where
  show V10 = "v1.0"
  show V11 = "v1.1"
------------------------------------------------------------

data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes

derive instance eqCTabNgramType :: Eq CTabNgramType

instance showCTabNgramType :: Show CTabNgramType where
  show CTabTerms      = "Terms"
  show CTabSources    = "Sources"
  show CTabAuthors    = "Authors"
  show CTabInstitutes = "Institutes"

data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication

derive instance eqPTabNgramType :: Eq PTabNgramType

instance showPTabNgramType :: Show PTabNgramType where
  show PTabPatents       = "Patents"
  show PTabBooks         = "Books"
  show PTabCommunication = "Communication"

data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash

derive instance eqTabSubType :: Eq a => Eq (TabSubType a)

instance showTabSubType :: Show a => Show (TabSubType a) where
  show TabDocs          = "Docs"
  show (TabNgramType a) = show a
  show TabTrash         = "Trash"
  show TabMoreLikeFav   = "MoreFav"
  show TabMoreLikeTrash = "MoreTrash"

data TabType
  = TabCorpus   (TabSubType CTabNgramType)
  | TabPairing  (TabSubType PTabNgramType)
  | TabDocument (TabSubType CTabNgramType)

derive instance eqTabType :: Eq TabType

derive instance genericTabType :: Generic TabType _

instance showTabType :: Show TabType where
  show = genericShow