mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 10:21:51 +00:00
48 lines
1.9 KiB
Haskell
48 lines
1.9 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE KindSignatures #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
module Lib.Registry where
|
|
|
|
import Startlude ( ($)
|
|
, (.)
|
|
, ConvertText(toS)
|
|
, Eq((==))
|
|
, KnownSymbol
|
|
, Proxy(Proxy)
|
|
, Read
|
|
, Show
|
|
, String
|
|
, Symbol
|
|
, readMaybe
|
|
, show
|
|
, symbolVal
|
|
)
|
|
|
|
import qualified GHC.Read ( Read(..) )
|
|
import qualified GHC.Show ( Show(..) )
|
|
import System.FilePath ( (<.>)
|
|
, splitExtension
|
|
)
|
|
import Yesod.Core ( PathPiece(..) )
|
|
|
|
newtype Extension (a :: Symbol) = Extension String deriving (Eq)
|
|
type S9PK = Extension "s9pk"
|
|
|
|
extension :: KnownSymbol a => Extension a -> String
|
|
extension = symbolVal
|
|
|
|
instance KnownSymbol a => Show (Extension a) where
|
|
show e@(Extension file) = file <.> extension e
|
|
|
|
instance KnownSymbol a => Read (Extension a) where
|
|
readsPrec _ s = case symbolVal $ Proxy @a of
|
|
"" -> [(Extension s, "")]
|
|
other -> [ (Extension file, "") | ext' == "" <.> other ]
|
|
where (file, ext') = splitExtension s
|
|
|
|
instance KnownSymbol a => PathPiece (Extension a) where
|
|
fromPathPiece = readMaybe . toS
|
|
toPathPiece = show
|