{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE RecordWildCards, ViewPatterns, PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module CryptoID
  ( module CryptoID
  , module Data.CryptoID.Poly.ImplicitNamespace
  , module Data.UUID.Cryptographic.ImplicitNamespace
  , module System.FilePath.Cryptographic.ImplicitNamespace
  ) where

import CryptoID.TH

import ClassyPrelude hiding (fromString)
import Model

import Data.CryptoID.Poly.ImplicitNamespace
import Data.UUID.Cryptographic.ImplicitNamespace
import System.FilePath.Cryptographic.ImplicitNamespace

import qualified Data.Text as Text

import Data.UUID.Types
import Web.PathPieces

import           Data.CaseInsensitive   (CI)
import qualified Data.CaseInsensitive as CI


instance PathPiece UUID where
  fromPathPiece = fromString . unpack
  toPathPiece = pack . toString

instance (CI.FoldCase s, PathPiece s) => PathPiece (CI s) where
  fromPathPiece = fmap CI.mk . fromPathPiece
  toPathPiece = toPathPiece . CI.foldedCase

instance {-# OVERLAPS #-} PathMultiPiece FilePath where
  fromPathMultiPiece = Just . unpack . intercalate "/"
  toPathMultiPiece = Text.splitOn "/" . pack
  
instance (CI.FoldCase s, PathMultiPiece s) => PathMultiPiece (CI s) where
  fromPathMultiPiece = fmap CI.mk . fromPathMultiPiece
  toPathMultiPiece = toPathMultiPiece . CI.foldedCase


-- Generates CryptoUUID... and CryptoFileName... Datatypes
decCryptoIDs [ ''SubmissionId
             , ''FileId
             , ''UserId
             ]
{- TODO: Do we need/want CryptoUUIDs for Sheet numbers? -}



newtype SubmissionMode = SubmissionMode (Maybe CryptoFileNameSubmission)
  deriving (Show, Read, Eq)

pattern NewSubmission :: SubmissionMode
pattern NewSubmission = SubmissionMode Nothing
pattern ExistingSubmission :: CryptoFileNameSubmission -> SubmissionMode
pattern ExistingSubmission cID = SubmissionMode (Just cID)

instance PathPiece SubmissionMode where
    fromPathPiece "new" = Just $ SubmissionMode Nothing
    fromPathPiece s     = SubmissionMode . Just <$> fromPathPiece s

    toPathPiece (SubmissionMode Nothing)  = "new"
    toPathPiece (SubmissionMode (Just x)) = toPathPiece x