{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Symantic for 'FileSystem'.
module Hcompta.LCC.Sym.FileSystem where

import Control.Applicative (Applicative(..))
import Data.Eq (Eq)
import Data.Foldable (concat)
import Data.Function (($), (.))
import Data.Functor (Functor(..), (<$>))
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Proxy
import Data.Type.Equality ((:~:)(Refl))
import System.IO (FilePath)
import Text.Show (Show(..))
import qualified Data.Text as Text
import qualified Prelude ()

import Language.Symantic
-- import Language.Symantic.Lib.Lambda
import qualified Language.Symantic.Lib as Sym
import Hcompta.LCC.Journal (PathFile(..))

-- * Class 'Sym_FileSystem'
class Sym_FileSystem term where
	pathfile :: PathFile -> term PathFile
	default pathfile :: Trans t term => PathFile -> t term PathFile
	pathfile = trans_lift . pathfile

type instance Sym_of_Iface (Proxy PathFile) = Sym_FileSystem
type instance TyConsts_of_Iface (Proxy PathFile) = Proxy PathFile ': TyConsts_imported_by (Proxy PathFile)
type instance TyConsts_imported_by (Proxy PathFile) =
 [ Proxy Eq
 , Proxy Show
 ]

instance Sym_FileSystem HostI where
	pathfile = HostI
instance Sym_FileSystem TextI where
	pathfile a = TextI $ \_p _v ->
		Text.pack (show a)
instance (Sym_FileSystem r1, Sym_FileSystem r2) => Sym_FileSystem (DupI r1 r2) where
	pathfile x = pathfile x `DupI` pathfile x

instance
 ( Read_TyNameR TyName cs rs
 , Inj_TyConst cs PathFile
 ) => Read_TyNameR TyName cs (Proxy PathFile ': rs) where
	read_TyNameR _cs (TyName "PathFile") k = k (ty @PathFile)
	read_TyNameR _rs raw k = read_TyNameR (Proxy @rs) raw k
instance Show_TyConst cs => Show_TyConst (Proxy PathFile ': cs) where
	show_TyConst TyConstZ{} = "PathFile"
	show_TyConst (TyConstS c) = show_TyConst c

instance Proj_TyFamC cs Sym.TyFam_MonoElement PathFile

instance -- Proj_TyConC
 ( Proj_TyConst cs PathFile
 , Proj_TyConsts cs (TyConsts_imported_by (Proxy PathFile))
 ) => Proj_TyConC cs (Proxy PathFile) where
	proj_TyConC _ (TyConst q :$ TyConst c)
	 | Just Refl <- eq_skind (kind_of_TyConst c) SKiType
	 , Just Refl <- proj_TyConst c (Proxy @PathFile)
	 = case () of
		 _ | Just Refl <- proj_TyConst q (Proxy @Eq)   -> Just TyCon
		   | Just Refl <- proj_TyConst q (Proxy @Show) -> Just TyCon
		 _ -> Nothing
	proj_TyConC _c _q = Nothing
data instance TokenT meta (ts::[*]) (Proxy PathFile)
 = Token_Term_FileSystem_PathFile PathFile
deriving instance (Eq meta, Eq_Token meta ts) => Eq (TokenT meta ts (Proxy PathFile))
deriving instance (Show meta, Show_Token meta ts) => Show (TokenT meta ts (Proxy PathFile))
instance -- CompileI
 ( Inj_TyConst cs PathFile
 -- , Inj_TyConst cs (->)
 , Proj_TyCon cs
 , Compile cs is
 ) => CompileI cs is (Proxy PathFile) where
	compileI tok _ctx k =
		case tok of
		 Token_Term_FileSystem_PathFile a -> k (ty @PathFile) $ TermO $ \_c -> pathfile a
instance -- TokenizeT
 Inj_Token meta ts PathFile =>
 TokenizeT meta ts (Proxy PathFile) where
	tokenizeT _t = mempty
instance -- Gram_Term_AtomsT
 ( Alt g
 , Gram_Rule g
 , Gram_Lexer g
 , Gram_Meta meta g
 , Inj_Token meta ts PathFile
 ) => Gram_Term_AtomsT meta ts (Proxy PathFile) g where
	gs_term_atomsT _t =
	 [ rule "term_pathfile" $
		lexeme $ metaG $
		(\a meta -> ProTok $ inj_EToken meta $ Token_Term_FileSystem_PathFile a)
		 <$> pathfileG
	 ]
		where
		pathfileG :: CF g PathFile
		pathfileG =
			fmap PathFile $
			(:)
			 <$> char '.'
			 <*> (concat <$> some ((:) <$> char '/' <*> pathfile_sectionG))
		pathfile_sectionG :: CF g FilePath
		pathfile_sectionG = some (choice $ unicat <$> [Unicat_Letter, Unicat_Number])