

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}

-- {-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE RecordWildCards #-}

{-# LANGUAGE DeriveTraversable #-}

{-# LANGUAGE DataKinds #-}


-- {-# OPTIONS_GHC -Wall #-}

-- {-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- {-# OPTIONS_GHC -fno-warn-orphans #-}
-- {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-- {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
-- {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
-- {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
-- {-# OPTIONS_GHC -fno-warn-name-shadowing #-}


-- |
-- Copyright :  (c) Andreas Reuleaux 2015
-- License   :  BSD2
-- Maintainer:  Andreas Reuleaux <rx@a-rx.info>
-- Stability :  experimental
-- Portability: non-portable
--
-- This module provides Pire's Text to String conversion functions




module Pire.String2Text where

import Pire.Syntax.Expr
import Pire.Syntax.Ex
import Pire.Syntax.Decl
import Pire.Syntax.Telescope

import Pire.Syntax.Constructor

import Pire.Syntax.Modules
import Pire.Syntax.ConstructorNames
import Pire.Syntax.Nm
import Pire.Syntax.Ws
import Pire.Syntax.Token


import qualified Data.Set as S


import Data.Bifunctor

-- import Control.Applicative

import qualified Data.Text as T




class S2T a b | a -> b where
  s2t :: a -> b


instance S2T (Ws String) (Ws T.Text)  where
  s2t = fmap T.pack

instance S2T (Token 'ModuleTokTy String) (Token 'ModuleTokTy T.Text) where
  s2t = fmap T.pack


instance S2T (Token 'WhereTy String) (Token 'WhereTy T.Text) where
  s2t = fmap T.pack
  




string2textExpr :: Expr String String -> Ex
string2textExpr = bimap T.pack T.pack


instance S2T (Expr String String) Ex where
  s2t = string2textExpr


-- needed only later for Navigation/textual -> navigating to matches 
instance S2T (Match String String) (Match T.Text T.Text) where
  s2t = bimap T.pack T.pack

  

string2textDecl :: Decl String String -> Decl T.Text T.Text
string2textDecl = bimap T.pack T.pack


instance S2T (Decl String String) (Decl T.Text T.Text)  where
  s2t = string2textDecl


instance S2T [Decl String String] [Decl T.Text T.Text] where
  s2t = map string2textDecl





string2textImport :: ModuleImport String -> ModuleImport T.Text 
string2textImport = fmap T.pack


instance S2T (ModuleImport String) (ModuleImport T.Text) where
  s2t = string2textImport



instance S2T [ModuleImport String] [ModuleImport T.Text] where
  s2t = fmap string2textImport
  


string2textConstructorNames :: ConstructorNames String -> ConstructorNames T.Text
string2textConstructorNames (ConstructorNames tcons dcons) =
  ConstructorNames (S.map T.pack tcons) (S.map T.pack dcons)


instance S2T (ConstructorNames String) (ConstructorNames T.Text) where
  s2t = string2textConstructorNames




instance S2T (Nm1 String) (Nm1 T.Text)  where
  s2t = fmap T.pack




string2textM :: Module String String -> Module T.Text T.Text
string2textM (Module nm mimports mdecls constructors) =
  Module (s2t nm) (s2t mimports) (s2t mdecls) (s2t constructors)

string2textM (Module_
              leadingWhiteSpace
              mtoken
              nm
              whereToken
              mimports
              mdecls
              constructors) =
  Module_ (s2t leadingWhiteSpace) (s2t mtoken) (s2t nm) (s2t whereToken) (s2t mimports) (s2t mdecls) (s2t constructors)



-- todo: make Module a Bifunctor
-- string2textM m@(Module_ {..}) = bimap T.unpack T.unpack m






instance S2T  (Module String String ) (Module T.Text T.Text) where
  s2t = string2textM





string2textTele :: Telescope String String -> Telescope T.Text T.Text
string2textTele = bimap T.pack T.pack


instance S2T (Telescope String String) (Telescope T.Text T.Text)  where
  s2t = string2textTele




instance S2T (ConstructorDef String String) (ConstructorDef T.Text T.Text)  where
  s2t = bimap T.pack T.pack

